bin/gargantext-cli/CLI/Server.hs

@@ -24,7 +24,7 @@ import GHC.IO.Encoding (setLocaleEncoding, utf8)
 import Gargantext.API (startGargantext)
 import Gargantext.API.Admin.EnvTypes (Mode(..))
 import Gargantext.Core.Config
-import Gargantext.Core.Config.Types (_SettingsFile)
+-- import Gargantext.Core.Config.Types (_SettingsFile)
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Prelude
 import Gargantext.System.Logging
@@ -39,25 +39,26 @@ withServerCLILogger ServerArgs{..} f = do
   withLogger (cfg ^. gc_logging) $ \logger -> f logger
 
 serverCLI :: CLIServer -> IO ()
-serverCLI (CLIS_start serverArgs) = withServerCLILogger serverArgs $ \ioLogger ->
-  startServerCLI ioLogger serverArgs
+serverCLI (CLIS_start serverArgs) = startServerCLI serverArgs
 
-serverCLI (CLIS_startAll serverArgs@(ServerArgs { .. })) = withServerCLILogger serverArgs $ \ioLogger -> do
-  withAsync (startServerCLI ioLogger serverArgs) $ \aServer -> do
-    res <- Async.race (runAllWorkers ioLogger server_toml) (waitCatch aServer)
+serverCLI (CLIS_startAll serverArgs@(ServerArgs { .. })) = do
+  withAsync (startServerCLI serverArgs) $ \aServer -> do
+    res <- Async.race (runAllWorkers server_toml) (waitCatch aServer)
     case res of
       Left ()  -> pure ()
       Right (Left ex)
         -> do
-          $(logLoc) ioLogger ERROR $ "Exception raised when running the server:\n\n" <> T.pack (displayException ex)
-          exitFailure
+          panicTrace $ "Exception raised when running the server:\n\n" <> T.pack (displayException ex)
+          -- exitFailure
       Right (Right ())
         -> pure ()
 
-serverCLI (CLIS_version) = withLogger (LogConfig Nothing DEBUG) $ \ioLogger -> do
+serverCLI (CLIS_version) = withLogger dummyLogConfig $ \ioLogger -> do
     -- Sets the locale to avoid encoding issues like in #284.
   setLocaleEncoding utf8
   logMsg ioLogger INFO $ "Version: " <> showVersion PG.version
+  where
+    dummyLogConfig = LogConfig { _lc_log_file = Nothing, _lc_log_level = DEBUG}
 
 
 serverCmd :: HasCallStack => Mod CommandFields CLI
@@ -104,14 +105,15 @@ version_p :: Parser CLIServer
 version_p = pure CLIS_version
 
 
-startServerCLI :: Logger IO -> ServerArgs -> IO ()
-startServerCLI ioLogger (ServerArgs { .. }) = do
-  logMsg ioLogger INFO $ "starting server, mode: " <> show server_mode <> ", port: " <> show server_port <> ", config: " <> _SettingsFile server_toml
+startServerCLI :: ServerArgs -> IO ()
+startServerCLI (ServerArgs { .. }) = do
+  -- logMsg ioLogger INFO $ "starting server, mode: " <> show server_mode <> ", port: " <> show server_port <> ", config: " <> _SettingsFile server_toml
   -- Sets the locale to avoid encoding issues like in #284.
   setLocaleEncoding utf8
 
   when (server_mode == Mock) $ do
-    logMsg ioLogger ERROR "Mock mode not supported!"
-    exitFailure
+    -- logMsg ioLogger ERROR "Mock mode not supported!"
+    panicTrace "Mock mode not supported!"
+    -- exitFailure
 
   startGargantext server_mode server_port server_toml

bin/gargantext-cli/CLI/Server/Routes.hs

@@ -14,8 +14,8 @@ import Data.Aeson.Encode.Pretty
 import Data.ByteString qualified as B
 import Data.ByteString.Lazy qualified as BL
 import Gargantext.API.Routes.Named
+import Gargantext.Prelude
 import Options.Applicative
-import Prelude
 import Servant.API
 import Servant.API.Routes
 import Servant.API.WebSocket qualified as WS (WebSocketPending)
@@ -52,6 +52,6 @@ instance HasRoutes Raw where
 routesCLI :: CLIRoutes -> IO ()
 routesCLI = \case
   CLIR_list
-    -> printRoutes @(NamedRoutes API)
+    -> printRoutesSorted @(NamedRoutes API)
   (CLIR_export filePath)
     -> B.writeFile filePath . BL.toStrict $ encodePretty (getRoutes @(NamedRoutes API))

bin/gargantext-cli/CLI/Worker.hs

@@ -17,20 +17,18 @@ import Async.Worker.Types qualified as W
 import CLI.Types
 import CLI.Parsers
 import Control.Concurrent.Async (forConcurrently_)
-import Data.List qualified as List (cycle, concat, take)
 import Data.Text qualified as T
-import Gargantext.Core.Config (hasConfig, gc_worker, gc_logging)
+import Gargantext.Core.Config (hasConfig, gc_worker)
 import Gargantext.Core.Config.Types (SettingsFile(..))
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Config.Worker (WorkerDefinition(..), WorkerSettings(..), findDefinitionByName)
 import Gargantext.Core.Worker (withPGMQWorkerCtrlC, withPGMQWorkerSingleCtrlC, initWorkerState)
-import Gargantext.Core.Worker.Env (withWorkerEnv)
+import Gargantext.Core.Worker.Env (withWorkerEnv, runWorkerMonad)
 -- import Gargantext.Core.Worker.Jobs (sendJob)
 -- import Gargantext.Core.Worker.Jobs.Types (Job(Ping))
 import Gargantext.Prelude
-import Gargantext.System.Logging (withLogger, logMsg, LogLevel(..), Logger)
+import Gargantext.System.Logging (logM, LogLevel(..))
 import Options.Applicative
-import Prelude qualified
 
 
 -- TODO Command to monitor queues
@@ -38,60 +36,48 @@ import Prelude qualified
 
 workerCLI :: CLIWorker -> IO ()
 workerCLI (CLIW_run (WorkerArgs { .. })) = do
-  let ___ = putStrLn ((List.concat
-                       $ List.take 72
-                       $ List.cycle ["_"]) :: Prelude.String)
-
-  withWorkerEnv worker_toml $ \env -> do
-    let log_cfg = env ^. hasConfig . gc_logging
-    withLogger log_cfg $ \ioLogger -> do
-      ___
-      logMsg ioLogger INFO "GarganText worker"
-      logMsg ioLogger INFO $ "worker_name: " <> T.unpack worker_name
-      logMsg ioLogger INFO $ "worker toml: " <> _SettingsFile worker_toml
-      ___
-      
-      let ws = env ^. hasConfig . gc_worker
-      case findDefinitionByName ws worker_name of
-        Nothing -> do
-          let workerNames = _wdName <$> (_wsDefinitions ws)
-          let availableWorkers = T.intercalate ", " workerNames
-          putText $ "Worker definition not found! Available workers: " <> availableWorkers
-        Just wd -> do
-          logMsg ioLogger INFO $ "Starting worker '" <> T.unpack worker_name <> "'"
-          logMsg ioLogger DEBUG $ "gc config: " <> show (env ^. hasConfig)
-          logMsg ioLogger DEBUG $ "Worker settings: " <> show ws
-          ___
-          if worker_run_single then
-            withPGMQWorkerSingleCtrlC env wd $ \a _state -> do
-              wait a
-          else
-            withPGMQWorkerCtrlC env wd $ \a _state -> do
-              -- _ <- runReaderT (sendJob Ping) env
-              wait a
-workerCLI (CLIW_runAll (WorkerAllArgs { .. })) = withWorkerEnv worker_toml $ \env -> do
-  let log_cfg = env ^. hasConfig . gc_logging
-  withLogger log_cfg $ \ioLogger -> runAllWorkers ioLogger worker_toml
+  cfg <- readConfig worker_toml
+  let ws = cfg ^. gc_worker
+  case findDefinitionByName ws worker_name of
+    Nothing -> do
+      let workerNames = _wdName <$> (_wsDefinitions ws)
+      let availableWorkers = T.intercalate ", " workerNames
+      panicTrace $ "Worker definition not found! Available workers: " <> availableWorkers
+    Just wd -> do
+      withWorkerEnv worker_toml (T.unpack worker_name) $ \env -> do
+        runWorkerMonad env $ do
+          logM INFO $ "Starting worker '" <> worker_name <> "'"
+          logM DEBUG $ "gc config: " <> show (env ^. hasConfig)
+          logM DEBUG $ "Worker settings: " <> show ws
+        if worker_run_single then
+          withPGMQWorkerSingleCtrlC env wd $ \a _state -> do
+            wait a
+        else
+          withPGMQWorkerCtrlC env wd $ \a _state -> do
+            -- _ <- runReaderT (sendJob Ping) env
+            wait a
+workerCLI (CLIW_runAll (WorkerAllArgs { .. })) = do
+  runAllWorkers worker_toml
 workerCLI (CLIW_stats (WorkerStatsArgs { .. })) = do
-  putStrLn ("worker toml: " <> _SettingsFile ws_toml)
-
-  withWorkerEnv ws_toml $ \env -> do
-    let ws = env ^. hasConfig . gc_worker
-    mapM_ (\wd -> do
-              state' <- initWorkerState env wd
-              let b = W.broker state'
-              let q = W.queueName state'
-              qs <- BT.getQueueSize b q
-              msgIds <- BT.listPendingMessageIds b q
-              putStrLn ("Queue: " <> show q <> ", size: " <> show qs :: Text)
-              putStrLn ("  Messages: " :: Text)
-              mapM_ (\msgId -> do
-                        mm <- BT.getMessageById b q msgId
+  cfg <- readConfig ws_toml
+  let ws = cfg ^. gc_worker
+  mapM_ (\wd -> withWorkerEnv ws_toml (T.unpack $ _wdName wd) $ \env -> do
+            state' <- initWorkerState env wd
+            let b = W.broker state'
+            let q = W.queueName state'
+            qs <- BT.getQueueSize b q
+            msgIds <- BT.listPendingMessageIds b q
+            runWorkerMonad env $ do
+              logM INFO $ ("Queue: " <> show q <> ", size: " <> show qs :: Text)
+              logM INFO $ ("  Messages: " :: Text)
+            mapM_ (\msgId -> do
+                      mm <- BT.getMessageById b q msgId
+                      runWorkerMonad env $ do
                         case mm of
-                          Nothing -> putStrLn ("  - " <> show msgId <> " :: NOTHING!" :: Text)
-                          Just m -> putStrLn ("  - " <> show m :: Text)
-                        ) msgIds
-              ) (_wsDefinitions ws)
+                          Nothing -> logM ERROR ("  - " <> show msgId <> " :: NOTHING!" :: Text)
+                          Just m -> logM INFO ("  - " <> show m :: Text)
+                      ) msgIds
+            ) (_wsDefinitions ws)
 
 
 workerCmd :: HasCallStack => Mod CommandFields CLI
@@ -135,12 +121,13 @@ stats_p = fmap CLIW_stats $ WorkerStatsArgs
 -- loop for the workers, so beware when using this, make sure that the calling
 -- code is using this properly (for example along the use of 'race' or a similar
 -- function from async).
-runAllWorkers :: Logger IO -> SettingsFile -> IO ()
-runAllWorkers ioLogger worker_toml = do
+runAllWorkers :: SettingsFile -> IO ()
+runAllWorkers worker_toml = do
   cfg <- readConfig worker_toml
   let ws = cfg ^. gc_worker
   forConcurrently_ (_wsDefinitions ws) $ \wd -> do
-    withWorkerEnv worker_toml $ \env -> do
-      logMsg ioLogger INFO $ "Starting worker '" <> T.unpack (_wdName wd) <> "' (queue " <> show (_wdQueue wd) <> ")"
+    withWorkerEnv worker_toml (T.unpack $ _wdName wd) $ \env -> do
+      runWorkerMonad env $ do
+        logM INFO $ "Starting worker '" <> _wdName wd <> "' (queue " <> show (_wdQueue wd) <> ")"
       withPGMQWorkerCtrlC env wd $ \a _state -> do
         wait a

cabal.project

@@ -146,7 +146,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://github.com/fpringle/servant-routes.git
-    tag: 7694f62af6bc1596d754b42af16da131ac403b3a
+    tag: c3c558d9278ef239a474f1e1b69afc461be60d01
 
 source-repository-package
     type: git

gargantext.cabal

@@ -120,7 +120,6 @@ library
       Gargantext.API.Admin.Orchestrator.Types
       Gargantext.API.Admin.Settings
       Gargantext.API.Auth.PolicyCheck
-      Gargantext.API.Count.Types
       Gargantext.API.Dev
       Gargantext.API.Errors
       Gargantext.API.Errors.Class
@@ -166,7 +165,6 @@ library
       Gargantext.API.Routes.Named.Contact
       Gargantext.API.Routes.Named.Context
       Gargantext.API.Routes.Named.Corpus
-      Gargantext.API.Routes.Named.Count
       Gargantext.API.Routes.Named.Document
       Gargantext.API.Routes.Named.EKG
       Gargantext.API.Routes.Named.File
@@ -332,7 +330,6 @@ library
       Gargantext.API.Admin.Auth
       Gargantext.API.Admin.FrontEnd
       Gargantext.API.Context
-      Gargantext.API.Count
       Gargantext.API.EKG
       Gargantext.API.GraphQL
       Gargantext.API.GraphQL.Annuaire

nix/pkgs.nix

@@ -19,6 +19,7 @@ rec {
     ghc966
     cabal_install
     pkgs.haskellPackages.alex
+    pkgs.haskellPackages.ghcid
     pkgs.haskellPackages.happy
     pkgs.haskellPackages.pretty-show
   ];

src/Gargantext/API/Count.hs

-{-|
-Module      : Gargantext.API.Count
-Description : Server API
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
-Count API part of Gargantext.
--}
-
-{-# OPTIONS_GHC -fno-warn-deprecations #-}
-
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE TypeOperators      #-}
-{-# LANGUAGE DeriveAnyClass     #-}
-
-module Gargantext.API.Count (
-    countAPI
-  ) where
-
-import Gargantext.API.Count.Types
-import Gargantext.API.Routes.Named.Count qualified as Named
-import Gargantext.Prelude
-import Servant.Server.Generic (AsServerT)
-
------------------------------------------------------------------------
--- TODO-ACCESS: CanCount
--- TODO-EVENTS: No events as this is a read only query.
------------------------------------------------------------------------
-countAPI :: Query -> Named.CountAPI (AsServerT m)
-countAPI _ = Named.CountAPI undefined

src/Gargantext/API/Count/Types.hs

-{-|
-Module      : Gargantext.API.Count.Types
-Description : 
-Copyright   : (c) CNRS, 2017-Present
-License     : AGPL + CECILL v3
-Maintainer  : team@gargantext.org
-Stability   : experimental
-Portability : POSIX
-
--}
-
-{-# LANGUAGE TemplateHaskell    #-}
-
-module Gargantext.API.Count.Types (
-    Scraper(..)
-  , QueryBool(..)
-  , Query(..)
-  , Message(..)
-  , Code
-  , Error
-  , Errors
-  , Counts(..)
-  , Count(..)
-
-  -- * functions
-  , scrapers
-  ) where
-
-import Data.Swagger ( ToSchema(..), genericDeclareNamedSchema )
-import Data.Text (pack)
-import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
-import Gargantext.Prelude
-import Test.QuickCheck (elements)
-import Test.QuickCheck.Arbitrary (Arbitrary(..))
-
------------------------------------------------------------------------
-data Scraper = Pubmed | Hal | IsTex | Isidore
-  deriving (Eq, Show, Generic, Enum, Bounded)
-
-scrapers :: [Scraper]
-scrapers = [minBound..maxBound]
-
-instance FromJSON Scraper
-instance ToJSON   Scraper
-
-instance Arbitrary Scraper where
-    arbitrary = elements scrapers
-
-instance ToSchema Scraper
-
------------------------------------------------------------------------
-data QueryBool = QueryBool Text
-        deriving (Eq, Show, Generic)
-
-queries :: [QueryBool]
-queries =  [QueryBool (pack "(X OR X') AND (Y OR Y') NOT (Z OR Z')")]
---queries =  [QueryBool (pack "(X + X') * (Y + Y') - (Z + Z')")]
-
-instance Arbitrary QueryBool where
-    arbitrary = elements queries
-
-instance FromJSON QueryBool
-instance ToJSON   QueryBool
-
-instance ToSchema QueryBool
------------------------------------------------------------------------
-
-data Query = Query { query_query :: QueryBool
-                   , query_name  :: Maybe [Scraper]
-                   }
-                   deriving (Eq, Show, Generic)
-instance FromJSON Query
-instance ToJSON   Query
-
-instance Arbitrary Query where
-    arbitrary = elements [ Query q (Just n) 
-                         | q <- queries
-                         , n <- take 10 $ permutations scrapers
-                         ]
-
-instance ToSchema Query where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "query_")
-
------------------------------------------------------------------------
-type Code = Integer
-type Error  = Text
-type Errors = [Error]
-
------------------------------------------------------------------------
-data Message = Message Code Errors
-        deriving (Eq, Show, Generic)
-
-toMessage :: [(Code, Errors)] -> [Message]
-toMessage = map (\(c,err) -> Message c err)
-
-messages :: [Message]
-messages =  toMessage $ [ (400, ["Ill formed query             "])
-                        , (300, ["API connexion error          "])
-                        , (300, ["Internal Gargantext Error    "])
-                        ] <> take 10 ( repeat (200, [""]))
-
-instance Arbitrary Message where
-    arbitrary = elements messages
-
-instance ToSchema Message
------------------------------------------------------------------------
-data Counts = Counts { results :: [Either Message Count]
-                     } deriving (Eq, Show, Generic)
-
-
-instance Arbitrary Counts where
-    arbitrary = elements [Counts [ Right (Count Pubmed (Just 20 ))
-                                 , Right (Count IsTex  (Just 150))
-                                 , Right (Count Hal    (Just 150))
-                                 ]
-                         ]
-
-instance ToSchema Counts
-
------------------------------------------------------------------------
-data Count = Count { count_name    :: Scraper
-                   , count_count   :: Maybe Int
-                   }
-                   deriving (Eq, Show, Generic)
-
-instance ToSchema Count where
-  declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "count_")
---instance Arbitrary Count where
---    arbitrary = Count <$> arbitrary <*> arbitrary <*> arbitrary
-
---
--- JSON instances
---
-
-instance FromJSON Message
-instance ToJSON   Message
-
-$(deriveJSON (unPrefix "count_") ''Count)
-
-instance FromJSON Counts
-instance ToJSON   Counts
-

src/Gargantext/API/Node.hs

@@ -133,7 +133,7 @@ catApi :: CorpusId -> GargServer CatApi
 catApi cId cs' = do
   ret <- nodeContextsCategory $ map (\n -> (cId, n, ntc_category cs')) (ntc_nodesId cs')
   lId <- defaultList cId
-  _ <- updateChart cId (Just lId) Docs Nothing
+  _ <- updateChart cId (Just lId) Docs
   pure ret
 
 ------------------------------------------------------------------------

src/Gargantext/API/Node/Update.hs

@@ -92,11 +92,11 @@ updateNode lId (UpdateNodeParamsList Advanced) jobHandle = do
 
   _ <- case corpusId of
     Just cId -> do
-      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Authors Nothing
+      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Authors
       markProgress 1 jobHandle
       _ <- Metrics.updateTree cId (Just lId) NgramsTypes.Institutes MapTerm
       markProgress 1 jobHandle
-      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Sources Nothing
+      _ <- Metrics.updatePie cId (Just lId) NgramsTypes.Sources
       pure ()
     Nothing  -> pure ()
 
@@ -197,7 +197,7 @@ updateDocs cId jobHandle = do
   markProgress 1 jobHandle
   _ <- updateContextScore      cId lId
   markProgress 1 jobHandle
-  _ <- Metrics.updateChart'    cId lId NgramsTypes.Docs Nothing
+  _ <- Metrics.updateChart'    cId lId NgramsTypes.Docs
   markProgress 1 jobHandle
   -- printDebug "updateContextsScore" (cId, lId, u)
   pure ()

src/Gargantext/API/Routes/Named/Contact.hs

@@ -10,12 +10,12 @@ module Gargantext.API.Routes.Named.Contact (
   ) where
 
 
-import GHC.Generics (Generic)
 import Gargantext.API.Node.Contact.Types (AddContactParams(..))
 import Gargantext.API.Routes.Named.Node (NodeNodeAPI(..))
 import Gargantext.API.Worker (WorkerAPI)
 import Gargantext.Database.Admin.Types.Hyperdata.Contact (HyperdataContact)
 import Gargantext.Database.Admin.Types.Node (NodeId)
+import GHC.Generics (Generic)
 import Servant
 
 

src/Gargantext/API/Routes/Named/Count.hs

-{-# LANGUAGE TypeOperators #-}
-
-module Gargantext.API.Routes.Named.Count (
-  -- * Routes types
-    CountAPI(..)
-
-  -- * Re-exports
-  , module X
-  ) where
-
-import GHC.Generics (Generic)
-import Gargantext.API.Count.Types as X
-import Servant
-
-
-newtype CountAPI mode = CountAPI
-  { postCountsEp :: mode :- Post '[JSON] X.Counts
-  } deriving Generic

src/Gargantext/API/Routes/Named/Metrics.hs

+{-|
+Module      : Gargantext.API.Routes.Named.Metrics
+Description : Server API
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+Metrics API routes
+
+-}
+
 {-# LANGUAGE TypeOperators #-}
 
 module Gargantext.API.Routes.Named.Metrics (
@@ -10,7 +23,6 @@ module Gargantext.API.Routes.Named.Metrics (
   ) where
 
 import Data.Text (Text)
-import Data.Time (UTCTime)
 import Data.Vector (Vector)
 import GHC.Generics (Generic)
 import Gargantext.API.HashedResponse (HashedResponse)
@@ -26,8 +38,6 @@ import Servant
 
 data TreeAPI mode = TreeAPI
   { treeChartEp       :: mode :- Summary " Tree API"
-                              :> QueryParam "from" UTCTime
-                              :> QueryParam "to"   UTCTime
                               :> QueryParam  "list"       ListId
                               :> QueryParamR "ngramsType" TabType
                               :> QueryParamR "listType"   ListType
@@ -50,7 +60,6 @@ data ScatterAPI mode = ScatterAPI
   { sepGenEp :: mode :- Summary "SepGen IncExc metrics"
                      :> QueryParam  "list"       ListId
                      :> QueryParamR "ngramsType" TabType
-                     :> QueryParam  "limit"      Limit
                      :> Get '[JSON] (HashedResponse Metrics)
   , scatterUpdateEp :: mode :- Summary "Scatter update"
                             :> QueryParam  "list"       ListId
@@ -67,15 +76,12 @@ data ScatterAPI mode = ScatterAPI
 
 data PieAPI mode = PieAPI
   { getPieChartEp :: mode :- Summary "Pie Chart"
-                          :> QueryParam "from" UTCTime
-                          :> QueryParam "to"   UTCTime
                           :> QueryParam  "list"       ListId
                           :> QueryParamR "ngramsType" TabType
                           :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
   , pieChartUpdateEp :: mode :- Summary "Pie Chart update"
                              :> QueryParam  "list"       ListId
                              :> QueryParamR "ngramsType" TabType
-                             :> QueryParam  "limit"      Limit
                              :> Post '[JSON] ()
   , pieHashEp :: mode :- "hash"
                       :> Summary "Pie Hash"
@@ -87,15 +93,12 @@ data PieAPI mode = PieAPI
 
 data ChartAPI mode = ChartAPI
   { getChartEp :: mode :- Summary " Chart API"
-                       :> QueryParam "from" UTCTime
-                       :> QueryParam "to"   UTCTime
                        :> QueryParam  "list"       ListId
                        :> QueryParamR "ngramsType" TabType
                        :> Get '[JSON] (HashedResponse (ChartMetrics Histo))
   , updateChartEp :: mode :- Summary "Chart update"
                           :> QueryParam  "list"       ListId
                           :> QueryParamR "ngramsType" TabType
-                          :> QueryParam  "limit"      Limit
                           :> Post '[JSON] ()
   , chartHashEp :: mode :- "hash"
                         :> Summary "Chart Hash"

src/Gargantext/API/Routes/Named/Private.hs

@@ -30,7 +30,6 @@ import Gargantext.API.Auth.PolicyCheck (PolicyChecked)
 import Gargantext.API.Routes.Named.Contact (ContactAPI)
 import Gargantext.API.Routes.Named.Context (ContextAPI)
 import Gargantext.API.Routes.Named.Corpus (AddWithTempFile, AddWithQuery, CorpusExportAPI, MakeSubcorpusAPI)
-import Gargantext.API.Routes.Named.Count (CountAPI, Query)
 import Gargantext.API.Routes.Named.Document (DocumentExportAPI)
 import Gargantext.API.Routes.Named.List (GETAPI, JSONAPI, TSVAPI)
 import Gargantext.API.Routes.Named.Node
@@ -81,9 +80,6 @@ data GargPrivateAPI' mode = GargPrivateAPI'
                                          :> NamedRoutes DocumentExportAPI
   , phyloExportAPI    :: mode :- "phylo" :> Capture "node_id" DocId
                                          :> NamedRoutes PhyloExportAPI
-  , countAPI :: mode :- "count" :> Summary "Count endpoint"
-                                :> ReqBody '[JSON] Query
-                                :> NamedRoutes CountAPI
   , graphAPI :: mode :- "graph" :> Summary "Graph endpoint"
                                 :> Capture "graph_id" NodeId
                                 :> NamedRoutes GraphAPI

src/Gargantext/API/Search.hs

 {-|
-Module      : Gargantext.API.Count
+Module      : Gargantext.API.Search
 Description : Server API
 Copyright   : (c) CNRS, 2017-Present
 License     : AGPL + CECILL v3

src/Gargantext/API/Server/Named/Ngrams.hs

@@ -75,7 +75,8 @@ apiNgramsAsync nId =
     }
 
 tableNgramsPostChartsAsync :: ( HasNodeStory env err m
-                              , MonadJobStatus m )
+                              , MonadJobStatus m
+                              , MonadLogger m )
                             => UpdateTableNgramsCharts
                             -> JobHandle m
                             -> m ()
@@ -101,7 +102,7 @@ tableNgramsPostChartsAsync utn jobHandle = do
             Authors -> do
               -- printDebug "[tableNgramsPostChartsAsync] Authors, updating Pie, cId" cId
               markStarted 1 jobHandle
-              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              _ <- Metrics.updatePie cId (Just listId) tabType
               markComplete jobHandle
             Institutes -> do
               -- printDebug "[tableNgramsPostChartsAsync] Institutes, updating Tree, cId" cId
@@ -118,7 +119,7 @@ tableNgramsPostChartsAsync utn jobHandle = do
             Sources -> do
               -- printDebug "[tableNgramsPostChartsAsync] Sources, updating chart, cId" cId
               markStarted 1 jobHandle
-              _ <- Metrics.updatePie cId (Just listId) tabType Nothing
+              _ <- Metrics.updatePie cId (Just listId) tabType
               markComplete jobHandle
             Terms -> do
               -- printDebug "[tableNgramsPostChartsAsync] Terms, updating Metrics (Histo), cId" cId

src/Gargantext/API/Server/Named/Private.hs

@@ -5,7 +5,6 @@ module Gargantext.API.Server.Named.Private where
 import Gargantext.API.Admin.Auth.Types (AuthenticatedUser(..))
 import Gargantext.API.Admin.EnvTypes (Env)
 import Gargantext.API.Context (contextAPI)
-import Gargantext.API.Count qualified as Count
 import Gargantext.API.Errors.Types (BackendInternalError)
 import Gargantext.API.Members (members)
 import Gargantext.API.Ngrams.List qualified as List
@@ -54,7 +53,6 @@ serverPrivateGargAPI' authenticatedUser@(AuthenticatedUser userNodeId userId)
        , tableNgramsAPI    = apiNgramsTableDoc authenticatedUser
        , phyloExportAPI    = PhyloExport.api userNodeId
        , documentExportAPI = documentExportAPI userNodeId
-       , countAPI          = Count.countAPI
        , graphAPI          = Viz.graphAPI authenticatedUser userId
        , treeAPI           = Tree.treeAPI authenticatedUser
        , treeFlatAPI       = Tree.treeFlatAPI authenticatedUser

src/Gargantext/Core/Worker/Env.hs

@@ -20,7 +20,7 @@ module Gargantext.Core.Worker.Env where
 
 import Control.Concurrent.STM.TVar (TVar, modifyTVar, newTVarIO, readTVarIO)
 import Control.Exception.Safe qualified as CES
-import Control.Lens (prism', to, view)
+import Control.Lens (prism', to, view, (%~), _Just)
 import Control.Lens.TH
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Data.Maybe (fromJust)
@@ -31,7 +31,7 @@ import Gargantext.API.Job (RemainingSteps(..), jobLogStart, jobLogProgress, jobL
 import Gargantext.API.Prelude (GargM)
 import Gargantext.Core.Notifications.CentralExchange qualified as CE
 import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
-import Gargantext.Core.Config (GargConfig(..), HasConfig(..), gc_logging, LogConfig)
+import Gargantext.Core.Config (GargConfig(..), HasConfig(..), gc_logging, LogConfig, lc_log_file)
 import Gargantext.Core.Config.Mail qualified as Mail
 import Gargantext.Core.Config.Utils (readConfig)
 import Gargantext.Core.Config.Types (SettingsFile(..))
@@ -48,6 +48,7 @@ import Gargantext.System.Logging (HasLogger(..), Logger, LogLevel(..), MonadLogg
 import Gargantext.Utils.Jobs.Monad ( MonadJobStatus(..), JobHandle )
 import GHC.IO.Exception (IOException(..), IOErrorType(OtherError))
 import Prelude qualified
+import System.FilePath ((</>), takeDirectory, takeFileName, takeBaseName, takeExtension)
 import System.Log.FastLogger qualified as FL
 import Gargantext.System.Logging.Loggers
 
@@ -69,10 +70,20 @@ data WorkerJobState = WorkerJobState
   deriving (Show, Eq)
 
 
-withWorkerEnv :: SettingsFile -> (WorkerEnv -> IO a) -> IO a
-withWorkerEnv settingsFile k = do
+withWorkerEnv :: SettingsFile -> Prelude.String -> (WorkerEnv -> IO a) -> IO a
+withWorkerEnv settingsFile workerName k = do
   cfg <- readConfig settingsFile
-  withLoggerIO (cfg ^. gc_logging) $ \logger -> do
+  -- each worker should have it's own log file, not to conflict with the server
+  let modifyFileName path = dir </> (base ++ suffix ++ ext)
+        where
+          dir = takeDirectory path
+          filename = takeFileName path
+          base = takeBaseName filename
+          ext = takeExtension filename
+          suffix = "-worker-" <> workerName
+  let workerLogging = (lc_log_file . _Just) %~ modifyFileName $ cfg ^. gc_logging
+  putText $ "workerLogging: " <> show workerLogging
+  withLoggerIO workerLogging $ \logger -> do
     env <- newWorkerEnv logger cfg
     k env -- `finally` cleanEnv env
 

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

@@ -446,11 +446,11 @@ getOrMkList pId uId =
       mkList' pId' uId' = insertDefaultNode NodeList pId' uId'
 
 -- | TODO remove defaultList
-defaultList :: (HasNodeError err, HasDBid NodeType) => CorpusId -> DBCmd err ListId
+defaultList :: (HasNodeError err) => CorpusId -> DBCmd err ListId
 defaultList cId =
   maybe (nodeError (NoListFound cId)) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
-getListsWithParentId :: HasDBid NodeType => NodeId -> DBCmd err [Node HyperdataList]
+getListsWithParentId :: NodeId -> DBCmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
 
 -- | Returns the /root/ public node for the input user. By root we mean that

src/Gargantext/System/Logging/Loggers.hs

@@ -33,7 +33,7 @@ data IOStdLogger =
               }
 
 ioStdLogger :: LogConfig -> IO IOStdLogger
-ioStdLogger LogConfig{..} = do
+ioStdLogger LogConfig { _lc_log_file = Nothing, _lc_log_level } = do
   let minLvl = _lc_log_level
   let log_msg lvl msg = do
         t <- getCurrentTime
@@ -46,6 +46,21 @@ ioStdLogger LogConfig{..} = do
     , _iosl_log_msg   = log_msg
     , _iosl_log_txt = \lvl msg -> log_msg lvl (T.unpack msg)
     }
+ioStdLogger LogConfig { _lc_log_file = Just fpath, _lc_log_level } = do
+  let minLvl = _lc_log_level
+  let logType = FL.LogFileNoRotate fpath FL.defaultBufSize
+  (logger, loggerClose) <- FL.newFastLogger logType
+  let log_msg lvl msg = do
+        t <- getCurrentTime
+        when (lvl >= minLvl) $ do
+          let pfx = "[" <> show t <> "] [" <> show lvl <> "] "
+          logger $ FL.toLogStr $ pfx <> msg
+  pure $ IOStdLogger
+    { _iosl_log_level = minLvl
+    , _iosl_destroy   = loggerClose
+    , _iosl_log_msg   = log_msg
+    , _iosl_log_txt = \lvl msg -> log_msg lvl (T.unpack msg)
+    }
 
 -- | A monadic standard logger powered by fast-logger underneath.
 data MonadicStdLogger payload m =