hexpat-streamparser-0.1.3
Copyright(c) Kristof Bastiaensen 2020
LicenseBSD-3
Maintainerkristof@resonata.be
Stabilityunstable
Portabilityghc
Safe HaskellNone
LanguageHaskell2010

Text.XML.Expat.StreamParser

Description

This module implements a streaming parser built on top of hexpat. It has an interface similar to parsec and other parser libraries. Note that backtracking is not supported. Only the current tag name and attributes can be looked at without backtracking. After a tag test and attribute parser has succeeded, attempting to backtrack will generate an error.

This library can be used with a streaming library (conduit, pipes, etc...) by providing an instance for List.

Synopsis

Event parser datatype

type EventListParser e a = EventParser [] e Identity a Source #

A parser that parses a lazy list of SAX events into a value of type a, or an error of type `EventParseError e`, where e is a custom error type.

data EventParser l e m a Source #

A parser that parses a stream of SAX events of type l EventLoc into to a value of type a using m as the underlying monad. l should be an instance of List, and m should be equal to the type instance (ItemM l). Custom error messages are possible using the type e.

Instances

Instances details
Monad m => MonadError (EventParseError e) (EventParser l e m) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

throwError :: EventParseError e -> EventParser l e m a #

catchError :: EventParser l e m a -> (EventParseError e -> EventParser l e m a) -> EventParser l e m a #

MonadTrans (EventParser l e) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

lift :: Monad m => m a -> EventParser l e m a #

Monad m => Monad (EventParser l e m) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

(>>=) :: EventParser l e m a -> (a -> EventParser l e m b) -> EventParser l e m b #

(>>) :: EventParser l e m a -> EventParser l e m b -> EventParser l e m b #

return :: a -> EventParser l e m a #

Functor (EventParser l e m) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

fmap :: (a -> b) -> EventParser l e m a -> EventParser l e m b #

(<$) :: a -> EventParser l e m b -> EventParser l e m a #

(Monad m, IsString e) => MonadFail (EventParser l e m) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

fail :: String -> EventParser l e m a #

Monad m => Applicative (EventParser l e m) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

pure :: a -> EventParser l e m a #

(<*>) :: EventParser l e m (a -> b) -> EventParser l e m a -> EventParser l e m b #

liftA2 :: (a -> b -> c) -> EventParser l e m a -> EventParser l e m b -> EventParser l e m c #

(*>) :: EventParser l e m a -> EventParser l e m b -> EventParser l e m b #

(<*) :: EventParser l e m a -> EventParser l e m b -> EventParser l e m a #

Monad m => MonadPlus (EventParser l e m) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

mzero :: EventParser l e m a #

mplus :: EventParser l e m a -> EventParser l e m a -> EventParser l e m a #

Monad m => Alternative (EventParser l e m) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

empty :: EventParser l e m a #

(<|>) :: EventParser l e m a -> EventParser l e m a -> EventParser l e m a #

some :: EventParser l e m a -> EventParser l e m [a] #

many :: EventParser l e m a -> EventParser l e m [a] #

(Monad m, Semigroup a) => Semigroup (EventParser l e m a) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

(<>) :: EventParser l e m a -> EventParser l e m a -> EventParser l e m a #

sconcat :: NonEmpty (EventParser l e m a) -> EventParser l e m a #

stimes :: Integral b => b -> EventParser l e m a -> EventParser l e m a #

(Monad m, Monoid a) => Monoid (EventParser l e m a) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

mempty :: EventParser l e m a #

mappend :: EventParser l e m a -> EventParser l e m a -> EventParser l e m a #

mconcat :: [EventParser l e m a] -> EventParser l e m a #

data EventParseError e Source #

Instances

Instances details
Eq e => Eq (EventParseError e) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Show e => Show (EventParseError e) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Semigroup (EventParseError e) Source #

semigroup instance concatenates Expected tags.

Instance details

Defined in Text.XML.Expat.StreamParser

Monoid (EventParseError e) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Monad m => MonadError (EventParseError e) (EventParser l e m) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

throwError :: EventParseError e -> EventParser l e m a #

catchError :: EventParser l e m a -> (EventParseError e -> EventParser l e m a) -> EventParser l e m a #

mapParser :: (Monad m, Monad n) => (forall b. m b -> n b) -> EventParser l e m a -> EventParser l e n a Source #

Change the base monad of a parser

runEventParser Source #

Arguments

:: List l 
=> EventParser l e (ItemM l) a

parser to run

-> l EventLoc

list of SAX event

-> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a) 

customError :: Monad m => e -> EventParser l e m a Source #

Throw an error with a custom type. If the custom error type provides an IsString instance, you can also use fail (for example Text, String).

Running parsers

parseXMLByteString :: EventListParser e a -> ParseOptions Text Text -> ByteString -> Either (EventParseError e, Maybe XMLParseLocation) a Source #

Parse a lazy bytestring with the given parser. Evaluating the result to WHNF will consume the bytestring (as much as needed). However this function does not close resources, for example a file handle when using readFile. Make sure to always explicitly close a resource, after evaluating to WHNF, or use the streaming version of this library (hexpat-conduit). For reading from a file use the parseXMLFile function.

parseXMLFile :: ParseOptions Text Text -> IOMode -> FilePath -> EventListParser e a -> IO (Either (EventParseError e, Maybe XMLParseLocation) a) Source #

Lazily parse an xml file into a value. This function ensures the input is consumed and the file handle closed, before returning the value.

Attribute parsers

data AttrParser e a Source #

A parser for the attributes of a single tag, that returns a value of type a. Custom error messages are possible of type e.

Instances

Instances details
Monad (AttrParser e) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

(>>=) :: AttrParser e a -> (a -> AttrParser e b) -> AttrParser e b #

(>>) :: AttrParser e a -> AttrParser e b -> AttrParser e b #

return :: a -> AttrParser e a #

Functor (AttrParser e) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

fmap :: (a -> b) -> AttrParser e a -> AttrParser e b #

(<$) :: a -> AttrParser e b -> AttrParser e a #

Applicative (AttrParser e) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

pure :: a -> AttrParser e a #

(<*>) :: AttrParser e (a -> b) -> AttrParser e a -> AttrParser e b #

liftA2 :: (a -> b -> c) -> AttrParser e a -> AttrParser e b -> AttrParser e c #

(*>) :: AttrParser e a -> AttrParser e b -> AttrParser e b #

(<*) :: AttrParser e a -> AttrParser e b -> AttrParser e a #

Alternative (AttrParser e) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

empty :: AttrParser e a #

(<|>) :: AttrParser e a -> AttrParser e a -> AttrParser e a #

some :: AttrParser e a -> AttrParser e [a] #

many :: AttrParser e a -> AttrParser e [a] #

Semigroup a => Semigroup (AttrParser e a) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

(<>) :: AttrParser e a -> AttrParser e a -> AttrParser e a #

sconcat :: NonEmpty (AttrParser e a) -> AttrParser e a #

stimes :: Integral b => b -> AttrParser e a -> AttrParser e a #

Monoid a => Monoid (AttrParser e a) Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

mempty :: AttrParser e a #

mappend :: AttrParser e a -> AttrParser e a -> AttrParser e a #

mconcat :: [AttrParser e a] -> AttrParser e a #

class ParseAttr e a Source #

A parser for the value of an attribute

Minimal complete definition

parseAttr

Instances

Instances details
ParseAttr e Text Source # 
Instance details

Defined in Text.XML.Expat.StreamParser

Methods

parseAttr :: Text -> Either e Text

getAttr Source #

Arguments

:: ParseAttr e a 
=> Text

attribute name

-> AttrParser e a 

returns the value for the given attribute. Fail if the attribute is not found.

peekAttr :: AttrParser e a -> AttrParser e a Source #

run an attribute parser without consuming any attributes.

findAttr Source #

Arguments

:: ParseAttr e a 
=> Text

attribute name

-> AttrParser e (Maybe a) 

return the value for the attribute if it exists, otherwise Nothing.

skipAttrs :: AttrParser e () Source #

consume all remaining attributes

noAttrs :: AttrParser e () Source #

expect no attributes. This is the same as `pure ()`

Event parsers

someTag Source #

Arguments

:: (Monad (ItemM l), List l) 
=> (Text -> Bool)

tagname test

-> AttrParser e b

parser for attributes

-> (b -> EventParser l e (ItemM l) a)

parser for tag children

-> EventParser l e (ItemM l) a 

Parse a tag that succeed on the given test function. Parses the children in the order or the inner parser.

skipTag :: (Monad (ItemM l), List l) => EventParser l e (ItemM l) () Source #

Skip next tag

skipTags :: (Monad (ItemM l), List l) => EventParser l e (ItemM l) () Source #

Skip remaining tags and text, if any.

skipTagsTill :: (Monad (ItemM l), List l) => EventParser l e (ItemM l) a -> EventParser l e (ItemM l) a Source #

Skip zero or more tags until the given parser succeeds

tag Source #

Arguments

:: (Monad (ItemM l), List l) 
=> Text

tag name

-> AttrParser e b

attribute parser

-> (b -> EventParser l e (ItemM l) a)

tag children parser

-> EventParser l e (ItemM l) a 

Parse a tag with the given name, using the inner parser for the children tags.

someEmptyTag Source #

Arguments

:: (Monad (ItemM l), List l) 
=> (Text -> Bool)

tag name test

-> AttrParser e b

attribute parser

-> EventParser l e (ItemM l) b 

Parse a tag which should have no children.

emptyTag Source #

Arguments

:: (Monad (ItemM l), List l) 
=> Text

tag name

-> AttrParser e b

attribute parser

-> EventParser l e (ItemM l) b 

Parser a tag with the given name which should have no children. If the tag has children, an error is raised.

text :: (Monad (ItemM l), List l) => EventParser l e (ItemM l) Text Source #

Parse text. Note that parsing a tag will skip white space, so if whitespace is significant, run this parser first.

Re-exports from Control.Applicative.Combinators

(<|>) :: Alternative f => f a -> f a -> f a infixl 3 #

An associative binary operation

optional :: Alternative f => f a -> f (Maybe a) #

One or none.

empty :: Alternative f => f a #

The identity of <|>

Re-exports from Control.Monad.Combinators

between :: Applicative m => m open -> m close -> m a -> m a #

between open close p parses open, followed by p and close. Returns the value returned by p.

braces = between (symbol "{") (symbol "}")

choice :: (Foldable f, Alternative m) => f (m a) -> m a #

choice ps tries to apply the parsers in the list ps in order, until one of them succeeds. Returns the value of the succeeding parser.

choice = asum

count :: Monad m => Int -> m a -> m [a] #

count n p parses n occurrences of p. If n is smaller or equal to zero, the parser equals to return []. Returns a list of n values.

See also: skipCount, count'.

count' :: MonadPlus m => Int -> Int -> m a -> m [a] #

count' m n p parses from m to n occurrences of p. If n is not positive or m > n, the parser equals to return []. Returns a list of parsed values.

Please note that m may be negative, in this case effect is the same as if it were equal to zero.

See also: skipCount, count.

eitherP :: Alternative m => m a -> m b -> m (Either a b) #

Combine two alternatives.

eitherP a b = (Left <$> a) <|> (Right <$> b)

endBy :: MonadPlus m => m a -> m sep -> m [a] #

endBy p sep parses zero or more occurrences of p, separated and ended by sep. Returns a list of values returned by p.

cStatements = cStatement `endBy` semicolon

endBy1 :: MonadPlus m => m a -> m sep -> m [a] #

endBy1 p sep parses one or more occurrences of p, separated and ended by sep. Returns a list of values returned by p.

many :: MonadPlus m => m a -> m [a] #

many p applies the parser p zero or more times and returns a list of the values returned by p.

identifier = (:) <$> letter <*> many (alphaNumChar <|> char '_')

manyTill :: MonadPlus m => m a -> m end -> m [a] #

manyTill p end applies parser p zero or more times until parser end succeeds. Returns the list of values returned by p. Note that end result is consumed and lost. Use manyTill_ if you wish to keep it.

See also: skipMany, skipManyTill.

manyTill_ :: MonadPlus m => m a -> m end -> m ([a], end) #

manyTill_ p end applies parser p zero or more times until parser end succeeds. Returns the list of values returned by p and the end result. Use manyTill if you have no need in the result of the end.

See also: skipMany, skipManyTill.

Since: parser-combinators-1.2.0

some :: MonadPlus m => m a -> m [a] #

some p applies the parser p one or more times and returns a list of the values returned by p.

word = some letter

someTill :: MonadPlus m => m a -> m end -> m [a] #

someTill p end works similarly to manyTill p end, but p should succeed at least once. Note that end result is consumed and lost. Use someTill_ if you wish to keep it.

someTill p end = liftM2 (:) p (manyTill p end)

See also: skipSome, skipSomeTill.

someTill_ :: MonadPlus m => m a -> m end -> m ([a], end) #

someTill_ p end works similarly to manyTill_ p end, but p should succeed at least once. Use someTill if you have no need in the result of the end.

See also: skipSome, skipSomeTill.

Since: parser-combinators-1.2.0

option :: Alternative m => a -> m a -> m a #

option x p tries to apply the parser p. If p fails without consuming input, it returns the value x, otherwise the value returned by p.

option x p = p <|> pure x

See also: optional.

sepBy :: MonadPlus m => m a -> m sep -> m [a] #

sepBy p sep parses zero or more occurrences of p, separated by sep. Returns a list of values returned by p.

commaSep p = p `sepBy` comma

sepBy1 :: MonadPlus m => m a -> m sep -> m [a] #

sepBy1 p sep parses one or more occurrences of p, separated by sep. Returns a list of values returned by p.

sepEndBy :: MonadPlus m => m a -> m sep -> m [a] #

sepEndBy p sep parses zero or more occurrences of p, separated and optionally ended by sep. Returns a list of values returned by p.

sepEndBy1 :: MonadPlus m => m a -> m sep -> m [a] #

sepEndBy1 p sep parses one or more occurrences of p, separated and optionally ended by sep. Returns a list of values returned by p.

skipMany :: MonadPlus m => m a -> m () #

skipMany p applies the parser p zero or more times, skipping its result.

See also: manyTill, skipManyTill.

skipSome :: MonadPlus m => m a -> m () #

skipSome p applies the parser p one or more times, skipping its result.

See also: someTill, skipSomeTill.

skipCount :: Monad m => Int -> m a -> m () #

skipCount n p parses n occurrences of p, skipping its result. If n is smaller or equal to zero, the parser equals to return []. Returns a list of n values.

See also: count, count'.

skipManyTill :: MonadPlus m => m a -> m end -> m end #

skipManyTill p end applies the parser p zero or more times skipping results until parser end succeeds. Result parsed by end is then returned.

See also: manyTill, skipMany.

skipSomeTill :: MonadPlus m => m a -> m end -> m end #

skipSomeTill p end applies the parser p one or more times skipping results until parser end succeeds. Result parsed by end is then returned.

See also: someTill, skipSome.