src/Data/JLD/Control/Monad/RES.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39

module Data.JLD.Control.Monad.RES (
    REST,
    runREST,
    evalREST,
    execREST,
    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

execREST :: Monad m => r -> s -> REST r e s m a -> m s
execREST env st = flip runReaderT env .> runExceptT .> flip execStateT 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)