Skip to content

H
haskell-gargantext
Commit 7d5a98c6 authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[FacetDoc] Adding Favorite Left Join and Ngrams count queries.

parent a026a549
Hide whitespace changes
Inline Side-by-side
Showing with 62 additions and 118 deletions
gargantext.cabal
View file @ 7d5a98c6
......@@ -2,7 +2,7 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: 84f85626582b6f0f3f7b0c3dadf65d7f797a14e8a50389db1167f6652ec74e28
-- hash: 20ddea403b5eab78aff204d088cc635422d7b9b34369ff1c4263e3ba67969442
name: gargantext
version: 0.1.0.0
......@@ -85,11 +85,12 @@ library
Gargantext.Database.Instances
Gargantext.Database.Ngram
Gargantext.Database.Node
Gargantext.Database.Facet
Gargantext.Database.NodeNgram
Gargantext.Database.NodeNgramNgram
Gargantext.Database.NodeNode
Gargantext.Database.NodeNodeNgram
Gargantext.Database.Private
Gargantext.Database.Utils
Gargantext.Database.User
Gargantext.Ngrams
Gargantext.Ngrams.Count
......@@ -114,6 +115,7 @@ library
Gargantext.Utils.Prefix
other-modules:
Gargantext.API.Node
Gargantext.Database.Queries
Gargantext.Utils
Paths_gargantext
default-language: Haskell2010
......
package.yaml
View file @ 7d5a98c6
......@@ -29,11 +29,12 @@ library:
- Gargantext.Database.Instances
- Gargantext.Database.Ngram
- Gargantext.Database.Node
- Gargantext.Database.Facet
- Gargantext.Database.NodeNgram
- Gargantext.Database.NodeNgramNgram
- Gargantext.Database.NodeNode
- Gargantext.Database.NodeNodeNgram
- Gargantext.Database.Private
- Gargantext.Database.Utils
- Gargantext.Database.User
- Gargantext.Ngrams
- Gargantext.Ngrams.Count
......
src/Gargantext/API.hs
View file @ 7d5a98c6
......@@ -35,7 +35,7 @@ import Gargantext.API.Node ( Roots , roots
, NodesAPI , nodesAPI
)
import Gargantext.Database.Private (databaseParameters)
import Gargantext.Database.Utils (databaseParameters)
......
src/Gargantext/API/Node.hs
View file @ 7d5a98c6
......@@ -27,11 +27,11 @@ import System.IO (putStrLn, readFile)
import Data.Text (Text(), pack)
import Database.PostgreSQL.Simple (Connection)
import Gargantext.Prelude
import Gargantext.Types.Main (Node, NodeId, NodeType, FacetDoc)
import Gargantext.Types.Main (Node, NodeId, NodeType)
import Gargantext.Database.Node (getNodesWithParentId
, getNode, getNodesWith
, deleteNode, deleteNodes
, getDocFacet)
, deleteNode, deleteNodes)
import Gargantext.Database.Facet (FacetDoc, getDocFacet)
-- | Node API Types management
......@@ -48,10 +48,10 @@ type NodeAPI = Get '[JSON] (Node Value)
:> Get '[JSON] [Node Value]
:<|> "facetDoc" :> QueryParam "type" NodeType
:> QueryParam "offset" Int
:> QueryParam "limit" Int
:> Get '[JSON] [FacetDoc Value]
:<|> "facet" :> QueryParam "type" NodeType
:> QueryParam "offset" Int
:> QueryParam "limit" Int
:> Get '[JSON] [FacetDoc]
-- Depending on the Type of the Node, we could post
......@@ -90,7 +90,7 @@ getNodesWith' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe In
getNodesWith' conn id nodeType offset limit = liftIO (getNodesWith conn id nodeType offset limit)
getDocFacet' :: Connection -> NodeId -> Maybe NodeType -> Maybe Int -> Maybe Int
-> Handler [FacetDoc Value]
-> Handler [FacetDoc]
getDocFacet' conn id nodeType offset limit = liftIO (getDocFacet conn id nodeType offset limit)
query :: Text -> Handler Text
......
src/Gargantext/Database.hs
View file @ 7d5a98c6
module Gargantext.Database (
module Gargantext.Database.Private
module Gargantext.Database.Utils
-- , module Gargantext.Database.Instances
, module Gargantext.Database.User
, module Gargantext.Database.Node
......@@ -14,7 +14,7 @@ module Gargantext.Database (
-- , module Gargantext.Database.NodeType
) where
import Gargantext.Database.Private
import Gargantext.Database.Utils
--import Gargantext.Database.Gargandb
import Gargantext.Database.User
import Gargantext.Database.Node
......@@ -26,3 +26,5 @@ import Gargantext.Database.NodeNgramNgram
--import Gargantext.Database.Simple
--import Gargantext.Database.NodeType
--import Gargantext.Database.InsertNode
src/Gargantext/Database/Node.hs
View file @ 7d5a98c6
......@@ -29,8 +29,7 @@ import Prelude hiding (null, id, map, sum)
import Gargantext.Types
import Gargantext.Types.Main (NodeType)
import Gargantext.Database.NodeNode
-- import Gargantext.Database.NodeNgram
import Gargantext.Database.Queries
import Gargantext.Prelude hiding (sum)
......@@ -49,20 +48,6 @@ import Opaleye
-- | Types for Node Database Management
data PGTSVector
type NodeWrite = NodePoly (Maybe (Column PGInt4)) (Column PGInt4)
(Column PGInt4) (Column (Nullable PGInt4))
(Column (PGText)) (Maybe (Column PGTimestamptz))
(Column PGJsonb) -- (Maybe (Column PGTSVector))
type NodeRead = NodePoly (Column PGInt4) (Column PGInt4)
(Column PGInt4) (Column (Nullable PGInt4))
(Column (PGText)) (Column PGTimestamptz)
(Column PGJsonb) -- (Column PGTSVector)
-- Facets / Views for the Front End
type FacetDocRead = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
-- type FacetDocWrite = Facet (Column PGInt4) (Column PGJsonb) (Column PGBool) (Column PGFloat8)
instance FromField HyperdataCorpus where
fromField = fromField'
......@@ -101,14 +86,9 @@ fromField' field mb = do
Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
$(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly)
$(makeAdaptorAndInstance "pFacetDoc" ''Facet)
$(makeLensesWith abbreviatedFields ''Facet)
nodeTable :: Table NodeWrite NodeRead
nodeTable = Table "nodes" (pNode Node { node_id = optional "id"
......@@ -136,11 +116,6 @@ selectNodes id = proc () -> do
runGetNodes :: Connection -> Query NodeRead -> IO [Node Value]
runGetNodes = runQuery
type ParentId = NodeId
type Limit = Int
type Offset = Int
-- | order by publication date
-- Favorites (Bool), node_ngrams
selectNodesWith :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query NodeRead
......@@ -148,15 +123,6 @@ selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
--offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
limit' maybeLimit $ offset' maybeOffset $ orderBy (asc node_id) $ selectNodesWith' parentId maybeNodeType
limit' :: Maybe Limit -> Query a -> Query a
limit' maybeLimit query = maybe query (\l -> limit l query) maybeLimit
offset' :: Maybe Offset -> Query a -> Query a
offset' maybeOffset query = maybe query (\o -> offset o query) maybeOffset
selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
selectNodesWith' parentId maybeNodeType = proc () -> do
node <- (proc () -> do
......@@ -172,49 +138,6 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
returnA -< node
getDocFacet :: Connection -> Int -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> IO [FacetDoc Value]
getDocFacet conn parentId nodeType maybeOffset maybeLimit =
runQuery conn $ selectDocFacet parentId nodeType maybeOffset maybeLimit
selectDocFacet :: ParentId -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Query FacetDocRead
selectDocFacet parentId maybeNodeType maybeOffset maybeLimit =
-- limit' maybeLimit $ offset' maybeOffset $ orderBy (asc docFacet_id) $ selectDocFacet' parentId maybeNodeType
limit' maybeLimit $ offset' maybeOffset $ selectDocFacet' parentId maybeNodeType
--
selectDocFacet' :: ParentId -> Maybe NodeType -> Query FacetDocRead
selectDocFacet' parentId maybeNodeType = proc () -> do
node <- (proc () -> do
-- Selecting the documents
(Node n_id typeId _ parentId' _ _ hyperdata) <- queryNodeTable -< ()
restrict -< parentId' .== (toNullable $ pgInt4 parentId)
let typeId' = maybe 0 nodeTypeId maybeNodeType
restrict -< if typeId' > 0
then typeId .== (pgInt4 (typeId' :: Int))
else (pgBool True)
-- Ngram count by document
-- nodeNgramNgram@(NodeNgram _ n_id_nn _ weight) <- queryNodeNgramTable -< ()
-- restrict -< n_id_nn .== n_id
let ngramCount = (pgDouble 10) -- groupBy n_id
-- Favorite Column
(Node n_id_fav typeId_fav _ parentId_fav _ _ _) <- queryNodeTable -< ()
(NodeNode n1_id n2_id count) <- queryNodeNodeTable -< ()
restrict -< typeId_fav .== 15 .&& parentId_fav .== (toNullable $ pgInt4 parentId)
restrict -< n1_id .== n_id_fav .&& n_id .== n2_id
let isFav = ifThenElse (isNull count) (pgBool False) (pgBool True)
returnA -< (FacetDoc n_id hyperdata isFav ngramCount)) -< ()
returnA -< node
deleteNode :: Connection -> Int -> IO Int
deleteNode conn n = fromIntegral
<$> runDelete conn nodeTable
......@@ -232,6 +155,8 @@ getNodesWith conn parentId nodeType maybeOffset maybeLimit =
parentId nodeType maybeOffset maybeLimit
-- NP check type
getNodesWithParentId :: Connection -> Int -> Maybe Text -> IO [Node Value]
getNodesWithParentId conn n _ = runQuery conn $ selectNodesWithParentID n
......
src/Gargantext/Database/NodeNode.hs
View file @ 7d5a98c6
......@@ -22,8 +22,16 @@ data NodeNodePoly node1_id node2_id score
, nodeNode_score :: score
} deriving (Show)
type NodeNodeWrite = NodeNodePoly (Column PGInt4) (Column PGInt4) (Column (Nullable PGFloat8))
type NodeNodeRead = NodeNodePoly (Column PGInt4) (Column PGInt4) (Column (Nullable PGFloat8))
type NodeNodeWrite = NodeNodePoly (Column (Nullable PGInt4)) (Column (PGInt4)) (Column (Nullable PGFloat8))
type NodeNodeRead = NodeNodePoly (Column (Nullable PGInt4)) (Column (PGInt4)) (Column (Nullable PGFloat8))
type NodeNodeReadNull = NodeNodePoly (Column (Nullable PGInt4)) (Column (Nullable PGInt4)) (Column (Nullable PGFloat8))
-- type NodeNodeNodeJoined = (Co
type NodeNode = NodeNodePoly Int Int (Maybe Double)
......@@ -34,9 +42,9 @@ $(makeLensesWith abbreviatedFields ''NodeNodePoly)
nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
nodeNodeTable = Table "nodes_nodes" (pNodeNode NodeNode { nodeNode_node1_id = required "node1_id"
, nodeNode_node2_id = required "node2_id"
, nodeNode_score = required "score"
}
, nodeNode_node2_id = required "node2_id"
, nodeNode_score = required "score"
}
)
......
src/Gargantext/Database/NodeNodeNgram.hs
View file @ 7d5a98c6
......@@ -28,6 +28,7 @@ data NodeNodeNgramPoly node1_id node2_id ngram_id score
type NodeNodeNgramWrite = NodeNodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Maybe (Column PGFloat8))
type NodeNodeNgramRead = NodeNodeNgramPoly (Column PGInt4) (Column PGInt4) (Column PGInt4) (Column PGFloat8)
type NodeNodeNgramReadNull = NodeNodeNgramPoly (Column(Nullable PGInt4)) (Column (Nullable PGInt4)) (Column (Nullable PGInt4)) (Column (Nullable PGFloat8))
type NodeNodeNgram = NodeNodeNgramPoly Int Int Int (Maybe Double)
......
src/Gargantext/Database/Private.hs → src/Gargantext/Database/Utils.hs
View file @ 7d5a98c6
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module Gargantext.Database.Private where
module Gargantext.Database.Utils where
import qualified Database.PostgreSQL.Simple as PGS
......@@ -15,6 +15,11 @@ import Data.Word (Word16)
import System.IO (FilePath)
import Database.PostgreSQL.Simple (Connection, connect)
-- Utilities
import Opaleye (Query, Unpackspec, showSqlForPostgres)
import Data.Profunctor.Product.Default (Default)
import Data.Maybe (maybe)
import Prelude (id, putStrLn)
-- TODO add a reader Monad here
-- read this in the init file
......@@ -39,3 +44,9 @@ connectGargandb :: FilePath -> IO Connection
connectGargandb fp = do
parameters <- databaseParameters fp
connect parameters
printSql :: Default Unpackspec a a => Query a -> IO ()
printSql = putStrLn . maybe "Empty query" id . showSqlForPostgres
src/Gargantext/Types/Main.hs
View file @ 7d5a98c6
......@@ -37,7 +37,6 @@ import Gargantext.Types.Node ( NodePoly, HyperdataUser
, HyperdataGraph
, HyperdataPhylo
, HyperdataNotebook
, Facet
)
......@@ -93,7 +92,7 @@ corpusTree = NodeT Corpus ( [ leafT Document ]
data NodeType = NodeUser | Project | Corpus | Document | DocumentCopy
| Classification
| Lists
| Metrics
| Metrics | Occurrences
deriving (Show, Read, Eq, Generic)
instance FromJSON NodeType
......@@ -104,14 +103,13 @@ data Classification = Favorites | MyClassifcation
data Lists = StopList | MainList | MapList | GroupList
data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
| TfidfCorpus | TfidfGlobal | TirankLocal | TirankGlobal
-- data Metrics = Occurrences | Cooccurrences | Specclusion | Genclusion | Cvalue
-- | TfidfCorpus | TfidfGlobal | TirankLocal | TirankGlobal
-- | NodePoly indicates that Node has a Polymorphism Type
type Node json = NodePoly NodeId NodeTypeId NodeUserId (Maybe NodeParentId) NodeName UTCTime json -- NodeVector
type FacetDoc json = Facet NodeId HyperdataDocument Bool Double
-- type Node json = NodePoly NodeId NodeTypeId UserId ParentId NodeName UTCTime json
type NodeTypeId = Int
......@@ -179,7 +177,7 @@ nodeTypes = [ (NodeUser , 1)
-- , (MainList , 7)
-- , (MapList ,  8)
---- Scores
-- , (Occurrences , 10)
, (Occurrences , 10)
-- , (Cooccurrences , 9)
--
-- , (Specclusion , 11)
......@@ -204,9 +202,13 @@ nodeTypeId tn = fromMaybe (error $ "Typename " <> show tn <> " does not exist")
-- Temporary types to be removed
type Ngrams = (Text, Text, Text)
type ErrorMessage = Text
-- Queries
type ParentId = NodeId
type Limit = Int
type Offset = Int
src/Gargantext/Types/Node.hs
View file @ 7d5a98c6
......@@ -14,14 +14,6 @@ import Gargantext.Utils.Prefix (unPrefix)
import Data.Aeson.TH (deriveJSON)
-- DocFacet
data Facet id hyperdata favorite ngramCount = FacetDoc { facetDoc_id :: id
, facetDoc_hyperdata :: hyperdata
, facetDoc_favorite :: favorite
, facetDoc_ngramCount :: ngramCount
}
$(deriveJSON (unPrefix "facetDoc_") ''Facet)
-- node_Id... ?
data NodePoly id typename userId parentId name date hyperdata = Node { node_id :: id
......@@ -55,11 +47,11 @@ data HyperdataDocument = HyperdataDocument { hyperdataDocument_Bdd
, hyperdataDocument_Abstract :: Maybe Text
, hyperdataDocument_Statuses :: Maybe [Status]
, hyperdataDocument_Publication_date :: Maybe Text
, hyperdataDocument_Publication_year :: Maybe Text
, hyperdataDocument_Publication_month :: Maybe Text
, hyperdataDocument_Publication_hour :: Maybe Text
, hyperdataDocument_Publication_minute :: Maybe Text
, hyperdataDocument_Publication_second :: Maybe Text
, hyperdataDocument_Publication_year :: Maybe Double
, hyperdataDocument_Publication_month :: Maybe Double
, hyperdataDocument_Publication_hour :: Maybe Double
, hyperdataDocument_Publication_minute :: Maybe Double
, hyperdataDocument_Publication_second :: Maybe Double
, hyperdataDocument_LanguageIso2 :: Maybe Text
} deriving (Show, Generic)
$(deriveJSON (unPrefix "hyperdataDocument_") ''HyperdataDocument)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment