{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------
-- |
-- 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 (EachVia, makeUntagged, runVia)
import Control.Effect.Reader    (Reader, Reader')
import Control.Effect.RWS       (RWS, RWS')
import Control.Effect.State     (State, State')
import Control.Effect.Writer    (Writer, Writer')

-- | 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, Reader' tag r, Writer' tag w, State' tag s] `EachVia` 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
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (w, a)
evalRWS' r
r 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))
-> (EachVia
      '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
      (RWST r w s)
      m
      a
    -> m (a, s, w))
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\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))
-> (EachVia
      '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
      (RWST r w s)
      m
      a
    -> RWST r w s m a)
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (a, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EachVia
  '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
  (RWST r w s)
  m
  a
-> RWST r w s m a
forall (effs :: [(* -> *) -> Constraint]) (t :: Transformer)
       (m :: * -> *) a.
EachVia effs t m a -> t m a
runVia
  where
    reorder :: (b, b, a) -> (a, b)
reorder (b
a, b
_, a
w) = (a
w, b
a)
{-# 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, Reader' tag r, Writer' tag w, State' tag s] `EachVia` 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
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (w, s)
execRWS' r
r 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))
-> (EachVia
      '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
      (RWST r w s)
      m
      a
    -> m (a, s, w))
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (w, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\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))
-> (EachVia
      '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
      (RWST r w s)
      m
      a
    -> RWST r w s m a)
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (a, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EachVia
  '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
  (RWST r w s)
  m
  a
-> RWST r w s m a
forall (effs :: [(* -> *) -> Constraint]) (t :: Transformer)
       (m :: * -> *) a.
EachVia effs t m a -> t m a
runVia
  where
    reorder :: (a, b, a) -> (a, b)
reorder (a
_, b
s', a
w) = (a
w, b
s')
{-# 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, Reader' tag r, Writer' tag w, State' tag s] `EachVia` 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
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (w, s, a)
runRWS' r
r 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))
-> (EachVia
      '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
      (RWST r w s)
      m
      a
    -> m (a, s, w))
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (w, s, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\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))
-> (EachVia
      '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
      (RWST r w s)
      m
      a
    -> RWST r w s m a)
-> EachVia
     '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
     (RWST r w s)
     m
     a
-> m (a, s, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EachVia
  '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
  (RWST r w s)
  m
  a
-> RWST r w s m a
forall (effs :: [(* -> *) -> Constraint]) (t :: Transformer)
       (m :: * -> *) a.
EachVia effs t m a -> t m a
runVia
  where
    reorder :: (c, b, a) -> (a, b, c)
reorder (c
a, b
s', a
w) = (a
w, b
s', c
a)
{-# INLINE runRWS' #-}

makeUntagged ['evalRWS', 'execRWS', 'runRWS']