[DB][FACT] WIP

src/Gargantext/Core/Flow.hs

@@ -46,8 +46,6 @@ class HasText h
   where
     hasText :: h -> [Text]
 
-------------------------------------------------------------------------
-
 instance UniqId HyperdataDocument
   where
     uniqId = hyperdataDocument_uniqId
@@ -56,4 +54,3 @@ instance UniqId HyperdataContact
   where
     uniqId = hc_uniqId
 
-

src/Gargantext/Database/Flow.hs

@@ -41,15 +41,12 @@ import Prelude (String)
 import Data.Either
 import Debug.Trace (trace)
 import Control.Lens ((^.), view, _Just)
-import Control.Monad (mapM_)
 import Control.Monad.IO.Class (liftIO)
 import Data.List (concat)
-import Data.Map (Map, lookup, toList)
+import Data.Map (Map, lookup)
 import Data.Maybe (Maybe(..), catMaybes)
 import Data.Monoid
 import Data.Text (Text, splitOn, intercalate)
-import GHC.Show (Show)
-import Gargantext.API.Ngrams (HasRepoVar, NgramsElement(..), putListNgrams, RepoCmdM)
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types (NodePoly(..), Terms(..))
 import Gargantext.Core.Types.Individu (Username)
@@ -57,16 +54,17 @@ import Gargantext.Core.Flow
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Flow.Utils (insertDocNgrams)
+import Gargantext.Database.Flow.List
+import Gargantext.Database.Flow.Types
 import Gargantext.Database.Node.Contact -- (HyperdataContact(..), ContactWho(..))
 import Gargantext.Database.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
 import Gargantext.Database.Root (getRoot)
 import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
 import Gargantext.Database.Schema.Node -- (mkRoot, mkCorpus, getOrMkList, mkGraph, {-mkPhylo,-} mkDashboard, mkAnnuaire, getCorporaWithParentId, HasNodeError, NodeError(..), nodeError)
-import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb)
 import Gargantext.Database.Schema.User (getUser, UserLight(..))
 import Gargantext.Database.TextSearch (searchInDatabase)
 import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
-import Gargantext.Database.Utils (Cmd, CmdM)
+import Gargantext.Database.Utils (Cmd)
 import Gargantext.Ext.IMT (toSchoolName)
 import Gargantext.Ext.IMTUser (deserialiseImtUsersFromFile)
 import Gargantext.Prelude
@@ -84,13 +82,6 @@ import qualified Data.Text as Text
 import qualified Gargantext.Database.Node.Document.Add  as Doc  (add)
 import qualified Gargantext.Text.Corpus.Parsers.GrandDebat as GD
 
-type FlowCmdM env err m =
-  ( CmdM     env err m
-  , RepoCmdM env err m
-  , HasNodeError err
-  , HasRepoVar env
-  )
-
 ------------------------------------------------------------------------
 
 data ApiQuery = ApiIsidoreQuery Text | ApiIsidoreAuth Text
@@ -353,15 +344,6 @@ toInserted =
   Map.fromList . map    (\r ->  (reUniqId r, r)    )
                . filter (\r -> reInserted r == True)
 
-data DocumentWithId a = DocumentWithId
-  { documentId   :: !NodeId
-  , documentData :: !a
-  } deriving (Show)
-
-instance HasText a => HasText (DocumentWithId a)
-  where
-    hasText (DocumentWithId _ a) = hasText a
-
 mergeData :: Map HashId ReturnId
           -> Map HashId a
           -> [DocumentWithId a]
@@ -372,11 +354,6 @@ mergeData rs = catMaybes . map toDocumentWithId . Map.toList
                      <*> Just hpd
 
 ------------------------------------------------------------------------
-data DocumentIdWithNgrams a = DocumentIdWithNgrams
-  { documentWithId  :: !(DocumentWithId a)
-  , document_ngrams :: !(Map Ngrams (Map NgramsType Int))
-  } deriving (Show)
-
 
 instance HasText HyperdataContact
   where
@@ -454,51 +431,3 @@ documentIdWithNgrams f = mapM toDocumentIdWithNgrams
       e <- f $ documentData         d
       pure   $ DocumentIdWithNgrams d e
 
-
--- FLOW LIST
--- | TODO check optimization
-mapNodeIdNgrams :: [DocumentIdWithNgrams a]
-                -> Map Ngrams (Map NgramsType (Map NodeId Int))
-mapNodeIdNgrams = Map.unionsWith (Map.unionWith (Map.unionWith (+))) . fmap f
-  where
-    f :: DocumentIdWithNgrams a
-      -> Map Ngrams (Map NgramsType (Map NodeId Int))
-    f d = fmap (fmap (Map.singleton nId)) $ document_ngrams d
-      where
-        nId = documentId $ documentWithId d
-
-------------------------------------------------------------------------
-listInsert :: FlowCmdM env err m
-             => ListId
-             -> Map NgramsType [NgramsElement]
-             -> m ()
-listInsert lId ngs = mapM_ (\(typeList, ngElmts)
-                             -> putListNgrams lId typeList ngElmts
-                             ) $ toList ngs
-
-toNodeNgramsW :: ListId
-              -> [(NgramsType, [NgramsElement])]
-              -> [NodeNgramsW]
-toNodeNgramsW l ngs = List.concat $ map (toNodeNgramsW' l) ngs
-  where
-    toNodeNgramsW' :: ListId
-                  -> (NgramsType, [NgramsElement])
-                  -> [NodeNgramsW]
-    toNodeNgramsW' l' (ngrams_type, elms) =
-      [ NodeNgrams Nothing l' list_type ngrams_terms' ngrams_type Nothing Nothing Nothing 0 |
-       (NgramsElement ngrams_terms' _size list_type _occ _root _parent _children) <- elms
-      ]
-
-flowList :: FlowCmdM env err m
-         => ListId
-         -> Map NgramsType [NgramsElement]
-         -> m ListId
-flowList lId ngs = do
-  printDebug "listId flowList" lId
-  -- TODO save in database
-  r <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
-  printDebug "result " r
-  listInsert lId ngs
-  --trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs
-  pure lId
-

src/Gargantext/Database/Flow/List.hs

+{-|
+Module      : Gargantext.Database.Flow.List
+Description : List Flow
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# OPTIONS_GHC -fno-warn-orphans    #-}
+
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE RankNTypes              #-}
+{-# LANGUAGE ConstrainedClassMethods #-}
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE DeriveGeneric           #-}
+{-# LANGUAGE FlexibleContexts        #-}
+{-# LANGUAGE InstanceSigs            #-}
+{-# LANGUAGE NoImplicitPrelude       #-}
+{-# LANGUAGE OverloadedStrings       #-}
+
+module Gargantext.Database.Flow.List
+    where
+import Control.Monad (mapM_)
+import Data.Map (Map, toList)
+import Data.Maybe (Maybe(..))
+import Gargantext.API.Ngrams (NgramsElement(..), putListNgrams)
+import Gargantext.Database.Schema.Ngrams -- (insertNgrams, Ngrams(..), NgramsIndexed(..), indexNgrams,  NgramsType(..), text2ngrams, ngramsTypeId)
+import Gargantext.Database.Schema.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb)
+import Gargantext.Database.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
+import Gargantext.Database.Flow.Types
+import Gargantext.Prelude
+import qualified Data.List as List
+import qualified Data.Map  as Map
+
+
+-- FLOW LIST
+-- | TODO check optimization
+mapNodeIdNgrams :: [DocumentIdWithNgrams a]
+                -> Map Ngrams (Map NgramsType (Map NodeId Int))
+mapNodeIdNgrams = Map.unionsWith (Map.unionWith (Map.unionWith (+))) . fmap f
+  where
+    f :: DocumentIdWithNgrams a
+      -> Map Ngrams (Map NgramsType (Map NodeId Int))
+    f d = fmap (fmap (Map.singleton nId)) $ document_ngrams d
+      where
+        nId = documentId $ documentWithId d
+
+------------------------------------------------------------------------
+listInsert :: FlowCmdM env err m
+             => ListId
+             -> Map NgramsType [NgramsElement]
+             -> m ()
+listInsert lId ngs = mapM_ (\(typeList, ngElmts)
+                             -> putListNgrams lId typeList ngElmts
+                             ) $ toList ngs
+
+toNodeNgramsW :: ListId
+              -> [(NgramsType, [NgramsElement])]
+              -> [NodeNgramsW]
+toNodeNgramsW l ngs = List.concat $ map (toNodeNgramsW' l) ngs
+  where
+    toNodeNgramsW' :: ListId
+                  -> (NgramsType, [NgramsElement])
+                  -> [NodeNgramsW]
+    toNodeNgramsW' l' (ngrams_type, elms) =
+      [ NodeNgrams Nothing l' list_type ngrams_terms' ngrams_type Nothing Nothing Nothing 0 |
+       (NgramsElement ngrams_terms' _size list_type _occ _root _parent _children) <- elms
+      ]
+
+flowList :: FlowCmdM env err m
+         => ListId
+         -> Map NgramsType [NgramsElement]
+         -> m ListId
+flowList lId ngs = do
+  printDebug "listId flowList" lId
+  -- TODO save in database
+  r <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
+  printDebug "result " r
+  listInsert lId ngs
+  --trace (show $ List.filter (\n -> _ne_ngrams n == "versatile") $ List.concat $ Map.elems ngs) $ listInsert lId ngs
+  pure lId
+

src/Gargantext/Database/Flow/Types.hs

+{-|
+Module      : Gargantext.Database.Flow.Types
+Description : Types for Flow
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# OPTIONS_GHC -fno-warn-orphans    #-}
+
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE RankNTypes              #-}
+{-# LANGUAGE ConstrainedClassMethods #-}
+{-# LANGUAGE ConstraintKinds         #-}
+{-# LANGUAGE DeriveGeneric           #-}
+{-# LANGUAGE FlexibleContexts        #-}
+{-# LANGUAGE InstanceSigs            #-}
+{-# LANGUAGE NoImplicitPrelude       #-}
+{-# LANGUAGE OverloadedStrings       #-}
+
+module Gargantext.Database.Flow.Types
+    where
+
+import Data.Map (Map)
+import Gargantext.Prelude
+import Gargantext.Core.Flow
+import Gargantext.API.Ngrams (HasRepoVar, RepoCmdM)
+import Gargantext.Database.Schema.Ngrams (Ngrams(..), NgramsType(..))
+import Gargantext.Database.Types.Node (NodeId)
+import Gargantext.Database.Schema.Node (HasNodeError)
+import Gargantext.Database.Utils (CmdM)
+
+type FlowCmdM env err m =
+  ( CmdM     env err m
+  , RepoCmdM env err m
+  , HasNodeError err
+  , HasRepoVar env
+  )
+
+data DocumentIdWithNgrams a = DocumentIdWithNgrams
+  { documentWithId  :: !(DocumentWithId a)
+  , document_ngrams :: !(Map Ngrams (Map NgramsType Int))
+  } deriving (Show)
+
+data DocumentWithId a = DocumentWithId
+  { documentId   :: !NodeId
+  , documentData :: !a
+  } deriving (Show)
+
+instance HasText a => HasText (DocumentWithId a)
+  where
+    hasText (DocumentWithId _ a) = hasText a
+
+