Commit c45dba95 authored by Nicolas Pouillard's avatar Nicolas Pouillard

Update to lasted version of servant-job

parent a31740fe
...@@ -11,7 +11,7 @@ import Data.Text (Text) ...@@ -11,7 +11,7 @@ import Data.Text (Text)
import GHC.Generics import GHC.Generics
import Servant import Servant
import Servant.Job.Utils (jsonOptions) import Servant.Job.Utils (jsonOptions)
import Servant.Client.Streaming import Servant.Client
import Web.FormUrlEncoded hiding (parseMaybe) import Web.FormUrlEncoded hiding (parseMaybe)
data Schedule = Schedule data Schedule = Schedule
......
...@@ -16,6 +16,7 @@ Portability : POSIX ...@@ -16,6 +16,7 @@ Portability : POSIX
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
...@@ -33,6 +34,7 @@ import Control.Lens (Prism', (#)) ...@@ -33,6 +34,7 @@ import Control.Lens (Prism', (#))
import Control.Lens.TH (makePrisms) import Control.Lens.TH (makePrisms)
import Control.Monad.Error.Class (MonadError(throwError)) import Control.Monad.Error.Class (MonadError(throwError))
import Crypto.JOSE.Error as Jose import Crypto.JOSE.Error as Jose
import Data.Aeson.Types
import Data.Typeable import Data.Typeable
import Data.Validity import Data.Validity
import Servant import Servant
...@@ -42,8 +44,8 @@ import Gargantext.Prelude ...@@ -42,8 +44,8 @@ import Gargantext.Prelude
import Gargantext.API.Settings import Gargantext.API.Settings
import Gargantext.API.Orchestrator.Types import Gargantext.API.Orchestrator.Types
import Gargantext.API.Ngrams import Gargantext.API.Ngrams
import Gargantext.Database.Tree
import Gargantext.Core.Types import Gargantext.Core.Types
import Gargantext.Database.Tree
import Gargantext.Database.Utils import Gargantext.Database.Utils
import Gargantext.Database.Schema.Node import Gargantext.Database.Schema.Node
...@@ -80,6 +82,7 @@ type GargServerC env err m = ...@@ -80,6 +82,7 @@ type GargServerC env err m =
, HasTreeError err , HasTreeError err
, HasServerError err , HasServerError err
, HasJoseError err , HasJoseError err
, ToJSON err -- TODO this is arguable
, Exception err , Exception err
, HasRepo env , HasRepo env
, HasSettings env , HasSettings env
...@@ -101,6 +104,9 @@ data GargError ...@@ -101,6 +104,9 @@ data GargError
makePrisms ''GargError makePrisms ''GargError
instance ToJSON GargError where
toJSON _ = String "SomeGargErrorPleaseReport"
instance Exception GargError instance Exception GargError
instance HasNodeError GargError where instance HasNodeError GargError where
......
...@@ -35,9 +35,9 @@ extra-deps: ...@@ -35,9 +35,9 @@ extra-deps:
# #
- git: https://gitlab.iscpif.fr/gargantext/patches-class - git: https://gitlab.iscpif.fr/gargantext/patches-class
commit: 746b4ce0af8f9e600d555ad7e5b2973a940cdad9 commit: 746b4ce0af8f9e600d555ad7e5b2973a940cdad9
- git: https://github.com/delanoe/servant-job.git #- git: https://github.com/delanoe/servant-job.git
#- git: https://github.com/np/servant-job.git - git: https://github.com/np/servant-job.git
commit: 3fee20ed7743097d795769ffad8e1866fbd3c665 commit: 471f4952d2aa72bd373f850255a662442ad58c94
- git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git - git: https://gitlab.iscpif.fr/gargantext/clustering-louvain.git
commit: 1c636112b151110408e7c5a28cec39e46657358e commit: 1c636112b151110408e7c5a28cec39e46657358e
- git: https://github.com/np/patches-map - git: https://github.com/np/patches-map
......
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