module Control.Pipe.Combinators (
tryAwait,
forP,
($$),
fromList,
fold,
fold1,
consume,
consume1,
take,
drop,
takeWhile,
takeWhile_,
dropWhile,
intersperse,
groupBy,
filter,
pipeList,
nullP,
feed,
) where
import Control.Applicative
import Control.Monad
import Control.Pipe
import Control.Pipe.Exception
import Data.Maybe
import Prelude hiding (until, take, drop, concatMap, filter, takeWhile, dropWhile, catch)
tryAwait :: Monad m => Pipe a b m (Maybe a)
tryAwait = catch (Just <$> await) $ \(_ :: BrokenPipe) -> return Nothing
forP :: Monad m => (a -> Pipe a b m r) -> Pipe a b m ()
forP f = tryAwait >>= maybe (return ()) (\a -> f a >> forP f)
infixr 5 $$
($$) :: Monad m => Pipe x a m r' -> Pipe a y m r -> Pipe x y m (Maybe r)
p1 $$ p2 = (p1 >> return Nothing) >+> fmap Just p2
fromList :: Monad m => [a] -> Pipe x a m ()
fromList = mapM_ yield
nullP :: Monad m => Pipe a b m ()
nullP = return ()
fold :: Monad m => (b -> a -> b) -> b -> Pipe a x m b
fold f = go
where
go x = tryAwait >>= maybe (return x) (go . f x)
fold1 :: Monad m => (a -> a -> a) -> Pipe a x m a
fold1 f = tryAwait >>= maybe discard (fold f)
consume :: Monad m => Pipe a x m [a]
consume = pipe (:) >+> (fold (.) id <*> pure [])
consume1 :: Monad m => Pipe a x m [a]
consume1 = pipe (:) >+> (fold1 (.) <*> pure [])
take :: Monad m => Int -> Pipe a a m ()
take n = replicateM_ n $ await >>= yield
drop :: Monad m => Int -> Pipe a a m r
drop n = replicateM_ n await >> idP
pipeList :: Monad m => (a -> [b]) -> Pipe a b m r
pipeList f = forever $ await >>= mapM_ yield . f
takeWhile :: Monad m => (a -> Bool) -> Pipe a a m a
takeWhile p = go
where
go = await >>= \x -> if p x then yield x >> go else return x
takeWhile_ :: Monad m => (a -> Bool) -> Pipe a a m ()
takeWhile_ = void . takeWhile
dropWhile :: Monad m => (a -> Bool) -> Pipe a a m r
dropWhile p = (takeWhile p >+> discard) >>= yield >> idP
intersperse :: Monad m => (a -> Bool) -> Pipe a (Maybe a) m r
intersperse p = forever $ do
x <- await
when (p x) $ yield Nothing
yield $ Just x
groupBy :: Monad m => (a -> a -> Bool) -> Pipe a [a] m r
groupBy p = streaks >+> createGroups
where
streaks = await >>= \x -> yield (Just x) >> streaks' x
streaks' x = do
y <- await
unless (p x y) $ yield Nothing
yield $ Just y
streaks' y
createGroups = forever $
takeWhile_ isJust >+>
pipe fromJust >+>
(consume1 >>= yield)
filter :: Monad m => (a -> Bool) -> Pipe a a m r
filter p = forever $ takeWhile_ p
feed :: Monad m => a -> Pipe a b m r -> Pipe a b m r
feed _ (Pure r w) = Pure r w
feed _ (Throw e w) = Throw e w
feed a (Yield x b w) = Yield x (feed a b) w
feed a (M s m h) = M s (liftM (feed a) m) (feed a . h)
feed a (Await k _) = k a