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

-- |

-- Module      :  Control.Effect.Writer.Strict

-- Copyright   :  (c) Michael Szvetits, 2020

-- License     :  BSD3 (see the file LICENSE)

-- Maintainer  :  typedbyte@qualified.name

-- Stability   :  stable

-- Portability :  portable

--

-- Strict interpretations of the 'Writer'' effect.

--

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

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

-- you usually need the untagged interpretations.

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

module Control.Effect.Writer.Strict
  ( -- * Interpreter Type

    WriterT
    -- * Tagged Interpretations

  , execWriter'
  , runWriter'
    -- * Untagged Interpretations

  , execWriter
  , runWriter
  ) where

-- base

import Control.Monad (liftM)
import Data.Coerce   (coerce)
import Data.Tuple    (swap)

-- transformers

import qualified Control.Monad.Trans.Writer.CPS as W

import Control.Effect.Machinery
import Control.Effect.Writer (Writer, Writer')

-- This is necessary until the writer CPS instance land in monad-control.

-- See: https://github.com/basvandijk/monad-control/pull/51

-- | The strict interpreter of the writer effect. This type implements the

-- 'Writer'' type class in a strict manner.

--

-- When interpreting the effect, you usually don\'t interact with this type directly,

-- but instead use one of its corresponding interpretation functions.

newtype WriterT w m a =
  WriterT { WriterT w m a -> WriterT w m a
runWriterT :: W.WriterT w m a }
    deriving (Functor (WriterT w m)
a -> WriterT w m a
Functor (WriterT w m) =>
(forall a. a -> WriterT w m a)
-> (forall a b.
    WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b)
-> (forall a b c.
    (a -> b -> c) -> WriterT w m a -> WriterT w m b -> WriterT w m c)
-> (forall a b. WriterT w m a -> WriterT w m b -> WriterT w m b)
-> (forall a b. WriterT w m a -> WriterT w m b -> WriterT w m a)
-> Applicative (WriterT w m)
WriterT w m a -> WriterT w m b -> WriterT w m b
WriterT w m a -> WriterT w m b -> WriterT w m a
WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
(a -> b -> c) -> WriterT w m a -> WriterT w m b -> WriterT w m c
forall a. a -> WriterT w m a
forall a b. WriterT w m a -> WriterT w m b -> WriterT w m a
forall a b. WriterT w m a -> WriterT w m b -> WriterT w m b
forall a b. WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
forall a b c.
(a -> b -> c) -> WriterT w m a -> WriterT w m b -> WriterT w m c
forall w (m :: * -> *). Monad m => Functor (WriterT w m)
forall w (m :: * -> *) a. Monad m => a -> WriterT w m a
forall w (m :: * -> *) a b.
Monad m =>
WriterT w m a -> WriterT w m b -> WriterT w m a
forall w (m :: * -> *) a b.
Monad m =>
WriterT w m a -> WriterT w m b -> WriterT w m b
forall w (m :: * -> *) a b.
Monad m =>
WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
forall w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> WriterT w m a -> WriterT w m b -> WriterT w 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
<* :: WriterT w m a -> WriterT w m b -> WriterT w m a
$c<* :: forall w (m :: * -> *) a b.
Monad m =>
WriterT w m a -> WriterT w m b -> WriterT w m a
*> :: WriterT w m a -> WriterT w m b -> WriterT w m b
$c*> :: forall w (m :: * -> *) a b.
Monad m =>
WriterT w m a -> WriterT w m b -> WriterT w m b
liftA2 :: (a -> b -> c) -> WriterT w m a -> WriterT w m b -> WriterT w m c
$cliftA2 :: forall w (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> WriterT w m a -> WriterT w m b -> WriterT w m c
<*> :: WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
$c<*> :: forall w (m :: * -> *) a b.
Monad m =>
WriterT w m (a -> b) -> WriterT w m a -> WriterT w m b
pure :: a -> WriterT w m a
$cpure :: forall w (m :: * -> *) a. Monad m => a -> WriterT w m a
$cp1Applicative :: forall w (m :: * -> *). Monad m => Functor (WriterT w m)
Applicative, a -> WriterT w m b -> WriterT w m a
(a -> b) -> WriterT w m a -> WriterT w m b
(forall a b. (a -> b) -> WriterT w m a -> WriterT w m b)
-> (forall a b. a -> WriterT w m b -> WriterT w m a)
-> Functor (WriterT w m)
forall a b. a -> WriterT w m b -> WriterT w m a
forall a b. (a -> b) -> WriterT w m a -> WriterT w m b
forall w (m :: * -> *) a b.
Functor m =>
a -> WriterT w m b -> WriterT w m a
forall w (m :: * -> *) a b.
Functor m =>
(a -> b) -> WriterT w m a -> WriterT w m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WriterT w m b -> WriterT w m a
$c<$ :: forall w (m :: * -> *) a b.
Functor m =>
a -> WriterT w m b -> WriterT w m a
fmap :: (a -> b) -> WriterT w m a -> WriterT w m b
$cfmap :: forall w (m :: * -> *) a b.
Functor m =>
(a -> b) -> WriterT w m a -> WriterT w m b
Functor, Applicative (WriterT w m)
a -> WriterT w m a
Applicative (WriterT w m) =>
(forall a b.
 WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b)
-> (forall a b. WriterT w m a -> WriterT w m b -> WriterT w m b)
-> (forall a. a -> WriterT w m a)
-> Monad (WriterT w m)
WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b
WriterT w m a -> WriterT w m b -> WriterT w m b
forall a. a -> WriterT w m a
forall a b. WriterT w m a -> WriterT w m b -> WriterT w m b
forall a b. WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b
forall w (m :: * -> *). Monad m => Applicative (WriterT w m)
forall w (m :: * -> *) a. Monad m => a -> WriterT w m a
forall w (m :: * -> *) a b.
Monad m =>
WriterT w m a -> WriterT w m b -> WriterT w m b
forall w (m :: * -> *) a b.
Monad m =>
WriterT w m a -> (a -> WriterT w m b) -> WriterT w 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 -> WriterT w m a
$creturn :: forall w (m :: * -> *) a. Monad m => a -> WriterT w m a
>> :: WriterT w m a -> WriterT w m b -> WriterT w m b
$c>> :: forall w (m :: * -> *) a b.
Monad m =>
WriterT w m a -> WriterT w m b -> WriterT w m b
>>= :: WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b
$c>>= :: forall w (m :: * -> *) a b.
Monad m =>
WriterT w m a -> (a -> WriterT w m b) -> WriterT w m b
$cp1Monad :: forall w (m :: * -> *). Monad m => Applicative (WriterT w m)
Monad, Monad (WriterT w m)
Monad (WriterT w m) =>
(forall a. IO a -> WriterT w m a) -> MonadIO (WriterT w m)
IO a -> WriterT w m a
forall a. IO a -> WriterT w m a
forall w (m :: * -> *). MonadIO m => Monad (WriterT w m)
forall w (m :: * -> *) a. MonadIO m => IO a -> WriterT w m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> WriterT w m a
$cliftIO :: forall w (m :: * -> *) a. MonadIO m => IO a -> WriterT w m a
$cp1MonadIO :: forall w (m :: * -> *). MonadIO m => Monad (WriterT w m)
MonadIO)
    deriving (m a -> WriterT w m a
(forall (m :: * -> *) a. Monad m => m a -> WriterT w m a)
-> MonadTrans (WriterT w)
forall w (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (m :: * -> *) a. Monad m => m a -> WriterT w m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> WriterT w m a
$clift :: forall w (m :: * -> *) a. Monad m => m a -> WriterT w m a
MonadTrans)
    deriving (Writer' tag w)

instance MonadBase b m => MonadBase b (WriterT w m) where
  liftBase :: b α -> WriterT w m α
liftBase = b α -> WriterT w m α
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault
  {-# INLINE liftBase #-}

instance (MonadBaseControl b m, Monoid w) => MonadBaseControl b (WriterT w m) where
  type StM (WriterT w m) a = ComposeSt (WriterT w) m a
  liftBaseWith :: (RunInBase (WriterT w m) b -> b a) -> WriterT w m a
liftBaseWith = (RunInBase (WriterT w m) b -> b a) -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
  {-# INLINE liftBaseWith #-}
  restoreM :: StM (WriterT w m) a -> WriterT w m a
restoreM = StM (WriterT w m) a -> WriterT w m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
  {-# INLINE restoreM #-}

instance Monoid w => MonadTransControl (WriterT w) where
  type StT (WriterT w) a = (a, w)
  liftWith :: (Run (WriterT w) -> m a) -> WriterT w m a
liftWith f :: Run (WriterT w) -> m a
f = WriterT w m a -> WriterT w m a
forall w (m :: * -> *) a. WriterT w m a -> WriterT w m a
WriterT (WriterT w m a -> WriterT w m a)
-> (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, w) -> WriterT w m a
forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
W.writerT (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall a b. (a -> b) -> a -> b
$
    (a -> (a, w)) -> m a -> m (a, w)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ( \x :: a
x -> (a
x, w
forall a. Monoid a => a
mempty) )
          ( Run (WriterT w) -> m a
f (Run (WriterT w) -> m a) -> Run (WriterT w) -> m a
forall a b. (a -> b) -> a -> b
$ WriterT w n b -> n (b, w)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
W.runWriterT (WriterT w n b -> n (b, w))
-> (WriterT w n b -> WriterT w n b) -> WriterT w n b -> n (b, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w n b -> WriterT w n b
forall w (m :: * -> *) a. WriterT w m a -> WriterT w m a
runWriterT )
  {-# INLINABLE liftWith #-}
  restoreT :: m (StT (WriterT w) a) -> WriterT w m a
restoreT = WriterT w m a -> WriterT w m a
forall w (m :: * -> *) a. WriterT w m a -> WriterT w m a
WriterT (WriterT w m a -> WriterT w m a)
-> (m (a, w) -> WriterT w m a) -> m (a, w) -> WriterT w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (a, w) -> WriterT w m a
forall (m :: * -> *) w a.
(Functor m, Monoid w) =>
m (a, w) -> WriterT w m a
W.writerT
  {-# INLINABLE restoreT #-}

-- | Runs the writer effect and returns the final output.

execWriter' :: forall tag w m a. (Monad m, Monoid w)
            => (Writer' tag w `Via` WriterT w) m a -- ^ The program whose writer effect should be handled.

            -> m w                                 -- ^ The program with its writer effect handled, producing the final output @w@.

execWriter' :: Via (Writer' tag w) (WriterT w) m a -> m w
execWriter' = WriterT w m a -> m w
forall (m :: * -> *) w a.
(Monad m, Monoid w) =>
WriterT w m a -> m w
W.execWriterT (WriterT w m a -> m w)
-> (Via (Writer' tag w) (WriterT w) m a -> WriterT w m a)
-> Via (Writer' tag w) (WriterT w) m a
-> m w
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (Writer' tag w) (WriterT w) m a -> WriterT w m a
forall a b. Coercible a b => a -> b
coerce
{-# INLINE execWriter' #-}

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

execWriter :: (Monad m, Monoid w) => (Writer w `Via` WriterT w) m a -> m w
execWriter :: Via (Writer w) (WriterT w) m a -> m w
execWriter = forall k (tag :: k) w (m :: * -> *) a.
(Monad m, Monoid w) =>
Via (Writer' tag w) (WriterT w) m a -> m w
forall w (m :: * -> *) a.
(Monad m, Monoid w) =>
Via (Writer' G w) (WriterT w) m a -> m w
execWriter' @G
{-# INLINE execWriter #-}

-- | Runs the writer effect and returns both the final output and the result of the interpreted program.

runWriter' :: forall tag w m a. (Functor m, Monoid w)
           => (Writer' tag w `Via` WriterT w) m a -- ^ The program whose writer effect should be handled.

           -> m (w, a)                            -- ^ The program with its writer effect handled, producing the final output @w@ and the result @a@.

runWriter' :: Via (Writer' tag w) (WriterT w) m a -> m (w, a)
runWriter' = ((a, w) -> (w, a)) -> m (a, w) -> m (w, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, w) -> (w, a)
forall a b. (a, b) -> (b, a)
swap (m (a, w) -> m (w, a))
-> (Via (Writer' tag w) (WriterT w) m a -> m (a, w))
-> Via (Writer' tag w) (WriterT w) m a
-> m (w, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT w m a -> m (a, w)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
W.runWriterT (WriterT w m a -> m (a, w))
-> (Via (Writer' tag w) (WriterT w) m a -> WriterT w m a)
-> Via (Writer' tag w) (WriterT w) m a
-> m (a, w)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Via (Writer' tag w) (WriterT w) m a -> WriterT w m a
forall a b. Coercible a b => a -> b
coerce
{-# INLINE runWriter' #-}

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

runWriter :: (Functor m, Monoid w) => (Writer w `Via` WriterT w) m a -> m (w, a)
runWriter :: Via (Writer w) (WriterT w) m a -> m (w, a)
runWriter = forall k (tag :: k) w (m :: * -> *) a.
(Functor m, Monoid w) =>
Via (Writer' tag w) (WriterT w) m a -> m (w, a)
forall w (m :: * -> *) a.
(Functor m, Monoid w) =>
Via (Writer' G w) (WriterT w) m a -> m (w, a)
runWriter' @G
{-# INLINE runWriter #-}