Data.IterIO.Parse
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.
- (<|>) :: (ChunkData t, Monad m) => Iter t m a -> Iter t m a -> Iter t m a
- (\/) :: (ChunkData t, Monad m) => Iter t m a -> Iter t m b -> (a -> Iter t m b) -> Iter t m b
- orEmpty :: (ChunkData t, Monad m, Monoid b) => Iter t m a -> (a -> Iter t m b) -> Iter t m b
- (<?>) :: (ChunkData t, Monad m) => Iter t m a -> String -> Iter t m a
- expectedI :: ChunkData t => String -> String -> Iter t m a
- foldrI :: (ChunkData t, Monad m) => (a -> b -> b) -> b -> Iter t m a -> Iter t m b
- foldr1I :: (ChunkData t, Monad m) => (a -> b -> b) -> b -> Iter t m a -> Iter t m b
- foldrMinMaxI :: (ChunkData t, Monad m) => Int -> Int -> (a -> b -> b) -> b -> Iter t m a -> Iter t m b
- foldlI :: (ChunkData t, Monad m) => (b -> a -> b) -> b -> Iter t m a -> Iter t m b
- foldl1I :: (ChunkData t, Monad m) => (b -> a -> b) -> b -> Iter t m a -> Iter t m b
- foldMI :: (ChunkData t, Monad m) => (b -> a -> Iter t m b) -> b -> Iter t m a -> Iter t m b
- foldM1I :: (ChunkData t, Monad m) => (b -> a -> Iter t m b) -> b -> Iter t m a -> Iter t m b
- skipI :: Applicative f => f a -> f ()
- optionalI :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()
- ensureI :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m ()
- eord :: Enum e => Char -> e
- skipWhileI :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m ()
- skipWhile1I :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m ()
- whileI :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m t
- while1I :: (ChunkData t, ListLike t e, Monad m) => (e -> Bool) -> Iter t m t
- whileMaxI :: (ChunkData t, ListLike t e, Monad m) => Int -> (e -> Bool) -> Iter t m t
- whileMinMaxI :: (ChunkData t, ListLike t e, Monad m) => Int -> Int -> (e -> Bool) -> Iter t m t
- concatI :: (ChunkData t, Monoid s, Monad m) => Iter t m s -> Iter t m s
- concat1I :: (ChunkData t, Monoid s, Monad m) => Iter t m s -> Iter t m s
- concatMinMaxI :: (ChunkData t, Monoid s, Monad m) => Int -> Int -> Iter t m s -> Iter t m s
- readI :: (ChunkData t, Monad m, StringLike s, Read a) => s -> Iter t m a
- eofI :: (ChunkData t, Monad m, Show t) => Iter t m ()
- (<$>) :: Functor f => (a -> b) -> f a -> f b
- (<$) :: Functor f => forall a b. a -> f b -> f a
- ($>) :: Functor f => f a -> b -> f b
- (>$>) :: Functor f => (t -> a -> b) -> f a -> t -> f b
- class Functor f => Applicative f where
- (<**>) :: Applicative f => f a -> f (a -> b) -> f b
- (<++>) :: (Applicative f, Monoid t) => f t -> f t -> f t
- (<:>) :: (ListLike t e, Applicative f) => f e -> f t -> f t
- nil :: (Applicative f, Monoid t) => f t
- many :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m f
- skipMany :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()
- sepBy :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m f
- endBy :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m f
- sepEndBy :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m f
- many1 :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m f
- skipMany1 :: (ChunkData t, Monad m) => Iter t m a -> Iter t m ()
- sepBy1 :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m f
- endBy1 :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m f
- sepEndBy1 :: (ChunkData t, ListLike f a, Monad m) => Iter t m a -> Iter t m b -> Iter t m f
- satisfy :: (ChunkData t, ListLike t e, Enum e, Monad m) => (e -> Bool) -> Iter t m e
- char :: (ChunkData t, ListLike t e, Eq e, Enum e, Monad m) => Char -> Iter t m e
- match :: (ChunkData t, ListLike t e, Eq e, Monad m) => t -> Iter t m t
- string :: (ChunkData t, ListLike t e, StringLike t, Eq e, Monad m) => String -> Iter t m t
- stringCase :: (ChunkData t, ListLike t e, Enum e, Eq e, Monad m) => String -> Iter t m t
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
class in Control.Applicative, but the
Alternative operator has left fixity, while for efficiency this
one has:
Alternative
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 = (, and useful when
parse failures should just return an empty \/ return mempty)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
where expectedI prefix tokenprefix is a prefix of the input that was fed to iter and
caused it to fail.
Has fixity:
infix 0 <?>
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.
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) ...
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 s (which consist
of ByteStrings). For example, to skip one or more space or TAB
characters, you can use:
Word8
skipSpace :: (ListLiket e, ChunkData t,Eqe,Enume, Monad m) =>Itert 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.
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.
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.
Arguments
| :: (ChunkData t, Monoid s, Monad m) | |
| => Int | Minimum number to parse |
| -> Int | Maximum number to parse |
| -> Iter t m s |
|
| -> 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 => (t -> a -> b) -> f a -> t -> f bSource
(f >$> a) t is equivalent to f t (where <$> a<$> 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
A minimal complete definition must include implementations of these functions satisfying the following laws:
- identity
-
pureid<*>v = v - composition
-
pure(.)<*>u<*>v<*>w = u<*>(v<*>w) - homomorphism
-
puref<*>purex =pure(f x) - interchange
-
u<*>purey =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 and
pure = return( (which implies that <*>) = appure 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.
Instances
(<**>) :: 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
(<:>) :: (ListLike t e, Applicative f) => f e -> f t -> f tSource
cons an Applicative type onto an an Applicative
ListLike type (<:> = ). Has the same
fixity as liftA2 cons:, namely:
infixr 5 <:>
nil :: (Applicative f, Monoid t) => f tSource
nil = --An empty pure memptyMonoid 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.
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 |
Parses a sequence of the form
Item1 Separator Item2 Separator ... Separator ItemN
and returns the list [Item1, Item2, ..., ItemN]
or a ListLike equivalent.
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.
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.