Merge branch 'dev' into dev-list-charts

package.yaml

 name: gargantext
-version: '0.0.1.5.1'
+version: '0.0.1.5.2'
 synopsis: Search, map, share
 description: Please see README.md
 category: Data

src/Gargantext/API/Admin/Orchestrator.hs

@@ -16,18 +16,17 @@ 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 Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
+import Gargantext.API.Admin.Orchestrator.Types
+import Gargantext.API.Admin.Settings
+import Gargantext.Prelude
 import Servant
 import Servant.Job.Async
 import Servant.Job.Client
 import Servant.Job.Server
 import Servant.Job.Utils (extendBaseUrl)
-
-import Gargantext.Prelude
-import Gargantext.API.Admin.Settings
-import Gargantext.API.Admin.Orchestrator.Types
-import Gargantext.API.Admin.Orchestrator.Scrapy.Schedule
+import qualified Data.ByteString.Lazy.Char8 as LBS
 
 callJobScrapy :: (ToJSON e, FromJSON e, FromJSON o, MonadClientJob m)
               => JobServerURL e Schedule o
@@ -44,7 +43,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 +63,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

src/Gargantext/API/Admin/Orchestrator/Types.hs

@@ -20,7 +20,6 @@ import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
 ------------------------------------------------------------------------
-
 instance Arbitrary a => Arbitrary (JobStatus 'Safe a) where
   arbitrary = panic "TODO"
 
@@ -90,7 +89,9 @@ instance ToJSON ScraperEvent where
 instance FromJSON ScraperEvent where
   parseJSON = genericParseJSON $ jsonOptions "_scev_"
 
-data ScraperStatus = ScraperStatus
+
+
+data JobLog = JobLog
   { _scst_succeeded :: !(Maybe Int)
   , _scst_failed    :: !(Maybe Int)
   , _scst_remaining :: !(Maybe Int)
@@ -98,20 +99,20 @@ data ScraperStatus = ScraperStatus
   }
   deriving (Show, Generic)
 
-instance Arbitrary ScraperStatus where
-  arbitrary = ScraperStatus
+instance Arbitrary JobLog where
+  arbitrary = JobLog
            <$> arbitrary
            <*> arbitrary
            <*> arbitrary
            <*> arbitrary
 
-instance ToJSON ScraperStatus where
+instance ToJSON JobLog where
   toJSON = genericToJSON $ jsonOptions "_scst_"
 
-instance FromJSON ScraperStatus where
+instance FromJSON JobLog where
   parseJSON = genericParseJSON $ jsonOptions "_scst_"
 
-instance ToSchema ScraperStatus -- TODO _scst_ prefix
+instance ToSchema JobLog -- TODO _scst_ prefix
 
 instance ToSchema ScraperInput  -- TODO _scin_ prefix
 instance ToSchema ScraperEvent  -- TODO _scev_ prefix
@@ -122,6 +123,6 @@ instance ToParamSchema Offset -- where
 instance ToParamSchema Limit -- where
   -- toParamSchema = panic "TODO"
 
-type ScrapersEnv = JobEnv ScraperStatus ScraperStatus
+type ScrapersEnv = JobEnv JobLog JobLog
 
-type ScraperAPI  = AsyncJobsAPI ScraperStatus ScraperInput  ScraperStatus
+type ScraperAPI  = AsyncJobsAPI JobLog ScraperInput  JobLog

src/Gargantext/API/Admin/Settings.hs

@@ -156,10 +156,10 @@ instance HasRepo Env where
 instance HasSettings Env where
   settings = env_settings
 
-instance Servant.Job.Core.HasEnv Env (Job ScraperStatus ScraperStatus) where
+instance Servant.Job.Core.HasEnv Env (Job JobLog JobLog) where
   _env = env_scrapers . Servant.Job.Core._env
 
-instance HasJobEnv Env ScraperStatus ScraperStatus where
+instance HasJobEnv Env JobLog JobLog where
   job_env = env_scrapers
 
 data MockEnv = MockEnv

src/Gargantext/API/Ngrams/List.hs

@@ -93,7 +93,7 @@ type PostAPI = Summary "Update List"
         :> "add"
         :> "form"
         :> "async"
-        :> AsyncJobs ScraperStatus '[FormUrlEncoded] WithFile ScraperStatus
+        :> AsyncJobs JobLog '[FormUrlEncoded] WithFile JobLog
 
 postAsync :: ListId -> GargServer PostAPI
 postAsync lId =
@@ -103,18 +103,18 @@ postAsync lId =
 postAsync' :: FlowCmdM env err m
           => ListId
           -> WithFile
-          -> (ScraperStatus -> m ())
-          -> m ScraperStatus
+          -> (JobLog -> m ())
+          -> m JobLog
 postAsync' l (WithFile _ m _) logStatus = do
 
-  logStatus ScraperStatus { _scst_succeeded = Just 0
+  logStatus JobLog { _scst_succeeded = Just 0
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 1
                           , _scst_events    = Just []
                           }
   _r <- post l m
 
-  pure ScraperStatus { _scst_succeeded = Just 1
+  pure JobLog { _scst_succeeded = Just 1
                      , _scst_failed    = Just 0
                      , _scst_remaining = Just 0
                      , _scst_events    = Just []

src/Gargantext/API/Node.hs

@@ -119,6 +119,7 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> PostNodeApi -- TODO move to children POST
              :<|> PostNodeAsync
              :<|> ReqBody '[JSON] a :> Put    '[JSON] Int
+             :<|> "update"     :> Update.API
              :<|> Delete '[JSON] Int
              :<|> "children"  :> ChildrenApi a
 
@@ -143,7 +144,6 @@ type NodeAPI a = Get '[JSON] (Node a)
              :<|> "tree"      :> TreeApi
              :<|> "phylo"     :> PhyloAPI
              -- :<|> "add"       :> NodeAddAPI
-             :<|> "update"     :> Update.API
 
 -- TODO-ACCESS: check userId CanRenameNode nodeId
 -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
@@ -194,6 +194,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> postNode  uId id'
            :<|> postNodeAsyncAPI  uId id'
            :<|> putNode       id'
+           :<|> Update.api  uId id'
            :<|> Action.deleteNode (RootId $ NodeId uId) id'
            :<|> getChildren   id' p
 
@@ -217,7 +218,6 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> phyloAPI   id' uId
            -- :<|> nodeAddAPI id'
            -- :<|> postUpload id'
-           :<|> Update.api  uId id'
 
 scatterApi :: NodeId -> GargServer ScatterAPI
 scatterApi id' = getScatter id'
@@ -316,5 +316,3 @@ putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a)
         -> Cmd err Int
 putNode n h = fromIntegral <$> updateHyperdata n h
 -------------------------------------------------------------
-
-

src/Gargantext/API/Node/Corpus/Annuaire.hs

@@ -62,14 +62,14 @@ type AddWithForm = Summary "Add with FormUrlEncoded to annuaire endpoint"
    :> "add"
    :> "form"
    :> "async"
-   :> AsyncJobs ScraperStatus '[FormUrlEncoded] AnnuaireWithForm ScraperStatus
+   :> AsyncJobs JobLog '[FormUrlEncoded] AnnuaireWithForm JobLog
 
 ------------------------------------------------------------------------
 addToAnnuaireWithForm :: FlowCmdM env err m
                     => AnnuaireId
                     -> AnnuaireWithForm
-                    -> (ScraperStatus -> m ())
-                    -> m ScraperStatus
+                    -> (JobLog -> m ())
+                    -> m JobLog
 addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
 
   printDebug "ft" ft
@@ -86,7 +86,7 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
   --      <$> take 1000000
   --      <$> parse (cs d)
 
-  logStatus ScraperStatus { _scst_succeeded = Just 1
+  logStatus JobLog { _scst_succeeded = Just 1
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 1
                           , _scst_events    = Just []
@@ -98,7 +98,7 @@ addToAnnuaireWithForm _cid (AnnuaireWithForm ft _d _l) logStatus = do
 
   -- printDebug "cid'" cid'
 
-  pure      ScraperStatus { _scst_succeeded = Just 2
+  pure      JobLog { _scst_succeeded = Just 2
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 0
                           , _scst_events    = Just []

src/Gargantext/API/Node/Corpus/New.hs

@@ -36,7 +36,7 @@ import Servant.Job.Utils (jsonOptions)
 import Test.QuickCheck.Arbitrary
 import Web.FormUrlEncoded          (FromForm)
 
-import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import qualified Gargantext.API.Admin.Orchestrator.Types as T
 import Gargantext.API.Node.Corpus.New.File
 import Gargantext.Core (Lang(..){-, allLangs-})
@@ -175,7 +175,7 @@ type AddWithQuery = Summary "Add with Query to corpus endpoint"
    :> "corpus"
      :> Capture "corpus_id" CorpusId
    :> "query"
-     :> AsyncJobs ScraperStatus '[JSON] WithQuery ScraperStatus
+     :> AsyncJobs JobLog '[JSON] WithQuery JobLog
 
 {-
 type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
@@ -186,7 +186,7 @@ type AddWithFile = Summary "Add with MultipartData to corpus endpoint"
      :> MultipartForm Mem (MultipartData Mem)
      :> QueryParam "fileType"  FileType
    :> "async"
-     :> AsyncJobs ScraperStatus '[JSON] () ScraperStatus
+     :> AsyncJobs JobLog '[JSON] () JobLog
 -}
 
 type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
@@ -195,7 +195,7 @@ type AddWithForm = Summary "Add with FormUrlEncoded to corpus endpoint"
    :> "add"
    :> "form"
    :> "async"
-     :> AsyncJobs ScraperStatus '[FormUrlEncoded] NewWithForm ScraperStatus
+     :> AsyncJobs JobLog '[FormUrlEncoded] NewWithForm JobLog
 
 
 ------------------------------------------------------------------------
@@ -204,13 +204,13 @@ addToCorpusWithQuery :: FlowCmdM env err m
                        => User
                        -> CorpusId
                        -> WithQuery
-                       -> (ScraperStatus -> m ())
-                       -> m ScraperStatus
+                       -> (JobLog -> m ())
+                       -> m JobLog
 addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
   -- TODO ...
-  logStatus ScraperStatus { _scst_succeeded = Just 10
-                          , _scst_failed    = Just 2
-                          , _scst_remaining = Just 138
+  logStatus JobLog { _scst_succeeded = Just 0
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 5
                           , _scst_events    = Just []
                           }
   printDebug "addToCorpusWithQuery" cid
@@ -219,11 +219,18 @@ addToCorpusWithQuery u cid (WithQuery q dbs l _nid) logStatus = do
   --      if cid is corpus -> add to corpus
   --      if cid is root   -> create corpus in Private
   txts <- mapM (\db  -> getDataText db     (Multi l) q (Just 10000)) [database2origin dbs]
+
+  logStatus JobLog { _scst_succeeded = Just 2
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 1
+                          , _scst_events    = Just []
+                          }
+
   cids <- mapM (\txt -> flowDataText u txt (Multi l) cid) txts
   printDebug "corpus id" cids
   -- TODO ...
-  pure      ScraperStatus { _scst_succeeded = Just 137
-                          , _scst_failed    = Just 13
+  pure      JobLog { _scst_succeeded = Just 3
+                          , _scst_failed    = Just 0
                           , _scst_remaining = Just 0
                           , _scst_events    = Just []
                           }
@@ -232,10 +239,16 @@ addToCorpusWithForm :: FlowCmdM env err m
                     => User
                     -> CorpusId
                     -> NewWithForm
-                    -> (ScraperStatus -> m ())
-                    -> m ScraperStatus
+                    -> (JobLog -> m ())
+                    -> m JobLog
 addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
 
+  printDebug "Parsing corpus: " cid
+  logStatus JobLog { _scst_succeeded = Just 0
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 2
+                          , _scst_events    = Just []
+                          }
   let
     parse = case ft of
       CSV_HAL   -> Parser.parseFormat Parser.CsvHal
@@ -243,22 +256,20 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
       WOS       -> Parser.parseFormat Parser.WOS
       PresseRIS -> Parser.parseFormat Parser.RisPresse
 
-  logStatus ScraperStatus { _scst_succeeded = Just 1
-                          , _scst_failed    = Just 0
-                          , _scst_remaining = Just 1
-                          , _scst_events    = Just []
-                          }
-
-  printDebug "Parsing corpus: " cid
-
   -- TODO granularity of the logStatus
   docs <- liftBase $ splitEvery 500
       <$> take 1000000
       <$> parse (cs d)
 
   printDebug "Parsing corpus finished : " cid
-  printDebug "Starting extraction     : " cid
+  logStatus JobLog { _scst_succeeded = Just 1
+                          , _scst_failed    = Just 0
+                          , _scst_remaining = Just 1
+                          , _scst_events    = Just []
+                          }
 
+
+  printDebug "Starting extraction     : " cid
   -- TODO granularity of the logStatus
   _cid' <- flowCorpus user
                      (Right [cid])
@@ -266,8 +277,7 @@ addToCorpusWithForm user cid (NewWithForm ft d l _n) logStatus = do
                      (map (map toHyperdataDocument) docs)
 
   printDebug "Extraction finished   : " cid
-
-  pure      ScraperStatus { _scst_succeeded = Just 2
+  pure      JobLog { _scst_succeeded = Just 2
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 0
                           , _scst_events    = Just []
@@ -278,10 +288,10 @@ addToCorpusWithFile :: FlowCmdM env err m
                     => CorpusId
                     -> MultipartData Mem
                     -> Maybe FileType
-                    -> (ScraperStatus -> m ())
-                    -> m ScraperStatus
+                    -> (JobLog -> m ())
+                    -> m JobLog
 addToCorpusWithFile cid input filetype logStatus = do
-  logStatus ScraperStatus { _scst_succeeded = Just 10
+  logStatus JobLog { _scst_succeeded = Just 10
                           , _scst_failed    = Just 2
                           , _scst_remaining = Just 138
                           , _scst_events    = Just []
@@ -289,7 +299,7 @@ addToCorpusWithFile cid input filetype logStatus = do
   printDebug "addToCorpusWithFile" cid
   _h <- postUpload cid filetype input
 
-  pure      ScraperStatus { _scst_succeeded = Just 137
+  pure      JobLog { _scst_succeeded = Just 137
                           , _scst_failed    = Just 13
                           , _scst_remaining = Just 0
                           , _scst_events    = Just []

src/Gargantext/API/Node/New.hs

@@ -24,7 +24,7 @@ import Data.Aeson
 import Data.Swagger
 import Data.Text (Text)
 import GHC.Generics (Generic)
-import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import Gargantext.API.Node.Corpus.New (AsyncJobs)
 import Gargantext.API.Prelude
 import Gargantext.Database.Action.Flow.Types
@@ -68,7 +68,7 @@ postNode uId pId (PostNode nodeName nt) = do
 ------------------------------------------------------------------------
 type PostNodeAsync = Summary "Post Node"
    :> "async"
-   :> AsyncJobs ScraperStatus '[FormUrlEncoded] PostNode ScraperStatus
+   :> AsyncJobs JobLog '[FormUrlEncoded] PostNode JobLog
 
 
 postNodeAsyncAPI :: UserId -> NodeId -> GargServer PostNodeAsync
@@ -81,12 +81,12 @@ postNodeAsync :: FlowCmdM env err m
     => UserId
     -> NodeId
     -> PostNode
-    -> (ScraperStatus -> m ())
-    -> m ScraperStatus
+    -> (JobLog -> m ())
+    -> m JobLog
 postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
 
   printDebug "postNodeAsync" nId
-  logStatus ScraperStatus { _scst_succeeded = Just 1
+  logStatus JobLog { _scst_succeeded = Just 1
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 2
                           , _scst_events    = Just []
@@ -95,7 +95,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
   nodeUser <- getNodeUser (NodeId uId)
 
   -- _ <- threadDelay 1000
-  logStatus ScraperStatus { _scst_succeeded = Just 1
+  logStatus JobLog { _scst_succeeded = Just 1
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 2
                           , _scst_events    = Just []
@@ -104,7 +104,7 @@ postNodeAsync uId nId (PostNode nodeName tn) logStatus = do
   let uId' = nodeUser ^. node_userId
   _ <- mkNodeWithParent tn (Just nId) uId' nodeName
 
-  pure      ScraperStatus { _scst_succeeded = Just 3
+  pure      JobLog { _scst_succeeded = Just 3
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 0
                           , _scst_events    = Just []

src/Gargantext/API/Node/Update.hs

@@ -19,18 +19,20 @@ module Gargantext.API.Node.Update
 import Data.Aeson
 import Data.Swagger
 import GHC.Generics (Generic)
-import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
+import Gargantext.API.Admin.Orchestrator.Types (JobLog(..))
 import Gargantext.API.Node.Corpus.New (AsyncJobs)
-import Gargantext.API.Prelude (GargServer, simuLogs)
+import Gargantext.API.Prelude (GargServer{-, simuLogs-})
 import Gargantext.Database.Action.Flow.Types (FlowCmdM)
 import Gargantext.Database.Admin.Types.Node
-import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.))
+import Gargantext.Prelude (Ord, Eq, (<$>), ($), liftBase, (.), Int, pure, (*), printDebug, (^)) -- (-), (^))
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Servant
 import Servant.Job.Async (JobFunction(..), serveJobsAPI)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
+import Data.Maybe (Maybe(..))
+import Control.Concurrent (threadDelay)
 
 
 
@@ -95,21 +97,68 @@ instance Arbitrary Charts where
   arbitrary = elements [ minBound .. maxBound ]
 
 ------------------------------------------------------------------------
+
 api :: UserId -> NodeId -> GargServer API
 api uId nId =
   serveJobsAPI $
-    JobFunction (\p logs -> updateNode uId nId p (liftBase . logs))
+    JobFunction (\p log ->
+      let
+        log' x = do
+          printDebug "updateNode" x
+          liftBase $ log x
+      in updateNode uId nId p (liftBase . log')
+      )
 
 
 updateNode :: FlowCmdM env err m
     => UserId
     -> NodeId
     -> UpdateNodeParams
-    -> (ScraperStatus -> m ())
-    -> m ScraperStatus
-updateNode _uId _nId _ logStatus = do
-  simuLogs logStatus 100
+    -> (JobLog -> m ())
+    -> m JobLog
+updateNode uId nId _p logStatus = do
+
+-- Why this does not work ?
+--  simuLogs logStatus 100
+  let
+    m = (10 :: Int) ^ (6 :: Int)
+
+  printDebug "updateNode xxxxxxxxxxxxxxxxxxxx" nId
+  --liftBase $ threadDelay ( m * 10)
+  logStatus $ JobLog { _scst_succeeded = Just 3
+                            , _scst_failed    = Just 0
+                            , _scst_remaining = Just 10
+                            , _scst_events    = Just []
+                            }
+
+{-
+    status t n = do
+      _ <- liftBase $ threadDelay ( m * 1000)
+      let s = JobLog { _scst_succeeded = Just n
+                             , _scst_failed    = Just 0
+                             , _scst_remaining = Just (t - n)
+                             , _scst_events    = Just []
+                             }
+      printDebug "status " s
+      pure s
+-}
+
+  printDebug "updateNode yyyyyyyyyyyyyyyyyyyy" uId
+  --liftBase $ threadDelay ( m * 10)
+  logStatus $ JobLog { _scst_succeeded = Just 6
+                            , _scst_failed    = Just 0
+                            , _scst_remaining = Just 4
+                            , _scst_events    = Just []
+                            }
+
+  printDebug "updateNode zzzzzzzzzzzzzzzzzzzz" nId
+  liftBase $ threadDelay ( m * 10)
+  pure $  JobLog { _scst_succeeded = Just 10
+                            , _scst_failed    = Just 0
+                            , _scst_remaining = Just 0
+                            , _scst_events    = Just []
+                            }
 
 ------------------------------------------------------------------------
-type API = Summary " Share Node with username"
-         :> AsyncJobs ScraperStatus '[JSON] UpdateNodeParams ScraperStatus
+type API = Summary " Update node according to NodeType params"
+         :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog

src/Gargantext/API/Prelude.hs

@@ -82,7 +82,7 @@ type GargServerC env err m =
     , Exception        err
     , HasRepo      env
     , HasSettings  env
-    , HasJobEnv    env ScraperStatus ScraperStatus
+    , HasJobEnv    env JobLog JobLog
     )
 
 type GargServerT env err m api = GargServerC env err m => ServerT api m
@@ -98,7 +98,7 @@ type EnvC env =
   ( HasConnectionPool env
   , HasRepo env
   , HasSettings env
-  , HasJobEnv env ScraperStatus ScraperStatus
+  , HasJobEnv env JobLog JobLog
   )
 
 -------------------------------------------------------------------
@@ -154,38 +154,66 @@ instance HasJoseError GargError where
 -- | Simulate logs
 
 simuLogs  :: MonadBase IO m
-         => (ScraperStatus -> m a)
+         => (JobLog -> m ())
          -> Int
-         -> m ScraperStatus
+         -> m JobLog
 simuLogs logStatus t = do
-  let task = ScraperStatus { _scst_succeeded = Just 0
+{-
+  let task = JobLog { _scst_succeeded = Just 0
+                           , _scst_failed    = Just 0
+                           , _scst_remaining = Just 0
+                           , _scst_events    = Just []
+                           }
+-}
+  -- f <- mapM (\status n -> simuTask logStatus status n t) task $ take t [1,2..]
+  _ <- mapM (\n -> simuTask' logStatus n t) $ take t [1,2..]
+  pure $ JobLog { _scst_succeeded = Just t
                         , _scst_failed    = Just 0
                         , _scst_remaining = Just 0
                         , _scst_events    = Just []
                         }
-  f <- foldM' (\status n -> simuTask logStatus status n t) task $ take t [1..]
-  pure f
 
 
+{-
 simuTask :: MonadBase IO m
-         => (ScraperStatus -> m a)
-         -> ScraperStatus
+         => (JobLog -> m ())
+         -> JobLog
          -> Int
          -> Int
-         -> m ScraperStatus
-simuTask logStatus (ScraperStatus s f _r e) n t = do
+         -> m JobLog
+simuTask logStatus (JobLog _s f _r e) n t = do
   let
     m = (10 :: Int) ^ (6 :: Int)
   _ <- liftBase $ threadDelay ( m * 10)
 
-  let status =  ScraperStatus { _scst_succeeded = (+) <$> s <*> Just n
+  let status =  JobLog { _scst_succeeded = Just n
                               , _scst_failed    = f
-                              , _scst_remaining = (-) <$> Just t <*> s
+                              , _scst_remaining = (-) <$> Just t <*> Just n
                               , _scst_events    = e
                               }
   printDebug "status" status
-  _ <- logStatus status
+  logStatus status
   pure status
+-}
+
+simuTask' :: MonadBase IO m
+          => (JobLog -> m ())
+          -> Int
+          -> Int
+          -> m ()
+simuTask' logStatus cur total = do
+  let
+    m = (10 :: Int) ^ (6 :: Int)
+  _ <- liftBase $ threadDelay ( m * 10)
+
+  let status =  JobLog { _scst_succeeded = Just cur
+                              , _scst_failed    = Just 0
+                              , _scst_remaining = (-) <$> Just total <*> Just cur
+                              , _scst_events    = Just []
+                              }
+  printDebug "status" status
+  logStatus status
+
 
 
 

src/Gargantext/Viz/Graph/API.hs

@@ -155,7 +155,7 @@ computeGraph cId nt repo = do
 ------------------------------------------------------------
 type GraphAsyncAPI = Summary "Update graph"
                    :> "async"
-                   :> AsyncJobsAPI ScraperStatus () ScraperStatus
+                   :> AsyncJobsAPI JobLog () JobLog
 
 
 graphAsync :: UserId -> NodeId -> GargServer GraphAsyncAPI
@@ -166,16 +166,16 @@ graphAsync u n =
 
 graphAsync' :: UserId
            -> NodeId
-           -> (ScraperStatus -> GargNoServer ())
-           -> GargNoServer ScraperStatus
+           -> (JobLog -> GargNoServer ())
+           -> GargNoServer JobLog
 graphAsync' u n logStatus = do
-  logStatus ScraperStatus { _scst_succeeded = Just 0
+  logStatus JobLog { _scst_succeeded = Just 0
                           , _scst_failed    = Just 0
                           , _scst_remaining = Just 1
                           , _scst_events    = Just []
                           }
   _g <- trace (show u) $ recomputeGraph u n
-  pure  ScraperStatus { _scst_succeeded = Just 1
+  pure  JobLog { _scst_succeeded = Just 1
                       , _scst_failed    = Just 0
                       , _scst_remaining = Just 0
                       , _scst_events    = Just []