{-|
Module      : Gargantext.API.Prelude
Description : Server API main Types
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MonoLocalBinds  #-}

module Gargantext.API.Prelude
  ( module Gargantext.API.Prelude
  , HasServerError(..)
  , serverError ) where

import Control.Exception.Safe qualified as Safe
import Control.Lens ((#))
import Control.Monad.Random (MonadRandom)
import Gargantext.API.Admin.Auth.Types (AuthenticationError)
import Gargantext.API.Errors.Class (HasAuthenticationError, _AuthenticationError)
import Gargantext.API.Errors.Types (HasServerError(..), serverError, HasBackendInternalError)
import Gargantext.Core.Notifications.CentralExchange.Types (HasCentralExchangeNotification)
import Gargantext.Core.Config (HasConfig, HasManager)
import Gargantext.Core.Mail.Types (HasMail)
import Gargantext.Core.NLP (HasNLPServer)
import Gargantext.Core.NodeStory (HasNodeStory, HasNodeStoryEnv)
import Gargantext.Core.Types (HasValidationError)
import Gargantext.Database.Prelude (IsDBCmdExtra, HasConnectionPool)
import Gargantext.Database.Query.Table.Node.Error (HasNodeError(..))
import Gargantext.Database.Query.Tree (HasTreeError)
import Gargantext.Prelude
import Gargantext.System.Logging (MonadLogger)
import Gargantext.Utils.Jobs.Monad (MonadJobStatus(..), JobHandle)
import Servant

authenticationError :: (MonadError e m, HasAuthenticationError e) => AuthenticationError -> m a
authenticationError = throwError . (_AuthenticationError #)

type EnvC env =
  ( HasConnectionPool env
  , HasConfig         env
  , HasNodeStoryEnv   env
  , HasMail           env
  , HasNLPServer      env
  , HasManager        env
  , HasCentralExchangeNotification env
  )

type ErrC err =
  ( HasNodeError           err
  , HasValidationError     err
  , HasTreeError           err
  , HasServerError         err
  , HasBackendInternalError err
  , HasAuthenticationError err
--  , ToJSON               err -- TODO this is arguable
  , Exception              err
  )

type GargServerC env err m =
  ( HasNodeStory env err m
  , HasMail      env
  , MonadRandom          m
  , Safe.MonadCatch m
  , EnvC         env
  , ErrC             err
  , ToJSON           err
  )

type GargServerT env err m api = GargServerC env err m => ServerT api m

type GargServer api = forall env err m. MonadLogger m => GargServerT env err m api

class (MonadLogger m, GargServerC env err m) => IsGargServer env err m
-- = forall env err m. (MonadLogger m, GargServerC env err m) => AsServerT m

-- 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 t =
  forall env err m. GargNoServer' env err m => m t

type GargNoServer' env err m =
  ( IsDBCmdExtra env err m
  , HasNodeStory env err m
  , HasNodeError     err
  )

------------------------------------------------------------------------
-- | Utils
-- | Simulate logs
simuLogs  :: (MonadBase IO m, MonadJobStatus m) => JobHandle m -> Int -> m ()
simuLogs jobHandle t = do
  markStarted t jobHandle
  mapM_ (const simuTask) $ take t ([0,1..] :: [Int])
  markComplete jobHandle
  where
    simuTask = do
      let m = (10 :: Int) ^ (6 :: Int)
      liftBase $ threadDelay (m*5)
      markProgress 1 jobHandle