-}
-{-# LANGUAGE ConstraintKinds #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MonoLocalBinds #-}
module Gargantext.API.Prelude
( module Gargantext.API.Prelude
import Data.Aeson.Types
import Data.Typeable
import Data.Validity
-import Servant
-import Servant.Job.Async
-import Servant.Job.Core (HasServerError(..), serverError)
-
import Gargantext.API.Admin.Orchestrator.Types
import Gargantext.API.Admin.Types
-import Gargantext.API.Ngrams.Types
+import Gargantext.Core.NodeStory
import Gargantext.Core.Types
import Gargantext.Database.Prelude
import Gargantext.Database.Query.Table.Node.Error (NodeError(..), HasNodeError(..))
import Gargantext.Database.Query.Tree
import Gargantext.Prelude
+import Servant
+import Servant.Job.Async
+import Servant.Job.Core (HasServerError(..), serverError)
class HasJoseError e where
_JoseError :: Prism' e Jose.Error
joseError :: (MonadError e m, HasJoseError e) => Jose.Error -> m a
joseError = throwError . (_JoseError #)
-class ThrowAll' e a | a -> e where
- -- | 'throwAll' is a convenience function to throw errors across an entire
- -- sub-API
- --
- --
- -- > throwAll err400 :: Handler a :<|> Handler b :<|> Handler c
- -- > == throwError err400 :<|> throwError err400 :<|> err400
- throwAll' :: e -> a
-
-instance (ThrowAll' e a, ThrowAll' e b) => ThrowAll' e (a :<|> b) where
- throwAll' e = throwAll' e :<|> throwAll' e
-
--- Really this shouldn't be necessary - ((->) a) should be an instance of
--- MonadError, no?
-instance {-# OVERLAPPING #-} ThrowAll' e b => ThrowAll' e (a -> b) where
- throwAll' e = const $ throwAll' e
+type EnvC env =
+ ( HasConnectionPool env
+ , HasSettings env -- TODO rename HasDbSettings
+ , HasJobEnv env JobLog JobLog
+ , HasConfig env
+ , HasNodeStoryEnv env
+ )
-instance {-# OVERLAPPABLE #-} (MonadError e m) => ThrowAll' e (m a) where
- throwAll' = throwError
+type ErrC err =
+ ( HasNodeError err
+ , HasInvalidError err
+ , HasTreeError err
+ , HasServerError err
+ , HasJoseError err
+ , ToJSON err -- TODO this is arguable
+ , Exception err
+ )
type GargServerC env err m =
- ( CmdM env err m
- , HasNodeError err
- , HasInvalidError err
- , HasTreeError err
- , HasServerError err
- , HasJoseError err
- , ToJSON err -- TODO this is arguable
- , Exception err
- , HasRepo env -- TODO rename HasNgramsRepo
- , HasSettings env -- TODO rename HasDbSettings
- , HasJobEnv env JobLog JobLog
- , HasConfig env
- )
-
-
-type GargServer api =
- forall env err m. GargServerT env err m api
+ ( CmdRandom env err m
+ , HasNodeStory env err m
+ , EnvC env
+ , ErrC err
+ , MimeRender JSON err
+ )
type GargServerT env err m api = GargServerC env err m => ServerT api m
--- This is the concrete monad. It needs to be used as little as possible,
--- instead, prefer GargServer, GargServerT, GargServerC.
-type GargServerM env err = ReaderT env (ExceptT err IO)
+type GargServer api = forall env err m. GargServerT env err m api
-type EnvC env =
- ( HasConnectionPool env
- , HasRepo env
- , HasSettings env
- , HasJobEnv env JobLog JobLog
- , HasConfig env
- )
+-- This is the concrete monad. It needs to be used as little as possible.
+type GargM env err = ReaderT env (ExceptT err IO)
+-- This is the server type using GargM. It needs to be used as little as possible.
+-- Instead, prefer GargServer, GargServerT.
+type GargServerM env err api = (EnvC env, ErrC err) => ServerT api (GargM env err)
-------------------------------------------------------------------
-- | This Type is needed to prepare the function before the GargServer
type GargNoServer' env err m =
( CmdM env err m
- , HasRepo env
+ , HasNodeStory env err m
, HasSettings env
, HasNodeError err
)