{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}

{- |
Copyright : Flipstone Technology Partners 2023
License   : MIT
Stability : Stable

@since 1.0.0.0
-}
module Orville.PostgreSQL.Monad.HasOrvilleState
  ( HasOrvilleState (askOrvilleState, localOrvilleState)
  )
where

import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Reader (ReaderT, ask, local, mapReaderT)

import Orville.PostgreSQL.OrvilleState (OrvilleState)

{- |
  'HasOrvilleState' is the typeclass that Orville uses to access and manange
  the connection pool and state tracking when it is being executed inside an
  unknown Monad. It is a specialized version of the Reader interface so that it
  can be easily implemented by application Monads that already have a Reader
  context and want to simply add 'OrvilleState' as an attribute to that
  context, like so

  @
    data MyApplicationState =
      MyApplicationState
        { appConfig :: MyAppConfig
        , appOrvilleState :: OrvilleState
        }

    newtype MyApplicationMonad a =
      MyApplicationMonad (ReaderT MyApplicationState IO) a

    instance HasOrvilleState MyApplicationMonad where
      askOrvilleState =
        MyApplicationMonad (asks appOrvilleState)

      localOrvilleState f (MyApplicationMonad reader) =
        MyApplicationMonad $
          local
            (\\state -> state { appOrvilleState = f (appOrvilleState state))
            reader
  @

  An instance for 'ReaderT OrvilleState m' is provided as a convenience in
  the case that your application has no extra context to track.

@since 1.0.0.0
-}
class HasOrvilleState m where
  -- |
  --     Fetches the current 'OrvilleState' from the host Monad context. The
  --     equivalent of 'ask' for 'ReaderT OrvilleState'.
  --
  -- @since 1.0.0.0
  askOrvilleState :: m OrvilleState

  -- |
  --     Applies a modification to the 'OrvilleState' that is local to the given
  --     monad operation. Calls to 'askOrvilleState' made within the 'm a' provided
  --     must return the modified state. The modified state must only apply to
  --     the given 'm a' and not be persisted beyond it. The equivalent of 'local'
  --     for 'ReaderT OrvilleState'.
  --
  -- @since 1.0.0.0
  localOrvilleState ::
    -- | The function to modify the 'OrvilleState'.
    (OrvilleState -> OrvilleState) ->
    -- | The monad operation to execute with the modified state.
    m a ->
    m a

instance Monad m => HasOrvilleState (ReaderT OrvilleState m) where
  askOrvilleState :: ReaderT OrvilleState m OrvilleState
askOrvilleState = ReaderT OrvilleState m OrvilleState
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  localOrvilleState :: forall a.
(OrvilleState -> OrvilleState)
-> ReaderT OrvilleState m a -> ReaderT OrvilleState m a
localOrvilleState = (OrvilleState -> OrvilleState)
-> ReaderT OrvilleState m a -> ReaderT OrvilleState m a
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local

instance {-# OVERLAPS #-} (Monad m, HasOrvilleState m) => HasOrvilleState (ReaderT r m) where
  askOrvilleState :: ReaderT r m OrvilleState
askOrvilleState = m OrvilleState -> ReaderT r m OrvilleState
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m OrvilleState
forall (m :: * -> *). HasOrvilleState m => m OrvilleState
askOrvilleState
  localOrvilleState :: forall a.
(OrvilleState -> OrvilleState) -> ReaderT r m a -> ReaderT r m a
localOrvilleState OrvilleState -> OrvilleState
f = (m a -> m a) -> ReaderT r m a -> ReaderT r m a
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT ((OrvilleState -> OrvilleState) -> m a -> m a
forall a. (OrvilleState -> OrvilleState) -> m a -> m a
forall (m :: * -> *) a.
HasOrvilleState m =>
(OrvilleState -> OrvilleState) -> m a -> m a
localOrvilleState OrvilleState -> OrvilleState
f)