Update from WIP

src/Gargantext/API/Admin/EnvTypes.hs

@@ -51,7 +51,6 @@ import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (HasConnectionPool(..))
 import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging
-import Gargantext.Utils.Jobs.Error
 import Gargantext.Utils.Jobs.Map (LoggerM, J(..), jTask, rjGetLog)
 import Gargantext.Utils.Jobs.Monad qualified as Jobs
 import Network.HTTP.Client (Manager)
@@ -61,6 +60,7 @@ import Servant.Job.Async (HasJobEnv(..), Job)
 import Servant.Job.Async qualified as SJ
 import Servant.Job.Core qualified
 import System.Log.FastLogger qualified as FL
+import Debug.Trace as DT
 
 data Mode = Dev | Mock | Prod
   deriving (Show, Read, Generic)
@@ -185,21 +185,19 @@ data ConcreteJobHandle err =
   | JobHandle {
       _jh_id     :: !(SJ.JobID 'SJ.Safe)
     , _jh_logger :: LoggerM (GargM Env err) JobLog
-    , _jh_warnings :: [WarningDiagnostic]
     }
 
 -- | Creates a new /concrete/ 'JobHandle', given its underlying 'JobID' and the logging function to
 -- be used to report the status.
 mkJobHandle :: SJ.JobID 'SJ.Safe
             -> LoggerM (GargM Env err) JobLog
-            -> [WarningDiagnostic]
             -> ConcreteJobHandle err
 mkJobHandle jId = JobHandle jId
 
 -- | Updates the status of a 'JobHandle' by using the input 'updateJobStatus' function.
 updateJobProgress :: ConcreteJobHandle err -> (JobLog -> JobLog) -> GargM Env err ()
 updateJobProgress ConcreteNullHandle _ = pure ()
-updateJobProgress hdl@(JobHandle _ logStatus _) updateJobStatus =
+updateJobProgress hdl@(JobHandle _ logStatus) updateJobStatus =
   Jobs.getLatestJobStatus hdl >>= logStatus . updateJobStatus
 
 
@@ -213,7 +211,7 @@ instance Jobs.MonadJobStatus (GargM Env err) where
   noJobHandle Proxy = ConcreteNullHandle
 
   getLatestJobStatus ConcreteNullHandle = pure noJobLog
-  getLatestJobStatus (JobHandle jId _ _) = do
+  getLatestJobStatus (JobHandle jId _) = do
     mb_jb <- Jobs.findJob jId
     case mb_jb of
       Nothing -> pure noJobLog
@@ -228,7 +226,7 @@ instance Jobs.MonadJobStatus (GargM Env err) where
                                    l :< _ -> l
 
   withTracer _ ConcreteNullHandle f  = f ConcreteNullHandle
-  withTracer extraLogger (JobHandle jId logger _) n = n (JobHandle jId (\w -> logger w >> liftIO (extraLogger w)) [])
+  withTracer extraLogger (JobHandle jId logger) n = n (JobHandle jId (\w -> logger w >> liftIO (extraLogger w)))
 
   markStarted n jh = updateJobProgress jh (const $ jobLogStart (RemainingSteps n))
 
@@ -242,7 +240,12 @@ instance Jobs.MonadJobStatus (GargM Env err) where
 
   markComplete jh = updateJobProgress jh jobLogComplete
 
-  markWarning jh warn = updateJobProgress jh (addWarningEvent warn)
+  markCompleteWithWarning h diag = do
+    Jobs.emitWarning h diag
+    Jobs.markComplete h
+
+
+  emitWarning jh warn = DT.trace ("Test") $ updateJobProgress jh (addWarningEvent warn)
 
   markFailed mb_msg jh =
     updateJobProgress jh (\latest -> case mb_msg of
@@ -321,7 +324,9 @@ instance Jobs.MonadJobStatus (GargM DevEnv err) where
 
   markComplete _ = pure ()
 
-  markWarning _ _ = pure ()
+  markCompleteWithWarning _ _ = pure ()
+
+  emitWarning _ _ = pure ()
 
   markFailed _ _ = pure ()
 

src/Gargantext/API/Job.hs

@@ -51,7 +51,7 @@ addErrorEvent :: ToHumanFriendlyError e => e -> JobLog -> JobLog
 addErrorEvent message = addEvent "ERROR" (mkHumanFriendly message)
 
 addWarningEvent :: WarningDiagnostic -> JobLog -> JobLog
-addWarningEvent message = addEvent "WARNING" (renderWarningDiagnostic message)
+addWarningEvent message = addEvent "ERROR" (renderWarningDiagnostic message)
 
 jobLogProgress :: Int -> JobLog -> JobLog
 jobLogProgress n jl = over (scst_succeeded . _Just) (+ n) $

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

@@ -296,7 +296,7 @@ addToCorpusWithForm user cid nwf jobHandle = do
       -- TODO uncomment this
       --sendMail user
       
-      markWarning jobHandle (Warn.MissingAbstractFromCorpus "Test")
+      emitWarning jobHandle (Warn.MissingAbstractFromCorpus "Test")
       $(logLocM) WARNING $ T.pack $ "Warning in parsing"
       --markFailed (Just $ Parser.ParseFormatError "Test") jobHandle
       

src/Gargantext/Utils/Jobs.hs

@@ -29,7 +29,6 @@ import Prelude
 import System.Directory (doesFileExist)
 import Text.Read (readMaybe)
 import qualified Data.Text as T
-
 import Gargantext.API.Admin.EnvTypes ( mkJobHandle, Env, GargJob(..) )
 import Gargantext.API.Errors.Types ( BackendInternalError(InternalJobError) )
 import Gargantext.API.Prelude ( GargM )

src/Gargantext/Utils/Jobs/Internal.hs

@@ -27,7 +27,6 @@ import Servant.API.Alternative
 import Servant.API.ContentTypes
 
 import Gargantext.API.Errors.Types (BackendInternalError)
-import Gargantext.Utils.Jobs.Error
 import Gargantext.Utils.Jobs.Map
 import Gargantext.Utils.Jobs.Monad
 
@@ -44,7 +43,7 @@ serveJobsAPI
      , ToJSON event, ToJSON output, MimeRender JSON output
      , Foldable callback
      )
-  => (SJ.JobID 'SJ.Safe -> LoggerM m event -> [WarningDiagnostic] -> JobHandle m)
+  => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
   -> m env
   -> t
   -> (JobError -> BackendInternalError)
@@ -83,7 +82,7 @@ newJob
      , MimeRender JSON output
      , Foldable callbacks
      )
-  => (SJ.JobID 'SJ.Safe -> LoggerM m event -> [WarningDiagnostic] -> JobHandle m)
+  => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
   -> m env
   -> t
   -> (env -> JobHandle m -> input -> IO (Either BackendInternalError output))
@@ -102,7 +101,7 @@ newJob newJobHandle getenv jobkind f input = do
 
       f' jId inp logF = do
         catch (do
-          r <- f env (newJobHandle jId (liftIO . pushLog logF . Seq.singleton) []) inp
+          r <- f env (newJobHandle jId (liftIO . pushLog logF . Seq.singleton)) inp
           case r of
             Left e  -> postCallback (SJ.mkChanError e) >> throwIO e
             Right a -> postCallback (SJ.mkChanResult a) >> pure a)

src/Gargantext/Utils/Jobs/Monad.hs

@@ -224,8 +224,10 @@ class MonadJobStatus m where
   -- | Finish tracking a job by marking all the remaining steps as succeeded.
   markComplete :: JobHandle m -> m ()
 
+  markCompleteWithWarning :: MonadJobStatus m => JobHandle m -> WarningDiagnostic -> m ()
+
   -- | 
-  markWarning :: JobHandle m -> WarningDiagnostic -> m ()
+  emitWarning :: JobHandle m -> WarningDiagnostic -> m ()
 
   -- | Finish tracking a job by marking all the remaining steps as failed. Attach an optional
   -- message to the failure.