[worker] add missing CLI.Worker module

parent a23870d5
Pipeline #6807 failed with stages
{-|
Module : Worker.hs
Description : Gargantext Job Worker
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
module CLI.Worker where
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.Types (SettingsFile(..))
import Gargantext.Core.Config.Worker (WorkerDefinition(..), WorkerSettings(..), findDefinitionByName)
import Gargantext.Core.Worker (withPGMQWorker)
import Gargantext.Core.Worker.Env (withWorkerEnv)
import Gargantext.Core.Worker.Jobs (sendJob)
import Gargantext.Core.Worker.Jobs.Types (Job(Ping))
import Gargantext.Prelude
import Options.Applicative
import Prelude qualified
-- TODO Command to spawn all workers at once
-- 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
let ___ = putStrLn ((List.concat
$ List.take 72
$ List.cycle ["_"]) :: Prelude.String)
___
putStrLn ("GarganText worker" :: Text)
putStrLn ("worker_name: " <> worker_name)
putStrLn ("worker toml: " <> _SettingsFile worker_toml)
___
withWorkerEnv worker_toml $ \env -> do
let gc = env ^. hasConfig
let ws = _gc_worker gc
case findDefinitionByName ws worker_name of
Nothing -> do
let workerNames = _wdName <$> (_wsDefinitions ws)
let availableWorkers = T.intercalate ", " workerNames
putStrLn ("Worker definition not found! Available workers: " <> availableWorkers)
Just wd -> do
putStrLn ("Starting worker '" <> worker_name <> "'")
putStrLn ("Worker settings: " <> show ws :: Text)
withPGMQWorker env wd $ \a _state -> do
runReaderT (sendJob Ping) env
wait a
workerCmd :: HasCallStack => Mod CommandFields CLI
workerCmd = command "worker" (info (helper <*> fmap CLISub worker_p) (progDesc "Gargantext worker."))
worker_p :: Parser CLICmd
worker_p = fmap CCMD_worker $ WorkerArgs
<$> settings_p
<*> strOption ( long "name"
<> metavar "STRING"
<> help "Worker name, as defined in the .toml file" )
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment