[TOFIX] logs are not really taken into account

src/Gargantext/API/Node.hs

@@ -121,6 +121,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
 
@@ -145,7 +146,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...
@@ -196,6 +196,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
 
@@ -219,7 +220,6 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
            :<|> phyloAPI   id' uId
            -- :<|> nodeAddAPI id'
            -- :<|> postUpload id'
-           :<|> Update.api  uId id'
 
 ------------------------------------------------------------------------
 data RenameNode = RenameNode { r_name :: Text }

src/Gargantext/API/Node/Update.hs

@@ -21,16 +21,18 @@ import Data.Swagger
 import GHC.Generics (Generic)
 import Gargantext.API.Admin.Orchestrator.Types (ScraperStatus(..))
 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)
 
 
 
@@ -108,7 +110,43 @@ updateNode :: FlowCmdM env err m
     -> (ScraperStatus -> m ())
     -> m ScraperStatus
 updateNode _uId _nId _ logStatus = do
-  simuLogs logStatus 100
+
+-- Why this does not work ?
+--  simuLogs logStatus 100
+
+  logStatus $ ScraperStatus { _scst_succeeded = Just 1
+                             , _scst_failed    = Just 0
+                             , _scst_remaining = Just 10
+                             , _scst_events    = Just []
+                             }
+
+  let
+    m = (10 :: Int) ^ (6 :: Int)
+    status t n = do
+      _ <- liftBase $ threadDelay ( m * 100)
+      let s = ScraperStatus { _scst_succeeded = Just n
+                             , _scst_failed    = Just 0
+                             , _scst_remaining = Just (t - n)
+                             , _scst_events    = Just []
+                             }
+      printDebug "status " s
+      pure s
+
+  s1 <- status 10 2
+  logStatus s1
+
+  s2 <- status 10 5
+  logStatus s2
+
+  s3 <- status 10 7
+  logStatus s3
+
+  status 10 10
+
+
+
+
+
 
 ------------------------------------------------------------------------
 type API = Summary " Share Node with username"

src/Gargantext/API/Prelude.hs

@@ -154,38 +154,66 @@ instance HasJoseError GargError where
 -- | Simulate logs
 
 simuLogs  :: MonadBase IO m
-         => (ScraperStatus -> m a)
+         => (ScraperStatus -> m ())
          -> Int
          -> m ScraperStatus
 simuLogs logStatus t = do
+{-
   let task = ScraperStatus { _scst_succeeded = Just 0
                            , _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
+-}
+  -- 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 $ ScraperStatus { _scst_succeeded = Just t
+                        , _scst_failed    = Just 0
+                        , _scst_remaining = Just 0
+                        , _scst_events    = Just []
+                        }
 
 
+{-
 simuTask :: MonadBase IO m
-         => (ScraperStatus -> m a)
+         => (ScraperStatus -> m ())
          -> ScraperStatus
          -> Int
          -> Int
          -> m ScraperStatus
-simuTask logStatus (ScraperStatus s f _r e) n t = do
+simuTask logStatus (ScraperStatus _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 =  ScraperStatus { _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
+          => (ScraperStatus -> m ())
+          -> Int
+          -> Int
+          -> m ()
+simuTask' logStatus cur total = do
+  let
+    m = (10 :: Int) ^ (6 :: Int)
+  _ <- liftBase $ threadDelay ( m * 10)
+
+  let status =  ScraperStatus { _scst_succeeded = Just cur
+                              , _scst_failed    = Just 0
+                              , _scst_remaining = (-) <$> Just total <*> Just cur
+                              , _scst_events    = Just []
+                              }
+  printDebug "status" status
+  logStatus status
+