Merge remote-tracking branch 'origin/272-dev-fixes-for-node-score' into dev

gargantext.cabal

@@ -62,11 +62,13 @@ library
       Gargantext.API.Node.Corpus.Update
       Gargantext.API.Node.File
       Gargantext.API.Node.Share
+      Gargantext.API.Node.Update
       Gargantext.API.Prelude
       Gargantext.API.Routes
       Gargantext.Core
-      Gargantext.Core.NLP
+      Gargantext.Core.Mail.Types
       Gargantext.Core.Methods.Similarities
+      Gargantext.Core.NLP
       Gargantext.Core.NodeStory
       Gargantext.Core.Text
       Gargantext.Core.Text.Context
@@ -193,7 +195,6 @@ library
       Gargantext.API.Node.Get
       Gargantext.API.Node.New
       Gargantext.API.Node.Types
-      Gargantext.API.Node.Update
       Gargantext.API.Public
       Gargantext.API.Search
       Gargantext.API.Server
@@ -206,7 +207,6 @@ library
       Gargantext.Core.Flow.Ngrams
       Gargantext.Core.Flow.Types
       Gargantext.Core.Mail
-      Gargantext.Core.Mail.Types
       Gargantext.Core.Methods.Graph.BAC.Proxemy
       Gargantext.Core.Methods.Graph.MaxClique
       Gargantext.Core.Methods.Matrix.Accelerate.Utils
@@ -941,6 +941,7 @@ test-suite garg-test-tasty
     , crawlerArxiv
     , duckling ^>= 0.2.0.0
     , extra ^>= 1.7.9
+    , fast-logger ^>= 3.0.5
     , fmt
     , gargantext
     , gargantext-prelude
@@ -1044,6 +1045,7 @@ test-suite garg-test-hspec
     , crawlerArxiv
     , duckling ^>= 0.2.0.0
     , extra ^>= 1.7.9
+    , fast-logger ^>= 3.0.5
     , fmt
     , gargantext
     , gargantext-prelude

src/Gargantext/API/Admin/EnvTypes.hs

@@ -8,6 +8,7 @@ module Gargantext.API.Admin.EnvTypes (
     GargJob(..)
   , Env(..)
   , Mode(..)
+  , modeToLoggingLevels
   , mkJobHandle
   , env_logger
   , env_manager

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,12 +67,12 @@ scatterApi id' = getScatter id'
             :<|> updateScatter id'
             :<|> getScatterHash id'
 
-getScatter :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> Maybe Limit
-  -> m (HashedResponse Metrics)
+getScatter :: HasNodeStory env err m
+           => CorpusId
+           -> Maybe ListId
+           -> TabType
+           -> Maybe Limit
+           -> m (HashedResponse Metrics)
 getScatter cId maybeListId tabType _maybeLimit = do
   listId <- case maybeListId of
     Just lid -> pure lid
@@ -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
-  -> Maybe ListId
-  -> TabType
-  -> Maybe Limit
-  -> m ()
+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
-  -> TabType
-  -> Maybe Limit
-  -> m Metrics
-updateScatter' cId maybeListId tabType maybeLimit = do
-  (ngs', scores) <- Metrics.getMetrics cId maybeListId tabType maybeLimit
+updateScatter' :: HasNodeStory env err m
+               => CorpusId
+               -> ListId
+               -> TabType
+               -> Maybe Limit
+               -> m Metrics
+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,11 +130,11 @@ updateScatter' cId maybeListId tabType maybeLimit = do
 
   pure $ Metrics metrics
 
-getScatterHash :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> m Text
+getScatterHash :: HasNodeStory env err m
+               => CorpusId
+               -> Maybe ListId
+               -> TabType
+               -> m Text
 getScatterHash cId maybeListId tabType = do
   hash <$> getScatter cId maybeListId tabType Nothing
 
@@ -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
 
@@ -190,25 +190,25 @@ updateChart :: HasNodeError err =>
   -> Maybe ListId
   -> TabType
   -> Maybe Limit
-  -> Cmd err ()
+  -> 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
-  -> Cmd err (ChartMetrics Histo)
-updateChart' cId maybeListId tabType _maybeLimit = do
-  listId <- case maybeListId of
-    Just lid -> pure lid
-    Nothing  -> defaultList cId
+  -> DBCmd err (ChartMetrics Histo)
+updateChart' cId listId tabType _maybeLimit = do
   node <- getNodeWith listId (Proxy :: Proxy HyperdataList)
   let hl = node ^. node_hyperdata
       chartMap = hl ^. hl_chart
@@ -218,11 +218,11 @@ updateChart' cId maybeListId tabType _maybeLimit = do
   pure $ ChartMetrics h
 
 
-getChartHash :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> m Text
+getChartHash :: HasNodeStory env err m
+             => CorpusId
+             -> Maybe ListId
+             -> TabType
+             -> m Text
 getChartHash cId maybeListId tabType = do
   hash <$> getChart cId Nothing Nothing maybeListId tabType
 
@@ -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,12 +271,12 @@ getPie cId _start _end maybeListId tabType = do
 
   pure $ constructHashedResponse chart
 
-updatePie :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> Maybe Limit
-  -> m ()
+updatePie :: HasNodeStory env err m
+          => CorpusId
+          -> Maybe ListId
+          -> TabType
+          -> Maybe Limit
+          -> m ()
 updatePie cId maybeListId tabType maybeLimit = do
   printDebug "[updatePie] cId" cId
   printDebug "[updatePie] maybeListId" maybeListId
@@ -285,12 +285,12 @@ updatePie cId maybeListId tabType maybeLimit = do
   _ <- updatePie' cId maybeListId tabType maybeLimit
   pure ()
 
-updatePie' :: FlowCmdM env err m =>
-     CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> Maybe Limit
-  -> m (ChartMetrics Histo)
+updatePie' :: (HasNodeStory env err m, HasNodeError err)
+           => CorpusId
+           -> Maybe ListId
+           -> TabType
+           -> Maybe Limit
+           -> m (ChartMetrics Histo)
 updatePie' cId maybeListId tabType _maybeLimit = do
   listId <- case maybeListId of
     Just lid -> pure lid
@@ -304,11 +304,11 @@ updatePie' cId maybeListId tabType _maybeLimit = do
 
   pure $ ChartMetrics p
 
-getPieHash :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> m Text
+getPieHash :: HasNodeStory env err m
+           => CorpusId
+           -> Maybe ListId
+           -> TabType
+           -> m Text
 getPieHash cId maybeListId tabType = do
   hash <$> getPie cId Nothing Nothing maybeListId tabType
 
@@ -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,12 +362,12 @@ getTree cId _start _end maybeListId tabType listType = do
 
   pure $ constructHashedResponse chart
 
-updateTree :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> ListType
-  -> m ()
+updateTree :: HasNodeStory env err m
+           => CorpusId
+           -> Maybe ListId
+           -> TabType
+           -> ListType
+           -> m ()
 updateTree cId maybeListId tabType listType = do
   printDebug "[updateTree] cId" cId
   printDebug "[updateTree] maybeListId" maybeListId
@@ -376,12 +376,12 @@ updateTree cId maybeListId tabType listType = do
   _ <- updateTree' cId maybeListId tabType listType
   pure ()
 
-updateTree' :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> ListType
-  -> m (ChartMetrics (Vector NgramsTree))
+updateTree' :: HasNodeStory env err m
+            => CorpusId
+            -> Maybe ListId
+            -> TabType
+            -> ListType
+            -> m (ChartMetrics (Vector NgramsTree))
 updateTree' cId maybeListId tabType listType = do
   listId <- case maybeListId of
     Just lid -> pure lid
@@ -395,11 +395,11 @@ updateTree' cId maybeListId tabType listType = do
 
   pure $ ChartMetrics t
 
-getTreeHash :: FlowCmdM env err m =>
-  CorpusId
-  -> Maybe ListId
-  -> TabType
-  -> ListType
-  -> m Text
+getTreeHash :: HasNodeStory env err m
+            => CorpusId
+            -> Maybe ListId
+            -> TabType
+            -> ListType
+            -> m Text
 getTreeHash cId maybeListId tabType listType = do
   hash <$> getTree cId Nothing Nothing maybeListId 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,28 +16,28 @@ 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)
 import Gargantext.Core.Types.Main (ListType(..))
 import Gargantext.Core.Viz.Graph.API (recomputeGraph)
 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
@@ -46,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"
@@ -99,12 +96,12 @@ api uId nId =
   serveJobsAPI UpdateNodeJob $ \jHandle p ->
     updateNode uId nId p jHandle
 
-updateNode :: (HasSettings env, FlowCmdM env err m, MonadJobStatus m)
-    => UserId
-    -> NodeId
-    -> UpdateNodeParams
-    -> JobHandle m
-    -> m ()
+updateNode :: (HasNodeStory env err m, HasSettings env, MonadJobStatus m)
+           => UserId
+           -> NodeId
+           -> UpdateNodeParams
+           -> JobHandle m
+           -> m ()
 updateNode uId nId (UpdateNodeParamsGraph metric partitionMethod bridgeMethod strength nt1 nt2) jobHandle = do
 
   markStarted 2 jobHandle
@@ -149,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 ()
 
@@ -181,24 +178,31 @@ updateNode _userId phyloId (UpdateNodePhylo config) jobHandle = do
 updateNode _uId tId (UpdateNodeParamsTexts _mode) jobHandle = do
   markStarted 3 jobHandle
   corpusId <- view node_parent_id <$> getNode tId
-  lId      <- defaultList $ fromMaybe (panic "[G.A.N.Update] updateNode/UpdateNodeParamsTexts: no defaultList") corpusId
   markProgress 1 jobHandle
 
   _ <- case corpusId of
-    Just cId -> do
-      _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
-      _ <- updateNgramsOccurrences cId (Just lId)
-      _ <- updateContextScore      cId (Just lId)
-      _ <- Metrics.updateChart     cId (Just lId) NgramsTypes.Docs Nothing
-      -- printDebug "updateContextsScore" (cId, lId, u)
+    Just cId -> updateDocs cId
+    Nothing  -> do
+      _ <- panic "[G.A.N.Update] updateNode/UpdateNodeParamsText: no corpus Id given"
       pure ()
-    Nothing  -> pure ()
 
   markComplete jobHandle
 
 
 updateNode _uId _nId _p jobHandle = do
   simuLogs jobHandle 10
+------------------------------------------------------------------------
+
+updateDocs :: (HasNodeStory env err m)
+            => NodeId -> m ()
+updateDocs cId = do
+  lId <- defaultList cId
+  _ <- reIndexWith cId lId NgramsTerms (Set.singleton MapTerm)
+  _ <- updateNgramsOccurrences cId lId
+  _ <- updateContextScore      cId lId
+  _ <- Metrics.updateChart'    cId lId NgramsTypes.Docs Nothing
+  -- printDebug "updateContextsScore" (cId, lId, u)
+  pure ()
 
 ------------------------------------------------------------------------
 -- TODO unPrefix "pn_" FromJSON, ToJSON, ToSchema, adapt frontend.

src/Gargantext/API/Table.hs

@@ -133,7 +133,10 @@ getTableApi cId tabType mLimit mOffset mOrderBy mQuery mYear =
       t <- getTable cId tabType mOffset mLimit mOrderBy mQuery mYear
       pure $ constructHashedResponse t
 
-postTableApi :: (CmdM env err m, MonadLogger m, HasNodeError err) => NodeId -> TableQuery -> m FacetTableResult
+postTableApi :: (CmdM env err m, MonadLogger m, HasNodeError err)
+             => NodeId
+             -> TableQuery
+             -> m FacetTableResult
 postTableApi cId tq = case tq of
  TableQuery o l order ft "" -> do
    $(logLocM) DEBUG $ "New search with no query"
@@ -170,7 +173,8 @@ searchInCorpus' cId t q o l order = do
     Right boolQuery -> do
       docs          <- searchInCorpus cId t boolQuery o l order
       countAllDocs  <- searchCountInCorpus cId t boolQuery
-      pure $ TableResult { tr_docs = docs, tr_count = countAllDocs }
+      pure $ TableResult { tr_docs = docs
+                         , tr_count = countAllDocs }
 
 
 getTable :: HasNodeError err

src/Gargantext/Core/NLP.hs

+{-|
+Module      : Gargantext.Core.NLP
+Description : GarganText NLP
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
 module Gargantext.Core.NLP where
 
 import Control.Lens (Getter, at, non)

src/Gargantext/Core/NodeStory.hs

@@ -117,7 +117,7 @@ import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types (ListId, NodeId(..), NodeType)
 import Gargantext.Core.Utils.Prefix (unPrefix)
 import Gargantext.Database.Admin.Config (nodeTypeId)
-import Gargantext.Database.Prelude (CmdM', HasConnectionPool(..), HasConfig)
+import Gargantext.Database.Prelude (DbCmd', HasConnectionPool(..))
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError())
 import Gargantext.Database.Schema.Ngrams (NgramsType)
 import Gargantext.Prelude
@@ -143,12 +143,10 @@ data NodeStoryEnv = NodeStoryEnv
   }
   deriving (Generic)
 
-type HasNodeStory env err m = ( CmdM' env err m
+type HasNodeStory env err m = ( DbCmd' env err m
                               , MonadReader env m
                               , MonadError  err m
                               , HasNodeStoryEnv env
-                              , HasConfig env
-                              , HasConnectionPool env
                               , HasNodeError err
                               )
 

src/Gargantext/Core/Viz/Chart.hs

@@ -14,12 +14,15 @@ Portability : POSIX
 module Gargantext.Core.Viz.Chart
   where
 
+import Data.HashMap.Strict qualified as HashMap
 import Data.List (sortOn)
+import Data.List qualified as List
 import Data.Map.Strict (toList)
-import qualified Data.List as List
 import Data.Maybe (catMaybes)
-import qualified Data.Vector as V
+import Data.Vector qualified as V
 
+import Gargantext.Core.NodeStory (HasNodeStory)
+import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
 import Gargantext.Core.Types.Main
 import Gargantext.Database.Admin.Config
 import Gargantext.Database.Prelude
@@ -28,21 +31,18 @@ import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Database.Query.Table.NodeContext (selectDocsDates)
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude
-import Gargantext.Core.Text.Metrics.Count (occurrencesWith)
 
 -- Pie Chart
 import Gargantext.API.Ngrams.NgramsTree
 import Gargantext.API.Ngrams.Tools
 import Gargantext.API.Ngrams.Types
 import Gargantext.Core.Types
-import Gargantext.Database.Action.Flow.Types
 import Gargantext.Database.Action.Metrics.NgramsByContext
 import Gargantext.Database.Schema.Ngrams
 import Gargantext.Core.Viz.Types
-import qualified Data.HashMap.Strict as HashMap
 
 
-histoData :: CorpusId -> Cmd err Histo
+histoData :: CorpusId -> DBCmd err Histo
 histoData cId = do
   dates <- selectDocsDates cId
   let (ls, css) = V.unzip
@@ -53,9 +53,9 @@ histoData cId = do
   pure (Histo ls css)
 
 
-chartData :: FlowCmdM env err m
-        => CorpusId -> NgramsType -> ListType
-        -> m Histo
+chartData :: HasNodeStory env err m
+          => CorpusId -> NgramsType -> ListType
+          -> m Histo
 chartData cId nt lt = do
   ls' <- selectNodesWithUsername NodeList userMaster
   ls <- map (_node_id) <$> getListsWithParentId cId
@@ -77,7 +77,7 @@ chartData cId nt lt = do
   pure (Histo dates (round <$> count))
 
 
-treeData :: FlowCmdM env err m
+treeData :: HasNodeStory env err m
         => CorpusId -> NgramsType -> ListType
         -> m (V.Vector NgramsTree)
 treeData cId nt lt = do

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,8 +82,8 @@ graphAPI u n = getGraph         u n
 
 ------------------------------------------------------------------------
 --getGraph :: UserId -> NodeId -> GargServer HyperdataGraphAPI
-getGraph :: FlowCmdM env err m
-         => UserId
+getGraph :: HasNodeStory env err m
+          => UserId
          -> NodeId
          -> m HyperdataGraphAPI
 getGraph _uId nId = do
@@ -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,8 +350,8 @@ graphClone uId pId (HyperdataGraphAPI { _hyperdataAPIGraph = graph
 --getGraphGexf :: UserId
 --             -> NodeId
 --             -> GargNoServer (Headers '[Servant.Header "Content-Disposition" Text] Graph)
-getGraphGexf :: FlowCmdM env err m
-             => UserId
+getGraphGexf :: HasNodeStory env err m
+              => UserId
              -> NodeId
              -> m (Headers '[Servant.Header "Content-Disposition" Text] Graph)
 getGraphGexf uId nId = do

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

@@ -374,8 +374,8 @@ flowCorpusUser l user userCorpusId listId ctype mfslw = do
   -- Annuaire Flow
   -- _ <- mkAnnuaire  rootUserId userId
   _ <- reIndexWith userCorpusId listId NgramsTerms (Set.singleton MapTerm)
-  _ <- updateContextScore      userCorpusId (Just listId)
-  _ <- updateNgramsOccurrences userCorpusId (Just listId)
+  _ <- updateContextScore      userCorpusId listId
+  _ <- updateNgramsOccurrences userCorpusId listId
   
   pure userCorpusId
 
@@ -614,9 +614,7 @@ extractInsert docs = do
 
 
 -- | Re-index documents of a corpus with ngrams in the list
-reIndexWith :: ( HasNodeStory env err m
-               , FlowCmdM     env err m
-               )
+reIndexWith :: ( HasNodeStory env err m )
             => CorpusId
             -> ListId
             -> NgramsType

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

@@ -15,58 +15,50 @@ Node API
 module Gargantext.Database.Action.Metrics
   where
 
-import Database.PostgreSQL.Simple.SqlQQ (sql)
+-- import Gargantext.Database.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
 import Data.HashMap.Strict (HashMap)
+import Data.HashMap.Strict qualified as HM
+import Data.List qualified as List
 import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
 import Data.Set (Set)
+import Data.Set qualified as Set
+import Data.Text qualified as Text
+import Data.Vector (Vector)
 import Database.PostgreSQL.Simple (Query, Only(..))
+import Database.PostgreSQL.Simple.SqlQQ (sql)
+import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
-import Data.Vector (Vector)
-import Gargantext.Core (HasDBid(toDBid))
 import Gargantext.API.Ngrams.Tools (filterListWithRoot, groupNodesByNgrams, Diagonal(..), getCoocByNgrams, mapTermListRoot, RootTerm, getRepo)
-import Gargantext.Database.Prelude (runPGSQuery{-, formatPGSQuery-})
 import Gargantext.API.Ngrams.Types (TabType(..), ngramsTypeFromTabType, NgramsTerm(..))
-import Gargantext.Core.Mail.Types (HasMail)
+import Gargantext.Core (HasDBid(toDBid))
 import Gargantext.Core.NodeStory hiding (runPGSQuery)
 import Gargantext.Core.Text.Metrics (scored, Scored(..), {-localMetrics, toScored-})
-import Database.PostgreSQL.Simple.ToField (toField, Action{-, ToField-})
 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.Action.Metrics.NgramsByContext (refreshNgramsMaterialized)
 import Gargantext.Database.Admin.Types.Node (ListId, CorpusId)
-import Gargantext.Database.Query.Table.Node (defaultList)
+import Gargantext.Database.Prelude (runPGSQuery{-, formatPGSQuery-})
 import Gargantext.Database.Query.Table.Node.Select
 import Gargantext.Prelude
-import qualified Data.HashMap.Strict as HM
-import qualified Data.Map.Strict     as Map
-import qualified Data.Set            as Set
-import qualified Data.List           as List
-import qualified Data.Text           as Text
-
-getMetrics :: FlowCmdM env err m
-            => CorpusId -> Maybe 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 :: (HasNodeStory env err m)
+           => CorpusId -> ListId -> TabType -> Maybe Limit
+           -> m (HashMap NgramsTerm (ListType, Maybe NgramsTerm), Vector (Scored NgramsTerm))
+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
-            -> 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 :: (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 lId tabType maybeLimit = do
   (ngs', ngs) <- getNgrams lId tabType
 
   lIds <- selectNodesWithUsername NodeList userMaster
@@ -81,22 +73,18 @@ getNgramsCooc cId maybeListId tabType maybeLimit = do
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-updateNgramsOccurrences :: (FlowCmdM env err m)
-             => CorpusId -> Maybe ListId
-             -> m ()
-updateNgramsOccurrences cId mlId = do
-  _ <- mapM (updateNgramsOccurrences' cId mlId Nothing) [Terms, Sources, Authors, Institutes]
+updateNgramsOccurrences :: (HasNodeStory env err m)
+                        => CorpusId -> ListId
+                        -> m ()
+updateNgramsOccurrences cId lId = do
+  _ <- mapM (updateNgramsOccurrences' cId lId Nothing) [Terms, Sources, Authors, Institutes]
   pure ()
 
 
-updateNgramsOccurrences' :: (FlowCmdM env err m)
-             => CorpusId -> Maybe ListId -> Maybe Limit -> TabType
-             -> m [Int]
-updateNgramsOccurrences' cId maybeListId maybeLimit tabType = do
-
-  lId <- case maybeListId of
-    Nothing   -> defaultList cId
-    Just lId' -> pure lId'
+updateNgramsOccurrences' :: (HasNodeStory env err m)
+                         => CorpusId -> ListId -> Maybe Limit -> TabType
+                         -> m [Int]
+updateNgramsOccurrences' cId lId maybeLimit tabType = do
 
   result <- getNgramsOccurrences cId lId tabType maybeLimit
 
@@ -136,16 +124,16 @@ updateNgramsOccurrences' cId maybeListId maybeLimit tabType = do
 
 ------------------------------------------------------------------------
 -- Used for scores in Ngrams Table
-getNgramsOccurrences :: (FlowCmdM env err m)
-             => CorpusId -> ListId -> TabType -> Maybe Limit
-             -> m (HashMap NgramsTerm Int)
+getNgramsOccurrences :: (HasNodeStory env err m)
+                     => CorpusId -> ListId -> TabType -> Maybe Limit
+                     -> m (HashMap NgramsTerm Int)
 getNgramsOccurrences c l t ml = HM.map Set.size <$> getNgramsContexts c l t ml
 
 
 
-getNgramsContexts :: (FlowCmdM env err m)
-             => CorpusId -> ListId -> TabType -> Maybe Limit
-             -> m (HashMap NgramsTerm (Set ContextId))
+getNgramsContexts :: (HasNodeStory env err m)
+                  => CorpusId -> ListId -> TabType -> Maybe Limit
+                  -> m (HashMap NgramsTerm (Set ContextId))
 getNgramsContexts cId lId tabType maybeLimit = do
   (_ngs', ngs) <- getNgrams lId tabType
   lIds <- selectNodesWithUsername NodeList userMaster
@@ -159,14 +147,10 @@ getNgramsContexts cId lId tabType maybeLimit = do
 
 
 ------------------------------------------------------------------------
-updateContextScore :: (FlowCmdM env err m)
-             => CorpusId -> Maybe ListId
-             -> m [Int]
-updateContextScore cId maybeListId = do
-
-  lId <- case maybeListId of
-    Nothing   -> defaultList cId
-    Just lId' -> pure lId'
+updateContextScore :: (HasNodeStory env err m)
+                   => CorpusId -> ListId
+                   -> m [Int]
+updateContextScore cId lId = do
 
   result <- getContextsNgramsScore cId lId Terms MapTerm Nothing
 
@@ -200,15 +184,17 @@ updateContextScore cId maybeListId = do
 
 
 -- Used for scores in Doc Table
-getContextsNgramsScore :: (FlowCmdM env err m)
-             => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
-             -> m (Map ContextId Int)
+getContextsNgramsScore :: --(FlowCmdM env err m)
+                          (HasNodeStory env err m)
+                       => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
+                       -> m (Map ContextId Int)
 getContextsNgramsScore cId lId tabType listType maybeLimit
  = Map.map Set.size <$> getContextsNgrams cId lId tabType listType maybeLimit
 
-getContextsNgrams :: (FlowCmdM env err m)
-             => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
-             -> m (Map ContextId (Set NgramsTerm))
+getContextsNgrams :: --(FlowCmdM env err m)
+                     (HasNodeStory env err m)
+                  => CorpusId -> ListId -> TabType -> ListType -> Maybe Limit
+                  -> m (Map ContextId (Set NgramsTerm))
 getContextsNgrams cId lId tabType listType maybeLimit = do
   (ngs', ngs) <- getNgrams lId tabType
   lIds <- selectNodesWithUsername NodeList userMaster
@@ -232,7 +218,7 @@ getContextsNgrams cId lId tabType listType maybeLimit = do
 ------------------------------------------------------------------------
 
 
-getNgrams :: (HasMail env, HasNodeStory env err m)
+getNgrams :: (HasNodeStory env err m)
             => ListId -> TabType
             -> m ( HashMap NgramsTerm (ListType, Maybe NgramsTerm)
                  , HashMap NgramsTerm (Maybe RootTerm)

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/Action/Metrics/NgramsByContext.hs

@@ -20,25 +20,25 @@ module Gargantext.Database.Action.Metrics.NgramsByContext
 --import Data.Map.Strict.Patch (PatchMap, Replace, diff)
 -- import Control.Monad (void)
 import Data.HashMap.Strict (HashMap)
+import Data.HashMap.Strict qualified as HM
+import Data.List qualified as List
 import Data.Map.Strict (Map)
+import Data.Map.Strict qualified as Map
 import Data.Set (Set)
+import Data.Set qualified as Set
 import Data.Text (Text)
 import Data.Tuple.Extra (first, second, swap)
+import Database.PostgreSQL.Simple qualified as DPS
 import Database.PostgreSQL.Simple.SqlQQ (sql)
 import Database.PostgreSQL.Simple.Types (Values(..), QualifiedIdentifier(..))
+import Database.PostgreSQL.Simple.Types qualified as DPST
 import Gargantext.API.Ngrams.Types (NgramsTerm(..))
 import Gargantext.Core
 import Gargantext.Data.HashMap.Strict.Utils as HM
 import Gargantext.Database.Admin.Types.Node (ListId, CorpusId, NodeId(..), ContextId, MasterCorpusId, NodeType(NodeDocument), UserCorpusId, DocId)
-import Gargantext.Database.Prelude (Cmd, runPGSQuery)  -- , execPGSQuery)
+import Gargantext.Database.Prelude (DBCmd, runPGSQuery)  -- , execPGSQuery)
 import Gargantext.Database.Schema.Ngrams (ngramsTypeId, NgramsType(..))
 import Gargantext.Prelude
-import qualified Data.HashMap.Strict              as HM
-import qualified Data.List                        as List
-import qualified Data.Map.Strict                  as Map
-import qualified Data.Set                         as Set
-import qualified Database.PostgreSQL.Simple       as DPS
-import qualified Database.PostgreSQL.Simple.Types as DPST
 
 -- | fst is size of Supra Corpus
 --   snd is Texts and size of Occurrences (different docs)
@@ -61,10 +61,10 @@ countContextsByNgramsWith f m = (total, m')
                            $ HM.toList m''
 
 ------------------------------------------------------------------------
-getContextsByNgramsUser ::  HasDBid NodeType
+getContextsByNgramsUser :: HasDBid NodeType
                         => CorpusId
                         -> NgramsType
-                        -> Cmd err (HashMap NgramsTerm (Set ContextId))
+                        -> DBCmd err (HashMap NgramsTerm (Set ContextId))
 getContextsByNgramsUser cId nt =
   HM.fromListWith (<>) <$> map (\(n,t) -> (NgramsTerm t, Set.singleton n))
                     <$> selectNgramsByContextUser cId nt
@@ -73,7 +73,7 @@ getContextsByNgramsUser cId nt =
       selectNgramsByContextUser :: HasDBid NodeType
                                 => CorpusId
                                 -> NgramsType
-                                -> Cmd err [(NodeId, Text)]
+                                -> DBCmd err [(NodeId, Text)]
       selectNgramsByContextUser cId' nt' =
         runPGSQuery queryNgramsByContextUser
                     ( cId'
@@ -99,11 +99,11 @@ getContextsByNgramsUser cId nt =
 
 ------------------------------------------------------------------------
 getOccByNgramsOnlyFast_withSample :: HasDBid NodeType
-                       => CorpusId
-                       -> Int
-                       -> NgramsType
-                       -> [NgramsTerm]
-                       -> Cmd err (HashMap NgramsTerm Int)
+                                  => CorpusId
+                                  -> Int
+                                  -> NgramsType
+                                  -> [NgramsTerm]
+                                  -> DBCmd err (HashMap NgramsTerm Int)
 getOccByNgramsOnlyFast_withSample cId int nt ngs =
   HM.fromListWith (+) <$> selectNgramsOccurrencesOnlyByContextUser_withSample cId int nt ngs
 
@@ -111,7 +111,7 @@ getOccByNgramsOnlyFast_withSample cId int nt ngs =
 getOccByNgramsOnlyFast :: CorpusId
                        -> ListId
                        -> NgramsType
-                       -> Cmd err (HashMap NgramsTerm [ContextId])
+                       -> DBCmd err (HashMap NgramsTerm [ContextId])
 getOccByNgramsOnlyFast cId lId nt = do
     --HM.fromList <$> map (\(t,n) -> (NgramsTerm t, round n)) <$> run cId lId nt
     HM.fromList <$> map (\(t, ns) -> (NgramsTerm t, NodeId <$> DPST.fromPGArray ns)) <$> run cId lId nt
@@ -120,7 +120,7 @@ getOccByNgramsOnlyFast cId lId nt = do
       run :: CorpusId
            -> ListId
            -> NgramsType
-           -> Cmd err [(Text, DPST.PGArray Int)]
+           -> DBCmd err [(Text, DPST.PGArray Int)]
       run cId' lId' nt' = runPGSQuery query
                 ( cId'
                 , lId'
@@ -179,11 +179,11 @@ getOccByNgramsOnlyFast cId lId nt = do
 
 
 selectNgramsOccurrencesOnlyByContextUser_withSample :: HasDBid NodeType
-                                      => CorpusId
-                                      -> Int
-                                      -> NgramsType
-                                      -> [NgramsTerm]
-                                      -> Cmd err [(NgramsTerm, Int)]
+                                                    => CorpusId
+                                                    -> Int
+                                                    -> NgramsType
+                                                    -> [NgramsTerm]
+                                                    -> DBCmd err [(NgramsTerm, Int)]
 selectNgramsOccurrencesOnlyByContextUser_withSample cId int nt tms =
   fmap (first NgramsTerm) <$>
   runPGSQuery queryNgramsOccurrencesOnlyByContextUser_withSample
@@ -216,10 +216,10 @@ queryNgramsOccurrencesOnlyByContextUser_withSample = [sql|
   |]
 
 selectNgramsOccurrencesOnlyByContextUser_withSample' :: HasDBid NodeType
-                                      => CorpusId
-                                      -> Int
-                                      -> NgramsType
-                                      -> Cmd err [(NgramsTerm, Int)]
+                                                     => CorpusId
+                                                     -> Int
+                                                     -> NgramsType
+                                                     -> DBCmd err [(NgramsTerm, Int)]
 selectNgramsOccurrencesOnlyByContextUser_withSample' cId int nt =
   fmap (first NgramsTerm) <$>
   runPGSQuery queryNgramsOccurrencesOnlyByContextUser_withSample
@@ -253,7 +253,7 @@ getContextsByNgramsOnlyUser :: HasDBid NodeType
                          -> [ListId]
                          -> NgramsType
                          -> [NgramsTerm]
-                         -> Cmd err (HashMap NgramsTerm (Set NodeId))
+                         -> DBCmd err (HashMap NgramsTerm (Set NodeId))
 getContextsByNgramsOnlyUser cId ls nt ngs =
      HM.unionsWith        (<>)
    . map (HM.fromListWith (<>)
@@ -262,11 +262,11 @@ getContextsByNgramsOnlyUser cId ls nt ngs =
            (splitEvery 1000 ngs)
 
 getNgramsByContextOnlyUser :: HasDBid NodeType
-                        => NodeId
-                        -> [ListId]
-                        -> NgramsType
-                        -> [NgramsTerm]
-                        -> Cmd err (Map NodeId (Set NgramsTerm))
+                           => NodeId
+                           -> [ListId]
+                           -> NgramsType
+                           -> [NgramsTerm]
+                           -> DBCmd err (Map NodeId (Set NgramsTerm))
 getNgramsByContextOnlyUser cId ls nt ngs =
      Map.unionsWith         (<>)
    . map ( Map.fromListWith (<>)
@@ -282,7 +282,7 @@ selectNgramsOnlyByContextUser :: HasDBid NodeType
                            -> [ListId]
                            -> NgramsType
                            -> [NgramsTerm]
-                           -> Cmd err [(NgramsTerm, ContextId)]
+                           -> DBCmd err [(NgramsTerm, ContextId)]
 selectNgramsOnlyByContextUser cId ls nt tms =
   fmap (first NgramsTerm) <$>
   runPGSQuery queryNgramsOnlyByContextUser
@@ -317,7 +317,7 @@ getNgramsByDocOnlyUser :: DocId
                        -> [ListId]
                        -> NgramsType
                        -> [NgramsTerm]
-                       -> Cmd err (HashMap NgramsTerm (Set NodeId))
+                       -> DBCmd err (HashMap NgramsTerm (Set NodeId))
 getNgramsByDocOnlyUser cId ls nt ngs =
   HM.unionsWith (<>)
   . map (HM.fromListWith (<>) . map (second Set.singleton))
@@ -328,7 +328,7 @@ selectNgramsOnlyByDocUser :: DocId
                           -> [ListId]
                           -> NgramsType
                           -> [NgramsTerm]
-                          -> Cmd err [(NgramsTerm, NodeId)]
+                          -> DBCmd err [(NgramsTerm, NodeId)]
 selectNgramsOnlyByDocUser dId ls nt tms =
   fmap (first NgramsTerm) <$>
   runPGSQuery queryNgramsOnlyByDocUser
@@ -360,7 +360,7 @@ queryNgramsOnlyByDocUser = [sql|
 getContextsByNgramsMaster :: HasDBid NodeType
                           =>  UserCorpusId
                           -> MasterCorpusId
-                          -> Cmd err (HashMap Text (Set NodeId))
+                          -> DBCmd err (HashMap Text (Set NodeId))
 getContextsByNgramsMaster ucId mcId = unionsWith (<>)
                                  . map (HM.fromListWith (<>) . map (\(n,t) -> (t, Set.singleton n)))
                                  -- . takeWhile (not . List.null)
@@ -368,11 +368,11 @@ getContextsByNgramsMaster ucId mcId = unionsWith (<>)
                                 <$> mapM (selectNgramsByContextMaster 1000 ucId mcId) [0,500..10000]
 
 selectNgramsByContextMaster :: HasDBid NodeType
-                         => Int
-                         -> UserCorpusId
-                         -> MasterCorpusId
-                         -> Int
-                         -> Cmd err [(NodeId, Text)]
+                            => Int
+                            -> UserCorpusId
+                            -> MasterCorpusId
+                            -> Int
+                            -> DBCmd err [(NodeId, Text)]
 selectNgramsByContextMaster n ucId mcId p = runPGSQuery
                                queryNgramsByContextMaster'
                                  ( ucId

src/Gargantext/Database/Query/Facet.hs

@@ -39,15 +39,12 @@ module Gargantext.Database.Query.Facet
 
 import Control.Arrow (returnA)
 import Control.Lens ((^.))
-import qualified Data.Text as T
-import Opaleye
-import qualified Opaleye.Aggregate as OAgg
-import Protolude hiding (null, map, sum, not)
-import qualified Opaleye.Internal.Unpackspec()
-
+import Data.Text qualified as T
 import Gargantext.Core
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Query (Limit, Offset, IsTrash)
+import Gargantext.Database.Prelude
+import Gargantext.Database.Query.Facet.Types
 import Gargantext.Database.Query.Filter
 import Gargantext.Database.Query.Table.Context
 import Gargantext.Database.Query.Table.ContextNodeNgrams
@@ -55,11 +52,13 @@ import Gargantext.Database.Query.Table.Ngrams
 import Gargantext.Database.Query.Table.Node (defaultList)
 import Gargantext.Database.Query.Table.Node.Error (HasNodeError)
 import Gargantext.Database.Query.Table.NodeContext (queryNodeContextTable)
-import Gargantext.Database.Query.Facet.Types
-import Gargantext.Database.Prelude
 import Gargantext.Database.Schema.Context
 import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.NodeContext
+import Opaleye
+import Opaleye.Aggregate qualified as OAgg
+import Opaleye.Internal.Unpackspec ()
+import Protolude hiding (null, map, sum, not)
 
 ------------------------------------------------------------------------
 
@@ -162,7 +161,7 @@ viewDocuments cId lId t ntId mQuery mYear =
                                 , facetDoc_hyperdata  = OAgg.groupBy
                                 , facetDoc_category   = OAgg.groupBy
                                 , facetDoc_ngramCount = OAgg.sumInt4
-                                , facetDoc_score      = OAgg.sumInt4 })
+                                , facetDoc_score      = OAgg.groupBy })
         (viewDocumentsAgg cId lId t ntId mQuery mYear)
 
 viewDocumentsAgg :: CorpusId
@@ -188,7 +187,7 @@ viewDocumentsAgg cId lId t ntId mQuery mYear = proc () -> do
                        -- currently it is all 0's in the DB and the
                        -- search functionality on the frontend orders
                        -- by Score.
-                       , facetDoc_score      = ngramCount
+                       , facetDoc_score      = unsafeCast "int8" $ nc ^. nc_score
                        }
 
 -- TODO Join with context_node_ngrams at context_id/node_id and sum by

src/Gargantext/Database/Query/Facet/Types.hs

@@ -152,7 +152,7 @@ type FacetDocAggPart = Facet (Field SqlInt4       )
                              (Field SqlJsonb      )
                              (Field SqlInt4) -- Category
                              (Field SqlInt4) -- Ngrams Count
-                             (Field SqlInt4) -- Score
+                             (Field SqlInt8) -- Score
 
 -----------------------------------------------------------------------
 -----------------------------------------------------------------------

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
@@ -97,12 +97,12 @@ selectChildrenNode parentId maybeNodeType = proc () -> do
 
 
 getChildrenContext :: (JSONB a, HasDBid NodeType)
-            => ParentId
-            -> proxy a
-            -> Maybe NodeType
-            -> Maybe Offset
-            -> Maybe Limit
-            -> Cmd err (NodeTableResult a)
+                   => ParentId
+                   -> proxy a
+                   -> Maybe NodeType
+                   -> Maybe Offset
+                   -> Maybe Limit
+                   -> DBCmd err (NodeTableResult a)
 getChildrenContext pId _ maybeNodeType maybeOffset maybeLimit = do
   -- printDebug "getChildrenContext" (pId, maybeNodeType)
   let query = selectChildren' pId maybeNodeType

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

@@ -27,7 +27,7 @@ import Gargantext.Database.Schema.Node
 import Gargantext.Database.Schema.User
 import Gargantext.Database.Query.Table.User
 
-selectNodesWithUsername :: (HasDBid NodeType) => NodeType -> Username -> Cmd err [NodeId]
+selectNodesWithUsername :: (HasDBid NodeType) => NodeType -> Username -> DBCmd err [NodeId]
 selectNodesWithUsername nt u = runOpaQuery $ proc () -> do
   n <- queryNodeTable -< ()
   usrs <- optionalRestrict queryUserTable -<

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

@@ -70,12 +70,12 @@ queryNodeContextTable :: Select NodeContextRead
 queryNodeContextTable = selectTable nodeContextTable
 
 -- | not optimized (get all ngrams without filters)
-_nodesContexts :: Cmd err [NodeContext]
+_nodesContexts :: DBCmd err [NodeContext]
 _nodesContexts = runOpaQuery queryNodeContextTable
 
 ------------------------------------------------------------------------
 -- | Basic NodeContext tools
-getNodeContexts :: NodeId -> Cmd err [NodeContext]
+getNodeContexts :: NodeId -> DBCmd err [NodeContext]
 getNodeContexts n = runOpaQuery (selectNodeContexts $ pgNodeId n)
   where
     selectNodeContexts :: Field SqlInt4 -> Select NodeContextRead
@@ -85,7 +85,7 @@ getNodeContexts n = runOpaQuery (selectNodeContexts $ pgNodeId n)
       returnA -< ns
 
 
-getNodeContext :: HasNodeError err => ContextId -> NodeId -> Cmd err NodeContext
+getNodeContext :: HasNodeError err => ContextId -> NodeId -> DBCmd err NodeContext
 getNodeContext c n = do
   maybeNodeContext <- headMay <$> runOpaQuery (selectNodeContext (pgNodeId c) (pgNodeId n))
   case maybeNodeContext of
@@ -99,7 +99,7 @@ getNodeContext c n = do
       restrict -< _nc_node_id ns .== n'
       returnA -< ns
 
-updateNodeContextCategory :: ContextId -> NodeId -> Int -> Cmd err Int64
+updateNodeContextCategory :: ContextId -> NodeId -> Int -> DBCmd err Int64
 updateNodeContextCategory cId nId cat = do
   execPGSQuery upScore (cat, cId, nId)
   where
@@ -120,7 +120,7 @@ data ContextForNgrams =
 getContextsForNgrams :: HasNodeError err
                      => NodeId
                      -> [Int]
-                     -> Cmd err [ContextForNgrams]
+                     -> DBCmd err [ContextForNgrams]
 getContextsForNgrams cId ngramsIds = do
   res <- runPGSQuery query (cId, PGS.In ngramsIds)
   pure $ (\( _cfn_nodeId
@@ -153,7 +153,7 @@ data ContextForNgramsTerms =
 getContextsForNgramsTerms :: HasNodeError err
                           => NodeId
                           -> [Text]
-                          -> Cmd err [ContextForNgramsTerms]
+                          -> DBCmd err [ContextForNgramsTerms]
 getContextsForNgramsTerms cId ngramsTerms = do
   res <- runPGSQuery query (cId, PGS.In ngramsTerms)
   pure $ (\( _cfnt_nodeId
@@ -180,15 +180,17 @@ getContextsForNgramsTerms cId ngramsTerms = do
                        date,
                        hyperdata,
                        nodes_contexts.score AS score,
-                       nodes_contexts.category AS category,
-                       context_node_ngrams.doc_count AS doc_count
+                       nodes_contexts.category AS category --,
+                       -- context_node_ngrams.doc_count AS doc_count
                     FROM contexts
                     JOIN context_node_ngrams ON contexts.id = context_node_ngrams.context_id
                     JOIN nodes_contexts ON contexts.id = nodes_contexts.context_id
                     JOIN ngrams ON context_node_ngrams.ngrams_id = ngrams.id
                     WHERE nodes_contexts.node_id = ?
                      AND ngrams.terms IN ?) t
-                   ORDER BY t.doc_count DESC |]
+                   -- ORDER BY t.doc_count DESC
+                   ORDER BY t.score DESC
+                   |]
 
 
 
@@ -201,7 +203,7 @@ getContextsForNgramsTerms cId ngramsTerms = do
 getContextNgrams :: HasNodeError err
                  => NodeId
                  -> NodeId
-                 -> Cmd err [Text]
+                 -> DBCmd err [Text]
 getContextNgrams contextId listId = do
   res <- runPGSQuery query (contextId, listId)
   pure $ (\(PGS.Only term) -> term) <$> res
@@ -225,7 +227,7 @@ getContextNgrams contextId listId = do
 getContextNgramsMatchingFTS :: HasNodeError err
                             => NodeId
                             -> NodeId
-                            -> Cmd err [Text]
+                            -> DBCmd err [Text]
 getContextNgramsMatchingFTS contextId listId = do
   res <- runPGSQuery query (listId, contextId)
   pure $ (\(PGS.Only term) -> term) <$> res
@@ -254,7 +256,7 @@ getContextNgramsMatchingFTS contextId listId = do
                 AND (contexts.search @@ plainto_tsquery(ngrams.terms)
                   OR contexts.search @@ plainto_tsquery('french', ngrams.terms)) |]
 ------------------------------------------------------------------------
-insertNodeContext :: [NodeContext] -> Cmd err Int
+insertNodeContext :: [NodeContext] -> DBCmd err Int
 insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
                           $ Insert nodeContextTable ns' rCount (Just DoNothing))
   where
@@ -272,7 +274,7 @@ insertNodeContext ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
 type Node_Id    = NodeId
 type Context_Id = NodeId
 
-deleteNodeContext :: Node_Id -> Context_Id -> Cmd err Int
+deleteNodeContext :: Node_Id -> Context_Id -> DBCmd err Int
 deleteNodeContext n c = mkCmd $ \conn ->
   fromIntegral <$> runDelete_ conn
                               (Delete nodeContextTable
@@ -284,7 +286,7 @@ deleteNodeContext n c = mkCmd $ \conn ->
 
 ------------------------------------------------------------------------
 -- | Favorite management
-nodeContextsCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
+nodeContextsCategory :: [(CorpusId, DocId, Int)] -> DBCmd err [Int]
 nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
                             <$> runPGSQuery catSelect (PGS.Only $ Values fields inputData)
   where
@@ -300,7 +302,7 @@ nodeContextsCategory inputData = map (\(PGS.Only a) -> a)
 
 ------------------------------------------------------------------------
 -- | Score management
-nodeContextsScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
+nodeContextsScore :: [(CorpusId, DocId, Int)] -> DBCmd err [Int]
 nodeContextsScore inputData = map (\(PGS.Only a) -> a)
                             <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
   where
@@ -316,7 +318,7 @@ nodeContextsScore inputData = map (\(PGS.Only a) -> a)
 
 
 ------------------------------------------------------------------------
-selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
+selectCountDocs :: HasDBid NodeType => CorpusId -> DBCmd err Int
 selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
   where
     queryCountDocs cId' = proc () -> do
@@ -328,13 +330,13 @@ selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 
 
 -- | TODO use UTCTime fast
-selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
+selectDocsDates :: HasDBid NodeType => CorpusId -> DBCmd err [Text]
 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
                    <$> catMaybes
                    <$> map (view hd_publication_date)
                    <$> selectDocs cId
 
-selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
+selectDocs :: HasDBid NodeType => CorpusId -> DBCmd err [HyperdataDocument]
 selectDocs cId = runOpaQuery (queryDocs cId)
 
 queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Field SqlJsonb)
@@ -345,7 +347,7 @@ queryDocs cId = proc () -> do
   restrict -< (c ^. context_typename) .== sqlInt4 (toDBid NodeDocument)
   returnA  -< view (context_hyperdata) c
 
-selectDocNodes :: HasDBid NodeType => CorpusId -> Cmd err [Context HyperdataDocument]
+selectDocNodes :: HasDBid NodeType => CorpusId -> DBCmd err [Context HyperdataDocument]
 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 
 queryDocNodes :: HasDBid NodeType => CorpusId -> O.Select ContextRead
@@ -378,7 +380,7 @@ joinOn1 = proc () -> do
 
 ------------------------------------------------------------------------
 selectPublicContexts :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
-                  => Cmd err [(Node a, Maybe Int)]
+                  => DBCmd err [(Node a, Maybe Int)]
 selectPublicContexts = runOpaQuery (queryWithType NodeFolderPublic)
 
 queryWithType :: HasDBid NodeType => NodeType -> O.Select (NodeRead, MaybeFields (Field SqlInt4))

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

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

@@ -54,12 +54,12 @@ queryNodeNodeTable :: Select NodeNodeRead
 queryNodeNodeTable = selectTable nodeNodeTable
 
 -- | not optimized (get all ngrams without filters)
-_nodesNodes :: Cmd err [NodeNode]
+_nodesNodes :: DBCmd err [NodeNode]
 _nodesNodes = runOpaQuery queryNodeNodeTable
 
 ------------------------------------------------------------------------
 -- | Basic NodeNode tools
-getNodeNode :: NodeId -> Cmd err [NodeNode]
+getNodeNode :: NodeId -> DBCmd err [NodeNode]
 getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
   where
     selectNodeNode :: Column SqlInt4 -> Select NodeNodeRead
@@ -71,7 +71,7 @@ getNodeNode n = runOpaQuery (selectNodeNode $ pgNodeId n)
 ------------------------------------------------------------------------
 -- TODO (refactor with Children)
 {-
-getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> Cmd err [a]
+getNodeNodeWith :: NodeId -> proxy a -> Maybe NodeType -> DBCmd err [a]
 getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
   where
     query = selectChildren pId maybeNodeType
@@ -93,7 +93,7 @@ getNodeNodeWith pId _ maybeNodeType = runOpaQuery query
 -}
 
 ------------------------------------------------------------------------
-insertNodeNode :: [NodeNode] -> Cmd err Int
+insertNodeNode :: [NodeNode] -> DBCmd err Int
 insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
                           $ Insert nodeNodeTable ns' rCount (Just DoNothing))
   where
@@ -111,7 +111,7 @@ insertNodeNode ns = mkCmd $ \conn -> fromIntegral <$> (runInsert_ conn
 type Node1_Id = NodeId
 type Node2_Id = NodeId
 
-deleteNodeNode :: Node1_Id -> Node2_Id -> Cmd err Int
+deleteNodeNode :: Node1_Id -> Node2_Id -> DBCmd err Int
 deleteNodeNode n1 n2 = mkCmd $ \conn ->
   fromIntegral <$> runDelete_ conn
                   (Delete nodeNodeTable
@@ -123,7 +123,7 @@ deleteNodeNode n1 n2 = mkCmd $ \conn ->
 
 ------------------------------------------------------------------------
 -- | Favorite management
-_nodeNodeCategory :: CorpusId -> DocId -> Int -> Cmd err [Int]
+_nodeNodeCategory :: CorpusId -> DocId -> Int -> DBCmd err [Int]
 _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery (c,cId,dId)
   where
     favQuery :: PGS.Query
@@ -132,7 +132,7 @@ _nodeNodeCategory cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery favQuery
                RETURNING node2_id;
                |]
 
-nodeNodesCategory :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
+nodeNodesCategory :: [(CorpusId, DocId, Int)] -> DBCmd err [Int]
 nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
                             <$> runPGSQuery catQuery (PGS.Only $ Values fields inputData)
   where
@@ -148,7 +148,7 @@ nodeNodesCategory inputData = map (\(PGS.Only a) -> a)
 
 ------------------------------------------------------------------------
 -- | Score management
-_nodeNodeScore :: CorpusId -> DocId -> Int -> Cmd err [Int]
+_nodeNodeScore :: CorpusId -> DocId -> Int -> DBCmd err [Int]
 _nodeNodeScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (c,cId,dId)
   where
     scoreQuery :: PGS.Query
@@ -157,7 +157,7 @@ _nodeNodeScore cId dId c = map (\(PGS.Only a) -> a) <$> runPGSQuery scoreQuery (
                   RETURNING node2_id;
                   |]
 
-nodeNodesScore :: [(CorpusId, DocId, Int)] -> Cmd err [Int]
+nodeNodesScore :: [(CorpusId, DocId, Int)] -> DBCmd err [Int]
 nodeNodesScore inputData = map (\(PGS.Only a) -> a)
                             <$> runPGSQuery catScore (PGS.Only $ Values fields inputData)
   where
@@ -172,7 +172,7 @@ nodeNodesScore inputData = map (\(PGS.Only a) -> a)
                   |]
 
 ------------------------------------------------------------------------
-_selectCountDocs :: HasDBid NodeType => CorpusId -> Cmd err Int
+_selectCountDocs :: HasDBid NodeType => CorpusId -> DBCmd err Int
 _selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
   where
     queryCountDocs cId' = proc () -> do
@@ -188,13 +188,13 @@ _selectCountDocs cId = runCountOpaQuery (queryCountDocs cId)
 
 
 -- | TODO use UTCTime fast
-selectDocsDates :: HasDBid NodeType => CorpusId -> Cmd err [Text]
+selectDocsDates :: HasDBid NodeType => CorpusId -> DBCmd err [Text]
 selectDocsDates cId =  map (head' "selectDocsDates" . splitOn "-")
                    <$> catMaybes
                    <$> map (view hd_publication_date)
                    <$> selectDocs cId
 
-selectDocs :: HasDBid NodeType => CorpusId -> Cmd err [HyperdataDocument]
+selectDocs :: HasDBid NodeType => CorpusId -> DBCmd err [HyperdataDocument]
 selectDocs cId = runOpaQuery (queryDocs cId)
 
 queryDocs :: HasDBid NodeType => CorpusId -> O.Select (Column SqlJsonb)
@@ -207,7 +207,7 @@ queryDocs cId = proc () -> do
   restrict -< n ^. node_typename .== (sqlInt4 $ toDBid NodeDocument)
   returnA -< view node_hyperdata n
 
-selectDocNodes :: HasDBid NodeType =>CorpusId -> Cmd err [Node HyperdataDocument]
+selectDocNodes :: HasDBid NodeType => CorpusId -> DBCmd err [Node HyperdataDocument]
 selectDocNodes cId = runOpaQuery (queryDocNodes cId)
 
 queryDocNodes :: HasDBid NodeType =>CorpusId -> O.Select NodeRead
@@ -230,7 +230,7 @@ joinInCorpus = proc () -> do
 
 ------------------------------------------------------------------------
 selectPublicNodes :: HasDBid NodeType => (Hyperdata a, DefaultFromField SqlJsonb a)
-                  => Cmd err [(Node a, Maybe Int)]
+                  => DBCmd err [(Node a, Maybe Int)]
 selectPublicNodes = runOpaQuery (queryWithType NodeFolderPublic)
 
 queryWithType :: HasDBid NodeType

test/Test/Database/Operations.hs

@@ -64,6 +64,7 @@ tests = sequential $ aroundAll withTestDB $ describe "Database" $ do
       it "Can perform a simple search inside documents" corpusSearch01
       it "Can perform search by author in documents" corpusSearch02
       it "Can perform more complex searches using the boolean API" corpusSearch03
+      it "Can correctly count doc score" corpusScore01
 
 data ExpectedActual a =
     Expected a

test/Test/Database/Operations/DocumentSearch.hs

+{-|
+Module      : Test.Database.Operations.DocumentSearch
+Description : GarganText database tests
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes       #-}
+
 module Test.Database.Operations.DocumentSearch where
 
 import Prelude
 
+import Control.Lens (view)
 import Control.Monad.Reader
 import Data.Aeson.QQ.Simple
 import Data.Aeson.Types
-import Data.Maybe
+-- import Gargantext.API.Node.Update (updateDocs)
 import Gargantext.Core
+import Gargantext.Core.NLP (nlpServerGet)
 import Gargantext.Core.Types.Individu
 import Gargantext.Database.Action.Flow
 import Gargantext.Database.Action.Search
@@ -16,7 +29,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Document
 import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Tree.Root
 import Gargantext.Database.Schema.Node (NodePoly(..))
-import Network.URI (parseURI)
+-- import Network.URI (parseURI)
 
 import Test.Database.Types
 import Test.Hspec.Expectations
@@ -104,11 +117,6 @@ exampleDocument_04 = either error id $ parseEither parseJSON $ [aesonQQ|
 }
 |]
 
-nlpServerConfig :: NLPServerConfig
-nlpServerConfig =
-  let uri = parseURI "http://localhost:9000"
-  in NLPServerConfig CoreNLP (fromMaybe (error "parseURI for nlpServerConfig failed") uri)
-
 corpusAddDocuments :: TestEnv -> Assertion
 corpusAddDocuments env = do
   flip runReaderT env $ runTestMonad $ do
@@ -118,9 +126,11 @@ corpusAddDocuments env = do
     [corpus] <- getCorporaWithParentId parentId
     let corpusId = _node_id corpus
 
-    ids <- addDocumentsToHyperCorpus nlpServerConfig
+    let lang = EN
+    server <- view (nlpServerGet lang)
+    ids <- addDocumentsToHyperCorpus server
                                      (Just $ _node_hyperdata $ corpus)
-                                     (Multi EN)
+                                     (Multi lang)
                                      corpusId
                                      [exampleDocument_01, exampleDocument_02, exampleDocument_03, exampleDocument_04]
     liftIO $ length ids `shouldBe` 4
@@ -177,3 +187,24 @@ corpusSearch03 env = do
       length results1 `shouldBe` 1
       map facetDoc_title results2 `shouldBe` ["Haskell for OCaml programmers"]
       map facetDoc_title results3 `shouldBe` ["PyPlasm: computational geometry made easy", "Haskell for OCaml programmers"]
+
+-- | Check that the score doc count is correct
+--   TODO This test is unfinished because `updateDocs` needs more work
+corpusScore01 :: TestEnv -> Assertion
+corpusScore01 env = do
+  flip runReaderT env $ runTestMonad $ do
+
+    parentId <- getRootId (UserName userMaster)
+    [corpus] <- getCorporaWithParentId parentId
+
+    results <- searchInCorpus (_node_id corpus) False (mkQ "Haskell") Nothing Nothing Nothing
+
+    liftIO $ do
+      map facetDoc_title results `shouldBe` ["Haskell for OCaml programmers", "Rust for functional programmers"]
+
+      map facetDoc_score results `shouldBe` [Just 0.0, Just 0.0]
+
+    -- _ <- updateDocs (_node_id corpus)
+
+    liftIO $ do
+      map facetDoc_score results `shouldBe` [Just 0.0, Just 0.0]

test/Test/Database/Setup.hs

@@ -10,20 +10,21 @@ import Control.Monad
 import Data.Maybe (fromMaybe)
 import Data.Monoid
 import Data.Pool hiding (withResource)
+import Data.Pool qualified as Pool
 import Data.String
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Database.PostgreSQL.Simple qualified as PG
+import Database.PostgreSQL.Simple.Options qualified as Client
+import Database.PostgreSQL.Simple.Options qualified as Opts
+import Database.Postgres.Temp qualified as Tmp
+import Gargantext.API.Admin.EnvTypes (Mode(Mock))
 import Gargantext.Prelude.Config
+import Gargantext.System.Logging (withLoggerHoisted)
 import Paths_gargantext
 import Prelude
 import Shelly hiding (FilePath, run)
-import qualified Data.Pool as Pool
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as TE
-import qualified Database.PostgreSQL.Simple as PG
-import qualified Database.PostgreSQL.Simple.Options as Client
-import qualified Database.PostgreSQL.Simple.Options as Opts
-import qualified Database.Postgres.Temp as Tmp
-import qualified Shelly as SH
-
+import Shelly qualified as SH
 import Test.Database.Types
 
 -- | Test DB settings.
@@ -73,7 +74,8 @@ setup = do
                          (PG.close) 2 60 2
       bootstrapDB db pool gargConfig
       ugen <- emptyCounter
-      pure $ TestEnv (DBHandle pool db) gargConfig ugen
+      withLoggerHoisted Mock $ \logger -> do
+        pure $ TestEnv (DBHandle pool db) gargConfig ugen logger
 
 withTestDB :: (TestEnv -> IO ()) -> IO ()
 withTestDB = bracket setup teardown

test/Test/Database/Types.hs

+{-|
+Module      : Test.Database.Types
+Description : GarganText tests
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+-}
+
 {-# LANGUAGE TypeFamilies         #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans      #-}
@@ -10,18 +20,27 @@ import Control.Monad.Except
 import Control.Monad.Reader
 import Control.Monad.Trans.Control
 import Data.IORef
+import Data.Map qualified as Map
+import Data.Maybe (fromMaybe)
 import Data.Pool
+import Data.Text qualified as T
+import Database.PostgreSQL.Simple qualified as PG
+import Database.Postgres.Temp qualified as Tmp
 import Gargantext
 import Gargantext.API.Admin.EnvTypes
+import Gargantext.API.Admin.EnvTypes qualified as EnvTypes
 import Gargantext.API.Admin.Orchestrator.Types
 import Gargantext.API.Prelude
+import Gargantext.Core.Mail.Types (HasMail(..))
+import Gargantext.Core.NLP (HasNLPServer(..))
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Prelude.Config
+import Gargantext.Prelude.Mail.Types (MailConfig(..), LoginType(NoAuth))
+import Gargantext.System.Logging (HasLogger(..), Logger, MonadLogger(..))
 import Gargantext.Utils.Jobs
+import Network.URI (parseURI)
 import Prelude
-import qualified Database.PostgreSQL.Simple as PG
-import qualified Database.Postgres.Temp as Tmp
-import qualified Gargantext.API.Admin.EnvTypes as EnvTypes
+import System.Log.FastLogger qualified as FL
 
 newtype Counter = Counter { _Counter :: IORef Int }
   deriving Eq
@@ -39,6 +58,7 @@ data TestEnv = TestEnv {
     test_db                  :: !DBHandle
   , test_config              :: !GargConfig
   , test_usernameGen         :: !Counter
+  , test_logger              :: !(Logger (GargM TestEnv GargError))
   }
 
 newtype TestMonad a = TestMonad { runTestMonad :: ReaderT TestEnv IO a }
@@ -79,3 +99,40 @@ instance HasConnectionPool TestEnv where
 instance HasConfig TestEnv where
   hasConfig = to test_config
 
+instance HasMail TestEnv where
+  mailSettings = to $ const (MailConfig { _mc_mail_host       = "localhost"
+                                        , _mc_mail_port       = 25
+                                        , _mc_mail_user       = "test"
+                                        , _mc_mail_from       = "test@localhost"
+                                        , _mc_mail_password   = "test"
+                                        , _mc_mail_login_type = NoAuth })
+
+coreNLPConfig :: NLPServerConfig
+coreNLPConfig =
+  let uri = parseURI "http://localhost:9000"
+  in NLPServerConfig CoreNLP (fromMaybe (error "parseURI for nlpServerConfig failed") uri)
+
+
+instance HasNLPServer TestEnv where
+  nlpServer = to $ const (Map.singleton EN coreNLPConfig)
+
+instance MonadLogger (GargM TestEnv GargError) where
+  getLogger = asks test_logger
+
+instance HasLogger (GargM TestEnv GargError) where
+  data instance Logger (GargM TestEnv GargError) =
+    GargTestLogger {
+      test_logger_mode :: Mode
+    , test_logger_set  :: FL.LoggerSet
+    }
+  type instance LogInitParams (GargM TestEnv GargError) = Mode
+  type instance LogPayload (GargM TestEnv GargError)    = FL.LogStr
+  initLogger                = \mode -> do
+    test_logger_set <- liftIO $ FL.newStderrLoggerSet FL.defaultBufSize
+    pure $ GargTestLogger mode test_logger_set
+  destroyLogger             = \GargTestLogger{..}  -> liftIO $ FL.rmLoggerSet test_logger_set
+  logMsg = \(GargTestLogger mode logger_set) lvl msg -> do
+    let pfx = "[" <> show lvl <> "] "
+    when (lvl `elem` (modeToLoggingLevels mode)) $
+      liftIO $ FL.pushLogStrLn logger_set $ FL.toLogStr pfx <> msg
+  logTxt lgr lvl msg = logMsg lgr lvl (FL.toLogStr $ T.unpack msg)