[FIX] removing cLouvain c++ lib
[gargantext.git] / src / Gargantext / API / Admin / Orchestrator.hs
index 056f561967a38b83cbeca5b33dc817437b0f34af..ede10e866ceaf368958063187c76508a9d0b6be2 100644 (file)
@@ -9,25 +9,18 @@ Portability : POSIX
 
 -}
 
-{-# 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
@@ -44,7 +37,7 @@ callJobScrapy jurl schedule = do
 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
@@ -64,11 +57,11 @@ callScraper url input =
           ,("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
@@ -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