MonadOps.hs

-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_HADDOCK not-home #-}

-- | Internally used typeclass for operations-related actions
module Test.Cleveland.Internal.Actions.MonadOps
  ( module Test.Cleveland.Internal.Actions.MonadOps
  ) where

import Test.Cleveland.Internal.Abstract

-- | Typeclass for monads where operations-related actions can occur.
--
-- This is implemented for 'MonadCleveland' and batch context.
--
-- Has 'Functor' as a superclass constraint for convenience, all the related methods
-- require it.
--
-- This is used internally to implement @originate@ and @transfer@. There is a
-- more specific, more user-friendly @MonadOps@ class defined in
-- "Test.Cleveland.Internal.Actions".
class Functor m => MonadOpsInternal m where
  -- | Obtain 'ClevelandOpsImpl' suitable for the current \"monad\".
  --
  -- In CPS style, because the \"monad\" can be actually not a monad, so
  -- it can't work like 'ask' for 'ReaderT'.
  withOpsCap :: (ClevelandOpsImpl m -> m a) -> m a

instance MonadOpsInternal ClevelandOpsBatch where
  withOpsCap mkAction = mkAction batchedOpsImpl

instance (HasClevelandCaps caps, ClevelandBaseMonad caps ~ m) => MonadOpsInternal (ReaderT caps m) where
  withOpsCap mkAction = do
    opsCap :: ClevelandOpsImpl m <- asks getOpsCap
    let opsCap' :: ClevelandOpsImpl (ReaderT caps m) =
          ClevelandOpsImpl
            { coiRunOperationBatch =  lift ... coiRunOperationBatch opsCap
            }
    mkAction opsCap'