-- 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 :: forall a.
(ClevelandOpsImpl ClevelandOpsBatch -> ClevelandOpsBatch a)
-> ClevelandOpsBatch a
withOpsCap ClevelandOpsImpl ClevelandOpsBatch -> ClevelandOpsBatch a
mkAction = ClevelandOpsImpl ClevelandOpsBatch -> ClevelandOpsBatch a
mkAction ClevelandOpsImpl ClevelandOpsBatch
batchedOpsImpl

instance (HasClevelandCaps caps, ClevelandBaseMonad caps ~ m) => MonadOpsInternal (ReaderT caps m) where
  withOpsCap :: forall a.
(ClevelandOpsImpl (ReaderT caps m) -> ReaderT caps m a)
-> ReaderT caps m a
withOpsCap ClevelandOpsImpl (ReaderT caps m) -> ReaderT caps m a
mkAction = do
    ClevelandOpsImpl m
opsCap :: ClevelandOpsImpl m <- (caps -> ClevelandOpsImpl m) -> ReaderT caps m (ClevelandOpsImpl m)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks caps -> ClevelandOpsImpl m
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandOpsImpl (ClevelandBaseMonad caps)
getOpsCap
    let ClevelandOpsImpl (ReaderT caps m)
opsCap' :: ClevelandOpsImpl (ReaderT caps m) =
          ClevelandOpsImpl :: forall (m :: * -> *).
(HasCallStack =>
 [OperationInfo ClevelandInput]
 -> m [OperationInfo ClevelandResult])
-> ClevelandOpsImpl m
ClevelandOpsImpl
            { coiRunOperationBatch :: HasCallStack =>
[OperationInfo ClevelandInput]
-> ReaderT caps m [OperationInfo ClevelandResult]
coiRunOperationBatch =  m [OperationInfo ClevelandResult]
-> ReaderT caps m [OperationInfo ClevelandResult]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [OperationInfo ClevelandResult]
 -> ReaderT caps m [OperationInfo ClevelandResult])
-> ([OperationInfo ClevelandInput]
    -> m [OperationInfo ClevelandResult])
-> [OperationInfo ClevelandInput]
-> ReaderT caps m [OperationInfo ClevelandResult]
forall a b c. SuperComposition a b c => a -> b -> c
... ClevelandOpsImpl m
-> HasCallStack =>
   [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
forall (m :: * -> *).
ClevelandOpsImpl m
-> HasCallStack =>
   [OperationInfo ClevelandInput] -> m [OperationInfo ClevelandResult]
coiRunOperationBatch ClevelandOpsImpl m
opsCap
            }
    ClevelandOpsImpl (ReaderT caps m) -> ReaderT caps m a
mkAction ClevelandOpsImpl (ReaderT caps m)
opsCap'