{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Text.XML.Expat.StreamParser
(
EventParser
, EventLoc
, EventParseError (..)
, runEventParser
, customError
,
parseXMLByteString
, parseXMLFile
,
AttrParser
, ParseAttr
, getAttr
, peekAttr
, findAttr
, skipAttrs
,
someTag
, skipTag
, skipTags
, skipTagsTill
, tag
, someEmptyTag
, emptyTag
, text
, (<?>)
, (C.<|>)
, C.optional
, C.empty
, 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.Except hiding (fail, lift)
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
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 |
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)
data AttrParserError e =
AttrRequired Text |
AttrEmpty |
CustomAttrError e
attrErrorToEvent :: AttrParserError e -> EventParseError e
attrErrorToEvent :: AttrParserError e -> EventParseError e
attrErrorToEvent AttrParserError e
AttrEmpty = EventParseError e
forall e. EventParseError e
Empty
attrErrorToEvent (AttrRequired Text
t) = Text -> EventParseError e
forall e. Text -> EventParseError e
AttributeNotFound Text
t
attrErrorToEvent (CustomAttrError e
e) = e -> EventParseError e
forall e. e -> EventParseError e
CustomError e
e
instance Semigroup (EventParseError e) where
XmlError XMLParseError
e <> :: EventParseError e -> EventParseError e -> EventParseError e
<> EventParseError e
_ = XMLParseError -> EventParseError e
forall e. XMLParseError -> EventParseError e
XmlError XMLParseError
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
Expected [Text]
t <> EventParseError e
_ = [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
Expected [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
newtype EventParser l e m a = EventParser
{ EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser :: ExceptT (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.
Functor m =>
a -> EventParser l e m b -> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a b.
Functor m =>
(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.
Functor m =>
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.
Functor m =>
(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))
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
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
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 = ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall a b. (a -> b) -> a -> b
$ StateT (ParserState l) m a
-> ExceptT (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
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> StateT (ParserState l) m a
-> ExceptT (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
setConsumedState :: Monad m => Bool -> EventParser l e m Bool
setConsumedState :: Bool -> EventParser l e m Bool
setConsumedState Bool
newState = ExceptT (EventParseError e) (StateT (ParserState l) m) Bool
-> EventParser l e m Bool
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (ExceptT (EventParseError e) (StateT (ParserState l) m) Bool
-> EventParser l e m Bool)
-> ExceptT (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 <- ExceptT
(EventParseError e) (StateT (ParserState l) m) (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
ParserState l
-> ExceptT (EventParseError e) (StateT (ParserState l) m) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
-> ExceptT (EventParseError e) (StateT (ParserState l) m) ())
-> ParserState l
-> ExceptT (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 -> ExceptT (EventParseError e) (StateT (ParserState l) m) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
oldState
instance Monad m => Alternative (EventParser l e m) where
EventParser ExceptT (EventParseError e) (StateT (ParserState l) m) a
p <|> :: EventParser l e m a -> EventParser l e m a -> EventParser l e m a
<|> EventParser ExceptT (EventParseError e) (StateT (ParserState l) m) a
q = ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall a b. (a -> b) -> a -> b
$ do
Bool
oldConsumedState <- EventParser l e m Bool
-> ExceptT (EventParseError e) (StateT (ParserState l) m) Bool
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e m Bool
-> ExceptT (EventParseError e) (StateT (ParserState l) m) Bool)
-> EventParser l e m Bool
-> ExceptT (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
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> (EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ExceptT (EventParseError e) (StateT (ParserState l) m) a
p ((EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> (EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
forall a b. (a -> b) -> a -> b
$ \EventParseError e
err -> do
ParserState Bool
pConsumed SAXStream l
_ <- ExceptT
(EventParseError e) (StateT (ParserState l) m) (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
if Bool
pConsumed
then EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
err
else ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> (EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ExceptT (EventParseError e) (StateT (ParserState l) m) a
q ((EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> (EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
forall a b. (a -> b) -> a -> b
$ \EventParseError e
err2 ->
do ParserState Bool
qConsumed SAXStream l
_ <- ExceptT
(EventParseError e) (StateT (ParserState l) m) (ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
if Bool
qConsumed
then EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError EventParseError e
err2
else do
Bool
_ <- EventParser l e m Bool
-> ExceptT (EventParseError e) (StateT (ParserState l) m) Bool
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e m Bool
-> ExceptT (EventParseError e) (StateT (ParserState l) m) Bool)
-> EventParser l e m Bool
-> ExceptT (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
oldConsumedState
EventParseError e
-> ExceptT (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)
empty :: EventParser l e m a
empty = ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a)
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall a b. (a -> b) -> a -> b
$ EventParseError e
-> ExceptT (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
runEventParser
:: List l
=> EventParser l e (ItemM l) a
-> l EventLoc
-> (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 ExceptT (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
$ ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
-> StateT (ParserState l) (ItemM l) (Either (EventParseError e) a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT (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)
parseXMLByteString :: EventParser [] e Identity a
-> Expat.ParseOptions Text Text
-> LazyBS.ByteString
-> Either (EventParseError e, Maybe XMLParseLocation) a
parseXMLByteString :: EventParser [] e Identity a
-> ParseOptions Text Text
-> ByteString
-> Either (EventParseError e, Maybe XMLParseLocation) a
parseXMLByteString EventParser [] e Identity 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
EventParser [] e Identity 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
parseXMLFile :: EventParser [] e Identity a
-> Expat.ParseOptions Text Text
-> FilePath
-> IOMode
-> IO (Either (EventParseError e, Maybe XMLParseLocation) a)
parseXMLFile :: EventParser [] e Identity a
-> ParseOptions Text Text
-> String
-> IOMode
-> IO (Either (EventParseError e, Maybe XMLParseLocation) a)
parseXMLFile EventParser [] e Identity a
parser ParseOptions Text Text
parseOptions String
fp IOMode
mode =
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
$! EventParser [] e Identity a
-> ParseOptions Text Text
-> ByteString
-> Either (EventParseError e, Maybe XMLParseLocation) a
forall e a.
EventParser [] e Identity a
-> ParseOptions Text Text
-> ByteString
-> Either (EventParseError e, Maybe XMLParseLocation) a
parseXMLByteString EventParser [] e Identity a
parser ParseOptions Text Text
parseOptions ByteString
bs
skipToNextTag :: forall l e. (List l, Monad (ItemM l))
=> EventParser l e (ItemM l) ()
skipToNextTag :: EventParser l e (ItemM l) ()
skipToNextTag =
ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
-> EventParser l e (ItemM l) ()
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
-> EventParser l e (ItemM l) ())
-> ExceptT
(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) <- ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
let loop :: ListItem l EventLoc
-> ExceptT
(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
-> ExceptT
(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
-> ExceptT
(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
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> ExceptT
(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
-> ExceptT
(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
ExpectedTag
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
-> ExceptT
(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
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> ExceptT
(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
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc))
-> EventParseError e
-> ExceptT
(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)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc))
-> EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(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
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
loop ListItem l EventLoc
nextItem
ListItem l EventLoc
lastList <- ListItem l EventLoc
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall (l :: * -> *) e.
List l =>
ListItem l EventLoc
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
loop ListItem l EventLoc
firstItem
ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> ExceptT
(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)
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 =
ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
-> EventParser l e (ItemM l) ()
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) ()
-> EventParser l e (ItemM l) ())
-> ExceptT
(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) <- ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ParserState l)
forall s (m :: * -> *). MonadState s m => m s
get
let loop :: ListItem l EventLoc
-> ExceptT
(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
-> ExceptT
(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)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc))
-> EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(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
-> ExceptT
(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
-> ExceptT
(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) ->
String
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall a. HasCallStack => String -> a
error String
"unexpected text"
FailDocument XMLParseError
err -> do
ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> ExceptT
(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
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc))
-> EventParseError e
-> ExceptT
(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)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc))
-> EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(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
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
loop ListItem l EventLoc
nextItem
ListItem l EventLoc
lastList <- ListItem l EventLoc
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall (l :: * -> *) e.
List l =>
ListItem l EventLoc
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
loop ListItem l EventLoc
firstItem
ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> ExceptT
(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
getAttr :: ParseAttr e a
=> Text
-> 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
findAttr :: ParseAttr e a
=> Text
-> 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
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
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 []
(<?>) :: Monad m => EventParser l e m a -> Text -> EventParser l e m a
EventParser l e m a
parser <?> :: EventParser l e m a -> Text -> EventParser l e m a
<?> Text
msg = EventParser l e m a
parser 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
<|> ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a)
-> EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
forall a b. (a -> b) -> a -> b
$ [Text] -> EventParseError e
forall e. [Text] -> EventParseError e
Expected [Text
msg])
someTag :: (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)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag Text -> Bool
tagnameTest AttrParser e b
attrParser b -> EventParser l e (ItemM l) a
inner = ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
-> EventParser l e (ItemM l) a
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
-> EventParser l e (ItemM l) a)
-> ExceptT (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) ()
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser EventParser l e (ItemM l) ()
forall (l :: * -> *) e.
(List l, Monad (ItemM l)) =>
EventParser l e (ItemM l) ()
skipToNextTag
ParserState Bool
_ SAXStream l
elems <- ExceptT
(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
-> ExceptT (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
err -> EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) a)
-> EventParseError e
-> ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall a b. (a -> b) -> a -> b
$ AttrParserError e -> EventParseError e
forall e. AttrParserError e -> EventParseError e
attrErrorToEvent AttrParserError e
err
Right (b
attrData, []) -> do
ListItem l EventLoc
nextItem <- EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc)
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l EventLoc))
-> EventParser l e (ItemM l) (ListItem l EventLoc)
-> ExceptT
(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
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> ExceptT
(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
-> ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) a
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) a)
-> EventParser l e (ItemM l) a
-> ExceptT (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) ()
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) ()
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> EventParser l e (ItemM l) ()
-> ExceptT
(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
-> ExceptT (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
-> ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (EventParseError e
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) a)
-> EventParseError e
-> ExceptT (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 -> EventParseError e
-> ExceptT (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
ExpectedTag
Ordered ListItem l EventLoc
_ -> EventParseError e
-> ExceptT (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
ExpectedTag
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)
EventParser l e (ItemM l) ()
-> Text -> EventParser l e (ItemM l) ()
forall (m :: * -> *) (l :: * -> *) e a.
Monad m =>
EventParser l e m a -> Text -> EventParser l e m a
<?> Text
"Any Tag"
skipTags :: (Monad (ItemM l), List l) => EventParser l e(ItemM l) ()
skipTags :: EventParser l e (ItemM l) ()
skipTags = EventParser l e (ItemM l) [()] -> EventParser l e (ItemM l) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (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 (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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)
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
tag :: (Monad (ItemM l), List l)
=> Text
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> 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 = (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) =>
(Text -> Bool)
-> AttrParser e b
-> (b -> EventParser l e (ItemM l) a)
-> EventParser l e (ItemM l) a
someTag (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) AttrParser e b
attrP b -> EventParser l e (ItemM l) a
children
EventParser l e (ItemM l) a -> Text -> EventParser l e (ItemM l) a
forall (m :: * -> *) (l :: * -> *) e a.
Monad m =>
EventParser l e m a -> Text -> EventParser l e m a
<?> (Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Tag")
someEmptyTag :: (Monad (ItemM l), List l)
=> (Text -> Bool)
-> AttrParser e b
-> 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
emptyTag :: (Monad (ItemM l), List l)
=> Text
-> AttrParser e b
-> EventParser l e (ItemM l) b
emptyTag :: Text -> AttrParser e b -> EventParser l e (ItemM l) b
emptyTag Text
name = (Text -> Bool) -> AttrParser e b -> EventParser l e (ItemM l) b
forall (l :: * -> *) e b.
(Monad (ItemM l), List l) =>
(Text -> Bool) -> AttrParser e b -> EventParser l e (ItemM l) b
someEmptyTag (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name)
text :: (Monad (ItemM l), List l) => EventParser l e (ItemM l) Text
text :: EventParser l e (ItemM l) Text
text = ExceptT (EventParseError e) (StateT (ParserState l) (ItemM l)) Text
-> EventParser l e (ItemM l) Text
forall (l :: * -> *) e (m :: * -> *) a.
ExceptT (EventParseError e) (StateT (ParserState l) m) a
-> EventParser l e m a
EventParser (ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) Text
-> EventParser l e (ItemM l) Text)
-> ExceptT
(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) <- ExceptT
(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)
-> ExceptT
(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
-> ExceptT
(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))
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b))
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (EventParseError e) (StateT (ParserState l) m) a
getEventParser (EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b)))
-> EventParser l e (ItemM l) (ListItem l (SAXEvent tag a, b))
-> ExceptT
(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]))
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b), [a])
-> ExceptT
(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)
-> ExceptT
(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])
-> ExceptT
(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])
-> ExceptT
(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
-> ExceptT
(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
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b), [a]))
-> EventParseError e
-> ExceptT
(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)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b), [a])
loop (ListItem l (SAXEvent tag a, b)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b), [a]))
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b))
-> ExceptT
(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))
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b))
forall (l :: * -> *) e (m :: * -> *) a.
EventParser l e m a
-> ExceptT (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
-> ExceptT
(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)
-> ExceptT
(EventParseError e)
(StateT (ParserState l) (ItemM l))
(ListItem l (SAXEvent tag a, b), [a])
loop ListItem l EventLoc
firstItem
ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ParserState l
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) ())
-> ParserState l
-> ExceptT
(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
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
-> ExceptT
(EventParseError e) (StateT (ParserState l) (ItemM l)) Text)
-> Text
-> ExceptT
(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