Merge branch 'dev-tree-reload' of ssh://gitlab.iscpif.fr:20022/gargantext/haskell...
[gargantext.git] / src / Gargantext / API / Admin / Orchestrator.hs
index 8b2fd1ec56dbeb47027f0bf56aa970e224b4e42d..ede10e866ceaf368958063187c76508a9d0b6be2 100644 (file)
@@ -9,24 +9,17 @@ Portability : POSIX
 
 -}
 
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE TypeOperators     #-}
-
 module Gargantext.API.Admin.Orchestrator where
 
 import Control.Lens hiding (elements)
 import Data.Aeson
-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.API.Admin.Orchestrator.Scrapy.Schedule
 import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Admin.Types
 import Gargantext.Prelude
 
 callJobScrapy :: (ToJSON e, FromJSON e, FromJSON o, MonadClientJob m)
@@ -77,10 +70,20 @@ pipeline scrapyurl client_env input log_status = do
 --  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