1 {-# LANGUAGE TypeFamilies #-}
2 module Gargantext.Utils.Jobs (
3 -- * Serving the JOBS API
5 -- * Parsing and reading @GargJob@s from disk
9 import Control.Monad.Except
10 import Control.Monad.Reader
11 import Data.Aeson (ToJSON)
12 import Data.Monoid (Dual)
14 import System.Directory (doesFileExist)
15 import Text.Read (readMaybe)
17 import Gargantext.API.Admin.EnvTypes
18 import Gargantext.API.Prelude
19 import qualified Gargantext.Utils.Jobs.Internal as Internal
20 import Gargantext.Utils.Jobs.Map
21 import Gargantext.Utils.Jobs.Monad
23 import qualified Servant.Job.Async as SJ
26 :: JobError -> GargError
27 jobErrorToGargError = GargJobError
34 , ToJSON (JobEventType m)
35 , ToJSON (JobOutputType m)
36 , MonadJobStatus m Dual
37 , m ~ (GargM env GargError)
40 -> (Internal.JobHandle -> input -> Logger (JobEventType m) -> m (JobOutputType m))
41 -> SJ.AsyncJobsServerT' ctI ctO callbacks (JobEventType m) input (JobOutputType m) m
42 serveJobsAPI jobType f = Internal.serveJobsAPI ask jobType jobErrorToGargError $ \env jHandle i l -> do
43 putStrLn ("Running job of type: " ++ show jobType)
44 runExceptT $ runReaderT (f jHandle i l) env
46 parseGargJob :: String -> Maybe GargJob
47 parseGargJob s = case s of
48 "tablengrams" -> Just TableNgramsJob
49 "forgotpassword" -> Just ForgotPasswordJob
50 "updatengramslistjson" -> Just UpdateNgramsListJobJSON
51 "updatengramslistcsv" -> Just UpdateNgramsListJobCSV
52 "addcontact" -> Just AddContactJob
53 "addfile" -> Just AddFileJob
54 "documentfromwritenode" -> Just DocumentFromWriteNodeJob
55 "updatenode" -> Just UpdateNodeJob
56 "updateframecalc" -> Just UploadFrameCalcJob
57 "updatedocument" -> Just UploadDocumentJob
58 "newnode" -> Just NewNodeJob
59 "addcorpusquery" -> Just AddCorpusQueryJob
60 "addcorpusform" -> Just AddCorpusFormJob
61 "addcorpusfile" -> Just AddCorpusFileJob
62 "addannuaireform" -> Just AddAnnuaireFormJob
63 "recomputegraph" -> Just RecomputeGraphJob
66 parsePrios :: [String] -> IO [(GargJob, Int)]
67 parsePrios [] = return []
68 parsePrios (x : xs) = (:) <$> go x <*> parsePrios xs
69 where go s = case break (=='=') s of
70 ([], _) -> error "parsePrios: empty jobname?"
72 | Just val <- readMaybe (tail valS)
73 , Just j <- parseGargJob prop -> return (j, val)
74 | otherwise -> error $
75 "parsePrios: invalid input. " ++ show (prop, valS)
77 readPrios :: FilePath -> IO [(GargJob, Int)]
79 exists <- doesFileExist fp
83 "Warning: " ++ fp ++ " doesn't exist, using default job priorities."
85 True -> parsePrios . lines =<< readFile fp