{-# LANGUAGE Safe #-}

{- |
Copyright:  (c) 2016 Stephen Diehl
            (c) 2016-2018 Serokell
            (c) 2018-2019 Kowainik
SPDX-License-Identifier: MIT
Maintainer: Kowainik <xrom.xkov@gmail.com>

Monad transformers utilities.
-}

module Relude.Monad.Trans
       ( -- * Convenient functions to work with 'Reader' monad
         usingReader
       , usingReaderT

         -- * Convenient functions to work with 'State' monad
       , evaluatingState
       , evaluatingStateT
       , executingState
       , executingStateT
       , usingState
       , usingStateT
         -- * Lifted to Transformers
       , hoistMaybe
       , hoistEither
       ) where

import Prelude (flip, fst, snd)

import Relude.Applicative (Applicative (pure))
import Relude.Functor (Functor, (<$>))
import Relude.Monad.Reexport (Either, ExceptT (..), Maybe, MaybeT (..), Reader, ReaderT, State,
                              StateT, runReader, runReaderT, runState, runStateT)


-- $setup
-- >>> import Relude

{- | Shorter and more readable alias for @flip runReaderT@.

>>> usingReaderT 42 $ asks (+5)
47
-}
usingReaderT :: r -> ReaderT r m a -> m a
usingReaderT :: r -> ReaderT r m a -> m a
usingReaderT = (ReaderT r m a -> r -> m a) -> r -> ReaderT r m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
{-# INLINE usingReaderT #-}

{- | Shorter and more readable alias for @flip runReader@.

>>> usingReader 42 $ asks (+5)
47
-}
usingReader :: r -> Reader r a -> a
usingReader :: r -> Reader r a -> a
usingReader = (Reader r a -> r -> a) -> r -> Reader r a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Reader r a -> r -> a
forall r a. Reader r a -> r -> a
runReader
{-# INLINE usingReader #-}

{- | Shorter and more readable alias for @flip runStateT@.

>>> usingStateT 0 $ put 42 >> pure False
(False,42)
-}
usingStateT :: s -> StateT s m a -> m (a, s)
usingStateT :: s -> StateT s m a -> m (a, s)
usingStateT = (StateT s m a -> s -> m (a, s)) -> s -> StateT s m a -> m (a, s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT s m a -> s -> m (a, s)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT
{-# INLINE usingStateT #-}

-- | Shorter and more readable alias for @flip runState@.
usingState :: s -> State s a -> (a, s)
usingState :: s -> State s a -> (a, s)
usingState = (State s a -> s -> (a, s)) -> s -> State s a -> (a, s)
forall a b c. (a -> b -> c) -> b -> a -> c
flip State s a -> s -> (a, s)
forall s a. State s a -> s -> (a, s)
runState
{-# INLINE usingState #-}

{- | Alias for @flip evalStateT@. It's not shorter but sometimes
more readable. Done by analogy with @using*@ functions family.
-}
evaluatingStateT :: Functor f => s -> StateT s f a -> f a
evaluatingStateT :: s -> StateT s f a -> f a
evaluatingStateT s :: s
s st :: StateT s f a
st = (a, s) -> a
forall a b. (a, b) -> a
fst ((a, s) -> a) -> f (a, s) -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> StateT s f a -> f (a, s)
forall s (m :: * -> *) a. s -> StateT s m a -> m (a, s)
usingStateT s
s StateT s f a
st
{-# INLINE evaluatingStateT #-}

{- | Alias for @flip evalState@. It's not shorter but sometimes
more readable. Done by analogy with @using*@ functions family.
-}
evaluatingState :: s -> State s a -> a
evaluatingState :: s -> State s a -> a
evaluatingState s :: s
s st :: State s a
st = (a, s) -> a
forall a b. (a, b) -> a
fst (s -> State s a -> (a, s)
forall s a. s -> State s a -> (a, s)
usingState s
s State s a
st)
{-# INLINE evaluatingState #-}

{- | Alias for @flip execStateT@. It's not shorter but sometimes
more readable. Done by analogy with @using*@ functions family.
-}
executingStateT :: Functor f => s -> StateT s f a -> f s
executingStateT :: s -> StateT s f a -> f s
executingStateT s :: s
s st :: StateT s f a
st = (a, s) -> s
forall a b. (a, b) -> b
snd ((a, s) -> s) -> f (a, s) -> f s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> StateT s f a -> f (a, s)
forall s (m :: * -> *) a. s -> StateT s m a -> m (a, s)
usingStateT s
s StateT s f a
st
{-# INLINE executingStateT #-}

{- | Alias for @flip execState@. It's not shorter but sometimes
more readable. Done by analogy with @using*@ functions family.
-}
executingState :: s -> State s a -> s
executingState :: s -> State s a -> s
executingState s :: s
s st :: State s a
st = (a, s) -> s
forall a b. (a, b) -> b
snd (s -> State s a -> (a, s)
forall s a. s -> State s a -> (a, s)
usingState s
s State s a
st)
{-# INLINE executingState #-}

-- | Lift a 'Maybe' to the 'MaybeT' monad
hoistMaybe  :: Applicative m => Maybe a -> MaybeT m a
hoistMaybe :: Maybe a -> MaybeT m a
hoistMaybe m :: Maybe a
m = m (Maybe a) -> MaybeT m a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
m)
{-# INLINE hoistMaybe #-}

-- | Lift a 'Either' to the 'ExceptT' monad
hoistEither :: Applicative m => Either e a -> ExceptT e m a
hoistEither :: Either e a -> ExceptT e m a
hoistEither e :: Either e a
e = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (Either e a -> m (Either e a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either e a
e)
{-# INLINE hoistEither #-}