{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RankNTypes #-}

{-|
Module      : Text.XML.Expat.StreamParser
Description : Streaming parsers using hexpat
Copyright   : (c) Kristof Bastiaensen, 2020
License     : BSD-3
Maintainer  : kristof@resonata.be
Stability   : unstable
Portability : ghc

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`.
-}

module Text.XML.Expat.StreamParser
  (
    -- * Event parser datatype
    EventListParser
  , EventParser
  , EventLoc
  , EventParseError (..)
  , mapParser
  , runEventParser
  , customError
  , -- * Running parsers
    parseXMLByteString
  , parseXMLFile
  , -- * Attribute parsers
    AttrParser
  , ParseAttr
  , getAttr
  , peekAttr
  , findAttr
  , skipAttrs
  , noAttrs
  , -- * Event parsers
    someTag
  , skipTag
  , skipTags
  , skipTagsTill
  , tag
  , someEmptyTag
  , emptyTag
  , text
    -- * Re-exports from "Control.Applicative.Combinators"
  ,  (C.<|>)
  , C.optional
  , C.empty
    -- * Re-exports from "Control.Monad.Combinators"
  , C.between
  , C.choice
  , count
  , count'
  , C.eitherP
  , endBy
  , endBy1
  , many
  , manyTill
  , manyTill_
  , C.some
  , someTill
  , someTill_
  , C.option
  , sepBy
  , sepBy1
  , sepEndBy
  , sepEndBy1
  , skipMany
  , skipSome
  , skipCount
  , skipManyTill
  , skipSomeTill
  ) where

import Control.Applicative hiding (many)
import Control.Monad.Combinators as C
import Control.Monad.Error.Class
import Control.Monad.CPSExcept
import Control.Monad.Fail
import Control.Monad.State hiding (fail, lift)
import Control.Monad.Trans (lift)
import qualified Data.ByteString.Lazy as LazyBS
import System.IO
import Data.Functor.Identity
import Data.Bifunctor
import Data.String
import qualified Data.List.Class as List
import Data.List.Class (ItemM, List, ListItem(..))
import qualified Data.Text as Text
import Data.Text (Text)
import Text.XML.Expat.SAX as Expat
import Data.List (nub)

type EventLoc = (SAXEvent Text Text, XMLParseLocation)

type Attrs = [(Text, Text)]

data SAXStream l = Ordered (ListItem l EventLoc)

data ParserState l = ParserState Bool (SAXStream l)

data EventParseError e =
  EndOfSaxStream |
  Empty |
  ExpectedTag |
  UnMatchedTag |
  ExpectedCloseTag |
  XmlError XMLParseError |
  AttributeNotFound Text Text |
  UnknownAttributes [Text]|
  Expected [Text] |
  CustomError e
  deriving (Int -> EventParseError e -> ShowS
[EventParseError e] -> ShowS
EventParseError e -> String
(Int -> EventParseError e -> ShowS)
-> (EventParseError e -> String)
-> ([EventParseError e] -> ShowS)
-> Show (EventParseError e)
forall e. Show e => Int -> EventParseError e -> ShowS
forall e. Show e => [EventParseError e] -> ShowS
forall e. Show e => EventParseError e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventParseError e] -> ShowS
$cshowList :: forall e. Show e => [EventParseError e] -> ShowS
show :: EventParseError e -> String
$cshow :: forall e. Show e => EventParseError e -> String
showsPrec :: Int -> EventParseError e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> EventParseError e -> ShowS
Show, EventParseError e -> EventParseError e -> Bool
(EventParseError e -> EventParseError e -> Bool)
-> (EventParseError e -> EventParseError e -> Bool)
-> Eq (EventParseError e)
forall e. Eq e => EventParseError e -> EventParseError e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventParseError e -> EventParseError e -> Bool
$c/= :: forall e. Eq e => EventParseError e -> EventParseError e -> Bool
== :: EventParseError e -> EventParseError e -> Bool
$c== :: forall e. Eq e => EventParseError e -> EventParseError e -> Bool
Eq)

data AttrParserError e =
  AttrRequired Text |
  AttrEmpty |
  CustomAttrError e
  deriving (Int -> AttrParserError e -> ShowS
[AttrParserError e] -> ShowS
AttrParserError e -> String
(Int -> AttrParserError e -> ShowS)
-> (AttrParserError e -> String)
-> ([AttrParserError e] -> ShowS)
-> Show (AttrParserError e)
forall e. Show e => Int -> AttrParserError e -> ShowS
forall e. Show e => [AttrParserError e] -> ShowS
forall e. Show e => AttrParserError e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttrParserError e] -> ShowS
$cshowList :: forall e. Show e => [AttrParserError e] -> ShowS
show :: AttrParserError e -> String
$cshow :: forall e. Show e => AttrParserError e -> String
showsPrec :: Int -> AttrParserError e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> AttrParserError e -> ShowS
Show, AttrParserError e -> AttrParserError e -> Bool
(AttrParserError e -> AttrParserError e -> Bool)
-> (AttrParserError e -> AttrParserError e -> Bool)
-> Eq (AttrParserError e)
forall e. Eq e => AttrParserError e -> AttrParserError e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttrParserError e -> AttrParserError e -> Bool
$c/= :: forall e. Eq e => AttrParserError e -> AttrParserError e -> Bool
== :: AttrParserError e -> AttrParserError e -> Bool
$c== :: forall e. Eq e => AttrParserError e -> AttrParserError e -> Bool
Eq)

-- | semigroup instance concatenates Expected tags.
instance Semigroup (EventParseError e) where
  EventParseError e
e <> :: EventParseError e -> EventParseError e -> EventParseError e
<> EventParseError e
Empty = EventParseError e
e
  Expected [Text]
t <> Expected [Text]
s = [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
Expected ([Text] -> EventParseError e) -> [Text] -> EventParseError e
forall a b. (a -> b) -> a -> b
$ [Text]
t [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
s
  AttributeNotFound Text
t Text
_ <> Expected [Text]
s = [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
Expected ([Text] -> EventParseError e) -> [Text] -> EventParseError e
forall a b. (a -> b) -> a -> b
$ Text
tText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
s
  Expected [Text]
t <> AttributeNotFound Text
s Text
_ = [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
Expected ([Text] -> EventParseError e) -> [Text] -> EventParseError e
forall a b. (a -> b) -> a -> b
$ [Text]
t [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
s]
  AttributeNotFound Text
s Text
_ <> AttributeNotFound Text
t Text
_ =
    [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
Expected ([Text] -> EventParseError e) -> [Text] -> EventParseError e
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text
s, Text
t]
  EventParseError e
_ <> EventParseError e
e = EventParseError e
e

instance Monoid (EventParseError e) where
  mempty :: EventParseError e
mempty = EventParseError e
forall e. EventParseError e
Empty

-- | 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.
type EventListParser e a = EventParser [] e Identity a
     
-- | 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.
newtype EventParser l e m a = EventParser
  { EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser :: CPSExceptT (EventParseError e) (StateT (ParserState l) m)
                      a
  } deriving (a -> EventParser l e m b -> EventParser l e m a
(a -> b) -> EventParser l e m a -> EventParser l e m b
(forall a b.
 (a -> b) -> EventParser l e m a -> EventParser l e m b)
-> (forall a b. a -> EventParser l e m b -> EventParser l e m a)
-> Functor (EventParser l e m)
forall a b. a -> EventParser l e m b -> EventParser l e m a
forall a b. (a -> b) -> EventParser l e m a -> EventParser l e m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (l :: * -> *) e (m :: * -> *) a b.
a -> EventParser l e m b -> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a b.
(a -> b) -> EventParser l e m a -> EventParser l e m b
<$ :: a -> EventParser l e m b -> EventParser l e m a
$c<$ :: forall (l :: * -> *) e (m :: * -> *) a b.
a -> EventParser l e m b -> EventParser l e m a
fmap :: (a -> b) -> EventParser l e m a -> EventParser l e m b
$cfmap :: forall (l :: * -> *) e (m :: * -> *) a b.
(a -> b) -> EventParser l e m a -> EventParser l e m b
Functor, Functor (EventParser l e m)
a -> EventParser l e m a
Functor (EventParser l e m)
-> (forall a. a -> EventParser l e m a)
-> (forall a b.
    EventParser l e m (a -> b)
    -> EventParser l e m a -> EventParser l e m b)
-> (forall a b c.
    (a -> b -> c)
    -> EventParser l e m a
    -> EventParser l e m b
    -> EventParser l e m c)
-> (forall a b.
    EventParser l e m a -> EventParser l e m b -> EventParser l e m b)
-> (forall a b.
    EventParser l e m a -> EventParser l e m b -> EventParser l e m a)
-> Applicative (EventParser l e m)
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
EventParser l e m (a -> b)
-> EventParser l e m a -> EventParser l e m b
(a -> b -> c)
-> EventParser l e m a
-> EventParser l e m b
-> EventParser l e m c
forall a. a -> EventParser l e m a
forall a b.
EventParser l e m a -> EventParser l e m b -> EventParser l e m a
forall a b.
EventParser l e m a -> EventParser l e m b -> EventParser l e m b
forall a b.
EventParser l e m (a -> b)
-> EventParser l e m a -> EventParser l e m b
forall a b c.
(a -> b -> c)
-> EventParser l e m a
-> EventParser l e m b
-> EventParser l e m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (l :: * -> *) e (m :: * -> *).
Monad m =>
Functor (EventParser l e m)
forall (l :: * -> *) e (m :: * -> *) a.
Monad m =>
a -> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m a -> EventParser l e m b -> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m a -> EventParser l e m b -> EventParser l e m b
forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m (a -> b)
-> EventParser l e m a -> EventParser l e m b
forall (l :: * -> *) e (m :: * -> *) a b c.
Monad m =>
(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 a
$c<* :: forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m a -> EventParser l e m b -> EventParser l e m a
*> :: EventParser l e m a -> EventParser l e m b -> EventParser l e m b
$c*> :: forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m a -> EventParser l e m b -> EventParser l e m b
liftA2 :: (a -> b -> c)
-> EventParser l e m a
-> EventParser l e m b
-> EventParser l e m c
$cliftA2 :: forall (l :: * -> *) e (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> EventParser l e m a
-> EventParser l e m b
-> EventParser l e m c
<*> :: EventParser l e m (a -> b)
-> EventParser l e m a -> EventParser l e m b
$c<*> :: forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m (a -> b)
-> EventParser l e m a -> EventParser l e m b
pure :: a -> EventParser l e m a
$cpure :: forall (l :: * -> *) e (m :: * -> *) a.
Monad m =>
a -> EventParser l e m a
$cp1Applicative :: forall (l :: * -> *) e (m :: * -> *).
Monad m =>
Functor (EventParser l e m)
Applicative, Applicative (EventParser l e m)
a -> EventParser l e m a
Applicative (EventParser l e m)
-> (forall a b.
    EventParser l e m a
    -> (a -> EventParser l e m b) -> EventParser l e m b)
-> (forall a b.
    EventParser l e m a -> EventParser l e m b -> EventParser l e m b)
-> (forall a. a -> EventParser l e m a)
-> Monad (EventParser l e m)
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
forall a. a -> EventParser l e m a
forall a b.
EventParser l e m a -> EventParser l e m b -> EventParser l e m b
forall a b.
EventParser l e m a
-> (a -> EventParser l e m b) -> EventParser l e m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
forall (l :: * -> *) e (m :: * -> *).
Monad m =>
Applicative (EventParser l e m)
forall (l :: * -> *) e (m :: * -> *) a.
Monad m =>
a -> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m a -> EventParser l e m b -> EventParser l e m b
forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m a
-> (a -> EventParser l e m b) -> EventParser l e m b
return :: a -> EventParser l e m a
$creturn :: forall (l :: * -> *) e (m :: * -> *) a.
Monad m =>
a -> EventParser l e m a
>> :: EventParser l e m a -> EventParser l e m b -> EventParser l e m b
$c>> :: forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m a -> EventParser l e m b -> EventParser l e m b
>>= :: EventParser l e m a
-> (a -> EventParser l e m b) -> EventParser l e m b
$c>>= :: forall (l :: * -> *) e (m :: * -> *) a b.
Monad m =>
EventParser l e m a
-> (a -> EventParser l e m b) -> EventParser l e m b
$cp1Monad :: forall (l :: * -> *) e (m :: * -> *).
Monad m =>
Applicative (EventParser l e m)
Monad, MonadError (EventParseError e))

-- | Change the base monad of a parser
mapParser :: (Monad m, Monad n)
          => (forall b . m b -> n b)
          -> EventParser l e m a -> EventParser l e n a
mapParser :: (forall b. m b -> n b)
-> EventParser l e m a -> EventParser l e n a
mapParser forall b. m b -> n b
tr (EventParser CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
parser) =
  CPSExceptT (EventParseError e) (StateT (ParserState l) n) a
-> EventParser l e n a
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT (EventParseError e) (StateT (ParserState l) n) a
 -> EventParser l e n a)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) n) a
-> EventParser l e n a
forall a b. (a -> b) -> a -> b
$ (StateT (ParserState l) m (Either (EventParseError e) a)
 -> StateT (ParserState l) n (Either (EventParseError e) a))
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) n) a
forall (m :: * -> *) (n :: * -> *) e a e' b.
(Monad m, Monad n) =>
(m (Either e a) -> n (Either e' b))
-> CPSExceptT e m a -> CPSExceptT e' n b
mapCPSExceptT ((m (Either (EventParseError e) a, ParserState l)
 -> n (Either (EventParseError e) a, ParserState l))
-> StateT (ParserState l) m (Either (EventParseError e) a)
-> StateT (ParserState l) n (Either (EventParseError e) a)
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT m (Either (EventParseError e) a, ParserState l)
-> n (Either (EventParseError e) a, ParserState l)
forall b. m b -> n b
tr) CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
parser

-- | 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).
customError :: Monad m => e -> EventParser l e m a
customError :: e -> EventParser l e m a
customError = EventParseError e -> EventParser l e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e -> EventParser l e m a)
-> (e -> EventParseError e) -> e -> EventParser l e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> EventParseError e
forall e. e -> EventParseError e
CustomError

instance (Monad m, IsString e) => MonadFail (EventParser l e m) where
  fail :: String -> EventParser l e m a
fail = EventParseError e -> EventParser l e m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e -> EventParser l e m a)
-> (String -> EventParseError e) -> String -> EventParser l e m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> EventParseError e
forall e. e -> EventParseError e
CustomError (e -> EventParseError e)
-> (String -> e) -> String -> EventParseError e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> e
forall a. IsString a => String -> a
fromString

-- | A parser for the attributes of a single tag, that returns a value
-- of type a.  Custom error messages are possible of type e.
newtype AttrParser e a = AttrParser
  { AttrParser e a -> StateT Attrs (Either (AttrParserError e)) a
runAttrParser :: StateT Attrs (Either (AttrParserError e)) a
  } deriving (a -> AttrParser e b -> AttrParser e a
(a -> b) -> AttrParser e a -> AttrParser e b
(forall a b. (a -> b) -> AttrParser e a -> AttrParser e b)
-> (forall a b. a -> AttrParser e b -> AttrParser e a)
-> Functor (AttrParser e)
forall a b. a -> AttrParser e b -> AttrParser e a
forall a b. (a -> b) -> AttrParser e a -> AttrParser e b
forall e a b. a -> AttrParser e b -> AttrParser e a
forall e a b. (a -> b) -> AttrParser e a -> AttrParser e b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> AttrParser e b -> AttrParser e a
$c<$ :: forall e a b. a -> AttrParser e b -> AttrParser e a
fmap :: (a -> b) -> AttrParser e a -> AttrParser e b
$cfmap :: forall e a b. (a -> b) -> AttrParser e a -> AttrParser e b
Functor, Functor (AttrParser e)
a -> AttrParser e a
Functor (AttrParser e)
-> (forall a. a -> AttrParser e a)
-> (forall a b.
    AttrParser e (a -> b) -> AttrParser e a -> AttrParser e b)
-> (forall a b c.
    (a -> b -> c)
    -> AttrParser e a -> AttrParser e b -> AttrParser e c)
-> (forall a b. AttrParser e a -> AttrParser e b -> AttrParser e b)
-> (forall a b. AttrParser e a -> AttrParser e b -> AttrParser e a)
-> Applicative (AttrParser e)
AttrParser e a -> AttrParser e b -> AttrParser e b
AttrParser e a -> AttrParser e b -> AttrParser e a
AttrParser e (a -> b) -> AttrParser e a -> AttrParser e b
(a -> b -> c) -> AttrParser e a -> AttrParser e b -> AttrParser e c
forall e. Functor (AttrParser e)
forall a. a -> AttrParser e a
forall e a. a -> AttrParser e a
forall a b. AttrParser e a -> AttrParser e b -> AttrParser e a
forall a b. AttrParser e a -> AttrParser e b -> AttrParser e b
forall a b.
AttrParser e (a -> b) -> AttrParser e a -> AttrParser e b
forall e a b. AttrParser e a -> AttrParser e b -> AttrParser e a
forall e a b. AttrParser e a -> AttrParser e b -> AttrParser e b
forall e a b.
AttrParser e (a -> b) -> AttrParser e a -> AttrParser e b
forall a b c.
(a -> b -> c) -> AttrParser e a -> AttrParser e b -> AttrParser e c
forall e a b c.
(a -> b -> c) -> AttrParser e a -> AttrParser e b -> AttrParser e c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: AttrParser e a -> AttrParser e b -> AttrParser e a
$c<* :: forall e a b. AttrParser e a -> AttrParser e b -> AttrParser e a
*> :: AttrParser e a -> AttrParser e b -> AttrParser e b
$c*> :: forall e a b. AttrParser e a -> AttrParser e b -> AttrParser e b
liftA2 :: (a -> b -> c) -> AttrParser e a -> AttrParser e b -> AttrParser e c
$cliftA2 :: forall e a b c.
(a -> b -> c) -> AttrParser e a -> AttrParser e b -> AttrParser e c
<*> :: AttrParser e (a -> b) -> AttrParser e a -> AttrParser e b
$c<*> :: forall e a b.
AttrParser e (a -> b) -> AttrParser e a -> AttrParser e b
pure :: a -> AttrParser e a
$cpure :: forall e a. a -> AttrParser e a
$cp1Applicative :: forall e. Functor (AttrParser e)
Applicative, Applicative (AttrParser e)
a -> AttrParser e a
Applicative (AttrParser e)
-> (forall a b.
    AttrParser e a -> (a -> AttrParser e b) -> AttrParser e b)
-> (forall a b. AttrParser e a -> AttrParser e b -> AttrParser e b)
-> (forall a. a -> AttrParser e a)
-> Monad (AttrParser e)
AttrParser e a -> (a -> AttrParser e b) -> AttrParser e b
AttrParser e a -> AttrParser e b -> AttrParser e b
forall e. Applicative (AttrParser e)
forall a. a -> AttrParser e a
forall e a. a -> AttrParser e a
forall a b. AttrParser e a -> AttrParser e b -> AttrParser e b
forall a b.
AttrParser e a -> (a -> AttrParser e b) -> AttrParser e b
forall e a b. AttrParser e a -> AttrParser e b -> AttrParser e b
forall e a b.
AttrParser e a -> (a -> AttrParser e b) -> AttrParser e b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> AttrParser e a
$creturn :: forall e a. a -> AttrParser e a
>> :: AttrParser e a -> AttrParser e b -> AttrParser e b
$c>> :: forall e a b. AttrParser e a -> AttrParser e b -> AttrParser e b
>>= :: AttrParser e a -> (a -> AttrParser e b) -> AttrParser e b
$c>>= :: forall e a b.
AttrParser e a -> (a -> AttrParser e b) -> AttrParser e b
$cp1Monad :: forall e. Applicative (AttrParser e)
Monad, MonadError (AttrParserError e))

instance Alternative (AttrParser e) where
  AttrParser e a
p <|> :: AttrParser e a -> AttrParser e a -> AttrParser e a
<|> AttrParser e a
q = AttrParser e a
p AttrParser e a
-> (AttrParserError e -> AttrParser e a) -> AttrParser e a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` AttrParser e a -> AttrParserError e -> AttrParser e a
forall a b. a -> b -> a
const AttrParser e a
q
  empty :: AttrParser e a
empty = AttrParserError e -> AttrParser e a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError AttrParserError e
forall e. AttrParserError e
AttrEmpty

instance Semigroup a => Semigroup (AttrParser e a) where
  <> :: AttrParser e a -> AttrParser e a -> AttrParser e a
(<>) = (a -> a -> a) -> AttrParser e a -> AttrParser e a -> AttrParser e a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance Monoid a => Monoid (AttrParser e a) where
  mempty :: AttrParser e a
mempty = a -> AttrParser e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

-- | A parser for the value of an attribute
class ParseAttr e a where
  parseAttr :: Text -> Either e a

instance ParseAttr e Text where
  parseAttr :: Text -> Either e Text
parseAttr = Text -> Either e Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance MonadTrans (EventParser l e) where
  lift :: m a -> EventParser l e m a
lift m a
m = CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
 -> EventParser l e m a)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall a b. (a -> b) -> a -> b
$ StateT (ParserState l) m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (ParserState l) m a
 -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> StateT (ParserState l) m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall a b. (a -> b) -> a -> b
$ m a -> StateT (ParserState l) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m

-- set consumed state, and return old consumed state
setConsumedState :: Monad m => Bool -> EventParser l e m Bool
setConsumedState :: Bool -> EventParser l e m Bool
setConsumedState Bool
newState = CPSExceptT (EventParseError e) (StateT (ParserState l) m) Bool
-> EventParser l e m Bool
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT (EventParseError e) (StateT (ParserState l) m) Bool
 -> EventParser l e m Bool)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) Bool
-> EventParser l e m Bool
forall a b. (a -> b) -> a -> b
$ do
  ParserState Bool
oldState SAXStream l
stream <- CPSExceptT
  (EventParseError e) (StateT (ParserState l) m) (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
  ParserState l
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ())
-> ParserState l
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
newState SAXStream l
stream
  Bool
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
oldState

-- combine old and new consumed state
updateConsumedState :: Monad m => Bool -> EventParser l e m ()
updateConsumedState :: Bool -> EventParser l e m ()
updateConsumedState Bool
oldState = CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
-> EventParser l e m ()
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
 -> EventParser l e m ())
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
-> EventParser l e m ()
forall a b. (a -> b) -> a -> b
$ do
  ParserState Bool
newState SAXStream l
stream <- CPSExceptT
  (EventParseError e) (StateT (ParserState l) m) (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
  ParserState l
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ())
-> ParserState l
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState (Bool
oldState Bool -> Bool -> Bool
|| Bool
newState) SAXStream l
stream

instance Monad m => Alternative (EventParser l e m) where
  EventParser CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
p <|> :: EventParser l e m a -> EventParser l e m a -> EventParser l e m a
<|> EventParser CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
q = CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
 -> EventParser l e m a)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall a b. (a -> b) -> a -> b
$ do
    -- clear consumed state
    Bool
oldConsumedState <- EventParser l e m Bool
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) Bool
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e m Bool
 -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) Bool)
-> EventParser l e m Bool
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) Bool
forall a b. (a -> b) -> a -> b
$ Bool -> EventParser l e m Bool
forall (m :: * -> *) (l :: * -> *) e.
Monad m =>
Bool -> EventParser l e m Bool
setConsumedState Bool
False
    a
res <- CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> (EventParseError e
    -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
p ((EventParseError e
  -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
 -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> (EventParseError e
    -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall a b. (a -> b) -> a -> b
$ \EventParseError e
err -> do
      ParserState Bool
pConsumed SAXStream l
_ <- CPSExceptT
  (EventParseError e) (StateT (ParserState l) m) (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
      if Bool
pConsumed
        -- don't backtrack when already consumed some state
        then EventParseError e
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
err
        else CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> (EventParseError e
    -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
q ((EventParseError e
  -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
 -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> (EventParseError e
    -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall a b. (a -> b) -> a -> b
$ \EventParseError e
err2 ->
        do ParserState Bool
qConsumed SAXStream l
_ <- CPSExceptT
  (EventParseError e) (StateT (ParserState l) m) (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
           if Bool
qConsumed
             then EventParseError e
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
err2
             else do
             -- if nothing consumed, then reset consumed state and
             -- combine error messages
             EventParser l e m ()
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e m ()
 -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ())
-> EventParser l e m ()
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> EventParser l e m ()
forall (m :: * -> *) (l :: * -> *) e.
Monad m =>
Bool -> EventParser l e m ()
updateConsumedState Bool
oldConsumedState
             EventParseError e
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
err EventParseError e -> EventParseError e -> EventParseError e
forall a. Semigroup a => a -> a -> a
<> EventParseError e
err2)
    EventParser l e m ()
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e m ()
 -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ())
-> EventParser l e m ()
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall a b. (a -> b) -> a -> b
$ Bool -> EventParser l e m ()
forall (m :: * -> *) (l :: * -> *) e.
Monad m =>
Bool -> EventParser l e m ()
updateConsumedState Bool
oldConsumedState
    a -> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
res

  empty :: EventParser l e m a
empty = CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
 -> EventParser l e m a)
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall a b. (a -> b) -> a -> b
$ EventParseError e
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
Empty

instance Monad m => MonadPlus (EventParser l e m) where
  mplus :: EventParser l e m a -> EventParser l e m a -> EventParser l e m a
mplus = EventParser l e m a -> EventParser l e m a -> EventParser l e m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
  mzero :: EventParser l e m a
mzero = EventParser l e m a
forall (f :: * -> *) a. Alternative f => f a
empty

instance (Monad m, Semigroup a) => Semigroup (EventParser l e m a) where
  <> :: EventParser l e m a -> EventParser l e m a -> EventParser l e m a
(<>) = (a -> a -> a)
-> EventParser l e m a
-> EventParser l e m a
-> EventParser l e m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Monad m, Monoid a) => Monoid (EventParser l e m a) where
  mempty :: EventParser l e m a
mempty = a -> EventParser l e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

-- run a parser
runEventParser
  :: 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)
runEventParser :: EventParser l e (ItemM l) a
-> l EventLoc
-> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a)
runEventParser (EventParser CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
parser) l EventLoc
events = do
  ListItem l EventLoc
firstItem <- l EventLoc -> ItemM l (ListItem l EventLoc)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
List.runList l EventLoc
events
  let initState :: ParserState l
initState = Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
False (ListItem l EventLoc -> SAXStream l
forall (l :: * -> *). ListItem l EventLoc -> SAXStream l
Ordered ListItem l EventLoc
firstItem)
  do (Either (EventParseError e) a
a, ParserState Bool
_ (Ordered ListItem l EventLoc
item)) <-
       (StateT (ParserState l) (ItemM l) (Either (EventParseError e) a)
 -> ParserState l
 -> ItemM l (Either (EventParseError e) a, ParserState l))
-> ParserState l
-> StateT (ParserState l) (ItemM l) (Either (EventParseError e) a)
-> ItemM l (Either (EventParseError e) a, ParserState l)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (ParserState l) (ItemM l) (Either (EventParseError e) a)
-> ParserState l
-> ItemM l (Either (EventParseError e) a, ParserState l)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT ParserState l
initState (StateT (ParserState l) (ItemM l) (Either (EventParseError e) a)
 -> ItemM l (Either (EventParseError e) a, ParserState l))
-> StateT (ParserState l) (ItemM l) (Either (EventParseError e) a)
-> ItemM l (Either (EventParseError e) a, ParserState l)
forall a b. (a -> b) -> a -> b
$ CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
-> StateT (ParserState l) (ItemM l) (Either (EventParseError e) a)
forall (m :: * -> *) e a.
Applicative m =>
CPSExceptT e m a -> m (Either e a)
runCPSExceptT CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
parser
     case Either (EventParseError e) a
a of
       Right a
res -> Either (EventParseError e, Maybe XMLParseLocation) a
-> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (EventParseError e, Maybe XMLParseLocation) a
 -> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a))
-> Either (EventParseError e, Maybe XMLParseLocation) a
-> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a)
forall a b. (a -> b) -> a -> b
$ a -> Either (EventParseError e, Maybe XMLParseLocation) a
forall a b. b -> Either a b
Right a
res
       Left EventParseError e
err -> Either (EventParseError e, Maybe XMLParseLocation) a
-> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (EventParseError e, Maybe XMLParseLocation) a
 -> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a))
-> Either (EventParseError e, Maybe XMLParseLocation) a
-> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a)
forall a b. (a -> b) -> a -> b
$ (EventParseError e, Maybe XMLParseLocation)
-> Either (EventParseError e, Maybe XMLParseLocation) a
forall a b. a -> Either a b
Left ((EventParseError e, Maybe XMLParseLocation)
 -> Either (EventParseError e, Maybe XMLParseLocation) a)
-> (EventParseError e, Maybe XMLParseLocation)
-> Either (EventParseError e, Maybe XMLParseLocation) a
forall a b. (a -> b) -> a -> b
$ case ListItem l EventLoc
item of
         ListItem l EventLoc
Nil -> (EventParseError e
err, Maybe XMLParseLocation
forall a. Maybe a
Nothing)
         (Cons (SAXEvent Text Text
_, XMLParseLocation
loc) l EventLoc
_) -> (EventParseError e
err, XMLParseLocation -> Maybe XMLParseLocation
forall a. a -> Maybe a
Just XMLParseLocation
loc)

-- | 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.
parseXMLByteString :: EventListParser e a
                   -> Expat.ParseOptions Text Text
                   -> LazyBS.ByteString
                   -> Either (EventParseError e, Maybe XMLParseLocation) a
parseXMLByteString :: EventListParser e a
-> ParseOptions Text Text
-> ByteString
-> Either (EventParseError e, Maybe XMLParseLocation) a
parseXMLByteString EventListParser e a
parser ParseOptions Text Text
parseOptions ByteString
bs =
  Identity (Either (EventParseError e, Maybe XMLParseLocation) a)
-> Either (EventParseError e, Maybe XMLParseLocation) a
forall a. Identity a -> a
runIdentity (Identity (Either (EventParseError e, Maybe XMLParseLocation) a)
 -> Either (EventParseError e, Maybe XMLParseLocation) a)
-> Identity (Either (EventParseError e, Maybe XMLParseLocation) a)
-> Either (EventParseError e, Maybe XMLParseLocation) a
forall a b. (a -> b) -> a -> b
$ EventParser [] e (ItemM []) a
-> [EventLoc]
-> ItemM [] (Either (EventParseError e, Maybe XMLParseLocation) a)
forall (l :: * -> *) e a.
List l =>
EventParser l e (ItemM l) a
-> l EventLoc
-> ItemM l (Either (EventParseError e, Maybe XMLParseLocation) a)
runEventParser EventParser [] e (ItemM []) a
EventListParser e a
parser ([EventLoc]
 -> ItemM [] (Either (EventParseError e, Maybe XMLParseLocation) a))
-> [EventLoc]
-> ItemM [] (Either (EventParseError e, Maybe XMLParseLocation) a)
forall a b. (a -> b) -> a -> b
$ ParseOptions Text Text -> ByteString -> [EventLoc]
forall tag text.
(GenericXMLString tag, GenericXMLString text) =>
ParseOptions tag text
-> ByteString -> [(SAXEvent tag text, XMLParseLocation)]
Expat.parseLocations ParseOptions Text Text
parseOptions ByteString
bs

-- | Lazily parse an xml file into a value.  This function ensures the
--  input is consumed and the file handle closed, before returning the
--  value.
parseXMLFile :: Expat.ParseOptions Text Text
             -> IOMode
             -> FilePath
             -> EventListParser e a
             -> IO (Either (EventParseError e, Maybe XMLParseLocation) a)
parseXMLFile :: ParseOptions Text Text
-> IOMode
-> String
-> EventListParser e a
-> IO (Either (EventParseError e, Maybe XMLParseLocation) a)
parseXMLFile ParseOptions Text Text
parseOptions IOMode
mode String
fp EventListParser e a
parser =
  String
-> IOMode
-> (Handle
    -> IO (Either (EventParseError e, Maybe XMLParseLocation) a))
-> IO (Either (EventParseError e, Maybe XMLParseLocation) a)
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
fp IOMode
mode ((Handle
  -> IO (Either (EventParseError e, Maybe XMLParseLocation) a))
 -> IO (Either (EventParseError e, Maybe XMLParseLocation) a))
-> (Handle
    -> IO (Either (EventParseError e, Maybe XMLParseLocation) a))
-> IO (Either (EventParseError e, Maybe XMLParseLocation) a)
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
  ByteString
bs <- Handle -> IO ByteString
LazyBS.hGetContents Handle
h
  Either (EventParseError e, Maybe XMLParseLocation) a
-> IO (Either (EventParseError e, Maybe XMLParseLocation) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (EventParseError e, Maybe XMLParseLocation) a
 -> IO (Either (EventParseError e, Maybe XMLParseLocation) a))
-> Either (EventParseError e, Maybe XMLParseLocation) a
-> IO (Either (EventParseError e, Maybe XMLParseLocation) a)
forall a b. (a -> b) -> a -> b
$! EventListParser e a
-> ParseOptions Text Text
-> ByteString
-> Either (EventParseError e, Maybe XMLParseLocation) a
forall e a.
EventListParser e a
-> ParseOptions Text Text
-> ByteString
-> Either (EventParseError e, Maybe XMLParseLocation) a
parseXMLByteString EventListParser e a
parser ParseOptions Text Text
parseOptions ByteString
bs

-- skip to next open tag.  Skip whitespace text if any. This doesn't
-- consume any tags.
skipToNextTag :: forall l e. (List l, Monad (ItemM l))
              => Maybe Text -> EventParser l e (ItemM l) ()
skipToNextTag :: Maybe Text -> EventParser l e (ItemM l) ()
skipToNextTag Maybe Text
expectedTag =
  CPSExceptT
  (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
-> EventParser l e (ItemM l) ()
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT
   (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
 -> EventParser l e (ItemM l) ())
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
-> EventParser l e (ItemM l) ()
forall a b. (a -> b) -> a -> b
$ do
    ParserState Bool
consumed (Ordered ListItem l EventLoc
firstItem) <- CPSExceptT
  (EventParseError e)
  (StateT (ParserState l) (ItemM l))
  (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
    let loop :: ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
loop ListItem l EventLoc
item =
          case ListItem l EventLoc
item of
            ListItem l EventLoc
Nil -> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
EndOfSaxStream
            list :: ListItem l EventLoc
list@(Cons (SAXEvent Text Text
eventTag, XMLParseLocation
_loc) l EventLoc
next) ->
              case SAXEvent Text Text
eventTag of
                StartElement Text
_ Attrs
_ -> ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListItem l EventLoc
list
                EndElement Text
_ -> do
                  ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
consumed (ListItem l EventLoc -> SAXStream l
forall (l :: * -> *). ListItem l EventLoc -> SAXStream l
Ordered ListItem l EventLoc
list)
                  EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l EventLoc))
-> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ case Maybe Text
expectedTag of
                    Maybe Text
Nothing -> EventParseError e
forall e. EventParseError e
ExpectedTag
                    Just Text
t -> [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
Expected [Text
t]
                CharacterData Text
t
                  | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
Text.all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t\r\n" :: String)) Text
t) -> ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListItem l EventLoc
list
                FailDocument XMLParseError
err -> do
                  ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
consumed (ListItem l EventLoc -> SAXStream l
forall (l :: * -> *). ListItem l EventLoc -> SAXStream l
Ordered ListItem l EventLoc
list)
                  EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l EventLoc))
-> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ XMLParseError -> EventParseError e
forall e. XMLParseError -> EventParseError e
XmlError XMLParseError
err
                SAXEvent Text Text
_ -> do
                  ListItem l EventLoc
nextItem <- EventParser l e (ItemM l) (ListItem l EventLoc)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l EventLoc)
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l EventLoc))
-> EventParser l e (ItemM l) (ListItem l EventLoc)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ ItemM l (ListItem l EventLoc)
-> EventParser l e (ItemM l) (ListItem l EventLoc)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ItemM l (ListItem l EventLoc)
 -> EventParser l e (ItemM l) (ListItem l EventLoc))
-> ItemM l (ListItem l EventLoc)
-> EventParser l e (ItemM l) (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ l EventLoc -> ItemM l (ListItem l EventLoc)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
List.runList l EventLoc
next
                  ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
loop ListItem l EventLoc
nextItem
    ListItem l EventLoc
lastList <- ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall (l :: * -> *) e.
List l =>
ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
loop ListItem l EventLoc
firstItem
    ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
consumed (ListItem l EventLoc -> SAXStream l
forall (l :: * -> *). ListItem l EventLoc -> SAXStream l
Ordered ListItem l EventLoc
lastList)

-- skip to after closed tag, or raise an error
closeTag :: forall l e. (List l, Monad (ItemM l))
         => Text
         -> EventParser l e (ItemM l) ()
closeTag :: Text -> EventParser l e (ItemM l) ()
closeTag Text
tagName =
  CPSExceptT
  (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
-> EventParser l e (ItemM l) ()
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT
   (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
 -> EventParser l e (ItemM l) ())
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
-> EventParser l e (ItemM l) ()
forall a b. (a -> b) -> a -> b
$ do
    ParserState Bool
consumed (Ordered ListItem l EventLoc
firstItem) <- CPSExceptT
  (EventParseError e)
  (StateT (ParserState l) (ItemM l))
  (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
    let loop :: ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
loop ListItem l EventLoc
item =
          case ListItem l EventLoc
item of
            ListItem l EventLoc
Nil -> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
EndOfSaxStream
            list :: ListItem l EventLoc
list@(Cons (SAXEvent Text Text
eventTag, XMLParseLocation
_loc) l EventLoc
next) ->
              case SAXEvent Text Text
eventTag of
                EndElement Text
tagName2
                  | Text
tagName2 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
tagName ->
                    EventParser l e (ItemM l) (ListItem l EventLoc)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l EventLoc)
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l EventLoc))
-> EventParser l e (ItemM l) (ListItem l EventLoc)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ ItemM l (ListItem l EventLoc)
-> EventParser l e (ItemM l) (ListItem l EventLoc)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ItemM l (ListItem l EventLoc)
 -> EventParser l e (ItemM l) (ListItem l EventLoc))
-> ItemM l (ListItem l EventLoc)
-> EventParser l e (ItemM l) (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ l EventLoc -> ItemM l (ListItem l EventLoc)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
List.runList l EventLoc
next
                  | Bool
otherwise -> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
UnMatchedTag
                StartElement Text
_ Attrs
_ -> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
ExpectedCloseTag
                CharacterData Text
t
                  | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
Text.all (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
" \t\r\n" :: String)) Text
t) ->
                    EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
ExpectedCloseTag
                FailDocument XMLParseError
err -> do
                  ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
consumed (ListItem l EventLoc -> SAXStream l
forall (l :: * -> *). ListItem l EventLoc -> SAXStream l
Ordered ListItem l EventLoc
list)
                  EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l EventLoc))
-> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ XMLParseError -> EventParseError e
forall e. XMLParseError -> EventParseError e
XmlError XMLParseError
err
                SAXEvent Text Text
_ -> do
                  ListItem l EventLoc
nextItem <- EventParser l e (ItemM l) (ListItem l EventLoc)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l EventLoc)
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l EventLoc))
-> EventParser l e (ItemM l) (ListItem l EventLoc)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ ItemM l (ListItem l EventLoc)
-> EventParser l e (ItemM l) (ListItem l EventLoc)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ItemM l (ListItem l EventLoc)
 -> EventParser l e (ItemM l) (ListItem l EventLoc))
-> ItemM l (ListItem l EventLoc)
-> EventParser l e (ItemM l) (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ l EventLoc -> ItemM l (ListItem l EventLoc)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
List.runList l EventLoc
next
                  ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
loop ListItem l EventLoc
nextItem
    ListItem l EventLoc
lastList <- ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall (l :: * -> *) e.
List l =>
ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
loop ListItem l EventLoc
firstItem
    ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
consumed (ListItem l EventLoc -> SAXStream l
forall (l :: * -> *). ListItem l EventLoc -> SAXStream l
Ordered ListItem l EventLoc
lastList)

lookupRemove :: (Eq k) => k -> [(k, v)] -> Maybe (v, [(k, v)])
lookupRemove :: k -> [(k, v)] -> Maybe (v, [(k, v)])
lookupRemove k
_ [] = Maybe (v, [(k, v)])
forall a. Maybe a
Nothing
lookupRemove k
k1 ((k
k2, v
v):[(k, v)]
rest)
  | k
k1 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k2 = (v, [(k, v)]) -> Maybe (v, [(k, v)])
forall a. a -> Maybe a
Just (v
v, [(k, v)]
rest)
  | Bool
otherwise = ([(k, v)] -> [(k, v)]) -> (v, [(k, v)]) -> (v, [(k, v)])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((k
k2, v
v) (k, v) -> [(k, v)] -> [(k, v)]
forall a. a -> [a] -> [a]
:) ((v, [(k, v)]) -> (v, [(k, v)]))
-> Maybe (v, [(k, v)]) -> Maybe (v, [(k, v)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k -> [(k, v)] -> Maybe (v, [(k, v)])
forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
lookupRemove k
k1 [(k, v)]
rest

-- | returns the value for the given attribute.  Fail if the attribute
-- is not found.
getAttr :: ParseAttr e a
        => Text            -- ^ attribute name
        -> AttrParser e a
getAttr :: Text -> AttrParser e a
getAttr Text
attr =
  StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a
forall e a.
StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a
AttrParser (StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a)
-> StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a
forall a b. (a -> b) -> a -> b
$ do
    Attrs
attrs <- StateT Attrs (Either (AttrParserError e)) Attrs
forall s (m :: * -> *). MonadState s m => m s
get
    case Text -> Attrs -> Maybe (Text, Attrs)
forall k v. Eq k => k -> [(k, v)] -> Maybe (v, [(k, v)])
lookupRemove Text
attr Attrs
attrs of
      Maybe (Text, Attrs)
Nothing -> AttrParserError e -> StateT Attrs (Either (AttrParserError e)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AttrParserError e -> StateT Attrs (Either (AttrParserError e)) a)
-> AttrParserError e -> StateT Attrs (Either (AttrParserError e)) a
forall a b. (a -> b) -> a -> b
$ Text -> AttrParserError e
forall e. Text -> AttrParserError e
AttrRequired Text
attr
      Just (Text
v, Attrs
st) -> do
        Attrs -> StateT Attrs (Either (AttrParserError e)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Attrs
st
        (e -> StateT Attrs (Either (AttrParserError e)) a)
-> (a -> StateT Attrs (Either (AttrParserError e)) a)
-> Either e a
-> StateT Attrs (Either (AttrParserError e)) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (AttrParserError e -> StateT Attrs (Either (AttrParserError e)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (AttrParserError e -> StateT Attrs (Either (AttrParserError e)) a)
-> (e -> AttrParserError e)
-> e
-> StateT Attrs (Either (AttrParserError e)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> AttrParserError e
forall e. e -> AttrParserError e
CustomAttrError) a -> StateT Attrs (Either (AttrParserError e)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either e a -> StateT Attrs (Either (AttrParserError e)) a)
-> Either e a -> StateT Attrs (Either (AttrParserError e)) a
forall a b. (a -> b) -> a -> b
$ Text -> Either e a
forall e a. ParseAttr e a => Text -> Either e a
parseAttr Text
v

-- | return the value for the attribute if it exists, otherwise
-- @Nothing@.
findAttr :: ParseAttr e a
         => Text                    -- ^ attribute name
         -> AttrParser e (Maybe a)
findAttr :: Text -> AttrParser e (Maybe a)
findAttr Text
attr =
  AttrParser e (Maybe a)
-> (AttrParserError e -> AttrParser e (Maybe a))
-> AttrParser e (Maybe a)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> AttrParser e a -> AttrParser e (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> AttrParser e a
forall e a. ParseAttr e a => Text -> AttrParser e a
getAttr Text
attr) ((AttrParserError e -> AttrParser e (Maybe a))
 -> AttrParser e (Maybe a))
-> (AttrParserError e -> AttrParser e (Maybe a))
-> AttrParser e (Maybe a)
forall a b. (a -> b) -> a -> b
$ \AttrParserError e
err ->
  case AttrParserError e
err of
    (AttrRequired Text
_) -> Maybe a -> AttrParser e (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
    AttrParserError e
_ -> AttrParserError e -> AttrParser e (Maybe a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError AttrParserError e
err
    
-- | run an attribute parser without consuming any attributes.
peekAttr :: AttrParser e a -> AttrParser e a
peekAttr :: AttrParser e a -> AttrParser e a
peekAttr (AttrParser StateT Attrs (Either (AttrParserError e)) a
attrP) =
  StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a
forall e a.
StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a
AttrParser (StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a)
-> StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a
forall a b. (a -> b) -> a -> b
$ do
    Attrs
attrs <- StateT Attrs (Either (AttrParserError e)) Attrs
forall s (m :: * -> *). MonadState s m => m s
get
    StateT Attrs (Either (AttrParserError e)) a
attrP StateT Attrs (Either (AttrParserError e)) a
-> StateT Attrs (Either (AttrParserError e)) ()
-> StateT Attrs (Either (AttrParserError e)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Attrs -> StateT Attrs (Either (AttrParserError e)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Attrs
attrs

-- | consume all remaining attributes
skipAttrs :: AttrParser e ()
skipAttrs :: AttrParser e ()
skipAttrs = StateT Attrs (Either (AttrParserError e)) () -> AttrParser e ()
forall e a.
StateT Attrs (Either (AttrParserError e)) a -> AttrParser e a
AttrParser (StateT Attrs (Either (AttrParserError e)) () -> AttrParser e ())
-> StateT Attrs (Either (AttrParserError e)) () -> AttrParser e ()
forall a b. (a -> b) -> a -> b
$ Attrs -> StateT Attrs (Either (AttrParserError e)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put []

-- | expect no attributes.  This is the same as `pure ()`
noAttrs :: AttrParser e ()
noAttrs :: AttrParser e ()
noAttrs = () -> AttrParser e ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Parse a tag that succeed on the given test function.  Parses the
-- children in the order or the inner parser.
someTag :: (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
someTag :: (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag = Maybe Text
-> (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
forall (l :: * -> *) e b a.
(Monad (ItemM l), List l) =>
Maybe Text
-> (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag' Maybe Text
forall a. Maybe a
Nothing


-- | Parse a tag that succeed on the given test function.  Parses the
-- children in the order or the inner parser.
someTag' :: (Monad (ItemM l), List l)
         => Maybe Text
         -> (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
someTag' :: Maybe Text
-> (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag' Maybe Text
expectedName Text -> Bool
tagnameTest AttrParser e b
attrParser b -> EventParser l e (ItemM l) a
inner = CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
-> EventParser l e (ItemM l) a
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT
   (EventParseError e) (StateT (ParserState l) (ItemM l)) a
 -> EventParser l e (ItemM l) a)
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
-> EventParser l e (ItemM l) a
forall a b. (a -> b) -> a -> b
$ do
  ()
_ <- EventParser l e (ItemM l) ()
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) ()
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> EventParser l e (ItemM l) ()
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Maybe Text -> EventParser l e (ItemM l) ()
forall (l :: * -> *) e.
(List l, Monad (ItemM l)) =>
Maybe Text -> EventParser l e (ItemM l) ()
skipToNextTag Maybe Text
expectedName
  ParserState Bool
_ SAXStream l
elems <- CPSExceptT
  (EventParseError e)
  (StateT (ParserState l) (ItemM l))
  (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
  case SAXStream l
elems of
    Ordered ListItem l EventLoc
Nil -> EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
EndOfSaxStream
    Ordered (Cons (StartElement Text
tagName Attrs
attrs, XMLParseLocation
_loc) l EventLoc
next)
      | Text -> Bool
tagnameTest Text
tagName ->
          case StateT Attrs (Either (AttrParserError e)) b
-> Attrs -> Either (AttrParserError e) (b, Attrs)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (AttrParser e b -> StateT Attrs (Either (AttrParserError e)) b
forall e a.
AttrParser e a -> StateT Attrs (Either (AttrParserError e)) a
runAttrParser AttrParser e b
attrParser) Attrs
attrs of
            Left AttrParserError e
AttrEmpty -> EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
Empty
            Left (AttrRequired Text
t) -> EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) a)
-> EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall a b. (a -> b) -> a -> b
$ Text -> Text -> EventParseError e
forall e. Text -> Text -> EventParseError e
AttributeNotFound Text
tagName Text
t
            Left (CustomAttrError e
e) -> EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) a)
-> EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall a b. (a -> b) -> a -> b
$ e -> EventParseError e
forall e. e -> EventParseError e
CustomError e
e
            Right (b
attrData, []) -> do
              ListItem l EventLoc
nextItem <- EventParser l e (ItemM l) (ListItem l EventLoc)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l EventLoc)
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l EventLoc))
-> EventParser l e (ItemM l) (ListItem l EventLoc)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ ItemM l (ListItem l EventLoc)
-> EventParser l e (ItemM l) (ListItem l EventLoc)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ItemM l (ListItem l EventLoc)
 -> EventParser l e (ItemM l) (ListItem l EventLoc))
-> ItemM l (ListItem l EventLoc)
-> EventParser l e (ItemM l) (ListItem l EventLoc)
forall a b. (a -> b) -> a -> b
$ l EventLoc -> ItemM l (ListItem l EventLoc)
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
List.runList l EventLoc
next
              ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
True (ListItem l EventLoc -> SAXStream l
forall (l :: * -> *). ListItem l EventLoc -> SAXStream l
Ordered ListItem l EventLoc
nextItem)
              a
result <- EventParser l e (ItemM l) a
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) a
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) a)
-> EventParser l e (ItemM l) a
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall a b. (a -> b) -> a -> b
$ b -> EventParser l e (ItemM l) a
inner b
attrData
              EventParser l e (ItemM l) ()
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) ()
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> EventParser l e (ItemM l) ()
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Text -> EventParser l e (ItemM l) ()
forall (l :: * -> *) e.
(List l, Monad (ItemM l)) =>
Text -> EventParser l e (ItemM l) ()
closeTag Text
tagName
              a
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
            Right (b
_, Attrs
attributes) ->
              EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) a)
-> EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall a b. (a -> b) -> a -> b
$ [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
UnknownAttributes ([Text] -> EventParseError e) -> [Text] -> EventParseError e
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> Attrs -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Text
forall a b. (a, b) -> a
fst Attrs
attributes
      | Bool
otherwise -> CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall a.
CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
tagExpectedError
    Ordered ListItem l EventLoc
_ -> CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall a.
CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
tagExpectedError
    where
      tagExpectedError :: CPSExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
tagExpectedError = EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) a)
-> EventParseError e
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall a b. (a -> b) -> a -> b
$ case Maybe Text
expectedName of
        Maybe Text
Nothing -> EventParseError e
forall e. EventParseError e
ExpectedTag
        Just Text
t -> [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
Expected [Text
t]
{-# INLINABLE someTag #-}    

--  UnOrdered [] -> throwError "Unexpected end of input."
--  UnOrdered lst -> _ 
-- -- | 
-- someUnorderedTag  :: (Monad (ItemM l), List l)
--                   => (Text -> Bool)
--                   -> AttrParser b
--                   -> (b -> EventParser l (ItemM l) a)
--                   -> EventParser l (ItemM l) a
-- someUnorderedTag inner = _
-- | Skip next tag
skipTag :: (Monad (ItemM l), List l) => EventParser l e (ItemM l) ()
skipTag :: EventParser l e (ItemM l) ()
skipTag = (Text -> Bool)
-> AttrParser e ()
-> (() -> EventParser l e (ItemM l) ())
-> EventParser l e (ItemM l) ()
forall (l :: * -> *) e b a.
(Monad (ItemM l), List l) =>
(Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True) AttrParser e ()
forall e. AttrParser e ()
skipAttrs ((() -> EventParser l e (ItemM l) ())
 -> EventParser l e (ItemM l) ())
-> (() -> EventParser l e (ItemM l) ())
-> EventParser l e (ItemM l) ()
forall a b. (a -> b) -> a -> b
$ EventParser l e (ItemM l) () -> () -> EventParser l e (ItemM l) ()
forall a b. a -> b -> a
const EventParser l e (ItemM l) ()
forall (l :: * -> *) e.
(Monad (ItemM l), List l) =>
EventParser l e (ItemM l) ()
skipTags
{-# INLINE skipTag #-}          

-- | Skip remaining tags and text, if any.
skipTags :: (Monad (ItemM l), List l) => EventParser l e(ItemM l) ()
skipTags :: EventParser l e (ItemM l) ()
skipTags = EventParser l e (ItemM l) Text
-> EventParser l e (ItemM l) (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional EventParser l e (ItemM l) Text
forall (l :: * -> *) e.
(Monad (ItemM l), List l) =>
EventParser l e (ItemM l) Text
text EventParser l e (ItemM l) (Maybe Text)
-> EventParser l e (ItemM l) () -> EventParser l e (ItemM l) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventParser l e (ItemM l) () -> EventParser l e (ItemM l) ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany (EventParser l e (ItemM l) ()
forall (l :: * -> *) e.
(Monad (ItemM l), List l) =>
EventParser l e (ItemM l) ()
skipTag EventParser l e (ItemM l) ()
-> EventParser l e (ItemM l) () -> EventParser l e (ItemM l) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EventParser l e (ItemM l) Text -> EventParser l e (ItemM l) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void EventParser l e (ItemM l) Text
forall (l :: * -> *) e.
(Monad (ItemM l), List l) =>
EventParser l e (ItemM l) Text
text)

-- | Skip zero or more tags until the given parser succeeds
skipTagsTill ::
     (Monad (ItemM l), List l)
  => EventParser l e (ItemM l) a
  -> EventParser l e (ItemM l) a
skipTagsTill :: EventParser l e (ItemM l) a -> EventParser l e (ItemM l) a
skipTagsTill = EventParser l e (ItemM l) ()
-> EventParser l e (ItemM l) a -> EventParser l e (ItemM l) a
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
skipManyTill EventParser l e (ItemM l) ()
forall (l :: * -> *) e.
(Monad (ItemM l), List l) =>
EventParser l e (ItemM l) ()
skipTag

-- | Parse a tag with the given name, using the inner parser for the
-- children tags.
tag :: (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
tag :: Text
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
tag Text
name AttrParser e b
attrP b -> EventParser l e (ItemM l) a
children =
  Maybe Text
-> (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
forall (l :: * -> *) e b a.
(Monad (ItemM l), List l) =>
Maybe Text
-> (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag' (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) AttrParser e b
attrP b -> EventParser l e (ItemM l) a
children
    
-- -- | Parse a tag with the given name, using the inner parser for the
-- -- children tags.  The children tags can be in any order.  Note that
-- -- this is less efficient than an orderedTag, since it has to keep
-- -- track of all unmatched tags.
-- -- unorderedTag :: (Monad (ItemM l), List l)
-- --              => Text
-- --              -> AttrParser b
-- --              -> (b -> EventParser l (ItemM l) a)
-- --              -> EventParser l (ItemM l) a
-- -- unorderedTag name = someUnorderedTag (==name)

-- | Parse a tag which should have no children.
someEmptyTag :: (Monad (ItemM l), List l)
             => (Text -> Bool)   -- ^ tag name test
             -> AttrParser e b   -- ^ attribute parser
             -> EventParser l e (ItemM l) b
someEmptyTag :: (Text -> Bool) -> AttrParser e b -> EventParser l e (ItemM l) b
someEmptyTag Text -> Bool
tagnameTest AttrParser e b
attrP = (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) b)
-> EventParser l e (ItemM l) b
forall (l :: * -> *) e b a.
(Monad (ItemM l), List l) =>
(Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag Text -> Bool
tagnameTest AttrParser e b
attrP b -> EventParser l e (ItemM l) b
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Parser a tag with the given name which should have no children.
-- If the tag has children, an error is raised.
emptyTag :: (Monad (ItemM l), List l)
         => Text                 -- ^ tag name
         -> AttrParser e b       -- ^ attribute parser
         -> EventParser l e (ItemM l) b
emptyTag :: Text -> AttrParser e b -> EventParser l e (ItemM l) b
emptyTag Text
name AttrParser e b
attrP = Maybe Text
-> (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) b)
-> EventParser l e (ItemM l) b
forall (l :: * -> *) e b a.
(Monad (ItemM l), List l) =>
Maybe Text
-> (Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag' (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) AttrParser e b
attrP b -> EventParser l e (ItemM l) b
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Parse text.  Note that parsing a tag will skip white space, so if
-- whitespace is significant, run this parser first.
text :: (Monad (ItemM l), List l) => EventParser l e (ItemM l) Text
text :: EventParser l e (ItemM l) Text
text = CPSExceptT
  (EventParseError e) (StateT (ParserState l) (ItemM l)) Text
-> EventParser l e (ItemM l) Text
forall (l :: * -> *) e (m :: * -> *) a.
CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (CPSExceptT
   (EventParseError e) (StateT (ParserState l) (ItemM l)) Text
 -> EventParser l e (ItemM l) Text)
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) Text
-> EventParser l e (ItemM l) Text
forall a b. (a -> b) -> a -> b
$ do
  ParserState Bool
consumed (Ordered ListItem l EventLoc
firstItem) <- CPSExceptT
  (EventParseError e)
  (StateT (ParserState l) (ItemM l))
  (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
  let loop :: ListItem l (SAXEvent tag a, b)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
loop ListItem l (SAXEvent tag a, b)
item =
        case ListItem l (SAXEvent tag a, b)
item of
          ListItem l (SAXEvent tag a, b)
Nil -> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
forall e. EventParseError e
EndOfSaxStream
          (Cons (SAXEvent tag a
eventTag, b
_loc) l (SAXEvent tag a, b)
next) ->
            case SAXEvent tag a
eventTag of
              CharacterData a
textData -> do
                ListItem l (SAXEvent tag a, b)
nextItem <- EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b))
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l (SAXEvent tag a, b)))
-> EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b))
forall a b. (a -> b) -> a -> b
$ ItemM l (ListItem l (SAXEvent tag a, b))
-> EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ItemM l (ListItem l (SAXEvent tag a, b))
 -> EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b)))
-> ItemM l (ListItem l (SAXEvent tag a, b))
-> EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
forall a b. (a -> b) -> a -> b
$ l (SAXEvent tag a, b) -> ItemM l (ListItem l (SAXEvent tag a, b))
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
List.runList l (SAXEvent tag a, b)
next
                ([a] -> [a])
-> (ListItem l (SAXEvent tag a, b), [a])
-> (ListItem l (SAXEvent tag a, b), [a])
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (a
textData a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((ListItem l (SAXEvent tag a, b), [a])
 -> (ListItem l (SAXEvent tag a, b), [a]))
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListItem l (SAXEvent tag a, b)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
loop ListItem l (SAXEvent tag a, b)
nextItem
              StartElement tag
_ [(tag, a)]
_ -> (ListItem l (SAXEvent tag a, b), [a])
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListItem l (SAXEvent tag a, b)
item, [])
              EndElement tag
_ -> (ListItem l (SAXEvent tag a, b), [a])
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ListItem l (SAXEvent tag a, b)
item, [])
              FailDocument XMLParseError
err -> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l (SAXEvent tag a, b), [a]))
-> EventParseError e
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
forall a b. (a -> b) -> a -> b
$ XMLParseError -> EventParseError e
forall e. XMLParseError -> EventParseError e
XmlError XMLParseError
err
              SAXEvent tag a
_ -> ListItem l (SAXEvent tag a, b)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
loop (ListItem l (SAXEvent tag a, b)
 -> CPSExceptT
      (EventParseError e)
      (StateT (ParserState l) (ItemM l))
      (ListItem l (SAXEvent tag a, b), [a]))
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b))
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b))
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> CPSExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (ItemM l (ListItem l (SAXEvent tag a, b))
-> EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ItemM l (ListItem l (SAXEvent tag a, b))
 -> EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b)))
-> ItemM l (ListItem l (SAXEvent tag a, b))
-> EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
forall a b. (a -> b) -> a -> b
$ l (SAXEvent tag a, b) -> ItemM l (ListItem l (SAXEvent tag a, b))
forall (l :: * -> *) a. List l => l a -> ItemM l (ListItem l a)
List.runList l (SAXEvent tag a, b)
next)
  (ListItem l EventLoc
lastList, [Text]
texts) <- ListItem l EventLoc
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l EventLoc, [Text])
forall (l :: * -> *) tag a b e (l :: * -> *).
List l =>
ListItem l (SAXEvent tag a, b)
-> CPSExceptT
     (EventParseError e)
     (StateT (ParserState l) (ItemM l))
     (ListItem l (SAXEvent tag a, b), [a])
loop ListItem l EventLoc
firstItem
  ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall a b. (a -> b) -> a -> b
$ Bool -> SAXStream l -> ParserState l
forall (l :: * -> *). Bool -> SAXStream l -> ParserState l
ParserState Bool
consumed (ListItem l EventLoc -> SAXStream l
forall (l :: * -> *). ListItem l EventLoc -> SAXStream l
Ordered ListItem l EventLoc
lastList)
  Text
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
 -> CPSExceptT
      (EventParseError e) (StateT (ParserState l) (ItemM l)) Text)
-> Text
-> CPSExceptT
     (EventParseError e) (StateT (ParserState l) (ItemM l)) Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
Text.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
texts