[refactoring] more FlowCmdM typeclass refactoring

src/Gargantext/Core/Text/List.hs

@@ -18,14 +18,19 @@ module Gargantext.Core.Text.List
 
 import Control.Lens hiding (both) -- ((^.), view, over, set, (_1), (_2))
 import Data.HashMap.Strict (HashMap)
+import Data.HashMap.Strict qualified as HashMap
 import Data.HashSet (HashSet)
+import Data.HashSet qualified as HashSet
+import Data.List qualified as List
 import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
 import Data.Monoid (mempty)
 import Data.Ord (Down(..))
 import Data.Set (Set)
--- import Data.Text (Text)
+import Data.Set qualified as Set
 import Data.Tuple.Extra (both)
 import Gargantext.API.Ngrams.Types (NgramsElement, NgramsTerm(..))
+import Gargantext.Core.NLP (HasNLPServer)
 import Gargantext.Core.NodeStory
 import Gargantext.Core.Text (size)
 import Gargantext.Core.Text.List.Group
@@ -36,10 +41,11 @@ import Gargantext.Core.Text.List.Social.Prelude
 import Gargantext.Core.Text.Metrics (scored', Scored(..), scored_speExc, scored_genInc, normalizeGlobal, normalizeLocal, scored_terms)
 import Gargantext.Core.Types (ListType(..), MasterCorpusId, UserCorpusId)
 import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Data.HashMap.Strict.Utils qualified as HashMap
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsUser, getContextsByNgramsOnlyUser)
 import Gargantext.Database.Action.Metrics.TFICF (getTficf_withSample)
 import Gargantext.Database.Admin.Types.Node (NodeId)
-import Gargantext.Database.Prelude (CmdM)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Ngrams (text2ngrams)
 import Gargantext.Database.Query.Table.NgramsPostag (selectLems)
 import Gargantext.Database.Query.Table.Node (defaultList)
@@ -47,12 +53,6 @@ import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Database.Query.Tree.Error (HasTreeError)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..), Ngrams(..))
 import Gargantext.Prelude
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.HashSet as HashSet
-import qualified Data.List    as List
-import qualified Data.Map.Strict as Map
-import qualified Data.Set     as Set
-import qualified Gargantext.Data.HashMap.Strict.Utils as HashMap
 
 {-
 -- TODO maybe useful for later
@@ -65,7 +65,7 @@ isStopTerm (StopSize n) x = Text.length x < n || any isStopChar (Text.unpack x)
 
 -- | TODO improve grouping functions of Authors, Sources, Institutes..
 buildNgramsLists :: ( HasNodeStory env err m
-                    , CmdM     env err m
+                    , HasNLPServer env
                     , HasTreeError err
                     , HasNodeError err
                     )
@@ -90,7 +90,7 @@ data MapListSize = MapListSize { unMapListSize :: !Int }
 data MaxListSize = MaxListSize { unMaxListSize :: !Int }
 
 buildNgramsOthersList :: ( HasNodeError err
-                         , CmdM     env err m
+                         , HasNLPServer env
                          , HasNodeStory env err m
                          , HasTreeError err
                          )
@@ -134,11 +134,9 @@ buildNgramsOthersList user uCid mfslw _groupParams (nt, MapListSize mapListSize,
 
 
 getGroupParams :: ( HasNodeError err
-                  , CmdM     env err m
-                  , HasNodeStory env err m
                   , HasTreeError err
                   )
-               => GroupParams -> HashSet Ngrams -> m GroupParams
+               => GroupParams -> HashSet Ngrams -> DBCmd err GroupParams
 getGroupParams gp@(GroupWithPosTag l nsc _m) ng = do
   !hashMap <- HashMap.fromList <$> selectLems l nsc (HashSet.toList ng)
   -- printDebug "hashMap" hashMap
@@ -148,7 +146,7 @@ getGroupParams gp _ = pure gp
 
 -- TODO use ListIds
 buildNgramsTermsList :: ( HasNodeError err
-                        , CmdM     env err m
+                        , HasNLPServer env
                         , HasNodeStory env err m
                         , HasTreeError err
                         )

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

@@ -23,7 +23,7 @@ import Data.Pool
 import Data.Swagger
 import GHC.Generics
 import Gargantext.API.Ngrams.Types (NgramsTerm, NgramsPatch)
-import Gargantext.Core.NodeStory (HasNodeStory, getNodesArchiveHistory)
+import Gargantext.Core.NodeStory (getNodesArchiveHistory)
 import Gargantext.Core.Text.List.Social.Find (findListsId)
 import Gargantext.Core.Text.List.Social.Patch (addScorePatches)
 import Gargantext.Core.Text.List.Social.Prelude (FlowCont, FlowListScores)
@@ -116,84 +116,72 @@ keepAllParents _           = KeepAllParents True
 -}
 
 ------------------------------------------------------------------------
-flowSocialList :: ( HasNodeStory env err m
-                   , CmdM     env err m
-                   , HasNodeError err
-                   , HasTreeError err
-                   )
-                  => Maybe FlowSocialListWith
-                  -> User
-                  -> NgramsType
-                  -> FlowCont NgramsTerm FlowListScores
-                  -> m (FlowCont NgramsTerm FlowListScores)
+flowSocialList :: ( HasNodeError err
+                  , HasTreeError err
+                  )
+               => Maybe FlowSocialListWith
+               -> User
+               -> NgramsType
+               -> FlowCont NgramsTerm FlowListScores
+               -> DBCmd err (FlowCont NgramsTerm FlowListScores)
 flowSocialList Nothing u = flowSocialList' MySelfFirst u
 flowSocialList (Just (FlowSocialListWithPriority p))  u = flowSocialList' p u
 flowSocialList (Just (FlowSocialListWithLists    ls)) _ = getHistoryScores ls
 flowSocialList (Just (NoList _))                     _u = panic "[G.C.T.L.Social] Should not be executed"
 
-flowSocialList' :: ( HasNodeStory env err m
-                   , CmdM     env err m
-                   , HasNodeError err
+flowSocialList' :: ( HasNodeError err
                    , HasTreeError err
                    )
                   => FlowSocialListPriority
                   -> User -> NgramsType
                   -> FlowCont NgramsTerm FlowListScores
-                  -> m (FlowCont NgramsTerm FlowListScores)
+                  -> DBCmd err (FlowCont NgramsTerm FlowListScores)
 flowSocialList' flowPriority user nt flc =
   mconcat <$> mapM (flowSocialListByMode'   user nt flc)
                    (flowSocialListPriority flowPriority)
     where
 
-      flowSocialListByMode' :: ( HasNodeStory env err m
-                               , CmdM     env err m
-                               , HasNodeError err
+      flowSocialListByMode' :: ( HasNodeError err
                                , HasTreeError err
                                )
                             => User -> NgramsType
                             -> FlowCont NgramsTerm FlowListScores
                             -> NodeMode
-                            -> m (FlowCont NgramsTerm FlowListScores)
+                            -> DBCmd err (FlowCont NgramsTerm FlowListScores)
       flowSocialListByMode' user' nt' flc' mode =
             findListsId user' mode
         >>= flowSocialListByModeWith nt' flc'
 
 
-      flowSocialListByModeWith :: ( HasNodeStory env err m
-                                  , CmdM     env err m
-                                  , HasNodeError err
+      flowSocialListByModeWith :: ( HasNodeError err
                                   , HasTreeError err
                                   )
                                => NgramsType
                                -> FlowCont NgramsTerm FlowListScores
                                -> [ListId]
-                               -> m (FlowCont NgramsTerm FlowListScores)
+                               -> DBCmd err (FlowCont NgramsTerm FlowListScores)
       flowSocialListByModeWith nt'' flc'' listes =
         getHistoryScores listes nt'' flc''
 
 
 -----------------------------------------------------------------
-getHistoryScores :: ( HasNodeStory env err m
-                    , CmdM         env err m
-                    , HasNodeError     err
+getHistoryScores :: ( HasNodeError     err
                     , HasTreeError     err
                     )
                  => [ListId]
                  -> NgramsType
                  -> FlowCont NgramsTerm FlowListScores
-                 -> m (FlowCont NgramsTerm FlowListScores)
+                 -> DBCmd err (FlowCont NgramsTerm FlowListScores)
 getHistoryScores lists nt fl =
   addScorePatches nt lists fl <$> getHistory [nt] lists
 
 
-getHistory :: ( HasNodeStory env err m
-              , CmdM     env err m
-              , HasNodeError err
+getHistory :: ( HasNodeError err
               , HasTreeError err
               )
          => [NgramsType]
          -> [ListId]
-         -> m (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch]))
+         -> DBCmd err (Map ListId (Map NgramsType [HashMap NgramsTerm NgramsPatch]))
 getHistory types listsId = do
   pool <- view connPool
   nsp  <- liftBase $ withResource pool $ \c -> getNodesArchiveHistory c listsId

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

@@ -25,7 +25,7 @@ import Gargantext.Prelude
 
 ------------------------------------------------------------------------
 findListsId :: (HasNodeError err, HasTreeError err)
-            => User -> NodeMode -> Cmd err [NodeId]
+            => User -> NodeMode -> DBCmd err [NodeId]
 findListsId u mode = do
   rootId <- getRootId u
   ns <- map (view dt_nodeId) <$> filter ((== nodeTypeId NodeList) . (view dt_typeId))
@@ -40,7 +40,7 @@ findListsId u mode = do
 findNodes' :: (HasTreeError err, HasNodeError err)
           => RootId
           -> NodeMode
-          -> Cmd err [DbTreeNode]
+          -> DBCmd err [DbTreeNode]
 findNodes' r Private = do
   pv <- (findNodes r Private $ [NodeFolderPrivate]          <> commonNodes)
   sh <- (findNodes' r Shared)
@@ -52,3 +52,5 @@ findNodes' r PublicDirect = findNodes r Public  $ [NodeFolderPublic ]          <
 
 commonNodes:: [NodeType]
 commonNodes = [NodeFolder, NodeCorpus, NodeList, NodeFolderShared, NodeTeam]
+
+

src/Gargantext/Core/Viz/Graph/API.hs

@@ -108,7 +108,7 @@ getGraph _uId nId = do
         let defaultEdgesStrength   = Strong
         let defaultBridgenessMethod = BridgenessMethod_Basic
         graph' <- computeGraph cId defaultPartitionMethod defaultBridgenessMethod (withMetric defaultMetric) defaultEdgesStrength (NgramsTerms, NgramsTerms) repo
-        mt     <- defaultGraphMetadata cId "Title" repo defaultMetric defaultEdgesStrength
+        mt     <- defaultGraphMetadata cId listId "Title" repo defaultMetric defaultEdgesStrength
         let
           graph'' = set graph_metadata (Just mt) graph'
           hg = HyperdataGraphAPI graph'' camera
@@ -167,7 +167,7 @@ recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStreng
 
   case graph of
     Nothing     -> do
-      mt     <- defaultGraphMetadata cId "Title" repo (fromMaybe Order1 maybeSimilarity) strength
+      mt     <- defaultGraphMetadata cId listId "Title" repo (fromMaybe Order1 maybeSimilarity) strength
       g <- computeG $ Just mt
       pure $ trace "[G.V.G.API.recomputeGraph] Graph empty, computed" g
     Just graph' -> if (listVersion == Just v) && (not force)
@@ -225,14 +225,13 @@ computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2)
 
 defaultGraphMetadata :: HasNodeError err
                      => CorpusId
+                     -> ListId
                      -> Text
                      -> NodeListStory
                      -> GraphMetric
                      -> Strength
                      -> DBCmd err GraphMetadata
-defaultGraphMetadata cId t repo gm str = do
-  lId  <- defaultList cId
-
+defaultGraphMetadata cId lId t repo gm str = do
   pure $ GraphMetadata { _gm_title         = t
                        , _gm_metric        = gm
                        , _gm_edgesStrength = Just str

src/Gargantext/Core/Viz/Phylo/Legacy/LegacyMain.hs

@@ -16,42 +16,34 @@ Portability : POSIX
 module Gargantext.Core.Viz.Phylo.Legacy.LegacyMain
   where
 
--- import Data.GraphViz
--- import qualified Data.ByteString as DB
 import Control.Lens hiding (Level)
-import qualified Data.List as List
+import Data.HashMap.Strict qualified as HashMap
+import Data.List qualified as List
 import Data.Maybe
 import Data.Proxy
+import Data.Set qualified as Set
 import Data.Text (Text)
+import Data.Text qualified as Text
 import Debug.Trace (trace)
 import GHC.IO (FilePath)
 import Gargantext.API.Ngrams.Tools (getTermsWith)
 import Gargantext.API.Ngrams.Types
-import Gargantext.Database.Admin.Types.Node
+import Gargantext.Core (HasDBid, withDefaultLanguage)
+import Gargantext.Core.NodeStory (HasNodeStory)
 import Gargantext.Core.Text.Context (TermList)
 import Gargantext.Core.Text.Terms.WithList
-import Gargantext.Database.Query.Table.Node(defaultList, getNodeWith)
-import Gargantext.Prelude
-import Gargantext.Database.Action.Flow.Types
+import Gargantext.Core.Types
 import Gargantext.Core.Viz.LegacyPhylo hiding (Svg, Dot)
 import Gargantext.Database.Admin.Types.Hyperdata
+import Gargantext.Database.Query.Table.Node(defaultList, getNodeWith)
+import Gargantext.Database.Query.Table.NodeContext (selectDocs)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Database.Schema.Node
-import Gargantext.Database.Query.Table.NodeContext (selectDocs)
-import Gargantext.Core.Types
-import Gargantext.Core (HasDBid, withDefaultLanguage)
-
--- import Gargantext.Core.Viz.Phylo.LevelMaker (toPhylo)
--- import Gargantext.Core.Viz.Phylo.Tools
--- import Gargantext.Core.Viz.Phylo.View.Export
--- import Gargantext.Core.Viz.Phylo.View.ViewMaker    -- TODO Just Maker is fine
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.Set            as Set
-import qualified Data.Text           as Text
+import Gargantext.Prelude
 
 type MinSizeBranch = Int
 
-flowPhylo :: (FlowCmdM env err m, HasDBid NodeType)
+flowPhylo :: (HasNodeStory env err m, HasDBid NodeType)
           => CorpusId
           -> m Phylo
 flowPhylo cId = do

src/Gargantext/Database/Action/Flow.hs

@@ -77,7 +77,7 @@ import Gargantext.Core (Lang(..), PosTagAlgo(..), NLPServerConfig)
 import Gargantext.Core (withDefaultLanguage)
 import Gargantext.Core.Ext.IMTUser (readFile_Annuaire)
 import Gargantext.Core.Flow.Types
-import Gargantext.Core.NLP (nlpServerGet)
+import Gargantext.Core.NLP (HasNLPServer, nlpServerGet)
 import Gargantext.Core.NodeStory (HasNodeStory)
 import Gargantext.Core.Text
 import Gargantext.Core.Text.Corpus.API qualified as API
@@ -88,7 +88,7 @@ import Gargantext.Core.Text.List.Social (FlowSocialListWith(..))
 import Gargantext.Core.Text.Terms
 import Gargantext.Core.Text.Terms.Mono.Stem.En (stemIt)
 import Gargantext.Core.Text.Terms.WithList (MatchedText, buildPatternsWith, termsInText)
-import Gargantext.Core.Types (POS(NP), TermsCount)
+import Gargantext.Core.Types (HasInvalidError, POS(NP), TermsCount)
 import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main
 import Gargantext.Core.Types.Query (Limit)
@@ -127,7 +127,7 @@ import PUBMED.Types qualified as PUBMED
 ------------------------------------------------------------------------
 -- Imports for upgrade function
 import Gargantext.Database.Query.Tree.Root (getRootId)
-import Gargantext.Database.Query.Tree (findNodesId)
+import Gargantext.Database.Query.Tree (findNodesId, HasTreeError)
 
 ------------------------------------------------------------------------
 -- TODO use internal with API name (could be old data)
@@ -157,13 +157,13 @@ printDataText (DataNew (maybeInt, conduitData)) = do
   putText $ show (maybeInt, res)
 
 -- TODO use the split parameter in config file
-getDataText :: FlowCmdM env err m
+getDataText :: (HasNodeError err)
             => DataOrigin
             -> TermType Lang
             -> API.RawQuery
             -> Maybe PUBMED.APIKey
             -> Maybe API.Limit
-            -> m (Either API.GetCorpusError DataText)
+            -> DBCmd err (Either API.GetCorpusError DataText)
 getDataText (ExternalOrigin api) la q mPubmedAPIKey li = do
   eRes <- liftBase $ API.get api (_tt_lang la) q mPubmedAPIKey li
   pure $ DataNew <$> eRes
@@ -175,12 +175,12 @@ getDataText (InternalOrigin _) _la q _ _li = do
   ids <-  map fst <$> searchDocInDatabase cId (stemIt $ API.getRawQuery q)
   pure $ Right $ DataOld ids
 
-getDataText_Debug :: FlowCmdM env err m
-            => DataOrigin
-            -> TermType Lang
-            -> API.RawQuery
-            -> Maybe API.Limit
-            -> m ()
+getDataText_Debug :: (HasNodeError err)
+                  => DataOrigin
+                  -> TermType Lang
+                  -> API.RawQuery
+                  -> Maybe API.Limit
+                  -> DBCmd err ()
 getDataText_Debug a l q li = do
   result <- getDataText a l q Nothing li
   case result of
@@ -190,7 +190,12 @@ getDataText_Debug a l q li = do
 
 -------------------------------------------------------------------------------
 flowDataText :: forall env err m.
-                ( FlowCmdM env err m
+                ( DbCmd' env err m
+                , HasNodeStory env err m
+                , MonadLogger m
+                , HasNLPServer env
+                , HasTreeError err
+                , HasInvalidError err
                 , MonadJobStatus m
                 )
                 => User
@@ -214,7 +219,13 @@ flowDataText u (DataNew (mLen, txtC)) tt cid mfslw jobHandle = do
 
 ------------------------------------------------------------------------
 -- TODO use proxy
-flowAnnuaire :: (FlowCmdM env err m, MonadJobStatus m)
+flowAnnuaire :: ( DbCmd' env err m
+                , HasNodeStory env err m
+                , MonadLogger m
+                , HasNLPServer env
+                , HasTreeError err
+                , HasInvalidError err
+                , MonadJobStatus m )
              => User
              -> Either CorpusName [CorpusId]
              -> (TermType Lang)
@@ -227,7 +238,13 @@ flowAnnuaire u n l filePath jobHandle = do
   flow (Nothing :: Maybe HyperdataAnnuaire) u n l Nothing (fromIntegral $ length docs, yieldMany docs) jobHandle
 
 ------------------------------------------------------------------------
-flowCorpusFile :: (FlowCmdM env err m, MonadJobStatus m)
+flowCorpusFile :: ( DbCmd' env err m
+                  , HasNodeStory env err m
+                  , MonadLogger m
+                  , HasNLPServer env
+                  , HasTreeError err
+                  , HasInvalidError err
+                  , MonadJobStatus m )
            => User
            -> Either CorpusName [CorpusId]
            -> Limit -- Limit the number of docs (for dev purpose)
@@ -250,7 +267,14 @@ flowCorpusFile u n _l la ft ff fp mfslw jobHandle = do
 ------------------------------------------------------------------------
 -- | TODO improve the needed type to create/update a corpus
 -- (For now, Either is enough)
-flowCorpus :: (FlowCmdM env err m, FlowCorpus a, MonadJobStatus m)
+flowCorpus :: ( DbCmd' env err m
+              , HasNodeStory env err m
+              , MonadLogger m
+              , HasNLPServer env
+              , HasTreeError err
+              , HasInvalidError err
+              , FlowCorpus a
+              , MonadJobStatus m )
            => User
            -> Either CorpusName [CorpusId]
            -> TermType Lang
@@ -262,7 +286,12 @@ flowCorpus = flow (Nothing :: Maybe HyperdataCorpus)
 
 
 flow :: forall env err m a c.
-        ( FlowCmdM env err m
+        ( DbCmd' env err m
+        , HasNodeStory env err m
+        , MonadLogger m
+        , HasNLPServer env
+        , HasTreeError err
+        , HasInvalidError err
         , FlowCorpus a
         , MkCorpus c
         , MonadJobStatus m
@@ -338,7 +367,11 @@ createNodes user corpusName ctype = do
   pure (userId, userCorpusId, listId)
 
 
-flowCorpusUser :: ( FlowCmdM env err m
+flowCorpusUser :: ( HasNodeError err
+                  , HasInvalidError err
+                  , HasNLPServer env
+                  , HasTreeError err
+                  , HasNodeStory env err m
                   , MkCorpus c
                   )
                => Lang

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

@@ -17,27 +17,26 @@ Portability : POSIX
 module Gargantext.Database.Action.Flow.List
     where
 
+-- import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
 import Control.Concurrent
 import Control.Lens ((^.), (+~), (%~), at, (.~), _Just)
 import Control.Monad.Reader
+import Data.List qualified as List
 import Data.Map.Strict (Map, toList)
+import Data.Map.Strict qualified as Map
+import Data.Map.Strict.Patch qualified as PM
 import Data.Text (Text)
 import Gargantext.API.Ngrams (saveNodeStory)
 import Gargantext.API.Ngrams.Tools (getNodeStoryVar)
 import Gargantext.API.Ngrams.Types
+import Gargantext.Core.NodeStory
 import Gargantext.Core.Types (HasInvalidError(..), assertValid)
 import Gargantext.Core.Types.Main (ListType(CandidateTerm))
-import Gargantext.Core.NodeStory
-import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Admin.Types.Node
+import Gargantext.Database.Query.Table.Ngrams qualified as TableNgrams
 import Gargantext.Database.Query.Table.NodeNgrams (NodeNgramsPoly(..), NodeNgramsW, listInsertDb,{- getCgramsId -})
--- import Gargantext.Database.Query.Table.Node_NodeNgramsNodeNgrams
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.Prelude
-import qualified Data.List as List
-import qualified Data.Map.Strict as Map
-import qualified Data.Map.Strict.Patch as PM
-import qualified Gargantext.Database.Query.Table.Ngrams as TableNgrams
 
 -- FLOW LIST
 -- 1. select specific terms of the corpus when compared with others langs
@@ -82,10 +81,10 @@ flowList_Tficf' u m nt f = do
 
 
 ------------------------------------------------------------------------
-flowList_DbRepo :: FlowCmdM env err m
-         => ListId
-         -> Map NgramsType [NgramsElement]
-         -> m ListId
+flowList_DbRepo :: (HasInvalidError err, HasNodeStory env err m)
+                => ListId
+                -> Map NgramsType [NgramsElement]
+                -> m ListId
 flowList_DbRepo lId ngs = do
   -- printDebug "listId flowList" lId
   _mapCgramsId <- listInsertDb lId toNodeNgramsW (Map.toList ngs)
@@ -157,10 +156,10 @@ toNodeNgramsW' l'' ngs = [ NodeNgrams { _nng_id            = Nothing
                          ]
 
 
-listInsert :: FlowCmdM env err m
-             => ListId
-             -> Map NgramsType [NgramsElement]
-             -> m ()
+listInsert :: (HasInvalidError err, HasNodeStory env err m)
+           => ListId
+           -> Map NgramsType [NgramsElement]
+           -> m ()
 listInsert lId ngs = mapM_ (\(typeList, ngElmts)
                              -> putListNgrams lId typeList ngElmts) (toList ngs)
 

src/Gargantext/Database/Action/Metrics/TFICF.hs

@@ -23,7 +23,7 @@ import Gargantext.Core
 import Gargantext.Core.Text.Metrics.TFICF
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsUser, {-getOccByNgramsOnlyFast,-} getOccByNgramsOnlyFast_withSample)
 import Gargantext.Database.Admin.Types.Node -- (ListId, CorpusId, NodeId)
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.NodeContext (selectCountDocs)
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
 import Gargantext.API.Ngrams.Types
@@ -58,10 +58,10 @@ getTficf cId mId nt = do
 -}
 
 getTficf_withSample :: HasDBid NodeType
-         => UserCorpusId
-         -> MasterCorpusId
-         -> NgramsType
-         -> Cmd err (HashMap NgramsTerm Double)
+                    => UserCorpusId
+                    -> MasterCorpusId
+                    -> NgramsType
+                    -> DBCmd err (HashMap NgramsTerm Double)
 getTficf_withSample cId mId nt = do
   mapTextDoubleLocal <- HM.filter (> 1)
      <$> HM.map (fromIntegral . Set.size)

src/Gargantext/Database/Query/Table/NgramsPostag.hs

@@ -155,7 +155,7 @@ SELECT terms,id FROM ins_form_ret
 
 -- TODO add lang and postag algo
 -- TODO remove when form == lem in insert
-selectLems :: Lang -> NLPServerConfig -> [Ngrams] -> Cmd err [(Form, Lem)]
+selectLems :: Lang -> NLPServerConfig -> [Ngrams] -> DBCmd err [(Form, Lem)]
 selectLems l (NLPServerConfig { server }) ns = runPGSQuery querySelectLems (PGS.Only $ Values fields datas)
   where
     fields = map (\t -> QualifiedIdentifier Nothing t) ["int4","int4","text", "int4"]

src/Gargantext/Database/Query/Tree.hs

@@ -60,7 +60,7 @@ import Gargantext.Core.Types.Main (NodeTree(..), Tree(..))
 import Gargantext.Database.Admin.Config (fromNodeTypeId, nodeTypeId, fromNodeTypeId)
 import Gargantext.Database.Admin.Types.Hyperdata.Any (HyperdataAny)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd, runPGSQuery, DBCmd)
+import Gargantext.Database.Prelude (runPGSQuery, DBCmd)
 import Gargantext.Database.Query.Table.Node (getNodeWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.NodeNode (getNodeNode)
@@ -89,7 +89,7 @@ tree :: (HasTreeError err, HasNodeError err)
      => TreeMode
      -> RootId
      -> [NodeType]
-     -> Cmd err (Tree NodeTree)
+     -> DBCmd err (Tree NodeTree)
 tree TreeBasic    = tree_basic
 tree TreeAdvanced = tree_advanced
 tree TreeFirstLevel = tree_first_level
@@ -100,7 +100,7 @@ tree TreeFirstLevel = tree_first_level
 tree_basic :: (HasTreeError err, HasNodeError err)
            => RootId
            -> [NodeType]
-           -> Cmd err (Tree NodeTree)
+           -> DBCmd err (Tree NodeTree)
 tree_basic r nodeTypes =
   (dbTree r nodeTypes <&> toTreeParent) >>= toTree
   -- Same as (but easier to read) :
@@ -110,7 +110,7 @@ tree_basic r nodeTypes =
 tree_advanced :: (HasTreeError err, HasNodeError err)
               => RootId
               -> [NodeType]
-              -> Cmd err (Tree NodeTree)
+              -> DBCmd err (Tree NodeTree)
 tree_advanced r nodeTypes = do
   -- let rPrefix s = "[tree_advanced] root = " <> show r <> " " <> s
   mainRoot    <- findNodes r Private nodeTypes
@@ -128,7 +128,7 @@ tree_advanced r nodeTypes = do
 tree_first_level :: (HasTreeError err, HasNodeError err)
                  => RootId
                  -> [NodeType]
-                 -> Cmd err (Tree NodeTree)
+                 -> DBCmd err (Tree NodeTree)
 tree_first_level r nodeTypes = do
   -- let rPrefix s = mconcat [ "[tree_first_level] root = "
   --                         , show r
@@ -151,7 +151,7 @@ tree_flat :: (HasTreeError err, HasNodeError err)
           => RootId
           -> [NodeType]
           -> Maybe Text
-          -> Cmd err [NodeTree]
+          -> DBCmd err [NodeTree]
 tree_flat r nodeTypes q = do
   mainRoot <- findNodes r Private nodeTypes
   publicRoots <- findNodes r Public nodeTypes
@@ -169,7 +169,7 @@ findNodes :: (HasTreeError err, HasNodeError err)
           => RootId
           -> NodeMode
           -> [NodeType]
-          -> Cmd err [DbTreeNode]
+          -> DBCmd err [DbTreeNode]
 findNodes r Private nt       = dbTree r nt
 findNodes r Shared  nt       = findShared r NodeFolderShared nt sharedTreeUpdate
 findNodes r SharedDirect  nt = findSharedDirect r NodeFolderShared nt sharedTreeUpdate
@@ -181,7 +181,7 @@ findNodes r PublicDirect  nt = findSharedDirect r NodeFolderPublic nt publicTree
 --   Queries the `nodes_nodes` table.
 findShared :: HasTreeError err
            => RootId -> NodeType -> [NodeType] -> UpdateTree err
-           -> Cmd err [DbTreeNode]
+           -> DBCmd err [DbTreeNode]
 findShared r nt nts fun = do
   foldersSharedId <- findNodesId r [nt]
   trees           <- mapM (updateTree nts fun) foldersSharedId
@@ -192,7 +192,7 @@ findShared r nt nts fun = do
 -- and get the tree for its parent.
 findSharedDirect :: (HasTreeError err, HasNodeError err)
                  => RootId -> NodeType -> [NodeType] -> UpdateTree err
-                 -> Cmd err [DbTreeNode]
+                 -> DBCmd err [DbTreeNode]
 findSharedDirect r nt nts fun = do
   -- let rPrefix s = mconcat [ "[findSharedDirect] r = "
   --                         , show r
@@ -214,11 +214,11 @@ findSharedDirect r nt nts fun = do
       pure $ concat trees
 
 
-type UpdateTree err = ParentId -> [NodeType] -> NodeId -> Cmd err [DbTreeNode]
+type UpdateTree err = ParentId -> [NodeType] -> NodeId -> DBCmd err [DbTreeNode]
 
 updateTree :: HasTreeError err
            => [NodeType] -> UpdateTree err -> RootId
-           -> Cmd err [DbTreeNode]
+           -> DBCmd err [DbTreeNode]
 updateTree nts fun r = do
   folders       <- getNodeNode r
   nodesSharedId <- mapM (fun r nts)
@@ -245,12 +245,12 @@ publicTreeUpdate p nt n = dbTree n nt
 
 
 -- | findNodesId returns all nodes matching nodeType but the root (Nodeuser)
-findNodesId :: RootId -> [NodeType] -> Cmd err [NodeId]
+findNodesId :: RootId -> [NodeType] -> DBCmd err [NodeId]
 findNodesId r nt = tail
                 <$> map _dt_nodeId
                 <$> dbTree r nt
 
-findNodesWithType :: RootId -> [NodeType] -> [NodeType] -> Cmd err [DbTreeNode]
+findNodesWithType :: RootId -> [NodeType] -> [NodeType] -> DBCmd err [DbTreeNode]
 findNodesWithType root target through =
   filter isInTarget <$> dbTree root through
     where
@@ -331,7 +331,7 @@ toSubtreeParent r ns = fromListWith (\a b -> nub $ a <> b) . map (\n -> (_dt_par
 -- | Main DB Tree function
 dbTree :: RootId
        -> [NodeType]
-       -> Cmd err [DbTreeNode]
+       -> DBCmd err [DbTreeNode]
 dbTree rootId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
   <$> runPGSQuery [sql|
     WITH RECURSIVE
@@ -383,7 +383,7 @@ isDescendantOf childId rootId = (== [Only True])
   |] (childId, rootId)
 
 -- TODO should we check the category?
-isIn :: NodeId -> DocId -> Cmd err Bool
+isIn :: NodeId -> DocId -> DBCmd err Bool
 isIn cId docId = ( == [Only True])
   <$> runPGSQuery [sql| SELECT COUNT(*) = 1
     FROM nodes_nodes nn
@@ -393,8 +393,8 @@ isIn cId docId = ( == [Only True])
 
 -- Recursive parents function to construct a breadcrumb
 recursiveParents :: NodeId
-       -> [NodeType]
-       -> Cmd err [DbTreeNode]
+                 -> [NodeType]
+                 -> DBCmd err [DbTreeNode]
 recursiveParents nodeId nodeTypes = map (\(nId, tId, pId, n) -> DbTreeNode nId tId pId n)
   <$> runPGSQuery [sql|
     WITH RECURSIVE recursiveParents AS