module Control.Proxy.Trans.Writer (
WriterP(..),
runWriterP,
runWriterK,
execWriterP,
execWriterK,
tell,
censor
) where
import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))
import Control.Monad (MonadPlus(mzero, mplus))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.MFunctor (MFunctor(hoist))
import Control.PFunctor (PFunctor(hoistP))
import Control.Proxy.Class
import Control.Proxy.Trans (ProxyTrans(liftP))
import Data.Monoid (Monoid(mempty, mappend))
newtype WriterP w p a' a b' b (m :: * -> *) r
= WriterP { unWriterP :: w -> p a' a b' b m (r, w) }
instance (Proxy p, Monad m)
=> Functor (WriterP w p a' a b' b m) where
fmap f p = WriterP (\w0 ->
unWriterP p w0 ?>= \(x, w1) ->
return_P (f x, w1) )
instance (Proxy p, Monad m)
=> Applicative (WriterP w p a' a b' b m) where
pure = return
fp <*> xp = WriterP (\w0 ->
unWriterP fp w0 ?>= \(f, w1) ->
unWriterP xp w1 ?>= \(x, w2) ->
return_P (f x, w2) )
instance (Proxy p, Monad m)
=> Monad (WriterP w p a' a b' b m) where
return = return_P
(>>=) = (?>=)
instance (MonadPlusP p, Monad m)
=> Alternative (WriterP w p a' a b' b m) where
empty = mzero
(<|>) = mplus
instance (MonadPlusP p )
=> MonadPlusP (WriterP w p) where
mzero_P = WriterP (\_ -> mzero_P)
mplus_P m1 m2 = WriterP (\w -> mplus_P (unWriterP m1 w) (unWriterP m2 w))
instance (MonadPlusP p, Monad m)
=> MonadPlus (WriterP w p a' a b' b m) where
mzero = mzero_P
mplus = mplus_P
instance (Proxy p )
=> MonadTrans (WriterP w p a' a b' b) where
lift = lift_P
instance (MonadIOP p )
=> MonadIOP (WriterP w p) where
liftIO_P m = WriterP (\w -> liftIO_P (m >>= \r -> return (r, w)))
instance (MonadIOP p, MonadIO m)
=> MonadIO (WriterP w p a' a b' b m) where
liftIO = liftIO_P
instance (Proxy p )
=> MFunctor (WriterP w p a' a b' b) where
hoist = hoist_P
instance (Proxy p )
=> Proxy (WriterP w p) where
p1 >-> p2 = \c'1 -> WriterP (\w ->
((\b' -> unWriterP (p1 b') w) >-> (\c'2 -> unWriterP (p2 c'2) w)) c'1 )
p1 >~> p2 = \c'1 -> WriterP (\w ->
((\b' -> unWriterP (p1 b') w) >~> (\c'2 -> unWriterP (p2 c'2) w)) c'1 )
request = \a' -> WriterP (\w -> request a' ?>= \a -> return_P (a, w))
respond = \b -> WriterP (\w -> respond b ?>= \b' -> return_P (b', w))
return_P = \r -> WriterP (\w -> return_P (r, w))
m ?>= f = WriterP (\w ->
unWriterP m w ?>= \(a, w') ->
unWriterP (f a) w' )
lift_P m = WriterP (\w -> lift_P (m >>= \r -> return (r, w)))
hoist_P nat p = WriterP (\w -> hoist_P nat (unWriterP p w))
instance ProxyTrans (WriterP w) where
liftP m = WriterP (\w -> m ?>= \r -> return_P (r, w))
instance PFunctor (WriterP w) where
hoistP nat = WriterP . (nat .) . unWriterP
runWriterP :: (Monoid w) => WriterP w p a' a b' b m r -> p a' a b' b m (r, w)
runWriterP p = unWriterP p mempty
runWriterK
:: (Monoid w)
=> (q -> WriterP w p a' a b' b m r) -> (q -> p a' a b' b m (r, w))
runWriterK k q = runWriterP (k q)
execWriterP
:: (Proxy p, Monad m, Monoid w)
=> WriterP w p a' a b' b m r -> p a' a b' b m w
execWriterP m = runWriterP m ?>= \(_, w) -> return_P w
execWriterK
:: (Proxy p, Monad m, Monoid w)
=> (q -> WriterP w p a' a b' b m r) -> (q -> p a' a b' b m w)
execWriterK k q= execWriterP (k q)
tell :: (Proxy p, Monad m, Monoid w) => w -> WriterP w p a' a b' b m ()
tell w' = WriterP (\w -> let w'' = mappend w w' in w'' `seq` return_P ((), w''))
censor
:: (Proxy p, Monad m, Monoid w)
=> (w -> w) -> WriterP w p a' a b' b m r -> WriterP w p a' a b' b m r
censor f p = WriterP (\w0 ->
unWriterP p w0 ?>= \(r, w1) ->
return_P (r, f w1) )