{-# LANGUAGE ConstraintKinds #-} module Gargantext.Database.Class where import Control.Lens (Getter) import Control.Monad.Random ( MonadRandom ) import Control.Monad.Trans.Control (MonadBaseControl) import Data.Pool (Pool) import Database.PostgreSQL.Simple (Connection) import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET import Gargantext.Core.Config (HasConfig(..)) import Gargantext.Core.Mail.Types (HasMail) import Gargantext.Core.NLP (HasNLPServer) import Gargantext.Prelude -- $typesAndConstraints -- -- The names of the constraints and types in this module are chosen based on -- the following guidelines: -- * By default, constraints are relatively lenient. Stricter constraints are -- obtained by appending the `Extra` suffix to the minimal constraint name. -- * `IsDBEnv(Extra)` applies to the environment; the basic constraint allows -- access to the database, and the `Extra` variant offers some more -- capabilities such as access to mail. -- * `IsCmd` is the basic constraint for command monads. Append `DB` to it to get -- a monad of commands that can talk to the database. Append `Extra` to get -- the ability to send mail, make use of the NLP server and deal with central -- exchange notifications. Append `Random` to get access to randomness. -- * Existential versions of the constraints bear the same name as the constraint -- they are based on, but without the `Is` prefix. class HasConnectionPool env where connPool :: Getter env (Pool Connection) instance HasConnectionPool (Pool Connection) where connPool = identity -- | The most basic constraints for an environment with a database. -- If possible, try to not add more constraints here. When performing -- a query/update on the DB, one shouldn't need more than being able to -- fetch from the underlying 'env' the connection pool and access the -- 'GargConfig' for some sensible defaults to store into the DB. type IsDBEnv env = ( HasConnectionPool env , HasConfig env ) -- | Constraints for a full-fledged environment, with a database, mail exchange, -- NLP processing, notifications. type IsDBEnvExtra env = ( IsDBEnv env , HasMail env , HasNLPServer env , CET.HasCentralExchangeNotification env ) -- | The most general constraints for commands. To interact with the database, -- or access extra features (such as sending mail), you'll need to add some more -- constraints (see the rest of this module) type IsCmd env err m = ( MonadReader env m , MonadError err m , MonadBaseControl IO m ) -- | Only the /minimum/ amount of class constraints required -- to use the Gargantext Database. It's important, to ease testability, -- that these constraints stays as few as possible. type IsDBCmd env err m = ( IsCmd env err m , IsDBEnv env ) -- | Full-fledged command class. Types in this class provide commands that can -- interact with the database, perform NLP processing, etc. type IsDBCmdExtra env err m = ( IsCmd env err m , IsDBEnvExtra env ) -- | Basic command with access to randomness. It feels a little ad hoc to have -- such a constraint instead of substituting it (and its counterpart existential -- type `CmdRandom`) with its definition every time it appears in the codebase, -- but I tried to doing that substitution and it wasn't so easy. type IsCmdRandom env err m = ( IsCmd env err m , MonadRandom m ) -- | Barebones command type, without any built-in ability to interact with the -- database or do stuff like email exchanges. type Cmd env err a = forall m. IsCmd env err m => m a -- | Basic command type with access to randomness type CmdRandom env err a = forall m. IsCmdRandom env err m => m a -- | Command type that allows for interaction with the database. type DBCmd err a = forall m env. IsDBCmd env err m => m a -- | Command type that allows for interaction with the database. Similar to -- `DBCmd`, except you can constraint the environment type some more. type DBCmdWithEnv env err a = forall m. IsDBCmd env err m => m a -- | Full-fledged command types, with access to the database, mail, NLP -- processing and central exchange notifications. type DBCmdExtra err a = forall m env. IsDBCmdExtra env err m => m a