-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators #-}
-
module Gargantext.API.Admin.Orchestrator where
import Control.Lens hiding (elements)
import Data.Aeson
-import qualified Data.ByteString.Lazy.Char8 as LBS
-import Data.Text
import Servant
import Servant.Job.Async
import Servant.Job.Client
-import Servant.Job.Server
-import Servant.Job.Utils (extendBaseUrl)
+import qualified Data.ByteString.Lazy.Char8 as LBS
-import Gargantext.Prelude
-import Gargantext.API.Admin.Settings
-import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
+import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.Prelude
callJobScrapy :: (ToJSON e, FromJSON e, FromJSON o, MonadClientJob m)
=> JobServerURL e Schedule o
logConsole :: ToJSON a => a -> IO ()
logConsole = LBS.putStrLn . encode
-callScraper :: MonadClientJob m => URL -> ScraperInput -> m ScraperStatus
+callScraper :: MonadClientJob m => URL -> ScraperInput -> m JobLog
callScraper url input =
callJobScrapy jurl $ \cb ->
Schedule
,("callback", [toUrlPiece cb])]
}
where
- jurl :: JobServerURL ScraperStatus Schedule ScraperStatus
+ jurl :: JobServerURL JobLog Schedule JobLog
jurl = JobServerURL url Callback
pipeline :: FromJSON e => URL -> ClientEnv -> ScraperInput
- -> (e -> IO ()) -> IO ScraperStatus
+ -> (e -> IO ()) -> IO JobLog
pipeline scrapyurl client_env input log_status = do
e <- runJobMLog client_env log_status $ callScraper scrapyurl input
either (panic . cs . show) pure e -- TODO throwError
-- use:
-- * serveJobsAPI instead of simpleServeJobsAPI
-- * JobFunction instead of simpleJobFunction
+-- TODO:
+-- * HasSelfUrl or move self_url to settings
+-- * HasScrapers or move scrapers to settings
+-- * EnvC env
+{- NOT USED YET
+import Data.Text
+import Servant.Job.Server
+import Servant.Job.Utils (extendBaseUrl)
+import Gargantext.API.Admin.Types
scrapyOrchestrator :: Env -> IO (Server (WithCallbacks ScraperAPI))
scrapyOrchestrator env = do
apiWithCallbacksServer (Proxy :: Proxy ScraperAPI)
defaultSettings (extendBaseUrl ("scraper" :: Text) $ env ^. env_self_url)
(env ^. env_manager) (LogEvent logConsole) $
simpleServeJobsAPI (env ^. env_scrapers) .
- simpleJobFunction . pipeline (URL $ env ^. env_settings . scrapydUrl)
+ simpleJobFunction . pipeline (URL $ env ^. settings . scrapydUrl)
+-}
\ No newline at end of file