From 11d0fb47c292a0ca25a9c377499d2b221d97a5cb Mon Sep 17 00:00:00 2001 From: Volpeon Date: Fri, 26 May 2023 07:40:13 +0200 Subject: Init --- src/Data/JLD/Control/Monad/RES.hs | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) create mode 100644 src/Data/JLD/Control/Monad/RES.hs (limited to 'src/Data/JLD/Control') diff --git a/src/Data/JLD/Control/Monad/RES.hs b/src/Data/JLD/Control/Monad/RES.hs new file mode 100644 index 0000000..1c96d46 --- /dev/null +++ b/src/Data/JLD/Control/Monad/RES.hs @@ -0,0 +1,35 @@ +module Data.JLD.Control.Monad.RES ( + REST, + runREST, + evalREST, + withEnvRES, + withErrorRES, + withErrorRES', + withStateRES, +) where + +import Data.JLD.Prelude + +import Control.Monad.Except (mapExceptT) + +type REST r e s m = ReaderT r (ExceptT e (StateT s m)) + +runREST :: r -> s -> REST r e s m a -> m (Either e a, s) +runREST env st = flip runReaderT env .> runExceptT .> flip runStateT st + +evalREST :: Monad m => r -> s -> REST r e s m a -> m (Either e a) +evalREST env st = flip runReaderT env .> runExceptT .> flip evalStateT st + +withEnvRES :: (r -> r') -> REST r' e s m a -> REST r e s m a +withEnvRES fn (ReaderT m) = ReaderT <| fn .> m + +withErrorRES :: Functor m => (e' -> e) -> REST r e' s m a -> REST r e s m a +withErrorRES fn (ReaderT m) = ReaderT <| m .> mapExceptT (fmap <| first fn) + +withErrorRES' :: Monad m => (e' -> REST r e s m a) -> REST r e' s m a -> REST r e s m a +withErrorRES' fn (ReaderT m) = + ReaderT <| \r -> m r |> mapExceptT \m' -> m' >>= either (fn .> flip runReaderT r .> runExceptT) (Right .> pure) + +withStateRES :: Monad m => (s -> s') -> (s -> s' -> s) -> REST r e s' m a -> REST r e s m a +withStateRES fin fout (ReaderT m) = + ReaderT \env -> m env |> mapExceptT \st -> StateT \s -> second (fout s) <$> runStateT st (fin s) -- cgit v1.2.3-70-g09d2