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

gargantext.cabal

@@ -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

@@ -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

@@ -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

@@ -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
+             :<|> "facet" :> QueryParam "type"   NodeType
                           :> QueryParam "offset" Int
                           :> QueryParam "limit"  Int
-                             :> Get '[JSON] [FacetDoc Value]
+                          :> 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

 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

@@ -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

@@ -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)

src/Gargantext/Database/NodeNodeNgram.hs

@@ -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

 {-# 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

@@ -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

@@ -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)