src/Gargantext/Utils/Jobs.hs

   1 module Gargantext.Utils.Jobs where
   2
   3 import Control.Monad.Except
   4 import Control.Monad.Reader
   5 import Prelude
   6 import System.Directory (doesFileExist)
   7 import Text.Read (readMaybe)
   8
   9 import Gargantext.API.Admin.EnvTypes
  10 import Gargantext.API.Admin.Orchestrator.Types (JobLog)
  11 import Gargantext.API.Prelude
  12 import qualified Gargantext.Utils.Jobs.API as API
  13 import Gargantext.Utils.Jobs.Map
  14 import Gargantext.Utils.Jobs.Monad
  15
  16 import qualified Servant.Job.Async as SJ
  17
  18 jobErrorToGargError
  19   :: JobError -> GargError
  20 jobErrorToGargError = GargJobError
  21
  22 serveJobsAPI
  23   :: Foldable callbacks
  24   => GargJob
  25   -> (input -> Logger JobLog -> GargM Env GargError JobLog)
  26   -> JobsServerAPI ctI ctO callbacks input
  27 serveJobsAPI t f = API.serveJobsAPI ask t jobErrorToGargError $ \env i l -> do
  28   putStrLn ("Running job of type: " ++ show t)
  29   runExceptT $ runReaderT (f i l) env
  30
  31 type JobsServerAPI ctI ctO callbacks input =
  32   SJ.AsyncJobsServerT' ctI ctO callbacks JobLog input JobLog
  33                        (GargM Env GargError)
  34
  35 parseGargJob :: String -> Maybe GargJob
  36 parseGargJob s = case s of
  37   "tablengrams" -> Just TableNgramsJob
  38   "forgotpassword" -> Just ForgotPasswordJob
  39   "updatengramslistjson" -> Just UpdateNgramsListJobJSON
  40   "updatengramslistcsv" -> Just UpdateNgramsListJobCSV
  41   "addcontact" -> Just AddContactJob
  42   "addfile" -> Just AddFileJob
  43   "documentfromwritenode" -> Just DocumentFromWriteNodeJob
  44   "updatenode" -> Just UpdateNodeJob
  45   "updateframecalc" -> Just UploadFrameCalcJob
  46   "updatedocument" -> Just UploadDocumentJob
  47   "newnode" -> Just NewNodeJob
  48   "addcorpusquery" -> Just AddCorpusQueryJob
  49   "addcorpusform" -> Just AddCorpusFormJob
  50   "addcorpusfile" -> Just AddCorpusFileJob
  51   "addannuaireform" -> Just AddAnnuaireFormJob
  52   "recomputegraph" -> Just RecomputeGraphJob
  53   _ -> Nothing
  54
  55 parsePrios :: [String] -> IO [(GargJob, Int)]
  56 parsePrios []       = return []
  57 parsePrios (x : xs) = (:) <$> go x <*> parsePrios xs
  58   where go s = case break (=='=') s of
  59           ([], _) -> error "parsePrios: empty jobname?"
  60           (prop, valS)
  61             | Just val <- readMaybe (tail valS)
  62             , Just j   <- parseGargJob prop -> return (j, val)
  63             | otherwise                  -> error $
  64               "parsePrios: invalid input. " ++ show (prop, valS)
  65
  66 readPrios :: FilePath -> IO [(GargJob, Int)]
  67 readPrios fp = do
  68   exists <- doesFileExist fp
  69   case exists of
  70     False -> do
  71       putStrLn $
  72         "Warning: " ++ fp ++ " doesn't exist, using default job priorities."
  73       return []
  74     True -> parsePrios . lines =<< readFile fp