Commit cb861bf2 authored by Alfredo Di Napoli's avatar Alfredo Di Napoli

Remove superclass constraint of MonadJob for MonadJobStatus

parent 97e04297
Pipeline #3855 failed with stage
in 33 minutes and 1 second
...@@ -200,7 +200,6 @@ data DevEnv = DevEnv ...@@ -200,7 +200,6 @@ data DevEnv = DevEnv
, _dev_env_nodeStory :: !NodeStoryEnv , _dev_env_nodeStory :: !NodeStoryEnv
, _dev_env_mail :: !MailConfig , _dev_env_mail :: !MailConfig
, _dev_env_nlp :: !NLPServerMap , _dev_env_nlp :: !NLPServerMap
, _dev_env_jobs :: !(Jobs.JobEnv GargJob (Seq JobLog) JobLog)
} }
makeLenses ''DevEnv makeLenses ''DevEnv
...@@ -208,9 +207,6 @@ makeLenses ''DevEnv ...@@ -208,9 +207,6 @@ makeLenses ''DevEnv
-- | Our /mock/ job handle. -- | Our /mock/ job handle.
data DevJobHandle = DevJobHandle data DevJobHandle = DevJobHandle
instance Jobs.MonadJob (GargM DevEnv err) GargJob (Seq JobLog) JobLog where
getJobEnv = asks (view dev_env_jobs)
instance Jobs.MonadJobStatus (GargM DevEnv err) where instance Jobs.MonadJobStatus (GargM DevEnv err) where
type JobHandle (GargM DevEnv err) = DevJobHandle type JobHandle (GargM DevEnv err) = DevJobHandle
......
...@@ -9,8 +9,6 @@ Portability : POSIX ...@@ -9,8 +9,6 @@ Portability : POSIX
-} -}
{-# LANGUAGE ScopedTypeVariables #-}
-- Use only for dev/repl -- Use only for dev/repl
module Gargantext.API.Dev where module Gargantext.API.Dev where
...@@ -27,11 +25,8 @@ import Gargantext.Core.NodeStory ...@@ -27,11 +25,8 @@ import Gargantext.Core.NodeStory
import Gargantext.Database.Prelude import Gargantext.Database.Prelude
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Prelude.Config (readConfig) import Gargantext.Prelude.Config (readConfig)
import Network.HTTP.Client.TLS (newTlsManager)
import qualified Gargantext.Prelude.Mail as Mail import qualified Gargantext.Prelude.Mail as Mail
import qualified Gargantext.Prelude.NLP as NLP import qualified Gargantext.Prelude.NLP as NLP
import qualified Gargantext.Utils.Jobs.Monad as Jobs
import qualified Gargantext.Utils.Jobs.Queue as Jobs
import Servant import Servant
import System.IO (FilePath) import System.IO (FilePath)
...@@ -52,10 +47,6 @@ withDevEnv iniPath k = do ...@@ -52,10 +47,6 @@ withDevEnv iniPath k = do
setts <- devSettings devJwkFile setts <- devSettings devJwkFile
mail <- Mail.readConfig iniPath mail <- Mail.readConfig iniPath
nlp_config <- NLP.readConfig iniPath nlp_config <- NLP.readConfig iniPath
secret <- Jobs.genSecret
let jobs_settings = Jobs.defaultJobSettings 1 secret
manager_env <- newTlsManager
jobs_env <- Jobs.newJobEnv jobs_settings Jobs.defaultPrios manager_env
pure $ DevEnv pure $ DevEnv
{ _dev_env_pool = pool { _dev_env_pool = pool
, _dev_env_nodeStory = nodeStory_env , _dev_env_nodeStory = nodeStory_env
...@@ -63,14 +54,8 @@ withDevEnv iniPath k = do ...@@ -63,14 +54,8 @@ withDevEnv iniPath k = do
, _dev_env_config = cfg , _dev_env_config = cfg
, _dev_env_mail = mail , _dev_env_mail = mail
, _dev_env_nlp = nlpServerMap nlp_config , _dev_env_nlp = nlpServerMap nlp_config
, _dev_env_jobs = jobs_env
} }
type DevCmd env err a = forall m. (
CmdM'' env err m
, Jobs.MonadJobStatus m
) => m a
-- | Run Cmd Sugar for the Repl (GHCI) -- | Run Cmd Sugar for the Repl (GHCI)
runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a runCmdRepl :: Show err => Cmd'' DevEnv err a -> IO a
runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f runCmdRepl f = withDevEnv "gargantext.ini" $ \env -> runCmdDev env f
...@@ -82,11 +67,9 @@ runCmdReplServantErr = runCmdRepl ...@@ -82,11 +67,9 @@ runCmdReplServantErr = runCmdRepl
-- the command. -- the command.
-- This function is constrained to the DevEnv rather than -- This function is constrained to the DevEnv rather than
-- using HasConnectionPool and HasRepoVar. -- using HasConnectionPool and HasRepoVar.
runCmdDev :: Show err => DevEnv -> DevCmd DevEnv err a -> IO a runCmdDev :: Show err => DevEnv -> Cmd'' DevEnv err a -> IO a
runCmdDev env cmd = runCmdDev env f =
(either (fail . show) pure =<< runExceptT (runReaderT cmd env)) (either (fail . show) pure =<< runCmd env f)
`finally`
runReaderT saveNodeStoryImmediate env
runCmdGargDev :: DevEnv -> GargM DevEnv GargError a -> IO a runCmdGargDev :: DevEnv -> GargM DevEnv GargError a -> IO a
runCmdGargDev env cmd = runCmdGargDev env cmd =
......
{-# LANGUAGE MultiWayIf, FunctionalDependencies, MultiParamTypeClasses, TypeFamilies, TypeFamilyDependencies #-} {-# LANGUAGE MultiWayIf, FunctionalDependencies, MultiParamTypeClasses, TypeFamilies #-}
module Gargantext.Utils.Jobs.Monad ( module Gargantext.Utils.Jobs.Monad (
-- * Types and classes -- * Types and classes
JobEnv(..) JobEnv(..)
...@@ -37,7 +37,6 @@ import Control.Monad.Except ...@@ -37,7 +37,6 @@ import Control.Monad.Except
import Control.Monad.Reader import Control.Monad.Reader
import Data.Kind (Type) import Data.Kind (Type)
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
import Data.Sequence (Seq)
import Data.Time.Clock import Data.Time.Clock
import qualified Data.Text as T import qualified Data.Text as T
import Network.HTTP.Client (Manager) import Network.HTTP.Client (Manager)
...@@ -174,7 +173,7 @@ removeJob queued t jid = do ...@@ -174,7 +173,7 @@ removeJob queued t jid = do
-- --
-- | A monad to query for the status of a particular job /and/ submit updates for in-progress jobs. -- | A monad to query for the status of a particular job /and/ submit updates for in-progress jobs.
class MonadJob m (JobType m) (Seq (JobEventType m)) (JobOutputType m) => MonadJobStatus m where class MonadJobStatus m where
-- | This is type family for the concrete 'JobHandle' that is associated to -- | This is type family for the concrete 'JobHandle' that is associated to
-- a job when it starts and it can be used to query for its completion status. Different environment -- a job when it starts and it can be used to query for its completion status. Different environment
...@@ -187,7 +186,7 @@ class MonadJob m (JobType m) (Seq (JobEventType m)) (JobOutputType m) => MonadJo ...@@ -187,7 +186,7 @@ class MonadJob m (JobType m) (Seq (JobEventType m)) (JobOutputType m) => MonadJo
-- | Retrevies the latest 'JobEventType' from the underlying monad. It can be -- | Retrevies the latest 'JobEventType' from the underlying monad. It can be
-- used to query the latest status for a particular job, given its 'JobHandle' as input. -- used to query the latest status for a particular job, given its 'JobHandle' as input.
getLatestJobStatus :: MonadJobStatus m => JobHandle m -> m (JobEventType m) getLatestJobStatus :: JobHandle m -> m (JobEventType m)
-- | Adds an extra \"tracer\" that logs events to the passed action. Produces -- | Adds an extra \"tracer\" that logs events to the passed action. Produces
-- a new 'JobHandle'. -- a new 'JobHandle'.
......
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