pipes-parse 1.0.0 → 2.0.0
raw patch · 4 files changed
+366/−791 lines, 4 filesdep +freedep +transformersdep ~pipes
Dependencies added: free, transformers
Dependency ranges changed: pipes
Files
- Control/Proxy/Parse.hs +0/−311
- Control/Proxy/Parse/Tutorial.hs +0/−463
- pipes-parse.cabal +16/−17
- src/Pipes/Parse.hs +350/−0
− Control/Proxy/Parse.hs
@@ -1,311 +0,0 @@--- | Parsing utilities for pipes--module Control.Proxy.Parse (- -- * Pushback and Leftovers- -- $pushback- draw,- unDraw,-- -- * Utilities- peek,- isEndOfInput,- drawAll,- skipAll,- passUpTo,- passWhile,-- -- * Adapters- -- $adapters- wrap,- unwrap,- fmapPull,- returnPull,- bindPull,-- -- * Lenses- -- $lenses- zoom,- _fst,- _snd,-- -- * Re-exports- -- $reexports- module Control.Proxy.Trans.State,- module Data.Monoid- ) where--import Control.Monad (forever)-import Control.Proxy ((>->), (\>\), (//>), (>\\), (?>=))-import qualified Control.Proxy as P-import Control.Proxy.Trans.State (- StateP(StateP, unStateP),- state,- stateT,- runStateP,- runStateK,- evalStateP,- evalStateK,- execStateP,- execStateK,- get,- put,- modify,- gets )-import Data.Monoid (Monoid(mempty, mappend))--{- $pushback- 'unDraw' stores all leftovers in a 'StateP' buffer and 'draw' retrieves- leftovers from this buffer before drawing new input from upstream.--}--{-| Like @request ()@, except try to use the leftovers buffer first-- A 'Nothing' return value indicates end of input.--}-draw :: (Monad m, P.Proxy p) => StateP [a] p () (Maybe a) y' y m (Maybe a)-draw = do- s <- get- case s of- [] -> P.request ()- a:as -> do- put as- return (Just a)-{-# INLINABLE draw #-}---- | Push an element back onto the leftovers buffer-unDraw :: (Monad m, P.Proxy p) => a -> StateP [a] p x' x y' y m ()-unDraw a = modify (a:)-{-# INLINABLE unDraw #-}---- | Peek at the next element without consuming it-peek :: (Monad m, P.Proxy p) => StateP [a] p () (Maybe a) y' y m (Maybe a)-peek = do- ma <- draw- case ma of- Nothing -> return ()- Just a -> unDraw a- return ma-{-# INLINABLE peek #-}---- | Check if at end of input stream.-isEndOfInput :: (Monad m, P.Proxy p) => StateP [a] p () (Maybe a) y' y m Bool-isEndOfInput = do- ma <- peek- case ma of- Nothing -> return True- Just _ -> return False-{-# INLINABLE isEndOfInput #-}--{-| Fold all input into a list-- Note: 'drawAll' is usually an anti-pattern.--}-drawAll :: (Monad m, P.Proxy p) => () -> StateP [a] p () (Maybe a) y' y m [a]-drawAll = \() -> go id- where- go diffAs = do- ma <- draw- case ma of- Nothing -> return (diffAs [])- Just a -> go (diffAs . (a:))-{-# INLINABLE drawAll #-}---- | Consume the input completely, discarding all values-skipAll :: (Monad m, P.Proxy p) => () -> StateP [a] p () (Maybe a) y' y m ()-skipAll = \() -> go- where- go = do- ma <- draw- case ma of- Nothing -> return ()- Just _ -> go-{-# INLINABLE skipAll #-}---- | Forward up to the specified number of elements downstream-passUpTo- :: (Monad m, P.Proxy p)- => Int -> () -> P.Pipe (StateP [a] p) (Maybe a) (Maybe a) m r-passUpTo n0 = \() -> go n0- where- go n0 =- if (n0 <= 0)- then forever $ P.respond Nothing- else do- ma <- draw- P.respond ma- case ma of- Nothing -> forever $ P.respond Nothing- Just _ -> go (n0 - 1)-{-# INLINABLE passUpTo #-}--{-| Forward downstream as many consecutive elements satisfying a predicate as- possible--}-passWhile- :: (Monad m, P.Proxy p)- => (a -> Bool) -> () -> P.Pipe (StateP [a] p) (Maybe a) (Maybe a) m r-passWhile pred = \() -> go- where- go = do- ma <- draw- case ma of- Nothing -> forever $ P.respond Nothing- Just a ->- if (pred a)- then do- P.respond ma- go- else do- unDraw a- forever $ P.respond Nothing-{-# INLINABLE passWhile #-}--{- $adapters- Use 'wrap' and 'unwrap' to convert between guarded and unguarded pipes.-- 'fmapPull', 'returnPull', and 'bindPull' promote compatibility with- existing utilities that are not 'Maybe'-aware.--}--{-| Guard a pipe from terminating by wrapping every output in 'Just' and ending- with a never-ending stream of 'Nothing's.--}-wrap :: (Monad m, P.Proxy p) => p a' a b' b m r -> p a' a b' (Maybe b) m s-wrap = \p -> P.runIdentityP $ do- P.IdentityP p //> \b -> P.respond (Just b)- forever $ P.respond Nothing-{-# INLINABLE wrap #-}--{-| Compose 'unwrap' downstream of a guarded pipe to unwrap all 'Just's and- terminate on the first 'Nothing'.--}-unwrap :: (Monad m, P.Proxy p) => x -> p x (Maybe a) x a m ()-unwrap = \x -> P.runIdentityP (go x)- where- go x = do- ma <- P.request x- case ma of- Nothing -> return ()- Just a -> do- x2 <- P.respond a- go x2-{-# INLINABLE unwrap #-}--{-| Lift a 'Maybe'-oblivious pipe to a 'Maybe'-aware pipe by auto-forwarding- all 'Nothing's.--> fmapPull f >-> fmapPull g = fmapPull (f >-> g)->-> fmapPull pull = pull--}-fmapPull- :: (Monad m, P.Proxy p)- => (x -> p x a x b m r)- -> (x -> p x (Maybe a) x (Maybe b) m r)-fmapPull f = bindPull (f >-> returnPull)-{-# INLINABLE fmapPull #-}---- | Wrap all values flowing downstream in 'Just'.-returnPull :: (Monad m, P.Proxy p) => x -> p x a x (Maybe a) m r-returnPull = P.mapD Just-{-# INLINABLE returnPull #-}--{-| Lift a 'Maybe'-generating pipe to a 'Maybe'-transforming pipe by- auto-forwarding all 'Nothing's--> -- Using: f >>> g = f >-> bindPull g->-> returnPull >>> f = f->-> f >>> returnPull = f->-> (f >>> g) >>> h = f >>> (g >>> h)--Or equivalently:--> returnPull >-> bindPull f = f->-> bindPull returnPull = pull->-> bindPull (f >-> bindPull g) = bindPull f >-> bindPull g--}-bindPull- :: (Monad m, P.Proxy p)- => (x -> p x a x (Maybe b) m r)- -> (x -> p x (Maybe a) x (Maybe b) m r)-bindPull f = P.runIdentityP . (up \>\ P.IdentityP . f)- where- up a' = do- ma <- P.request a'- case ma of- Nothing -> do- a'2 <- P.respond Nothing- up a'2- Just a -> return a-{-# INLINABLE bindPull #-}--{- $lenses- Use 'zoom', '_fst', and '_snd' to mix pipes that have different leftover- buffers or to isolate leftover buffers of different parsing stages.--}--{-| 'zoom' in on a sub-state using a @Lens'@.--> zoom :: Lens' s1 s2 -> StateP s2 p a' a b' b m r -> StateP s1 p a' a b' b m r--> zoom (f . g) = zoom f . zoom g->-> zoom id = id--}-zoom- :: (Monad m, P.Proxy p)- => ((s2 -> (s2, s2)) -> (s1 -> (s2, s1)))- -- ^ @Lens'@ s1 s2- -> StateP s2 p a' a b' b m r- -- ^ Local state- -> StateP s1 p a' a b' b m r- -- ^ Global state-zoom lens = \p -> StateP $ \s2_0 ->- let (s1_0, s2_0') = lens (\x -> (x, x)) s2_0- in (up >\\ P.thread_P (unStateP p s1_0) s2_0' //> dn) ?>= nx- where- up ((a', s1), s2) =- let (_, s2') = lens (\x -> (x, s1)) s2- in P.request (a', s2') ?>= \(a, s2'') ->- let (s1', s2''') = lens (\x -> (x, x)) s2''- in P.return_P ((a, s1'), s2''')- dn ((b, s1), s2) =- let (_, s2') = lens (\x -> (x, s1)) s2- in P.respond (b, s2') ?>= \(b', s2'') ->- let (s1', s2''') = lens (\x -> (x, x)) s2''- in P.return_P ((b', s1'), s2''')- nx ((r, s1), s2) =- let (_, s2') = lens (\x -> (x, s1)) s2- in P.return_P (r, s2')-{-# INLINABLE zoom #-}--{-| A @Lens'@ to the first element of a pair.-- Like @_1@, but more monomorphic--> _fst :: Lens' (a, b) a--}-_fst :: (Functor f) => (a -> f b) -> ((a, x) -> f (b, x))-_fst = \f (a, x) -> fmap (\b -> (b, x)) (f a)-{-# INLINABLE _fst #-}--{-| A @Lens'@ to the second element of a pair.-- Like @_2@, but more monomorphic--> _snd :: Lens' (a, b) b--}-_snd :: (Functor f) => (a -> f b) -> ((x, a) -> f (x, b))-_snd = \f (x, a) -> fmap (\b -> (x, b)) (f a)-{-# INLINABLE _snd #-}--{- $reexports- "Control.Proxy.Trans.State" re-exports all functions.-- "Data.Monoid" re-exports the 'Monoid' class.--}
− Control/Proxy/Parse/Tutorial.hs
@@ -1,463 +0,0 @@-{-| This module provides the tutorial for the @pipes-parse@ library-- This tutorial assumes that you have read the @pipes@ tutorial in- @Control.Proxy.Tutorial@.--}--module Control.Proxy.Parse.Tutorial (- -- * Introduction- -- $introduction-- -- * End of input- -- $eof-- -- * Compatibility- -- $compatibility-- -- * Pushback and leftovers- -- $leftovers-- -- * Diverse leftovers- -- $diverse-- -- * Isolating leftovers- -- $mix-- -- * Return value- -- $return-- -- * Resumable Parsing- -- $resume-- -- * Nesting- -- $nesting-- -- * Conclusion- -- $conclusion- ) where--import Control.Proxy-import Control.Proxy.Parse--{- $introduction- @pipes-parse@ provides utilities commonly required for parsing streams using- @pipes@:-- * End of input utilities and conventions for the @pipes@ ecosystem-- * Pushback and leftovers support for saving unused input-- * Tools to combine parsing stages with diverse or isolated leftover buffers-- * Ways to delimit parsers to subsets of streams-- Use these utilities to parse and validate streaming input in constant- memory.--}--{- $eof- To guard an input stream against termination, protect it with the 'wrap'- function:--> wrap :: (Monad m, Proxy p) => p a' a b' b m r -> p a' a b' (Maybe b) m s-- This wraps all output values in a 'Just' and then protects against- termination by producing a never-ending stream of 'Nothing' values:-->>> -- Before->>> runProxy $ enumFromToS 1 3 >-> printD-1-2-3->>> -- After->>> runProxy $ wrap . enumFromToS 1 3 >-> printD-Just 1-Just 2-Just 3-Nothing-Nothing-Nothing-Nothing-...-- You can also 'unwrap' streams:--> unwrap :: (Monad m, Proxy p) => x -> p x (Maybe a) x a m ()-- 'unwrap' behaves like the inverse of 'wrap'. Compose 'unwrap' downstream of- a pipe to unwrap every 'Just' and terminate on the first 'Nothing':--> wrap . p >-> unwrap = p-- You will commonly use 'unwrap' to terminate an infinite stream:-->>> runProxy $ wrap . enumFromToS 1 3 >-> printD >-> unwrap-Just 1-Just 2-Just 3-Nothing---}--{- $compatibility- What if we want to ignore the 'Maybe' machinery entirely and interact with- the original unwrapped stream? We can use 'fmapPull' to lift existing- proxies to ignore all 'Nothing's and only operate on the 'Just's:--> fmapPull-> :: (Monad m, Proxy p)-> => (x -> p x a x b m r)-> -> (x -> p x (Maybe a) x (Maybe b) m r)-- We can use this to lift 'printD' to operate on the original stream:-->>> runProxy $ wrap . enumFromToS 1 3 >-> fmapPull printD >-> unwrap-1-2-3-- This lifting cleanly distributes over composition and obeys the following- laws:--> fmapPull (f >-> g) = fmapPull f >-> fmapPull g->-> fmapPull pull = pull-- You can navigate even more complicated mixtures of 'Maybe'-aware and- 'Maybe'-oblivious code using 'bindPull' and 'returnPull'.-- @pipes-parse@ requires no buy-in from the rest of the @pipes@ ecosystem- thanks to these adapter routines that automatically lift existing pipes to- interoperate with end-of-input protocols.--}--{- $leftovers- To take advantage of leftovers support, just replace your 'request's with- 'draw':--> draw :: (Monad m, Proxy p) => StateP [a] p () (Maybe a) y' y m (Maybe a)-- ... and use 'unDraw' to push back leftovers:--> unDraw :: (Monad m, Proxy p) => a -> StateP [a] p x' x y' y m ()-- These both use a last-in-first-out (LIFO) leftovers buffer of type @[a]@- stored in a 'StateP' layer. 'unDraw' prepends elements to this list of- leftovers and 'draw' will consume elements from the head of the leftovers- list until it is empty before requesting new input from upstream:--> consumer :: (Proxy p) => () -> Consumer (StateP [a] p) (Maybe Int) IO ()-> consumer () = do-> ma <- draw-> lift $ print ma-> -- You can push back values you never drew-> unDraw 99-> -- You can push back more than one value at a time-> case ma of-> Nothing -> return ()-> -- The leftovers buffer only stores unwrapped values-> Just a -> unDraw a-> -- Values come out of the buffer in last-in-first-out (LIFO) order-> replicateM_ 2 $ do-> ma <- draw-> lift $ print ma-- To run the 'StateP' layer, just provide an empty initial state using- 'mempty':-->>> runProxy $ evalStateK mempty $ wrap . enumFromS 1 >-> consumer-Just 1-Just 1-Just 99---}--{- $diverse- Why use 'mempty' instead of @[]@? @pipes-parse@ lets you easily mix- distinct leftovers buffers into the same 'StateP' layer and 'mempty' will- still do the correct thing when you use multiple buffers.-- For example, suppose that we need to compose parsing pipes that have- different input types and therefore different types of leftovers buffers,- such as the following two parsers:--> tallyLength-> :: (Monad m, Proxy p)-> => () -> Pipe (StateP [String] p) (Maybe String) (Maybe Int) m r-> tallyLength () = loop 0-> where-> loop tally = do-> respond (Just tally)-> mstr <- draw-> case mstr of-> Nothing -> forever $ respond Nothing-> Just str -> loop (tally + length str)->-> adder-> :: (Monad m, Proxy p)-> => () -> Consumer (StateP [Int] p) (Maybe Int) m Int-> adder () = fmap sum $ drawAll ()-- We can use 'zoom' to unify these two parsers to share the same 'StateP'- layer:--> combined-> :: (Monad m, Proxy p)-> => () -> Consumer (StateP ([String], [Int]) p) (Maybe String) m Int-> -- ^ ^-> -- | |-> -- Two leftovers buffers ---+-------+-> combined = zoom _fst . tallyLength >-> zoom _snd . adder->-> source :: (Monad m, Proxy p) => () -> Producer p String m ()-> source = fromListS ["One", "Two", "Three"]-- 'zoom' takes a @Lens'@ as an argument which specifies which subset of the- state that each parser will use. '_fst' directs the @tallyLength@ parser to- use the @[String]@ leftovers buffer and '_snd' directs the @adder@ parser to- use the @[Int]@ leftovers buffer.-- Notice that we can still run the mixture of buffers by supplying 'mempty':-->>> runProxy $ evalStateK mempty $ wrap . source >-> combined-20-- This works because:--> (mempty :: ([String], [Int])) = ([], [])-- Let's study the type of 'zoom' to understand how it works:--> -- zoom's true type is slightly different to avoid a dependency on `lens`-> zoom :: Lens' s1 s2 -> StateP s2 p a' a b' b m r -> StateP s1 p a' a b' b m r-- 'zoom' behaves like the function of the same name from the @lens@ package- and zooms in on a sub-state using the provided lens. When we give it the- '_fst' lens we zoom in on the first element of a tuple:--> _fst :: Lens' (s1, s2) s1->-> zoom _fst :: StateP s1 p a' a b' b m r -> StateP (s1, s2) p a' a b' b m r-- ... and when we give it the '_snd' lens we zoom in on the second element of- a tuple:--> _snd :: Lens' (s1, s2) s2->-> zoom _snd :: StateP s2 p a' a b' b m r -> StateP (s1, s2) p a' a b' b m r-- '_fst' and '_snd' are like '_1' and '_2' from the @lens@ package, except- with a more monomorphic type. This ensures that type inference works- correctly when supplying 'mempty' as the initial state.-- If you want to merge more than one leftovers buffer, you can either nest- pairs of tuples:--> p = zoom _fst . p1 >-> zoom (_snd . _fst) . p2 >-> zoom (_snd . _snd) . p3-- ... or you can create a data type that holds all your leftovers and generate- lenses to its fields:--> import Control.Lens hiding (zoom)->-> data Leftovers = Leftovers-> { _buf1 :: [String]-> , _buf2 :: [Int]-> , _buf3 :: [Double]-> }-> makeLenses ''Leftovers-> -- Generates:-> -- buf1 :: Lens' Leftovers [String]-> -- buf2 :: Lens' Leftovers [Int]-> -- buf3 :: Lens' Leftovers [Double]->-> instance Monoid Leftovers where-> mempty = Leftovers [] [] []-> mappend (Leftovers as bs cs) (Leftovers as' bs' cs')-> = Leftovers (as ++ as') (bs ++ bs') (cs ++ cs')->-> p = zoom buf1 . p1 >-> zoom buf2 . p2 >-> zoom buf3 . p3-- 'zoom' works seamlessly with all lenses from the @lens@ package, but you- don't need a @lens@ dependency to use @pipes-parse@.--}--{- $mix- 'zoom' isn't the only way to isolate buffers. Let's say that you want to- mix the following three @pipes-parse@ utilities:--> -- Transmit up to the specified number of elements-> passUpTo-> :: (Monad m, Proxy p)-> => Int -> () -> Pipe (StateP [a] p) (Maybe a) (Maybe a) m r->-> -- Fold all input into a list-> drawAll :: (Monad m, Proxy p) => () -> StateP [a] p () (Maybe a) y' y m [a]->-> -- Check if at end of input stream-> isEndOfInput :: (Monad m, Proxy p) => StateP [a] p () (Maybe a) y' y m Bool-- We might expect the following code to yield chunks of three elements at a- time:--> chunks :: (Monad m, Proxy p) => () -> Pipe (StateP [a] p) (Maybe a) [a] m ()-> chunks () = loop-> where-> loop = do-> as <- (passUpTo 3 >-> drawAll) ()-> respond as-> eof <- isEndOfInput-> unless eof loop-- ... but it doesn't:-->>> runProxy $ evalStateK mempty $ wrap . enumFromToS 1 15 >-> chunks >-> printD-[1,2,3]-[4,5,6,7]-[8,9,10,11]-[12,13,14,15]-- @chunks@ behaves strangely because 'drawAll' shares the same leftovers- buffer as 'passUpTo' and 'isEndOfInput'. After the first chunk completes,- 'isEndOfInput' peeks at the next value, @4@, and immediately 'unDraw's the- value. 'drawAll' retrieves this undrawn value from the leftovers before- consulting 'passUpTo' which is why every subsequent list contains an extra- element.-- We often don't want composed parsing stages like 'drawAll' to share the same- leftovers buffer as upstream stages, but we also don't want to use 'zoom' to- add yet another permanent buffer to our global leftovers state. To solve- this, we embed 'drawAll' within a transient 'StateP' layer using- 'evalStateK':--> chunks () = loop-> where-> loop = do-> as <- (passUpTo 3 >-> evalStateK mempty drawAll) ()-> respond as-> eof <- isEndOfInput-> unless eof loop-- This runs 'drawAll' within a fresh temporary buffer so that it does not- reuse the same buffer as the surrounding pipe:-->>> runProxy $ evalStateK mempty $ wrap . enumFromToS 1 15 >-> chunks >-> printD-[1,2,3]-[4,5,6]-[7,8,9]-[10,11,12]-[13,14,15]-- Conversely, remove the 'evalStateK' if you deliberately want downstream- parsers to share the same leftovers buffers.--}--{- $return- 'wrap' allows you to return values directly from parsers because it produces- a polymorphic return value:--> -- The 's' is polymorphic and will type-check as anything-> wrap :: (Monad m, Proxy p) => p a' a b' b m r -> p a' a b' (Maybe b) m s-- This means that if you compose a parser downstream the parser can return the- result directly:--> parser-> :: (Monad m, Proxy p)-> => () -> Consumer (StateP [a] p) (Maybe a) m (Maybe a, Maybe a)-> parser () = do-> mx <- draw-> my <- draw-> return (mx, my) -- Return the result-- The polymorphic return value of 'wrap' will type-check as anything,- including our parser's result:--> session-> :: (Monad m, Proxy p)-> => () -> Session (StateP [Int] p) m (Maybe Int, Maybe Int)-> session = wrap . enumFromToS 0 9 >-> parser-- So we can run this 'Session' and retrieve the result directly from the- return value:-->>> runProxy $ evalStateK session-(Just 0, Just 1)---}--{- $resume- You can save leftovers buffers if you need to interrupt parsing for any- reason. Just replace 'evalStateK' with 'runStateK':-->>> let session = wrap . enumFromS 0 >-> passWhile (< 3) >-> printD >-> unwrap->>> runProxy $ runStateK mempty session-Just 0-Just 1-Just 2-Nothing-((), [3])-- This returns the leftovers buffers in the result so that you can reuse them- later on. In the above example, 'passWhile' pushed back the @3@ input onto- the leftovers buffer, so the result includes the unused @3@.--}--{- $nesting- @pipes-parse@ allows you to cleanly delimit the scope of sub-parsers by- restricting them to a subset of the stream, as the following example- illustrates:--> import Control.Proxy-> import Control.Proxy.Parse->-> parser-> :: (Proxy p)-> => () -> Consumer (StateP [Int] p) (Maybe Int) IO ([Int], [Int])-> parser () = do-> lift $ putStrLn "Skip the first three elements"-> (passUpTo 3 >-> evalStateK mempty skipAll) ()-> lift $ putStrLn "Restrict subParser to consecutive elements less than 10"-> (passWhile (< 10) >-> evalStateK mempty subParser) ()->-> subParser-> :: (Proxy p)-> => () -> Consumer (StateP [Int] p) (Maybe Int) IO ([Int], [Int])-> subParser () = do-> lift $ putStrLn "- Get the next four elements"-> xs <- (passUpTo 4 >-> evalStateK mempty drawAll) ()-> lift $ putStrLn "- Get the rest of the input"-> ys <- drawAll ()-> return (xs, ys)-- Notice how we use 'evalStateK' each time we subset a parser so that the- sub-parser uses a fresh and transient leftovers buffer.-->>> runProxy $ evalStateK mempty $ wrap . enumFromS 0 >-> parser-Skip the first three elements-Restrict subParser to consecutive elements less than 10-- Get the next four elements-- Get the rest of the input-([3,4,5,6],[7,8,9])---}--{- $conclusion- @pipes-parse@ provides standardized end-of-input and leftovers utilities for- you to use in your @pipes@-based libraries. Unlike other streaming- libraries, you can:-- * mix or isolate leftovers buffers in a precise and type-safe way,-- * easily delimit parsers to subsets of the input, and-- * ignore standardization, thanks to compatibility functions like 'fmapPull'.-- This library is intentionally minimal and datatype-specific parsers belong- in derived libraries. This makes @pipes-parse@ a very light-weight and- stable dependency that you can use in your own projects.-- You can ask any questions about @pipes-parse@ and other @pipes@ libraries on- the official @pipes@ mailing list at- <mailto:haskell-pipes@googlegroups.com>.--}
pipes-parse.cabal view
@@ -1,5 +1,5 @@ Name: pipes-parse-Version: 1.0.0+Version: 2.0.0 Cabal-Version: >=1.8.0.2 Build-Type: Simple License: BSD3@@ -9,30 +9,29 @@ Maintainer: Gabriel439@gmail.com Bug-Reports: https://github.com/Gabriel439/Haskell-Pipes-Parse-Library/issues Synopsis: Parsing infrastructure for the pipes ecosystem-Description: This package defines the generic machinery necessary for common- parsing tasks using @pipes@:- .- * /End of input/: Detect and handle end of input+Description: @pipes-parse@ builds upon the @pipes@ library to provide shared+ parsing idioms and utilities: .- * /Push-back/: Save unused input for later steps+ * /Perfect Streaming/: Program in a list-like style in constant memory .- * /Lens Support/: Mix proxies with different leftover buffers using lenses+ * /Leftovers/: Save unused input for later consumption .- * /Compatibility/: Transparently upgrade proxies to work with @pipes-parse@+ * /Connect and Resume/: Use @StateT@ to save unused input for later .- Import @Control.Proxy.Parse@ to use this library.+ * /Termination Safety/: Detect and recover from end of input .- Read @Control.Proxy.Parse.Tutorial@ for an introductory tutorial.-Category: Control, Pipes, Proxies, Parsing+ @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 ,- pipes >= 3.3 && < 3.4- Exposed-Modules:- Control.Proxy.Parse,- Control.Proxy.Parse.Tutorial- GHC-Options: -O2+ base >= 4 && < 5 ,+ free >= 3.1 && < 3.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
@@ -0,0 +1,350 @@+{-|+ 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. 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 contains the lower-level monadic parsing+ primitives. These are more useful for `pipes` implementers, particularly+ for building splitters. I recommend that application developers use the+ list-like style whenever possible.+-}++{-# LANGUAGE RankNTypes #-}++module Pipes.Parse (+ -- * Splitters+ groupBy,+ chunksOf,+ splitOn,++ -- * Transformations+ takeFree,++ -- * 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.Class (lift)+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 (Producer, Pipe, await, yield, next, (>->), Producer')+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+ concat 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 #-}++-- | @(take 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 #-}++{- $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'.+-}