Commit b1ec2c42 authored by Loïc Chapron's avatar Loïc Chapron Committed by Grégoire Locqueville

Update from WIP

parent a50cd7ac
...@@ -51,7 +51,6 @@ import Gargantext.Core.NodeStory ...@@ -51,7 +51,6 @@ import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude (HasConnectionPool(..)) import Gargantext.Database.Prelude (HasConnectionPool(..))
import Gargantext.Prelude hiding (to) import Gargantext.Prelude hiding (to)
import Gargantext.System.Logging import Gargantext.System.Logging
import Gargantext.Utils.Jobs.Error
import Gargantext.Utils.Jobs.Map (LoggerM, J(..), jTask, rjGetLog) import Gargantext.Utils.Jobs.Map (LoggerM, J(..), jTask, rjGetLog)
import Gargantext.Utils.Jobs.Monad qualified as Jobs import Gargantext.Utils.Jobs.Monad qualified as Jobs
import Network.HTTP.Client (Manager) import Network.HTTP.Client (Manager)
...@@ -186,21 +185,19 @@ data ConcreteJobHandle err = ...@@ -186,21 +185,19 @@ data ConcreteJobHandle err =
| JobHandle { | JobHandle {
_jh_id :: !(SJ.JobID 'SJ.Safe) _jh_id :: !(SJ.JobID 'SJ.Safe)
, _jh_logger :: LoggerM (GargM Env err) JobLog , _jh_logger :: LoggerM (GargM Env err) JobLog
, _jh_warnings :: [WarningDiagnostic]
} }
-- | Creates a new /concrete/ 'JobHandle', given its underlying 'JobID' and the logging function to -- | Creates a new /concrete/ 'JobHandle', given its underlying 'JobID' and the logging function to
-- be used to report the status. -- be used to report the status.
mkJobHandle :: SJ.JobID 'SJ.Safe mkJobHandle :: SJ.JobID 'SJ.Safe
-> LoggerM (GargM Env err) JobLog -> LoggerM (GargM Env err) JobLog
-> [WarningDiagnostic]
-> ConcreteJobHandle err -> ConcreteJobHandle err
mkJobHandle jId = JobHandle jId mkJobHandle jId = JobHandle jId
-- | Updates the status of a 'JobHandle' by using the input 'updateJobStatus' function. -- | Updates the status of a 'JobHandle' by using the input 'updateJobStatus' function.
updateJobProgress :: ConcreteJobHandle err -> (JobLog -> JobLog) -> GargM Env err () updateJobProgress :: ConcreteJobHandle err -> (JobLog -> JobLog) -> GargM Env err ()
updateJobProgress ConcreteNullHandle _ = pure () updateJobProgress ConcreteNullHandle _ = pure ()
updateJobProgress hdl@(JobHandle _ logStatus _) updateJobStatus = updateJobProgress hdl@(JobHandle _ logStatus) updateJobStatus =
Jobs.getLatestJobStatus hdl >>= logStatus . updateJobStatus Jobs.getLatestJobStatus hdl >>= logStatus . updateJobStatus
...@@ -214,7 +211,7 @@ instance Jobs.MonadJobStatus (GargM Env err) where ...@@ -214,7 +211,7 @@ instance Jobs.MonadJobStatus (GargM Env err) where
noJobHandle Proxy = ConcreteNullHandle noJobHandle Proxy = ConcreteNullHandle
getLatestJobStatus ConcreteNullHandle = pure noJobLog getLatestJobStatus ConcreteNullHandle = pure noJobLog
getLatestJobStatus (JobHandle jId _ _) = do getLatestJobStatus (JobHandle jId _) = do
mb_jb <- Jobs.findJob jId mb_jb <- Jobs.findJob jId
case mb_jb of case mb_jb of
Nothing -> pure noJobLog Nothing -> pure noJobLog
...@@ -229,7 +226,7 @@ instance Jobs.MonadJobStatus (GargM Env err) where ...@@ -229,7 +226,7 @@ instance Jobs.MonadJobStatus (GargM Env err) where
l :< _ -> l l :< _ -> l
withTracer _ ConcreteNullHandle f = f ConcreteNullHandle 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)) markStarted n jh = updateJobProgress jh (const $ jobLogStart (RemainingSteps n))
......
...@@ -51,11 +51,7 @@ addErrorEvent :: ToHumanFriendlyError e => e -> JobLog -> JobLog ...@@ -51,11 +51,7 @@ addErrorEvent :: ToHumanFriendlyError e => e -> JobLog -> JobLog
addErrorEvent message = addEvent "ERROR" (mkHumanFriendly message) addErrorEvent message = addEvent "ERROR" (mkHumanFriendly message)
addWarningEvent :: WarningDiagnostic -> JobLog -> JobLog addWarningEvent :: WarningDiagnostic -> JobLog -> JobLog
<<<<<<< HEAD
addWarningEvent message = addEvent "ERROR" (renderWarningDiagnostic message)
=======
addWarningEvent message = addEvent "WARNING" (renderWarningDiagnostic message) addWarningEvent message = addEvent "WARNING" (renderWarningDiagnostic message)
>>>>>>> 99c6b95c (warning in JobHandle and Monad)
jobLogProgress :: Int -> JobLog -> JobLog jobLogProgress :: Int -> JobLog -> JobLog
jobLogProgress n jl = over (scst_succeeded . _Just) (+ n) $ jobLogProgress n jl = over (scst_succeeded . _Just) (+ n) $
......
...@@ -27,7 +27,6 @@ import Servant.API.Alternative ...@@ -27,7 +27,6 @@ import Servant.API.Alternative
import Servant.API.ContentTypes import Servant.API.ContentTypes
import Gargantext.API.Errors.Types (BackendInternalError) import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.Utils.Jobs.Error
import Gargantext.Utils.Jobs.Map import Gargantext.Utils.Jobs.Map
import Gargantext.Utils.Jobs.Monad import Gargantext.Utils.Jobs.Monad
...@@ -44,7 +43,7 @@ serveJobsAPI ...@@ -44,7 +43,7 @@ serveJobsAPI
, ToJSON event, ToJSON output, MimeRender JSON output , ToJSON event, ToJSON output, MimeRender JSON output
, Foldable callback , Foldable callback
) )
=> (SJ.JobID 'SJ.Safe -> LoggerM m event -> [WarningDiagnostic] -> JobHandle m) => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
-> m env -> m env
-> t -> t
-> (JobError -> BackendInternalError) -> (JobError -> BackendInternalError)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment