{-# LANGUAGE CPP         #-}
{-# LANGUAGE Trustworthy #-}

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

Monad transformers utilities.
-}

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

#if MIN_VERSION_base(4,10,0)
    , etaReaderT
#endif

      -- * Convenient functions to work with 'State' monad
    , evaluatingState
    , evaluatingStateT
    , executingState
    , executingStateT
    , usingState
    , usingStateT

      -- * Lifted to Transformers
    , hoistMaybe
    , hoistEither
    ) where

#if MIN_VERSION_base(4,10,0)
import GHC.Exts (oneShot)
#endif

import Relude.Applicative (Applicative (pure))
import Relude.Container.Reexport (fst, snd)
import Relude.Function (flip, (.))
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 #-}

#if MIN_VERSION_base(4,10,0)
{- | This function helps with optimizing performance when working with
the 'ReaderT' transformer. If you have code like below, that is
called in a loop

@
step :: Instruction -> 'ReaderT' Config IO Result
step instruction = __case__ instruction __of__
    Add -> __do__ stuff ...
    Del -> __do__ stuff ...
@

you can improve performance of your Haskell applications by using
'etaReaderT' in the following way:

@
step :: Instruction -> 'ReaderT' Config IO Result
step instruction = 'etaReaderT' $ __case__ instruction __of__
    Add -> __do__ stuff ...
    Del -> __do__ stuff ...
@

For a detailed explanation, refer to the following blog post:

* <https://www.joachim-breitner.de/blog/763-Faster_Winter_5__Eta-Expanding_ReaderT Faster Winter 5: Eta-Expanding ReaderT (by Joachim Breitners)>

@since 0.7.0.0
-}
etaReaderT :: ReaderT r m a -> ReaderT r m a
etaReaderT :: ReaderT r m a -> ReaderT r m a
etaReaderT = (r -> m a) -> ReaderT r m a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((r -> m a) -> ReaderT r m a)
-> (ReaderT r m a -> r -> m a) -> ReaderT r m a -> ReaderT r m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> m a) -> r -> m a
oneShot ((r -> m a) -> r -> m a)
-> (ReaderT r m a -> r -> m a) -> ReaderT r m a -> r -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT r m a -> r -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
{-# INLINE etaReaderT #-}
#endif

{- | 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

@since 0.3.0
-}
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

@since 0.3.0
-}
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 #-}