diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,24 +1,24 @@ -Copyright (c) 2014 Gabriel Gonzalez -All rights reserved. - -Redistribution and use in source and binary forms, with or without modification, -are permitted provided that the following conditions are met: - * Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. - * Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - * Neither the name of Gabriel Gonzalez nor the names of other contributors - may be used to endorse or promote products derived from this software - without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON -ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c) 2014 Gabriel Gonzalez +All rights reserved. + +Redistribution and use in source and binary forms, with or without modification, +are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + * Neither the name of Gabriel Gonzalez nor the names of other contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON +ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/pipes-group.cabal b/pipes-group.cabal --- a/pipes-group.cabal +++ b/pipes-group.cabal @@ -1,38 +1,38 @@ -Name: pipes-group -Version: 1.0.1 -Cabal-Version: >=1.8.0.2 -Build-Type: Simple -License: BSD3 -License-File: LICENSE -Copyright: 2014 Gabriel Gonzalez -Author: Gabriel Gonzalez -Maintainer: Gabriel439@gmail.com -Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Group-Library/issues -Synopsis: Group streams into substreams -Description: @pipes-group@ uses @FreeT@ and lenses to group streams into - sub-streams. Notable features include: - . - * /Perfect Streaming/: Group elements without collecting them into memory - . - * /Lens Support/: Use lenses to simplify many common operations - . - @Pipes.Group@ contains the full documentation for this library. - . - Read @Pipes.Group.Tutorial@ for an extensive tutorial. -Category: Control, Pipes -Source-Repository head - Type: git - Location: https://github.com/Gabriel439/Haskell-Pipes-Group-Library - -Library - HS-Source-Dirs: src - Build-Depends: - base >= 4 && < 5 , - free >= 3.2 && < 5 , - pipes >= 4.0 && < 4.2, - pipes-parse >= 3.0.0 && < 3.1, - transformers >= 0.2.0.0 && < 0.5 - Exposed-Modules: - Pipes.Group - Pipes.Group.Tutorial - GHC-Options: -O2 -Wall +Name: pipes-group +Version: 1.0.2 +Cabal-Version: >=1.8.0.2 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Copyright: 2014 Gabriel Gonzalez +Author: Gabriel Gonzalez +Maintainer: Gabriel439@gmail.com +Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Group-Library/issues +Synopsis: Group streams into substreams +Description: @pipes-group@ uses @FreeT@ and lenses to group streams into + sub-streams. Notable features include: + . + * /Perfect Streaming/: Group elements without collecting them into memory + . + * /Lens Support/: Use lenses to simplify many common operations + . + @Pipes.Group@ contains the full documentation for this library. + . + Read @Pipes.Group.Tutorial@ for an extensive tutorial. +Category: Control, Pipes +Source-Repository head + Type: git + Location: https://github.com/Gabriel439/Haskell-Pipes-Group-Library + +Library + HS-Source-Dirs: src + Build-Depends: + base >= 4 && < 5 , + free >= 3.2 && < 5 , + pipes >= 4.0 && < 4.2, + pipes-parse >= 3.0.0 && < 3.1, + transformers >= 0.2.0.0 && < 0.5 + Exposed-Modules: + Pipes.Group + Pipes.Group.Tutorial + GHC-Options: -O2 -Wall diff --git a/src/Pipes/Group.hs b/src/Pipes/Group.hs --- a/src/Pipes/Group.hs +++ b/src/Pipes/Group.hs @@ -1,338 +1,353 @@ -{-| Element-agnostic grouping utilities for @pipes@ - - See "Pipes.Group.Tutorial" for an extended tutorial --} - -{-# LANGUAGE RankNTypes #-} - -module Pipes.Group ( - -- * Lenses - groupsBy, - groups, - chunksOf, - - -- * Transformations - takes, - takes', - drops, - maps, - individually, - - -- * Joiners - concats, - intercalates, - - -- * Folds - -- $folds - folds, - foldsM, - - -- * Re-exports - -- $reexports - module Control.Monad.Trans.Class, - module Control.Monad.Trans.Free, - module Pipes - ) where - -import Control.Monad.Trans.Class (lift) -import Control.Monad.Trans.Free (FreeF(Pure, Free), FreeT(FreeT, runFreeT)) -import qualified Control.Monad.Trans.Free as F -import Data.Functor.Constant (Constant(Constant, getConstant)) -import Data.Functor.Identity (Identity(Identity, runIdentity)) -import Pipes (Producer, yield, next) -import Pipes.Parse (span, splitAt) -import qualified Pipes as P - -import Prelude hiding (span, splitAt) - -type Lens a' a b' b = forall f . Functor f => (b' -> f b) -> (a' -> f a) -type Setter a' a b' b = (b' -> Identity b) -> (a' -> Identity a) - -(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b -a ^. lens = getConstant (lens Constant a) - -{-| 'groupsBy' splits a 'Producer' into a 'FreeT' of 'Producer's grouped using - the given equality predicate - - You can think of this as: - -> groupsBy -> :: Monad m -> => (a -> a -> Bool) -> Lens' (Producer a m x) (FreeT (Producer a m) m x) --} -groupsBy - :: Monad m - => (a' -> a' -> Bool) -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) -groupsBy equals k p0 = fmap concats (k (_groupsBy p0)) - where --- _groupsBy :: Monad m => Producer a m r -> FreeT (Producer a m) m r - _groupsBy p = FreeT $ do - x <- next p - return $ case x of - Left r -> Pure r - Right (a, p') -> Free $ - fmap _groupsBy ((yield a >> p')^.span (equals a)) -{-# INLINABLE groupsBy #-} - -{-| Like 'groupsBy', where the equality predicate is ('==') - - You can think of this as: - -> groups -> :: (Monad m, Eq a) => Lens' (Producer a m x) (FreeT (Producer a m) m x) --} -groups :: (Monad m, Eq a') => Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) -groups = groupsBy (==) -{-# INLINABLE groups #-} - -{-| 'chunksOf' is an splits a 'Producer' into a 'FreeT' of 'Producer's of fixed - length - - You can think of this as: - -> chunksOf -> :: Monad m => Int -> Lens' (Producer a m x) (FreeT (Producer a m) m x) --} -chunksOf - :: Monad m => Int -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) -chunksOf n0 k p0 = fmap concats (k (_chunksOf p0)) - where --- _chunksOf :: Monad m => Producer a m x -> FreeT (Producer a m) m x - _chunksOf p = FreeT $ do - x <- next p - return $ case x of - Left r -> Pure r - Right (a, p') -> Free $ fmap _chunksOf ((yield a >> p')^.splitAt n0) -{-# INLINABLE chunksOf #-} - --- | Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' -concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x -concats = go - where - go f = do - x <- lift (runFreeT f) - case x of - Pure r -> return r - Free p -> do - f' <- p - go f' -{-# INLINABLE concats #-} - -{-| Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' by - intercalating a 'Producer' in between them --} -intercalates - :: Monad m => Producer a m () -> FreeT (Producer a m) m x -> Producer a m x -intercalates sep = go0 - where - go0 f = do - x <- lift (runFreeT f) - case x of - Pure r -> return r - Free p -> do - f' <- p - go1 f' - go1 f = do - x <- lift (runFreeT f) - case x of - Pure r -> return r - Free p -> do - sep - f' <- p - go1 f' -{-# INLINABLE intercalates #-} - -{-| @(takes n)@ only keeps the first @n@ functor layers of a 'FreeT' - - You can think of this as: - -> takes -> :: (Functor f, Monad m) -> => Int -> FreeT (Producer a m) m () -> FreeT (Producer a m) m () --} -takes :: (Functor f, Monad m) => Int -> FreeT f m () -> FreeT f m () -takes = go - where - go n f = - if (n > 0) - then FreeT $ do - x <- runFreeT f - case x of - Pure () -> return (Pure ()) - Free w -> return (Free (fmap (go $! n - 1) w)) - else return () -{-# INLINABLE takes #-} - -{-| @(takes' n)@ only keeps the first @n@ 'Producer's of a 'FreeT' - - 'takes'' differs from 'takes' by draining unused 'Producer's in order - to preserve the return value. This makes it a suitable argument for 'maps'. --} -takes' :: Monad m => Int -> FreeT (Producer a m) m x -> FreeT (Producer a m) m x -takes' = go0 - where - go0 n f = FreeT $ - if (n > 0) - then do - x <- runFreeT f - return $ case x of - Pure r -> Pure r - Free p -> Free $ fmap (go0 $! n - 1) p - else go1 f - go1 f = do - x <- runFreeT f - case x of - Pure r -> return (Pure r) - Free p -> do - f' <- P.runEffect (P.for p P.discard) - go1 f' -{-# INLINABLE takes' #-} - -{-| @(drops n)@ peels off the first @n@ 'Producer' layers of a 'FreeT' - - Use carefully: the peeling off is not free. This runs the first @n@ - layers, just discarding everything they produce. --} -drops :: Monad m => Int -> FreeT (Producer a m) m x -> FreeT (Producer a m) m x -drops = go - where - go n ft - | n <= 0 = ft - | otherwise = FreeT $ do - ff <- runFreeT ft - case ff of - Pure _ -> return ff - Free f -> do - ft' <- P.runEffect $ P.for f P.discard - runFreeT $ go (n-1) ft' -{-# INLINABLE drops #-} - -{-| Transform each individual functor layer of a 'FreeT' - - You can think of this as: - -> maps -> :: (forall r . Producer a m r -> Producer b m r) -> -> FreeT (Producer a m) m x -> FreeT (Producer b m) m x - - This is just a synonym for 'F.transFreeT' --} -maps - :: (Monad m, Functor g) - => (forall r . f r -> g r) -> FreeT f m x -> FreeT g m x -maps = F.transFreeT -{-# INLINABLE maps #-} - -{-| Lens to transform each individual functor layer of a 'FreeT' - -> over individually = maps -- ... with a less general type --} -individually - :: (Monad m, Functor g) - => Setter (FreeT f m x) (FreeT g m x) (f (FreeT f m x)) (g (FreeT f m x)) -individually nat f0 = Identity (go f0) - where - nat' = runIdentity . nat - go f = FreeT $ do - x <- runFreeT f - return $ case x of - Pure r -> Pure r - Free w -> Free (fmap go (nat' w)) -{-# INLINABLE individually #-} - -{- $folds - These folds are designed to be compatible with the @foldl@ library. See - the 'Control.Foldl.purely' and 'Control.Foldl.impurely' functions from that - library for more details. - - For example, to count the number of 'Producer' layers in a 'FreeT', you can - write: - -> import Control.Applicative (pure) -> import qualified Control.Foldl as L -> import Pipes.Group -> import qualified Pipes.Prelude as P -> -> count :: Monad m => FreeT (Producer a m) m () -> m Int -> count = P.sum . L.purely folds (pure 1) --} -{-| Fold each 'Producer' of a 'FreeT' - -> purely folds -> :: Monad m => Fold a b -> FreeT (Producer a m) m r -> Producer b m r --} -folds - :: Monad m - => (x -> a -> x) - -- ^ Step function - -> x - -- ^ Initial accumulator - -> (x -> b) - -- ^ Extraction function - -> FreeT (Producer a m) m r - -- ^ - -> Producer b m r -folds step begin done = go - where - go f = do - x <- lift (runFreeT f) - case x of - Pure r -> return r - Free p -> do - (f', b) <- lift (fold p begin) - yield b - go f' - - fold p x = do - y <- next p - case y of - Left f -> return (f, done x) - Right (a, p') -> fold p' $! step x a -{-# INLINABLE folds #-} - -{-| Fold each 'Producer' of a 'FreeT', monadically - -> impurely foldsM -> :: Monad m => FoldM a b -> FreeT (Producer a m) m r -> Producer b m r --} -foldsM - :: Monad m - => (x -> a -> m x) - -- ^ Step function - -> m x - -- ^ Initial accumulator - -> (x -> m b) - -- ^ Extraction function - -> FreeT (Producer a m) m r - -- ^ - -> Producer b m r -foldsM step begin done = go - where - go f = do - y <- lift (runFreeT f) - case y of - Pure r -> return r - Free p -> do - (f', b) <- lift $ do - x <- begin - foldM p x - yield b - go f' - - foldM p x = do - y <- next p - case y of - Left f -> do - b <- done x - return (f, b) - Right (a, p') -> do - x' <- step x a - foldM p' $! x' - -{- $reexports - "Control.Monad.Trans.Class" re-exports 'lift'. - - "Control.Monad.Trans.Free" re-exports 'FreeF' and 'FreeT' - - "Pipes" re-exports 'Producer', 'yield', and 'next'. --} +{-| Element-agnostic grouping utilities for @pipes@ + + See "Pipes.Group.Tutorial" for an extended tutorial +-} + +{-# LANGUAGE RankNTypes #-} + +module Pipes.Group ( + -- * Lenses + groupsBy, + groups, + chunksOf, + + -- * Transformations + takes, + takes', + drops, + maps, + individually, + + -- * Joiners + concats, + intercalates, + + -- * Folds + -- $folds + folds, + foldsM, + + -- * Re-exports + -- $reexports + module Control.Monad.Trans.Class, + module Control.Monad.Trans.Free, + module Pipes + ) where + +import Control.Monad.Trans.Class (lift) +import Control.Monad.Trans.Free (FreeF(Pure, Free), FreeT(FreeT, runFreeT)) +import qualified Control.Monad.Trans.Free as F +import Data.Functor.Constant (Constant(Constant, getConstant)) +import Data.Functor.Identity (Identity(Identity, runIdentity)) +import Pipes (Producer, yield, next) +import Pipes.Parse (span, splitAt) +import qualified Pipes as P + +import Prelude hiding (span, splitAt) + +type Lens a' a b' b = forall f . Functor f => (b' -> f b) -> (a' -> f a) +type Setter a' a b' b = (b' -> Identity b) -> (a' -> Identity a) + +(^.) :: a -> ((b -> Constant b b) -> (a -> Constant b a)) -> b +a ^. lens = getConstant (lens Constant a) + +{-| 'groupsBy' splits a 'Producer' into a 'FreeT' of 'Producer's grouped using + the given equality predicate + +>>> P.toList . intercalates (P.yield '|') . view (groupsBy (==)) $ P.each "12233345" +"1|22|333|4|5" + + You can think of this as: + +> groupsBy +> :: Monad m +> => (a -> a -> Bool) -> Lens' (Producer a m x) (FreeT (Producer a m) m x) +-} +groupsBy + :: Monad m + => (a' -> a' -> Bool) -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) +groupsBy equals k p0 = fmap concats (k (_groupsBy p0)) + where +-- _groupsBy :: Monad m => Producer a m r -> FreeT (Producer a m) m r + _groupsBy p = FreeT $ do + x <- next p + return $ case x of + Left r -> Pure r + Right (a, p') -> Free $ + fmap _groupsBy ((yield a >> p')^.span (equals a)) +{-# INLINABLE groupsBy #-} + +{-| Like 'groupsBy', where the equality predicate is ('==') + +>>> P.toList . intercalates (P.yield '|') . view groups $ P.each "12233345" +"1|22|333|4|5" + + You can think of this as: + +> groups +> :: (Monad m, Eq a) => Lens' (Producer a m x) (FreeT (Producer a m) m x) +-} +groups :: (Monad m, Eq a') => Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) +groups = groupsBy (==) +{-# INLINABLE groups #-} + +{-| 'chunksOf' is an splits a 'Producer' into a 'FreeT' of 'Producer's of fixed + length + +>>> P.toList . intercalates (P.yield '|') . view (chunksOf 3) $ P.each "12233345" +"122|333|45" + + You can think of this as: + +> chunksOf +> :: Monad m => Int -> Lens' (Producer a m x) (FreeT (Producer a m) m x) +-} +chunksOf + :: Monad m => Int -> Lens (Producer a' m x) (Producer a m x) (FreeT (Producer a' m) m x) (FreeT (Producer a m) m x) +chunksOf n0 k p0 = fmap concats (k (_chunksOf p0)) + where +-- _chunksOf :: Monad m => Producer a m x -> FreeT (Producer a m) m x + _chunksOf p = FreeT $ do + x <- next p + return $ case x of + Left r -> Pure r + Right (a, p') -> Free $ fmap _chunksOf ((yield a >> p')^.splitAt n0) +{-# INLINABLE chunksOf #-} + +-- | Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' +concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x +concats = go + where + go f = do + x <- lift (runFreeT f) + case x of + Pure r -> return r + Free p -> do + f' <- p + go f' +{-# INLINABLE concats #-} + +{-| Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' by + intercalating a 'Producer' in between them +-} +intercalates + :: Monad m => Producer a m () -> FreeT (Producer a m) m x -> Producer a m x +intercalates sep = go0 + where + go0 f = do + x <- lift (runFreeT f) + case x of + Pure r -> return r + Free p -> do + f' <- p + go1 f' + go1 f = do + x <- lift (runFreeT f) + case x of + Pure r -> return r + Free p -> do + sep + f' <- p + go1 f' +{-# INLINABLE intercalates #-} + +{-| @(takes n)@ only keeps the first @n@ functor layers of a 'FreeT' + +>>> P.toList . intercalates (P.yield '|') . takes 3 . view groups $ P.each "12233345" +"1|22|333" + + You can think of this as: + +> takes +> :: (Functor f, Monad m) +> => Int -> FreeT (Producer a m) m () -> FreeT (Producer a m) m () +-} +takes :: (Functor f, Monad m) => Int -> FreeT f m () -> FreeT f m () +takes = go + where + go n f = + if (n > 0) + then FreeT $ do + x <- runFreeT f + case x of + Pure () -> return (Pure ()) + Free w -> return (Free (fmap (go $! n - 1) w)) + else return () +{-# INLINABLE takes #-} + +{-| @(takes' n)@ only keeps the first @n@ 'Producer's of a 'FreeT' + + 'takes'' differs from 'takes' by draining unused 'Producer's in order + to preserve the return value. This makes it a suitable argument for 'maps'. +-} +takes' :: Monad m => Int -> FreeT (Producer a m) m x -> FreeT (Producer a m) m x +takes' = go0 + where + go0 n f = FreeT $ + if (n > 0) + then do + x <- runFreeT f + return $ case x of + Pure r -> Pure r + Free p -> Free $ fmap (go0 $! n - 1) p + else go1 f + go1 f = do + x <- runFreeT f + case x of + Pure r -> return (Pure r) + Free p -> do + f' <- P.runEffect (P.for p P.discard) + go1 f' +{-# INLINABLE takes' #-} + +{-| @(drops n)@ peels off the first @n@ 'Producer' layers of a 'FreeT' + +>>> P.toList . intercalates (P.yield '|') . drops 3 . view groups $ P.each "12233345" +"4|5" + + __Use carefully__: the peeling off is not free. This runs the first @n@ + layers, just discarding everything they produce. +-} +drops :: Monad m => Int -> FreeT (Producer a m) m x -> FreeT (Producer a m) m x +drops = go + where + go n ft + | n <= 0 = ft + | otherwise = FreeT $ do + ff <- runFreeT ft + case ff of + Pure _ -> return ff + Free f -> do + ft' <- P.runEffect $ P.for f P.discard + runFreeT $ go (n-1) ft' +{-# INLINABLE drops #-} + +{-| Transform each individual functor layer of a 'FreeT' + + You can think of this as: + +> maps +> :: (forall r . Producer a m r -> Producer b m r) +> -> FreeT (Producer a m) m x -> FreeT (Producer b m) m x + + This is just a synonym for 'F.transFreeT' +-} +maps + :: (Monad m, Functor g) + => (forall r . f r -> g r) -> FreeT f m x -> FreeT g m x +maps = F.transFreeT +{-# INLINABLE maps #-} + +{-| Lens to transform each individual functor layer of a 'FreeT' + +> over individually = maps -- ... with a less general type +-} +individually + :: (Monad m, Functor g) + => Setter (FreeT f m x) (FreeT g m x) (f (FreeT f m x)) (g (FreeT f m x)) +individually nat f0 = Identity (go f0) + where + nat' = runIdentity . nat + go f = FreeT $ do + x <- runFreeT f + return $ case x of + Pure r -> Pure r + Free w -> Free (fmap go (nat' w)) +{-# INLINABLE individually #-} + +{- $folds + These folds are designed to be compatible with the @foldl@ library. See + the 'Control.Foldl.purely' and 'Control.Foldl.impurely' functions from that + library for more details. + + For example, to count the number of 'Producer' layers in a 'FreeT', you can + write: + +> import Control.Applicative (pure) +> import qualified Control.Foldl as L +> import Pipes.Group +> import qualified Pipes.Prelude as P +> +> count :: Monad m => FreeT (Producer a m) m () -> m Int +> count = P.sum . L.purely folds (pure 1) +-} +{-| Fold each 'Producer' of a 'FreeT' + +> purely folds +> :: Monad m => Fold a b -> FreeT (Producer a m) m r -> Producer b m r +-} +folds + :: Monad m + => (x -> a -> x) + -- ^ Step function + -> x + -- ^ Initial accumulator + -> (x -> b) + -- ^ Extraction function + -> FreeT (Producer a m) m r + -- ^ + -> Producer b m r +folds step begin done = go + where + go f = do + x <- lift (runFreeT f) + case x of + Pure r -> return r + Free p -> do + (f', b) <- lift (fold p begin) + yield b + go f' + + fold p x = do + y <- next p + case y of + Left f -> return (f, done x) + Right (a, p') -> fold p' $! step x a +{-# INLINABLE folds #-} + +{-| Fold each 'Producer' of a 'FreeT', monadically + +> impurely foldsM +> :: Monad m => FoldM a b -> FreeT (Producer a m) m r -> Producer b m r +-} +foldsM + :: Monad m + => (x -> a -> m x) + -- ^ Step function + -> m x + -- ^ Initial accumulator + -> (x -> m b) + -- ^ Extraction function + -> FreeT (Producer a m) m r + -- ^ + -> Producer b m r +foldsM step begin done = go + where + go f = do + y <- lift (runFreeT f) + case y of + Pure r -> return r + Free p -> do + (f', b) <- lift $ do + x <- begin + foldM p x + yield b + go f' + + foldM p x = do + y <- next p + case y of + Left f -> do + b <- done x + return (f, b) + Right (a, p') -> do + x' <- step x a + foldM p' $! x' + +{- $reexports + "Control.Monad.Trans.Class" re-exports 'lift'. + + "Control.Monad.Trans.Free" re-exports 'FreeF' and 'FreeT' + + "Pipes" re-exports 'Producer', 'yield', and 'next'. +-} diff --git a/src/Pipes/Group/Tutorial.hs b/src/Pipes/Group/Tutorial.hs --- a/src/Pipes/Group/Tutorial.hs +++ b/src/Pipes/Group/Tutorial.hs @@ -1,354 +1,354 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports #-} - -{-| @pipes-group@ builds upon @pipes@ to establish idioms for grouping streams - into sub-streams without collecting elements into memory. This tutorial - assumes familiarity with @pipes@ and @pipes-parse@. --} - -module Pipes.Group.Tutorial ( - -- * Motivation - -- $motivation - - -- * FreeT - -- $freeT - - -- * How FreeT Works - -- $advanced - - -- * Conclusion - -- $conclusion - ) where - -import Pipes -import Pipes.Group - -{- $motivation - Dividing a stream into sub-streams is non-trivial. To illustrate the - problem, consider the following task: limit a stream to the first three - groups of elements (a group means consecutive equal elements). - - The wrong way to do it is to read each group into memory like this: - -> import Lens.Family.State.Strict (zoom) -> import Pipes -> import Pipes.Parse -> import qualified Pipes.Prelude as P -> -> threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () -> threeGroups p0 = loop 3 p0 -> where -> loop 0 _ = return () -> loop n p = do -> (as, p') <- lift $ runStateT (zoom group drawAll) p -> each as -> loop (n - 1) p' - - The first problem is that this approach does not output any elements from - each group until after parsing the entire group: - ->>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn -1 -1 -2 -1 -1 -2 -2 -3 -2 -2 -2 -4 -3 ->>> - - Worse, this program will crash without outputting a single value if fed an - infinitely long group of identical elements: - ->>> runEffect $ threeGroups (each (repeat 1)) >-> P.print - - - A better approach is to just stream directly from the first three groups - instead of storing the groups in intermediate lists: - -> import Lens.Family ((^.)) -> import Pipes -> import Pipes.Parse -> import qualified Pipes.Prelude as P -> -> threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () -> threeGroups p0 = loop 3 p0 -> where -> loop 0 _ = return () -> loop n p = do -> p' <- p ^. group -> loop (n - 1) p' - - This will run in constant memory and stream values immediately: - ->>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn -1 -1 -1 -1 -2 -2 -2 -2 -2 -2 -3 -3 -4 - - However, this code is not very modular: we have to integrate our group - creation logic with our group consumption logic. This conflicts with the - @pipes@ philosophy of decoupling streaming programs into modular components. - - An more modular approach would be to split our logic into three steps: - - * Split our 'Producer' into groups - - * Take the first three groups - - * Join these three groups back into a 'Producer' - - But how do we split our 'Producer' into groups without loading an entire - group into memory? We want to avoid solutions like the following code: - -> import Control.Monad (when, liftM2) -> import Lens.Family.State.Strict (zoom) -> import Pipes.Parse -> -> split :: (Monad m, Eq a) => Producer a m () -> Producer [a] m () -> split p = do -> ((as, eof), p') <- lift (runStateT parser p) -> yield as -> when (not eof) (split p') -> where -> parser = liftM2 (,) (zoom group drawAll) isEndOfInput - - ... because then we're back where we started, loading entire groups into - memory. --} - -{- $freeT - Fortunately, you can group elements while still streaming individual - elements at a time. The 'FreeT' type from the @free@ package solves this - problem by allowing us to build \"linked lists\" of 'Producer's. This lets - you work with streams in a list-like manner. - - The key idea is that: - -> -- '~' means "is analogous to" -> -> -- If a Producer is like a list -> Producer a m () ~ [a] -> -> -- ... then a 'FreeT'-delimited 'Producer' is like a list of lists -> FreeT (Producer a m) m () ~ [[a]] - - Think of @(FreeT (Producer a m) m ())@ as a \"list of 'Producer's\". - 'FreeT' nests each subsequent 'Producer' within the return value of the - previous 'Producer' so that you cannot access the next 'Producer' until you - completely drain the current 'Producer'. However, you rarely need to work - with 'FreeT' directly. Instead, you can structure most things using - \"splitters\", \"transformations\" and \"joiners\": - -> -- A "splitter" -> Producer a m () -> FreeT (Producer a m) m () ~ [a] -> [[a]] -> -> -- A "transformation" -> FreeT (Producer a m) m () -> FreeT (Producer a m) m () ~ [[a]] -> [[a]] -> -> -- A "joiner" -> FreeT (Producer a m) m () -> Producer a m () ~ [[a]] -> [a] - - An example splitter is @(view groups)@, which splits a 'Producer' into - 'FreeT'-delimited 'Producer's, one for each group of consecutive equal - elements: - -> view groups :: (Eq a, Monad m) => Producer a m x -> FreeT (Producer a m) m x - - An example transformation is @(takes 3)@, which takes the first three - 'Producer's from a 'FreeT' and drops the rest: - -> takes 3 :: Monad m => FreeT (Producer a m) m () -> FreeT (Producer a m) m () - - An example joiner is @concats@, which collapses a 'FreeT' of 'Producer's - back down into a single 'Producer': - -> concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x - - If you compose these three functions together, you will create a function - that transforms a 'Producer' to keep only the first three groups of - consecutive equal elements: - -> import Lens.Family -> import Pipes -> import Pipes.Group -> import qualified Pipes.Prelude as P -> -> threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () -> threeGroups = concats . takes 3 . view groups - - Both splitting and joining preserve the streaming nature of 'Producer's and - do not collect or buffer any values. The transformed 'Producer' still - outputs values immediately and does not wait for groups to complete before - producing results. - ->>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn -1 -1 -1 -1 -2 -2 -2 -2 -2 -2 -3 -3 -4 ->>> - - Also, lenses simplify things even further. The reason that 'groups' is a - lens is because it actually combines both a splitter and joiner into a - single package. We can then use 'over' to handle both the splitting and - joining for us: - ->>> runEffect $ over groups (takes 3) P.stdinLn >-> P.stdoutLn - - - This behaves the same because 'over' takes care of calling the splitter - before applying the transformation, then calling the inverse joiner - afterward. - - Another useful lens is 'individually', which lets you apply transformations - to each 'Producer' layer of a 'FreeT'. For example, if we wanted to - add an extra @"!"@ line to the end of every group, we would write: - ->>> import Control.Applicative ((<*)) ->>> runEffect $ over (groups . individually) (<* yield "!") P.stdinLn >-> P.stdoutLn -1 -1 -1 -1 -2 -! -2 -2 -2 -2 -2 -3 -! -3 -4 -! ->>> - - Note that 'individually' is only compatible with the @lens@ package. You - can alternatively use 'maps' if you are using @lens-family-core@: - ->>> runEffect $ over groups (maps (<* yield "!")) P.stdinLn >-> P.stdoutLn - - --} - -{- $advanced - You don't necessarily have to restrict yourself to predefined 'FreeT' - functions. You can also manually build or recurse over 'FreeT's of - 'Producer's. - - For example, here is how 'concats' is implemented, which collapses all the - 'Producer's within a 'FreeT' into a single 'Producer': - -> concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x -> concats = go -> where -> go f = do -> x <- lift (runFreeT f) -- Match against the "head" of the "list" -> case x of -> Pure r -> return r -- The "list" is empty -> Free p -> do -- The "list" is non-empty -> f' <- p -- The return value of the 'Producer' is -> go f' -- the "tail" of the "list" - - Many patterns for 'FreeT's have equivalent analogs for lists. 'runFreeT' - behaves like pattern matching on the list, except that you have to bind the - result. 'Pure' is analogous to @[]@ and 'Free' is analogous to @(:)@. - - When you receive a 'Free' constructor that means you have a 'Producer' whose - return value is the rest of the list (i.e. another 'FreeT'). You cannot - access the rest of the list without running the 'Producer' to completion to - retrieve this return value. The above example just runs the entire - 'Producer', binds the remainder of the list to @f'@ and then recurses on - that value. - - You can also build 'FreeT's in a manner similar to lists. For example, the - 'chunksOf' lens uses the following splitter function internally: - -> _chunksOf :: Monad m => Producer a m x -> FreeT (Producer a m) m x -> _chunksOf p = FreeT $ do -> x <- next p -- Pattern match on the 'Producer' -> return $ case x of -> Left r -> Pure r -- Build an empty "list" -> Right (a, p') -> Free $ do -- Build a non-empty "list" -> p'' <- (yield a >> p')^.splitAt n0 -- Emit the "head" -> return (_chunksOf p'') -- Return the "tail" - - 'Pure' signifies an empty 'FreeT' (one with no 'Producer' layers), just like - @[]@ signifies an empty list (one with no elements). We return 'Pure' - whenever we cannot emit any more 'Producer's. - - 'Free' indicates that we wish to emit a 'Producer' followed by another - \"list\". The 'Producer' we run directly within the body of the 'Free'. - However, we store the remainder of the \"list\" within the return value of - the 'Producer'. This is where @_chunksOf@ recurses to build the rest of the - \"list\". - - To gain a better understanding for how 'FreeT' works, consult the definition - of the type, which you can find in "Control.Monad.Trans.Free": - -> newtype FreeT f m a = FreeT { runFreeT :: m (FreeF f a (FreeT f m a)) } -> -> data FreeF f a b = Pure a | Free (f b) - - ... and just replace all occurences of @f@ with @(Producer e m)@: - -> -- This is pseudocode -> -> newtype FreeT' m a = FreeT { runFreeT :: m (FreeF' a (FreeT' m a)) } -> -> data FreeF' a b = Pure a | Free (Producer e m b) - - ... which you can further think of as: - -> -- More pseudocode -> -> newtype FreeT' m a = -> FreeT { runFreeT :: m (Pure a | Producer e m (FreeT' m a)) } - - In other words, 'runFreeT' unwraps a 'FreeT' to produce an action in the - base monad which either finishes with a value of type @a@ or continues with - a 'Producer' which returns a new 'FreeT'. Vice versa, if you want to build - a 'FreeT', you must create an action in the base monad which returns either - a 'Pure' or a 'Producer' wrapping another 'FreeT'. --} - -{- $conclusion - This library is very small since it only contains element-agnostic grouping - utilities. Downstream libraries that provide richer grouping utilities - include @pipes-bytestring@ and @pipes-text@. - - To learn more about @pipes-group@, ask questions, or follow development, you - can subscribe to the @haskell-pipes@ mailing list at: - - - - ... or you can mail the list directly at: - - --} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} + +{-| @pipes-group@ builds upon @pipes@ to establish idioms for grouping streams + into sub-streams without collecting elements into memory. This tutorial + assumes familiarity with @pipes@ and @pipes-parse@. +-} + +module Pipes.Group.Tutorial ( + -- * Motivation + -- $motivation + + -- * FreeT + -- $freeT + + -- * How FreeT Works + -- $advanced + + -- * Conclusion + -- $conclusion + ) where + +import Pipes +import Pipes.Group + +{- $motivation + Dividing a stream into sub-streams is non-trivial. To illustrate the + problem, consider the following task: limit a stream to the first three + groups of elements (a group means consecutive equal elements). + + The wrong way to do it is to read each group into memory like this: + +> import Lens.Family.State.Strict (zoom) +> import Pipes +> import Pipes.Parse +> import qualified Pipes.Prelude as P +> +> threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () +> threeGroups p0 = loop 3 p0 +> where +> loop 0 _ = return () +> loop n p = do +> (as, p') <- lift $ runStateT (zoom group drawAll) p +> each as +> loop (n - 1) p' + + The first problem is that this approach does not output any elements from + each group until after parsing the entire group: + +>>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn +1 +1 +2 +1 +1 +2 +2 +3 +2 +2 +2 +4 +3 +>>> + + Worse, this program will crash without outputting a single value if fed an + infinitely long group of identical elements: + +>>> runEffect $ threeGroups (each (repeat 1)) >-> P.print + + + A better approach is to just stream directly from the first three groups + instead of storing the groups in intermediate lists: + +> import Lens.Family ((^.)) +> import Pipes +> import Pipes.Parse +> import qualified Pipes.Prelude as P +> +> threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () +> threeGroups p0 = loop 3 p0 +> where +> loop 0 _ = return () +> loop n p = do +> p' <- p ^. group +> loop (n - 1) p' + + This will run in constant memory and stream values immediately: + +>>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn +1 +1 +1 +1 +2 +2 +2 +2 +2 +2 +3 +3 +4 + + However, this code is not very modular: we have to integrate our group + creation logic with our group consumption logic. This conflicts with the + @pipes@ philosophy of decoupling streaming programs into modular components. + + An more modular approach would be to split our logic into three steps: + + * Split our 'Producer' into groups + + * Take the first three groups + + * Join these three groups back into a 'Producer' + + But how do we split our 'Producer' into groups without loading an entire + group into memory? We want to avoid solutions like the following code: + +> import Control.Monad (when, liftM2) +> import Lens.Family.State.Strict (zoom) +> import Pipes.Parse +> +> split :: (Monad m, Eq a) => Producer a m () -> Producer [a] m () +> split p = do +> ((as, eof), p') <- lift (runStateT parser p) +> yield as +> when (not eof) (split p') +> where +> parser = liftM2 (,) (zoom group drawAll) isEndOfInput + + ... because then we're back where we started, loading entire groups into + memory. +-} + +{- $freeT + Fortunately, you can group elements while still streaming individual + elements at a time. The 'FreeT' type from the @free@ package solves this + problem by allowing us to build \"linked lists\" of 'Producer's. This lets + you work with streams in a list-like manner. + + The key idea is that: + +> -- '~' means "is analogous to" +> +> -- If a Producer is like a list +> Producer a m () ~ [a] +> +> -- ... then a 'FreeT'-delimited 'Producer' is like a list of lists +> FreeT (Producer a m) m () ~ [[a]] + + Think of @(FreeT (Producer a m) m ())@ as a \"list of 'Producer's\". + 'FreeT' nests each subsequent 'Producer' within the return value of the + previous 'Producer' so that you cannot access the next 'Producer' until you + completely drain the current 'Producer'. However, you rarely need to work + with 'FreeT' directly. Instead, you can structure most things using + \"splitters\", \"transformations\" and \"joiners\": + +> -- A "splitter" +> Producer a m () -> FreeT (Producer a m) m () ~ [a] -> [[a]] +> +> -- A "transformation" +> FreeT (Producer a m) m () -> FreeT (Producer a m) m () ~ [[a]] -> [[a]] +> +> -- A "joiner" +> FreeT (Producer a m) m () -> Producer a m () ~ [[a]] -> [a] + + An example splitter is @(view groups)@, which splits a 'Producer' into + 'FreeT'-delimited 'Producer's, one for each group of consecutive equal + elements: + +> view groups :: (Eq a, Monad m) => Producer a m x -> FreeT (Producer a m) m x + + An example transformation is @(takes 3)@, which takes the first three + 'Producer's from a 'FreeT' and drops the rest: + +> takes 3 :: Monad m => FreeT (Producer a m) m () -> FreeT (Producer a m) m () + + An example joiner is @concats@, which collapses a 'FreeT' of 'Producer's + back down into a single 'Producer': + +> concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x + + If you compose these three functions together, you will create a function + that transforms a 'Producer' to keep only the first three groups of + consecutive equal elements: + +> import Lens.Family +> import Pipes +> import Pipes.Group +> import qualified Pipes.Prelude as P +> +> threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () +> threeGroups = concats . takes 3 . view groups + + Both splitting and joining preserve the streaming nature of 'Producer's and + do not collect or buffer any values. The transformed 'Producer' still + outputs values immediately and does not wait for groups to complete before + producing results. + +>>> runEffect $ threeGroups P.stdinLn >-> P.stdoutLn +1 +1 +1 +1 +2 +2 +2 +2 +2 +2 +3 +3 +4 +>>> + + Also, lenses simplify things even further. The reason that 'groups' is a + lens is because it actually combines both a splitter and joiner into a + single package. We can then use 'over' to handle both the splitting and + joining for us: + +>>> runEffect $ over groups (takes 3) P.stdinLn >-> P.stdoutLn + + + This behaves the same because 'over' takes care of calling the splitter + before applying the transformation, then calling the inverse joiner + afterward. + + Another useful lens is 'individually', which lets you apply transformations + to each 'Producer' layer of a 'FreeT'. For example, if we wanted to + add an extra @"!"@ line to the end of every group, we would write: + +>>> import Control.Applicative ((<*)) +>>> runEffect $ over (groups . individually) (<* yield "!") P.stdinLn >-> P.stdoutLn +1 +1 +1 +1 +2 +! +2 +2 +2 +2 +2 +3 +! +3 +4 +! +>>> + + Note that 'individually' is only compatible with the @lens@ package. You + can alternatively use 'maps' if you are using @lens-family-core@: + +>>> runEffect $ over groups (maps (<* yield "!")) P.stdinLn >-> P.stdoutLn + + +-} + +{- $advanced + You don't necessarily have to restrict yourself to predefined 'FreeT' + functions. You can also manually build or recurse over 'FreeT's of + 'Producer's. + + For example, here is how 'concats' is implemented, which collapses all the + 'Producer's within a 'FreeT' into a single 'Producer': + +> concats :: Monad m => FreeT (Producer a m) m x -> Producer a m x +> concats = go +> where +> go f = do +> x <- lift (runFreeT f) -- Match against the "head" of the "list" +> case x of +> Pure r -> return r -- The "list" is empty +> Free p -> do -- The "list" is non-empty +> f' <- p -- The return value of the 'Producer' is +> go f' -- the "tail" of the "list" + + Many patterns for 'FreeT's have equivalent analogs for lists. 'runFreeT' + behaves like pattern matching on the list, except that you have to bind the + result. 'Pure' is analogous to @[]@ and 'Free' is analogous to @(:)@. + + When you receive a 'Free' constructor that means you have a 'Producer' whose + return value is the rest of the list (i.e. another 'FreeT'). You cannot + access the rest of the list without running the 'Producer' to completion to + retrieve this return value. The above example just runs the entire + 'Producer', binds the remainder of the list to @f'@ and then recurses on + that value. + + You can also build 'FreeT's in a manner similar to lists. For example, the + 'chunksOf' lens uses the following splitter function internally: + +> _chunksOf :: Monad m => Producer a m x -> FreeT (Producer a m) m x +> _chunksOf p = FreeT $ do +> x <- next p -- Pattern match on the 'Producer' +> return $ case x of +> Left r -> Pure r -- Build an empty "list" +> Right (a, p') -> Free $ do -- Build a non-empty "list" +> p'' <- (yield a >> p')^.splitAt n0 -- Emit the "head" +> return (_chunksOf p'') -- Return the "tail" + + 'Pure' signifies an empty 'FreeT' (one with no 'Producer' layers), just like + @[]@ signifies an empty list (one with no elements). We return 'Pure' + whenever we cannot emit any more 'Producer's. + + 'Free' indicates that we wish to emit a 'Producer' followed by another + \"list\". The 'Producer' we run directly within the body of the 'Free'. + However, we store the remainder of the \"list\" within the return value of + the 'Producer'. This is where @_chunksOf@ recurses to build the rest of the + \"list\". + + To gain a better understanding for how 'FreeT' works, consult the definition + of the type, which you can find in "Control.Monad.Trans.Free": + +> newtype FreeT f m a = FreeT { runFreeT :: m (FreeF f a (FreeT f m a)) } +> +> data FreeF f a b = Pure a | Free (f b) + + ... and just replace all occurences of @f@ with @(Producer e m)@: + +> -- This is pseudocode +> +> newtype FreeT' m a = FreeT { runFreeT :: m (FreeF' a (FreeT' m a)) } +> +> data FreeF' a b = Pure a | Free (Producer e m b) + + ... which you can further think of as: + +> -- More pseudocode +> +> newtype FreeT' m a = +> FreeT { runFreeT :: m (Pure a | Producer e m (FreeT' m a)) } + + In other words, 'runFreeT' unwraps a 'FreeT' to produce an action in the + base monad which either finishes with a value of type @a@ or continues with + a 'Producer' which returns a new 'FreeT'. Vice versa, if you want to build + a 'FreeT', you must create an action in the base monad which returns either + a 'Pure' or a 'Producer' wrapping another 'FreeT'. +-} + +{- $conclusion + This library is very small since it only contains element-agnostic grouping + utilities. Downstream libraries that provide richer grouping utilities + include @pipes-bytestring@ and @pipes-text@. + + To learn more about @pipes-group@, ask questions, or follow development, you + can subscribe to the @haskell-pipes@ mailing list at: + + + + ... or you can mail the list directly at: + + +-}