-- | High-level parsers for doctype's internal subset, built on top of "Data.XML.InternalSubset.Parser.Mid":
--
-- - comments are ignored
-- - whitespace between tokens is ignored
module Data.XML.InternalSubset.Parser.High where

import           Data.XML.InternalSubset.Parser.Mid as Mid
import           Data.XML.Parser.Low
import           Data.XML.Parser.Mid.Comment
import           Data.XML.Parser.Mid.Instruction
import           Text.Parser.Char
import           Text.Parser.Combinators


-- | <https://www.w3.org/TR/REC-xml/#NT-intSubset>
data InternalSubset = InternalSubset
  { InternalSubset -> [ElementType]
_elementTypes      :: [ElementType]
  , InternalSubset -> [AttributeList]
_attributeLists    :: [AttributeList]
  , InternalSubset -> [GeneralEntity]
_generalEntities   :: [GeneralEntity]
  , InternalSubset -> [ParameterEntity]
_parameterEntities :: [ParameterEntity]
  , InternalSubset -> [Notation]
_notations         :: [Notation]
  , InternalSubset -> [Instruction]
_instructions      :: [Instruction]
  } deriving(InternalSubset -> InternalSubset -> Bool
(InternalSubset -> InternalSubset -> Bool)
-> (InternalSubset -> InternalSubset -> Bool) -> Eq InternalSubset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InternalSubset -> InternalSubset -> Bool
$c/= :: InternalSubset -> InternalSubset -> Bool
== :: InternalSubset -> InternalSubset -> Bool
$c== :: InternalSubset -> InternalSubset -> Bool
Eq, Eq InternalSubset
Eq InternalSubset
-> (InternalSubset -> InternalSubset -> Ordering)
-> (InternalSubset -> InternalSubset -> Bool)
-> (InternalSubset -> InternalSubset -> Bool)
-> (InternalSubset -> InternalSubset -> Bool)
-> (InternalSubset -> InternalSubset -> Bool)
-> (InternalSubset -> InternalSubset -> InternalSubset)
-> (InternalSubset -> InternalSubset -> InternalSubset)
-> Ord InternalSubset
InternalSubset -> InternalSubset -> Bool
InternalSubset -> InternalSubset -> Ordering
InternalSubset -> InternalSubset -> InternalSubset
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 :: InternalSubset -> InternalSubset -> InternalSubset
$cmin :: InternalSubset -> InternalSubset -> InternalSubset
max :: InternalSubset -> InternalSubset -> InternalSubset
$cmax :: InternalSubset -> InternalSubset -> InternalSubset
>= :: InternalSubset -> InternalSubset -> Bool
$c>= :: InternalSubset -> InternalSubset -> Bool
> :: InternalSubset -> InternalSubset -> Bool
$c> :: InternalSubset -> InternalSubset -> Bool
<= :: InternalSubset -> InternalSubset -> Bool
$c<= :: InternalSubset -> InternalSubset -> Bool
< :: InternalSubset -> InternalSubset -> Bool
$c< :: InternalSubset -> InternalSubset -> Bool
compare :: InternalSubset -> InternalSubset -> Ordering
$ccompare :: InternalSubset -> InternalSubset -> Ordering
$cp1Ord :: Eq InternalSubset
Ord, ReadPrec [InternalSubset]
ReadPrec InternalSubset
Int -> ReadS InternalSubset
ReadS [InternalSubset]
(Int -> ReadS InternalSubset)
-> ReadS [InternalSubset]
-> ReadPrec InternalSubset
-> ReadPrec [InternalSubset]
-> Read InternalSubset
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InternalSubset]
$creadListPrec :: ReadPrec [InternalSubset]
readPrec :: ReadPrec InternalSubset
$creadPrec :: ReadPrec InternalSubset
readList :: ReadS [InternalSubset]
$creadList :: ReadS [InternalSubset]
readsPrec :: Int -> ReadS InternalSubset
$creadsPrec :: Int -> ReadS InternalSubset
Read, Int -> InternalSubset -> ShowS
[InternalSubset] -> ShowS
InternalSubset -> String
(Int -> InternalSubset -> ShowS)
-> (InternalSubset -> String)
-> ([InternalSubset] -> ShowS)
-> Show InternalSubset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InternalSubset] -> ShowS
$cshowList :: [InternalSubset] -> ShowS
show :: InternalSubset -> String
$cshow :: InternalSubset -> String
showsPrec :: Int -> InternalSubset -> ShowS
$cshowsPrec :: Int -> InternalSubset -> ShowS
Show)

emptyInternalSubset :: InternalSubset
emptyInternalSubset :: InternalSubset
emptyInternalSubset = [ElementType]
-> [AttributeList]
-> [GeneralEntity]
-> [ParameterEntity]
-> [Notation]
-> [Instruction]
-> InternalSubset
InternalSubset [ElementType]
forall a. Monoid a => a
mempty [AttributeList]
forall a. Monoid a => a
mempty [GeneralEntity]
forall a. Monoid a => a
mempty [ParameterEntity]
forall a. Monoid a => a
mempty [Notation]
forall a. Monoid a => a
mempty [Instruction]
forall a. Monoid a => a
mempty

-- | <https://www.w3.org/TR/REC-xml/#NT-intSubset>
internalSubset :: CharParsing m => Monad m => m InternalSubset
internalSubset :: m InternalSubset
internalSubset = do
  [Token]
tokens <- TokenParser m Token -> m Token
forall (m :: * -> *) a. TokenParser m a -> m a
Mid.runTokenParser TokenParser m Token
forall (m :: * -> *).
(CharParsing m, Monad m) =>
TokenParser m Token
Mid.anyToken m Token -> m String -> m [Token]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy` m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  InternalSubset -> m InternalSubset
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InternalSubset -> m InternalSubset)
-> InternalSubset -> m InternalSubset
forall a b. (a -> b) -> a -> b
$ (Token -> InternalSubset -> InternalSubset)
-> InternalSubset -> [Token] -> InternalSubset
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Token -> InternalSubset -> InternalSubset
insert InternalSubset
emptyInternalSubset [Token]
tokens
  where insert :: Token -> InternalSubset -> InternalSubset
insert (TokenElementType ElementType
e) InternalSubset
is     = InternalSubset
is { _elementTypes :: [ElementType]
_elementTypes = ElementType
e ElementType -> [ElementType] -> [ElementType]
forall a. a -> [a] -> [a]
: InternalSubset -> [ElementType]
_elementTypes InternalSubset
is }
        insert (TokenAttributeList AttributeList
a) InternalSubset
is   = InternalSubset
is { _attributeLists :: [AttributeList]
_attributeLists = AttributeList
a AttributeList -> [AttributeList] -> [AttributeList]
forall a. a -> [a] -> [a]
: InternalSubset -> [AttributeList]
_attributeLists InternalSubset
is }
        insert (TokenGeneralEntity GeneralEntity
g) InternalSubset
is   = InternalSubset
is { _generalEntities :: [GeneralEntity]
_generalEntities = GeneralEntity
g GeneralEntity -> [GeneralEntity] -> [GeneralEntity]
forall a. a -> [a] -> [a]
: InternalSubset -> [GeneralEntity]
_generalEntities InternalSubset
is }
        insert (TokenParameterEntity ParameterEntity
p) InternalSubset
is = InternalSubset
is { _parameterEntities :: [ParameterEntity]
_parameterEntities = ParameterEntity
p ParameterEntity -> [ParameterEntity] -> [ParameterEntity]
forall a. a -> [a] -> [a]
: InternalSubset -> [ParameterEntity]
_parameterEntities InternalSubset
is }
        insert (TokenNotation Notation
n) InternalSubset
is        = InternalSubset
is { _notations :: [Notation]
_notations = Notation
n Notation -> [Notation] -> [Notation]
forall a. a -> [a] -> [a]
: InternalSubset -> [Notation]
_notations InternalSubset
is }
        insert (TokenInstruction Instruction
i) InternalSubset
is     = InternalSubset
is { _instructions :: [Instruction]
_instructions = Instruction
i Instruction -> [Instruction] -> [Instruction]
forall a. a -> [a] -> [a]
: InternalSubset -> [Instruction]
_instructions InternalSubset
is }
        insert (TokenComment Text
c) InternalSubset
is         = InternalSubset
is