pipes-parse 2.0.1 → 2.0.2
raw patch · 4 files changed
+472/−470 lines, 4 filesdep ~freesetup-changed
Dependency ranges changed: free
Files
- LICENSE +24/−24
- Setup.hs +2/−2
- pipes-parse.cabal +37/−37
- src/Pipes/Parse.hs +409/−407
LICENSE view
@@ -1,24 +1,24 @@-Copyright (c) 2013 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) 2013 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-parse.cabal view
@@ -1,37 +1,37 @@-Name: pipes-parse-Version: 2.0.1-Cabal-Version: >=1.8.0.2-Build-Type: Simple-License: BSD3-License-File: LICENSE-Copyright: 2013 Gabriel Gonzalez-Author: Gabriel Gonzalez-Maintainer: Gabriel439@gmail.com-Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Parse-Library/issues-Synopsis: Parsing infrastructure for the pipes ecosystem-Description: @pipes-parse@ builds upon the @pipes@ library to provide shared- parsing idioms and utilities:- .- * /Perfect Streaming/: Program in a list-like style in constant memory- .- * /Leftovers/: Save unused input for later consumption- .- * /Connect and Resume/: Use @StateT@ to save unused input for later- .- * /Termination Safety/: Detect and recover from end of input- .- @Pipes.Parse@ contains the full documentation for this library.-Category: Control, Pipes, Parsing-Source-Repository head- Type: git- Location: https://github.com/Gabriel439/Haskell-Pipes-Parse-Library--Library- HS-Source-Dirs: src- Build-Depends:- base >= 4 && < 5 ,- free >= 3.1 && < 4.2,- pipes >= 4.0 && < 4.1,- transformers >= 0.2.0.0 && < 0.4- Exposed-Modules: Pipes.Parse- GHC-Options: -O2 -Wall+Name: pipes-parse +Version: 2.0.2 +Cabal-Version: >=1.8.0.2 +Build-Type: Simple +License: BSD3 +License-File: LICENSE +Copyright: 2013 Gabriel Gonzalez +Author: Gabriel Gonzalez +Maintainer: Gabriel439@gmail.com +Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Parse-Library/issues +Synopsis: Parsing infrastructure for the pipes ecosystem +Description: @pipes-parse@ builds upon the @pipes@ library to provide shared + parsing idioms and utilities: + . + * /Perfect Streaming/: Program in a list-like style in constant memory + . + * /Leftovers/: Save unused input for later consumption + . + * /Connect and Resume/: Use @StateT@ to save unused input for later + . + * /Termination Safety/: Detect and recover from end of input + . + @Pipes.Parse@ contains the full documentation for this library. +Category: Control, Pipes, Parsing +Source-Repository head + Type: git + Location: https://github.com/Gabriel439/Haskell-Pipes-Parse-Library + +Library + HS-Source-Dirs: src + Build-Depends: + base >= 4 && < 5 , + free >= 3.1 && < 5 , + pipes >= 4.0 && < 4.1, + transformers >= 0.2.0.0 && < 0.4 + Exposed-Modules: Pipes.Parse + GHC-Options: -O2 -Wall
src/Pipes/Parse.hs view
@@ -1,407 +1,409 @@-{-|- Element-agnostic parsing utilities for @pipes@-- @pipes-parse@ provides two ways to parse and transform streams in constant- space:-- * The \"list-like\" approach, using the split \/ transform \/ join paradigm-- * The monadic approach, using parser combinators-- The top half of this module provides the list-like approach, which is easier- to use, but less powerful. The key idea is that:--> -- '~' means "is analogous to"-> Producer a m () ~ [a]->-> FreeT (Producer a m) m () ~ [[a]]-- '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 structure everything 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]-- For example, if you wanted to group standard input by equal lines and take- the first three groups, you would write:--> import Pipes-> import qualified Pipes.Parse as Parse-> import qualified Pipes.Prelude as Prelude->-> threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m ()-> threeGroups = Parse.concat . Parse.takeFree 3 . Parse.groupBy (==)-> -- ^ Joiner ^ Transformation ^ Splitter-- This then limits standard input to the first three consecutive groups of- equal lines:-->>> runEffect $ threeGroups Prelude.stdinLn >-> Prelude.stdoutLn-Group1<Enter>-Group1-Group1<Enter>-Group1-Group2<Enter>-Group2-Group3<Enter>-Group3-Group3<Enter>-Group3-Group4<Enter>->>> -- Done, because we began entering our fourth group-- The advantage of this style or programming is that you never bring more than- a single element into memory. This works because `FreeT` sub-divides the- `Producer` without concatenating elements together, preserving the laziness- of the underlying 'Producer'.-- The bottom half of this module lets you implement your own list-like- transformations using monadic parsers.-- For example, if you wanted to repeatedly sum every 3 elements and yield the- result, you would write:--> import Control.Monad (unless)-> import Pipes-> import qualified Pipes.Prelude as P-> import Pipes.Parse->-> sum3 :: (Monad m, Num a) => Producer a (StateT (Producer a m ()) m) ()-> sum3 = do-> eof <- lift isEndOfInput-> unless eof $ do-> n <- lift $ P.sum (input >-> P.take 3)-> yield n-> sum3-- When you are done building the parser, you convert your parser to a- list-like function using `evalStateP`:--> import Pipes.Lift (evalStateP)->-> -- sum3' ~ (Num a) => [a] -> [a]->-> sum3' :: (Monad m, Num a) => Producer a m () -> Producer a m ()-> sum3' p = evalStateP p sum3-- ... then apply it to the `Producer` you want to transform:-->>> runEffect $ sum3' (P.readLn >-> P.takeWhile (/= 0)) >-> P.print-1<Enter>-4<Enter>-5<Enter>-10-2<Enter>-0<Enter>-2->>>---}--{-# LANGUAGE RankNTypes #-}--module Pipes.Parse (- -- * Splitters- groupBy,- chunksOf,- splitOn,-- -- * Transformations- takeFree,- dropFree,-- -- * Joiners- concat,- intercalate,-- -- * Low-level Parsers- -- $lowlevel- draw,- unDraw,- peek,- isEndOfInput,-- -- * High-level Parsers- -- $highlevel- input,-- -- * Utilities- takeWhile,-- -- * Re-exports- -- $reexports- module Control.Monad.Trans.Free,- module Control.Monad.Trans.State.Strict- ) where--import Control.Applicative ((<$>), (<$))-import qualified Control.Monad.Trans.Free as F-import Control.Monad.Trans.Free (FreeF(Pure, Free), FreeT(FreeT, runFreeT))-import qualified Control.Monad.Trans.State.Strict as S-import Control.Monad.Trans.State.Strict (- StateT(StateT, runStateT), evalStateT, execStateT )-import Pipes-import Pipes.Lift (runStateP)-import qualified Pipes.Prelude as P-import Prelude hiding (concat, takeWhile)--{-| Split a 'Producer' into a `FreeT`-delimited stream of 'Producer's grouped by- the supplied equality predicate--}-groupBy- :: (Monad m)- => (a -> a -> Bool) -> Producer a m r -> FreeT (Producer a m) m r-groupBy equal = loop- where- loop p = do- (x, p') <- F.liftF $ runStateP p $ do- x <- lift draw- case x of- Left r -> return (Just r)- Right a -> do- yield a- (Just <$> input) >-> (Nothing <$ takeWhile (equal a))- case x of- Just r -> return r- Nothing -> loop p'-{-# INLINABLE groupBy #-}--{-| Split a 'Producer' into a `FreeT`-delimited stream of 'Producer's of the- given chunk size--}-chunksOf :: (Monad m) => Int -> Producer a m r -> FreeT (Producer a m) m r-chunksOf n = loop- where- loop p = do- (x, p') <- F.liftF $ runStateP p $- (Just <$> input) >-> (Nothing <$ P.take n)- case x of- Just r -> return r- Nothing -> loop p'-{-# INLINABLE chunksOf #-}--{-| Split a 'Producer' into a `FreeT`-delimited stream of 'Producer's separated- by elements that satisfy the given predicate--}-splitOn- :: (Monad m) => (a -> Bool) -> Producer a m r -> FreeT (Producer a m) m r-splitOn predicate = loop- where- loop p = do- (x, p') <- F.liftF $ runStateP p $- (Just <$> input) >-> (Nothing <$ takeWhile (not . predicate))- case x of- Just r -> return r- Nothing -> loop p'-{-# INLINABLE splitOn #-}---- | Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer'-concat :: (Monad m) => FreeT (Producer a m) m r -> Producer a m r-concat = loop- where- loop f = do- x <- lift (runFreeT f)- case x of- Pure r -> return r- Free p -> do- f' <- p- loop f'-{-# INLINABLE concat #-}--{-| Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' by- intercalating a 'Producer' in between them--}-intercalate- :: (Monad m)- => Producer a m () -> FreeT (Producer a m) m r -> Producer a m r-intercalate 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 intercalate #-}---- | @(takeFree n)@ only keeps the first @n@ functor layers of a 'FreeT'-takeFree :: (Functor f, Monad m) => Int -> FreeT f m () -> FreeT f m ()-takeFree = 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 takeFree #-}--{-| @(dropFree n)@ peels off the first @n@ layers of a 'FreeT'-- Use carefully: the peeling off is not free. This runs the first @n@- layers, just discarding everything they produce.--}-dropFree- :: (Monad m) => Int -> FreeT (Producer a m) m r -> FreeT (Producer a m) m r-dropFree = go- where- go n ft- | n <= 0 = ft- | otherwise = FreeT $ do- ff <- runFreeT ft- case ff of- Pure _ -> return ff- Free f -> do- ft' <- runEffect $ for f discard- runFreeT $ go (n-1) ft'-{-# INLINABLE dropFree #-}--{- $lowlevel- @pipes-parse@ handles end-of-input and pushback by storing a 'Producer' in- a 'StateT' layer.--}--{-| Draw one element from the underlying 'Producer', returning 'Left' if the- 'Producer' is empty--}-draw :: (Monad m) => StateT (Producer a m r) m (Either r a)-draw = do- p <- S.get- x <- lift (next p)- case x of- Left r -> do- S.put (return r)- return (Left r)- Right (a, p') -> do- S.put p'- return (Right a)-{-# INLINABLE draw #-}---- | Push back an element onto the underlying 'Producer'-unDraw :: (Monad m) => a -> StateT (Producer a m r) m ()-unDraw a = S.modify (yield a >>)-{-# INLINABLE unDraw #-}--{-| 'peek' checks the first element of the stream, but uses 'unDraw' to push the- element back so that it is available for the next 'draw' command.--> peek = do-> x <- draw-> case x of-> Left _ -> return ()-> Right a -> unDraw a-> return x--}-peek :: (Monad m) => StateT (Producer a m r) m (Either r a)-peek = do- x <- draw- case x of- Left _ -> return ()- Right a -> unDraw a- return x-{-# INLINABLE peek #-}--{-| Check if the underlying 'Producer' is empty--> isEndOfInput = liftM isLeft peek--}-isEndOfInput :: (Monad m) => StateT (Producer a m r) m Bool-isEndOfInput = do- x <- peek- return (case x of- Left _ -> True- Right _ -> False )-{-# INLINABLE isEndOfInput #-}--{- $highlevel- 'input' provides a 'Producer' that streams from the underlying 'Producer'.-- Streaming from 'input' differs from streaming directly from the underlying- 'Producer' because any unused input is saved for later, as the following- example illustrates:--> import Control.Monad.Trans.State.Strict-> import Pipes-> import Pipes.Parse-> import qualified Pipes.Prelude as P->-> parser :: (Show a) => StateT (Producer a IO ()) IO ()-> parser = do-> runEffect $ input >-> P.take 2 >-> P.show >-> P.stdoutLn->-> liftIO $ putStrLn "Intermission"->-> runEffect $ input >-> P.take 2 >-> P.show >-> P.stdoutLn-- The second pipeline resumes where the first pipeline left off:-->>> evalStateT parser (each [1..])-1-2-Intermission-3-4-- You can see more examples of how to use these parsing utilities by studying- the source code for the above splitters.--}--{-| Stream from the underlying 'Producer'-- 'input' terminates if the 'Producer' is empty, returning the final return- value of the 'Producer'.--}-input :: (Monad m) => Producer' a (StateT (Producer a m r) m) r-input = loop- where- loop = do- x <- lift draw- case x of- Left r -> return r- Right a -> do- yield a- loop-{-# INLINABLE input #-}--{-| A variation on 'Pipes.Prelude.takeWhile' from @Pipes.Prelude@ that 'unDraw's- the first element that does not match--}-takeWhile- :: (Monad m) => (a -> Bool) -> Pipe a a (StateT (Producer a m r) m) ()-takeWhile predicate = loop- where- loop = do- a <- await- if (predicate a)- then do- yield a- loop- else lift (unDraw a)-{-# INLINABLE takeWhile #-}--{- $reexports- @Control.Monad.Trans.Free@ re-exports 'FreeF', 'FreeT', and 'runFreeT'.-- @Control.Monad.Trans.State.Strict@ re-exports 'StateT', 'runStateT',- 'evalStateT', and 'execStateT'.--}+{-| + Element-agnostic parsing utilities for @pipes@ + + @pipes-parse@ provides two ways to parse and transform streams in constant + space: + + * The \"list-like\" approach, using the split \/ transform \/ join paradigm + + * The monadic approach, using parser combinators + + The top half of this module provides the list-like approach, which is easier + to use, but less powerful. The key idea is that: + +> -- '~' means "is analogous to" +> Producer a m () ~ [a] +> +> FreeT (Producer a m) m () ~ [[a]] + + '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 structure everything 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] + + For example, if you wanted to group standard input by equal lines and take + the first three groups, you would write: + +> import Pipes +> import qualified Pipes.Parse as Parse +> import qualified Pipes.Prelude as Prelude +> +> threeGroups :: (Monad m, Eq a) => Producer a m () -> Producer a m () +> threeGroups = Parse.concat . Parse.takeFree 3 . Parse.groupBy (==) +> -- ^ Joiner ^ Transformation ^ Splitter + + This then limits standard input to the first three consecutive groups of + equal lines: + +>>> runEffect $ threeGroups Prelude.stdinLn >-> Prelude.stdoutLn +Group1<Enter> +Group1 +Group1<Enter> +Group1 +Group2<Enter> +Group2 +Group3<Enter> +Group3 +Group3<Enter> +Group3 +Group4<Enter> +>>> -- Done, because we began entering our fourth group + + The advantage of this style or programming is that you never bring more than + a single element into memory. This works because `FreeT` sub-divides the + `Producer` without concatenating elements together, preserving the laziness + of the underlying 'Producer'. + + The bottom half of this module lets you implement your own list-like + transformations using monadic parsers. + + For example, if you wanted to repeatedly sum every 3 elements and yield the + result, you would write: + +> import Control.Monad (unless) +> import Pipes +> import qualified Pipes.Prelude as P +> import Pipes.Parse +> +> sum3 :: (Monad m, Num a) => Producer a (StateT (Producer a m ()) m) () +> sum3 = do +> eof <- lift isEndOfInput +> unless eof $ do +> n <- lift $ P.sum (input >-> P.take 3) +> yield n +> sum3 + + When you are done building the parser, you convert your parser to a + list-like function using `evalStateP`: + +> import Pipes.Lift (evalStateP) +> +> -- sum3' ~ (Num a) => [a] -> [a] +> +> sum3' :: (Monad m, Num a) => Producer a m () -> Producer a m () +> sum3' p = evalStateP p sum3 + + ... then apply it to the `Producer` you want to transform: + +>>> runEffect $ sum3' (P.readLn >-> P.takeWhile (/= 0)) >-> P.print +1<Enter> +4<Enter> +5<Enter> +10 +2<Enter> +0<Enter> +2 +>>> + +-} + +{-# LANGUAGE RankNTypes #-} + +module Pipes.Parse ( + -- * Splitters + groupBy, + chunksOf, + splitOn, + + -- * Transformations + takeFree, + dropFree, + + -- * Joiners + concat, + intercalate, + + -- * Low-level Parsers + -- $lowlevel + draw, + unDraw, + peek, + isEndOfInput, + + -- * High-level Parsers + -- $highlevel + input, + + -- * Utilities + takeWhile, + + -- * Re-exports + -- $reexports + module Control.Monad.Trans.Free, + module Control.Monad.Trans.State.Strict + ) where + +import Control.Applicative ((<$>), (<$)) +import Control.Monad (void) +import qualified Control.Monad.Trans.Free as F +import Control.Monad.Trans.Free (FreeF(Pure, Free), FreeT(FreeT, runFreeT)) +import qualified Control.Monad.Trans.State.Strict as S +import Control.Monad.Trans.State.Strict ( + StateT(StateT, runStateT), evalStateT, execStateT ) +import Pipes +import Pipes.Lift (runStateP) +import qualified Pipes.Prelude as P +import Prelude hiding (concat, takeWhile) + +{-| Split a 'Producer' into a `FreeT`-delimited stream of 'Producer's grouped by + the supplied equality predicate +-} +groupBy + :: (Monad m) + => (a -> a -> Bool) -> Producer a m r -> FreeT (Producer a m) m r +groupBy equal = loop + where + loop p = do + (x, p') <- F.liftF $ runStateP p $ do + x <- lift draw + case x of + Left r -> return (Just r) + Right a -> do + yield a + (Just <$> input) >-> (Nothing <$ takeWhile (equal a)) + case x of + Just r -> return r + Nothing -> loop p' +{-# INLINABLE groupBy #-} + +{-| Split a 'Producer' into a `FreeT`-delimited stream of 'Producer's of the + given chunk size +-} +chunksOf :: (Monad m) => Int -> Producer a m r -> FreeT (Producer a m) m r +chunksOf n = loop + where + loop p = do + (x, p') <- F.liftF $ runStateP p $ + (Just <$> input) >-> (Nothing <$ P.take n) + case x of + Just r -> return r + Nothing -> loop p' +{-# INLINABLE chunksOf #-} + +{-| Split a 'Producer' into a `FreeT`-delimited stream of 'Producer's separated + by elements that satisfy the given predicate +-} +splitOn + :: (Monad m) => (a -> Bool) -> Producer a m r -> FreeT (Producer a m) m r +splitOn predicate = go + where + go p = do + (x, p') <- F.liftF $ runStateP p $ do + void input >-> takeWhile (not . predicate) + lift draw + case x of + Left r -> return r + Right _ -> go p' +{-# INLINABLE splitOn #-} + +-- | Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' +concat :: (Monad m) => FreeT (Producer a m) m r -> Producer a m r +concat = loop + where + loop f = do + x <- lift (runFreeT f) + case x of + Pure r -> return r + Free p -> do + f' <- p + loop f' +{-# INLINABLE concat #-} + +{-| Join a 'FreeT'-delimited stream of 'Producer's into a single 'Producer' by + intercalating a 'Producer' in between them +-} +intercalate + :: (Monad m) + => Producer a m () -> FreeT (Producer a m) m r -> Producer a m r +intercalate 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 intercalate #-} + +-- | @(takeFree n)@ only keeps the first @n@ functor layers of a 'FreeT' +takeFree :: (Functor f, Monad m) => Int -> FreeT f m () -> FreeT f m () +takeFree = 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 takeFree #-} + +{-| @(dropFree n)@ peels off the first @n@ layers of a 'FreeT' + + Use carefully: the peeling off is not free. This runs the first @n@ + layers, just discarding everything they produce. +-} +dropFree + :: (Monad m) => Int -> FreeT (Producer a m) m r -> FreeT (Producer a m) m r +dropFree = go + where + go n ft + | n <= 0 = ft + | otherwise = FreeT $ do + ff <- runFreeT ft + case ff of + Pure _ -> return ff + Free f -> do + ft' <- runEffect $ for f discard + runFreeT $ go (n-1) ft' +{-# INLINABLE dropFree #-} + +{- $lowlevel + @pipes-parse@ handles end-of-input and pushback by storing a 'Producer' in + a 'StateT' layer. +-} + +{-| Draw one element from the underlying 'Producer', returning 'Left' if the + 'Producer' is empty +-} +draw :: (Monad m) => StateT (Producer a m r) m (Either r a) +draw = do + p <- S.get + x <- lift (next p) + case x of + Left r -> do + S.put (return r) + return (Left r) + Right (a, p') -> do + S.put p' + return (Right a) +{-# INLINABLE draw #-} + +-- | Push back an element onto the underlying 'Producer' +unDraw :: (Monad m) => a -> StateT (Producer a m r) m () +unDraw a = S.modify (yield a >>) +{-# INLINABLE unDraw #-} + +{-| 'peek' checks the first element of the stream, but uses 'unDraw' to push the + element back so that it is available for the next 'draw' command. + +> peek = do +> x <- draw +> case x of +> Left _ -> return () +> Right a -> unDraw a +> return x +-} +peek :: (Monad m) => StateT (Producer a m r) m (Either r a) +peek = do + x <- draw + case x of + Left _ -> return () + Right a -> unDraw a + return x +{-# INLINABLE peek #-} + +{-| Check if the underlying 'Producer' is empty + +> isEndOfInput = liftM isLeft peek +-} +isEndOfInput :: (Monad m) => StateT (Producer a m r) m Bool +isEndOfInput = do + x <- peek + return (case x of + Left _ -> True + Right _ -> False ) +{-# INLINABLE isEndOfInput #-} + +{- $highlevel + 'input' provides a 'Producer' that streams from the underlying 'Producer'. + + Streaming from 'input' differs from streaming directly from the underlying + 'Producer' because any unused input is saved for later, as the following + example illustrates: + +> import Control.Monad.Trans.State.Strict +> import Pipes +> import Pipes.Parse +> import qualified Pipes.Prelude as P +> +> parser :: (Show a) => StateT (Producer a IO ()) IO () +> parser = do +> runEffect $ input >-> P.take 2 >-> P.show >-> P.stdoutLn +> +> liftIO $ putStrLn "Intermission" +> +> runEffect $ input >-> P.take 2 >-> P.show >-> P.stdoutLn + + The second pipeline resumes where the first pipeline left off: + +>>> evalStateT parser (each [1..]) +1 +2 +Intermission +3 +4 + + You can see more examples of how to use these parsing utilities by studying + the source code for the above splitters. +-} + +{-| Stream from the underlying 'Producer' + + 'input' terminates if the 'Producer' is empty, returning the final return + value of the 'Producer'. +-} +input :: (Monad m) => Producer' a (StateT (Producer a m r) m) r +input = loop + where + loop = do + x <- lift draw + case x of + Left r -> return r + Right a -> do + yield a + loop +{-# INLINABLE input #-} + +{-| A variation on 'Pipes.Prelude.takeWhile' from @Pipes.Prelude@ that 'unDraw's + the first element that does not match +-} +takeWhile + :: (Monad m) => (a -> Bool) -> Pipe a a (StateT (Producer a m r) m) () +takeWhile predicate = loop + where + loop = do + a <- await + if (predicate a) + then do + yield a + loop + else lift (unDraw a) +{-# INLINABLE takeWhile #-} + +{- $reexports + @Control.Monad.Trans.Free@ re-exports 'FreeF', 'FreeT', and 'runFreeT'. + + @Control.Monad.Trans.State.Strict@ re-exports 'StateT', 'runStateT', + 'evalStateT', and 'execStateT'. +-}