[refactor] more typeclass refactorings

FlowCmdM -> DBCmd or HasNodeStory is usually enough

src/Gargantext/API/Metrics.hs

@@ -26,6 +26,7 @@ import Gargantext.API.HashedResponse
 import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Prelude (GargServer)
+import Gargantext.Core.NodeStory (HasNodeStory)
 import Gargantext.Core.Text.Metrics (Scored(..), {-normalizeGlobal,-} normalizeLocal)
 import Gargantext.Core.Types (CorpusId, ListId, ListType(..))
 import Gargantext.Core.Types.Query (Limit)
@@ -34,7 +35,6 @@ import Gargantext.Core.Viz.Types
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataList(..), hl_chart, hl_pie, hl_scatter, hl_tree)
 import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metric(..), Metrics(..))
 import Gargantext.Database.Admin.Types.Node (NodeId)
-import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
@@ -67,8 +67,8 @@ scatterApi id' = getScatter id'
             :<|> updateScatter id'
             :<|> getScatterHash id'
 
-getScatter :: FlowCmdM env err m =>
-  CorpusId
+getScatter :: HasNodeStory env err m
+           => CorpusId
            -> Maybe ListId
            -> TabType
            -> Maybe Limit
@@ -84,32 +84,35 @@ getScatter cId maybeListId tabType _maybeLimit = do
   chart <- case mChart of
     Just chart -> pure chart
     Nothing    -> do
-      updateScatter' cId maybeListId tabType Nothing
+      updateScatter' cId listId tabType Nothing
 
   pure $ constructHashedResponse chart
 
-updateScatter :: FlowCmdM env err m =>
-  CorpusId
+updateScatter :: HasNodeStory env err m
+              => CorpusId
               -> Maybe ListId
               -> TabType
               -> Maybe Limit
               -> m ()
 updateScatter cId maybeListId tabType maybeLimit = do
+  listId <- case maybeListId of
+    Just lid -> pure lid
+    Nothing  -> defaultList cId
   -- printDebug "[updateScatter] cId" cId
   -- printDebug "[updateScatter] maybeListId" maybeListId
   -- printDebug "[updateScatter] tabType" tabType
   -- printDebug "[updateScatter] maybeLimit" maybeLimit
-  _ <- updateScatter' cId maybeListId tabType maybeLimit
+  _ <- updateScatter' cId listId tabType maybeLimit
   pure ()
 
-updateScatter' :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
+updateScatter' :: HasNodeStory env err m
+               => CorpusId
+               -> ListId
                -> TabType
                -> Maybe Limit
                -> m Metrics
-updateScatter' cId maybeListId tabType maybeLimit = do
-  (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
+updateScatter' cId listId tabType maybeLimit = do
+  (ngs', scores) <- Metrics.getMetrics cId listId tabType maybeLimit
 
   let
     metrics      = fmap (\(Scored t s1 s2) -> Metric { m_label = unNgramsTerm t
@@ -120,9 +123,6 @@ updateScatter' cId maybeListId tabType maybeLimit = do
     listType t m = maybe (panic errorMsg) fst $ HashMap.lookup t m
     errorMsg     = "API.Node.metrics: key absent"
 
-  listId <- case maybeListId of
-    Just lid -> pure lid
-    Nothing  -> defaultList cId
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       scatterMap = hl ^. hl_scatter
@@ -130,8 +130,8 @@ updateScatter' cId maybeListId tabType maybeLimit = do
 
   pure $ Metrics metrics
 
-getScatterHash :: FlowCmdM env err m =>
-  CorpusId
+getScatterHash :: HasNodeStory env err m
+               => CorpusId
                -> Maybe ListId
                -> TabType
                -> m Text
@@ -163,8 +163,8 @@ chartApi id' = getChart id'
           :<|> getChartHash id'
 
 -- TODO add start / end
-getChart :: FlowCmdM env err m =>
-            CorpusId
+getChart :: HasNodeStory env err m
+         => CorpusId
          -> Maybe UTCTime
          -> Maybe UTCTime
          -> Maybe ListId
@@ -181,7 +181,7 @@ getChart cId _start _end maybeListId tabType = do
   chart <- case mChart of
     Just chart -> pure chart
     Nothing    -> do
-      updateChart' cId maybeListId tabType Nothing
+      updateChart' cId listId tabType Nothing
 
   pure $ constructHashedResponse chart
 
@@ -192,23 +192,23 @@ updateChart :: HasNodeError err =>
   -> Maybe Limit
   -> DBCmd err ()
 updateChart cId maybeListId tabType maybeLimit = do
+  listId <- case maybeListId of
+    Just lid -> pure lid
+    Nothing  -> defaultList cId
   printDebug "[updateChart] cId" cId
-  printDebug "[updateChart] maybeListId" maybeListId
+  printDebug "[updateChart] listId" listId
   printDebug "[updateChart] tabType" tabType
   printDebug "[updateChart] maybeLimit" maybeLimit
-  _ <- updateChart' cId maybeListId tabType maybeLimit
+  _ <- updateChart' cId listId tabType maybeLimit
   pure ()
 
 updateChart' :: HasNodeError err =>
   CorpusId
-  -> Maybe ListId
+  -> ListId
   -> TabType
   -> Maybe Limit
   -> DBCmd err (ChartMetrics Histo)
-updateChart' cId maybeListId tabType _maybeLimit = do
-  listId <- case maybeListId of
-    Just lid -> pure lid
-    Nothing  -> defaultList cId
+updateChart' cId listId tabType _maybeLimit = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       chartMap = hl ^. hl_chart
@@ -218,8 +218,8 @@ updateChart' cId maybeListId tabType _maybeLimit = do
   pure $ ChartMetrics h
 
 
-getChartHash :: FlowCmdM env err m =>
-  CorpusId
+getChartHash :: HasNodeStory env err m
+             => CorpusId
              -> Maybe ListId
              -> TabType
              -> m Text
@@ -249,7 +249,7 @@ pieApi id' = getPie id'
         :<|> updatePie id'
         :<|> getPieHash id'
 
-getPie :: FlowCmdM env err m
+getPie :: HasNodeStory env err m
        => CorpusId
        -> Maybe UTCTime
        -> Maybe UTCTime
@@ -271,8 +271,8 @@ getPie cId _start _end maybeListId tabType = do
 
   pure $ constructHashedResponse chart
 
-updatePie :: FlowCmdM env err m =>
-  CorpusId
+updatePie :: HasNodeStory env err m
+          => CorpusId
           -> Maybe ListId
           -> TabType
           -> Maybe Limit
@@ -285,8 +285,8 @@ updatePie cId maybeListId tabType maybeLimit = do
   _ <- updatePie' cId maybeListId tabType maybeLimit
   pure ()
 
-updatePie' :: FlowCmdM env err m =>
-     CorpusId
+updatePie' :: (HasNodeStory env err m, HasNodeError err)
+           => CorpusId
            -> Maybe ListId
            -> TabType
            -> Maybe Limit
@@ -304,8 +304,8 @@ updatePie' cId maybeListId tabType _maybeLimit = do
 
   pure $ ChartMetrics p
 
-getPieHash :: FlowCmdM env err m =>
-  CorpusId
+getPieHash :: HasNodeStory env err m
+           => CorpusId
            -> Maybe ListId
            -> TabType
            -> m Text
@@ -338,7 +338,7 @@ treeApi id' = getTree id'
          :<|> updateTree id'
          :<|> getTreeHash id'
 
-getTree :: FlowCmdM env err m
+getTree :: HasNodeStory env err m
         => CorpusId
         -> Maybe UTCTime
         -> Maybe UTCTime
@@ -362,8 +362,8 @@ getTree cId _start _end maybeListId tabType listType = do
 
   pure $ constructHashedResponse chart
 
-updateTree :: FlowCmdM env err m =>
-  CorpusId
+updateTree :: HasNodeStory env err m
+           => CorpusId
            -> Maybe ListId
            -> TabType
            -> ListType
@@ -376,8 +376,8 @@ updateTree cId maybeListId tabType listType = do
   _ <- updateTree' cId maybeListId tabType listType
   pure ()
 
-updateTree' :: FlowCmdM env err m =>
-  CorpusId
+updateTree' :: HasNodeStory env err m
+            => CorpusId
             -> Maybe ListId
             -> TabType
             -> ListType
@@ -395,8 +395,8 @@ updateTree' cId maybeListId tabType listType = do
 
   pure $ ChartMetrics t
 
-getTreeHash :: FlowCmdM env err m =>
-  CorpusId
+getTreeHash :: HasNodeStory env err m
+            => CorpusId
             -> Maybe ListId
             -> TabType
             -> ListType

src/Gargantext/API/Ngrams.hs

@@ -108,7 +108,6 @@ import Gargantext.Core.NodeStory
 import Gargantext.Core.Types (ListType(..), NodeId, ListId, DocId, TODO, assertValid, HasInvalidError, ContextId)
 import Gargantext.Core.Types.Query (Limit(..), Offset(..), MinSize(..), MaxSize(..))
 import Gargantext.API.Ngrams.Tools
-import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Metrics.NgramsByContext (getOccByNgramsOnlyFast)
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Node (NodeType(..))
@@ -418,8 +417,6 @@ tableNgramsPut tabType listId (Versioned p_version p_table)
 
 
 tableNgramsPostChartsAsync :: ( HasNodeStory env err m
-                              , FlowCmdM     env err m
-                              , HasNodeError err
                               , HasSettings env
                               , MonadJobStatus m
                               )
@@ -471,7 +468,7 @@ tableNgramsPostChartsAsync utn jobHandle = do
               -- printDebug "[tableNgramsPostChartsAsync] Terms, updating Metrics (Histo), cId" cId
               markStarted 6 jobHandle
 {-
-              _ <- Metrics.updateChart cId (Just listId) tabType Nothing
+              _ <- Metrics.updateChart cId listId tabType Nothing
               logRefSuccess
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
               logRefSuccess

src/Gargantext/API/Node/Update.hs

@@ -16,16 +16,17 @@ Portability : POSIX
 module Gargantext.API.Node.Update
       where
 
---import Gargantext.Core.Types.Individu (User(..))
 import Control.Lens (view)
 import Data.Aeson
 import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Set qualified as Set
 import Data.Swagger
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.EnvTypes (GargJob(..), Env)
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Admin.Types (HasSettings)
---import Gargantext.API.Ngrams.Types (TabType(..))
+import Gargantext.API.Metrics qualified as Metrics
+import Gargantext.API.Ngrams.Types qualified as NgramsTypes
 import Gargantext.API.Prelude (GargM, GargError, simuLogs)
 import Gargantext.Core.Methods.Similarities (GraphMetric(..))
 import Gargantext.Core.NodeStory (HasNodeStory)
@@ -35,10 +36,8 @@ import Gargantext.Core.Viz.Graph.Tools (PartitionMethod(..), BridgenessMethod(..
 import Gargantext.Core.Viz.Graph.Types (Strength)
 import Gargantext.Core.Viz.Phylo (PhyloSubConfigAPI(..), subConfigAPI2config)
 import Gargantext.Core.Viz.Phylo.API.Tools (flowPhyloAPI)
--- import Gargantext.Database.Action.Mail (sendMail)
 import Gargantext.Database.Action.Flow (reIndexWith)
 import Gargantext.Database.Action.Flow.Pairing (pairing)
-import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.Metrics (updateNgramsOccurrences, updateContextScore)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
@@ -47,15 +46,12 @@ import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
 import Gargantext.Database.Schema.Ngrams (NgramsType(NgramsTerms))
 import Gargantext.Database.Schema.Node (node_parent_id)
 import Gargantext.Prelude (Bool(..), Ord, Eq, (<$>), ($), {-printDebug,-} pure, show, cs, (<>), panic, (<*>))
+import Gargantext.Utils.Aeson qualified as GUA
 import Gargantext.Utils.Jobs (serveJobsAPI, MonadJobStatus(..))
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Servant
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
-import qualified Data.Set                    as Set
-import qualified Gargantext.API.Metrics      as Metrics
-import qualified Gargantext.API.Ngrams.Types as NgramsTypes
-import qualified Gargantext.Utils.Aeson      as GUA
 
 ------------------------------------------------------------------------
 type API = Summary " Update node according to NodeType params"
@@ -100,7 +96,7 @@ api uId nId =
   serveJobsAPI UpdateNodeJob $ \jHandle p ->
     updateNode uId nId p jHandle
 
-updateNode :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
+updateNode :: (HasNodeStory env err m, HasSettings env, MonadJobStatus m)
            => UserId
            -> NodeId
            -> UpdateNodeParams
@@ -150,7 +146,7 @@ updateNode _uId lId (UpdateNodeParamsList _mode) jobHandle = do
   _ <- case corpusId of
     Just cId -> do
       _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
-      _ <- updateNgramsOccurrences cId (Just lId)
+      _ <- updateNgramsOccurrences cId lId
       pure ()
     Nothing  -> pure ()
 
@@ -202,9 +198,9 @@ updateDocs :: (HasNodeStory env err m)
 updateDocs cId = do
   lId <- defaultList cId
   _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
-  _ <- updateNgramsOccurrences cId (Just lId)
+  _ <- updateNgramsOccurrences cId lId
   _ <- updateContextScore      cId lId
-  _ <- Metrics.updateChart     cId (Just lId) NgramsTypes.Docs Nothing
+  _ <- Metrics.updateChart'    cId lId NgramsTypes.Docs Nothing
   -- printDebug "updateContextsScore" (cId, lId, u)
   pure ()
 

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

@@ -34,11 +34,10 @@ import Gargantext.Core.Viz.Graph.GEXF ()
 import Gargantext.Core.Viz.Graph.Tools -- (cooc2graph)
 import Gargantext.Core.Viz.Graph.Types
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser)
-import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.Node (mkNodeWithParent)
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Database.Prelude (Cmd)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select
@@ -83,7 +82,7 @@ graphAPI u n = getGraph         u n
 
 ------------------------------------------------------------------------
 --getGraph :: UserId -> NodeId -> GargServer HyperdataGraphAPI
-getGraph :: FlowCmdM env err m
+getGraph :: HasNodeStory env err m
           => UserId
          -> NodeId
          -> m HyperdataGraphAPI
@@ -122,7 +121,7 @@ getGraph _uId nId = do
 
 
 --recomputeGraph :: UserId -> NodeId -> Maybe GraphMetric -> GargNoServer Graph
-recomputeGraph :: FlowCmdM env err m
+recomputeGraph :: HasNodeStory env err m
                => UserId
                -> NodeId
                -> PartitionMethod
@@ -179,7 +178,7 @@ recomputeGraph _uId nId partitionMethod bridgeMethod maybeSimilarity maybeStreng
 
 
 -- TODO remove repo
-computeGraph :: FlowCmdM env err m
+computeGraph :: HasNodeError err
              => CorpusId
              -> PartitionMethod
              -> BridgenessMethod
@@ -187,7 +186,7 @@ computeGraph :: FlowCmdM env err m
              -> Strength
              -> (NgramsType, NgramsType)
              -> NodeListStory
-             -> m Graph
+             -> DBCmd err Graph
 computeGraph corpusId partitionMethod bridgeMethod similarity strength (nt1,nt2) repo = do
   -- Getting the Node parameters
   lId  <- defaultList corpusId
@@ -230,7 +229,7 @@ defaultGraphMetadata :: HasNodeError err
                      -> NodeListStory
                      -> GraphMetric
                      -> Strength
-                     -> Cmd err GraphMetadata
+                     -> DBCmd err GraphMetadata
 defaultGraphMetadata cId t repo gm str = do
   lId  <- defaultList cId
 
@@ -265,7 +264,7 @@ graphAsync u n =
 --               -> (JobLog -> GargNoServer ())
 --               -> GargNoServer JobLog
 -- TODO get Graph Metadata to recompute
-graphRecompute :: (FlowCmdM env err m, MonadJobStatus m)
+graphRecompute ::  (HasNodeStory env err m, MonadJobStatus m)
                => UserId
                -> NodeId
                -> JobHandle m
@@ -319,7 +318,7 @@ graphVersions n nId = do
                            , gv_repo = v }
 
 --recomputeVersions :: UserId -> NodeId -> GargNoServer Graph
-recomputeVersions :: FlowCmdM env err m
+recomputeVersions :: HasNodeStory env err m
                   => UserId
                   -> NodeId
                   -> m Graph
@@ -351,7 +350,7 @@ graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
 --getGraphGexf :: UserId
 --             -> NodeId
 --             -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
-getGraphGexf :: FlowCmdM env err m
+getGraphGexf :: HasNodeStory env err m
               => UserId
              -> NodeId
              -> m (Headers '[Servant.Header "Content-Disposition" Text] Graph)

src/Gargantext/Core/Viz/Phylo/API/Tools.hs

@@ -16,35 +16,33 @@ module Gargantext.Core.Viz.Phylo.API.Tools
 
 import Control.Lens hiding (Context)
 import Data.Aeson (Value, decodeFileStrict, eitherDecode, encode)
+import Data.ByteString.Lazy qualified as Lazy
 import Data.Map.Strict (Map)
-import Data.Proxy
+import Data.Map.Strict qualified as Map
 import Data.Maybe (fromMaybe)
+import Data.Proxy
 import Data.Set (Set)
+import Data.Set qualified as Set
 import Data.Text (Text, pack)
 import Data.Time.Calendar (fromGregorian, diffGregorianDurationClip, cdMonths, diffDays, showGregorian)
 import Data.Time.Clock.POSIX(posixSecondsToUTCTime)
 import Gargantext.API.Ngrams.Prelude (getTermList)
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
-import Gargantext.API.Prelude (GargNoServer)
-import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, termsInText)
 import Gargantext.Core (withDefaultLanguage, Lang)
+import Gargantext.Core.NodeStory (HasNodeStory)
+import Gargantext.Core.Text.Terms.WithList (Patterns, buildPatterns, termsInText)
 import Gargantext.Core.Types (Context)
--- import Gargantext.Core.Types.Individu (User(..))
 import Gargantext.Core.Types.Main (ListType(MapTerm))
 import Gargantext.Core.Viz.Phylo (TimeUnit(..), Date, Document(..), PhyloConfig(..), Phylo)
 import Gargantext.Core.Viz.Phylo.PhyloExport (toPhyloExport, dotToFile)
 import Gargantext.Core.Viz.Phylo.PhyloMaker  (toPhylo, toPhyloWithoutLink)
 import Gargantext.Core.Viz.Phylo.PhyloTools  ({-printIOMsg, printIOComment,-} setConfig)
--- import Gargantext.Database.Action.Flow (getOrMk_RootWithCorpus)
--- import Gargantext.Database.Admin.Config (userMaster)
--- import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
--- import Gargantext.Database.Action.Flow (getOrMk_RootWithCorpus)
--- import Gargantext.Database.Admin.Config (userMaster)
--- import Gargantext.Database.Admin.Types.Hyperdata (HyperdataCorpus)
 import Gargantext.Database.Admin.Types.Hyperdata (HyperdataPhylo(..), HyperdataCorpus(..))
 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
 import Gargantext.Database.Admin.Types.Node (CorpusId, ContextId, PhyloId)
+import Gargantext.Database.Prelude (DBCmd)
 import Gargantext.Database.Query.Table.Node (defaultList, getNodeWith)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.NodeContext (selectDocNodes)
 import Gargantext.Database.Schema.Context
 import Gargantext.Database.Schema.Ngrams (NgramsType(..))
@@ -53,21 +51,19 @@ import Gargantext.Prelude
 import Prelude hiding (map)
 import System.FilePath ((</>))
 import System.IO.Temp (withTempDirectory)
-import System.Process      as Shell
-import qualified Data.ByteString.Lazy                    as Lazy
-import qualified Data.Map.Strict  as Map
-import qualified Data.Set  as Set
+import System.Process qualified as Shell
 
 --------------------------------------------------------------------
-getPhyloData :: PhyloId -> GargNoServer (Maybe Phylo)
+getPhyloData :: HasNodeError err
+             => PhyloId -> DBCmd err (Maybe Phylo)
 getPhyloData phyloId = do
   nodePhylo <- getNodeWith phyloId (Proxy :: Proxy HyperdataPhylo)
   pure $ _hp_data $ _node_hyperdata nodePhylo
 
-putPhylo :: PhyloId -> GargNoServer Phylo
+putPhylo :: PhyloId -> DBCmd err Phylo
 putPhylo = undefined
 
-savePhylo :: PhyloId -> GargNoServer ()
+savePhylo :: PhyloId -> DBCmd err ()
 savePhylo = undefined
 
 --------------------------------------------------------------------
@@ -93,7 +89,8 @@ phylo2dot2json phylo = do
       Just v  -> pure v
 
 
-flowPhyloAPI :: PhyloConfig -> CorpusId -> GargNoServer Phylo
+flowPhyloAPI :: (HasNodeStory env err m, HasNodeError err)
+             => PhyloConfig -> CorpusId -> m Phylo
 flowPhyloAPI config cId = do
   corpus <- corpusIdtoDocuments (timeUnit config) cId
   let phyloWithCliques = toPhyloWithoutLink corpus config
@@ -103,7 +100,8 @@ flowPhyloAPI config cId = do
   pure $ toPhylo $ setConfig config phyloWithCliques
 
 --------------------------------------------------------------------
-corpusIdtoDocuments :: TimeUnit -> CorpusId -> GargNoServer [Document]
+corpusIdtoDocuments :: (HasNodeStory env err m, HasNodeError err)
+                    => TimeUnit -> CorpusId -> m [Document]
 corpusIdtoDocuments timeUnit corpusId = do
   docs <- selectDocNodes corpusId
   lId  <- defaultList corpusId

src/Gargantext/Database/Action/Flow.hs

@@ -385,7 +385,7 @@ flowCorpusUser l user userCorpusId listId ctype mfslw = do
   -- _ <- mkAnnuaire  rootUserId userId
   _ <- reIndexWith userCorpusId listId NgramsTerms (Set.singleton MapTerm)
   _ <- updateContextScore      userCorpusId listId
-  _ <- updateNgramsOccurrences userCorpusId (Just listId)
+  _ <- updateNgramsOccurrences userCorpusId listId
   
   pure userCorpusId
 

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

@@ -25,8 +25,8 @@ import Data.Set (Set)
 import Data.Text (Text)
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
-import Gargantext.API.Prelude (GargNoServer)
 import Gargantext.Core
+import Gargantext.Core.NodeStory (HasNodeStory)
 import Gargantext.Core.Text.Metrics.CharByChar (levenshtein)
 import Gargantext.Core.Types (TableResult(..))
 import Gargantext.Core.Types.Main
@@ -38,6 +38,7 @@ import Gargantext.Database.Admin.Types.Node -- (AnnuaireId, CorpusId, ListId, Do
 import Gargantext.Database.Query.Prelude (returnA, queryNodeNodeTable)
 import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node.Children (getAllContacts)
+import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.Node.Select (selectNodesWithUsername)
 import Gargantext.Database.Query.Table.NodeContext_NodeContext (insertNodeContext_NodeContext)
 import Gargantext.Database.Query.Table.NodeNode (insertNodeNode)
@@ -68,7 +69,8 @@ isPairedWith nId nt = runOpaQuery (selectQuery nt nId)
       returnA  -<  node^.node_id
 
 -----------------------------------------------------------------------
-pairing :: AnnuaireId -> CorpusId -> Maybe ListId -> GargNoServer [Int]
+pairing :: (HasNodeStory env err m, HasNodeError err)
+        => AnnuaireId -> CorpusId -> Maybe ListId -> m [Int]
 pairing a c l' = do
   l <- case l' of
     Nothing -> defaultList c
@@ -78,9 +80,10 @@ pairing a c l' = do
   insertNodeContext_NodeContext $ prepareInsert c a dataPaired
 
 
-dataPairing :: AnnuaireId
+dataPairing :: HasNodeStory env err m
+             => AnnuaireId
              -> (CorpusId, ListId, NgramsType)
-             -> GargNoServer (HashMap ContactId (Set DocId))
+             -> m (HashMap ContactId (Set DocId))
 dataPairing aId (cId, lId, ngt) = do
   -- mc :: HM.HashMap ContactName (Set ContactId)
   mc <- getNgramsContactId aId
@@ -164,7 +167,7 @@ getClosest f (NgramsTerm from) candidates = fst <$> head scored
 
 ------------------------------------------------------------------------
 getNgramsContactId :: AnnuaireId
-                   -> Cmd err (HashMap ContactName (Set NodeId))
+                   -> DBCmd err (HashMap ContactName (Set NodeId))
 getNgramsContactId aId = do
   contacts <- getAllContacts aId
   -- printDebug "getAllContexts" (tr_count contacts)
@@ -181,10 +184,11 @@ toName contact = NgramsTerm $ (Text.toTitle firstName) <> " " <> (Text.toTitle l
     firstName = fromMaybe "" $ contact^.(node_hyperdata . hc_who . _Just . cw_firstName)
     lastName  = fromMaybe "" $ contact^.(node_hyperdata . hc_who . _Just . cw_lastName)
 
-getNgramsDocId :: CorpusId
+getNgramsDocId :: HasNodeStory env err m
+                => CorpusId
                 -> ListId
                 -> NgramsType
-                -> GargNoServer (HashMap DocAuthor (Set NodeId))
+                -> m (HashMap DocAuthor (Set NodeId))
 getNgramsDocId cId lId nt = do
   lIds <- selectNodesWithUsername NodeList userMaster
   repo <- getRepo (lId:lIds)

src/Gargantext/Database/Action/Metrics.hs

@@ -36,36 +36,29 @@ import Gargantext.Core.NodeStory hiding (runPGSQuery)
 import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
 import Gargantext.Core.Types (ListType(..), NodeType(..), ContextId)
 import Gargantext.Core.Types.Query (Limit(..))
-import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Action.Metrics.NgramsByContext (getContextsByNgramsOnlyUser{-, getTficfWith-})
 import Gargantext.Database.Admin.Config (userMaster)
 import Gargantext.Database.Admin.Types.Node (ListId, CorpusId)
 import Gargantext.Database.Prelude (runPGSQuery{-, formatPGSQuery-})
-import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Prelude
 
-getMetrics :: FlowCmdM env err m
-            => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
+getMetrics :: (HasNodeStory env err m)
+           => CorpusId -> ListId -> TabType -> Maybe Limit
            -> m (HashMap NgramsTerm (ListType, Maybe NgramsTerm), Vector (Scored NgramsTerm))
-getMetrics cId maybeListId tabType maybeLimit = do
-  (ngs, _, myCooc) <- getNgramsCooc cId maybeListId tabType maybeLimit
+getMetrics cId listId tabType maybeLimit = do
+  (ngs, _, myCooc) <- getNgramsCooc cId listId tabType maybeLimit
   -- TODO HashMap
   pure (ngs, scored myCooc)
 
 
-getNgramsCooc :: (FlowCmdM env err m)
-            => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
+getNgramsCooc :: (HasNodeStory env err m)
+              => CorpusId -> ListId -> TabType -> Maybe Limit
               -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
                    , HashMap NgramsTerm (Maybe RootTerm)
                    , HashMap (NgramsTerm, NgramsTerm) Int
                    )
-getNgramsCooc cId maybeListId tabType maybeLimit = do
-
-  lId <- case maybeListId of
-    Nothing   -> defaultList cId
-    Just lId' -> pure lId'
-
+getNgramsCooc cId lId tabType maybeLimit = do
   (ngs', ngs) <- getNgrams lId tabType
 
   lIds <- selectNodesWithUsername NodeList userMaster
@@ -81,21 +74,17 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 updateNgramsOccurrences :: (HasNodeStory env err m)
-                        => CorpusId -> Maybe ListId
+                        => CorpusId -> ListId
                         -> m ()
-updateNgramsOccurrences cId mlId = do
-  _ <- mapM (updateNgramsOccurrences' cId mlId Nothing) [Terms, Sources, Authors, Institutes]
+updateNgramsOccurrences cId lId = do
+  _ <- mapM (updateNgramsOccurrences' cId lId Nothing) [Terms, Sources, Authors, Institutes]
   pure ()
 
 
 updateNgramsOccurrences' :: (HasNodeStory env err m)
-                         => CorpusId -> Maybe ListId -> Maybe Limit -> TabType
+                         => CorpusId -> ListId -> Maybe Limit -> TabType
                          -> m [Int]
-updateNgramsOccurrences' cId maybeListId maybeLimit tabType = do
-
-  lId <- case maybeListId of
-    Nothing   -> defaultList cId
-    Just lId' -> pure lId'
+updateNgramsOccurrences' cId lId maybeLimit tabType = do
 
   result <- getNgramsOccurrences cId lId tabType maybeLimit
 

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

@@ -19,17 +19,17 @@ Portability : POSIX
 module Gargantext.Database.Action.Metrics.Lists
   where
 
-import Gargantext.API.Ngrams.Types (TabType(..))
-import Gargantext.Core.Text.Metrics (Scored(..))
-import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
-import Gargantext.Core.Types.Query (Limit)
-import Gargantext.Database.Action.Flow.Types (FlowCmdM)
-import Gargantext.Prelude hiding (sum, head)
-import Prelude hiding (null, id, map, sum)
-import qualified Data.HashMap.Strict as HashMap
-import qualified Data.Map.Strict as Map
-import qualified Data.Vector as Vec
-import qualified Gargantext.Database.Action.Metrics as Metrics
+-- import Gargantext.API.Ngrams.Types (TabType(..))
+-- import Gargantext.Core.Text.Metrics (Scored(..))
+-- import Gargantext.Core.Types -- (NodePoly(..), NodeCorpus, ListId)
+-- import Gargantext.Core.Types.Query (Limit)
+-- import Gargantext.Database.Action.Flow.Types (FlowCmdM)
+-- import Gargantext.Prelude hiding (sum, head)
+-- import Prelude hiding (null, id, map, sum)
+-- import qualified Data.HashMap.Strict as HashMap
+-- import qualified Data.Map.Strict as Map
+-- import qualified Data.Vector as Vec
+-- import qualified Gargantext.Database.Action.Metrics as Metrics
 {-
 trainModel :: FlowCmdM env ServantErr m
              => Username -> m Score
@@ -42,18 +42,18 @@ trainModel u = do
   --}
 
 
-getMetrics' :: FlowCmdM env err m
-             => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
-             -> m (Map.Map ListType [Vec.Vector Double])
-getMetrics' cId maybeListId tabType maybeLimit = do
-  (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
+-- getMetrics' :: FlowCmdM env err m
+--              => CorpusId -> Maybe ListId -> TabType -> Maybe Limit
+--              -> m (Map.Map ListType [Vec.Vector Double])
+-- getMetrics' cId maybeListId tabType maybeLimit = do
+--   (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
 
-  let
-    metrics      = map (\(Scored t s1 s2) -> (listType t ngs', [Vec.fromList [s1,s2]])) scores
-    listType t m = maybe (panic errorMsg) fst $ HashMap.lookup t m
-    errorMsg     = "API.Node.metrics: key absent"
+--   let
+--     metrics      = map (\(Scored t s1 s2) -> (listType t ngs', [Vec.fromList [s1,s2]])) scores
+--     listType t m = maybe (panic errorMsg) fst $ HashMap.lookup t m
+--     errorMsg     = "API.Node.metrics: key absent"
 
-  {-
-  _ <- Learn.grid 100 110 metrics' metrics'
-  --}
-  pure $ Map.fromListWith (<>) $ Vec.toList metrics
+--   {-
+--   _ <- Learn.grid 100 110 metrics' metrics'
+--   --}
+--   pure $ Map.fromListWith (<>) $ Vec.toList metrics

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

 {-|
-import Gargantext.Database.Prelude (Cmd, runPGSQuery)
 Module      : Gargantext.Database.Query.Table.Node
 Description : Main Tools of Node to the database
 Copyright   : (c) CNRS, 2017-Present
@@ -53,7 +52,7 @@ selectNode id' = proc () -> do
     restrict -< _node_id row .== id'
     returnA  -< row
 
-runGetNodes :: Select NodeRead -> Cmd err [Node HyperdataAny]
+runGetNodes :: Select NodeRead -> DBCmd err [Node HyperdataAny]
 runGetNodes = runOpaQuery
 
 ------------------------------------------------------------------------
@@ -84,7 +83,7 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
       returnA  -< row ) -< ()
     returnA -< node'
 
-deleteNode :: NodeId -> Cmd err Int
+deleteNode :: NodeId -> DBCmd err Int
 deleteNode n = mkCmd $ \conn ->
   fromIntegral <$> runDelete_ conn
                  (Delete nodeTable
@@ -92,7 +91,7 @@ deleteNode n = mkCmd $ \conn ->
                          rCount
                  )
 
-deleteNodes :: [NodeId] -> Cmd err Int
+deleteNodes :: [NodeId] -> DBCmd err Int
 deleteNodes ns = mkCmd $ \conn ->
   fromIntegral <$> runDelete_ conn
                    (Delete nodeTable
@@ -102,7 +101,7 @@ deleteNodes ns = mkCmd $ \conn ->
 
 -- TODO: NodeType should match with `a'
 getNodesWith :: (JSONB a, HasDBid NodeType) => NodeId -> proxy a -> Maybe NodeType
-             -> Maybe Offset -> Maybe Limit -> Cmd err [Node a]
+             -> Maybe Offset -> Maybe Limit -> DBCmd err [Node a]
 getNodesWith parentId _ nodeType maybeOffset maybeLimit =
     runOpaQuery $ selectNodesWith parentId nodeType maybeOffset maybeLimit
 
@@ -110,7 +109,7 @@ getNodesWith parentId _ nodeType maybeOffset maybeLimit =
 -- TODO: Why not use getNodesWith?
 getNodesWithParentId :: (Hyperdata a, JSONB a)
                      => Maybe NodeId
-                     -> Cmd err [Node a]
+                     -> DBCmd err [Node a]
 getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n'
   where
     n' = case n of
@@ -124,7 +123,7 @@ getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n'
 getClosestParentIdByType :: HasDBid NodeType
                          => NodeId
                          -> NodeType
-                         -> Cmd err (Maybe NodeId)
+                         -> DBCmd err (Maybe NodeId)
 getClosestParentIdByType nId nType = do
   result <- runPGSQuery query (PGS.Only nId)
   case result of
@@ -148,7 +147,7 @@ getClosestParentIdByType nId nType = do
 getClosestParentIdByType' :: HasDBid NodeType
                           => NodeId
                           -> NodeType
-                          -> Cmd err (Maybe NodeId)
+                          -> DBCmd err (Maybe NodeId)
 getClosestParentIdByType' nId nType = do
   result <- runPGSQuery query (PGS.Only nId)
   case result of
@@ -185,14 +184,14 @@ getChildrenByType nId nType = do
     |]
 
 ------------------------------------------------------------------------
-getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataDocumentV3]
+getDocumentsV3WithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataDocumentV3]
 getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
 
 -- TODO: merge with getDocumentsWithParentId by having a class IsHyperdataDocument
-getDocumentsWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataDocument]
+getDocumentsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataDocument]
 getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
 
-getListsModelWithParentId :: HasDBid NodeType => NodeId -> Cmd err [Node HyperdataModel]
+getListsModelWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataModel]
 getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeModel)
 
 getCorporaWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataCorpus]
@@ -209,7 +208,7 @@ selectNodesWithParentID n = proc () -> do
 ------------------------------------------------------------------------
 -- | Example of use:
 -- runCmdReplEasy  (getNodesWithType NodeList (Proxy :: Proxy HyperdataList))
-getNodesWithType :: (HasNodeError err, JSONB a, HasDBid NodeType) => NodeType -> proxy a -> Cmd err [Node a]
+getNodesWithType :: (HasNodeError err, JSONB a, HasDBid NodeType) => NodeType -> proxy a -> DBCmd err [Node a]
 getNodesWithType nt _ = runOpaQuery $ selectNodesWithType nt
   where
     selectNodesWithType ::  HasDBid NodeType
@@ -223,7 +222,7 @@ getNodeWithType :: (HasNodeError err, JSONB a, HasDBid NodeType)
                 => NodeId
                 -> NodeType
                 -> proxy a
-                -> Cmd err [Node a]
+                -> DBCmd err [Node a]
 getNodeWithType nId nt _ = runOpaQuery $ selectNodeWithType nId nt
   where
     selectNodeWithType ::  HasDBid NodeType
@@ -234,7 +233,7 @@ getNodeWithType nId nt _ = runOpaQuery $ selectNodeWithType nId nt
         restrict -< tn .== sqlInt4 (toDBid nt')
         returnA -< row
 
-getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> Cmd err [NodeId]
+getNodesIdWithType :: (HasNodeError err, HasDBid NodeType) => NodeType -> DBCmd err [NodeId]
 getNodesIdWithType nt = do
   ns <- runOpaQuery $ selectNodesIdWithType nt
   pure (map NodeId ns)
@@ -248,7 +247,7 @@ selectNodesIdWithType nt = proc () -> do
 
 ------------------------------------------------------------------------
 
-nodeExists :: (HasNodeError err) => NodeId -> Cmd err Bool
+nodeExists :: (HasNodeError err) => NodeId -> DBCmd err Bool
 nodeExists nId = (== [PGS.Only True])
   <$> runPGSQuery [sql|SELECT true FROM nodes WHERE id = ? |] (PGS.Only nId)
 
@@ -317,7 +316,7 @@ insertNodes :: [NodeWrite] -> DBCmd err Int64
 insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
 
 {-
-insertNodes' :: [Node a] -> Cmd err Int64
+insertNodes' :: [Node a] -> DBCmd err Int64
 insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
                         $ Insert nodeTable ns' rCount Nothing
   where
@@ -359,11 +358,11 @@ data Node' = Node' { _n_type :: NodeType
                    , _n_children :: [Node']
                    } deriving (Show)
 
-mkNodes :: [NodeWrite] -> Cmd err Int64
+mkNodes :: [NodeWrite] -> DBCmd err Int64
 mkNodes ns = mkCmd $ \conn -> runInsert_ conn
                    $ Insert nodeTable ns rCount Nothing
 
-mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
+mkNodeR :: [NodeWrite] -> DBCmd err [NodeId]
 mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing
 
 ------------------------------------------------------------------------
@@ -410,7 +409,7 @@ defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> DBCmd err Lis
 defaultList cId =
   maybe (nodeError (NoListFound cId)) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
-defaultListMaybe :: (HasNodeError err, HasDBid NodeType) => CorpusId -> Cmd err (Maybe NodeId)
+defaultListMaybe :: (HasNodeError err, HasDBid NodeType) => CorpusId -> DBCmd err (Maybe NodeId)
 defaultListMaybe cId = headMay <$> map (view node_id ) <$> getListsWithParentId cId
 
 getListsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataList]

src/Gargantext/Database/Query/Table/Node/Children.hs

@@ -36,12 +36,12 @@ import Opaleye
 
 
 -- TODO getAllTableDocuments
-getAllDocuments :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataDocument))
+getAllDocuments :: HasDBid NodeType => ParentId -> DBCmd err (TableResult (Node HyperdataDocument))
 getAllDocuments pId = getAllChildren pId (Proxy :: Proxy HyperdataDocument)
                                          (Just NodeDocument)
 
 -- TODO getAllTableContacts
-getAllContacts :: HasDBid NodeType => ParentId -> Cmd err (TableResult (Node HyperdataContact))
+getAllContacts :: HasDBid NodeType => ParentId -> DBCmd err (TableResult (Node HyperdataContact))
 getAllContacts pId = getAllChildren pId (Proxy :: Proxy HyperdataContact)
                                         (Just NodeContact)
 
@@ -49,7 +49,7 @@ getAllChildren :: (JSONB a, HasDBid NodeType)
                => ParentId
                -> proxy a
                -> Maybe NodeType
-               -> Cmd err (NodeTableResult a)
+               -> DBCmd err (NodeTableResult a)
 getAllChildren pId p maybeNodeType = getChildren pId p maybeNodeType Nothing Nothing
 
 
@@ -59,7 +59,7 @@ getChildren :: (JSONB a, HasDBid NodeType)
             -> Maybe NodeType
             -> Maybe Offset
             -> Maybe Limit
-            -> Cmd err (NodeTableResult a)
+            -> DBCmd err (NodeTableResult a)
 getChildren pId p t@(Just NodeDocument) maybeOffset maybeLimit = getChildrenContext pId p t maybeOffset maybeLimit
 getChildren pId p t@(Just NodeContact ) maybeOffset maybeLimit = getChildrenContext pId p t maybeOffset maybeLimit
 getChildren a b c d e = getChildrenNode a b c d e
@@ -71,7 +71,7 @@ getChildrenNode :: (JSONB a, HasDBid NodeType)
             -> Maybe NodeType
             -> Maybe Offset
             -> Maybe Limit
-            -> Cmd err (NodeTableResult a)
+            -> DBCmd err (NodeTableResult a)
 getChildrenNode pId _ maybeNodeType maybeOffset maybeLimit = do
   -- printDebug "getChildrenNode" (pId, maybeNodeType)
   let query = selectChildrenNode pId maybeNodeType
@@ -102,7 +102,7 @@ getChildrenContext :: (JSONB a, HasDBid NodeType)
                    -> Maybe NodeType
                    -> Maybe Offset
                    -> Maybe Limit
-            -> Cmd err (NodeTableResult a)
+                   -> DBCmd err (NodeTableResult a)
 getChildrenContext pId _ maybeNodeType maybeOffset maybeLimit = do
   -- printDebug "getChildrenContext" (pId, maybeNodeType)
   let query = selectChildren' pId maybeNodeType

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

@@ -32,7 +32,7 @@ queryNodeContext_NodeContextTable :: Select NodeContext_NodeContextRead
 queryNodeContext_NodeContextTable = selectTable nodeContext_NodeContextTable
 -}
 
-insertNodeContext_NodeContext :: [(CorpusId, DocId, AnnuaireId, ContactId)] -> Cmd err [Int]
+insertNodeContext_NodeContext :: [(CorpusId, DocId, AnnuaireId, ContactId)] -> DBCmd err [Int]
 insertNodeContext_NodeContext contexts = do
   let
     fields = map (\t -> QualifiedIdentifier Nothing t) $ snd fields_name