[FIX] dev logs simulogs ok

src/Gargantext/API/Node/Update.hs

@@ -21,18 +21,20 @@ import Data.Swagger
 import GHC.Generics (Generic)
 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, (.), Int, pure, (*), printDebug, (^)) -- (-), (^))
+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)
+
+------------------------------------------------------------------------
+type API = Summary " Update node according to NodeType params"
+         :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog
 
 ------------------------------------------------------------------------
 data UpdateNodeParams = UpdateNodeParamsList  { methodList  :: Method      }
@@ -99,7 +101,6 @@ instance Arbitrary Charts where
   arbitrary = elements [ minBound .. maxBound ]
 
 ------------------------------------------------------------------------
-
 api :: UserId -> NodeId -> GargServer API
 api uId nId =
   serveJobsAPI $
@@ -111,56 +112,12 @@ api uId nId =
       in updateNode uId nId p (liftBase . log')
       )
 
-
 updateNode :: FlowCmdM env err m
     => UserId
     -> NodeId
     -> UpdateNodeParams
     -> (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 []
-                 }
-
+updateNode _uId _nId _p logStatus = do
+  simuLogs logStatus 10
 ------------------------------------------------------------------------
-type API = Summary " Update node according to NodeType params"
-         :> AsyncJobs JobLog '[JSON] UpdateNodeParams JobLog

src/Gargantext/API/Prelude.hs

@@ -152,68 +152,32 @@ instance HasJoseError GargError where
 ------------------------------------------------------------------------
 -- | Utils
 -- | Simulate logs
-
 simuLogs  :: MonadBase IO m
          => (JobLog -> m ())
          -> Int
          -> m JobLog
 simuLogs logStatus t = do
-{-
-  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..]
+  _ <- mapM (\n -> simuTask logStatus n t) $ take t [0,1..]
   pure $ JobLog { _scst_succeeded = Just t
-                        , _scst_failed    = Just 0
-                        , _scst_remaining = Just 0
-                        , _scst_events    = Just []
-                        }
+                , _scst_failed    = Just 0
+                , _scst_remaining = Just 0
+                , _scst_events    = Just []
+                }
 
-
-{-
 simuTask :: MonadBase IO m
-         => (JobLog -> m ())
-         -> JobLog
-         -> Int
-         -> Int
-         -> m JobLog
-simuTask logStatus (JobLog _s f _r e) n t = do
-  let
-    m = (10 :: Int) ^ (6 :: Int)
-  _ <- liftBase $ threadDelay ( m * 10)
-
-  let status =  JobLog { _scst_succeeded = Just n
-                              , _scst_failed    = f
-                              , _scst_remaining = (-) <$> Just t <*> Just n
-                              , _scst_events    = e
-                              }
-  printDebug "status" 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)
+simuTask logStatus cur total = do
+  _ <- liftBase $ threadDelay (m*5)
+    where m = (10 :: Int) ^ (6 :: Int)
 
   let status =  JobLog { _scst_succeeded = Just cur
-                              , _scst_failed    = Just 0
-                              , _scst_remaining = (-) <$> Just total <*> Just cur
-                              , _scst_events    = Just []
-                              }
+                       , _scst_failed    = Just 0
+                       , _scst_remaining = (-) <$> Just total <*> Just cur
+                       , _scst_events    = Just []
+                       }
   printDebug "status" status
   logStatus status
 
-
-
-