module Control.Proxy.Trans.Reader (
ReaderP(..),
runReaderP,
runReaderK,
ask,
asks,
local,
withReaderP,
) where
import Control.Applicative (Applicative(pure, (<*>)), Alternative(empty, (<|>)))
import Control.Monad (MonadPlus(mzero, mplus))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Morph (MFunctor(hoist))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Proxy.Class (
Proxy(request, respond, (->>), (>>~)),
ProxyInternal(return_P, (?>=), lift_P, liftIO_P, hoist_P),
MonadPlusP(mzero_P, mplus_P) )
import Control.Proxy.Morph (PFunctor(hoistP), PMonad(embedP))
import Control.Proxy.ListT (ListT((>\\), (//>)))
import Control.Proxy.Trans (ProxyTrans(liftP))
newtype ReaderP i p a' a b' b (m :: * -> *) r
= ReaderP { unReaderP :: i -> p a' a b' b m r }
instance (Proxy p, Monad m) => Functor (ReaderP i p a' a b' b m) where
fmap f p = ReaderP (\i ->
unReaderP p i ?>= \x ->
return_P (f x) )
instance (Proxy p, Monad m) => Applicative (ReaderP i p a' a b' b m) where
pure = return
p1 <*> p2 = ReaderP (\i ->
unReaderP p1 i ?>= \f ->
unReaderP p2 i ?>= \x ->
return_P (f x) )
instance (Proxy p, Monad m) => Monad (ReaderP i p a' a b' b m) where
return = return_P
(>>=) = (?>=)
instance (Proxy p) => MonadTrans (ReaderP i p a' a b' b) where
lift = lift_P
instance (Proxy p) => MFunctor (ReaderP i p a' a b' b) where
hoist = hoist_P
instance (Proxy p, MonadIO m) => MonadIO (ReaderP i p a' a b' b m) where
liftIO = liftIO_P
instance (MonadPlusP p, Monad m) => Alternative (ReaderP i p a' a b' b m) where
empty = mzero
(<|>) = mplus
instance (MonadPlusP p, Monad m) => MonadPlus (ReaderP i p a' a b' b m) where
mzero = mzero_P
mplus = mplus_P
instance (Proxy p) => ProxyInternal (ReaderP i p) where
return_P = \r -> ReaderP (\_ -> return_P r)
m ?>= f = ReaderP (\i ->
unReaderP m i ?>= \a ->
unReaderP (f a) i )
lift_P m = ReaderP (\_ -> lift_P m)
hoist_P nat p = ReaderP (\i -> hoist_P nat (unReaderP p i))
liftIO_P m = ReaderP (\_ -> liftIO_P m)
instance (Proxy p) => Proxy (ReaderP i p) where
fb' ->> p = ReaderP (\i -> (\b' -> unReaderP (fb' b') i) ->> unReaderP p i)
p >>~ fb = ReaderP (\i -> unReaderP p i >>~ (\b -> unReaderP (fb b) i))
request = \a -> ReaderP (\_ -> request a)
respond = \a -> ReaderP (\_ -> respond a)
instance (ListT p) => ListT (ReaderP i p) where
fb' >\\ p = ReaderP (\i -> (\b' -> unReaderP (fb' b') i) >\\ unReaderP p i)
p //> fb = ReaderP (\i -> unReaderP p i //> (\b -> unReaderP (fb b) i))
instance (MonadPlusP p) => MonadPlusP (ReaderP i p) where
mzero_P = ReaderP (\_ -> mzero_P)
mplus_P m1 m2 = ReaderP (\i -> mplus_P (unReaderP m1 i) (unReaderP m2 i))
instance ProxyTrans (ReaderP i) where
liftP m = ReaderP (\_ -> m)
instance PFunctor (ReaderP i) where
hoistP nat p = ReaderP (\i -> nat (unReaderP p i))
instance PMonad (ReaderP i) where
embedP nat p = ReaderP (\i -> unReaderP (nat (unReaderP p i)) i)
runReaderP :: i -> ReaderP i p a' a b' b m r -> p a' a b' b m r
runReaderP i m = unReaderP m i
runReaderK :: i -> (q -> ReaderP i p a' a b' b m r) -> (q -> p a' a b' b m r)
runReaderK i p q = runReaderP i (p q)
ask :: (Proxy p, Monad m) => ReaderP i p a' a b' b m i
ask = ReaderP return_P
asks :: (Proxy p, Monad m) => (i -> r) -> ReaderP i p a' a b' b m r
asks f = ReaderP (\i -> return_P (f i))
local :: (i -> i) -> ReaderP i p a' a b' b m r -> ReaderP i p a' a b' b m r
local = withReaderP
withReaderP
:: (j -> i) -> ReaderP i p a' a b' b m r -> ReaderP j p a' a b' b m r
withReaderP f p = ReaderP (\i -> unReaderP p (f i))