[PAIR][WIP] NodeNgrams -> NodeNodeNgrams, needs tests.

src/Gargantext/API.hs

@@ -266,7 +266,8 @@ type GargPrivateAPI' =
                         :> ReqBody '[JSON] Query :> CountAPI
 
            -- Corpus endpoint --> TODO rename s/search/filter/g
-           :<|> "search":> Capture "corpus" NodeId :> SearchPairsAPI
+           :<|> "search":> Capture "corpus" NodeId
+                        :> SearchPairsAPI
 
            -- TODO move to NodeAPI?
            :<|> "graph" :> Summary "Graph endpoint"

src/Gargantext/API/Node.hs

@@ -131,7 +131,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              -- TODO gather it
              :<|> "table"     :> TableApi
              :<|> "ngrams"    :> TableNgramsApi
-             :<|> "pairing"   :> PairingApi
+             -- :<|> "pairing"   :> PairingApi
 
              :<|> "category"  :> CatApi
              :<|> "search"    :> SearchDocsAPI
@@ -187,7 +187,7 @@ nodeAPI p uId id = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode i
            -- TODO gather it
            :<|> tableApi             id
            :<|> apiNgramsTableCorpus id
-           :<|> getPairing           id
+           -- :<|> getPairing           id
            -- :<|> getTableNgramsDoc id
 
            :<|> catApi     id

src/Gargantext/API/Search.hs

@@ -65,7 +65,8 @@ instance Arbitrary SearchDocResults where
 instance ToSchema SearchDocResults where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sdr_")
 
-data SearchPairedResults = SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
+data SearchPairedResults =
+     SearchPairedResults { spr_results :: [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]] }
   deriving (Generic)
 $(deriveJSON (unPrefix "spr_") ''SearchPairedResults)
 
@@ -87,12 +88,14 @@ type SearchAPI results
  :> Post '[JSON] results
 
 type SearchDocsAPI  = SearchAPI SearchDocResults
-type SearchPairsAPI = SearchAPI SearchPairedResults
+type SearchPairsAPI = 
+  Summary "" :> "list"  :> Capture "list"   ListId
+  :> SearchAPI SearchPairedResults
 -----------------------------------------------------------------------
 
 searchPairs :: NodeId -> GargServer SearchPairsAPI
-searchPairs pId (SearchQuery q) o l order =
-  SearchPairedResults <$> searchInCorpusWithContacts pId q o l order
+searchPairs pId lId (SearchQuery q) o l order =
+  SearchPairedResults <$> searchInCorpusWithContacts pId lId q o l order
 
 searchDocs :: NodeId -> GargServer SearchDocsAPI
 searchDocs nId (SearchQuery q) o l order =

src/Gargantext/API/Table.hs

@@ -46,7 +46,7 @@ import GHC.Generics (Generic)
 import Gargantext.API.Ngrams (TabType(..))
 import Gargantext.Core.Types (Offset, Limit)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..),runViewAuthorsDoc)
+import Gargantext.Database.Facet (FacetDoc , runViewDocuments, OrderBy(..))
 import Gargantext.Database.Learn (FavOrTrash(..), moreLike)
 import Gargantext.Database.TextSearch
 import Gargantext.Database.Types.Node
@@ -97,6 +97,7 @@ getTable cId ft o l order =
     (Just MoreTrash) -> moreLike cId o l order IsTrash
     x     -> panic $ "not implemented in getTable: " <> (cs $ show x)
 
+{-
 getPairing :: ContactId -> Maybe TabType
          -> Maybe Offset  -> Maybe Limit
          -> Maybe OrderBy -> Cmd err [FacetDoc]
@@ -106,4 +107,4 @@ getPairing cId ft o l order =
     (Just Trash) -> runViewAuthorsDoc cId True  o l order
     _     -> panic $ "not implemented: get Pairing" <> (cs $ show ft)
 
-
+-}

src/Gargantext/Database/Facet.hs

@@ -26,8 +26,8 @@ Portability : POSIX
 {-# LANGUAGE TypeFamilies              #-}
 ------------------------------------------------------------------------
 module Gargantext.Database.Facet
-  ( runViewAuthorsDoc
-  , runViewDocuments
+  ( -- runViewAuthorsDoc
+   runViewDocuments
   , filterWith
 
   , Pair(..)
@@ -41,6 +41,7 @@ module Gargantext.Database.Facet
   where
 ------------------------------------------------------------------------
 import Control.Arrow (returnA)
+import Control.Lens ((^.))
 -- import Control.Lens.TH (makeLensesWith, abbreviatedFields)
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Aeson.TH (deriveJSON)
@@ -57,7 +58,6 @@ import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Schema.Node
-import Gargantext.Database.Schema.NodeNgram
 import Gargantext.Database.Schema.NodeNode
 import Gargantext.Database.Utils
 import Gargantext.Database.Queries.Join
@@ -115,36 +115,39 @@ instance (ToSchema i, ToSchema l) => ToSchema (Pair i l) where
 instance (Arbitrary i, Arbitrary l) => Arbitrary (Pair i l) where
   arbitrary = Pair <$> arbitrary <*> arbitrary
 
-data FacetPaired id date hyperdata score pairs =
+data FacetPaired id date hyperdata score pair =
   FacetPaired {_fp_id        :: id
               ,_fp_date      :: date
               ,_fp_hyperdata :: hyperdata
               ,_fp_score     :: score
-              ,_fp_pairs     :: pairs
+              ,_fp_pair      :: pair
   } deriving (Show, Generic)
 $(deriveJSON (unPrefix "_fp_") ''FacetPaired)
 $(makeAdaptorAndInstance "pFacetPaired" ''FacetPaired)
 
-instance (ToSchema id, ToSchema date, ToSchema hyperdata, ToSchema pairs, ToSchema score) => ToSchema (FacetPaired id date hyperdata score pairs) where
+instance ( ToSchema id
+         , ToSchema date
+         , ToSchema hyperdata
+         , ToSchema score
+         , ToSchema pair
+         ) => ToSchema (FacetPaired id date hyperdata score pair) where
   declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_fp_")
 
 instance ( Arbitrary id
          , Arbitrary date
          , Arbitrary hyperdata
          , Arbitrary score
-         , Arbitrary pairs
-         ) => Arbitrary (FacetPaired id date hyperdata score pairs) where
+         , Arbitrary pair
+         ) => Arbitrary (FacetPaired id date hyperdata score pair) where
   arbitrary = FacetPaired <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 
---{-
 type FacetPairedRead = FacetPaired (Column PGInt4       )
                                    (Column PGTimestamptz)
                                    (Column PGJsonb      )
                                    (Column PGInt4       )
-                                   (Pair (Column (Nullable PGInt4)) (Column (Nullable PGText)))
---}
-
-
+                                   ( Column (Nullable PGInt4)
+                                   , Column (Nullable PGText)
+                                   )
 
 -- | JSON instance
 $(deriveJSON (unPrefix "facetDoc_") ''Facet)
@@ -206,6 +209,8 @@ instance Arbitrary OrderBy
 
 
 -- TODO-SECURITY check
+
+{-
 runViewAuthorsDoc :: ContactId -> IsTrash -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
 runViewAuthorsDoc cId t o l order = runOpaQuery $ filterWith o l order $ viewAuthorsDoc cId t ntId
   where
@@ -234,16 +239,16 @@ queryAuthorsDoc = leftJoin5 queryNodeTable queryNodeNgramTable queryNgramsTable
                                 .== nng_node_id nodeNgram
 
          cond23 :: (NgramsRead, (NodeNgramRead, NodeReadNull)) -> Column PGBool
-         cond23 (ngrams, (nodeNgram, _)) =  ngrams_id                  ngrams
+         cond23 (ngrams, (nodeNgram, _)) =  ngrams^.ngrams_id
                                         .== nng_ngrams_id nodeNgram
 
          cond34 :: (NodeNgramRead, (NgramsRead, (NodeNgramReadNull, NodeReadNull))) -> Column PGBool
-         cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams_id ngrams     .== nng_ngrams_id       nodeNgram2
+         cond34 (nodeNgram2, (ngrams, (_,_)))= ngrams^.ngrams_id .== nng_ngrams_id       nodeNgram2
 
          cond45 :: (NodeRead, (NodeNgramRead, (NgramsReadNull, (NodeNgramReadNull, NodeReadNull)))) -> Column PGBool
          cond45 (contact, (nodeNgram2, (_, (_,_)))) = _node_id  contact    .== nng_node_id         nodeNgram2
 
-
+-}
 ------------------------------------------------------------------------
 
 -- TODO-SECURITY check
@@ -257,12 +262,12 @@ viewDocuments :: CorpusId -> IsTrash -> NodeTypeId -> Query FacetDocRead
 viewDocuments cId t ntId = proc () -> do
   n  <- queryNodeTable     -< ()
   nn <- queryNodeNodeTable -< ()
-  restrict -< _node_id        n .== nn_node2_id nn
-  restrict -< nn_node1_id    nn .== (pgNodeId cId)
-  restrict -< _node_typename  n .== (pgInt4 ntId)
-  restrict -< if t then nn_category  nn .== (pgInt4 0)
-                   else nn_category  nn .>= (pgInt4 1)
-  returnA  -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (toNullable $ nn_category nn) (toNullable $ nn_score nn)
+  restrict -< n^.node_id       .== nn^.nn_node2_id
+  restrict -< nn^.nn_node1_id  .== (pgNodeId cId)
+  restrict -< n^.node_typename .== (pgInt4 ntId)
+  restrict -< if t then nn^.nn_category .== (pgInt4 0)
+                   else nn^.nn_category .>= (pgInt4 1)
+  returnA  -< FacetDoc (_node_id n) (_node_date n) (_node_name n) (_node_hyperdata n) (toNullable $ nn^.nn_category) (toNullable $ nn^.nn_score)
 
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Flow.hs

@@ -7,15 +7,12 @@ Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
 
-
 -- TODO-ACCESS:
 --   check userId       CanFillUserCorpus   userCorpusId
 --   check masterUserId CanFillMasterCorpus masterCorpusId
 
 -- TODO-ACCESS: check uId CanInsertDoc pId && checkDocType nodeType
 -- TODO-EVENTS: InsertedNodes
-
-
 -}
 
 {-# OPTIONS_GHC -fno-warn-orphans    #-}
@@ -120,9 +117,12 @@ _flowCorpusApi u n tt l q = do
 
 ------------------------------------------------------------------------
 
--- UNUSED
 flowAnnuaire :: FlowCmdM env err m
-             => Username -> Either CorpusName [CorpusId] -> (TermType Lang) -> FilePath -> m AnnuaireId
+             => Username
+             -> Either CorpusName [CorpusId]
+             -> (TermType Lang)
+             -> FilePath
+             -> m AnnuaireId
 flowAnnuaire u n l filePath = do
   docs <- liftIO $ (( splitEvery 500 <$> deserialiseImtUsersFromFile filePath) :: IO [[HyperdataContact]])
   flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs
@@ -154,18 +154,30 @@ flowCorpusFile u n l la ff fp = do
 
 -- TODO query with complex query
 flowCorpusSearchInDatabase :: FlowCmdM env err m
-          => Username -> Lang -> Text -> m CorpusId
+                           => Username
+                           -> Lang
+                           -> Text
+                           -> m CorpusId
 flowCorpusSearchInDatabase u la q = do
-  (_masterUserId, _masterRootId, cId) <- getOrMkRootWithCorpus userMaster (Left "") (Nothing :: Maybe HyperdataCorpus)
+  (_masterUserId, _masterRootId, cId) <- getOrMkRootWithCorpus
+                                           userMaster
+                                           (Left "")
+                                           (Nothing :: Maybe HyperdataCorpus)
   ids <-  map fst <$> searchInDatabase cId (stemIt q)
   flowCorpusUser la u (Left q) (Nothing :: Maybe HyperdataCorpus) ids
 
 
 -- UNUSED
 _flowCorpusSearchInDatabaseApi :: FlowCmdM env err m
-          => Username -> Lang -> Text -> m CorpusId
+                               => Username
+                               -> Lang
+                               -> Text
+                               -> m CorpusId
 _flowCorpusSearchInDatabaseApi u la q = do
-  (_masterUserId, _masterRootId, cId) <- getOrMkRootWithCorpus userMaster (Left "") (Nothing :: Maybe HyperdataCorpus)
+  (_masterUserId, _masterRootId, cId) <- getOrMkRootWithCorpus
+                                           userMaster
+                                           (Left "")
+                                           (Nothing :: Maybe HyperdataCorpus)
   ids <-  map fst <$> searchInDatabase cId (stemIt q)
   flowCorpusUser la u (Left q) (Nothing :: Maybe HyperdataCorpus) ids
 
@@ -178,20 +190,33 @@ data CorpusInfo = CorpusName Lang Text
                 | CorpusId   Lang NodeId
 -}
 
-
 flow :: (FlowCmdM env err m, FlowCorpus a, MkCorpus c)
-     => Maybe c -> Username -> Either CorpusName [CorpusId] -> TermType Lang -> [[a]] -> m CorpusId
+     => Maybe c
+     -> Username
+     -> Either CorpusName [CorpusId]
+     -> TermType Lang
+     -> [[a]]
+     -> m CorpusId
 flow c u cn la docs = do
   ids <- mapM (insertMasterDocs c la ) docs
   flowCorpusUser (la ^. tt_lang) u cn c (concat ids)
 
 flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
-     => Username -> Either CorpusName [CorpusId] -> TermType Lang -> [[a]] -> m CorpusId
+           => Username
+           -> Either CorpusName [CorpusId]
+           -> TermType Lang
+           -> [[a]]
+           -> m CorpusId
 flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
 
 ------------------------------------------------------------------------
 flowCorpusUser :: (FlowCmdM env err m, MkCorpus c)
-               => Lang -> Username -> Either CorpusName [CorpusId] -> Maybe c -> [NodeId] -> m CorpusId
+               => Lang
+               -> Username
+               -> Either CorpusName [CorpusId]
+               -> Maybe c
+               -> [NodeId]
+               -> m CorpusId
 flowCorpusUser l userName corpusName ctype ids = do
   -- User Flow
   (userId, _rootId, userCorpusId) <- getOrMkRootWithCorpus userName corpusName ctype
@@ -223,7 +248,10 @@ insertMasterDocs :: ( FlowCmdM env err m
                     , FlowCorpus a
                     , MkCorpus   c
                     )
-                 => Maybe c -> TermType Lang -> [a] -> m [DocId]
+                 => Maybe c
+                 -> TermType Lang
+                 -> [a]
+                 -> m [DocId]
 insertMasterDocs c lang hs  =  do
   (masterUserId, _, masterCorpusId) <- getOrMkRootWithCorpus userMaster (Left corpusMasterName) c
 
@@ -254,13 +282,16 @@ insertMasterDocs c lang hs  =  do
 
   lId <- getOrMkList masterCorpusId masterUserId
   _   <- insertDocNgrams lId indexedNgrams
+
   pure $ map reId ids
 
 
 type CorpusName = Text
 
 
-getOrMkRoot :: (HasNodeError err) => Username -> Cmd err (UserId, RootId)
+getOrMkRoot :: (HasNodeError err)
+            => Username
+            -> Cmd err (UserId, RootId)
 getOrMkRoot username = do
   maybeUserId <- getUser username
   userId <- case maybeUserId of
@@ -280,7 +311,9 @@ getOrMkRoot username = do
 
 
 getOrMkRootWithCorpus :: (HasNodeError err, MkCorpus a)
-              => Username -> Either CorpusName [CorpusId] -> Maybe a
+                      => Username
+                      -> Either CorpusName [CorpusId]
+                      -> Maybe a
                       -> Cmd err (UserId, RootId, CorpusId)
 getOrMkRootWithCorpus username cName c = do
   (userId, rootId) <- getOrMkRoot username
@@ -301,14 +334,18 @@ getOrMkRootWithCorpus username cName c = do
 
 
 ------------------------------------------------------------------------
-viewUniqId' :: UniqId a => a -> (HashId, a)
+viewUniqId' :: UniqId a
+            => a
+            -> (HashId, a)
 viewUniqId' d = maybe err (\h -> (h,d)) (view uniqId d)
       where
         err = panic "[ERROR] Database.Flow.toInsert"
 
 
-toInserted :: [ReturnId] -> Map HashId ReturnId
-toInserted = Map.fromList . map    (\r ->  (reUniqId r, r)    )
+toInserted :: [ReturnId]
+           -> Map HashId ReturnId
+toInserted =
+  Map.fromList . map    (\r ->  (reUniqId r, r)    )
                . filter (\r -> reInserted r == True)
 
 data DocumentWithId a = DocumentWithId
@@ -361,10 +398,13 @@ instance HasText HyperdataDocument
 
 instance ExtractNgramsT HyperdataDocument
   where
-    extractNgramsT :: TermType Lang -> HyperdataDocument -> Cmd err (Map Ngrams (Map NgramsType Int))
+    extractNgramsT :: TermType Lang
+                   -> HyperdataDocument
+                   -> Cmd err (Map Ngrams (Map NgramsType Int))
     extractNgramsT lang hd = filterNgramsT 255 <$> extractNgramsT' lang hd
       where
-        extractNgramsT' :: TermType Lang -> HyperdataDocument
+        extractNgramsT' :: TermType Lang
+                        -> HyperdataDocument
                        -> Cmd err (Map Ngrams (Map NgramsType Int))
         extractNgramsT' lang' doc = do
           let source    = text2ngrams
@@ -389,7 +429,6 @@ instance ExtractNgramsT HyperdataDocument
                              <> [(a', Map.singleton Authors     1) | a' <- authors    ]
                              <> [(t', Map.singleton NgramsTerms 1) | t' <- terms'     ]
 
-
 filterNgramsT :: Int -> Map Ngrams (Map NgramsType Int)
                      -> Map Ngrams (Map NgramsType Int)
 filterNgramsT s ms = Map.fromList $ map (\a -> filter' s a) $ Map.toList ms
@@ -425,13 +464,16 @@ mapNodeIdNgrams = Map.unionsWith (Map.unionWith (Map.unionWith (+))) . fmap f
 
 ------------------------------------------------------------------------
 listInsert :: FlowCmdM env err m
-             => ListId -> Map NgramsType [NgramsElement]
+             => ListId
+             -> Map NgramsType [NgramsElement]
              -> m ()
 listInsert lId ngs = mapM_ (\(typeList, ngElmts)
                              -> putListNgrams lId typeList ngElmts
                              ) $ toList ngs
 
-flowList :: FlowCmdM env err m => UserId -> CorpusId
+flowList :: FlowCmdM env err m
+         => UserId
+         -> CorpusId
          -> Map NgramsType [NgramsElement]
          -> m ListId
 flowList uId cId ngs = do

src/Gargantext/Database/Flow/Pairing.hs

@@ -33,21 +33,22 @@ import Data.Text (Text, toLower)
 import qualified Data.Text as DT
 import Gargantext.Prelude hiding (sum)
 import Gargantext.Database.Schema.Ngrams -- (NgramsType(..))
---import Gargantext.Database.Node.Contact -- (HyperdataContact(..))
---import Gargantext.Database.Types.Node -- (Hyperdata(..))
-import Gargantext.Database.Node.Contact
+import Gargantext.Database.Node.Contact -- (HyperdataContact(..))
 import Gargantext.Database.Flow.Utils
 import Gargantext.Database.Utils (Cmd, runPGSQuery)
-import Gargantext.Database.Types.Node (AnnuaireId, CorpusId)
-import Gargantext.Database.Node.Children
+import Gargantext.Database.Types.Node (AnnuaireId, CorpusId, ListId)
+import Gargantext.Database.Node.Children (getContacts)
 import Gargantext.Core.Types (NodeType(..))
 
 -- TODO mv this type in Types Main
 type Terms = Text
 
 -- | TODO : add paring policy as parameter
-pairing :: AnnuaireId -> CorpusId -> Cmd err Int
-pairing aId cId = do
+pairing :: AnnuaireId
+        -> CorpusId
+        -> ListId
+        -> Cmd err Int
+pairing aId cId lId = do
   contacts' <- getContacts aId (Just NodeContact)
   let contactsMap = pairingPolicyToMap toLower $ toMaps extractNgramsT contacts'
 
@@ -56,31 +57,34 @@ pairing aId cId = do
 
   let indexedNgrams = pairMaps contactsMap ngramsMap
 
-  insertToNodeNgrams indexedNgrams
-  -- TODO add List
+  insertDocNgrams lId indexedNgrams
 
 lastName :: Terms -> Terms
-lastName texte = DT.toLower $ maybe texte (\x -> if DT.length x > 3 then x else texte) (lastName' texte)
+lastName texte = DT.toLower
+               $ maybe texte (\x -> if DT.length x > 3 then x else texte) (lastName' texte)
   where
     lastName' = lastMay . DT.splitOn " "
 
--- TODO: this methods is dangerous (maybe equalities of the result are not taken into account
--- emergency demo plan...
+-- TODO: this method is dangerous (maybe equalities of the result are not taken into account
+-- emergency demo plan...)
 pairingPolicyToMap :: (Terms -> Terms)
-                    -> Map (NgramsT Ngrams) a -> Map (NgramsT Ngrams) a
+                   -> Map (NgramsT Ngrams) a
+                   -> Map (NgramsT Ngrams) a
 pairingPolicyToMap f = DM.mapKeys (pairingPolicy f)
 
-pairingPolicy :: (Terms -> Terms) -> NgramsT Ngrams -> NgramsT Ngrams
+pairingPolicy :: (Terms -> Terms)
+              -> NgramsT Ngrams
+              -> NgramsT Ngrams
 pairingPolicy f (NgramsT nt (Ngrams ng _)) = (NgramsT nt (Ngrams (f ng) 1))
 
 -- | TODO : use Occurrences in place of Int
-extractNgramsT :: HyperdataContact -> Map (NgramsT Ngrams) Int
+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]
---}
 
--- NP: notice how this function is no longer specific to the ContactId type
+
 pairMaps :: Map (NgramsT Ngrams) a
          -> Map (NgramsT Ngrams) NgramsId
          -> Map NgramsIndexed (Map NgramsType a)
@@ -92,21 +96,25 @@ pairMaps m1 m2 =
     ]
 
 -----------------------------------------------------------------------
-getNgramsTindexed:: CorpusId -> NgramsType -> Cmd err (Map (NgramsT Ngrams) NgramsId)
+getNgramsTindexed :: CorpusId
+                  -> NgramsType
+                  -> Cmd err (Map (NgramsT Ngrams) NgramsId)
 getNgramsTindexed corpusId ngramsType' = fromList
     <$> map (\(ngramsId',t,n) -> (NgramsT ngramsType' (Ngrams t n),ngramsId'))
     <$> selectNgramsTindexed corpusId ngramsType'
-
-selectNgramsTindexed :: CorpusId -> NgramsType -> Cmd err [(NgramsId, Terms, Int)]
-selectNgramsTindexed corpusId ngramsType'' = runPGSQuery selectQuery (corpusId, ngramsTypeId ngramsType'')
+  where
+    selectNgramsTindexed :: CorpusId
+                         -> NgramsType
+                         -> Cmd err [(NgramsId, Terms, Int)]
+    selectNgramsTindexed corpusId' ngramsType'' = runPGSQuery selectQuery (corpusId', ngramsTypeId ngramsType'')
       where
         selectQuery = [sql| SELECT n.id,n.terms,n.n from ngrams n
-                  JOIN nodes_ngrams occ ON occ.ngram_id = n.id
-                  JOIN nodes_nodes  nn  ON nn.node2_id = occ.node_id
+                      JOIN node_node_ngrams occ ON occ.ngrams_id = n.id
+                      JOIN nodes_nodes  nn  ON nn.node2_id = occ.node2_id
 
                       WHERE nn.node1_id     = ?
                         AND occ.ngrams_type = ?
-                    AND occ.node_id = nn.node2_id
+                        AND occ.node2_id = nn.node2_id
                       GROUP BY n.id;
                      |]
 
@@ -124,5 +132,3 @@ selectNgramsTindexed corpusId ngramsType = proc () -> do
     result <- aggregate groupBy (ngrams_id ngrams)
     returnA -< result
 --}
-
-

src/Gargantext/Database/Flow/Utils.hs

@@ -22,10 +22,8 @@ import Gargantext.Prelude
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Database.Types.Node (NodeId, Node, NodePoly(..), Hyperdata)
 import Gargantext.Database.Utils (Cmd)
-import Gargantext.Database.Schema.NodeNgram
 import Gargantext.Database.Schema.NodeNodeNgrams
 import Gargantext.Database.Types.Node
-import Gargantext.Core.Types.Main (ListType(..), listTypeId)
 
 toMaps :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int) -> [Node a] -> Map (NgramsT Ngrams) (Map NodeId Int)
 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
@@ -39,8 +37,10 @@ mapNodeIdNgrams ds = DM.map (DM.fromListWith (+)) $ DM.fromListWith (<>) xs
     n2i = map (\d -> ((documentId . documentWithId) d, document_ngrams d))
 
 
-documentIdWithNgrams :: Hyperdata a => (a -> Map (NgramsT Ngrams) Int)
-                                     -> [DocumentWithId a] -> [DocumentIdWithNgrams a]
+documentIdWithNgrams :: Hyperdata a
+                     => (a -> Map (NgramsT Ngrams) Int)
+                     -> [DocumentWithId a]
+                     -> [DocumentIdWithNgrams a]
 documentIdWithNgrams f = map (\d -> DocumentIdWithNgrams d ((f . documentData) d))
 
 
@@ -56,19 +56,12 @@ data DocumentIdWithNgrams a =
      , document_ngrams :: Map (NgramsT Ngrams) Int
      } deriving (Show)
 
--- | TODO for now, list Type is CandidateTerm because Graph Terms
--- have to be detected in next step in the flow
--- TODO remvoe this
-insertToNodeNgrams :: Map NgramsIndexed (Map NgramsType (Map NodeId Int)) -> Cmd err Int
-insertToNodeNgrams m = insertNodeNgrams [ NodeNgram n (_ngramsId ng) Nothing (ngramsTypeId t) (listTypeId CandidateTerm) (fromIntegral i)
-                                        | (ng, t2n2i) <- DM.toList m
-                                        , (t,  n2i)   <- DM.toList t2n2i
-                                        , (n,  i)     <- DM.toList n2i
-                                        ]
-
 
-docNgrams2nodeNodeNgrams :: CorpusId -> DocNgrams -> NodeNodeNgrams
-docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) = NodeNodeNgrams Nothing cId d n nt w
+docNgrams2nodeNodeNgrams :: CorpusId
+                         -> DocNgrams
+                         -> NodeNodeNgrams
+docNgrams2nodeNodeNgrams cId (DocNgrams d n nt w) =
+  NodeNodeNgrams Nothing cId d n nt w
 
 data DocNgrams = DocNgrams { dn_doc_id :: DocId
                            , dn_ngrams_id :: Int
@@ -76,10 +69,14 @@ data DocNgrams = DocNgrams { dn_doc_id :: DocId
                            , dn_weight  :: Double
                            }
 
-insertDocNgramsOn :: CorpusId -> [DocNgrams] -> Cmd err Int
+insertDocNgramsOn :: CorpusId
+                  -> [DocNgrams]
+                  -> Cmd err Int
 insertDocNgramsOn cId dn = insertNodeNodeNgrams $ (map (docNgrams2nodeNodeNgrams cId) dn)
 
-insertDocNgrams :: CorpusId -> Map NgramsIndexed (Map NgramsType (Map NodeId Int)) -> Cmd err Int
+insertDocNgrams :: CorpusId
+                -> Map NgramsIndexed (Map NgramsType (Map NodeId Int))
+                -> Cmd err Int
 insertDocNgrams cId m = insertDocNgramsOn cId [ DocNgrams n (_ngramsId ng) (ngramsTypeId t) (fromIntegral i)
                                         | (ng, t2n2i) <- DM.toList m
                                         , (t,  n2i)   <- DM.toList t2n2i

src/Gargantext/Database/Ngrams.hs

@@ -18,6 +18,7 @@ module Gargantext.Database.Ngrams
     where
 
 import Data.Text (Text)
+import Control.Lens ((^.))
 import Gargantext.Core.Types
 import Gargantext.Database.Utils (runOpaQuery, Cmd)
 import Gargantext.Database.Schema.Ngrams
@@ -34,14 +35,14 @@ selectNgramsByDoc cIds dId nt = runOpaQuery (query cIds dId nt)
     join :: Query (NgramsRead, NodeNodeNgramsReadNull)
     join = leftJoin queryNgramsTable queryNodeNodeNgramsTable on1
       where
-        on1 (ng,nnng) = ngrams_id ng .== nnng_ngrams_id nnng
+        on1 (ng,nnng) = ng^.ngrams_id .== nnng^.nnng_ngrams_id
 
     query cIds' dId' nt' = proc () -> do
       (ng,nnng) <- join -< ()
-      restrict -< foldl (\b cId -> ((toNullable $ pgNodeId cId) .== nnng_node1_id nnng) .|| b) (pgBool True) cIds'
-      restrict -< (toNullable $ pgNodeId dId') .== nnng_node2_id nnng
-      restrict -< (toNullable $ pgNgramsType nt') .== nnng_ngramsType nnng
-      returnA -< ngrams_terms ng
+      restrict -< foldl (\b cId -> ((toNullable $ pgNodeId cId) .== nnng^.nnng_node1_id) .|| b) (pgBool True) cIds'
+      restrict -< (toNullable $ pgNodeId dId')    .== nnng^.nnng_node2_id
+      restrict -< (toNullable $ pgNgramsType nt') .== nnng^.nnng_ngramsType
+      returnA -< ng^.ngrams_terms
 
 
 postNgrams :: CorpusId -> DocId -> [Text] -> Cmd err Int

src/Gargantext/Database/Node/Children.hs

@@ -30,17 +30,27 @@ import Gargantext.Database.Schema.Node (pgNodeId)
 import Control.Arrow (returnA)
 
 -- | TODO: use getChildren with Proxy ?
-getContacts :: ParentId -> Maybe NodeType -> Cmd err [Node HyperdataContact]
+getContacts :: ParentId
+            -> Maybe NodeType
+            -> Cmd err [Node HyperdataContact]
 getContacts pId maybeNodeType = runOpaQuery $ selectChildren pId maybeNodeType
 
 
-getChildren :: JSONB a => ParentId -> proxy a -> Maybe NodeType -> Maybe Offset -> Maybe Limit -> Cmd err [Node a]
+getChildren :: JSONB a
+            => ParentId
+            -> proxy a
+            -> Maybe NodeType
+            -> Maybe Offset
+            -> Maybe Limit
+            -> Cmd err [Node a]
 getChildren pId _ maybeNodeType maybeOffset maybeLimit = runOpaQuery
                   $ limit' maybeLimit $ offset' maybeOffset
                   $ orderBy (asc _node_id)
                   $ selectChildren pId maybeNodeType
 
-selectChildren :: ParentId -> Maybe NodeType -> Query NodeRead
+selectChildren :: ParentId
+               -> Maybe NodeType
+               -> Query NodeRead
 selectChildren parentId maybeNodeType = proc () -> do
     row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
     (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()

src/Gargantext/Database/Node/Document/Insert.hs

@@ -186,7 +186,7 @@ queryInsert = [sql|
 data ReturnId = ReturnId { reInserted :: Bool -- if the document is inserted (True: is new, False: is not new)
                          , reId       :: NodeId  -- always return the id of the document (even new or not new)
                                          --   this is the uniq id in the database
-                         , reUniqId   :: Text -- Hash Id with concatenation of hash parameters
+                         , reUniqId   :: Text -- Hash Id with concatenation of sha parameters
                          } deriving (Show, Generic)
 
 instance FromRow ReturnId where
@@ -204,14 +204,14 @@ instance AddUniqId HyperdataDocument
     addUniqId = addUniqIdsDoc
       where
         addUniqIdsDoc :: HyperdataDocument -> HyperdataDocument
-        addUniqIdsDoc doc = set hyperdataDocument_uniqIdBdd (Just hashBdd)
-                          $ set hyperdataDocument_uniqId    (Just hashUni) doc
+        addUniqIdsDoc doc = set hyperdataDocument_uniqIdBdd (Just shaBdd)
+                          $ set hyperdataDocument_uniqId    (Just shaUni) doc
           where
-            hashUni = hash $ DT.concat $ map ($ doc) hashParametersDoc
-            hashBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hyperdataDocument_bdd d))] <> hashParametersDoc)
+            shaUni = sha $ DT.concat $ map ($ doc) shaParametersDoc
+            shaBdd = sha $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hyperdataDocument_bdd d))] <> shaParametersDoc)
 
-        hashParametersDoc :: [(HyperdataDocument -> Text)]
-        hashParametersDoc = [ \d -> maybeText (_hyperdataDocument_title    d)
+        shaParametersDoc :: [(HyperdataDocument -> Text)]
+        shaParametersDoc = [ \d -> maybeText (_hyperdataDocument_title    d)
                             , \d -> maybeText (_hyperdataDocument_abstract d)
                             , \d -> maybeText (_hyperdataDocument_source   d)
                             , \d -> maybeText (_hyperdataDocument_publication_date   d)
@@ -226,18 +226,18 @@ instance AddUniqId HyperdataContact
     addUniqId = addUniqIdsContact
 
 addUniqIdsContact :: HyperdataContact -> HyperdataContact
-addUniqIdsContact hc = set (hc_uniqIdBdd) (Just hashBdd)
-                     $ set (hc_uniqId   ) (Just hashUni) hc
+addUniqIdsContact hc = set (hc_uniqIdBdd) (Just shaBdd)
+                     $ set (hc_uniqId   ) (Just shaUni) hc
   where
-    hashUni = uniqId $ DT.concat $ map ($ hc) hashParametersContact
-    hashBdd = uniqId $ DT.concat $ map ($ hc) ([\d -> maybeText (view hc_bdd d)] <> hashParametersContact)
+    shaUni = uniqId $ DT.concat $ map ($ hc) shaParametersContact
+    shaBdd = uniqId $ DT.concat $ map ($ hc) ([\d -> maybeText (view hc_bdd d)] <> shaParametersContact)
 
     uniqId :: Text -> Text
     uniqId = DT.pack . SHA.showDigest . SHA.sha256 . DC.pack . DT.unpack
 
-    -- | TODO add more hashparameters
-    hashParametersContact :: [(HyperdataContact -> Text)]
-    hashParametersContact = [ \d -> maybeText $ view (hc_who . _Just . cw_firstName) d
+    -- | TODO add more shaparameters
+    shaParametersContact :: [(HyperdataContact -> Text)]
+    shaParametersContact = [ \d -> maybeText $ view (hc_who . _Just . cw_firstName) d
                             , \d -> maybeText $ view (hc_who . _Just . cw_lastName ) d
                             , \d -> maybeText $ view (hc_where . _head . cw_touch . _Just . ct_mail) d
                             ]

src/Gargantext/Database/Schema/Ngrams.hs

@@ -51,9 +51,9 @@ type NgramsId    = Int
 type NgramsTerms = Text
 type Size        = Int
 
-data NgramsPoly id terms n = NgramsDb { ngrams_id    :: id
-                                      , ngrams_terms :: terms
-                                      , ngrams_n     :: n
+data NgramsPoly id terms n = NgramsDb { _ngrams_id    :: id
+                                      , _ngrams_terms :: terms
+                                      , _ngrams_n     :: n
                                       } deriving (Show)
 
 type NgramsWrite = NgramsPoly (Maybe (Column PGInt4))
@@ -71,12 +71,13 @@ type NgramsReadNull = NgramsPoly (Column (Nullable PGInt4))
 type NgramsDb = NgramsPoly Int Text Int
 
 $(makeAdaptorAndInstance "pNgramsDb"    ''NgramsPoly)
--- $(makeLensesWith abbreviatedFields   ''NgramsPoly)
+makeLenses ''NgramsPoly
+
 
 ngramsTable :: Table NgramsWrite NgramsRead
-ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { ngrams_id    = optional "id"
-                                                 , ngrams_terms = required "terms"
-                                                 , ngrams_n     = required "n"
+ngramsTable = Table "ngrams" (pNgramsDb NgramsDb { _ngrams_id    = optional "id"
+                                                 , _ngrams_terms = required "terms"
+                                                 , _ngrams_n     = required "n"
                                                  }
                               )
 

src/Gargantext/Database/Schema/Node.hs

@@ -699,6 +699,7 @@ mkNode nt p u = insertNodesR [nodeDefault nt p u]
 mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
 mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
 
+
 mkDashboard :: ParentId -> UserId -> Cmd err [NodeId]
 mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
   where
@@ -709,7 +710,6 @@ mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
         dashboard = maybe arbitraryDashboard identity maybeDashboard
 
 
-
 mkPhylo :: ParentId -> UserId -> Cmd err [NodeId]
 mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u]
 
@@ -718,8 +718,5 @@ mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u]
 pgNodeId :: NodeId -> Column PGInt4
 pgNodeId = pgInt4 . id2int
 
-
 getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
-
-

src/Gargantext/Database/Schema/NodeNode.hs

@@ -25,11 +25,11 @@ commentary with @some markup@.
 
 module Gargantext.Database.Schema.NodeNode where
 
-import Control.Lens (view)
+import Control.Lens (view, (^.))
 import qualified Database.PostgreSQL.Simple as PGS (Query, Only(..))
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
 import Database.PostgreSQL.Simple.SqlQQ (sql)
-import Control.Lens.TH (makeLensesWith, abbreviatedFields)
+import Control.Lens.TH (makeLenses, makeLensesWith, abbreviatedFields)
 import Data.Maybe (Maybe, catMaybes)
 import Data.Text (Text, splitOn)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
@@ -44,10 +44,10 @@ import Control.Arrow (returnA)
 import qualified Opaleye as O
 
 data NodeNodePoly node1_id node2_id score cat
-                   = NodeNode { nn_node1_id   :: node1_id
-                              , nn_node2_id   :: node2_id
-                              , nn_score      :: score
-                              , nn_category   :: cat
+                   = NodeNode { _nn_node1_id   :: node1_id
+                              , _nn_node2_id   :: node2_id
+                              , _nn_score      :: score
+                              , _nn_category   :: cat
                               } deriving (Show)
 
 type NodeNodeWrite     = NodeNodePoly (Column (PGInt4))
@@ -68,14 +68,14 @@ type NodeNodeReadNull  = NodeNodePoly (Column (Nullable PGInt4))
 type NodeNode = NodeNodePoly Int Int (Maybe Double) (Maybe Int)
 
 $(makeAdaptorAndInstance "pNodeNode" ''NodeNodePoly)
-$(makeLensesWith abbreviatedFields   ''NodeNodePoly)
+makeLenses ''NodeNodePoly
 
 nodeNodeTable :: Table NodeNodeWrite NodeNodeRead
 nodeNodeTable  = Table "nodes_nodes" (pNodeNode
-                                NodeNode { nn_node1_id = required "node1_id"
-                                         , nn_node2_id = required "node2_id"
-                                         , nn_score    = optional "score"
-                                         , nn_category = optional "category"
+                                NodeNode { _nn_node1_id = required "node1_id"
+                                         , _nn_node2_id = required "node2_id"
+                                         , _nn_score    = optional "score"
+                                         , _nn_category = optional "category"
                                      }
                                      )
 
@@ -144,9 +144,9 @@ selectDocs cId = runOpaQuery (queryDocs cId)
 queryDocs :: CorpusId -> O.Query (Column PGJsonb)
 queryDocs cId = proc () -> do
   (n, nn) <- joinInCorpus -< ()
-  restrict -< ( nn_node1_id nn)  .== (toNullable $ pgNodeId cId)
-  restrict -< ( nn_category nn)  .>= (toNullable $ pgInt4 1)
-  restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
+  restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
+  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA -< view (node_hyperdata) n
 
 
@@ -156,9 +156,9 @@ selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 queryDocNodes :: CorpusId -> O.Query NodeRead
 queryDocNodes cId = proc () -> do
   (n, nn) <- joinInCorpus -< ()
-  restrict -< ( nn_node1_id nn)  .== (toNullable $ pgNodeId cId)
-  restrict -< ( nn_category nn)  .>= (toNullable $ pgInt4 1)
-  restrict -< (_node_typename n) .== (pgInt4 $ nodeTypeId NodeDocument)
+  restrict -< nn^.nn_node1_id  .== (toNullable $ pgNodeId cId)
+  restrict -< nn^.nn_category  .>= (toNullable $ pgInt4 1)
+  restrict -< n^.node_typename .== (pgInt4 $ nodeTypeId NodeDocument)
   returnA -<  n
 
 
@@ -166,7 +166,7 @@ joinInCorpus :: O.Query (NodeRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeTable queryNodeNodeTable cond
   where
     cond :: (NodeRead, NodeNodeRead) -> Column PGBool
-    cond (n, nn) = nn_node2_id nn .== (view node_id n)
+    cond (n, nn) = nn^.nn_node2_id .== (view node_id n)
 
 
 ------------------------------------------------------------------------

src/Gargantext/Database/Schema/NodeNodeNgrams.hs

@@ -25,7 +25,7 @@ module Gargantext.Database.Schema.NodeNodeNgrams
 import Prelude
 import Data.Maybe (Maybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
---import Control.Lens.TH (makeLensesWith, abbreviatedFields)
+import Control.Lens.TH (makeLenses)
 import Gargantext.Database.Utils (Cmd, mkCmd)
 import Gargantext.Database.Schema.Ngrams (NgramsTypeId, pgNgramsTypeId, NgramsId)
 import Gargantext.Database.Schema.Node (pgNodeId)
@@ -35,12 +35,12 @@ import Opaleye
 
 
 data NodeNodeNgramsPoly id' n1 n2 ngrams_id ngt w
-   = NodeNodeNgrams { nnng_id         :: id'
-                    , nnng_node1_id   :: n1
-                    , nnng_node2_id   :: n2
-                    , nnng_ngrams_id  :: ngrams_id
-                    , nnng_ngramsType :: ngt
-                    , nnng_weight     :: w
+   = NodeNodeNgrams { _nnng_id         :: id'
+                    , _nnng_node1_id   :: n1
+                    , _nnng_node2_id   :: n2
+                    , _nnng_ngrams_id  :: ngrams_id
+                    , _nnng_ngramsType :: ngt
+                    , _nnng_weight     :: w
                     } deriving (Show)
 
 
@@ -71,19 +71,19 @@ type NodeNodeNgramsReadNull =
 type NodeNodeNgrams =
   NodeNodeNgramsPoly (Maybe Int) CorpusId DocId NgramsId NgramsTypeId Double
 
---{-
 $(makeAdaptorAndInstance "pNodeNodeNgrams" ''NodeNodeNgramsPoly)
--- $(makeLensesWith          abbreviatedFields ''NodeNodeNgramsPoly)
+makeLenses ''NodeNodeNgramsPoly
+
 
 nodeNodeNgramsTable :: Table NodeNodeNgramsWrite NodeNodeNgramsRead
 nodeNodeNgramsTable  = Table "node_node_ngrams"
                           ( pNodeNodeNgrams NodeNodeNgrams
-                               { nnng_id         = optional "id"
-                               , nnng_node1_id   = required "node1_id"
-                               , nnng_node2_id   = required "node2_id"
-                               , nnng_ngrams_id  = required "ngrams_id"
-                               , nnng_ngramsType = required "ngrams_type"
-                               , nnng_weight     = required "weight"
+                               { _nnng_id         = optional "id"
+                               , _nnng_node1_id   = required "node1_id"
+                               , _nnng_node2_id   = required "node2_id"
+                               , _nnng_ngrams_id  = required "ngrams_id"
+                               , _nnng_ngramsType = required "ngrams_type"
+                               , _nnng_weight     = required "weight"
                                }
                           )
 

src/Gargantext/Database/TextSearch.hs

@@ -18,6 +18,7 @@ module Gargantext.Database.TextSearch where
 import Data.Aeson
 import Data.Map.Strict hiding (map, drop, take)
 import Data.Maybe
+import Control.Lens ((^.))
 import Data.List (intersperse, take, drop)
 import Data.String (IsString(..))
 import Data.Text (Text, words, unpack, intercalate)
@@ -43,12 +44,14 @@ import Opaleye hiding (Query, Order)
 
 
 ------------------------------------------------------------------------
-searchInDatabase :: ParentId -> Text -> Cmd err [(NodeId, HyperdataDocument)]
+searchInDatabase :: ParentId
+                 -> Text
+                 -> Cmd err [(NodeId, HyperdataDocument)]
 searchInDatabase p t = runOpaQuery (queryInDatabase p t)
-
--- | Global search query where ParentId is Master Node Corpus Id 
-queryInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
-queryInDatabase _ q = proc () -> do
+  where
+    -- | Global search query where ParentId is Master Node Corpus Id 
+    queryInDatabase :: ParentId -> Text -> O.Query (Column PGInt4, Column PGJsonb)
+    queryInDatabase _ q = proc () -> do
         row <- queryNodeSearchTable -< ()
         restrict -< (_ns_search row)    @@ (pgTSQuery (unpack q))
         restrict -< (_ns_typename row) .== (pgInt4 $ nodeTypeId NodeDocument)
@@ -56,83 +59,163 @@ queryInDatabase _ q = proc () -> do
 
 ------------------------------------------------------------------------
 -- | todo add limit and offset and order
-searchInCorpus :: CorpusId -> IsTrash -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetDoc]
+searchInCorpus :: CorpusId
+               -> IsTrash
+               -> [Text]
+               -> Maybe Offset
+               -> 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
 
-queryInCorpus :: CorpusId -> IsTrash -> Text -> O.Query FacetDocRead
+queryInCorpus :: CorpusId
+              -> IsTrash
+              -> Text
+              -> O.Query FacetDocRead
 queryInCorpus cId t q = proc () -> do
   (n, nn) <- joinInCorpus -< ()
-  restrict -< ( nn_node1_id nn) .== (toNullable $ pgNodeId cId)
+  restrict -< ( nn^.nn_node1_id) .== (toNullable $ pgNodeId cId)
   restrict -< if t
-                 then ( nn_category nn) .== (toNullable $ pgInt4     0)
-                 else ( nn_category nn) .>= (toNullable $ pgInt4     1)
-  restrict -< (_ns_search n)           @@ (pgTSQuery (unpack q))
-  restrict -< (_ns_typename n)        .== (pgInt4 $ nodeTypeId NodeDocument)
-  returnA  -< FacetDoc (_ns_id n) (_ns_date n) (_ns_name n) (_ns_hyperdata n) (nn_category nn) (nn_score nn)
+                 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)
+  returnA  -< FacetDoc (n^.ns_id       )
+                       (n^.ns_date     )
+                       (n^.ns_name     )
+                       (n^.ns_hyperdata)
+                       (nn^.nn_category)
+                       (nn^.nn_score   )
 
 joinInCorpus :: O.Query (NodeSearchRead, NodeNodeReadNull)
 joinInCorpus = leftJoin queryNodeSearchTable queryNodeNodeTable cond
   where
     cond :: (NodeSearchRead, NodeNodeRead) -> Column PGBool
-    cond (n, nn) = nn_node2_id nn .== _ns_id n
+    cond (n, nn) = nn^.nn_node2_id .== _ns_id n
 
 ------------------------------------------------------------------------
 type AuthorName = Text
 
 -- | TODO Optim: Offset and Limit in the Query
 -- TODO-SECURITY check
-searchInCorpusWithContacts :: CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]
-searchInCorpusWithContacts cId q o l order = take (maybe 5 identity l) <$> drop (maybe 0 identity o)
-  <$> map (\((i,u,h,s), ps) -> FacetPaired i u h s (catMaybes ps))
+searchInCorpusWithContacts
+  :: CorpusId
+  -> ListId
+  -> [Text]
+  -> Maybe Offset
+  -> Maybe Limit
+  -> Maybe OrderBy
+  -> Cmd err [FacetPaired Int UTCTime HyperdataDocument Int [Pair Int Text]]
+searchInCorpusWithContacts cId lId q o l order =
+      take (maybe 10 identity l)
+  <$> drop (maybe 0 identity o)
+  <$> map (\((i,u,h,s), ps) -> FacetPaired i u h s ps)
   <$> toList <$> fromListWith (<>)
-  <$> map (\(FacetPaired i u h s p) -> ((i,u,h,s), [maybePair p]))
-  <$> searchInCorpusWithContacts' cId q o l order
-  where
-    maybePair (Pair Nothing Nothing) = Nothing
-    maybePair (Pair _ Nothing) = Nothing
-    maybePair (Pair Nothing _) = Nothing
-    maybePair (Pair (Just p_id) (Just p_label)) = Just $ Pair p_id p_label
+  <$> map (\(FacetPaired i u h s (p1,p2)) -> ( (i,u,h,s)
+                                             , catMaybes [Pair <$> p1 <*> p2]
+                                             )
+          )
+  <$> searchInCorpusWithContacts' cId lId q o l order
 
 -- TODO-SECURITY check
-searchInCorpusWithContacts' :: CorpusId -> [Text] -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> Cmd err [(FacetPaired Int UTCTime HyperdataDocument Int (Pair (Maybe Int) (Maybe Text)))]
-searchInCorpusWithContacts' cId q o l order = runOpaQuery $ queryInCorpusWithContacts cId q' o l order
+searchInCorpusWithContacts'
+  :: CorpusId
+  -> ListId
+  -> [Text]
+  -> Maybe Offset
+  -> Maybe Limit
+  -> 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
 
 
-
-queryInCorpusWithContacts :: CorpusId -> Text -> Maybe Offset -> Maybe Limit -> Maybe OrderBy -> O.Query FacetPairedRead
-queryInCorpusWithContacts cId q _ _ _ = proc () -> do
-  (docs, (corpusDoc, (_docNgrams, (ngrams', (_, contacts))))) <- joinInCorpusWithContacts -< ()
-  restrict -< (_ns_search docs)              @@ (pgTSQuery  $ unpack q  )
-  restrict -< (_ns_typename docs)           .== (pgInt4 $ nodeTypeId NodeDocument)
-  restrict -< (nn_node1_id corpusDoc) .== (toNullable $ pgNodeId cId)
+queryInCorpusWithContacts
+  :: CorpusId
+  -> ListId
+  -> Text
+  -> Maybe Offset
+  -> Maybe Limit
+  -> Maybe OrderBy
+  -> 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 -< (_node_typename contacts)     .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
+  restrict -< (contacts^.node_typename)     .== (toNullable $ pgInt4 $ nodeTypeId NodeContact)
   -- let contact_id    = ifThenElse (isNull $ _node_id contacts) (toNullable $ pgInt4 0) (_node_id contacts)
-  returnA  -< FacetPaired (_ns_id docs) (_ns_date docs) (_ns_hyperdata docs) (pgInt4 0) (Pair (_node_id contacts) (ngrams_terms ngrams'))
-
-joinInCorpusWithContacts :: O.Query (NodeSearchRead, (NodeNodeReadNull, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))))
-joinInCorpusWithContacts = leftJoin6 queryNodeTable queryNodeNodeNgramsTable queryNgramsTable queryNodeNodeNgramsTable queryNodeNodeTable queryNodeSearchTable cond12 cond23 cond34 cond45 cond56
+  returnA  -< FacetPaired (docs^.ns_id) (docs^.ns_date) (docs^.ns_hyperdata) (pgInt4 0) (contacts^.node_id, ngrams'^.ngrams_terms)
+
+joinInCorpusWithContacts :: O.Query ( NodeSearchRead
+                                    , ( NodeNodeReadNull
+                                      , ( NodeNodeNgramsReadNull
+                                        , ( NgramsReadNull
+                                          , ( NodeNodeNgramsReadNull
+                                            , NodeReadNull
+                                            )
+                                          )
+                                        )
+                                      )
+                                    )
+joinInCorpusWithContacts =
+  leftJoin6
+  queryNodeTable
+  queryNodeNodeNgramsTable
+  queryNgramsTable
+  queryNodeNodeNgramsTable
+  queryNodeNodeTable
+  queryNodeSearchTable
+  cond12
+  cond23
+  cond34
+  cond45
+  cond56
     where
       cond12 :: (NodeNodeNgramsRead, NodeRead) -> Column PGBool
-         cond12 (ng3, n2) = _node_id n2 .== nnng_node1_id ng3
----------
-         cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
-         cond23 (ng2, (nnng2, _)) = nnng_ngrams_id nnng2 .== ngrams_id ng2
-         
-         cond34 :: (NodeNodeNgramsRead, (NgramsRead, (NodeNodeNgramsReadNull, NodeReadNull))) -> Column PGBool
-         cond34 (nng, (ng, (_,_))) = ngrams_id ng .== nnng_ngrams_id nng
-         
-         cond45 :: (NodeNodeRead, (NodeNodeNgramsRead, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull)))) -> Column PGBool
-         cond45 (nn, (nng, (_,(_,_)))) = nnng_node1_id nng .== nn_node2_id nn
-         
-         cond56 :: (NodeSearchRead, (NodeNodeRead, (NodeNodeNgramsReadNull, (NgramsReadNull, (NodeNodeNgramsReadNull, NodeReadNull))))) -> Column PGBool
-         cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nn_node2_id nn
-
+      cond12 (ng3, n2) = n2^.node_id .== ng3^.nnng_node1_id
 
+      cond23 :: (NgramsRead, (NodeNodeNgramsRead, NodeReadNull)) -> Column PGBool
+      cond23 (ng2, (nnng2, _)) = nnng2^.nnng_ngrams_id .== ng2^.ngrams_id
+
+      cond34 :: ( NodeNodeNgramsRead
+                , ( NgramsRead
+                  , ( NodeNodeNgramsReadNull
+                    , NodeReadNull
+                    )
+                  )
+                ) -> Column PGBool
+      cond34 (nng, (ng, (_,_))) = ng^.ngrams_id .== nng^.nnng_ngrams_id
+ 
+      cond45 :: ( NodeNodeRead
+                , ( NodeNodeNgramsRead
+                  , ( NgramsReadNull
+                    , ( NodeNodeNgramsReadNull
+                      , NodeReadNull
+                      )
+                    )
+                  )
+                ) -> Column PGBool
+      cond45 (nn, (nng, (_,(_,_)))) = nng^.nnng_node1_id .== nn^.nn_node2_id
+ 
+      cond56 :: ( NodeSearchRead
+                , ( NodeNodeRead
+                  , ( NodeNodeNgramsReadNull
+                    , ( NgramsReadNull
+                      , ( NodeNodeNgramsReadNull
+                        , NodeReadNull
+                        )
+                      )
+                    )
+                  )
+                ) -> Column PGBool
+      cond56 (n, (nn, (_,(_,(_,_))))) = _ns_id n .== nn^.nn_node2_id
  
 
 newtype TSQuery = UnsafeTSQuery [Text]

src/Gargantext/Database/Types/Node.hs

@@ -479,7 +479,7 @@ data NodePolySearch id        typename userId
               hyperdata search = NodeSearch { _ns_id        :: id
                                       , _ns_typename  :: typename
                                       , _ns_userId    :: userId
-                                                                --   , nodeUniqId    :: hashId
+                                                                --   , nodeUniqId    :: shaId
                                       , _ns_parentId  :: parentId
                                       , _ns_name      :: name
                                       , _ns_date      :: date

src/Gargantext/Prelude/Utils.hs

@@ -85,7 +85,7 @@ writeFile :: (MonadReader env m, MonadIO m, HasSettings env, SaveFile a)
          => a -> m FilePath
 writeFile a = do
   dataPath <- view (settings . fileFolder) <$> ask
-  (fp,fn)  <- liftIO $ (toPath 3) . hash . Text.pack . show <$> newStdGen
+  (fp,fn)  <- liftIO $ (toPath 3) . sha . Text.pack . show <$> newStdGen
   
   let foldPath = dataPath <> "/" <> fp
       filePath = foldPath <> "/" <> fn