streaming-eversion 0.2.0.0 → 0.3.0.0
raw patch · 6 files changed
+197/−432 lines, 6 files
Files
- CHANGELOG +7/−0
- README.md +0/−8
- src/Streaming/Eversion.hs +119/−346
- src/Streaming/Eversion/Pipes.hs +45/−52
- streaming-eversion.cabal +1/−1
- tests/tests.hs +25/−25
CHANGELOG view
@@ -1,3 +1,10 @@+0.3.0.0+=======+- Implemented the improvements suggested by Michael Thompson here :+https://groups.google.com/forum/#!topic/haskell-pipes/7n6NPTmxPKY by M.T.+- Removed the newtypes. I mistakenly believed that they were needed to avoid+having to enable -XImpredicativeTypes.+ 0.2.0.0 =======
README.md view
@@ -40,11 +40,3 @@ This library provides that. -## Why so many newtypes?--To avoid having to enable [-XImpredicativeTypes](https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#impredicative-polymorphism).--## Is it fast?--I haven't benchmarked or optimized it. It is likely to be slow.-
src/Streaming/Eversion.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-} {-| Most pull-to-push transformations in this module require functions that are polymorphic over a monad transformer. - Because of this, some of the type signatures look scary, but actually many+ Because of this, some of the type signatures look internals, but actually many (suitably polymorphic) operations on 'Stream's will unify with them. To get "interruptible" operations that can exit early with an error, put a@@ -18,49 +19,27 @@ module Streaming.Eversion ( -- * Stream folds - Eversible- , eversible- , evert- , EversibleM- , eversibleM- , eversibleM_+ evert , evertM- , EversibleMIO- , eversibleMIO- , eversibleMIO_+ , evertM_ , evertMIO+ , evertMIO_ -- * Stream transformations - , Transvertible- , transvertible , transvert- , TransvertibleM- , transvertibleM- , runTransvertibleM , transvertM- , TransvertibleMIO- , transvertibleMIO- , runTransvertibleMIO , transvertMIO+ -- * Internals+-- , Feed(..)+ , generalEvertM+ , generalTransvertM ) where -import Prelude hiding ((.),id)-import Data.Bifunctor-import Data.Profunctor--import Control.Category-import Control.Foldl (Fold(..),FoldM(..))-import qualified Control.Foldl as Foldl-import Streaming (Stream,Of(..),hoist,distribute)-import Streaming.Prelude (yield,next)-import qualified Streaming.Prelude as S-+import Prelude +import Control.Foldl (Fold(..),FoldM(..),generalize,simplify)+import Streaming (Stream,Of(..),Sum(..),inspect,unseparate)+import Streaming.Internal import Control.Monad.IO.Class import Control.Monad.Trans.Class-import Control.Monad.Trans.Identity-import Control.Monad.Free-import qualified Control.Monad.Trans.Free as TF-import Control.Monad.Trans.Except-import Control.Comonad {- $setup >>> import Data.Functor.Identity@@ -77,361 +56,155 @@ data Feed a = Input a | EOF --- What type could go here for efficiency?-type Iteratee a = Free ((->) a) --evertedStream :: forall a. Stream (Of a) (Iteratee (Feed a)) ()-evertedStream = do- r <- lift (liftF id)- case r of- Input a -> do- yield a- evertedStream- EOF -> return ()--type IterateeT a m = TF.FreeT ((->) a) m --evertedStreamM :: forall a m. Monad m => Stream (Of a) (IterateeT (Feed a) m) ()-evertedStreamM = do- r <- lift (TF.liftF id)- case r of- Input a -> do- yield a- evertedStreamM- EOF -> return ()----------------------------------------------------------------------------------------------- | A stream-folding function that can be turned into a pure, push-based fold. -newtype Eversible a x = - Eversible (forall m r. Monad m => Stream (Of a) m r -> m (Of x r)) --instance Functor (Eversible a) where- fmap f (Eversible somefold) = Eversible (fmap (first f) . somefold) --instance Profunctor Eversible where- lmap f (Eversible somefold) = Eversible (somefold . S.map f)- rmap = fmap- stoppedBeforeEOF :: String stoppedBeforeEOF = "Stopped before receiving EOF." continuedAfterEOF :: String continuedAfterEOF = "Continued after receiving EOF." -eversible :: (forall m r. Monad m => Stream (Of a) m r -> m (Of x r)) -> Eversible a x-eversible = Eversible-+internalsCat :: Monad m => Stream (Of a) (Stream ((->) (Feed a)) m) () +internalsCat = do+ r <- Effect (Step (Return . Return))+ case r of+ Input a -> Step (a :> internalsCat)+ EOF -> Return () -evert :: Eversible a x -> Fold a x-evert (Eversible consumer) = Fold step begin done- where- begin = consumer evertedStream- step s a = case s of- Pure _ -> error stoppedBeforeEOF- Free f -> f (Input a)- done s = case s of- Pure _ -> error stoppedBeforeEOF- Free f -> case f EOF of- Pure (a :> ()) -> a- Free _ -> error continuedAfterEOF+-- cat :: Monad m => Stream (Of a) (Stream ((->) (Feed a)) m) ()+-- cat = do+-- r <- lift (yields id)+-- case r of+-- Input a -> do+-- yield a+-- cat+-- EOF -> return () +evert :: (forall m r. Monad m => Stream (Of a) m r -> m (Of x r)) + -> Fold a x -- ^+evert phi = simplify (generalEvertM phi) -{- | Like 'Eversible', but gives the stream-folding function access to a base monad.+{- | Like 'evert', but gives the stream-folding function access to a base monad. >>> :{ let consume stream = lift (putStrLn "x") >> S.effects stream- in L.foldM (evertM (eversibleM_ consume)) ["a","b","c"]+ in L.foldM (evertM_ consume) ["a","b","c"] :} x Note however that control operations can't be lifted through the transformer. -}-newtype EversibleM m a x = - EversibleM (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) --instance Functor (EversibleM m a) where- fmap f (EversibleM somefold) = EversibleM (fmap (first f) . somefold) --instance Profunctor (EversibleM m) where- lmap f (EversibleM somefold) = EversibleM (somefold . S.map f)- rmap = fmap--eversibleM ::(forall t r . (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) -- ^- -> EversibleM m a x-eversibleM = EversibleM --eversibleM_ :: (forall t r . (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m r) -- ^- -> EversibleM m a ()-eversibleM_ f = EversibleM (fmap (fmap ((:>) ())) f)+evertM :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) + -> FoldM m a x -- ^+evertM phi = generalEvertM phi -evertM :: Monad m => EversibleM m a x -> FoldM m a x-evertM (EversibleM consumer) = FoldM step begin done- where- begin = return (consumer evertedStreamM)- step (TF.FreeT ms) i = do- s <- ms- case s of- TF.Pure _ -> error stoppedBeforeEOF- TF.Free f -> return (f (Input i))- done (TF.FreeT ms) = do- s <- ms- case s of - TF.Pure _ -> error stoppedBeforeEOF- TF.Free f -> do- let TF.FreeT ms' = f EOF- s' <- ms'- case s' of- TF.Pure (a :> ()) -> return a- TF.Free _ -> error continuedAfterEOF+evertM_ :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> t m r) + -> FoldM m a () -- ^+evertM_ phi = evertM (fmap (fmap ((:>) ())) phi) -{-| Like 'EversibleM', but gives the stream-consuming function the ability to use 'liftIO'.+{-| Like 'evertM', but gives the stream-consuming function the ability to use 'liftIO'. ->>> L.foldM (evertMIO (eversibleMIO_ S.print)) ["a","b","c"]+>>> L.foldM (evertMIO_ S.print) ["a","b","c"] "a" "b" "c" -}-newtype EversibleMIO m a x = - EversibleMIO (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) --instance Functor (EversibleMIO m a) where- fmap f (EversibleMIO somefold) = EversibleMIO (fmap (first f) . somefold) --instance Profunctor (EversibleMIO m) where- lmap f (EversibleMIO somefold) = EversibleMIO (somefold . S.map f)- rmap = fmap--eversibleMIO ::(forall t r . (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) -- ^- -> EversibleMIO m a x-eversibleMIO = EversibleMIO --eversibleMIO_ :: (forall t r . (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m r) -- ^- -> EversibleMIO m a ()-eversibleMIO_ f = EversibleMIO (fmap (fmap ((:>) ())) f)--evertMIO :: MonadIO m => EversibleMIO m a x -> FoldM m a x -evertMIO (EversibleMIO consumer) = FoldM step begin done- where- begin = return (consumer evertedStreamM)- step (TF.FreeT ms) i = do- s <- ms- case s of- TF.Pure _ -> error stoppedBeforeEOF- TF.Free f -> return (f (Input i))- done (TF.FreeT ms) = do- s <- ms- case s of - TF.Pure _ -> error stoppedBeforeEOF- TF.Free f -> do- let TF.FreeT ms' = f EOF- s' <- ms'- case s' of- TF.Pure (a :> ()) -> return a- TF.Free _ -> error continuedAfterEOF---- | A stream-transforming function that can be turned into fold-transforming function.-newtype Transvertible a b = - Transvertible (forall m r. Monad m => Stream (Of a) m r -> Stream (Of b) m r)--instance Functor (Transvertible a) where- fmap f (Transvertible transducer) = Transvertible (S.map f . transducer) --instance Profunctor Transvertible where- lmap f (Transvertible somefold) = Transvertible (somefold . S.map f)- rmap = fmap--instance Category Transvertible where- id = Transvertible id- (.) = \(Transvertible t1) (Transvertible t2) -> Transvertible (t1 . t2)--data Pair a b = Pair !a !b--data StreamState a b = Pristine (Stream (Of b) (Iteratee (Feed a)) ())- | Waiting (Feed a -> Iteratee (Feed a) (Either () (b, Stream (Of b) (Iteratee (Feed a)) ())))-+evertMIO :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m (Of x r)) + -> FoldM m a x -- ^+evertMIO phi = generalEvertM phi -transvertible :: (forall m r. Monad m => Stream (Of a) m r -> Stream (Of b) m r) -- ^- -> Transvertible a b-transvertible = Transvertible+evertMIO_ :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> t m r) + -> FoldM m a () -- ^+evertMIO_ phi = evertMIO (fmap (fmap ((:>) ())) phi) -transvert :: Transvertible b a - -> (forall x. Fold a x -> Fold b x)-transvert (Transvertible transducer) somefold = Fold step begin done+generalEvertM :: (Monad m) + => (forall r. Stream (Of a) (Stream ((->) (Feed a)) m) r -> Stream ((->) (Feed a)) m (Of b r))+ -> FoldM m a b -- ^+generalEvertM consumer = FoldM step begin done where- begin = Pair somefold (Pristine (transducer evertedStream))- step (Pair innerfold (Pristine pristine)) i = step (advance innerfold pristine) i- step (Pair innerfold (Waiting waiting)) i = - case waiting (Input i) of- Pure (Left ()) -> error stoppedBeforeEOF- Pure (Right (a, stream)) -> advance (Foldl.fold (duplicate innerfold) [a]) stream- Free f -> Pair innerfold (Waiting f)- advance innerfold stream = - case next stream of- Pure (Left ()) -> error stoppedBeforeEOF- Pure (Right (a,future)) -> advance (Foldl.fold (duplicate innerfold) [a]) future- Free f -> Pair innerfold (Waiting f)- done (Pair innerfold (Pristine pristine)) = done (advance innerfold pristine) - done (Pair innerfold (Waiting waiting)) =- case waiting EOF of- Pure (Left ()) -> extract innerfold- Pure (Right (a, stream)) -> extract (advancefinal (Foldl.fold (duplicate innerfold) [a]) stream)- Free _ -> error continuedAfterEOF- advancefinal innerfold stream = - case next stream of- Pure (Left ()) -> innerfold - Pure (Right (a,future)) -> advancefinal (Foldl.fold (duplicate innerfold) [a]) future- Free _ -> error continuedAfterEOF--data StreamStateM m a b = PristineM (Stream (Of b) (IterateeT (Feed a) m) ())- | WaitingM (Feed a -> IterateeT (Feed a) m (Either () (b, Stream (Of b) (IterateeT (Feed a) m) ())))---- | Like 'Transvertible', but gives the stream-transforming function access to a base monad.--- --- Note however that control operations can't be lifted through the transformer.----newtype TransvertibleM m a b = - TransvertibleM (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r)--transvertibleM :: (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r) -- ^- -> TransvertibleM m a b -transvertibleM = TransvertibleM--instance Category (TransvertibleM m) where- id = TransvertibleM id- (.) = \(TransvertibleM t1) (TransvertibleM t2) -> TransvertibleM (t1 . t2)---- | Recover the stored function, discarding the transformer.--- -runTransvertibleM :: TransvertibleM m a b -- ^- -> (forall r. Monad m => Stream (Of a) m r -> Stream (Of b) m r) -runTransvertibleM (TransvertibleM t) = \stream -> runIdentityT (distribute (t (hoist lift stream)))--instance Functor (TransvertibleM m a) where- fmap f (TransvertibleM transducer) = TransvertibleM (S.map f . transducer) + begin = return (consumer internalsCat)+ step str i = case str of + Return _ -> error stoppedBeforeEOF+ Step f -> return (f (Input i))+ Effect m -> m >>= \str' -> step str' i+ done str = do+ e <- inspect str+ case e of+ Left _ -> error stoppedBeforeEOF+ Right f -> do+ e' <- inspect (f EOF)+ case e' of+ Left (a :> ()) -> return a+ Right _ -> error continuedAfterEOF -instance Profunctor (TransvertibleM m) where- lmap f (TransvertibleM somefold) = TransvertibleM (somefold . S.map f)- rmap = fmap+transvert :: (forall m r. Monad m => Stream (Of a) m r -> Stream (Of b) m r)+ -> Fold b x -- ^+ -> Fold a x +transvert phi = \somefold -> simplify ((generalTransvertM phi) (generalize somefold)) transvertM :: Monad m - => TransvertibleM m b a - -> (forall x . FoldM m a x -> FoldM m b x)-transvertM (TransvertibleM transducer) somefold = FoldM step begin done- where- begin = return (Pair somefold (PristineM (transducer evertedStreamM)))- step (Pair innerfold (PristineM pristine)) i = do- s <- advance innerfold pristine - step s i- step (Pair innerfold (WaitingM waiting)) i = do - s <- TF.runFreeT (waiting (Input i))- case s of- TF.Pure (Left ()) -> error stoppedBeforeEOF- TF.Pure (Right (a, nexx)) -> do- step1 <- Foldl.foldM (Foldl.duplicateM innerfold) [a]- advance step1 nexx - TF.Free f -> return (Pair innerfold (WaitingM f))- advance innerfold stream = do - r <- TF.runFreeT (next stream) - case r of- TF.Pure (Left ()) -> error stoppedBeforeEOF- TF.Pure (Right (a,future)) -> do- step1 <- Foldl.foldM (Foldl.duplicateM innerfold) [a]- advance step1 future- TF.Free f -> return (Pair innerfold (WaitingM f))- done (Pair innerfold (PristineM pristine)) = do- s <- advance innerfold pristine - done s- done (Pair innerfold (WaitingM waiting)) = do- s <- TF.runFreeT (waiting EOF)- case s of- TF.Pure (Left ()) -> do- Foldl.foldM innerfold []- TF.Pure (Right (a,future)) -> do- step1 <- Foldl.foldM (Foldl.duplicateM innerfold) [a]- r <- advancefinal step1 future- Foldl.foldM r []- TF.Free _ -> error continuedAfterEOF- advancefinal innerfold stream = do- r <- TF.runFreeT (next stream) - case r of- TF.Pure (Right (a,future)) -> do- step1 <- Foldl.foldM (Foldl.duplicateM innerfold) [a]- advancefinal step1 future- TF.Pure (Left ()) -> return innerfold- TF.Free _ -> error continuedAfterEOF----- | Like 'TransvertibleM', but gives the stream-transforming function the ability to use 'liftIO'.--- -newtype TransvertibleMIO m a b = - TransvertibleMIO (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r)--instance Category (TransvertibleMIO m) where- id = TransvertibleMIO id- (.) = \(TransvertibleMIO t1) (TransvertibleMIO t2) -> TransvertibleMIO (t1 . t2)--instance Functor (TransvertibleMIO m a) where- fmap f (TransvertibleMIO transducer) = TransvertibleMIO (S.map f . transducer) --instance Profunctor (TransvertibleMIO m) where- lmap f (TransvertibleMIO somefold) = TransvertibleMIO (somefold . S.map f)- rmap = fmap+ => (forall t r. (MonadTrans t, Monad (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r)+ -> FoldM m b x -- ^+ -> FoldM m a x+transvertM phi = generalTransvertM phi -transvertibleMIO :: (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r) -- ^- -> TransvertibleMIO m a b -transvertibleMIO = TransvertibleMIO+transvertMIO :: MonadIO m + => (forall t r. (MonadTrans t, MonadIO (t m)) => Stream (Of a) (t m) r -> Stream (Of b) (t m) r)+ -> FoldM m b x -- ^+ -> FoldM m a x+transvertMIO phi = generalTransvertM phi -runTransvertibleMIO :: TransvertibleMIO m a b -- ^- -> (forall r. MonadIO m => Stream (Of a) m r -> Stream (Of b) m r) -runTransvertibleMIO (TransvertibleMIO t) = \stream -> runIdentityT (distribute (t (hoist lift stream)))+data Pair a b = Pair !a !b -transvertMIO :: (MonadIO m) - => TransvertibleMIO m b a -- ^- -> (forall x . FoldM m a x -> FoldM m b x)+data StreamStateM m a b = PristineM (Stream (Sum (Of b) ((->) (Feed a))) m ())+ | WaitingM (Feed a -> Stream (Sum (Of b) ((->) (Feed a))) m ()) -transvertMIO (TransvertibleMIO transducer) somefold = FoldM step begin done+generalTransvertM :: Monad m + => (forall r. Stream (Of a) (Stream ((->) (Feed a)) m) r -> Stream (Of b) (Stream ((->) (Feed a)) m) r) -- ^+ -> FoldM m b x + -> FoldM m a x+generalTransvertM transducer (FoldM innerstep innerbegin innerdone) = FoldM step begin done where- begin = return (Pair somefold (PristineM (transducer evertedStreamM)))- step (Pair innerfold (PristineM pristine)) i = do- s <- advance innerfold pristine + begin = do+ innerbegin' <- innerbegin+ return (Pair innerbegin' (PristineM (unseparate (transducer internalsCat))))+ step (Pair innerstate (PristineM pristine)) i = do+ s <- advance innerstate pristine step s i- step (Pair innerfold (WaitingM waiting)) i = do - s <- TF.runFreeT (waiting (Input i))+ step (Pair innerstate (WaitingM waiting)) i = do + s <- inspect (waiting (Input i)) case s of- TF.Pure (Left ()) -> error stoppedBeforeEOF- TF.Pure (Right (a, nexx)) -> do- step1 <- Foldl.foldM (Foldl.duplicateM innerfold) [a]- advance step1 nexx - TF.Free f -> return (Pair innerfold (WaitingM f))- advance innerfold stream = do - r <- TF.runFreeT (next stream) + Left () -> error stoppedBeforeEOF+ Right (InL (a :> future)) -> do+ step1 <- innerstep innerstate a+ advance step1 future + Right (InR f) -> return (Pair innerstate (WaitingM f))+ advance innerstate stream = do + r <- inspect stream case r of- TF.Pure (Left ()) -> error stoppedBeforeEOF- TF.Pure (Right (a,future)) -> do- step1 <- Foldl.foldM (Foldl.duplicateM innerfold) [a]+ Left () -> error stoppedBeforeEOF+ Right (InL (a :> future)) -> do+ step1 <- innerstep innerstate a advance step1 future- TF.Free f -> return (Pair innerfold (WaitingM f))- done (Pair innerfold (PristineM pristine)) = do- s <- advance innerfold pristine + Right (InR f) -> return (Pair innerstate (WaitingM f))+ done (Pair innerstate (PristineM pristine)) = do+ s <- advance innerstate pristine done s- done (Pair innerfold (WaitingM waiting)) = do- s <- TF.runFreeT (waiting EOF)+ done (Pair innerstate (WaitingM waiting)) = do+ s <- inspect (waiting EOF) case s of- TF.Pure (Left ()) -> do- Foldl.foldM innerfold []- TF.Pure (Right (a,future)) -> do- step1 <- Foldl.foldM (Foldl.duplicateM innerfold) [a]+ Left () -> do+ innerdone innerstate+ Right (InL (a :> future)) -> do+ step1 <- innerstep innerstate a r <- advancefinal step1 future- Foldl.foldM r []- TF.Free _ -> error continuedAfterEOF- advancefinal innerfold stream = do- r <- TF.runFreeT (next stream) + innerdone r+ Right _ -> error continuedAfterEOF+ advancefinal innerstate stream = do+ r <- inspect stream case r of- TF.Pure (Right (a,future)) -> do- step1 <- Foldl.foldM (Foldl.duplicateM innerfold) [a]+ Left () -> return innerstate+ Right (InL (a :> future)) -> do+ step1 <- innerstep innerstate a advancefinal step1 future- TF.Pure (Left ()) -> return innerfold- TF.Free _ -> error continuedAfterEOF+ Right (InR _) -> error continuedAfterEOF
src/Streaming/Eversion/Pipes.hs view
@@ -5,20 +5,14 @@ module Streaming.Eversion.Pipes ( -- * Producer folds - pipeEversible- , evert- , pipeEversibleM- , pipeEversibleM_+ evert , evertM- , pipeEversibleMIO- , pipeEversibleMIO_+ , evertM_ , evertMIO+ , evertMIO_ -- * Producer transformations - , pipeTransvertible , transvert- , pipeTransvertibleM , transvertM- , pipeTransvertibleMIO , transvertMIO -- * Examples -- $examples@@ -29,22 +23,18 @@ import Streaming(Of(..)) import qualified Streaming.Prelude-import Streaming.Eversion+import qualified Streaming.Eversion import Pipes import Pipes.Prelude+import Control.Foldl (Fold(..),FoldM(..)) {- $setup >>> :set -XOverloadedStrings->>> import Data.Functor.Identity->>> import Data.Bifunctor->>> import Data.Bitraversable >>> import Control.Error >>> import Control.Monad >>> import Control.Monad.Trans.Except->>> import Control.Monad.Trans.Identity >>> import Control.Foldl (Fold(..),FoldM(..)) >>> import qualified Control.Foldl as L->>> import Streaming (Stream,Of(..)) >>> import Streaming.Prelude (yield,next) >>> import qualified Streaming.Prelude as S >>> import Pipes@@ -57,61 +47,64 @@ ----------------------------------------------------------------------------------------- --pipeEversible :: (forall m r. Monad m => Producer a m r -> m (x,r)) -- ^- -> Eversible a x-pipeEversible f = eversible (\stream -> fmap (\(x,r) -> x :> r) (f (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))--pipeEversibleM :: (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> t m (x,r)) -- ^- -> EversibleM m a x-pipeEversibleM f = eversibleM (\stream -> fmap (\(x,r) -> x :> r) (f (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))+evert :: (forall m r. Monad m => Producer a m r -> m (x,r)) + -> Fold a x -- ^+evert phi = Streaming.Eversion.evert (\stream -> fmap (\(x,r) -> x :> r) (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) -pipeEversibleM_ :: (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> t m r) -- ^- -> EversibleM m a ()-pipeEversibleM_ f = eversibleM (\stream -> fmap (\r -> () :> r) (f (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))+evertM :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> t m (x,r)) + -> FoldM m a x -- ^+evertM phi = Streaming.Eversion.evertM (\stream -> fmap (\(x,r) -> x :> r) (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) -pipeEversibleMIO :: (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> t m (x,r)) -- ^- -> EversibleMIO m a x-pipeEversibleMIO f = eversibleMIO (\stream -> fmap (\(x,r) -> x :> r) (f (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))+evertM_ :: Monad m => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> t m r) + -> FoldM m a () -- ^+evertM_ phi = Streaming.Eversion.evertM_ (\stream -> phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)) -pipeEversibleMIO_ :: (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> t m r) -- ^- -> EversibleMIO m a ()-pipeEversibleMIO_ f = eversibleMIO (\stream -> fmap (\r -> () :> r) (f (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))+evertMIO :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> t m (x,r)) + -> FoldM m a x -- ^+evertMIO phi = Streaming.Eversion.evertMIO (\stream -> fmap (\(x,r) -> x :> r) (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) -pipeTransvertible :: (forall m r. Monad m => Producer a m r -> Producer b m r) -- ^- -> Transvertible a b-pipeTransvertible pt = transvertible (\stream -> Streaming.Prelude.unfoldr Pipes.next (pt (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))+evertMIO_ :: MonadIO m => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> t m r) + -> FoldM m a () -- ^+evertMIO_ phi = Streaming.Eversion.evertMIO_ (\stream -> phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)) -pipeTransvertibleM :: (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> Producer b (t m) r) -- ^- -> TransvertibleM m a b-pipeTransvertibleM pt = transvertibleM (\stream -> Streaming.Prelude.unfoldr Pipes.next (pt (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))+transvert :: (forall m r. Monad m => Producer a m r -> Producer b m r)+ -> Fold b x -- ^+ -> Fold a x +transvert phi = Streaming.Eversion.transvert (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) +transvertM :: Monad m + => (forall t r. (MonadTrans t, Monad (t m)) => Producer a (t m) r -> Producer b (t m) r)+ -> FoldM m b x -- ^+ -> FoldM m a x+transvertM phi = Streaming.Eversion.transvertM (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) -pipeTransvertibleMIO :: (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> Producer b (t m) r) -- ^- -> TransvertibleMIO m a b-pipeTransvertibleMIO pt = transvertibleMIO (\stream -> Streaming.Prelude.unfoldr Pipes.next (pt (Pipes.Prelude.unfoldr Streaming.Prelude.next stream)))+transvertMIO :: MonadIO m + => (forall t r. (MonadTrans t, MonadIO (t m)) => Producer a (t m) r -> Producer b (t m) r)+ -> FoldM m b x -- ^+ -> FoldM m a x+transvertMIO phi = Streaming.Eversion.transvertMIO (\stream -> Streaming.Prelude.unfoldr Pipes.next (phi (Pipes.Prelude.unfoldr Streaming.Prelude.next stream))) {- $examples - Creating a 'TransvertibleM' out a decoder from "Pipes.Text.Encoding". In- case the decoding fails, part of the leftovers are read in order to build- the error value. + Applying a decoder from "Pipes.Text.Encoding" to the inputs of a Fold. In+ case the decoding fails, part of the leftovers are read in order to build the+ error value. >>> :{ - let trans = transvertM (pipeTransvertibleM (\producer -> do result <- PT.decode (PT.utf8 . PT.eof) producer - lift (case result of- Left ls -> sample ls >>= lift . throwE- Right r -> return r)))+ let trans = transvertM (\producer -> do result <- PT.decode (PT.utf8 . PT.eof) producer + lift (case result of+ Left ls -> sample ls >>= lift . throwE+ Right r -> return r)) sample leftovers = L.purely P.fold L.mconcat (void (view (PB.splitAt 5) leftovers)) in runExceptT $ L.foldM (trans (L.generalize L.mconcat)) ["decode","this"] :} Right "decodethis" >>> :{ - let trans = transvertM (pipeTransvertibleM (\producer -> do result <- PT.decode (PT.utf8 . PT.eof) producer - lift (case result of- Left ls -> sample ls >>= lift . throwE- Right r -> return r)))+ let trans = transvertM (\producer -> do result <- PT.decode (PT.utf8 . PT.eof) producer + lift (case result of+ Left ls -> sample ls >>= lift . throwE+ Right r -> return r)) sample leftovers = L.purely P.fold L.mconcat (void (view (PB.splitAt 8) leftovers)) in runExceptT $ L.foldM (trans (L.generalize L.mconcat)) ["invalid \xc3\x28","sequence"] :}
streaming-eversion.cabal view
@@ -1,5 +1,5 @@ Name: streaming-eversion-Version: 0.2.0.0+Version: 0.3.0.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3
tests/tests.hs view
@@ -22,27 +22,27 @@ testCaseEq "empty" ([]::[Integer])- (Foldl.fold (evert (eversible S.toList)) [])+ (Foldl.fold (evert S.toList) []) , testCaseEq "toList" [1..10::Integer]- (Foldl.fold (evert (eversible S.toList)) [1..10])+ (Foldl.fold (evert S.toList) [1..10]) ] , testGroup "evertM" [ testCaseEq "empty" ([]::[Integer])- (runIdentity (Foldl.foldM (evertM (eversibleM S.toList)) []))+ (runIdentity (Foldl.foldM (evertM S.toList) [])) , testCaseEq "toList" [1..10::Integer]- (runIdentity (Foldl.foldM (evertM (eversibleM S.toList)) [1..10]))+ (runIdentity (Foldl.foldM (evertM S.toList) [1..10])) , testCaseEqIO "ref" (True,[1..10::Integer]) (do ref <- newIORef False - res <- Foldl.foldM (evertM (eversibleM (\s -> S.toList s <* lift (writeIORef ref True)))) [1..10]+ res <- Foldl.foldM (evertM (\s -> S.toList s <* lift (writeIORef ref True))) [1..10] refval <- readIORef ref return (refval,res)) ]@@ -51,16 +51,16 @@ testCaseEqIO "empty" ([]::[Integer])- (Foldl.foldM (evertMIO (eversibleMIO S.toList)) [])+ (Foldl.foldM (evertMIO S.toList) []) , testCaseEqIO "toList" [1..10::Integer]- (Foldl.foldM (evertMIO (eversibleMIO S.toList)) [1..10])+ (Foldl.foldM (evertMIO S.toList) [1..10]) , testCaseEqIO "ref" (True,[1..10::Integer]) (do ref <- newIORef False - res <- Foldl.foldM (evertMIO (eversibleMIO (\s -> S.toList s <* liftIO (writeIORef ref True)))) [1..10]+ res <- Foldl.foldM (evertMIO (\s -> S.toList s <* liftIO (writeIORef ref True))) [1..10] refval <- readIORef ref return (refval,res)) ]@@ -69,51 +69,51 @@ testCaseEq "empty" ([]::[Integer])- (Foldl.fold (transvert (transvertible id) Foldl.list) [])+ (Foldl.fold (transvert id Foldl.list) []) , testCaseEq "notempty" ([1..5]::[Integer])- (Foldl.fold (transvert (transvertible id) Foldl.list) [1..5])+ (Foldl.fold (transvert id Foldl.list) [1..5]) , testCaseEq "surroundempty" ([1,2,3,4]::[Integer])- (Foldl.fold (transvert (transvertible (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4)) Foldl.list) [])+ (Foldl.fold (transvert (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) Foldl.list) []) , testCaseEq "surround" ([1,2,3,4,5,6]::[Integer])- (Foldl.fold (transvert (transvertible (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6)) Foldl.list) [3,4])+ (Foldl.fold (transvert (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) Foldl.list) [3,4]) , testCaseEq "group" ([[1,1],[2,2,2],[3,3,3]]::[[Integer]])- (Foldl.fold (transvert (transvertible (mapped S.toList . S.group)) Foldl.list) [1,1,2,2,2,3,3,3])+ (Foldl.fold (transvert (mapped S.toList . S.group) Foldl.list) [1,1,2,2,2,3,3,3]) ] , testGroup "transduceM" [ testCaseEq "empty" ([]::[Integer])- (runIdentity (Foldl.foldM (transvertM (transvertibleM id) (Foldl.generalize Foldl.list)) []))+ (runIdentity (Foldl.foldM (transvertM id (Foldl.generalize Foldl.list)) [])) , testCaseEq "notempty" ([1..5]::[Integer])- (runIdentity (Foldl.foldM (transvertM (transvertibleM id) (Foldl.generalize Foldl.list)) [1..5]))+ (runIdentity (Foldl.foldM (transvertM id (Foldl.generalize Foldl.list)) [1..5])) , testCaseEq "surroundempty" ([1,2,3,4]::[Integer])- (runIdentity (Foldl.foldM (transvertM (transvertibleM (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4)) (Foldl.generalize Foldl.list)) []))+ (runIdentity (Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) (Foldl.generalize Foldl.list)) [])) , testCaseEq "surround" ([1,2,3,4,5,6]::[Integer])- (runIdentity (Foldl.foldM (transvertM (transvertibleM (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6)) (Foldl.generalize Foldl.list)) [3,4]))+ (runIdentity (Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4])) , testCaseEq "group" ([[1,1],[2,2,2],[3,3,3]]::[[Integer]])- (runIdentity (Foldl.foldM (transvertM (transvertibleM (mapped S.toList . S.group)) (Foldl.generalize Foldl.list)) [1,1,2,2,2,3,3,3]))+ (runIdentity (Foldl.foldM (transvertM (mapped S.toList . S.group) (Foldl.generalize Foldl.list)) [1,1,2,2,2,3,3,3])) , testCaseEqIO "ref" (True,[1,2,3,4,5,6]::[Integer]) (do ref <- newIORef False - res <- Foldl.foldM (transvertM (transvertibleM (\s -> S.yield 1 *> S.yield 2 *> (lift (lift (writeIORef ref True))) *> s <* S.yield 5 <* S.yield 6)) (Foldl.generalize Foldl.list)) [3,4]+ res <- Foldl.foldM (transvertM (\s -> S.yield 1 *> S.yield 2 *> (lift (lift (writeIORef ref True))) *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4] refval <- readIORef ref return (refval,res)) ]@@ -122,28 +122,28 @@ testCaseEqIO "empty" ([]::[Integer])- (Foldl.foldM (transvertMIO (transvertibleMIO id) (Foldl.generalize Foldl.list)) [])+ (Foldl.foldM (transvertMIO id (Foldl.generalize Foldl.list)) []) , testCaseEqIO "notempty" ([1..5]::[Integer])- (Foldl.foldM (transvertMIO (transvertibleMIO id) (Foldl.generalize Foldl.list)) [1..5])+ (Foldl.foldM (transvertMIO id (Foldl.generalize Foldl.list)) [1..5]) , testCaseEqIO "surroundempty" ([1,2,3,4]::[Integer])- (Foldl.foldM (transvertMIO (transvertibleMIO (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4)) (Foldl.generalize Foldl.list)) [])+ (Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 3 <* S.yield 4) (Foldl.generalize Foldl.list)) []) , testCaseEqIO "surround" ([1,2,3,4,5,6]::[Integer])- (Foldl.foldM (transvertMIO (transvertibleMIO (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6)) (Foldl.generalize Foldl.list)) [3,4])+ (Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4]) , testCaseEqIO "group" ([[1,1],[2,2,2],[3,3,3]]::[[Integer]])- (Foldl.foldM (transvertMIO (transvertibleMIO (mapped S.toList . S.group)) (Foldl.generalize Foldl.list)) [1,1,2,2,2,3,3,3])+ (Foldl.foldM (transvertMIO (mapped S.toList . S.group) (Foldl.generalize Foldl.list)) [1,1,2,2,2,3,3,3]) , testCaseEqIO "ref" (True,[1,2,3,4,5,6]::[Integer]) (do ref <- newIORef False - res <- Foldl.foldM (transvertMIO (transvertibleMIO (\s -> S.yield 1 *> S.yield 2 *> (liftIO (writeIORef ref True)) *> s <* S.yield 5 <* S.yield 6)) (Foldl.generalize Foldl.list)) [3,4]+ res <- Foldl.foldM (transvertMIO (\s -> S.yield 1 *> S.yield 2 *> (liftIO (writeIORef ref True)) *> s <* S.yield 5 <* S.yield 6) (Foldl.generalize Foldl.list)) [3,4] refval <- readIORef ref return (refval,res)) ]