module Streaming.Prelude (
Stream
, Of (..)
, lazily
, strictly
, each
, yield
, unfoldr
, stdinLn
, readLn
, fromHandle
, repeatM
, replicateM
, stdoutLn
, stdoutLn'
, mapM_
, print
, toHandle
, drain
, map
, mapM
, maps'
, maps
, sequence
, mapFoldable
, filter
, filterM
, for
, take
, takeWhile
, drop
, dropWhile
, concat
, scan
, scanM
, chain
, read
, show
, seq
, next
, uncons
, split
, break
, span
, fold
, fold'
, foldM
, foldM'
, sum
, sum'
, product
, product'
, toList
, toListM
, toListM'
, foldrM
, foldrT
, zip
, zipWith
) where
import Streaming.Internal
import Control.Monad hiding (filterM, mapM, mapM_, foldM, replicateM, sequence)
import Data.Data ( Data, Typeable )
import Data.Functor.Identity
import Control.Monad.Trans
import qualified Prelude as Prelude
import qualified Data.Foldable as Foldable
import Text.Read (readMaybe)
import Prelude hiding (map, mapM, mapM_, filter, drop, dropWhile, take, sum, product
, iterate, repeat, replicate, splitAt
, takeWhile, enumFrom, enumFromTo
, print, zipWith, zip, seq, show, read
, readLn, sequence, concat, span, break)
import qualified GHC.IO.Exception as G
import qualified System.IO as IO
import Foreign.C.Error (Errno(Errno), ePIPE)
import Control.Exception (throwIO, try)
data Of a b = !a :> b
deriving (Data, Eq, Foldable, Functor, Ord,
Read, Show, Traversable, Typeable)
infixr 4 :>
lazily :: Of a b -> (a,b)
lazily = \(a:>b) -> (a,b)
strictly :: (a,b) -> Of a b
strictly = \(a,b) -> a :> b
break :: Monad m => (a -> Bool) -> Stream (Of a) m r
-> Stream (Of a) m (Stream (Of a) m r)
break pred = loop where
loop str = case str of
Return r -> Return (Return r)
Delay m -> Delay $ liftM loop m
Step (a :> rest) -> if (pred a)
then Return (Step (a :> rest))
else Step (a :> loop rest)
chain :: Monad m => (a -> m ()) -> Stream (Of a) m r -> Stream (Of a) m r
chain f str = for str $ \a -> do
lift (f a)
yield a
concat :: (Monad m, Foldable f) => Stream (Of (f a)) m r -> Stream (Of a) m r
concat str = for str each
drain :: Monad m => Stream (Of a) m r -> m r
drain = loop where
loop stream = case stream of
Return r -> return r
Delay m -> m >>= loop
Step (_ :> rest) -> loop rest
drop :: (Monad m) => Int -> Stream (Of a) m r -> Stream (Of a) m r
drop = loop where
loop n stream
| n <= 0 = stream
| otherwise = case stream of
Return r -> Return r
Delay ma -> Delay (liftM (loop n) ma)
Step (a :> as) -> loop (n1) as
dropWhile :: Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m r
dropWhile pred = loop where
loop stream = case stream of
Return r -> Return r
Delay ma -> Delay (liftM loop ma)
Step (a :> as) -> if pred a
then loop as
else Step (a :> as)
each :: (Monad m, Foldable.Foldable f) => f a -> Stream (Of a) m ()
each = Foldable.foldr (\a p -> Step (a :> p)) (Return ())
enumFrom :: (Monad m, Num n) => n -> Stream (Of n) m ()
enumFrom = loop where
loop !n = Step (n :> loop (n+1))
enumFromTo :: (Monad m, Num n, Ord n) => n -> n -> Stream (Of n) m ()
enumFromTo = loop where
loop !n m = if n <= m
then Step (n :> loop (n+1) m)
else Return ()
enumFromStepN :: (Monad m, Num a) => a -> a -> Int -> Stream (Of a) m ()
enumFromStepN start step = loop start where
loop !s m = case m of
0 -> Return ()
_ -> Step (s :> loop (s+step) (m1))
filter :: (Monad m) => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m r
filter pred = loop where
loop !str = case str of
Return r -> Return r
Delay m -> Delay (liftM loop m)
Step (a :> as) -> if pred a
then Step (a :> loop as)
else loop as
filterM :: (Monad m) => (a -> m Bool) -> Stream (Of a) m r -> Stream (Of a) m r
filterM pred = loop where
loop str = case str of
Return r -> Return r
Delay m -> Delay $ liftM loop m
Step (a :> as) -> Delay $ do
bool <- pred a
if bool
then return $ Step (a :> loop as)
else return $ loop as
fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m () -> m b
fold step begin done stream0 = loop stream0 begin
where
loop stream !x = case stream of
Return r -> return (done x)
Delay m -> m >>= \s -> loop s x
Step (a :> rest) -> loop rest (step x a)
fold' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> m (b, r)
fold' step begin done s0 = loop s0 begin
where
loop stream !x = case stream of
Return r -> return (done x, r)
Delay m -> m >>= \s -> loop s x
Step (a :> rest) -> loop rest (step x a)
foldM
:: Monad m
=> (x -> a -> m x) -> m x -> (x -> m b) -> Stream (Of a) m () -> m b
foldM step begin done s0 = do
x0 <- begin
loop s0 x0
where
loop stream !x = case stream of
Return r -> done x
Delay m -> m >>= \s -> loop s x
Step (a :> rest) -> do
x' <- step x a
loop rest x'
foldM'
:: Monad m
=> (x -> a -> m x) -> m x -> (x -> m b) -> Stream (Of a) m r -> m (b, r)
foldM' step begin done str = do
x0 <- begin
loop str x0
where
loop stream !x = case stream of
Return r -> done x >>= \b -> return (b, r)
Delay m -> m >>= \s -> loop s x
Step (a :> rest) -> do
x' <- step x a
loop rest x'
foldrT :: (Monad m, MonadTrans t, Monad (t m))
=> (a -> t m r -> t m r) -> Stream (Of a) m r -> t m r
foldrT step = loop where
loop stream = case stream of
Return r -> return r
Delay m -> lift m >>= loop
Step (a :> as) -> step a (loop as)
foldrM :: Monad m
=> (a -> m r -> m r) -> Stream (Of a) m r -> m r
foldrM step = loop where
loop stream = case stream of
Return r -> return r
Delay m -> m >>= loop
Step (a :> as) -> step a (loop as)
for :: (Monad m, Functor f) => Stream (Of a) m r -> (a -> Stream f m x) -> Stream f m r
for str0 act = loop str0 where
loop str = case str of
Return r -> Return r
Delay m -> Delay $ liftM loop m
Step (a :> rest) -> do
act a
loop rest
iterate :: (a -> a) -> a -> Stream (Of a) m r
iterate f = loop where
loop a' = Step (a' :> loop (f a'))
iterateM :: Monad m => (a -> m a) -> m a -> Stream (Of a) m r
iterateM f = loop where
loop ma = Delay $ do
a <- ma
return (Step (a :> loop (f a)))
map :: Monad m => (a -> b) -> Stream (Of a) m r -> Stream (Of b) m r
map f = loop where
loop stream = case stream of
Return r -> Return r
Delay m -> Delay (liftM loop m)
Step (a :> as) -> Step (f a :> loop as)
mapFoldable :: (Monad m, Foldable t) => (a -> t b) -> Stream (Of a) m r -> Stream (Of b) m r
mapFoldable f str = for str (\a -> each (f a))
mapM :: Monad m => (a -> m b) -> Stream (Of a) m r -> Stream (Of b) m r
mapM f = loop where
loop str = case str of
Return r -> Return r
Delay m -> Delay $ liftM loop m
Step (a :> as) -> Delay $ do
a' <- f a
return $ Step (a' :> loop as)
mapM_ :: Monad m => (a -> m b) -> Stream (Of a) m r -> m r
mapM_ f = loop where
loop str = case str of
Return r -> return r
Delay m -> m >>= loop
Step (a :> as) -> do
f a
loop as
maps' :: (Monad m, Functor f)
=> (forall x . f x -> m (a, x))
-> Stream f m r
-> Stream (Of a) m r
maps' phi = loop where
loop stream = case stream of
Return r -> Return r
Delay m -> Delay $ liftM loop m
Step fs -> Delay $ liftM (Step . uncurry (:>)) (phi (fmap loop fs))
next :: Monad m => Stream (Of a) m r -> m (Either r (a, Stream (Of a) m r))
next = loop where
loop stream = case stream of
Return r -> return (Left r)
Delay m -> m >>= loop
Step (a :> rest) -> return (Right (a,rest))
uncons :: Monad m => Stream (Of a) m () -> m (Maybe (a, Stream (Of a) m ()))
uncons = loop where
loop stream = case stream of
Return () -> return Nothing
Delay m -> m >>= loop
Step (a :> rest) -> return (Just (a,rest))
product :: (Monad m, Num a) => Stream (Of a) m () -> m a
product = fold (*) 1 id
product' :: (Monad m, Num a) => Stream (Of a) m r -> m (a,r)
product' = fold' (*) 1 id
read :: (Monad m, Read a) => Stream (Of String) m r -> Stream (Of a) m r
read stream = for stream $ \str -> case readMaybe str of
Nothing -> return ()
Just r -> yield r
repeat :: a -> Stream (Of a) m r
repeat a = loop where loop = Step (a :> loop)
repeatM :: Monad m => m a -> Stream (Of a) m r
repeatM ma = loop where
loop = Delay $ do
a <- ma
return (Step (a :> loop))
replicate :: Monad m => Int -> a -> Stream (Of a) m ()
replicate n a = loop n where
loop 0 = Return ()
loop m = Step (a :> loop (m1))
replicateM :: Monad m => Int -> m a -> Stream (Of a) m ()
replicateM n ma = loop n where
loop 0 = Return ()
loop n = Delay $ do
a <- ma
return (Step $ a :> loop (n1))
scan :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream (Of a) m r -> Stream (Of b) m r
scan step begin done = loop begin
where
loop !x stream = do
yield (done x)
case stream of
Return r -> Return r
Delay m -> Delay $ liftM (loop x) m
Step (a :> rest) -> do
let x' = step x a
loop x' rest
scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream (Of a) m r -> Stream (Of b) m r
scanM step begin done str = do
x <- lift begin
loop x str
where
loop !x stream = do
b <- lift (done x)
yield b
case stream of
Return r -> Return r
Delay m -> Delay $ liftM (loop x) m
Step (a :> rest) -> do
x' <- lift $ step x a
loop x' rest
sequence :: Monad m => Stream (Of (m a)) m r -> Stream (Of a) m r
sequence = loop where
loop stream = case stream of
Return r -> Return r
Delay m -> Delay $ liftM loop m
Step (ma :> rest) -> Delay $ do
a <- ma
return (Step (a :> loop rest))
show :: (Monad m, Show a) => Stream (Of a) m r -> Stream (Of String) m r
show = map Prelude.show
sum :: (Monad m, Num a) => Stream (Of a) m () -> m a
sum = fold (+) 0 id
sum' :: (Monad m, Num a) => Stream (Of a) m r -> m (a, r)
sum' = fold' (+) 0 id
span :: Monad m => (a -> Bool) -> Stream (Of a) m r
-> Stream (Of a) m (Stream (Of a) m r)
span pred = loop where
loop str = case str of
Return r -> Return (Return r)
Delay m -> Delay $ liftM loop m
Step (a :> rest) -> if pred a
then Step (a :> loop rest)
else Return (Step (a :> rest))
take :: (Monad m, Functor f) => Int -> Stream f m r -> Stream f m ()
take = loop where
loop n p = when (n > 0) $
case p of Step fas -> Step (fmap (loop (n1)) fas)
Delay m -> Delay (liftM (loop n) m)
Return r -> Return ()
takeWhile :: Monad m => (a -> Bool) -> Stream (Of a) m r -> Stream (Of a) m ()
takeWhile pred = loop where
loop str = case str of
Step (a :> as) -> when (pred a) (Step (a :> loop as))
Delay m -> Delay (liftM loop m)
Return r -> Return ()
toList :: Stream (Of a) Identity () -> [a]
toList = loop
where
loop stream = case stream of
Return _ -> []
Delay (Identity stream') -> loop stream'
Step (a :> rest) -> a : loop rest
toListM :: Monad m => Stream (Of a) m () -> m [a]
toListM = fold (\diff a ls -> diff (a: ls)) id (\diff -> diff [])
toListM' :: Monad m => Stream (Of a) m r -> m ([a], r)
toListM' = fold' (\diff a ls -> diff (a: ls)) id (\diff -> diff [])
unfoldr :: Monad m
=> (s -> m (Either r (a, s))) -> s -> Stream (Of a) m r
unfoldr step = loop where
loop s0 = Delay $ do
e <- step s0
case e of
Left r -> return (Return r)
Right (a,s) -> return (Step (a :> loop s))
yield :: Monad m => a -> Stream (Of a) m ()
yield a = Step (a :> Return ())
zip :: Monad m
=> (Stream (Of a) m r)
-> (Stream (Of b) m r)
-> (Stream (Of (a,b)) m r)
zip = zipWith (,)
zipWith :: Monad m
=> (a -> b -> c)
-> (Stream (Of a) m r)
-> (Stream (Of b) m r)
-> (Stream (Of c) m r)
zipWith f = loop
where
loop str0 str1 = case str0 of
Return r -> Return r
Delay m -> Delay $ liftM (\str -> loop str str1) m
Step (a :> rest0) -> case str1 of
Return r -> Return r
Delay m -> Delay $ liftM (loop str0) m
Step (b :> rest1) -> Step (f a b :>loop rest0 rest1)
stdinLn :: MonadIO m => Stream (Of String) m ()
stdinLn = fromHandle IO.stdin
readLn :: (MonadIO m, Read a) => Stream (Of a) m ()
readLn = for stdinLn $ \str -> case readMaybe str of
Nothing -> return ()
Just n -> yield n
fromHandle :: MonadIO m => IO.Handle -> Stream (Of String) m ()
fromHandle h = go
where
go = do
eof <- liftIO $ IO.hIsEOF h
unless eof $ do
str <- liftIO $ IO.hGetLine h
yield str
go
toHandle :: MonadIO m => IO.Handle -> Stream (Of String) m r -> m r
toHandle handle = loop where
loop str = case str of
Return r -> return r
Delay m -> m >>= loop
Step (s :> rest) -> do
liftIO $ IO.hPutStrLn handle s
loop rest
print :: (MonadIO m, Show a) => Stream (Of a) m r -> m r
print = loop where
loop stream = case stream of
Return r -> return r
Delay m -> m >>= loop
Step (a :> rest) -> do
liftIO (Prelude.print a)
loop rest
seq :: Monad m => Stream (Of a) m r -> Stream (Of a) m r
seq str = for str $ \a -> yield $! a
stdoutLn :: MonadIO m => Stream (Of String) m () -> m ()
stdoutLn = loop
where
loop stream = case stream of
Return _ -> return ()
Delay m -> m >>= loop
Step (s :> rest) -> do
x <- liftIO $ try (putStrLn s)
case x of
Left (G.IOError { G.ioe_type = G.ResourceVanished
, G.ioe_errno = Just ioe })
| Errno ioe == ePIPE
-> return ()
Left e -> liftIO (throwIO e)
Right () -> loop rest
stdoutLn' :: MonadIO m => Stream (Of String) m r -> m r
stdoutLn' = loop where
loop stream = case stream of
Return r -> return r
Delay m -> m >>= loop
Step (s :> rest) -> liftIO (putStrLn s) >> loop rest