diff options
Diffstat (limited to 'src/Data/JLD/Control')
-rw-r--r-- | src/Data/JLD/Control/Monad/RES.hs | 35 |
1 files changed, 35 insertions, 0 deletions
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 @@ | |||
1 | module Data.JLD.Control.Monad.RES ( | ||
2 | REST, | ||
3 | runREST, | ||
4 | evalREST, | ||
5 | withEnvRES, | ||
6 | withErrorRES, | ||
7 | withErrorRES', | ||
8 | withStateRES, | ||
9 | ) where | ||
10 | |||
11 | import Data.JLD.Prelude | ||
12 | |||
13 | import Control.Monad.Except (mapExceptT) | ||
14 | |||
15 | type REST r e s m = ReaderT r (ExceptT e (StateT s m)) | ||
16 | |||
17 | runREST :: r -> s -> REST r e s m a -> m (Either e a, s) | ||
18 | runREST env st = flip runReaderT env .> runExceptT .> flip runStateT st | ||
19 | |||
20 | evalREST :: Monad m => r -> s -> REST r e s m a -> m (Either e a) | ||
21 | evalREST env st = flip runReaderT env .> runExceptT .> flip evalStateT st | ||
22 | |||
23 | withEnvRES :: (r -> r') -> REST r' e s m a -> REST r e s m a | ||
24 | withEnvRES fn (ReaderT m) = ReaderT <| fn .> m | ||
25 | |||
26 | withErrorRES :: Functor m => (e' -> e) -> REST r e' s m a -> REST r e s m a | ||
27 | withErrorRES fn (ReaderT m) = ReaderT <| m .> mapExceptT (fmap <| first fn) | ||
28 | |||
29 | withErrorRES' :: Monad m => (e' -> REST r e s m a) -> REST r e' s m a -> REST r e s m a | ||
30 | withErrorRES' fn (ReaderT m) = | ||
31 | ReaderT <| \r -> m r |> mapExceptT \m' -> m' >>= either (fn .> flip runReaderT r .> runExceptT) (Right .> pure) | ||
32 | |||
33 | withStateRES :: Monad m => (s -> s') -> (s -> s' -> s) -> REST r e s' m a -> REST r e s m a | ||
34 | withStateRES fin fout (ReaderT m) = | ||
35 | ReaderT \env -> m env |> mapExceptT \st -> StateT \s -> second (fout s) <$> runStateT st (fin s) | ||