[ngrams] logRef for logging task progress

NOTE: for some reason this doesn't compile yet

src/Gargantext/API/Ngrams.hs

-{-# OPTIONS_GHC -fno-warn-unused-top-binds -fno-warn-name-shadowing #-}
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
 {-|
 Module      : Gargantext.API.Ngrams
 Description : Server API
@@ -375,52 +375,53 @@ tableNgramsPostChartsAsync utn logStatus = do
           case tabType of
             Authors -> do
               -- printDebug "[tableNgramsPut] Authors, updating Pie, cId" cId
-              let jl = jobLogInit 1
-              logStatus jl
+              (logRef, logRefSuccess, getRef) <- runJobLog 1 logStatus
+              logRef
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              pure $ jobLogSuccess jl
+              logRefSuccess
+
+              getRef
             Institutes -> do
               -- printDebug "[tableNgramsPut] Institutes, updating Tree, cId" cId
               -- printDebug "[tableNgramsPut] updating tree StopTerm, cId" cId
-              let jl = jobLogInit 3
-              logStatus jl
+              (logRef, logRefSuccess, getRef) <- runJobLog 3 logStatus
+              logRef
               _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
               -- printDebug "[tableNgramsPut] updating tree CandidateTerm, cId" cId
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
               -- printDebug "[tableNgramsPut] updating tree MapTerm, cId" cId
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
-              pure $ jobLogSuccess jl
+              logRefSuccess
+
+              getRef
             Sources -> do
               -- printDebug "[tableNgramsPut] Sources, updating chart, cId" cId
-              let jl = jobLogInit 1
-              logStatus jl
+              (logRef, logRefSuccess, getRef) <- runJobLog 1 logStatus
+              logRef
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              pure $ jobLogSuccess jl
+              logRefSuccess
+
+              getRef
             Terms -> do
               -- printDebug "[tableNgramsPut] Terms, updating Metrics (Histo), cId" cId
-              let jl = jobLogInit 6
-              logStatus jl
+              (logRef, logRefSuccess, getRef) <- runJobLog 6 logStatus
+              logRef
               _ <- Metrics.updateChart cId (Just listId) tabType Nothing
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updatePie cId (Just listId) tabType Nothing
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateScatter cId (Just listId) tabType Nothing
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType StopTerm
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType CandidateTerm
-              let jl = jobLogSuccess jl
-              logStatus jl
+              logRefSuccess
               _ <- Metrics.updateTree cId (Just listId) tabType MapTerm
-              pure $ jobLogSuccess jl
+              logRefSuccess
+
+              getRef
             _ -> do
               printDebug "[tableNgramsPut] no update for tabType = " tabType
               pure $ jobLogFail $ jobLogInit 1
@@ -729,12 +730,12 @@ apiNgramsTableDoc dId =  getTableNgramsDoc dId
 apiNgramsAsync :: NodeId -> GargServer TableNgramsAsyncApi
 apiNgramsAsync _dId =
   serveJobsAPI $
-    JobFunction (\i l ->
+    JobFunction $ \i log ->
       let
         log' x = do
           printDebug "tableNgramsPostChartsAsync" x
-          liftBase $ l x
-      in tableNgramsPostChartsAsync i log')
+          liftBase $ log x
+      in tableNgramsPostChartsAsync i log'
 
 -- Did the given list of ngrams changed since the given version?
 -- The returned value is versioned boolean value, meaning that one always retrieve the

src/Gargantext/API/Routes.hs

@@ -251,7 +251,7 @@ addCorpusWithQuery user cid =
   serveJobsAPI $
     JobFunction (\q log -> do
       limit <- view $ config . gc_max_docs_scrapers
-      New.addToCorpusWithQuery user cid q (Just limit) (liftBase . log)
+      New.ahttps://filezilla-project.org/ddToCorpusWithQuery user cid q (Just limit) (liftBase . log)
       {- let log' x = do
         printDebug "addToCorpusWithQuery" x
         liftBase $ log x

src/Gargantext/Prelude/Job.hs

 module Gargantext.Prelude.Job where
 
+import Data.IORef
 import Data.Maybe
 
 import Gargantext.Prelude
@@ -19,7 +20,7 @@ jobLogSuccess (JobLog { _scst_succeeded = mSucc
                       , _scst_failed = mFail
                       , _scst_events = evt }) =
   JobLog { _scst_succeeded = (+ 1) <$> mSucc
-         , _scst_remaining = (+ 1) <$> mRem
+         , _scst_remaining = (\x -> x - 1) <$> mRem
          , _scst_failed = mFail
          , _scst_events = evt }
 
@@ -29,7 +30,22 @@ jobLogFail (JobLog { _scst_succeeded = mSucc
                    , _scst_remaining = mRem
                    , _scst_failed = mFail
                    , _scst_events = evt }) =
-  JobLog { _scst_succeeded = (+ 1) <$> mSucc
+  JobLog { _scst_succeeded = mSucc
          , _scst_remaining = (\x -> x - 1) <$> mRem
          , _scst_failed = (+ 1) <$> mFail
          , _scst_events = evt }
+
+runJobLog :: Int -> (JobLog -> IO ()) -> IO (IO (), IO (), IO JobLog)
+runJobLog num logStatus = do
+  jlRef <- newIORef $ jobLogInit num
+
+  let logRef = do
+    jl <- readIORef jlRef
+    logStatus jl
+  let logRefSuccess = do
+    jl <- readIORef jlRef
+    writeIORef $ jobLogSuccess jl
+  let getRef = do
+    readIORef jlRef
+
+  return (logRef, logRefSuccess, getRef)