Resolve conflicts

src/Gargantext/API/Admin/EnvTypes.hs

@@ -51,7 +51,7 @@ import Gargantext.Core.NodeStory
 import Gargantext.Database.Prelude (HasConnectionPool(..))
 import Gargantext.Prelude hiding (to)
 import Gargantext.System.Logging
-import Gargantext.Utils.Jobs.Internal (pollJob)
+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)
@@ -60,7 +60,6 @@ import Servant.Client (BaseUrl)
 import Servant.Job.Async (HasJobEnv(..), Job)
 import Servant.Job.Async qualified as SJ
 import Servant.Job.Core qualified
-import Servant.Job.Types qualified as SJ
 import System.Log.FastLogger qualified as FL
 
 data Mode = Dev | Mock | Prod
@@ -186,31 +185,23 @@ 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 jId logStatus) updateJobStatus = do
-  jobLog <- Jobs.getLatestJobStatus hdl
-  let jobLogNew = updateJobStatus jobLog
-  logStatus jobLogNew
-  mJb <- Jobs.findJob jId
-  case mJb of
-    Nothing -> pure ()
-    Just je -> do
-      -- We use the same endpoint as the one for polling jobs via
-      -- API. This way we can send the job status directly in the
-      -- notification
-      j <- pollJob (Just $ SJ.Limit 1) Nothing jId je
-      CET.ce_notify $ CET.UpdateJobProgress j
+updateJobProgress hdl@(JobHandle _ logStatus _) updateJobStatus =
+  Jobs.getLatestJobStatus hdl >>= logStatus . updateJobStatus
+
 
 instance Jobs.MonadJobStatus (GargM Env err) where
 
@@ -222,7 +213,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
@@ -237,7 +228,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))
 
@@ -251,11 +242,7 @@ instance Jobs.MonadJobStatus (GargM Env err) where
 
   markComplete jh = updateJobProgress jh jobLogComplete
 
-  markWarning mb_msg jh =
-    updateJobProgress jh (\latest -> case mb_msg of
-                                       Nothing  -> jobLogFailTotal latest
-                                       Just msg -> jobLogFailTotalWithMessage msg latest
-                         )
+  markWarning jh warn = updateJobProgress jh (addWarningEvent warn)
 
   markFailed mb_msg jh =
     updateJobProgress jh (\latest -> case mb_msg of

src/Gargantext/API/Job.hs

@@ -20,6 +20,7 @@ module Gargantext.API.Job (
   , jobLogFailTotalWithMessage
   , RemainingSteps(..)
   , addErrorEvent
+  , addWarningEvent
   ) where
 
 import Control.Lens (over, _Just)
@@ -49,6 +50,9 @@ addEvent level message (JobLog { _scst_events = mEvts, .. }) = JobLog { _scst_ev
 addErrorEvent :: ToHumanFriendlyError e => e -> JobLog -> JobLog
 addErrorEvent message = addEvent "ERROR" (mkHumanFriendly message)
 
+addWarningEvent :: WarningDiagnostic -> JobLog -> JobLog
+addWarningEvent message = addEvent "WARNING" (renderWarningDiagnostic message)
+
 jobLogProgress :: Int -> JobLog -> JobLog
 jobLogProgress n jl = over (scst_succeeded . _Just) (+ n) $
                       over (scst_remaining . _Just) (\x -> max 0 (x - n)) jl

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

@@ -59,6 +59,7 @@ import Gargantext.Database.Schema.Node (node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.System.Logging ( logLocM, LogLevel(..) )
 import Gargantext.Utils.Jobs.Monad (JobHandle, MonadJobStatus(..))
+import Gargantext.Utils.Jobs.Error as Warn
 
 ------------------------------------------------------------------------
 {-
@@ -294,8 +295,11 @@ addToCorpusWithForm user cid nwf jobHandle = do
       -- printDebug "sending email" ("xxxxxxxxxxxxxxxxxxxxx" :: Text)
       -- TODO uncomment this
       --sendMail user
-      markWarning (Just (Parser.ParseFormatError {_ParseFormatError = T.pack "test"})) jobHandle
+      
+      markWarning jobHandle (Warn.MissingAbstractFromCorpus "Test")
       $(logLocM) WARNING $ T.pack $ "Warning in parsing"
+      --markFailed (Just $ Parser.ParseFormatError "Test") jobHandle
+      
 
       markComplete jobHandle
     Left parseErr -> do

src/Gargantext/Utils/Jobs/Error.hs

@@ -3,6 +3,8 @@
 module Gargantext.Utils.Jobs.Error
   ( ToHumanFriendlyError(..)
   , HumanFriendlyErrorText(..)
+  , WarningDiagnostic(..)
+  , renderWarningDiagnostic
   ) where
 
 import Prelude
@@ -34,3 +36,13 @@ instance ToHumanFriendlyError HumanFriendlyErrorText where
 -- /N.B/ Don't get fooled by this instance, it's just to help inference in case we use \"markFailed Nothing\".
 instance ToHumanFriendlyError Void where
   mkHumanFriendly = absurd
+
+-- Temporary : Need change to be more precises
+data WarningDiagnostic = 
+    MissingAbstractFromCorpus T.Text
+  | MalformedCorpus T.Text
+
+renderWarningDiagnostic :: WarningDiagnostic -> T.Text
+renderWarningDiagnostic = \case
+  MissingAbstractFromCorpus corpusName -> "The corpus " <> corpusName <> " had a missing abstract."
+  MalformedCorpus text -> text
\ No newline at end of file

src/Gargantext/Utils/Jobs/Internal.hs

@@ -27,6 +27,7 @@ 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
 
@@ -43,7 +44,7 @@ serveJobsAPI
      , ToJSON event, ToJSON output, MimeRender JSON output
      , Foldable callback
      )
-  => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
+  => (SJ.JobID 'SJ.Safe -> LoggerM m event -> [WarningDiagnostic] -> JobHandle m)
   -> m env
   -> t
   -> (JobError -> BackendInternalError)
@@ -82,7 +83,7 @@ newJob
      , MimeRender JSON output
      , Foldable callbacks
      )
-  => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
+  => (SJ.JobID 'SJ.Safe -> LoggerM m event -> [WarningDiagnostic] -> JobHandle m)
   -> m env
   -> t
   -> (env -> JobHandle m -> input -> IO (Either BackendInternalError output))
@@ -101,7 +102,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,9 +224,8 @@ class MonadJobStatus m where
   -- | Finish tracking a job by marking all the remaining steps as succeeded.
   markComplete :: JobHandle m -> m ()
 
-  -- | Finish tracking a job by marking all the remaining steps as failed. Attach an optional
-  -- message to the failure.
-  markWarning :: forall e. ToHumanFriendlyError e => Maybe e -> JobHandle m -> m ()
+  -- | 
+  markWarning :: JobHandle m -> WarningDiagnostic -> m ()
 
   -- | Finish tracking a job by marking all the remaining steps as failed. Attach an optional
   -- message to the failure.