[Database][Query] search for doc 2 authors

src/Gargantext/Database/Facet.hs

@@ -179,17 +179,17 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNgramTable queryNgramsTable
     where
          cond12 :: (NodeNgramRead, NodeRead) -> Column PGBool
          cond12 (nodeNgram, doc) =  _node_id                  doc
-                                .== nodeNgram_NodeNgramNodeId nodeNgram
+                                .== nodeNgram_node_id nodeNgram
 
          cond23 :: (NgramsRead, (NodeNgramRead, NodeReadNull)) -> Column PGBool
          cond23 (ngrams, (nodeNgram, _)) =  ngrams_id                  ngrams
-                                        .== nodeNgram_NodeNgramNgramId nodeNgram
+                                        .== nodeNgram_ngrams_id nodeNgram
          
          cond34 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, NodeReadNull))) -> Column PGBool
-         cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams_id ngrams     .== nodeNgram_NodeNgramNgramId        nodeNgram2
+         cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams_id ngrams     .== nodeNgram_ngrams_id       nodeNgram2
          
          cond45 :: (NodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))) -> Column PGBool
-         cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id  contact    .== nodeNgram_NodeNgramNodeId         nodeNgram2
+         cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id  contact    .== nodeNgram_node_id         nodeNgram2
 
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Queries/Join.hs

@@ -51,8 +51,8 @@ join3 q1 q2 q3 cond = ((,,) <$> q1 <*> q2 <*> q3) >>> keepWhen cond
 
 ------------------------------------------------------------------------
 
-leftJoin3' :: Query (NodeRead, (NodeNodeReadNull, NodeReadNull))
-leftJoin3' = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12 cond23
+leftJoin3Ex :: Query (NodeRead, (NodeNodeReadNull, NodeReadNull))
+leftJoin3Ex = leftJoin3 queryNodeNodeTable queryNodeTable queryNodeTable cond12 cond23
     where
          cond12 = undefined
          cond23 :: (NodeRead, (NodeNodeRead, NodeReadNull)) -> Column PGBool
@@ -75,6 +75,22 @@ leftJoin3 :: ( Default Unpackspec columnsL1 columnsL1
                 -> Query (columnsL3, nullableColumnsL3)
 leftJoin3 q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q1 q2 cond12) cond23
 
+
+leftJoin3'
+  :: (Default Unpackspec fieldsL1 fieldsL1,
+      Default Unpackspec fieldsL2 fieldsL2,
+      Default Unpackspec nullableFieldsR1 nullableFieldsR1,
+      Default Unpackspec fieldsR fieldsR,
+      Default NullMaker fieldsR nullableFieldsR1,
+      Default NullMaker (fieldsL2, nullableFieldsR1) nullableFieldsR2) =>
+     Opaleye.Select fieldsR
+     -> Opaleye.Select fieldsL2
+     -> Opaleye.Select fieldsL1
+     -> ((fieldsL2, fieldsR) -> Column PGBool)
+     -> ((fieldsL1, (fieldsL2, nullableFieldsR1)) -> Column PGBool)
+     -> Opaleye.Select (fieldsL1, nullableFieldsR2)
+leftJoin3' q1 q2 q3 cond12 cond23 = leftJoin q3 (leftJoin q2 q1 cond12) cond23
+
 --{-
 leftJoin4' :: Query (NodeRead, (NodeReadNull, (NgramsReadNull, NodeReadNull)))
 leftJoin4' = leftJoin4 queryNgramsTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34
@@ -127,22 +143,22 @@ leftJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = leftJoin q4 (leftJoin q3 (leftJoin
 
 -- rightJoin4 q1 q2 q3 q4 cond12 cond23 cond34 = rightJoin q4 (rightJoin q3 (rightJoin q1 q2 cond12) cond23) cond34
 
-
-leftJoin5' :: Query (NodeRead, (NodeReadNull, (NodeReadNull, (NodeReadNull, NodeReadNull))))
-leftJoin5' = leftJoin5 queryNodeTable queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34 cond45
+--{-
+leftJoin5' :: Query (NodeRead, (NodeReadNull, (NodeReadNull, (NodeNodeReadNull, NodeSearchReadNull))))
+leftJoin5' = leftJoin5 queryNodeSearchTable queryNodeNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34 cond45
     where
-         cond12 :: (NodeRead, NodeRead) -> Column PGBool
+         cond12 :: (NodeNodeRead, NodeSearchRead) -> Column PGBool
          cond12 = undefined
          
-         cond23 :: (NodeRead, (NodeRead, NodeReadNull)) -> Column PGBool
+         cond23 :: (NodeRead, (NodeNodeRead, NodeSearchReadNull)) -> Column PGBool
          cond23 = undefined
          
-         cond34 :: (NodeRead, (NodeRead, (NodeReadNull, NodeReadNull))) -> Column PGBool
+         cond34 :: (NodeRead, (NodeRead, (NodeNodeReadNull, NodeSearchReadNull))) -> Column PGBool
          cond34 = undefined
          
-         cond45 :: (NodeRead, (NodeRead, (NodeReadNull, (NodeReadNull, NodeReadNull)))) -> Column PGBool
+         cond45 :: (NodeRead, (NodeRead, (NodeReadNull, (NodeNodeReadNull, NodeSearchReadNull)))) -> Column PGBool
          cond45 = undefined
-
+--}
 
 leftJoin5 :: ( Default Unpackspec fieldsL1 fieldsL1,
                Default Unpackspec fieldsL2 fieldsL2,
@@ -198,4 +214,25 @@ leftJoin6 :: ( Default Unpackspec fieldsL1 fieldsL1,
 leftJoin6 q1 q2 q3 q4 q5 q6 cond12 cond23 cond34 cond45 cond56 =
   leftJoin q6 (leftJoin q5 (leftJoin q4 (leftJoin q3 (leftJoin q2 q1 cond12) cond23) cond34) cond45) cond56
 
+--{-
+leftJoin6' :: Query (NodeRead, (NodeReadNull, (NodeReadNull, (NodeReadNull, (NodeNodeReadNull, NodeSearchReadNull)))))
+leftJoin6' = leftJoin6 queryNodeSearchTable queryNodeNodeTable queryNodeTable queryNodeTable queryNodeTable queryNodeTable cond12 cond23 cond34 cond45 cond56
+    where
+         cond12 :: (NodeNodeRead, NodeSearchRead) -> Column PGBool
+         cond12 = undefined
+         
+         cond23 :: (NodeRead, (NodeNodeRead, NodeSearchReadNull)) -> Column PGBool
+         cond23 = undefined
+         
+         cond34 :: (NodeRead, (NodeRead, (NodeNodeReadNull, NodeSearchReadNull))) -> Column PGBool
+         cond34 = undefined
+         
+         cond45 :: (NodeRead, (NodeRead, (NodeReadNull, (NodeNodeReadNull, NodeSearchReadNull)))) -> Column PGBool
+         cond45 = undefined
+         
+         cond56 :: (NodeRead, (NodeRead, (NodeReadNull, (NodeReadNull, (NodeNodeReadNull, NodeSearchReadNull))))) -> Column PGBool
+         cond56 = undefined
+
+--}
+
 

src/Gargantext/Database/Schema/Node.hs

@@ -290,8 +290,6 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
     returnA -< node
 
 
---type Cmd' a = forall m. (MonadReader env m, HasConnection env, MonadIO m) => m a
-
 
 -- deleteNode :: (MonadReader Connection m, MonadIO m) => Int -> m Int
 -- deleteNode :: Int -> Cmd' Int

src/Gargantext/Database/Schema/NodeNgram.hs

@@ -42,11 +42,11 @@ import qualified Database.PostgreSQL.Simple as PGS (Connection, query, Only(..))
 
 -- | TODO : remove id
 data NodeNgramPoly id node_id ngram_id weight ngrams_type
-   = NodeNgram { nodeNgram_NodeNgramId      :: id
-               , nodeNgram_NodeNgramNodeId  :: node_id
-               , nodeNgram_NodeNgramNgramId :: ngram_id
-               , nodeNgram_NodeNgramWeight  :: weight
-               , nodeNgram_NodeNgramType    :: ngrams_type
+   = NodeNgram { nodeNgram_id      :: id
+               , nodeNgram_node_id  :: node_id
+               , nodeNgram_ngrams_id :: ngram_id
+               , nodeNgram_weight  :: weight
+               , nodeNgram_type    :: ngrams_type
                } deriving (Show)
 
 type NodeNgramWrite =
@@ -83,11 +83,11 @@ $(makeLensesWith abbreviatedFields    ''NodeNgramPoly)
 nodeNgramTable :: Table NodeNgramWrite NodeNgramRead
 nodeNgramTable  = Table "nodes_ngrams"
   ( pNodeNgram NodeNgram
-    { nodeNgram_NodeNgramId      = optional "id"
-    , nodeNgram_NodeNgramNodeId  = required "node_id"
-    , nodeNgram_NodeNgramNgramId = required "ngram_id"
-    , nodeNgram_NodeNgramWeight  = required "weight"
-    , nodeNgram_NodeNgramType    = required "ngrams_type"
+    { nodeNgram_id        = optional "id"
+    , nodeNgram_node_id   = required "node_id"
+    , nodeNgram_ngrams_id = required "ngram_id"
+    , nodeNgram_weight    = required "weight"
+    , nodeNgram_type      = required "ngrams_type"
     }
   )
 

src/Gargantext/Database/TextSearch.hs

@@ -23,8 +23,12 @@ import Database.PostgreSQL.Simple.ToField
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Types.Node (NodeType(..))
 import Gargantext.Prelude
+import Gargantext.Database.Node.Contact
 import Gargantext.Database.Schema.Node
+import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.NodeNode
+import Gargantext.Database.Schema.NodeNgram
+import Gargantext.Database.Queries.Join (leftJoin6, leftJoin3')
 import Gargantext.Core.Types
 import Control.Arrow (returnA)
 import qualified Opaleye as O hiding (Order)
@@ -44,28 +48,11 @@ globalTextSearchQuery _ q = proc () -> do
     returnA  -< (_ns_id row, _ns_hyperdata row)
 
 ------------------------------------------------------------------------
-{-
-graphCorpusAuthorQuery :: O.Query (NodeRead, (NodeNgramRead, (NgramsReadNull, NodeNgramReadNull)))
-graphCorpusAuthorQuery = leftJoin4 queryNgramsTable queryNodeNgramTable queryNodeNgramTable queryNodeTable cond12 cond23 cond34
-  where
-    --cond12 :: (NgramsRead, NodeNgramRead) -> Column PGBool
-    cond12 = undefined
-
-    cond23 :: (NodeNgramRead, (NodeNgramRead, NodeNgramReadNull)) -> Column PGBool
-    cond23 = undefined
-    
-    cond34 :: (NodeRead, (NodeNgramRead, (NodeReadNull, NodeNgramReadNull))) -> Column PGBool
-    cond34 = undefined
---}
---runGraphCorpusDocSearch :: Connection -> CorpusId -> Text -> IO [(Column PGInt4, Column PGJsonb)]
---runGraphCorpusDocSearch c cId t = runQuery c $ graphCorpusDocSearch cId t
-
-
 -- | todo add limit and offset and order
 graphCorpusDocSearch :: CorpusId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
-graphCorpusDocSearch cId t = proc () -> do
+graphCorpusDocSearch cId q = proc () -> do
   (n, nn) <- graphCorpusDocSearchQuery -< ()
-  restrict -< (_ns_search n) @@ (pgTSQuery (unpack t))
+  restrict -< (_ns_search n) @@ (pgTSQuery (unpack q))
   restrict -< ( nodeNode_node1_id nn) .== (toNullable $ pgInt4 cId)
   restrict -< (_ns_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA  -< (_ns_id n, _ns_hyperdata n)
@@ -77,9 +64,70 @@ graphCorpusDocSearchQuery = leftJoin queryNodeSearchTable queryNodeNodeTable con
     cond (n, nn) = nodeNode_node1_id nn .== _ns_id n
 
 
-
-
-
+getGraphCorpusAuthors :: Connection -> CorpusId -> Text -> IO [((Int, HyperdataDocument),(Maybe Int, Maybe HyperdataContact))]
+getGraphCorpusAuthors c cId q = runQuery c $ selectGraphCorpusAuthors' cId q
+
+selectGraphCorpusAuthors' :: CorpusId -> Text -> O.Query ((Column PGInt4, Column PGJsonb),(Column (Nullable PGInt4), Column (Nullable PGJsonb)))
+selectGraphCorpusAuthors' cId q = proc () -> do
+  (docs, (corpusDoc, (docNgrams, (ngrams, (ngramsContact, contacts))))) <- queryGraphCorpusAuthors' -< ()
+  restrict -< (_ns_search docs)              @@ (pgTSQuery  $ unpack q  )
+  restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgInt4 cId)
+  restrict -< (_ns_typename docs)           .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< (nodeNgram_type docNgrams)    .== (toNullable $ pgInt4 $ ngramsTypeId Authors)
+  restrict -< (_node_typename contacts)     .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
+  returnA  -< ((_ns_id docs, _ns_hyperdata docs), (_node_id contacts, _node_hyperdata contacts))
+
+
+
+-- | This query can be used to select document with Authors in Annuaire only
+selectGraphCorpusAuthors :: CorpusId -> Text -> O.Query (Column (Nullable PGInt4), Column PGInt4, Column PGJsonb)
+selectGraphCorpusAuthors cId q = proc () -> do
+  (contacts, (contactNgrams, (ngrams, (docNgrams, (corpusDoc, docSearch))))) <- queryGraphCorpusAuthors -< ()
+  restrict -< (_ns_search docSearch)         @@ (pgTSQuery  $ unpack q  )
+  restrict -< (nodeNode_node1_id corpusDoc) .== (toNullable $ pgInt4 cId)
+  restrict -< (_ns_typename docSearch)      .== (toNullable $ pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< (nodeNgram_type docNgrams)    .== (toNullable $ pgInt4 $ ngramsTypeId Authors)
+  restrict -< (_node_typename contacts)     .== (pgInt4 $ nodeTypeId NodeContact)
+  returnA  -< (_ns_id docSearch, _node_id contacts, _node_hyperdata contacts)
+  --returnA  -< (_ns_id docSearch, _ns_name docSearch)
+
+
+queryGraphCorpusAuthors :: O.Query (NodeRead, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, (NodeNodeReadNull, NodeSearchReadNull)))))
+queryGraphCorpusAuthors = leftJoin6 queryNodeSearchTable queryNodeNodeTable queryNodeNgramTable queryNgramsTable queryNodeNgramTable queryNodeTable cond12 cond23 cond34 cond45 cond56
+    where
+         cond12 :: (NodeNodeRead, NodeSearchRead) -> Column PGBool
+         cond12 (nn, n) = nodeNode_node2_id nn .== _ns_id n
+         
+         cond23 :: (NodeNgramRead, (NodeNodeRead, NodeSearchReadNull)) -> Column PGBool
+         cond23 (nng, (nn, _)) = nodeNgram_node_id nng .== nodeNode_node2_id nn
+         
+         cond34 :: (NgramsRead, (NodeNgramRead, (NodeNodeReadNull, NodeSearchReadNull))) -> Column PGBool
+         cond34 (ng, (nng, (_,_))) = ngrams_id ng .== nodeNgram_ngrams_id nng
+         
+         cond45 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, (NodeNodeReadNull, NodeSearchReadNull)))) -> Column PGBool
+         cond45 (nng2, (ng2, (_,(_,_)))) = nodeNgram_ngrams_id nng2 .== ngrams_id ng2
+         
+         cond56 :: (NodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, (NodeNodeReadNull, NodeSearchReadNull))))) -> Column PGBool
+         cond56 (n2, (ng3, (_,(_,(_,_))))) = _node_id n2 .== nodeNgram_node_id ng3
+
+
+queryGraphCorpusAuthors' :: O.Query (NodeSearchRead, (NodeNodeReadNull, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))))
+queryGraphCorpusAuthors' = leftJoin6 queryNodeTable queryNodeNgramTable queryNgramsTable queryNodeNgramTable queryNodeNodeTable queryNodeSearchTable cond12 cond23 cond34 cond45 cond56
+    where
+         cond12 :: (NodeNgramRead, NodeRead) -> Column PGBool
+         cond12 (ng3, n2) = _node_id n2 .== nodeNgram_node_id ng3
+---------
+         cond23 :: (NgramsRead, (NodeNgramRead, NodeReadNull)) -> Column PGBool
+         cond23 (ng2, (nng2, _)) = nodeNgram_ngrams_id nng2 .== ngrams_id ng2
+         
+         cond34 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, NodeReadNull))) -> Column PGBool
+         cond34 (nng, (ng, (_,_))) = ngrams_id ng .== nodeNgram_ngrams_id nng
+         
+         cond45 :: (NodeNodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))) -> Column PGBool
+         cond45 (nn, (nng, (_,(_,_)))) = nodeNgram_node_id nng .== nodeNode_node2_id nn
+         
+         cond56 :: (NodeSearchRead, (NodeNodeRead, (NodeNgramReadNull, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull))))) -> Column PGBool
+         cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nodeNode_node2_id nn
 
 
 

src/Gargantext/Database/Utils.hs

@@ -52,6 +52,8 @@ instance Monad Cmd where
     unCmd (f a) c
 -}
 
+--type Cmd' a = forall m. (MonadReader env m, HasConnection env, MonadIO m) => m a
+
 newtype Cmd a = Cmd (ReaderT Connection IO a)
   deriving (Functor, Applicative, Monad, MonadReader Connection, MonadIO)