module Control.Proxy.Prelude.Base (
mapD,
mapU,
mapB,
mapMD,
mapMU,
mapMB,
useD,
useU,
useB,
execD,
execU,
execB,
takeB,
takeB_,
takeWhileD,
takeWhileU,
dropD,
dropU,
dropWhileD,
dropWhileU,
filterD,
filterU,
fromListS,
fromListC,
enumFromS,
enumFromC,
enumFromToS,
enumFromToC,
foldD,
foldU,
allD,
allU,
allD_,
allU_,
anyD,
anyU,
anyD_,
anyU_,
sumD,
sumU,
productD,
productU,
lengthD,
lengthU,
headD,
headD_,
headU,
headU_,
lastD,
lastU,
toListD,
toListU,
foldrD,
foldrU,
foldlD',
foldlU',
zipD,
mergeD,
unitD,
unitU,
module Control.Monad.Trans.State.Strict,
module Control.Monad.Trans.Writer.Strict,
module Data.Monoid
) where
import Control.MFunctor (hoist)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Writer.Strict (
WriterT(runWriterT), execWriterT, runWriter, tell )
import Control.Monad.Trans.State.Strict (
StateT(runStateT), execStateT, runState, execState, get, put )
import Control.Proxy.Class
import Control.Proxy.Synonym
import Control.Proxy.Trans.Identity (runIdentityP, runIdentityK)
import Data.Monoid (
Monoid,
Endo(Endo, appEndo),
All(All, getAll),
Any(Any, getAny),
Sum(Sum, getSum),
Product(Product, getProduct),
First(First, getFirst),
Last(Last, getLast) )
mapD :: (Monad m, Proxy p) => (a -> b) -> x -> p x a x b m r
mapD f = runIdentityK go where
go x = do
a <- request x
x2 <- respond (f a)
go x2
mapU :: (Monad m, Proxy p) => (b' -> a') -> b' -> p a' x b' x m r
mapU g = runIdentityK go where
go b' = do
x <- request (g b')
b'2 <- respond x
go b'2
mapB :: (Monad m, Proxy p) => (a -> b) -> (b' -> a') -> b' -> p a' a b' b m r
mapB f g = runIdentityK go where
go b' = do
a <- request (g b')
b'2 <- respond (f a )
go b'2
mapMD :: (Monad m, Proxy p) => (a -> m b) -> x -> p x a x b m r
mapMD f = runIdentityK go where
go x = do
a <- request x
b <- lift (f a)
x2 <- respond b
go x2
mapMU :: (Monad m, Proxy p) => (b' -> m a') -> b' -> p a' x b' x m r
mapMU g = runIdentityK go where
go b' = do
a' <- lift (g b')
x <- request a'
b'2 <- respond x
go b'2
mapMB
:: (Monad m, Proxy p) => (a -> m b) -> (b' -> m a') -> b' -> p a' a b' b m r
mapMB f g = runIdentityK go where
go b' = do
a' <- lift (g b')
a <- request a'
b <- lift (f a )
b'2 <- respond b
go b'2
useD :: (Monad m, Proxy p) => (a -> m r1) -> x -> p x a x a m r
useD f = runIdentityK go where
go x = do
a <- request x
lift $ f a
x2 <- respond a
go x2
useU :: (Monad m, Proxy p) => (a' -> m r2) -> a' -> p a' x a' x m r
useU g = runIdentityK go where
go a' = do
lift $ g a'
x <- request a'
a'2 <- respond x
go a'2
useB
:: (Monad m, Proxy p) => (a -> m r1) -> (a' -> m r2) -> a' -> p a' a a' a m r
useB f g = runIdentityK go where
go a' = do
lift $ g a'
a <- request a'
lift $ f a
a'2 <- respond a
go a'2
execD :: (Monad m, Proxy p) => m r1 -> a' -> p a' a a' a m r
execD md = runIdentityK go where
go a' = do
a <- request a'
lift md
a'2 <- respond a
go a'2
execU :: (Monad m, Proxy p) => m r2 -> a' -> p a' a a' a m r
execU mu = runIdentityK go where
go a' = do
lift mu
a <- request a'
a'2 <- respond a
go a'2
execB :: (Monad m, Proxy p) => m r1 -> m r2 -> a' -> p a' a a' a m r
execB md mu = runIdentityK go where
go a' = do
lift mu
a <- request a'
lift md
a'2 <- respond a
go a'2
takeB :: (Monad m, Proxy p) => Int -> a' -> p a' a a' a m a'
takeB n0 = runIdentityK (go n0) where
go n
| n <= 0 = return
| otherwise = \a' -> do
a <- request a'
a'2 <- respond a
go (n 1) a'2
takeB_ :: (Monad m, Proxy p) => Int -> a' -> p a' a a' a m ()
takeB_ n0 = runIdentityK (go n0) where
go n
| n <= 0 = \_ -> return ()
| otherwise = \a' -> do
a <- request a'
a'2 <- respond a
go (n 1) a'2
takeWhileD :: (Monad m, Proxy p) => (a -> Bool) -> a' -> p a' a a' a m ()
takeWhileD p = runIdentityK go where
go a' = do
a <- request a'
if (p a)
then do
a'2 <- respond a
go a'2
else return ()
takeWhileU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' a a' a m ()
takeWhileU p = runIdentityK go where
go a' =
if (p a')
then do
a <- request a'
a'2 <- respond a
go a'2
else return_P ()
dropD :: (Monad m, Proxy p) => Int -> () -> Pipe p a a m r
dropD n0 = \() -> runIdentityP (go n0) where
go n
| n <= 0 = idT ()
| otherwise = do
request ()
go (n 1)
dropU :: (Monad m, Proxy p) => Int -> a' -> CoPipe p a' a' m r
dropU n0 = runIdentityK (go n0) where
go n
| n <= 0 = idT
| otherwise = \_ -> do
a' <- respond ()
go (n 1) a'
dropWhileD :: (Monad m, Proxy p) => (a -> Bool) -> () -> Pipe p a a m r
dropWhileD p () = runIdentityP go where
go = do
a <- request ()
if (p a)
then go
else do
x <- respond a
idT x
dropWhileU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> CoPipe p a' a' m r
dropWhileU p = runIdentityK go where
go a' =
if (p a')
then do
a2 <- respond ()
go a2
else idT a'
filterD :: (Monad m, Proxy p) => (a -> Bool) -> () -> Pipe p a a m r
filterD p = \() -> runIdentityP go where
go = do
a <- request ()
if (p a)
then do
respond a
go
else go
filterU :: (Monad m, Proxy p) => (a' -> Bool) -> a' -> CoPipe p a' a' m r
filterU p = runIdentityK go where
go a' =
if (p a')
then do
request a'
a'2 <- respond ()
go a'2
else do
a'2 <- respond ()
go a'2
fromListS :: (Monad m, Proxy p) => [b] -> () -> Producer p b m ()
fromListS xs = \_ -> foldr (\e a -> respond e ?>= \_ -> a) (return_P ()) xs
fromListC :: (Monad m, Proxy p) => [a'] -> () -> CoProducer p a' m ()
fromListC xs = \_ -> foldr (\e a -> request e ?>= \_ -> a) (return_P ()) xs
enumFromS :: (Enum b, Monad m, Proxy p) => b -> () -> Producer p b m r
enumFromS b0 = \_ -> runIdentityP (go b0) where
go b = do
respond b
go (succ b)
enumFromC :: (Enum a', Monad m, Proxy p) => a' -> () -> CoProducer p a' m r
enumFromC a'0 = \_ -> runIdentityP (go a'0) where
go a' = do
request a'
go (succ a')
enumFromToS
:: (Enum b, Ord b, Monad m, Proxy p) => b -> b -> () -> Producer p b m ()
enumFromToS b1 b2 _ = runIdentityP (go b1) where
go b
| b > b2 = return ()
| otherwise = do
respond b
go (succ b)
enumFromToC
:: (Enum a', Ord a', Monad m, Proxy p)
=> a' -> a' -> () -> CoProducer p a' m ()
enumFromToC a1 a2 _ = runIdentityP (go a1) where
go n
| n > a2 = return ()
| otherwise = do
request n
go (succ n)
foldD
:: (Monad m, Proxy p, Monoid w) => (a -> w) -> x -> p x a x a (WriterT w m) r
foldD f = runIdentityK go where
go x = do
a <- request x
lift $ tell $ f a
x2 <- respond a
go x2
foldU
:: (Monad m, Proxy p, Monoid w)
=> (a' -> w) -> a' -> p a' x a' x (WriterT w m) r
foldU f = runIdentityK go where
go a' = do
lift $ tell $ f a'
x <- request a'
a'2 <- respond x
go a'2
allD :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT All m) r
allD pred = foldD (All . pred)
allU
:: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT All m) r
allU pred = foldU (All . pred)
allD_ :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT All m) ()
allD_ pred = runIdentityK go where
go x = do
a <- request x
if (pred a)
then do
x2 <- respond a
go x2
else lift $ tell $ All False
allU_
:: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT All m) ()
allU_ pred = runIdentityK go where
go a' =
if (pred a')
then do
x <- request a'
a'2 <- respond x
go a'2
else lift $ tell $ All False
anyD :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT Any m) r
anyD pred = foldD (Any . pred)
anyU
:: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT Any m) r
anyU pred = foldU (Any . pred)
anyD_ :: (Monad m, Proxy p) => (a -> Bool) -> x -> p x a x a (WriterT Any m) ()
anyD_ pred = runIdentityK go where
go x = do
a <- request x
if (pred a)
then lift $ tell $ Any True
else do
x2 <- respond a
go x2
anyU_
:: (Monad m, Proxy p) => (a' -> Bool) -> a' -> p a' x a' x (WriterT Any m) ()
anyU_ pred = runIdentityK go where
go a' =
if (pred a')
then lift $ tell $ Any True
else do
x <- request a'
a'2 <- respond x
go a'2
sumD :: (Monad m, Proxy p, Num a) => x -> p x a x a (WriterT (Sum a) m) r
sumD = foldD Sum
sumU :: (Monad m, Proxy p, Num a') => a' -> p a' x a' x (WriterT (Sum a') m) r
sumU = foldU Sum
productD
:: (Monad m, Proxy p, Num a) => x -> p x a x a (WriterT (Product a) m) r
productD = foldD Product
productU
:: (Monad m, Proxy p, Num a') => a' -> p a' x a' x (WriterT (Product a') m) r
productU = foldU Product
lengthD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (Sum Int) m) r
lengthD = foldD (\_ -> Sum 1)
lengthU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (Sum Int) m) r
lengthU = foldU (\_ -> Sum 1)
headD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (First a) m) r
headD = foldD (First . Just)
headD_ :: (Monad m, Proxy p) => x -> p x a x a (WriterT (First a) m) ()
headD_ x = runIdentityP $ do
a <- request x
lift $ tell $ First (Just a)
headU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (First a') m) r
headU = foldU (First . Just)
headU_ :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (First a') m) ()
headU_ a' = runIdentityP $ lift $ tell $ First (Just a')
lastD :: (Monad m, Proxy p) => x -> p x a x a (WriterT (Last a) m) r
lastD = foldD (Last . Just)
lastU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT (Last a') m) r
lastU = foldU (Last . Just)
toListD :: (Monad m, Proxy p) => x -> p x a x a (WriterT [a] m) r
toListD = foldD (\x -> [x])
toListU :: (Monad m, Proxy p) => a' -> p a' x a' x (WriterT [a'] m) r
toListU = foldU (\x -> [x])
foldrD
:: (Monad m, Proxy p) => (a -> b -> b) -> x -> p x a x a (WriterT (Endo b) m) r
foldrD step = foldD (Endo . step)
foldrU
:: (Monad m, Proxy p)
=> (a' -> b -> b) -> a' -> p a' x a' x (WriterT (Endo b) m) r
foldrU step = foldU (Endo . step)
foldlD'
:: (Monad m, Proxy p) => (b -> a -> b) -> x -> p x a x a (StateT b m) r
foldlD' f = runIdentityK go where
go x = do
a <- request x
lift $ do
b <- get
put $! f b a
x2 <- respond a
go x2
foldlU'
:: (Monad m, Proxy p) => (b -> a' -> b) -> a' -> p a' x a' x (StateT b m) r
foldlU' f = runIdentityK go where
go a' = do
lift $ do
b <- get
put $! f b a'
x <- request a'
a'2 <- respond x
go a'2
zipD
:: (Monad m, Proxy p1, Proxy p2, Proxy p3)
=> () -> Consumer p1 a (Consumer p2 b (Producer p3 (a, b) m)) r
zipD () = runIdentityP $ hoist (runIdentityP . hoist runIdentityP) go where
go = do
a <- request ()
lift $ do
b <- request ()
lift $ respond (a, b)
go
mergeD
:: (Monad m, Proxy p1, Proxy p2, Proxy p3)
=> () -> Consumer p1 a (Consumer p2 a (Producer p3 a m)) r
mergeD () = runIdentityP $ hoist (runIdentityP . hoist runIdentityP) go where
go = do
a1 <- request ()
lift $ do
lift $ respond a1
a2 <- request ()
lift $ respond a2
go
unitD :: (Monad m, Proxy p) => y' -> p x' x y' () m r
unitD _ = runIdentityP go where
go = do
respond ()
go
unitU :: (Monad m, Proxy p) => y' -> p () x y' y m r
unitU _ = runIdentityP go where
go = do
request ()
go