pipes-group 1.0.1 → 1.0.2
raw patch · 5 files changed
+771/−756 lines, 5 filessetup-changed
Files
- LICENSE +24/−24
- Setup.hs +2/−2
- pipes-group.cabal +38/−38
- src/Pipes/Group.hs +353/−338
- src/Pipes/Group/Tutorial.hs +354/−354
LICENSE view
@@ -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.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple-main = defaultMain+import Distribution.Simple +main = defaultMain
pipes-group.cabal view
@@ -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
src/Pipes/Group.hs view
@@ -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'. +-}
src/Pipes/Group/Tutorial.hs view
@@ -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<Enter>-1<Enter>-2<Enter>-1-1-2<Enter>-2<Enter>-3<Enter>-2-2-2-4<Enter>-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-<Consumes all memory and crashes>-- 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<Enter>-1-1<Enter>-1-2<Enter>-2-2<Enter>-2-2<Enter>-2-3<Enter>-3-4<Enter>-- 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<Enter>-1-1<Enter>-1-2<Enter>-2-2<Enter>-2-2<Enter>-2-3<Enter>-3-4<Enter>->>>-- 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-<Exact same behavior>-- 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<Enter>-1-1<Enter>-1-2<Enter>-!-2-2<Enter>-2-2<Enter>-2-3<Enter>-!-3-4<Enter>-!->>>-- 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-<Exact same behavior>---}--{- $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:-- <https://groups.google.com/forum/#!forum/haskell-pipes>-- ... or you can mail the list directly at:-- <mailto:haskell-pipes@googlegroups.com>--}+{-# 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<Enter> +1<Enter> +2<Enter> +1 +1 +2<Enter> +2<Enter> +3<Enter> +2 +2 +2 +4<Enter> +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 +<Consumes all memory and crashes> + + 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<Enter> +1 +1<Enter> +1 +2<Enter> +2 +2<Enter> +2 +2<Enter> +2 +3<Enter> +3 +4<Enter> + + 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<Enter> +1 +1<Enter> +1 +2<Enter> +2 +2<Enter> +2 +2<Enter> +2 +3<Enter> +3 +4<Enter> +>>> + + 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 +<Exact same behavior> + + 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<Enter> +1 +1<Enter> +1 +2<Enter> +! +2 +2<Enter> +2 +2<Enter> +2 +3<Enter> +! +3 +4<Enter> +! +>>> + + 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 +<Exact same behavior> + +-} + +{- $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: + + <https://groups.google.com/forum/#!forum/haskell-pipes> + + ... or you can mail the list directly at: + + <mailto:haskell-pipes@googlegroups.com> +-}