[CLI] worker subcommands (run & stats)

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

@@ -23,14 +23,14 @@ import Servant.Auth qualified as Servant
 
 routesCmd :: Mod CommandFields CLI
 routesCmd = command "routes" (info (helper <*> (fmap CLISub $ fmap CCMD_routes routesParser))
-                                   (progDesc "Server routes related commands."))
+                               (progDesc "Server routes related commands."))
 
 routesParser :: Parser CLIRoutes
 routesParser = hsubparser (
   (command "list" (info (helper <*> list_p)
-                                   (progDesc "List all the available routes, computed by the Routes types."))) <>
+                    (progDesc "List all the available routes, computed by the Routes types."))) <>
   (command "export" (info (helper <*> export_p)
-                                   (progDesc "Exports all the routes into a file, for golden-diff testing.")))
+                      (progDesc "Exports all the routes into a file, for golden-diff testing.")))
   )
 
 list_p :: Parser CLIRoutes

bin/gargantext-cli/CLI/Types.hs

@@ -80,12 +80,21 @@ data CLIRoutes
   | CLIR_export FilePath
   deriving (Show, Eq)
 
+data CLIWorker
+  = CLIW_run WorkerArgs
+  | CLIW_stats WorkerStatsArgs
+  deriving (Show, Eq)
+
 data WorkerArgs = WorkerArgs
   { worker_toml       :: !SettingsFile
   , worker_name       :: !Text
   , worker_run_single :: !Bool
   } deriving (Show, Eq)
 
+data WorkerStatsArgs = WorkerStatsArgs
+  { ws_toml       :: !SettingsFile
+  } deriving (Show, Eq)
+
 data CLICmd
   = CCMD_clean_csv_corpus
   | CCMD_filter_terms_and_cooc !CorpusFile !TermListFile !OutputFile
@@ -100,7 +109,7 @@ data CLICmd
   | CCMD_upgrade !UpgradeArgs
   | CCMD_golden_file_diff !GoldenFileDiffArgs
   | CCMD_routes !CLIRoutes
-  | CCMD_worker !WorkerArgs
+  | CCMD_worker !CLIWorker
   deriving (Show, Eq)
 
 data CLI =

bin/gargantext-cli/CLI/Worker.hs

@@ -12,14 +12,16 @@ Portability : POSIX
 
 module CLI.Worker where
 
+import Async.Worker.Broker.Types qualified as BT
+import Async.Worker.Types qualified as W
 import CLI.Types
 import CLI.Parsers
 import Data.List qualified as List (cycle, concat, take)
 import Data.Text qualified as T
-import Gargantext.Core.Config (hasConfig, _gc_worker)
+import Gargantext.Core.Config (hasConfig, gc_worker)
 import Gargantext.Core.Config.Types (SettingsFile(..))
 import Gargantext.Core.Config.Worker (WorkerDefinition(..), WorkerSettings(..), findDefinitionByName)
-import Gargantext.Core.Worker (withPGMQWorker, withPGMQWorkerSingle)
+import Gargantext.Core.Worker (withPGMQWorker, withPGMQWorkerSingle, initWorkerState)
 import Gargantext.Core.Worker.Env (withWorkerEnv)
 import Gargantext.Core.Worker.Jobs (sendJob)
 import Gargantext.Core.Worker.Jobs.Types (Job(Ping))
@@ -32,9 +34,8 @@ import Prelude qualified
 -- TODO Command to monitor queues
 -- TODO Support for KillWorkerSafely on Ctrl-C (so that the job in progress is moved back into the queue)
 
-workerCLI :: WorkerArgs -> IO ()
-workerCLI (WorkerArgs { .. }) = do
-
+workerCLI :: CLIWorker -> IO ()
+workerCLI (CLIW_run (WorkerArgs { .. })) = do
   let ___ = putStrLn ((List.concat
                        $ List.take 72
                        $ List.cycle ["_"]) :: Prelude.String)
@@ -46,8 +47,7 @@ workerCLI (WorkerArgs { .. }) = do
   ___
 
   withWorkerEnv worker_toml $ \env -> do
-    let gc = env ^. hasConfig
-    let ws = _gc_worker gc
+    let ws = env ^. hasConfig . gc_worker
     case findDefinitionByName ws worker_name of
       Nothing -> do
         let workerNames = _wdName <$> (_wsDefinitions ws)
@@ -61,15 +61,35 @@ workerCLI (WorkerArgs { .. }) = do
             wait a
         else
           withPGMQWorker env wd $ \a _state -> do
-            runReaderT (sendJob Ping) env
+            _ <- runReaderT (sendJob Ping) env
             wait a
+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 q = W.queueName state'
+              qs <- BT.getQueueSize (W.broker state') q
+              putStrLn ("Queue: " <> show q <> ", size: " <> show qs :: Text)
+              ) (_wsDefinitions ws)
 
 
 workerCmd :: HasCallStack => Mod CommandFields CLI
-workerCmd = command "worker" (info (helper <*> fmap CLISub worker_p) (progDesc "Gargantext worker."))
+workerCmd = command "worker" (info (helper <*> (fmap CLISub $ fmap CCMD_worker workerParser))
+                               (progDesc "Gargantext worker."))
 
-worker_p :: Parser CLICmd
-worker_p = fmap CCMD_worker $ WorkerArgs
+workerParser :: Parser CLIWorker
+workerParser = hsubparser (
+  (command "run" (info (helper <*> worker_p)
+                   (progDesc "Run a single worker"))) <>
+  (command "stats" (info (helper <*> stats_p)
+                     (progDesc "Print queue stats")))
+  )
+
+worker_p :: Parser CLIWorker
+worker_p = fmap CLIW_run $ WorkerArgs
   <$> settings_p
   <*> strOption ( long "name"
                 <> metavar "STRING"
@@ -77,3 +97,6 @@ worker_p = fmap CCMD_worker $ WorkerArgs
   <*> flag False True ( long "run-single"
                      <> help "Whether to loop or run a single job from queue" )
 
+stats_p :: Parser CLIWorker
+stats_p = fmap CLIW_stats $ WorkerStatsArgs
+  <$> settings_p

cabal.project

@@ -196,7 +196,7 @@ source-repository-package
 source-repository-package
     type: git
     location: https://gitlab.iscpif.fr/gargantext/haskell-bee
-    tag: d783198e1b7ca8a61e5332965db468da3faef796
+    tag: 00a4113992545d1e0a78b9f73a69ec527e79bd1b
 
 source-repository-package
     type: git

gargantext.cabal

@@ -740,6 +740,7 @@ common testDependencies
     , gargantext
     , gargantext-prelude
     , graphviz ^>= 2999.20.1.0
+    , haskell-bee
     , hspec ^>= 2.11.1
     , hspec-core
     , hspec-expectations >= 0.8 && < 0.9
@@ -861,7 +862,6 @@ test-suite garg-test-hspec
   import:
       defaults
     , testDependencies
-  build-depends: haskell-bee
   type: exitcode-stdio-1.0
   main-is: drivers/hspec/Main.hs
   other-modules: