{-# LANGUAGE CPP #-}
module Stream (
Stream(..), yield, liftIO,
collect, fromList,
Stream.map, Stream.mapM, Stream.mapAccumL
) where
import Control.Monad
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative
#endif
newtype Stream m a b = Stream { runStream :: m (Either b (a, Stream m a b)) }
instance Monad f => Functor (Stream f a) where
fmap = liftM
instance Monad m => Applicative (Stream m a) where
pure a = Stream (return (Left a))
(<*>) = ap
instance Monad m => Monad (Stream m a) where
return = pure
Stream m >>= k = Stream $ do
r <- m
case r of
Left b -> runStream (k b)
Right (a,str) -> return (Right (a, str >>= k))
yield :: Monad m => a -> Stream m a ()
yield a = Stream (return (Right (a, return ())))
liftIO :: IO a -> Stream IO b a
liftIO io = Stream $ io >>= return . Left
collect :: Monad m => Stream m a () -> m [a]
collect str = go str []
where
go str acc = do
r <- runStream str
case r of
Left () -> return (reverse acc)
Right (a, str') -> go str' (a:acc)
fromList :: Monad m => [a] -> Stream m a ()
fromList = mapM_ yield
map :: Monad m => (a -> b) -> Stream m a x -> Stream m b x
map f str = Stream $ do
r <- runStream str
case r of
Left x -> return (Left x)
Right (a, str') -> return (Right (f a, Stream.map f str'))
mapM :: Monad m => (a -> m b) -> Stream m a x -> Stream m b x
mapM f str = Stream $ do
r <- runStream str
case r of
Left x -> return (Left x)
Right (a, str') -> do
b <- f a
return (Right (b, Stream.mapM f str'))
mapAccumL :: Monad m => (c -> a -> m (c,b)) -> c -> Stream m a ()
-> Stream m b c
mapAccumL f c str = Stream $ do
r <- runStream str
case r of
Left () -> return (Left c)
Right (a, str') -> do
(c',b) <- f c a
return (Right (b, mapAccumL f c' str'))