{-# LANGUAGE ConstraintKinds #-}

module Gargantext.Database.Class where

import Control.Exception.Safe (MonadCatch)
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.Config (HasConfig(..))
import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.Notifications.CentralExchange.Types qualified as CET
import Gargantext.Prelude
import Gargantext.System.Logging.Types (MonadLogger)

-- $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
  -- These 3 instances below are needed because in the transactional code
  -- we can throw 'err' as an exception, which requires 'err' to be an 'Exception'
  -- and thus have a 'Show' and 'Typeable' instances. The fact that we can catch
  -- exceptions in the evaluator of the 'DBTx' monad code means we need a 'MonadCatch'.
  , Typeable err
  , Show err
  , MonadCatch 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
  -- Due to the fact that a 'DBCmd' is essentially a DBTxCmd but with the ability to acquire
  -- a configuration, it makes sense for it to be able to emit logging messages.
  , MonadLogger m
  )

-- | 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
  , MonadLogger m
  )

-- | 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
