{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE StandaloneDeriving         #-}
-- | Mid-level XML parsers, built on top of "Data.XML.Parser.Low":
--
-- - some formatting details are abstracted away (e.g. quoting, whitespacing), therefore parsers are not reversible
-- - entities delimited by an opening and closing sequence are recognized, except for tags which need a more complex, recursive logic
-- - token parsers do not overlap, therefore XML document can be tokenized in a stateless way
--
-- All documentation examples assume the following setup:
--
-- > :set -XOverloadedStrings
-- > import Data.Attoparsec.ByteString
module Data.XML.Parser.Mid
  ( module Data.XML.Parser.Mid.Attribute
  , module Data.XML.Parser.Mid.Comment
  , module Data.XML.Parser.Mid.Doctype
  , module Data.XML.Parser.Mid.Instruction
  , XMLDeclaration(..)
  , StartTag(..)
  , EmptyElementTag(..)
  , Token(..)
  , TokenParser()
  , runTokenParser
  , tokenInstruction
  , tokenComment
  , tokenCdata
  , tokenDoctype
  , tokenXmlDeclaration
  , tokenStartTag
  , tokenEndTag
  , tokenEmptyElementTag
  , tokenData
  , anyToken
  ) where

import           Control.Applicative
import           Control.Arrow                   ((>>>))
import           Control.Monad.Compat
import           Control.Monad.Fail.Compat
import           Data.Char
import           Data.Functor
import           Data.Maybe
import           Data.Text                       (Text)
import qualified Data.Text                       as Text
import           Data.XML.Parser.Low
import           Data.XML.Parser.Mid.Attribute
import           Data.XML.Parser.Mid.Comment
import           Data.XML.Parser.Mid.Doctype
import           Data.XML.Parser.Mid.Instruction
import           Numeric
import           Text.Parser.Char
import           Text.Parser.Combinators


-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.Attoparsec.ByteString

data Token
  = TokenXMLDeclaration XMLDeclaration
  | TokenDoctype Doctype
  | TokenInstruction Instruction
  | TokenStartTag StartTag
  | TokenEndTag QName
  | TokenEmptyElementTag EmptyElementTag
  | TokenData [Content]
  | TokenComment Text
  | TokenCDATA Text
  deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c== :: Token -> Token -> Bool
Eq, Eq Token
Eq Token
-> (Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmax :: Token -> Token -> Token
>= :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c< :: Token -> Token -> Bool
compare :: Token -> Token -> Ordering
$ccompare :: Token -> Token -> Ordering
$cp1Ord :: Eq Token
Ord, Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Token] -> ShowS
$cshowList :: [Token] -> ShowS
show :: Token -> String
$cshow :: Token -> String
showsPrec :: Int -> Token -> ShowS
$cshowsPrec :: Int -> Token -> ShowS
Show)

-- | <https://www.w3.org/TR/REC-xml/#dt-xmldecl>
data XMLDeclaration = XMLDeclaration Text (Maybe Text) (Maybe Bool)
  deriving (XMLDeclaration -> XMLDeclaration -> Bool
(XMLDeclaration -> XMLDeclaration -> Bool)
-> (XMLDeclaration -> XMLDeclaration -> Bool) -> Eq XMLDeclaration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XMLDeclaration -> XMLDeclaration -> Bool
$c/= :: XMLDeclaration -> XMLDeclaration -> Bool
== :: XMLDeclaration -> XMLDeclaration -> Bool
$c== :: XMLDeclaration -> XMLDeclaration -> Bool
Eq, Eq XMLDeclaration
Eq XMLDeclaration
-> (XMLDeclaration -> XMLDeclaration -> Ordering)
-> (XMLDeclaration -> XMLDeclaration -> Bool)
-> (XMLDeclaration -> XMLDeclaration -> Bool)
-> (XMLDeclaration -> XMLDeclaration -> Bool)
-> (XMLDeclaration -> XMLDeclaration -> Bool)
-> (XMLDeclaration -> XMLDeclaration -> XMLDeclaration)
-> (XMLDeclaration -> XMLDeclaration -> XMLDeclaration)
-> Ord XMLDeclaration
XMLDeclaration -> XMLDeclaration -> Bool
XMLDeclaration -> XMLDeclaration -> Ordering
XMLDeclaration -> XMLDeclaration -> XMLDeclaration
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: XMLDeclaration -> XMLDeclaration -> XMLDeclaration
$cmin :: XMLDeclaration -> XMLDeclaration -> XMLDeclaration
max :: XMLDeclaration -> XMLDeclaration -> XMLDeclaration
$cmax :: XMLDeclaration -> XMLDeclaration -> XMLDeclaration
>= :: XMLDeclaration -> XMLDeclaration -> Bool
$c>= :: XMLDeclaration -> XMLDeclaration -> Bool
> :: XMLDeclaration -> XMLDeclaration -> Bool
$c> :: XMLDeclaration -> XMLDeclaration -> Bool
<= :: XMLDeclaration -> XMLDeclaration -> Bool
$c<= :: XMLDeclaration -> XMLDeclaration -> Bool
< :: XMLDeclaration -> XMLDeclaration -> Bool
$c< :: XMLDeclaration -> XMLDeclaration -> Bool
compare :: XMLDeclaration -> XMLDeclaration -> Ordering
$ccompare :: XMLDeclaration -> XMLDeclaration -> Ordering
$cp1Ord :: Eq XMLDeclaration
Ord, ReadPrec [XMLDeclaration]
ReadPrec XMLDeclaration
Int -> ReadS XMLDeclaration
ReadS [XMLDeclaration]
(Int -> ReadS XMLDeclaration)
-> ReadS [XMLDeclaration]
-> ReadPrec XMLDeclaration
-> ReadPrec [XMLDeclaration]
-> Read XMLDeclaration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [XMLDeclaration]
$creadListPrec :: ReadPrec [XMLDeclaration]
readPrec :: ReadPrec XMLDeclaration
$creadPrec :: ReadPrec XMLDeclaration
readList :: ReadS [XMLDeclaration]
$creadList :: ReadS [XMLDeclaration]
readsPrec :: Int -> ReadS XMLDeclaration
$creadsPrec :: Int -> ReadS XMLDeclaration
Read, Int -> XMLDeclaration -> ShowS
[XMLDeclaration] -> ShowS
XMLDeclaration -> String
(Int -> XMLDeclaration -> ShowS)
-> (XMLDeclaration -> String)
-> ([XMLDeclaration] -> ShowS)
-> Show XMLDeclaration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XMLDeclaration] -> ShowS
$cshowList :: [XMLDeclaration] -> ShowS
show :: XMLDeclaration -> String
$cshow :: XMLDeclaration -> String
showsPrec :: Int -> XMLDeclaration -> ShowS
$cshowsPrec :: Int -> XMLDeclaration -> ShowS
Show)

-- | <https://www.w3.org/TR/REC-xml/#dt-stag>
data StartTag = StartTag QName [Attribute]
  deriving (StartTag -> StartTag -> Bool
(StartTag -> StartTag -> Bool)
-> (StartTag -> StartTag -> Bool) -> Eq StartTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartTag -> StartTag -> Bool
$c/= :: StartTag -> StartTag -> Bool
== :: StartTag -> StartTag -> Bool
$c== :: StartTag -> StartTag -> Bool
Eq, Eq StartTag
Eq StartTag
-> (StartTag -> StartTag -> Ordering)
-> (StartTag -> StartTag -> Bool)
-> (StartTag -> StartTag -> Bool)
-> (StartTag -> StartTag -> Bool)
-> (StartTag -> StartTag -> Bool)
-> (StartTag -> StartTag -> StartTag)
-> (StartTag -> StartTag -> StartTag)
-> Ord StartTag
StartTag -> StartTag -> Bool
StartTag -> StartTag -> Ordering
StartTag -> StartTag -> StartTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: StartTag -> StartTag -> StartTag
$cmin :: StartTag -> StartTag -> StartTag
max :: StartTag -> StartTag -> StartTag
$cmax :: StartTag -> StartTag -> StartTag
>= :: StartTag -> StartTag -> Bool
$c>= :: StartTag -> StartTag -> Bool
> :: StartTag -> StartTag -> Bool
$c> :: StartTag -> StartTag -> Bool
<= :: StartTag -> StartTag -> Bool
$c<= :: StartTag -> StartTag -> Bool
< :: StartTag -> StartTag -> Bool
$c< :: StartTag -> StartTag -> Bool
compare :: StartTag -> StartTag -> Ordering
$ccompare :: StartTag -> StartTag -> Ordering
$cp1Ord :: Eq StartTag
Ord, ReadPrec [StartTag]
ReadPrec StartTag
Int -> ReadS StartTag
ReadS [StartTag]
(Int -> ReadS StartTag)
-> ReadS [StartTag]
-> ReadPrec StartTag
-> ReadPrec [StartTag]
-> Read StartTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartTag]
$creadListPrec :: ReadPrec [StartTag]
readPrec :: ReadPrec StartTag
$creadPrec :: ReadPrec StartTag
readList :: ReadS [StartTag]
$creadList :: ReadS [StartTag]
readsPrec :: Int -> ReadS StartTag
$creadsPrec :: Int -> ReadS StartTag
Read, Int -> StartTag -> ShowS
[StartTag] -> ShowS
StartTag -> String
(Int -> StartTag -> ShowS)
-> (StartTag -> String) -> ([StartTag] -> ShowS) -> Show StartTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartTag] -> ShowS
$cshowList :: [StartTag] -> ShowS
show :: StartTag -> String
$cshow :: StartTag -> String
showsPrec :: Int -> StartTag -> ShowS
$cshowsPrec :: Int -> StartTag -> ShowS
Show)

-- | <https://www.w3.org/TR/REC-xml/#dt-eetag>
data EmptyElementTag = EmptyElementTag QName [Attribute]
  deriving (EmptyElementTag -> EmptyElementTag -> Bool
(EmptyElementTag -> EmptyElementTag -> Bool)
-> (EmptyElementTag -> EmptyElementTag -> Bool)
-> Eq EmptyElementTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmptyElementTag -> EmptyElementTag -> Bool
$c/= :: EmptyElementTag -> EmptyElementTag -> Bool
== :: EmptyElementTag -> EmptyElementTag -> Bool
$c== :: EmptyElementTag -> EmptyElementTag -> Bool
Eq, Eq EmptyElementTag
Eq EmptyElementTag
-> (EmptyElementTag -> EmptyElementTag -> Ordering)
-> (EmptyElementTag -> EmptyElementTag -> Bool)
-> (EmptyElementTag -> EmptyElementTag -> Bool)
-> (EmptyElementTag -> EmptyElementTag -> Bool)
-> (EmptyElementTag -> EmptyElementTag -> Bool)
-> (EmptyElementTag -> EmptyElementTag -> EmptyElementTag)
-> (EmptyElementTag -> EmptyElementTag -> EmptyElementTag)
-> Ord EmptyElementTag
EmptyElementTag -> EmptyElementTag -> Bool
EmptyElementTag -> EmptyElementTag -> Ordering
EmptyElementTag -> EmptyElementTag -> EmptyElementTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmptyElementTag -> EmptyElementTag -> EmptyElementTag
$cmin :: EmptyElementTag -> EmptyElementTag -> EmptyElementTag
max :: EmptyElementTag -> EmptyElementTag -> EmptyElementTag
$cmax :: EmptyElementTag -> EmptyElementTag -> EmptyElementTag
>= :: EmptyElementTag -> EmptyElementTag -> Bool
$c>= :: EmptyElementTag -> EmptyElementTag -> Bool
> :: EmptyElementTag -> EmptyElementTag -> Bool
$c> :: EmptyElementTag -> EmptyElementTag -> Bool
<= :: EmptyElementTag -> EmptyElementTag -> Bool
$c<= :: EmptyElementTag -> EmptyElementTag -> Bool
< :: EmptyElementTag -> EmptyElementTag -> Bool
$c< :: EmptyElementTag -> EmptyElementTag -> Bool
compare :: EmptyElementTag -> EmptyElementTag -> Ordering
$ccompare :: EmptyElementTag -> EmptyElementTag -> Ordering
$cp1Ord :: Eq EmptyElementTag
Ord, ReadPrec [EmptyElementTag]
ReadPrec EmptyElementTag
Int -> ReadS EmptyElementTag
ReadS [EmptyElementTag]
(Int -> ReadS EmptyElementTag)
-> ReadS [EmptyElementTag]
-> ReadPrec EmptyElementTag
-> ReadPrec [EmptyElementTag]
-> Read EmptyElementTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmptyElementTag]
$creadListPrec :: ReadPrec [EmptyElementTag]
readPrec :: ReadPrec EmptyElementTag
$creadPrec :: ReadPrec EmptyElementTag
readList :: ReadS [EmptyElementTag]
$creadList :: ReadS [EmptyElementTag]
readsPrec :: Int -> ReadS EmptyElementTag
$creadsPrec :: Int -> ReadS EmptyElementTag
Read, Int -> EmptyElementTag -> ShowS
[EmptyElementTag] -> ShowS
EmptyElementTag -> String
(Int -> EmptyElementTag -> ShowS)
-> (EmptyElementTag -> String)
-> ([EmptyElementTag] -> ShowS)
-> Show EmptyElementTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyElementTag] -> ShowS
$cshowList :: [EmptyElementTag] -> ShowS
show :: EmptyElementTag -> String
$cshow :: EmptyElementTag -> String
showsPrec :: Int -> EmptyElementTag -> ShowS
$cshowsPrec :: Int -> EmptyElementTag -> ShowS
Show)

-- | A parser that consumes whole 'Token's.
newtype TokenParser m a = TokenParser { TokenParser m a -> m a
runTokenParser :: m a }

deriving instance Functor m => Functor (TokenParser m)
deriving instance Applicative m => Applicative (TokenParser m)
deriving instance Alternative m => Alternative (TokenParser m)
deriving instance Monad m => Monad (TokenParser m)

instance (Parsing m, Monad m) => MonadFail (TokenParser m) where
  fail :: String -> TokenParser m a
fail = m a -> TokenParser m a
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser (m a -> TokenParser m a)
-> (String -> m a) -> String -> TokenParser m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m a
forall (m :: * -> *) a. Parsing m => String -> m a
unexpected


-- | <https://www.w3.org/TR/REC-xml/#NT-doctypedecl>
tokenDoctype :: CharParsing m => Monad m => TokenParser m Doctype
tokenDoctype :: TokenParser m Doctype
tokenDoctype = m Doctype -> TokenParser m Doctype
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser m Doctype
forall (m :: * -> *). (CharParsing m, Monad m) => m Doctype
doctype

-- | <https://www.w3.org/TR/REC-xml/#dt-pi>
tokenInstruction :: CharParsing m => Monad m => TokenParser m Instruction
tokenInstruction :: TokenParser m Instruction
tokenInstruction = m Instruction -> TokenParser m Instruction
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser m Instruction
forall (m :: * -> *). (CharParsing m, Monad m) => m Instruction
instruction

-- | <https://www.w3.org/TR/REC-xml/#NT-Comment>
tokenComment :: CharParsing m => Monad m => TokenParser m Text
tokenComment :: TokenParser m Text
tokenComment = m Text -> TokenParser m Text
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser m Text
forall (m :: * -> *). (CharParsing m, Monad m) => m Text
comment

-- | <https://www.w3.org/TR/REC-xml/#dt-cdsection>
--
-- >>> parseOnly (runTokenParser tokenCdata) "<![CDATA[<greeting>Hello, world!</greeting>]]>"
-- Right "<greeting>Hello, world!</greeting>"
tokenCdata :: CharParsing m => Monad m => TokenParser m Text
tokenCdata :: TokenParser m Text
tokenCdata = m Text -> TokenParser m Text
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser (m Text -> TokenParser m Text) -> m Text -> TokenParser m Text
forall a b. (a -> b) -> a -> b
$ do
  m ()
forall (m :: * -> *). CharParsing m => m ()
tokenCdataOpen
  String
content <- m Char -> m () -> m String
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
manyTill m Char
forall (m :: * -> *). CharParsing m => m Char
anyChar (m () -> m String) -> m () -> m String
forall a b. (a -> b) -> a -> b
$ m () -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try m ()
forall (m :: * -> *). CharParsing m => m ()
tokenCdataClose
  Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
content

-- | <https://www.w3.org/TR/REC-xml/#NT-XMLDecl>
--
-- >>> parseOnly (runTokenParser tokenXmlDeclaration) "<?xml version='1.0' encoding='UTF-8' standalone='yes'?>"
-- Right (XMLDeclaration "1.0" (Just "UTF-8") (Just True))
tokenXmlDeclaration :: CharParsing m => Monad m => TokenParser m XMLDeclaration
tokenXmlDeclaration :: TokenParser m XMLDeclaration
tokenXmlDeclaration = m XMLDeclaration -> TokenParser m XMLDeclaration
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser (m XMLDeclaration -> TokenParser m XMLDeclaration)
-> m XMLDeclaration -> TokenParser m XMLDeclaration
forall a b. (a -> b) -> a -> b
$ do
  m ()
forall (m :: * -> *). CharParsing m => m ()
tokenXmlDeclarationOpen
  m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace

  Attribute QName
key [Content]
value <- m Attribute
forall (m :: * -> *). (CharParsing m, Monad m) => m Attribute
attribute
  Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ QName
key QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text -> QName
QName Text
"" Text
"version"
  Text
version <- EntityDecoder -> [Content] -> m Text
forall (m :: * -> *).
(Alternative m, Monad m) =>
EntityDecoder -> [Content] -> m Text
expandContents EntityDecoder
decodePredefinedEntities [Content]
value

  Maybe Text
encoding <- m Text -> m (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Text -> m (Maybe Text)) -> m Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
    Attribute QName
key [Content]
value <- m Attribute
forall (m :: * -> *). (CharParsing m, Monad m) => m Attribute
attribute
    Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ QName
key QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text -> QName
QName Text
"" Text
"encoding"
    EntityDecoder -> [Content] -> m Text
forall (m :: * -> *).
(Alternative m, Monad m) =>
EntityDecoder -> [Content] -> m Text
expandContents EntityDecoder
decodePredefinedEntities [Content]
value

  Maybe Bool
standalone <- m Bool -> m (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m Bool -> m (Maybe Bool)) -> m Bool -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ do
    m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
    Attribute QName
key [Content]
value <- m Attribute
forall (m :: * -> *). (CharParsing m, Monad m) => m Attribute
attribute
    Bool -> m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> m ()) -> Bool -> m ()
forall a b. (a -> b) -> a -> b
$ QName
key QName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Text -> QName
QName Text
"" Text
"standalone"
    Text
boolean <- EntityDecoder -> [Content] -> m Text
forall (m :: * -> *).
(Alternative m, Monad m) =>
EntityDecoder -> [Content] -> m Text
expandContents EntityDecoder
decodePredefinedEntities [Content]
value
    case Text
boolean of
      Text
"yes" -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      Text
"no"  -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Text
_     -> m Bool
forall (f :: * -> *) a. Alternative f => f a
empty

  m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  m ()
forall (m :: * -> *). CharParsing m => m ()
tokenXmlDeclarationClose
  XMLDeclaration -> m XMLDeclaration
forall (m :: * -> *) a. Monad m => a -> m a
return (XMLDeclaration -> m XMLDeclaration)
-> XMLDeclaration -> m XMLDeclaration
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Maybe Bool -> XMLDeclaration
XMLDeclaration Text
version Maybe Text
encoding Maybe Bool
standalone

-- | <https://www.w3.org/TR/REC-xml/#NT-STag>
--
-- >>> parseOnly (runTokenParser tokenStartTag) "<termdef id='dt-dog' term='dog'>"
-- Right (StartTag (QName {namePrefix = "", nameLocal = "termdef"}) [Attribute (QName {namePrefix = "", nameLocal = "id"}) [ContentText "dt-dog"],Attribute (QName {namePrefix = "", nameLocal = "term"}) [ContentText "dog"]])
-- >>> parse (runTokenParser tokenStartTag) "<updated>2003-12-13T18:30:02Z</updated>"
-- Done "2003-12-13T18:30:02Z</updated>" (StartTag (QName {namePrefix = "", nameLocal = "updated"}) [])
tokenStartTag :: CharParsing m => Monad m => TokenParser m StartTag
tokenStartTag :: TokenParser m StartTag
tokenStartTag = m StartTag -> TokenParser m StartTag
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser (m StartTag -> TokenParser m StartTag)
-> m StartTag -> TokenParser m StartTag
forall a b. (a -> b) -> a -> b
$ do
  QName
name <- m QName
forall (m :: * -> *). (CharParsing m, Monad m) => m QName
tokenStartTagOpen
  [Attribute]
attributes <- m Attribute -> m [Attribute]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace m String -> m Attribute -> m Attribute
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Attribute
forall (m :: * -> *). (CharParsing m, Monad m) => m Attribute
attribute)
  m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  m ()
forall (m :: * -> *). CharParsing m => m ()
tokenElementClose
  StartTag -> m StartTag
forall (m :: * -> *) a. Monad m => a -> m a
return (StartTag -> m StartTag) -> StartTag -> m StartTag
forall a b. (a -> b) -> a -> b
$ QName -> [Attribute] -> StartTag
StartTag QName
name [Attribute]
attributes

-- | <https://www.w3.org/TR/REC-xml/#NT-ETag>
--
-- >>> parseOnly (runTokenParser tokenEndTag) "</termdef>"
-- Right (QName {namePrefix = "", nameLocal = "termdef"})
tokenEndTag :: CharParsing m => Monad m => TokenParser m QName
tokenEndTag :: TokenParser m QName
tokenEndTag = m QName -> TokenParser m QName
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser (m QName -> TokenParser m QName) -> m QName -> TokenParser m QName
forall a b. (a -> b) -> a -> b
$ do
  QName
name <- m QName
forall (m :: * -> *). (CharParsing m, Monad m) => m QName
tokenEndTagOpen
  m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  m ()
forall (m :: * -> *). CharParsing m => m ()
tokenElementClose
  QName -> m QName
forall (m :: * -> *) a. Monad m => a -> m a
return QName
name

-- | <https://www.w3.org/TR/REC-xml/#NT-EmptyElemTag>
--
-- >>> parseOnly (runTokenParser tokenEmptyElementTag) "<IMG align='left' src='http://www.w3.org/Icons/WWW/w3c_home' />"
-- Right (EmptyElementTag (QName {namePrefix = "", nameLocal = "IMG"}) [Attribute (QName {namePrefix = "", nameLocal = "align"}) [ContentText "left"],Attribute (QName {namePrefix = "", nameLocal = "src"}) [ContentText "http://www.w3.org/Icons/WWW/w3c_home"]])
tokenEmptyElementTag :: CharParsing m => Monad m => TokenParser m EmptyElementTag
tokenEmptyElementTag :: TokenParser m EmptyElementTag
tokenEmptyElementTag = m EmptyElementTag -> TokenParser m EmptyElementTag
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser (m EmptyElementTag -> TokenParser m EmptyElementTag)
-> m EmptyElementTag -> TokenParser m EmptyElementTag
forall a b. (a -> b) -> a -> b
$ do
  QName
name <- m QName
forall (m :: * -> *). (CharParsing m, Monad m) => m QName
tokenStartTagOpen
  Maybe [Attribute]
attributes <- m [Attribute] -> m (Maybe [Attribute])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (m [Attribute] -> m (Maybe [Attribute]))
-> m [Attribute] -> m (Maybe [Attribute])
forall a b. (a -> b) -> a -> b
$ do
    m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
    m Attribute
forall (m :: * -> *). (CharParsing m, Monad m) => m Attribute
attribute m Attribute -> m String -> m [Attribute]
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
`sepBy` m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  m String -> m (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  m ()
forall (m :: * -> *). CharParsing m => m ()
tokenEmptyElementTagClose
  EmptyElementTag -> m EmptyElementTag
forall (m :: * -> *) a. Monad m => a -> m a
return (EmptyElementTag -> m EmptyElementTag)
-> EmptyElementTag -> m EmptyElementTag
forall a b. (a -> b) -> a -> b
$ QName -> [Attribute] -> EmptyElementTag
EmptyElementTag QName
name ([Attribute] -> EmptyElementTag) -> [Attribute] -> EmptyElementTag
forall a b. (a -> b) -> a -> b
$ [Attribute] -> Maybe [Attribute] -> [Attribute]
forall a. a -> Maybe a -> a
fromMaybe [Attribute]
forall a. Monoid a => a
mempty Maybe [Attribute]
attributes

-- | <https://www.w3.org/TR/REC-xml/#NT-CharData>
--
-- >>> parseOnly (runTokenParser tokenData) "Rock &amp; roll"
-- Right [ContentText "Rock ",ContentReference (EntityRef "amp"),ContentText " roll"]
tokenData :: CharParsing m => Monad m => TokenParser m [Content]
tokenData :: TokenParser m [Content]
tokenData = m [Content] -> TokenParser m [Content]
forall (m :: * -> *) a. m a -> TokenParser m a
TokenParser (m [Content] -> TokenParser m [Content])
-> m [Content] -> TokenParser m [Content]
forall a b. (a -> b) -> a -> b
$ m Content -> m [Content]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (String -> m Content
forall (m :: * -> *).
(CharParsing m, Monad m) =>
String -> m Content
tokenContent String
"<")

-- | Parse any 'Token'.
anyToken :: CharParsing m => Monad m => TokenParser m Token
anyToken :: TokenParser m Token
anyToken = Doctype -> Token
TokenDoctype (Doctype -> Token) -> TokenParser m Doctype -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m Doctype
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m Doctype
tokenDoctype
  TokenParser m Token -> TokenParser m Token -> TokenParser m Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Instruction -> Token
TokenInstruction (Instruction -> Token)
-> TokenParser m Instruction -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m Instruction
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m Instruction
tokenInstruction
  TokenParser m Token -> TokenParser m Token -> TokenParser m Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Token
TokenComment (Text -> Token) -> TokenParser m Text -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m Text
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m Text
tokenComment
  TokenParser m Token -> TokenParser m Token -> TokenParser m Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Token
TokenCDATA (Text -> Token) -> TokenParser m Text -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m Text
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m Text
tokenCdata
  TokenParser m Token -> TokenParser m Token -> TokenParser m Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> XMLDeclaration -> Token
TokenXMLDeclaration (XMLDeclaration -> Token)
-> TokenParser m XMLDeclaration -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m XMLDeclaration
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m XMLDeclaration
tokenXmlDeclaration
  TokenParser m Token -> TokenParser m Token -> TokenParser m Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StartTag -> Token
TokenStartTag (StartTag -> Token)
-> TokenParser m StartTag -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m StartTag
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m StartTag
tokenStartTag
  TokenParser m Token -> TokenParser m Token -> TokenParser m Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QName -> Token
TokenEndTag (QName -> Token) -> TokenParser m QName -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m QName
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m QName
tokenEndTag
  TokenParser m Token -> TokenParser m Token -> TokenParser m Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> EmptyElementTag -> Token
TokenEmptyElementTag (EmptyElementTag -> Token)
-> TokenParser m EmptyElementTag -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m EmptyElementTag
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m EmptyElementTag
tokenEmptyElementTag
  TokenParser m Token -> TokenParser m Token -> TokenParser m Token
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Content] -> Token
TokenData ([Content] -> Token)
-> TokenParser m [Content] -> TokenParser m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TokenParser m [Content]
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m [Content]
tokenData