{-# LANGUAGE TemplateHaskell #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Effect.RWS
-- Copyright   :  (c) Michael Szvetits, 2020
-- License     :  BSD3 (see the file LICENSE)
-- Maintainer  :  typedbyte@qualified.name
-- Stability   :  stable
-- Portability :  portable
--
-- The effect that combines the reader, writer and state effect, similar to the
-- @MonadRWS@ type class from the @mtl@ library.
--
-- Lazy and strict interpretations of the effect are available here:
-- "Control.Effect.RWS.Lazy" and "Control.Effect.RWS.Strict".
-----------------------------------------------------------------------------
module Control.Effect.RWS
  ( -- * Tagged RWS Effect
    RWS'
    -- * Untagged RWS Effect
    -- | If you don't require disambiguation of multiple RWS effects
    -- (i.e., you only have one RWS effect in your monadic context),
    -- it is recommended to always use the untagged RWS effect.
  , RWS
    -- * Interpretations
  , Separation
  , runSeparatedRWS'
  , runSeparatedRWS
    -- * Tagging and Untagging
    -- | Conversion functions between the tagged and untagged RWS effect,
    -- usually used in combination with type applications, like:
    --
    -- @
    --     'tagRWS'' \@\"newTag\" program
    --     'retagRWS'' \@\"oldTag\" \@\"newTag\" program
    --     'untagRWS'' \@\"erasedTag\" program
    -- @
    -- 
  , tagRWS'
  , retagRWS'
  , untagRWS'
  ) where

-- base
import Data.Coerce (coerce)

-- transformers
import qualified Control.Monad.Trans.RWS.CPS  as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy

import qualified Control.Effect.Reader as R
import qualified Control.Effect.State  as S
import qualified Control.Effect.Writer as W

import Control.Effect.Machinery hiding (Tagger)

-- | An effect that adds the following features to a given computation:
--
--     * (R) an immutable environment (the \"reader\" part)
--     * (W) a write-only, accumulated output (the \"writer\" part)
--     * (S) a mutable state (the \"state\" part)
--
-- @since 0.2.0.0
class (R.Reader' tag r m, W.Writer' tag w m, S.State' tag s m) => RWS' tag r w s m | tag m -> r w s

makeTaggedEffect ''RWS'

instance (Monad m, Monoid w) => RWS' tag r w s (Lazy.RWST r w s m)
instance (Monad m, Monoid w) => RWS' tag r w s (Strict.RWST r w s m)

-- | The separation interpreter of the RWS effect. This type implements the 'RWS''
-- type class by splitting the effect into separate 'R.Reader'', 'W.Writer'' and
-- 'S.State'' effects which can then be interpreted individually.
--
-- When interpreting the effect, you usually don\'t interact with this type directly,
-- but instead use one of its corresponding interpretation functions.
newtype Separation m a =
  Separation { Separation m a -> m a
runSeparation :: m a }
    deriving (Functor (Separation m)
a -> Separation m a
Functor (Separation m)
-> (forall a. a -> Separation m a)
-> (forall a b.
    Separation m (a -> b) -> Separation m a -> Separation m b)
-> (forall a b c.
    (a -> b -> c)
    -> Separation m a -> Separation m b -> Separation m c)
-> (forall a b. Separation m a -> Separation m b -> Separation m b)
-> (forall a b. Separation m a -> Separation m b -> Separation m a)
-> Applicative (Separation m)
Separation m a -> Separation m b -> Separation m b
Separation m a -> Separation m b -> Separation m a
Separation m (a -> b) -> Separation m a -> Separation m b
(a -> b -> c) -> Separation m a -> Separation m b -> Separation m c
forall a. a -> Separation m a
forall a b. Separation m a -> Separation m b -> Separation m a
forall a b. Separation m a -> Separation m b -> Separation m b
forall a b.
Separation m (a -> b) -> Separation m a -> Separation m b
forall a b c.
(a -> b -> c) -> Separation m a -> Separation m b -> Separation m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (Separation m)
forall (m :: * -> *) a. Applicative m => a -> Separation m a
forall (m :: * -> *) a b.
Applicative m =>
Separation m a -> Separation m b -> Separation m a
forall (m :: * -> *) a b.
Applicative m =>
Separation m a -> Separation m b -> Separation m b
forall (m :: * -> *) a b.
Applicative m =>
Separation m (a -> b) -> Separation m a -> Separation m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> Separation m a -> Separation m b -> Separation m c
<* :: Separation m a -> Separation m b -> Separation m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
Separation m a -> Separation m b -> Separation m a
*> :: Separation m a -> Separation m b -> Separation m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
Separation m a -> Separation m b -> Separation m b
liftA2 :: (a -> b -> c) -> Separation m a -> Separation m b -> Separation m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> Separation m a -> Separation m b -> Separation m c
<*> :: Separation m (a -> b) -> Separation m a -> Separation m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
Separation m (a -> b) -> Separation m a -> Separation m b
pure :: a -> Separation m a
$cpure :: forall (m :: * -> *) a. Applicative m => a -> Separation m a
$cp1Applicative :: forall (m :: * -> *). Applicative m => Functor (Separation m)
Applicative, a -> Separation m b -> Separation m a
(a -> b) -> Separation m a -> Separation m b
(forall a b. (a -> b) -> Separation m a -> Separation m b)
-> (forall a b. a -> Separation m b -> Separation m a)
-> Functor (Separation m)
forall a b. a -> Separation m b -> Separation m a
forall a b. (a -> b) -> Separation m a -> Separation m b
forall (m :: * -> *) a b.
Functor m =>
a -> Separation m b -> Separation m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Separation m a -> Separation m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Separation m b -> Separation m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> Separation m b -> Separation m a
fmap :: (a -> b) -> Separation m a -> Separation m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> Separation m a -> Separation m b
Functor, Applicative (Separation m)
a -> Separation m a
Applicative (Separation m)
-> (forall a b.
    Separation m a -> (a -> Separation m b) -> Separation m b)
-> (forall a b. Separation m a -> Separation m b -> Separation m b)
-> (forall a. a -> Separation m a)
-> Monad (Separation m)
Separation m a -> (a -> Separation m b) -> Separation m b
Separation m a -> Separation m b -> Separation m b
forall a. a -> Separation m a
forall a b. Separation m a -> Separation m b -> Separation m b
forall a b.
Separation m a -> (a -> Separation m b) -> Separation m b
forall (m :: * -> *). Monad m => Applicative (Separation m)
forall (m :: * -> *) a. Monad m => a -> Separation m a
forall (m :: * -> *) a b.
Monad m =>
Separation m a -> Separation m b -> Separation m b
forall (m :: * -> *) a b.
Monad m =>
Separation m a -> (a -> Separation m b) -> Separation m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Separation m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> Separation m a
>> :: Separation m a -> Separation m b -> Separation m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
Separation m a -> Separation m b -> Separation m b
>>= :: Separation m a -> (a -> Separation m b) -> Separation m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
Separation m a -> (a -> Separation m b) -> Separation m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (Separation m)
Monad, Monad (Separation m)
Monad (Separation m)
-> (forall a. IO a -> Separation m a) -> MonadIO (Separation m)
IO a -> Separation m a
forall a. IO a -> Separation m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (Separation m)
forall (m :: * -> *) a. MonadIO m => IO a -> Separation m a
liftIO :: IO a -> Separation m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> Separation m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (Separation m)
MonadIO)
    deriving (m a -> Separation m a
(forall (m :: * -> *) a. Monad m => m a -> Separation m a)
-> MonadTrans Separation
forall (m :: * -> *) a. Monad m => m a -> Separation m a
forall (t :: Transformer).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> Separation m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> Separation m a
MonadTrans, MonadTrans Separation
m (StT Separation a) -> Separation m a
MonadTrans Separation
-> (forall (m :: * -> *) a.
    Monad m =>
    (Run Separation -> m a) -> Separation m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT Separation a) -> Separation m a)
-> MonadTransControl Separation
(Run Separation -> m a) -> Separation m a
forall (m :: * -> *) a.
Monad m =>
m (StT Separation a) -> Separation m a
forall (m :: * -> *) a.
Monad m =>
(Run Separation -> m a) -> Separation m a
forall (t :: Transformer).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT Separation a) -> Separation m a
$crestoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT Separation a) -> Separation m a
liftWith :: (Run Separation -> m a) -> Separation m a
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run Separation -> m a) -> Separation m a
$cp1MonadTransControl :: MonadTrans Separation
MonadTransControl) via IdentityT
    deriving (MonadBase b, MonadBaseControl b)

-- The following three "boring" instances are needed by hand, since GHC 8.6 cannot
-- derive them. With newer GHCs, you can derive these instances by adding above:
-- deriving (R.Reader' tag r, W.Writer' tag w, S.State' tag s)
instance R.Reader' tag r m => R.Reader' tag r (Separation m) where
  ask' :: Separation m r
ask' = m r -> Separation m r
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation (forall k (tag :: k) r (m :: * -> *). Reader' tag r m => m r
forall r (m :: * -> *). Reader' tag r m => m r
R.ask' @tag)
  {-# INLINE ask' #-}
  local' :: (r -> r) -> Separation m a -> Separation m a
local' r -> r
f Separation m a
m = m a -> Separation m a
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation ((r -> r) -> m a -> m a
forall k (tag :: k) r (m :: * -> *) a.
Reader' tag r m =>
(r -> r) -> m a -> m a
R.local' @tag r -> r
f (Separation m a -> m a
forall k (m :: k -> *) (a :: k). Separation m a -> m a
runSeparation Separation m a
m))
  {-# INLINE local' #-}
  reader' :: (r -> a) -> Separation m a
reader' r -> a
f = m a -> Separation m a
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation ((r -> a) -> m a
forall k (tag :: k) r (m :: * -> *) a.
Reader' tag r m =>
(r -> a) -> m a
R.reader' @tag r -> a
f)
  {-# INLINE reader' #-}

instance W.Writer' tag w m => W.Writer' tag w (Separation m) where
  tell' :: w -> Separation m ()
tell' w
w = m () -> Separation m ()
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation (w -> m ()
forall k (tag :: k) w (m :: * -> *). Writer' tag w m => w -> m ()
W.tell' @tag w
w)
  {-# INLINE tell' #-}
  listen' :: Separation m a -> Separation m (w, a)
listen' Separation m a
m = m (w, a) -> Separation m (w, a)
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation (m a -> m (w, a)
forall k (tag :: k) w (m :: * -> *) a.
Writer' tag w m =>
m a -> m (w, a)
W.listen' @tag (Separation m a -> m a
forall k (m :: k -> *) (a :: k). Separation m a -> m a
runSeparation Separation m a
m))
  {-# INLINE listen' #-}
  censor' :: (w -> w) -> Separation m a -> Separation m a
censor' w -> w
f Separation m a
m = m a -> Separation m a
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation ((w -> w) -> m a -> m a
forall k (tag :: k) w (m :: * -> *) a.
Writer' tag w m =>
(w -> w) -> m a -> m a
W.censor' @tag w -> w
f (Separation m a -> m a
forall k (m :: k -> *) (a :: k). Separation m a -> m a
runSeparation Separation m a
m))
  {-# INLINE censor' #-}

instance S.State' tag s m => S.State' tag s (Separation m) where
  get' :: Separation m s
get' = m s -> Separation m s
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation (forall k (tag :: k) s (m :: * -> *). State' tag s m => m s
forall s (m :: * -> *). State' tag s m => m s
S.get' @tag)
  {-# INLINE get' #-}
  put' :: s -> Separation m ()
put' s
s = m () -> Separation m ()
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation (s -> m ()
forall k (tag :: k) s (m :: * -> *). State' tag s m => s -> m ()
S.put' @tag s
s)
  {-# INLINE put' #-}
  state' :: (s -> (s, a)) -> Separation m a
state' s -> (s, a)
f = m a -> Separation m a
forall k (m :: k -> *) (a :: k). m a -> Separation m a
Separation ((s -> (s, a)) -> m a
forall k (tag :: k) s (m :: * -> *) a.
State' tag s m =>
(s -> (s, a)) -> m a
S.state' @tag s -> (s, a)
f)
  {-# INLINE state' #-}

instance (R.Reader' tag r m, W.Writer' tag w m, S.State' tag s m) => RWS' tag r w s (Separation m)

-- | Runs the RWS effect via separation.
runSeparatedRWS'
  :: ('[RWS' tag r w s, R.Reader' tag r, W.Writer' tag w, S.State' tag s] `EachVia` Separation) m a
  -- ^ The program whose RWS effect should be handled.
  -> m a
  -- ^ The program with its RWS effect handled.
runSeparatedRWS' :: EachVia
  '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
  Separation
  m
  a
-> m a
runSeparatedRWS' = EachVia
  '[RWS' tag r w s, Reader' tag r, Writer' tag w, State' tag s]
  Separation
  m
  a
-> m a
coerce
{-# INLINE runSeparatedRWS' #-}

-- | The untagged version of 'runSeparatedRWS''.
runSeparatedRWS :: ('[RWS r w s, R.Reader r, W.Writer w, S.State s] `EachVia` Separation) m a -> m a
runSeparatedRWS :: EachVia '[RWS r w s, Reader r, Writer w, State s] Separation m a
-> m a
runSeparatedRWS = EachVia '[RWS r w s, Reader r, Writer w, State s] Separation m a
-> m a
coerce
{-# INLINE runSeparatedRWS #-}