[PAIRING][COSMETICS]

devops/postgres/schema.sql

@@ -157,10 +157,10 @@ RETURNS trigger AS $$
 begin
   IF new.typename = 4 AND new.hyperdata @> '{"language_iso2":"EN"}' THEN
     new.search := to_tsvector( 'english' , (new.hyperdata ->> 'title') || ' ' || (new.hyperdata ->> 'abstract'));
-  
+
   ELSIF new.typename = 4 AND new.hyperdata @> '{"language_iso2":"FR"}' THEN
     new.search := to_tsvector( 'french' , (new.hyperdata ->> 'title') || ' ' || (new.hyperdata ->> 'abstract'));
-  
+
   ELSIF new.typename = 41 THEN
     new.search := to_tsvector( 'french' , (new.hyperdata ->> 'prenom')
                                  || ' ' || (new.hyperdata ->> 'nom')
@@ -194,6 +194,3 @@ UPDATE nodes SET hyperdata = hyperdata;
 
 
 
-
-
-

src/Gargantext/Database/Flow/Pairing.hs

@@ -20,7 +20,7 @@ module Gargantext.Database.Flow.Pairing
     where
 
 --import Debug.Trace (trace)
-import Control.Lens (_Just,view)
+import Control.Lens (_Just, (^.))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 -- import Opaleye
 -- import Opaleye.Aggregate
@@ -37,8 +37,7 @@ import Gargantext.Database.Node.Contact -- (HyperdataContact(..))
 import Gargantext.Database.Flow.Utils
 import Gargantext.Database.Utils (Cmd, runPGSQuery)
 import Gargantext.Database.Types.Node (AnnuaireId, CorpusId, ListId)
-import Gargantext.Database.Node.Children (getContacts)
-import Gargantext.Core.Types (NodeType(..))
+import Gargantext.Database.Node.Children (getAllContacts)
 
 -- TODO mv this type in Types Main
 type Terms = Text
@@ -49,8 +48,9 @@ pairing :: AnnuaireId
         -> ListId
         -> Cmd err Int
 pairing aId cId lId = do
-  contacts' <- getContacts aId (Just NodeContact)
-  let contactsMap = pairingPolicyToMap toLower $ toMaps extractNgramsT contacts'
+  contacts' <- getAllContacts aId
+  let contactsMap = pairingPolicyToMap toLower
+                  $ toMaps extractNgramsT contacts'
 
   ngramsMap' <- getNgramsTindexed cId Authors
   let ngramsMap = pairingPolicyToMap lastName ngramsMap'
@@ -82,7 +82,8 @@ extractNgramsT :: HyperdataContact
                -> Map (NgramsT Ngrams) Int
 extractNgramsT contact = fromList [(NgramsT Authors    a' , 1)| a' <- authors    ]
   where
-    authors    = map text2ngrams $ catMaybes [view (hc_who . _Just . cw_lastName) contact]
+    authors    = map text2ngrams
+               $ catMaybes [ contact^.(hc_who . _Just . cw_lastName) ]
 
 
 pairMaps :: Map (NgramsT Ngrams) a
@@ -110,7 +111,7 @@ getNgramsTindexed corpusId ngramsType' = fromList
       where
         selectQuery = [sql| SELECT n.id,n.terms,n.n from ngrams n
                       JOIN node_node_ngrams occ ON occ.ngrams_id = n.id
-                      JOIN nodes_nodes  nn  ON nn.node2_id = occ.node2_id
+                      JOIN nodes_nodes      nn  ON nn.node2_id   = occ.node2_id
 
                       WHERE nn.node1_id     = ?
                         AND occ.ngrams_type = ?

src/Gargantext/Database/Node/Children.hs

@@ -18,6 +18,7 @@ Portability : POSIX
 
 module Gargantext.Database.Node.Children where
 
+import Data.Proxy
 import Opaleye
 import Gargantext.Core.Types
 import Gargantext.Database.Schema.Node
@@ -29,12 +30,21 @@ import Gargantext.Database.Node.Contact (HyperdataContact)
 import Gargantext.Database.Schema.Node (pgNodeId)
 import Control.Arrow (returnA)
 
--- | TODO: use getChildren with Proxy ?
-getContacts :: ParentId
-            -> Maybe NodeType
-            -> Cmd err [Node HyperdataContact]
-getContacts pId maybeNodeType = runOpaQuery $ selectChildren pId maybeNodeType
 
+getAllDocuments :: ParentId -> Cmd err [Node HyperdataDocument]
+getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
+                                         (Just NodeDocument)
+
+getAllContacts :: ParentId -> Cmd err [Node HyperdataContact]
+getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
+                                        (Just NodeContact)
+
+getAllChildren :: JSONB a
+               => ParentId
+               -> proxy a
+               -> Maybe NodeType
+               -> Cmd err [Node a]
+getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
 
 getChildren :: JSONB a
             => ParentId
@@ -62,7 +72,3 @@ selectChildren parentId maybeNodeType = proc () -> do
                       ( (.&&) (n1id .== pgNodeId parentId)
                               (n2id .== nId))
     returnA -< row
-
-
-
-

src/Gargantext/Database/TextSearch.hs

@@ -66,9 +66,11 @@ searchInCorpus :: CorpusId
                -> Maybe Limit
                -> Maybe OrderBy
                -> Cmd err [FacetDoc]
-searchInCorpus cId t q o l order = runOpaQuery (filterWith o l order $ queryInCorpus cId t q')
-  where
-    q' = intercalate " | " $ map stemIt q
+searchInCorpus cId t q o l order = runOpaQuery
+                                 $ filterWith o l order
+                                 $ queryInCorpus cId t
+                                 $ intercalate " | "
+                                 $ map stemIt q
 
 queryInCorpus :: CorpusId
               -> IsTrash
@@ -76,12 +78,12 @@ queryInCorpus :: CorpusId
               -> O.Query FacetDocRead
 queryInCorpus cId t q = proc () -> do
   (n, nn) <- joinInCorpus -< ()
-  restrict -< ( nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
+  restrict -< (nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
   restrict -< if t
-                 then ( nn^.nn_category) .== (toNullable $ pgInt4     0)
-                 else ( nn^.nn_category) .>= (toNullable $ pgInt4     1)
+                 then (nn^.nn_category) .== (toNullable $ pgInt4 0)
+                 else (nn^.nn_category) .>= (toNullable $ pgInt4 1)
   restrict -< (n ^. ns_search)           @@ (pgTSQuery (unpack q))
-  restrict -< (n ^. ns_typename)        .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< (n ^. ns_typename )       .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA  -< FacetDoc (n^.ns_id       )
                        (n^.ns_date     )
                        (n^.ns_name     )
@@ -129,29 +131,33 @@ searchInCorpusWithContacts'
   -> Maybe OrderBy
   -> Cmd err [(FacetPaired Int UTCTime HyperdataDocument Int (Maybe Int, Maybe Text))]
 searchInCorpusWithContacts' cId lId q o l order =
-  runOpaQuery $ queryInCorpusWithContacts cId lId q' o l order
-    where
-      q' = intercalate " | " $ map stemIt q
+  runOpaQuery $ queryInCorpusWithContacts cId lId o l order
+              $ intercalate " | "
+              $ map stemIt q
 
 
 queryInCorpusWithContacts
   :: CorpusId
   -> ListId
-  -> Text
   -> Maybe Offset
   -> Maybe Limit
   -> Maybe OrderBy
+  -> Text
   -> O.Query FacetPairedRead
-queryInCorpusWithContacts cId lId q _ _ _ = proc () -> do
-  (docs, (corpusDoc, (docNgrams, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
-  restrict -< (docs^.ns_search)              @@ (pgTSQuery  $ unpack q  )
-  restrict -< (docs^.ns_typename)           .== (pgInt4 $ nodeTypeId NodeDocument)
-  restrict -< (docNgrams^.nnng_node2_id)    .== (toNullable $ pgNodeId lId)
-  restrict -< (corpusDoc^.nn_node1_id)      .== (toNullable $ pgNodeId cId)
-  -- restrict -< (nng_listType docNgrams)      .== (toNullable $ pgNgramsType Authors)
-  restrict -< (contacts^.node_typename)     .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
-  -- let contact_id    = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
-  returnA  -< FacetPaired (docs^.ns_id) (docs^.ns_date) (docs^.ns_hyperdata) (pgInt4 0) (contacts^.node_id, ngrams'^.ngrams_terms)
+queryInCorpusWithContacts cId lId _ _ _ q = proc () -> do
+  (n, (nn, (_nng, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
+  restrict -< (n^.ns_search)        @@ (pgTSQuery  $ unpack q  )
+  restrict -< (n^.ns_typename)     .== (pgInt4 $ nodeTypeId NodeDocument)
+--  restrict -< (nng^.nnng_node1_id) .== (toNullable $ pgNodeId lId)
+  restrict -< (nn^.nn_node1_id)    .== (toNullable $ pgNodeId cId)
+--   -- restrict -< (nng_listType nng)      .== (toNullable $ pgNgramsType Authors)
+--  restrict -< (contacts^.node_typename) .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
+--   -- let contact_id    = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
+  returnA  -< FacetPaired (n^.ns_id)
+                          (n^.ns_date)
+                          (n^.ns_hyperdata)
+                          (pgInt4 0)
+                          (contacts^.node_id, ngrams'^.ngrams_terms)
 
 joinInCorpusWithContacts :: O.Query ( NodeSearchRead
                                     , ( NodeNodeReadNull
@@ -179,7 +185,7 @@ joinInCorpusWithContacts =
   cond56
     where
       cond12 :: (NodeNodeNgramsRead, NodeRead) -> Column PGBool
-      cond12 (ng3, n2) = n2^.node_id .== ng3^.nnng_node1_id
+      cond12 (nnng, n2) = n2^.node_id .== nnng^.nnng_node1_id
 
       cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
       cond23 (ng2, (nnng2, _)) = nnng2^.nnng_ngrams_id .== ng2^.ngrams_id