-----------------------------------------------------------------------------

-- |

-- Module      :  Control.Effect.RWS.Lazy

-- Copyright   :  (c) Michael Szvetits, 2020

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- Lazy interpretations of the 'RWS'' effect.

--

-- If you don't require disambiguation of multiple RWS effects

-- (i.e., you only have one RWS effect in your monadic context),

-- you usually need the untagged interpretations.

-----------------------------------------------------------------------------

module Control.Effect.RWS.Lazy
  ( -- * Tagged Interpretations

    evalRWS'
  , execRWS'
  , runRWS'
    -- * Untagged Interpretations

  , evalRWS
  , execRWS
  , runRWS
  ) where

-- transformers

import Control.Monad.Trans.RWS.Lazy (RWST, runRWST)

import Control.Effect.Machinery (G, Via, runVia)
import Control.Effect.RWS       (RWS, RWS')

-- | Runs the RWS effect and discards the final state.

evalRWS' :: forall tag r w s m a. Functor m
         => r                                     -- ^ The initial environment.

         -> s                                     -- ^ The initial state.

         -> (RWS' tag r w s `Via` RWST r w s) m a -- ^ The program whose RWS effect should be handled.

         -> m (w, a)                              -- ^ The program with its RWS effect handled, producing the final

                                                  -- output @w@ and the result @a@.

evalRWS' :: r -> s -> Via (RWS' tag r w s) (RWST r w s) m a -> m (w, a)
evalRWS' r :: r
r s :: s
s = ((a, s, w) -> (w, a)) -> m (a, s, w) -> m (w, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s, w) -> (w, a)
forall b b a. (b, b, a) -> (a, b)
reorder (m (a, s, w) -> m (w, a))
-> (Via (RWS' tag r w s) (RWST r w s) m a -> m (a, s, w))
-> Via (RWS' tag r w s) (RWST r w s) m a
-> m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\m :: RWST r w s m a
m -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST r w s m a
m r
r s
s) (RWST r w s m a -> m (a, s, w))
-> (Via (RWS' tag r w s) (RWST r w s) m a -> RWST r w s m a)
-> Via (RWS' tag r w s) (RWST r w s) m a
-> m (a, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (RWS' tag r w s) (RWST r w s) m a -> RWST r w s m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
Via eff t m a -> t m a
runVia
  where
    reorder :: (b, b, a) -> (a, b)
reorder (a :: b
a, _, w :: a
w) = (a
w, b
a)
{-# INLINE evalRWS' #-}

-- | The untagged version of 'evalRWS''.

evalRWS :: Functor m => r -> s -> (RWS r w s `Via` RWST r w s) m a -> m (w, a)
evalRWS :: r -> s -> Via (RWS r w s) (RWST r w s) m a -> m (w, a)
evalRWS = forall k (tag :: k) r w s (m :: * -> *) a.
Functor m =>
r -> s -> Via (RWS' tag r w s) (RWST r w s) m a -> m (w, a)
forall r w s (m :: * -> *) a.
Functor m =>
r -> s -> Via (RWS' G r w s) (RWST r w s) m a -> m (w, a)
evalRWS' @G
{-# INLINE evalRWS #-}

-- | Runs the RWS effect and discards the result of the interpreted program.

execRWS' :: forall tag r w s m a. Functor m
         => r                                     -- ^ The initial environment.

         -> s                                     -- ^ The initial state.

         -> (RWS' tag r w s `Via` RWST r w s) m a -- ^ The program whose RWS effect should be handled.

         -> m (w, s)                              -- ^ The program with its RWS effect handled, producing the final

                                                  -- output @w@ and the final state @s@.

execRWS' :: r -> s -> Via (RWS' tag r w s) (RWST r w s) m a -> m (w, s)
execRWS' r :: r
r s :: s
s = ((a, s, w) -> (w, s)) -> m (a, s, w) -> m (w, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s, w) -> (w, s)
forall a b a. (a, b, a) -> (a, b)
reorder (m (a, s, w) -> m (w, s))
-> (Via (RWS' tag r w s) (RWST r w s) m a -> m (a, s, w))
-> Via (RWS' tag r w s) (RWST r w s) m a
-> m (w, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\m :: RWST r w s m a
m -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST r w s m a
m r
r s
s) (RWST r w s m a -> m (a, s, w))
-> (Via (RWS' tag r w s) (RWST r w s) m a -> RWST r w s m a)
-> Via (RWS' tag r w s) (RWST r w s) m a
-> m (a, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (RWS' tag r w s) (RWST r w s) m a -> RWST r w s m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
Via eff t m a -> t m a
runVia
  where
    reorder :: (a, b, a) -> (a, b)
reorder (_, s' :: b
s', w :: a
w) = (a
w, b
s')
{-# INLINE execRWS' #-}

-- | The untagged version of 'execRWS''.

execRWS :: Functor m => r -> s -> (RWS r w s `Via` RWST r w s) m a -> m (w, s)
execRWS :: r -> s -> Via (RWS r w s) (RWST r w s) m a -> m (w, s)
execRWS = forall k (tag :: k) r w s (m :: * -> *) a.
Functor m =>
r -> s -> Via (RWS' tag r w s) (RWST r w s) m a -> m (w, s)
forall r w s (m :: * -> *) a.
Functor m =>
r -> s -> Via (RWS' G r w s) (RWST r w s) m a -> m (w, s)
execRWS' @G
{-# INLINE execRWS #-}

-- | Runs the RWS effect and returns the final output, the final state and the result of the interpreted program.

runRWS' :: forall tag r w s m a. Functor m
        => r                                     -- ^ The initial environment.

        -> s                                     -- ^ The initial state.

        -> (RWS' tag r w s `Via` RWST r w s) m a -- ^ The program whose RWS effect should be handled.

        -> m (w, s, a)                           -- ^ The program with its RWS effect handled, producing the final

                                                 -- output @w@, the final state @s@ and the result @a@.

runRWS' :: r -> s -> Via (RWS' tag r w s) (RWST r w s) m a -> m (w, s, a)
runRWS' r :: r
r s :: s
s = ((a, s, w) -> (w, s, a)) -> m (a, s, w) -> m (w, s, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, s, w) -> (w, s, a)
forall c b a. (c, b, a) -> (a, b, c)
reorder (m (a, s, w) -> m (w, s, a))
-> (Via (RWS' tag r w s) (RWST r w s) m a -> m (a, s, w))
-> Via (RWS' tag r w s) (RWST r w s) m a
-> m (w, s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\m :: RWST r w s m a
m -> RWST r w s m a -> r -> s -> m (a, s, w)
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST r w s m a
m r
r s
s) (RWST r w s m a -> m (a, s, w))
-> (Via (RWS' tag r w s) (RWST r w s) m a -> RWST r w s m a)
-> Via (RWS' tag r w s) (RWST r w s) m a
-> m (a, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (RWS' tag r w s) (RWST r w s) m a -> RWST r w s m a
forall (eff :: Effect) (t :: Transformer) (m :: * -> *) a.
Via eff t m a -> t m a
runVia
  where
    reorder :: (c, b, a) -> (a, b, c)
reorder (a :: c
a, s' :: b
s', w :: a
w) = (a
w, b
s', c
a)
{-# INLINE runRWS' #-}

-- | The untagged version of 'runRWS''.

runRWS :: Functor m => r -> s -> (RWS r w s `Via` RWST r w s) m a -> m (w, s, a)
runRWS :: r -> s -> Via (RWS r w s) (RWST r w s) m a -> m (w, s, a)
runRWS = forall k (tag :: k) r w s (m :: * -> *) a.
Functor m =>
r -> s -> Via (RWS' tag r w s) (RWST r w s) m a -> m (w, s, a)
forall r w s (m :: * -> *) a.
Functor m =>
r -> s -> Via (RWS' G r w s) (RWST r w s) m a -> m (w, s, a)
runRWS' @G
{-# INLINE runRWS #-}