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

Monomorphise Jobs.Internal API on BackendInternalError

parent f186014b
...@@ -21,7 +21,9 @@ import Data.Sequence (Seq) ...@@ -21,7 +21,9 @@ import Data.Sequence (Seq)
import qualified Data.Sequence as Seq import qualified Data.Sequence as Seq
import Prelude import Prelude
import Servant.API.Alternative import Servant.API.Alternative
import Servant.API.ContentTypes
import Gargantext.API.Errors.Types (BackendInternalError)
import Gargantext.Utils.Jobs.Map import Gargantext.Utils.Jobs.Map
import Gargantext.Utils.Jobs.Monad import Gargantext.Utils.Jobs.Monad
...@@ -33,16 +35,16 @@ import qualified Servant.Job.Core as SJ ...@@ -33,16 +35,16 @@ import qualified Servant.Job.Core as SJ
import qualified Servant.Job.Types as SJ import qualified Servant.Job.Types as SJ
serveJobsAPI serveJobsAPI
:: ( Ord t, Exception e, MonadError e m :: ( Ord t, MonadError BackendInternalError m
, MonadJob m t (Seq event) output , MonadJob m t (Seq event) output
, ToJSON e, ToJSON event, ToJSON output , ToJSON event, ToJSON output, MimeRender JSON output
, Foldable callback , Foldable callback
) )
=> (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m) => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
-> m env -> m env
-> t -> t
-> (JobError -> e) -> (JobError -> BackendInternalError)
-> (env -> JobHandle m -> input -> IO (Either e output)) -> (env -> JobHandle m -> input -> IO (Either BackendInternalError output))
-> SJ.AsyncJobsServerT' ctI ctO callback event input output m -> SJ.AsyncJobsServerT' ctI ctO callback event input output m
serveJobsAPI newJobHandle getenv t joberr f serveJobsAPI newJobHandle getenv t joberr f
= newJob newJobHandle getenv t f (SJ.JobInput undefined Nothing) = newJob newJobHandle getenv t f (SJ.JobInput undefined Nothing)
...@@ -50,10 +52,10 @@ serveJobsAPI newJobHandle getenv t joberr f ...@@ -50,10 +52,10 @@ serveJobsAPI newJobHandle getenv t joberr f
:<|> serveJobAPI t joberr :<|> serveJobAPI t joberr
serveJobAPI serveJobAPI
:: forall (m :: Type -> Type) e t event output. :: forall (m :: Type -> Type) t event output.
(Ord t, MonadError e m, MonadJob m t (Seq event) output) (Ord t, MonadError BackendInternalError m, MonadJob m t (Seq event) output, MimeRender JSON output)
=> t => t
-> (JobError -> e) -> (JobError -> BackendInternalError)
-> SJ.JobID 'SJ.Unsafe -> SJ.JobID 'SJ.Unsafe
-> SJ.AsyncJobServerT event output m -> SJ.AsyncJobServerT event output m
serveJobAPI t joberr jid' = wrap' (killJob t) serveJobAPI t joberr jid' = wrap' (killJob t)
...@@ -72,14 +74,15 @@ serveJobAPI t joberr jid' = wrap' (killJob t) ...@@ -72,14 +74,15 @@ serveJobAPI t joberr jid' = wrap' (killJob t)
wrap' g limit offset = wrap (g limit offset) wrap' g limit offset = wrap (g limit offset)
newJob newJob
:: ( Ord t, Exception e, MonadJob m t (Seq event) output :: ( Ord t, MonadJob m t (Seq event) output
, ToJSON e, ToJSON event, ToJSON output , ToJSON event, ToJSON output
, MimeRender JSON output
, Foldable callbacks , Foldable callbacks
) )
=> (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m) => (SJ.JobID 'SJ.Safe -> LoggerM m event -> JobHandle m)
-> m env -> m env
-> t -> t
-> (env -> JobHandle m -> input -> IO (Either e output)) -> (env -> JobHandle m -> input -> IO (Either BackendInternalError output))
-> SJ.JobInput callbacks input -> SJ.JobInput callbacks input
-> m (SJ.JobStatus 'SJ.Safe event) -> m (SJ.JobStatus 'SJ.Safe event)
newJob newJobHandle getenv jobkind f input = do newJob newJobHandle getenv jobkind f input = do
......
...@@ -254,7 +254,7 @@ withJob :: Env ...@@ -254,7 +254,7 @@ withJob :: Env
-> IO (SJ.JobStatus 'SJ.Safe JobLog) -> IO (SJ.JobStatus 'SJ.Safe JobLog)
withJob env f = runMyDummyMonad env $ MyDummyMonad $ withJob env f = runMyDummyMonad env $ MyDummyMonad $
-- the job type doesn't matter in our tests, we use a random one, as long as it's of type 'GargJob'. -- the job type doesn't matter in our tests, we use a random one, as long as it's of type 'GargJob'.
newJob @_ @BackendInternalError mkJobHandle (pure env) RecomputeGraphJob (\_ hdl input -> newJob @_ mkJobHandle (pure env) RecomputeGraphJob (\_ hdl input ->
runMyDummyMonad env $ (Right <$> (f hdl input >> getLatestJobStatus hdl))) (SJ.JobInput () Nothing) runMyDummyMonad env $ (Right <$> (f hdl input >> getLatestJobStatus hdl))) (SJ.JobInput () Nothing)
withJob_ :: Env withJob_ :: Env
......
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