module Tubes.Util
(
Tubes.Util.stop
, Tubes.Util.cat
, Tubes.Util.for
, Tubes.Util.each
, Tubes.Util.every
, Tubes.Util.map
, Tubes.Util.drop
, Tubes.Util.take
, Tubes.Util.takeWhile
, Tubes.Util.filter
, Tubes.Util.unyield
, Tubes.Util.pass
, Tubes.Util.mapM
, Tubes.Util.sequence
, Tubes.Util.lfold
) where
import Prelude hiding (map, mapM)
import Control.Monad (forever, unless, replicateM_, when)
import Control.Monad.Trans
import Control.Monad.Trans.Free
import Control.Monad.IO.Class
import Data.Foldable
import Data.Monoid (Monoid, mappend, mempty)
import System.IO
import Data.Functor.Identity
import Tubes.Core
for
:: Monad m
=> Tube a b m r
-> (b -> Tube a c m s)
-> Tube a c m r
for src body = liftT src >>= go where
go (Pure x) = return x
go (Free src') = runTubeF src'
(\f -> wrap $ awaitF (\x -> liftT (f x) >>= go))
(\(v,k) -> do
body v
liftT k >>= go)
stop :: Monad m => Tube a () m r
stop = map (const ())
cat :: Monad m => Tube a a m r
cat = forever $ do
x <- await
yield x
each :: (Monad m, Foldable t) => t b -> Tube () b m ()
each as = Data.Foldable.mapM_ yield as
every :: (Foldable t, Monad m) => t b -> Tube () (Maybe b) m ()
every xs = ((each xs) >< map Just) >> yield Nothing
map :: (Monad m) => (a -> b) -> Tube a b m r
map f = for cat (\x -> yield (f x))
drop :: Monad m => Int -> Tube a a m r
drop 0 = cat
drop n = await >> Tubes.Util.drop (n1)
filter :: Monad m => (a -> Bool) -> Tube a a m r
filter pred = for cat (\x -> when (pred x) (yield x))
takeWhile :: Monad m => (a -> Bool) -> Tube a a m ()
takeWhile pred = go
where
go = do
a <- await
if (pred a)
then do
yield a
go
else return ()
take :: Monad m => Int -> Tube a a m ()
take 0 = return ()
take n = do
await >>= yield
Tubes.Util.take (n1)
unyield
:: Monad m
=> Tube x b m ()
-> m (Maybe (b, Tube x b m ()))
unyield tsk = do
tsk' <- runFreeT tsk
case tsk' of
Pure _ -> return Nothing
Free tsk'' -> do
let res = runTubeF tsk'' diverge (\(v, k) -> Just (v, k))
return res
pass :: Monad m => a -> Tube a b m () -> m (Maybe (b, Tube a b m ()))
pass arg tb = do
mtb <- runFreeT tb
case mtb of
Free tb' -> do
let k = runTubeF tb' (\ak -> ak arg) diverge
unyield k
Pure _ -> return Nothing
mapM :: Monad m => (a -> m b) -> Tube a b m r
mapM f = for cat (\a -> do
b <- lift $ f a
yield b)
sequence :: Monad m => Tube (m a) a m r
sequence = mapM id
lfold
:: (x -> a -> x)
-> (x -> (b, x))
-> x
-> Pump b a Identity x
lfold step done init = pumpT (Identity init)
(\(Identity xs) x -> Identity (step xs x))
(\(Identity xs) -> Identity <$> done xs)