module Control.Monad.Trans.Open
( OpenT
, OpenT'
, close
) where
import Control.Monad.Open.Class
import Control.Applicative
import Control.Monad
import Control.Monad.Catch
import Control.Monad.Cont.Class
import Control.Monad.Error.Class
import Control.Monad.RWS.Class
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Writer
import Data.Monoid
newtype OpenT a b m b'
= OpenT
{ _openT ∷ ReaderT (a → m b) m b'
} deriving (Applicative, Functor, Monad, Alternative, MonadPlus, MonadIO, MonadCont, MonadFix, MonadThrow, MonadCatch, MonadMask, MonadError e, MonadWriter w, MonadState s)
deriving instance MonadRWS r w s m ⇒ MonadRWS r w s (OpenT a b m)
instance MonadTrans (OpenT a b) where
lift = OpenT . lift
instance MonadReader r m ⇒ MonadReader r (OpenT a b m) where
ask = OpenT $ lift ask
local f (OpenT x) = OpenT . ReaderT $ local f . (runReaderT x)
type OpenT' a m b = OpenT a b m b
instance Monad m ⇒ MonadOpen a b (OpenT a b m) where
call x = do
rec ← OpenT ask
OpenT . lift $ rec x
close
∷ Monad m
⇒ Op a (OpenT a b m) b
→ a
→ m b
close o@(Op f) x =
runReaderT (_openT $ f x) $ close o