module Control.Effect.Writer.Strict
(
WriterT
, execWriter'
, runWriter'
, execWriter
, runWriter
) where
import Control.Monad (liftM)
import Data.Coerce (coerce)
import Data.Tuple (swap)
import qualified Control.Monad.Trans.Writer.CPS as W
import Control.Effect.Machinery
import Control.Effect.Writer (Writer, Writer')
newtype WriterT w m a =
WriterT { runWriterT :: W.WriterT w m a }
deriving (Applicative, Functor, Monad, MonadIO)
deriving (MonadTrans)
deriving (Writer' tag w)
instance MonadBase b m => MonadBase b (WriterT w m) where
liftBase = 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 = defaultLiftBaseWith
{-# INLINE liftBaseWith #-}
restoreM = defaultRestoreM
{-# INLINE restoreM #-}
instance Monoid w => MonadTransControl (WriterT w) where
type StT (WriterT w) a = (a, w)
liftWith f = WriterT . W.writerT $
liftM ( \x -> (x, mempty) )
( f $ W.runWriterT . runWriterT )
{-# INLINABLE liftWith #-}
restoreT = WriterT . W.writerT
{-# INLINABLE restoreT #-}
execWriter' :: forall tag w m a. (Monad m, Monoid w)
=> (Writer' tag w `Via` WriterT w) m a
-> m w
execWriter' = W.execWriterT . coerce
{-# INLINE execWriter' #-}
execWriter :: (Monad m, Monoid w) => (Writer w `Via` WriterT w) m a -> m w
execWriter = execWriter' @G
{-# INLINE execWriter #-}
runWriter' :: forall tag w m a. (Functor m, Monoid w)
=> (Writer' tag w `Via` WriterT w) m a
-> m (w, a)
runWriter' = fmap swap . W.runWriterT . coerce
{-# INLINE runWriter' #-}
runWriter :: (Functor m, Monoid w) => (Writer w `Via` WriterT w) m a -> m (w, a)
runWriter = runWriter' @G
{-# INLINE runWriter #-}