[FIX] Monads dependencies, flowSocialList integration to flow (WIP)

src/Gargantext/API/Ngrams.hs

@@ -131,6 +131,7 @@ import Gargantext.Database.Admin.Types.Node (NodeType(..))
 import Gargantext.Database.Prelude (HasConnectionPool, HasConfig)
 import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 import Gargantext.Database.Query.Table.Node (getNode)
+import Gargantext.Database.Query.Tree.Error (HasTreeError)
 import Gargantext.Database.Schema.Node (node_id, node_parentId, node_userId)
 
 {-
@@ -318,12 +319,14 @@ tableNgramsPull listId ngramsType p_version = do
 -- Apply the given patch to the DB and returns the patch to be applied on the
 -- client.
 -- TODO-ACCESS check
-tableNgramsPut :: (HasNodeError err,
-                   HasInvalidError err,
-                   HasConfig env,
-                   HasConnectionPool env,
-                   HasSettings env,
-                   RepoCmdM env err m)
+tableNgramsPut :: ( HasNodeError err
+                  , HasTreeError err
+                  , HasInvalidError err
+                  , HasConfig env
+                  , HasConnectionPool env
+                  , HasSettings env
+                  , RepoCmdM env err m
+                  )
                  => TabType
                  -> ListId
                  -> Versioned NgramsTablePatch
@@ -668,9 +671,10 @@ getTableNgramsDoc dId tabType listId limit_ offset listType minSize maxSize orde
 
 
 
-apiNgramsTableCorpus :: ( RepoCmdM env err m
-                        , HasNodeError err
-                        , HasInvalidError err
+apiNgramsTableCorpus :: ( RepoCmdM          env err m
+                        , HasNodeError          err
+                        , HasTreeError          err
+                        , HasInvalidError       err
                         , HasConnectionPool env
                         , HasConfig         env
                         , HasSettings       env
@@ -681,9 +685,10 @@ apiNgramsTableCorpus cId =  getTableNgramsCorpus cId
                        :<|> scoresRecomputeTableNgrams cId
                        :<|> getTableNgramsVersion cId
 
-apiNgramsTableDoc :: ( RepoCmdM env err m
-                     , HasNodeError err
-                     , HasInvalidError err
+apiNgramsTableDoc :: ( RepoCmdM          env err m
+                     , HasNodeError          err
+                     , HasTreeError          err
+                     , HasInvalidError       err
                      , HasConnectionPool env
                      , HasConfig         env
                      , HasSettings       env

src/Gargantext/Core/Text/List.hs

@@ -14,6 +14,7 @@ Portability : POSIX
 module Gargantext.Core.Text.List
   where
 
+
 import Control.Lens (makeLenses)
 import Data.Maybe (fromMaybe, catMaybes)
 import Data.Ord (Down(..))
@@ -26,23 +27,25 @@ import qualified Data.Map  as Map
 import qualified Data.Set  as Set
 import qualified Data.Text as Text
 
-import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
 -- import Gargantext.API.Ngrams.Tools (getCoocByNgrams', Diagonal(..))
+import Gargantext.API.Ngrams.Types (NgramsElement, mkNgramsElement, NgramsTerm(..), RootParent(..), mSetFromList)
 import Gargantext.Core (Lang(..))
-import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
-import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Core.Text (size)
+import Gargantext.Core.Text.List.Learn (Model(..))
+import Gargantext.Core.Text.List.Social (flowSocialList)
 import Gargantext.Core.Text.Metrics (scored', Scored(..), normalizeGlobal, normalizeLocal)
+import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
+import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Database.Action.Metrics.NgramsByNode (ngramsGroup, getNodesByNgramsUser, groupNodesByNgramsWith, getNodesByNgramsOnlyUser)
 import Gargantext.Database.Action.Metrics.TFICF (getTficf)
+import Gargantext.API.Ngrams.Types (RepoCmdM)
+import Gargantext.Database.Admin.Types.Node (NodeId)
+import Gargantext.Database.Prelude (Cmd, CmdM)
 import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Query.Tree.Error (HasTreeError)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
-
 import Gargantext.Prelude
-import Gargantext.Core.Text (size)
-import Gargantext.Core.Text.List.Learn (Model(..))
--- import Gargantext.Core.Text.Metrics (takeScored)
 
 
 data NgramsListBuilder = BuilderStepO { stemSize :: !Int
@@ -63,26 +66,37 @@ data NgramsListBuilder = BuilderStepO { stemSize :: !Int
 data StopSize = StopSize {unStopSize :: !Int}
 
 -- | TODO improve grouping functions of Authors, Sources, Institutes..
-buildNgramsLists :: HasNodeError err
-                 => Lang
+buildNgramsLists :: ( RepoCmdM env err m
+                    , CmdM     env err m
+                    , HasTreeError err
+                    , HasNodeError err
+                    )
+                 => User
+                 -> Lang
                  -> Int
                  -> Int
                  -> StopSize
                  -> UserCorpusId
                  -> MasterCorpusId
-                 -> Cmd err (Map NgramsType [NgramsElement])
-buildNgramsLists l n m s uCid mCid = do
-  ngTerms     <- buildNgramsTermsList l n m s uCid mCid
-  othersTerms <- mapM (buildNgramsOthersList uCid identity)
+                 -> m (Map NgramsType [NgramsElement])
+buildNgramsLists user l n m s uCid mCid = do
+  ngTerms     <- buildNgramsTermsList user l n m s uCid mCid
+  othersTerms <- mapM (buildNgramsOthersList user uCid identity)
                       [Authors, Sources, Institutes]
   pure $ Map.unions $ othersTerms <> [ngTerms]
 
 
-buildNgramsOthersList :: UserCorpusId
+buildNgramsOthersList :: (--  RepoCmdM env err m
+                        -- , CmdM     env err m
+                         HasNodeError err
+                        -- , HasTreeError err
+                        )
+                        => User
+                      -> UserCorpusId
                       -> (Text -> Text)
                       -> NgramsType
                       -> Cmd err (Map NgramsType [NgramsElement])
-buildNgramsOthersList uCid groupIt nt = do
+buildNgramsOthersList user uCid groupIt nt = do
   ngs <- groupNodesByNgramsWith groupIt <$> getNodesByNgramsUser uCid nt
 
   let
@@ -105,15 +119,20 @@ buildNgramsOthersList uCid groupIt nt = do
                      )]
 
 -- TODO use ListIds
-buildNgramsTermsList :: HasNodeError err
-                     => Lang
-                     -> Int
-                     -> Int
-                     -> StopSize
-                     -> UserCorpusId
-                     -> MasterCorpusId
-                     -> Cmd err (Map NgramsType [NgramsElement])
-buildNgramsTermsList l n m s uCid mCid = do
+buildNgramsTermsList :: ( HasNodeError err
+                        , CmdM     env err m
+                        , RepoCmdM env err m
+                        , HasTreeError err
+                        )
+                        => User
+                        -> Lang
+                        -> Int
+                        -> Int
+                        -> StopSize
+                        -> UserCorpusId
+                        -> MasterCorpusId
+                        -> m (Map NgramsType [NgramsElement])
+buildNgramsTermsList user l n m s uCid mCid = do
 
 -- Computing global speGen score
   allTerms <- Map.toList <$> getTficf uCid mCid NgramsTerms
@@ -122,6 +141,8 @@ buildNgramsTermsList l n m s uCid mCid = do
   -- printDebug "tail candidates" (List.take 10 $ List.reverse $ allTerms)
 
   -- First remove stops terms
+  mapSocialList <- flowSocialList user NgramsTerms (Set.fromList $ map fst allTerms)
+
   let
     -- stopTerms ignored for now (need to be tagged already)
     (_stopTerms, candidateTerms) = List.partition ((isStopTerm s) . fst) allTerms

src/Gargantext/Core/Text/List/Social.hs

@@ -6,8 +6,6 @@ License     : AGPL + CECILL v3
 Maintainer  : team@gargantext.org
 Stability   : experimental
 Portability : POSIX
-
-
 -}
 
 module Gargantext.Core.Text.List.Social
@@ -28,7 +26,6 @@ import Data.Maybe (fromMaybe)
 import Data.Map (Map)
 import Data.Set (Set)
 import Data.Text (Text)
-import Gargantext.API.Ngrams
 import Gargantext.API.Ngrams.Tools -- (getListNgrams)
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types.Main
@@ -39,12 +36,12 @@ import qualified Data.Set as Set
 
 
 flowSocialList :: ( RepoCmdM env err m
-                        , CmdM     env err m
-                        , HasNodeError err
-                        , HasTreeError err
-                        )
-                     => User -> NgramsType -> Set Text
-                     -> m (Map ListType (Set Text))
+                  , CmdM     env err m
+                  , HasNodeError err
+                  , HasTreeError err
+                  )
+                  => User -> NgramsType -> Set Text
+                  -> m (Map ListType (Set Text))
 flowSocialList user nt ngrams' = do
   privateMapList <- flowSocialListByMode Private user nt ngrams'
   sharedMapList  <- flowSocialListByMode Shared  user nt (termsByList CandidateTerm privateMapList)

src/Gargantext/Database/Action/Flow.hs

@@ -79,19 +79,19 @@ import Gargantext.Database.Action.Search (searchDocInDatabase)
 import Gargantext.Database.Admin.Config (userMaster, corpusMasterName)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node -- (HyperdataDocument(..), NodeType(..), NodeId, UserId, ListId, CorpusId, RootId, MasterCorpusId, MasterUserId)
+import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Table.Ngrams
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Document.Insert -- (insertDocuments, ReturnId(..), addUniqIdsDoc, addUniqIdsContact, ToDbData(..))
-import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
-import Gargantext.Database.Query.Table.Ngrams
 import Gargantext.Database.Query.Table.NodeNgrams (listInsertDb , getCgramsId)
 import Gargantext.Database.Query.Table.NodeNodeNgrams2
-import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Tree.Root (getOrMkRoot, getOrMk_RootWithCorpus)
 import Gargantext.Database.Schema.Node (NodePoly(..))
 import Gargantext.Prelude
 import Gargantext.Prelude.Crypto.Hash (Hash)
-import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 import qualified Gargantext.Core.Text.Corpus.API as API
+import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 
 ------------------------------------------------------------------------
 -- TODO use internal with API name (could be old data)
@@ -132,12 +132,13 @@ getDataText (InternalOrigin _) _la q _li = do
   pure $ DataOld ids
 
 -------------------------------------------------------------------------------
-flowDataText :: FlowCmdM env err m
-             => User
-             -> DataText
-             -> TermType Lang
-             -> CorpusId
-             -> m CorpusId
+flowDataText :: ( FlowCmdM env err m
+                )
+                => User
+                -> DataText
+                -> TermType Lang
+                -> CorpusId
+                -> m CorpusId
 flowDataText u (DataOld ids) tt cid = flowCorpusUser (_tt_lang tt) u (Right [cid]) corpusType ids
   where
     corpusType = (Nothing :: Maybe HyperdataCorpus)
@@ -145,7 +146,7 @@ flowDataText u (DataNew txt) tt cid = flowCorpus u (Right [cid]) tt txt
 
 ------------------------------------------------------------------------
 -- TODO use proxy
-flowAnnuaire :: FlowCmdM env err m
+flowAnnuaire :: (FlowCmdM env err m)
              => User
              -> Either CorpusName [CorpusId]
              -> (TermType Lang)
@@ -156,7 +157,7 @@ flowAnnuaire u n l filePath = do
   flow (Nothing :: Maybe HyperdataAnnuaire) u n l docs
 
 ------------------------------------------------------------------------
-flowCorpusFile :: FlowCmdM env err m
+flowCorpusFile :: (FlowCmdM env err m)
            => User
            -> Either CorpusName [CorpusId]
            -> Limit -- Limit the number of docs (for dev purpose)
@@ -181,20 +182,25 @@ flowCorpus :: (FlowCmdM env err m, FlowCorpus a)
 flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
 
 
-flow :: (FlowCmdM env err m, FlowCorpus a, MkCorpus c)
-     => Maybe c
-     -> User
-     -> Either CorpusName [CorpusId]
-     -> TermType Lang
-     -> [[a]]
-     -> m CorpusId
+flow :: ( FlowCmdM env err m
+        , FlowCorpus a
+        , MkCorpus c
+        )
+        => Maybe c
+        -> User
+        -> Either CorpusName [CorpusId]
+        -> TermType Lang
+        -> [[a]]
+        -> m CorpusId
 flow c u cn la docs = do
   -- TODO if public insertMasterDocs else insertUserDocs
   ids <- traverse (insertMasterDocs c la) docs
   flowCorpusUser (la ^. tt_lang) u cn c (concat ids)
 
 ------------------------------------------------------------------------
-flowCorpusUser :: (FlowCmdM env err m, MkCorpus c)
+flowCorpusUser :: ( FlowCmdM env err m
+                  , MkCorpus c
+                  )
                => Lang
                -> User
                -> Either CorpusName [CorpusId]
@@ -214,7 +220,7 @@ flowCorpusUser l user corpusName ctype ids = do
 
   -- User List Flow
   (masterUserId, _masterRootId, masterCorpusId) <- getOrMk_RootWithCorpus (UserName userMaster) (Left "") ctype
-  ngs         <- buildNgramsLists l 2 3 (StopSize 3) userCorpusId masterCorpusId
+  ngs         <- buildNgramsLists user l 2 3 (StopSize 3) userCorpusId masterCorpusId
   _userListId <- flowList_DbRepo listId ngs
   _mastListId <- getOrMkList masterCorpusId masterUserId
   -- _ <- insertOccsUpdates userCorpusId mastListId

src/Gargantext/Database/Action/Flow/Types.hs

@@ -29,6 +29,7 @@ import Gargantext.Core.Text.Terms
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Prelude (CmdM)
 import Gargantext.Database.Query.Table.Node.Document.Insert
+import Gargantext.Database.Query.Tree.Error (HasTreeError)
 
 type FlowCmdM env err m =
   ( CmdM     env err m
@@ -36,6 +37,7 @@ type FlowCmdM env err m =
   , HasNodeError err
   , HasInvalidError err
   , HasRepoVar env
+  , HasTreeError err
   )
 
 type FlowCorpus a = ( AddUniqId      a

src/Gargantext/Database/Prelude.hs

@@ -81,11 +81,8 @@ type CmdM env err m =
   )
 
 type Cmd'' env err a = forall m.     CmdM'' env err m => m a
-type Cmd' env err a = forall m.     CmdM' env err m => m a
-type Cmd      err a = forall m env. CmdM  env err m => m a
-
-
-
+type Cmd'  env err a = forall m.     CmdM'  env err m => m a
+type Cmd       err a = forall m env. CmdM   env err m => m a