iterIO-0.2.2: Iteratee-based IO with pipe operators

Safe HaskellSafe

Data.IterIO.Parse

Contents

Description

This module contains functions to help parsing input from within Iters. Many of the operators are either imported from Data.Applicative or inspired by Text.Parsec.

Synopsis

Iteratee combinators

(<|>) :: (ChunkData t, Monad m) => Iter t m a -> Iter t m a -> Iter t m aSource

An infix synonym for multiParse that allows LL(*) parsing of alternatives by executing both Iteratees on input chunks as they arrive. This is similar to the <|> method of the Alternative class in Control.Applicative, but the Alternative operator has left fixity, while for efficiency this one has:

 infixr 3 <|>

(\/) :: (ChunkData t, Monad m) => Iter t m a -> Iter t m b -> (a -> Iter t m b) -> Iter t m bSource

An infix synonym for ifNoParse that allows LL(*) parsing of alternatives by keeping a copy of input data consumed by the first Iteratee so as to backtrack and execute the second Iteratee if the first one fails. Returns a function that takes a continuation for the first Iter, should it succeed. The code:

     iter1 \/ iter2 $ \iter1Result -> doSomethingWith iter1Result

Executes iter1 (saving a copy of the input for backtracking). If iter1 fails with an exception of class IterNoParse, then the input is re-wound and fed to iter2. On the other hand, if iter1 succeeds and returns iter1Result, then the saved input is discarded (as iter2 will not need to be run) and the result of iter1 is fed to function doSomethingWith.

For example, to build up a list of results of executing iter, one could implement a type-restricted version of many as follows:

   myMany :: (ChunkData t, Monad m) => Iter t m a -> Iter t m [a]
   myMany iter = iter \/ return [] $ \r -> fmap ((:) r) (myMany iter)

In other words, myMany tries running iter. If iter fails, then myMany returns the empty list. If iter succeeds, its result r is added to the head of the list returned by calling myMany recursively. This idiom of partially applying a binary funciton to a result and then applying the resulting function to an Iter via fmap is so common that there is an infix operator for it, >$>. Thus, the above code can be written:

   myMany iter = iter \/ return [] $ (:) >$> myMany iter

Of course, using fmap is not the most efficient way to implement myMany. If you are going to use this pattern for something performance critical, you should use an accumulator rather than build up long chains of fmaps. A faster implementation would be:

   myMany iter = loop id
       where loop ac = iter \/ return (acc []) $ a -> loop (acc . (a :))

\/ has fixity:

 infix 2 \/

orEmpty :: (ChunkData t, Monad m, Monoid b) => Iter t m a -> (a -> Iter t m b) -> Iter t m bSource

Defined as orEmpty = (\/ return mempty), and useful when parse failures should just return an empty Monoid. For example, a type-restricted many can be implemented as:

   myMany :: (ChunkData t, Monad m) => Iter t m a -> Iter t m [a]
   myMany iter = iter `orEmpty` (:) >$> myMany iter

Has fixity:

 infixr 3 `orEmpty`

(<?>) :: (ChunkData t, Monad m) => Iter t m a -> String -> Iter t m aSource

iter <?> token replaces any kind of parse failure in iter with an exception equivalent to calling expectedI prefix token where prefix is a prefix of the input that was fed to iter and caused it to fail.

Has fixity:

 infix 0 <?>

expectedISource

Arguments

:: ChunkData t 
=> String

Input actually received

-> String

Description of input that was wanted

-> Iter t m a 

Throw an Iter exception that describes expected input not found.

foldrI :: (ChunkData t, Monad m) => (a -> b -> b) -> b -> Iter t m a -> Iter t m bSource

Repeatedly invoke an Iter and right-fold a function over the results.

foldr1I :: (ChunkData t, Monad m) => (a -> b -> b) -> b -> Iter t m a -> Iter t m bSource

A variant of foldrI that requires the Iter to succeed at least once.

foldrMinMaxISource

Arguments

:: (ChunkData t, Monad m) 
=> Int

Minimum number to parse

-> Int

Maximum number to parse

-> (a -> b -> b)

Folding function

-> b

Rightmost value

-> Iter t m a

Iteratee generating items to fold

-> Iter t m b 

A variant of foldrI that requires the Iter to succeed at least a minimum number of items and stops parsing after executing the Iter some maximum number of times.

foldlI :: (ChunkData t, Monad m) => (b -> a -> b) -> b -> Iter t m a -> Iter t m bSource

Strict left fold over an Iter (until it throws an IterNoParse exception). foldlI f z iter is sort of equivalent to:

 ... (f <$> (f <$> (f z <$> iter) <*> iter) <*> iter) ...

foldl1I :: (ChunkData t, Monad m) => (b -> a -> b) -> b -> Iter t m a -> Iter t m bSource

A version of foldlI that fails if the Iter argument does not succeed at least once.

foldMI :: (ChunkData t, Monad m) => (b -> a -> Iter t m b) -> b -> Iter t m a -> Iter t m bSource

foldMI is a left fold in which the folding function can execute monadic actions. Essentially foldMI is to foldlI as foldM is to foldl' in the standard libraries.

foldM1I :: (ChunkData t, Monad m) => (b -> a -> Iter t m b) -> b -> Iter t m a -> Iter t m bSource

A variant of foldMI that requires the Iter to succeed at least once.

skipI :: Applicative f => f a -> f ()Source

Discard the result of executing an Iteratee once. Throws an error if the Iteratee fails. (Like skip x = x >> return ().)

optionalI :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()Source

Execute an iteratee. Discard the result if it succeeds. Rewind the input and suppress the error if it fails.

ensureI :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m ()Source

Ensures the next input element satisfies a predicate or throws a parse error. Does not consume any input.

eord :: Enum e => Char -> eSource

A variant of the standard library ord function, but that translates a Char into any Enum type, not just Int. Particularly useful for Iters that must work with both Strings (which consist of Chars) and ASCII ByteStrings (which consist of Word8s). For example, to skip one or more space or TAB characters, you can use:

   skipSpace :: (ListLike t e, ChunkData t, Eq e, Enum e, Monad m) =>
                Iter t m ()
   skipSpace = skipWhile1I (\c -> c == eord ' ' || c == eord '\t')

skipWhileI :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m ()Source

Skip all input elements encountered until an element is found that does not match the specified predicate.

skipWhile1I :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m ()Source

Like skipWhileI, but fails if at least one element does not satisfy the predicate.

whileI :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m tSource

Return all input elements up to the first one that does not match the specified predicate.

while1I :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m tSource

Like whileI, but fails if at least one element does not satisfy the predicate.

whileMaxISource

Arguments

:: (ChunkData t, ListLike t e, Monad m) 
=> Int

Maximum number to match

-> (e -> Bool)

Predicate test

-> Iter t m t 

A variant of whileI with a maximum number matches.

whileMinMaxISource

Arguments

:: (ChunkData t, ListLike t e, Monad m) 
=> Int

Minumum number

-> Int

Maximum number

-> (e -> Bool)

Predicate test

-> Iter t m t 

A variant of whileI with a minimum and maximum number matches.

concatI :: (ChunkData t, Monoid s, Monad m) => Iter t m s -> Iter t m sSource

Repeatedly execute an Iter returning a Monoid and mappend all the results in a right fold.

concat1I :: (ChunkData t, Monoid s, Monad m) => Iter t m s -> Iter t m sSource

Like concatI, but fails if the Iter doesn't return at least once.

concatMinMaxISource

Arguments

:: (ChunkData t, Monoid s, Monad m) 
=> Int

Minimum number to parse

-> Int

Maximum number to parse

-> Iter t m s

Iter whose results to concatenate

-> Iter t m s 

A version of concatI that takes a minimum and maximum number of items to parse.

readI :: (ChunkData t, Monad m, StringLike s, Read a) => s -> Iter t m aSource

This Iter parses a StringLike argument. It does not consume any Iteratee input. The only reason it is an Iteratee is so that it can throw an Iteratee parse error should it fail to parse the argument string (or should the argument yield an ambiguous parse).

eofI :: (ChunkData t, Monad m, Show t) => Iter t m ()Source

Ensures the input is at the end-of-file marker, or else throws an exception.

Applicative combinators

(<$>) :: Functor f => (a -> b) -> f a -> f b

An infix synonym for fmap.

(<$) :: Functor f => forall a b. a -> f b -> f a

Replace all locations in the input with the same value. The default definition is fmap . const, but this may be overridden with a more efficient version.

($>) :: Functor f => f a -> b -> f bSource

fa $> b = b <$ fa -- replaces the output value of a functor with some pure value. Has the same fixity as <$> and <$, namely:

 infixl 4 $>

(>$>) :: Functor f => (t -> a -> b) -> f a -> t -> f bSource

(f >$> a) t is equivalent to f t <$> a (where <$> is and infix alias for fmap). Particularly useful with infix combinators such as \/ and `orEmpty` when chaining parse actions. See examples at \/ and orEmpty. Note fmap is not always the most efficient solution (see an example in the description of \/).

Has fixity:

 infixl 3 >$>

class Functor f => Applicative f where

A functor with application, providing operations to

  • embed pure expressions (pure), and
  • sequence computations and combine their results (<*>).

A minimal complete definition must include implementations of these functions satisfying the following laws:

identity
pure id <*> v = v
composition
pure (.) <*> u <*> v <*> w = u <*> (v <*> w)
homomorphism
pure f <*> pure x = pure (f x)
interchange
u <*> pure y = pure ($ y) <*> u

The other methods have the following default definitions, which may be overridden with equivalent specialized implementations:

      u *> v = pure (const id) <*> u <*> v
      u <* v = pure const <*> u <*> v

As a consequence of these laws, the Functor instance for f will satisfy

      fmap f x = pure f <*> x

If f is also a Monad, it should satisfy pure = return and (<*>) = ap (which implies that pure and <*> satisfy the applicative functor laws).

Methods

pure :: a -> f a

Lift a value.

(<*>) :: f (a -> b) -> f a -> f b

Sequential application.

(*>) :: f a -> f b -> f b

Sequence actions, discarding the value of the first argument.

(<*) :: f a -> f b -> f a

Sequence actions, discarding the value of the second argument.

(<**>) :: Applicative f => f a -> f (a -> b) -> f b

A variant of <*> with the arguments reversed.

(<++>) :: (Applicative f, Monoid t) => f t -> f t -> f tSource

mappend the result of two Applicative types returning Monoid types (<++> = liftA2 mappend). Has the same fixity as ++, namely:

 infixr 5 <++>

(<:>) :: (ListLike t e, Applicative f) => f e -> f t -> f tSource

cons an Applicative type onto an an Applicative ListLike type (<:> = liftA2 cons). Has the same fixity as :, namely:

 infixr 5 <:>

nil :: (Applicative f, Monoid t) => f tSource

nil = pure mempty--An empty Monoid injected into an Applicative type.

Parsing Iteratees

These functions are intended to be similar to those supplied by Text.Parsec.

many :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m fSource

Run an Iter zero or more times (until it fails) and return a list-like container of the results.

skipMany :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()Source

Repeatedly run an Iter until it fails and discard all the results.

sepBySource

Arguments

:: (ChunkData t, ListLike f a, Monad m) 
=> Iter t m a

Item to parse

-> Iter t m b

Separator between items

-> Iter t m f

Returns ListLike list of items

Parses a sequence of the form Item1 Separator Item2 Separator ... Separator ItemN and returns the list [Item1, Item2, ..., ItemN] or a ListLike equivalent.

endBySource

Arguments

:: (ChunkData t, ListLike f a, Monad m) 
=> Iter t m a

Item to parse

-> Iter t m b

Separator that must follow each item

-> Iter t m f

Returns ListLike list of items

Like sepBy, but expects a separator after the final item. In other words, parses a sequence of the form Item1 Separator Item2 Separator ... Separator ItemN Separator and returns the list [Item1, Item2, ..., ItemN] or a ListLike equivalent.

sepEndBy :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m fSource

Accepts items that would be parsed by either sepBy or endBy. Essentially a version of endBy in which the final separator is optional.

many1 :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m fSource

Run an Iter one or more times (until it fails) and return a list-like container of the results.

skipMany1 :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()Source

A variant of skipMany that throws a parse error if the Iter does not succeed at least once.

sepBy1 :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m fSource

A variant of sepBy that throws a parse error if it cannot return at least one item.

endBy1 :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m fSource

A variant of endBy that throws a parse error if it cannot return at least one item.

sepEndBy1 :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m fSource

A variant of sepEndBy that throws a parse error if it cannot return at least one item.

satisfy :: (ChunkData t, ListLike t e, Enum e, Monad m) => (e -> Bool) -> Iter t m eSource

Read the next input element if it satisfies some predicate. Otherwise throw an error.

char :: (ChunkData t, ListLike t e, Eq e, Enum e, Monad m) => Char -> Iter t m eSource

Read input that exactly matches a character.

match :: (ChunkData t, ListLike t e, Eq e, Monad m) => t -> Iter t m tSource

Read input that exactly matches some target.

string :: (ChunkData t, ListLike t e, StringLike t, Eq e, Monad m) => String -> Iter t m tSource

Read input that exactly matches a string.

stringCase :: (ChunkData t, ListLike t e, Enum e, Eq e, Monad m) => String -> Iter t m tSource

Read input that matches a string up to case.