{- |
   This module defines an internal (generic) representation for XML
   documents including their DTDs.

   History:
   The original module was derived by hand from the XML specification,
   following the grammar precisely.  Then we simplified the types,
   removing layers of indirection and redundancy, and generally making
   things easier to work with.  Then we allowed PEReferences to be
   ubiquitous, by removing them from the types and resolving all
   PE references at parse-time.  Finally, we added a per-document
   symbol table for GEReferences, and a whitespace-significance flag
   for plaintext.
-}

module Text.XML.HaXml.Types
  (
  -- * A simple symbol table mapping strings (references) to values.
    SymTab
  -- ** Symbol table operations
  , emptyST
  , addST
  , lookupST

  -- * XML Types
  -- ** The top-level document container
  , Document(..)

  -- ** The main document content
  , Element(..)
  , ElemTag(..)
  , Content(..)
  , Attribute
  , AttValue(..)
  , info

  -- ** Administrative parts of the document
  , Prolog(..)
  , XMLDecl(..)
  , Misc(..)
  , ProcessingInstruction
  , SDDecl
  , VersionInfo
  , Comment
  , PITarget

  -- ** The DTD
  -- *** content model
  , DocTypeDecl(..)
  , MarkupDecl(..)
  , ExtSubset(..)
  , ExtSubsetDecl(..)
  , ElementDecl(..)
  , ContentSpec(..)
  , CP(..)
  , Modifier(..)
  , Mixed(..)

  -- *** attribute model
  , AttListDecl(..)
  , AttDef(..)
  , AttType(..)
  , TokenizedType(..)
  , EnumeratedType(..)
  , NotationType
  , Enumeration
  , DefaultDecl(..)
  , FIXED(..)

  -- *** conditional sections
  , ConditionalSect(..)
  , IncludeSect
  , IgnoreSect
  , Ignore(..)
  , IgnoreSectContents(..)

  -- ** References
  , Reference(..)
  , EntityRef
  , CharRef
  , PEReference

  -- ** Entities
  , EntityDecl(..)
  , GEDecl(..)
  , PEDecl(..)
  , EntityDef(..)
  , PEDef(..)
  , ExternalID(..)
  , NDataDecl(..)
  , TextDecl(..)
  , ExtParsedEnt(..)
  , ExtPE(..)
  , NotationDecl(..)
  , PublicID(..)
  , EncodingDecl(..)
  , EntityValue(..)
  , EV(..)
  , PubidLiteral(..)
  , SystemLiteral(..)

  -- ** Namespaces
  , QName(..)
  , Namespace(..)

  -- ** Basic value types
  , Name
  , Names
  , NmToken
  , NmTokens
  , CharData
  , CDSect
  ) where


{- A simple symbol table for storing macros whilst parsing. -}

type SymTab a = [(String,a)]

emptyST :: SymTab a
emptyST :: SymTab a
emptyST  = []

addST :: String -> a -> SymTab a -> SymTab a
addST :: String -> a -> SymTab a -> SymTab a
addST String
n a
v = ((String
n,a
v)(String, a) -> SymTab a -> SymTab a
forall a. a -> [a] -> [a]
:)

lookupST :: String -> SymTab a -> Maybe a
lookupST :: String -> SymTab a -> Maybe a
lookupST = String -> SymTab a -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup



{- XML types start here -}

-- | The symbol table stored in a document holds all its general entity
--   reference definitions.
data Document i = Document Prolog (SymTab EntityDef) (Element i) [Misc]
                  deriving (Document i -> Document i -> Bool
(Document i -> Document i -> Bool)
-> (Document i -> Document i -> Bool) -> Eq (Document i)
forall i. Document i -> Document i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Document i -> Document i -> Bool
$c/= :: forall i. Document i -> Document i -> Bool
== :: Document i -> Document i -> Bool
$c== :: forall i. Document i -> Document i -> Bool
Eq, Int -> Document i -> ShowS
[Document i] -> ShowS
Document i -> String
(Int -> Document i -> ShowS)
-> (Document i -> String)
-> ([Document i] -> ShowS)
-> Show (Document i)
forall i. Show i => Int -> Document i -> ShowS
forall i. Show i => [Document i] -> ShowS
forall i. Show i => Document i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Document i] -> ShowS
$cshowList :: forall i. Show i => [Document i] -> ShowS
show :: Document i -> String
$cshow :: forall i. Show i => Document i -> String
showsPrec :: Int -> Document i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> Document i -> ShowS
Show)
data Prolog     = Prolog (Maybe XMLDecl) [Misc] (Maybe DocTypeDecl) [Misc]
                  deriving (Prolog -> Prolog -> Bool
(Prolog -> Prolog -> Bool)
-> (Prolog -> Prolog -> Bool) -> Eq Prolog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Prolog -> Prolog -> Bool
$c/= :: Prolog -> Prolog -> Bool
== :: Prolog -> Prolog -> Bool
$c== :: Prolog -> Prolog -> Bool
Eq, Int -> Prolog -> ShowS
[Prolog] -> ShowS
Prolog -> String
(Int -> Prolog -> ShowS)
-> (Prolog -> String) -> ([Prolog] -> ShowS) -> Show Prolog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Prolog] -> ShowS
$cshowList :: [Prolog] -> ShowS
show :: Prolog -> String
$cshow :: Prolog -> String
showsPrec :: Int -> Prolog -> ShowS
$cshowsPrec :: Int -> Prolog -> ShowS
Show)
data XMLDecl    = XMLDecl VersionInfo (Maybe EncodingDecl) (Maybe SDDecl)
                  deriving (XMLDecl -> XMLDecl -> Bool
(XMLDecl -> XMLDecl -> Bool)
-> (XMLDecl -> XMLDecl -> Bool) -> Eq XMLDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XMLDecl -> XMLDecl -> Bool
$c/= :: XMLDecl -> XMLDecl -> Bool
== :: XMLDecl -> XMLDecl -> Bool
$c== :: XMLDecl -> XMLDecl -> Bool
Eq, Int -> XMLDecl -> ShowS
[XMLDecl] -> ShowS
XMLDecl -> String
(Int -> XMLDecl -> ShowS)
-> (XMLDecl -> String) -> ([XMLDecl] -> ShowS) -> Show XMLDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XMLDecl] -> ShowS
$cshowList :: [XMLDecl] -> ShowS
show :: XMLDecl -> String
$cshow :: XMLDecl -> String
showsPrec :: Int -> XMLDecl -> ShowS
$cshowsPrec :: Int -> XMLDecl -> ShowS
Show)
data Misc       = Comment Comment
                | PI ProcessingInstruction
                deriving (Misc -> Misc -> Bool
(Misc -> Misc -> Bool) -> (Misc -> Misc -> Bool) -> Eq Misc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Misc -> Misc -> Bool
$c/= :: Misc -> Misc -> Bool
== :: Misc -> Misc -> Bool
$c== :: Misc -> Misc -> Bool
Eq, Int -> Misc -> ShowS
[Misc] -> ShowS
Misc -> String
(Int -> Misc -> ShowS)
-> (Misc -> String) -> ([Misc] -> ShowS) -> Show Misc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Misc] -> ShowS
$cshowList :: [Misc] -> ShowS
show :: Misc -> String
$cshow :: Misc -> String
showsPrec :: Int -> Misc -> ShowS
$cshowsPrec :: Int -> Misc -> ShowS
Show)

type ProcessingInstruction = (PITarget,String)

type SDDecl      = Bool
type VersionInfo = String
type Comment     = String
type PITarget    = String

data DocTypeDecl = DTD QName (Maybe ExternalID) [MarkupDecl]  deriving (DocTypeDecl -> DocTypeDecl -> Bool
(DocTypeDecl -> DocTypeDecl -> Bool)
-> (DocTypeDecl -> DocTypeDecl -> Bool) -> Eq DocTypeDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocTypeDecl -> DocTypeDecl -> Bool
$c/= :: DocTypeDecl -> DocTypeDecl -> Bool
== :: DocTypeDecl -> DocTypeDecl -> Bool
$c== :: DocTypeDecl -> DocTypeDecl -> Bool
Eq, Int -> DocTypeDecl -> ShowS
[DocTypeDecl] -> ShowS
DocTypeDecl -> String
(Int -> DocTypeDecl -> ShowS)
-> (DocTypeDecl -> String)
-> ([DocTypeDecl] -> ShowS)
-> Show DocTypeDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocTypeDecl] -> ShowS
$cshowList :: [DocTypeDecl] -> ShowS
show :: DocTypeDecl -> String
$cshow :: DocTypeDecl -> String
showsPrec :: Int -> DocTypeDecl -> ShowS
$cshowsPrec :: Int -> DocTypeDecl -> ShowS
Show)
data MarkupDecl  = Element  ElementDecl
                 | AttList  AttListDecl
                 | Entity   EntityDecl
                 | Notation NotationDecl
                 | MarkupMisc Misc
                 deriving (MarkupDecl -> MarkupDecl -> Bool
(MarkupDecl -> MarkupDecl -> Bool)
-> (MarkupDecl -> MarkupDecl -> Bool) -> Eq MarkupDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkupDecl -> MarkupDecl -> Bool
$c/= :: MarkupDecl -> MarkupDecl -> Bool
== :: MarkupDecl -> MarkupDecl -> Bool
$c== :: MarkupDecl -> MarkupDecl -> Bool
Eq, Int -> MarkupDecl -> ShowS
[MarkupDecl] -> ShowS
MarkupDecl -> String
(Int -> MarkupDecl -> ShowS)
-> (MarkupDecl -> String)
-> ([MarkupDecl] -> ShowS)
-> Show MarkupDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MarkupDecl] -> ShowS
$cshowList :: [MarkupDecl] -> ShowS
show :: MarkupDecl -> String
$cshow :: MarkupDecl -> String
showsPrec :: Int -> MarkupDecl -> ShowS
$cshowsPrec :: Int -> MarkupDecl -> ShowS
Show)

data ExtSubset     = ExtSubset (Maybe TextDecl) [ExtSubsetDecl]  deriving (ExtSubset -> ExtSubset -> Bool
(ExtSubset -> ExtSubset -> Bool)
-> (ExtSubset -> ExtSubset -> Bool) -> Eq ExtSubset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtSubset -> ExtSubset -> Bool
$c/= :: ExtSubset -> ExtSubset -> Bool
== :: ExtSubset -> ExtSubset -> Bool
$c== :: ExtSubset -> ExtSubset -> Bool
Eq, Int -> ExtSubset -> ShowS
[ExtSubset] -> ShowS
ExtSubset -> String
(Int -> ExtSubset -> ShowS)
-> (ExtSubset -> String)
-> ([ExtSubset] -> ShowS)
-> Show ExtSubset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtSubset] -> ShowS
$cshowList :: [ExtSubset] -> ShowS
show :: ExtSubset -> String
$cshow :: ExtSubset -> String
showsPrec :: Int -> ExtSubset -> ShowS
$cshowsPrec :: Int -> ExtSubset -> ShowS
Show)
data ExtSubsetDecl = ExtMarkupDecl MarkupDecl
                   | ExtConditionalSect ConditionalSect
                   deriving (ExtSubsetDecl -> ExtSubsetDecl -> Bool
(ExtSubsetDecl -> ExtSubsetDecl -> Bool)
-> (ExtSubsetDecl -> ExtSubsetDecl -> Bool) -> Eq ExtSubsetDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtSubsetDecl -> ExtSubsetDecl -> Bool
$c/= :: ExtSubsetDecl -> ExtSubsetDecl -> Bool
== :: ExtSubsetDecl -> ExtSubsetDecl -> Bool
$c== :: ExtSubsetDecl -> ExtSubsetDecl -> Bool
Eq, Int -> ExtSubsetDecl -> ShowS
[ExtSubsetDecl] -> ShowS
ExtSubsetDecl -> String
(Int -> ExtSubsetDecl -> ShowS)
-> (ExtSubsetDecl -> String)
-> ([ExtSubsetDecl] -> ShowS)
-> Show ExtSubsetDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtSubsetDecl] -> ShowS
$cshowList :: [ExtSubsetDecl] -> ShowS
show :: ExtSubsetDecl -> String
$cshow :: ExtSubsetDecl -> String
showsPrec :: Int -> ExtSubsetDecl -> ShowS
$cshowsPrec :: Int -> ExtSubsetDecl -> ShowS
Show)

data Element i = Elem QName [Attribute] [Content i] deriving (Element i -> Element i -> Bool
(Element i -> Element i -> Bool)
-> (Element i -> Element i -> Bool) -> Eq (Element i)
forall i. Element i -> Element i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element i -> Element i -> Bool
$c/= :: forall i. Element i -> Element i -> Bool
== :: Element i -> Element i -> Bool
$c== :: forall i. Element i -> Element i -> Bool
Eq, Int -> Element i -> ShowS
[Element i] -> ShowS
Element i -> String
(Int -> Element i -> ShowS)
-> (Element i -> String)
-> ([Element i] -> ShowS)
-> Show (Element i)
forall i. Show i => Int -> Element i -> ShowS
forall i. Show i => [Element i] -> ShowS
forall i. Show i => Element i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element i] -> ShowS
$cshowList :: forall i. Show i => [Element i] -> ShowS
show :: Element i -> String
$cshow :: forall i. Show i => Element i -> String
showsPrec :: Int -> Element i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> Element i -> ShowS
Show)
--  ElemTag is an intermediate type for parsing only
data ElemTag   = ElemTag QName [Attribute]
type Attribute = (QName, AttValue)
data Content i = CElem (Element i) i
               | CString Bool CharData i
                        -- ^ bool is whether whitespace is significant
               | CRef Reference i
               | CMisc Misc i
               deriving Int -> Content i -> ShowS
[Content i] -> ShowS
Content i -> String
(Int -> Content i -> ShowS)
-> (Content i -> String)
-> ([Content i] -> ShowS)
-> Show (Content i)
forall i. Show i => Int -> Content i -> ShowS
forall i. Show i => [Content i] -> ShowS
forall i. Show i => Content i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content i] -> ShowS
$cshowList :: forall i. Show i => [Content i] -> ShowS
show :: Content i -> String
$cshow :: forall i. Show i => Content i -> String
showsPrec :: Int -> Content i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> Content i -> ShowS
Show

-- custom instance of Eq, ignoring the informational elements.
instance Eq (Content i) where
    (CElem Element i
e i
_)     == :: Content i -> Content i -> Bool
== (CElem Element i
e' i
_)       =  Element i
eElement i -> Element i -> Bool
forall a. Eq a => a -> a -> Bool
==Element i
e'
    (CString Bool
b String
c i
_) == (CString Bool
b' String
c' i
_)  =  Bool
bBool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
==Bool
b' Bool -> Bool -> Bool
&& String
cString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
c'
    (CRef Reference
r i
_)      == (CRef Reference
r' i
_)        =  Reference
rReference -> Reference -> Bool
forall a. Eq a => a -> a -> Bool
==Reference
r'
    (CMisc Misc
m i
_)     == (CMisc Misc
m' i
_)       =  Misc
mMisc -> Misc -> Bool
forall a. Eq a => a -> a -> Bool
==Misc
m'

info :: Content t -> t
info :: Content t -> t
info (CElem Element t
_ t
i) = t
i
info (CString Bool
_ String
_ t
i) = t
i
info (CRef Reference
_ t
i) = t
i
info (CMisc Misc
_ t
i) = t
i

instance Functor Document where
  fmap :: (a -> b) -> Document a -> Document b
fmap a -> b
f (Document Prolog
p SymTab EntityDef
st Element a
e [Misc]
ms) = Prolog -> SymTab EntityDef -> Element b -> [Misc] -> Document b
forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document Prolog
p SymTab EntityDef
st ((a -> b) -> Element a -> Element b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Element a
e) [Misc]
ms
instance Functor Element where
  fmap :: (a -> b) -> Element a -> Element b
fmap a -> b
f (Elem QName
t [Attribute]
as [Content a]
cs) = QName -> [Attribute] -> [Content b] -> Element b
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem QName
t [Attribute]
as ((Content a -> Content b) -> [Content a] -> [Content b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Content a -> Content b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Content a]
cs)
instance Functor Content where
  fmap :: (a -> b) -> Content a -> Content b
fmap a -> b
f (CElem Element a
e a
i)     = Element b -> b -> Content b
forall i. Element i -> i -> Content i
CElem ((a -> b) -> Element a -> Element b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Element a
e) (a -> b
f a
i)
  fmap a -> b
f (CString Bool
b String
s a
i) = Bool -> String -> b -> Content b
forall i. Bool -> String -> i -> Content i
CString Bool
b String
s (a -> b
f a
i)
  fmap a -> b
f (CRef Reference
r a
i)      = Reference -> b -> Content b
forall i. Reference -> i -> Content i
CRef Reference
r (a -> b
f a
i)
  fmap a -> b
f (CMisc Misc
m a
i)     = Misc -> b -> Content b
forall i. Misc -> i -> Content i
CMisc Misc
m (a -> b
f a
i)

data ElementDecl = ElementDecl QName ContentSpec deriving (ElementDecl -> ElementDecl -> Bool
(ElementDecl -> ElementDecl -> Bool)
-> (ElementDecl -> ElementDecl -> Bool) -> Eq ElementDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElementDecl -> ElementDecl -> Bool
$c/= :: ElementDecl -> ElementDecl -> Bool
== :: ElementDecl -> ElementDecl -> Bool
$c== :: ElementDecl -> ElementDecl -> Bool
Eq, Int -> ElementDecl -> ShowS
[ElementDecl] -> ShowS
ElementDecl -> String
(Int -> ElementDecl -> ShowS)
-> (ElementDecl -> String)
-> ([ElementDecl] -> ShowS)
-> Show ElementDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElementDecl] -> ShowS
$cshowList :: [ElementDecl] -> ShowS
show :: ElementDecl -> String
$cshow :: ElementDecl -> String
showsPrec :: Int -> ElementDecl -> ShowS
$cshowsPrec :: Int -> ElementDecl -> ShowS
Show)
data ContentSpec = EMPTY
                 | ANY
                 | Mixed Mixed
                 | ContentSpec CP
                 deriving (ContentSpec -> ContentSpec -> Bool
(ContentSpec -> ContentSpec -> Bool)
-> (ContentSpec -> ContentSpec -> Bool) -> Eq ContentSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentSpec -> ContentSpec -> Bool
$c/= :: ContentSpec -> ContentSpec -> Bool
== :: ContentSpec -> ContentSpec -> Bool
$c== :: ContentSpec -> ContentSpec -> Bool
Eq, Int -> ContentSpec -> ShowS
[ContentSpec] -> ShowS
ContentSpec -> String
(Int -> ContentSpec -> ShowS)
-> (ContentSpec -> String)
-> ([ContentSpec] -> ShowS)
-> Show ContentSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentSpec] -> ShowS
$cshowList :: [ContentSpec] -> ShowS
show :: ContentSpec -> String
$cshow :: ContentSpec -> String
showsPrec :: Int -> ContentSpec -> ShowS
$cshowsPrec :: Int -> ContentSpec -> ShowS
Show)
data CP = TagName QName Modifier
        | Choice [CP] Modifier
        | Seq [CP] Modifier
        deriving (CP -> CP -> Bool
(CP -> CP -> Bool) -> (CP -> CP -> Bool) -> Eq CP
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CP -> CP -> Bool
$c/= :: CP -> CP -> Bool
== :: CP -> CP -> Bool
$c== :: CP -> CP -> Bool
Eq, Int -> CP -> ShowS
[CP] -> ShowS
CP -> String
(Int -> CP -> ShowS)
-> (CP -> String) -> ([CP] -> ShowS) -> Show CP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CP] -> ShowS
$cshowList :: [CP] -> ShowS
show :: CP -> String
$cshow :: CP -> String
showsPrec :: Int -> CP -> ShowS
$cshowsPrec :: Int -> CP -> ShowS
Show)
data Modifier = None  -- ^ Just One
              | Query -- ^ Zero Or One
              | Star  -- ^ Zero Or More
              | Plus  -- ^ One Or More
              deriving (Modifier -> Modifier -> Bool
(Modifier -> Modifier -> Bool)
-> (Modifier -> Modifier -> Bool) -> Eq Modifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Modifier -> Modifier -> Bool
$c/= :: Modifier -> Modifier -> Bool
== :: Modifier -> Modifier -> Bool
$c== :: Modifier -> Modifier -> Bool
Eq, Int -> Modifier -> ShowS
[Modifier] -> ShowS
Modifier -> String
(Int -> Modifier -> ShowS)
-> (Modifier -> String) -> ([Modifier] -> ShowS) -> Show Modifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Modifier] -> ShowS
$cshowList :: [Modifier] -> ShowS
show :: Modifier -> String
$cshow :: Modifier -> String
showsPrec :: Int -> Modifier -> ShowS
$cshowsPrec :: Int -> Modifier -> ShowS
Show)
data Mixed = PCDATA
           | PCDATAplus [QName]
           deriving (Mixed -> Mixed -> Bool
(Mixed -> Mixed -> Bool) -> (Mixed -> Mixed -> Bool) -> Eq Mixed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mixed -> Mixed -> Bool
$c/= :: Mixed -> Mixed -> Bool
== :: Mixed -> Mixed -> Bool
$c== :: Mixed -> Mixed -> Bool
Eq, Int -> Mixed -> ShowS
[Mixed] -> ShowS
Mixed -> String
(Int -> Mixed -> ShowS)
-> (Mixed -> String) -> ([Mixed] -> ShowS) -> Show Mixed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mixed] -> ShowS
$cshowList :: [Mixed] -> ShowS
show :: Mixed -> String
$cshow :: Mixed -> String
showsPrec :: Int -> Mixed -> ShowS
$cshowsPrec :: Int -> Mixed -> ShowS
Show)
data AttListDecl = AttListDecl QName [AttDef] deriving (AttListDecl -> AttListDecl -> Bool
(AttListDecl -> AttListDecl -> Bool)
-> (AttListDecl -> AttListDecl -> Bool) -> Eq AttListDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttListDecl -> AttListDecl -> Bool
$c/= :: AttListDecl -> AttListDecl -> Bool
== :: AttListDecl -> AttListDecl -> Bool
$c== :: AttListDecl -> AttListDecl -> Bool
Eq, Int -> AttListDecl -> ShowS
[AttListDecl] -> ShowS
AttListDecl -> String
(Int -> AttListDecl -> ShowS)
-> (AttListDecl -> String)
-> ([AttListDecl] -> ShowS)
-> Show AttListDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttListDecl] -> ShowS
$cshowList :: [AttListDecl] -> ShowS
show :: AttListDecl -> String
$cshow :: AttListDecl -> String
showsPrec :: Int -> AttListDecl -> ShowS
$cshowsPrec :: Int -> AttListDecl -> ShowS
Show)
data AttDef      = AttDef QName AttType DefaultDecl deriving (AttDef -> AttDef -> Bool
(AttDef -> AttDef -> Bool)
-> (AttDef -> AttDef -> Bool) -> Eq AttDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttDef -> AttDef -> Bool
$c/= :: AttDef -> AttDef -> Bool
== :: AttDef -> AttDef -> Bool
$c== :: AttDef -> AttDef -> Bool
Eq, Int -> AttDef -> ShowS
[AttDef] -> ShowS
AttDef -> String
(Int -> AttDef -> ShowS)
-> (AttDef -> String) -> ([AttDef] -> ShowS) -> Show AttDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttDef] -> ShowS
$cshowList :: [AttDef] -> ShowS
show :: AttDef -> String
$cshow :: AttDef -> String
showsPrec :: Int -> AttDef -> ShowS
$cshowsPrec :: Int -> AttDef -> ShowS
Show)
data AttType     = StringType
                 | TokenizedType TokenizedType
                 | EnumeratedType EnumeratedType
                 deriving (AttType -> AttType -> Bool
(AttType -> AttType -> Bool)
-> (AttType -> AttType -> Bool) -> Eq AttType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttType -> AttType -> Bool
$c/= :: AttType -> AttType -> Bool
== :: AttType -> AttType -> Bool
$c== :: AttType -> AttType -> Bool
Eq, Int -> AttType -> ShowS
[AttType] -> ShowS
AttType -> String
(Int -> AttType -> ShowS)
-> (AttType -> String) -> ([AttType] -> ShowS) -> Show AttType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttType] -> ShowS
$cshowList :: [AttType] -> ShowS
show :: AttType -> String
$cshow :: AttType -> String
showsPrec :: Int -> AttType -> ShowS
$cshowsPrec :: Int -> AttType -> ShowS
Show)
data TokenizedType = ID
                   | IDREF
                   | IDREFS
                   | ENTITY
                   | ENTITIES
                   | NMTOKEN
                   | NMTOKENS
                   deriving (TokenizedType -> TokenizedType -> Bool
(TokenizedType -> TokenizedType -> Bool)
-> (TokenizedType -> TokenizedType -> Bool) -> Eq TokenizedType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenizedType -> TokenizedType -> Bool
$c/= :: TokenizedType -> TokenizedType -> Bool
== :: TokenizedType -> TokenizedType -> Bool
$c== :: TokenizedType -> TokenizedType -> Bool
Eq, Int -> TokenizedType -> ShowS
[TokenizedType] -> ShowS
TokenizedType -> String
(Int -> TokenizedType -> ShowS)
-> (TokenizedType -> String)
-> ([TokenizedType] -> ShowS)
-> Show TokenizedType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenizedType] -> ShowS
$cshowList :: [TokenizedType] -> ShowS
show :: TokenizedType -> String
$cshow :: TokenizedType -> String
showsPrec :: Int -> TokenizedType -> ShowS
$cshowsPrec :: Int -> TokenizedType -> ShowS
Show)
data EnumeratedType = NotationType NotationType
                    | Enumeration Enumeration
                    deriving (EnumeratedType -> EnumeratedType -> Bool
(EnumeratedType -> EnumeratedType -> Bool)
-> (EnumeratedType -> EnumeratedType -> Bool) -> Eq EnumeratedType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnumeratedType -> EnumeratedType -> Bool
$c/= :: EnumeratedType -> EnumeratedType -> Bool
== :: EnumeratedType -> EnumeratedType -> Bool
$c== :: EnumeratedType -> EnumeratedType -> Bool
Eq, Int -> EnumeratedType -> ShowS
[EnumeratedType] -> ShowS
EnumeratedType -> String
(Int -> EnumeratedType -> ShowS)
-> (EnumeratedType -> String)
-> ([EnumeratedType] -> ShowS)
-> Show EnumeratedType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnumeratedType] -> ShowS
$cshowList :: [EnumeratedType] -> ShowS
show :: EnumeratedType -> String
$cshow :: EnumeratedType -> String
showsPrec :: Int -> EnumeratedType -> ShowS
$cshowsPrec :: Int -> EnumeratedType -> ShowS
Show)
type NotationType   = [Name]    -- nonempty list
type Enumeration    = [NmToken] -- nonempty list
data DefaultDecl    = REQUIRED
                    | IMPLIED
                    | DefaultTo AttValue (Maybe FIXED)
                    deriving (DefaultDecl -> DefaultDecl -> Bool
(DefaultDecl -> DefaultDecl -> Bool)
-> (DefaultDecl -> DefaultDecl -> Bool) -> Eq DefaultDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DefaultDecl -> DefaultDecl -> Bool
$c/= :: DefaultDecl -> DefaultDecl -> Bool
== :: DefaultDecl -> DefaultDecl -> Bool
$c== :: DefaultDecl -> DefaultDecl -> Bool
Eq, Int -> DefaultDecl -> ShowS
[DefaultDecl] -> ShowS
DefaultDecl -> String
(Int -> DefaultDecl -> ShowS)
-> (DefaultDecl -> String)
-> ([DefaultDecl] -> ShowS)
-> Show DefaultDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DefaultDecl] -> ShowS
$cshowList :: [DefaultDecl] -> ShowS
show :: DefaultDecl -> String
$cshow :: DefaultDecl -> String
showsPrec :: Int -> DefaultDecl -> ShowS
$cshowsPrec :: Int -> DefaultDecl -> ShowS
Show)
data FIXED          = FIXED deriving (FIXED -> FIXED -> Bool
(FIXED -> FIXED -> Bool) -> (FIXED -> FIXED -> Bool) -> Eq FIXED
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FIXED -> FIXED -> Bool
$c/= :: FIXED -> FIXED -> Bool
== :: FIXED -> FIXED -> Bool
$c== :: FIXED -> FIXED -> Bool
Eq, Int -> FIXED -> ShowS
[FIXED] -> ShowS
FIXED -> String
(Int -> FIXED -> ShowS)
-> (FIXED -> String) -> ([FIXED] -> ShowS) -> Show FIXED
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FIXED] -> ShowS
$cshowList :: [FIXED] -> ShowS
show :: FIXED -> String
$cshow :: FIXED -> String
showsPrec :: Int -> FIXED -> ShowS
$cshowsPrec :: Int -> FIXED -> ShowS
Show)

data ConditionalSect = IncludeSect IncludeSect
                     | IgnoreSect IgnoreSect
                     deriving (ConditionalSect -> ConditionalSect -> Bool
(ConditionalSect -> ConditionalSect -> Bool)
-> (ConditionalSect -> ConditionalSect -> Bool)
-> Eq ConditionalSect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConditionalSect -> ConditionalSect -> Bool
$c/= :: ConditionalSect -> ConditionalSect -> Bool
== :: ConditionalSect -> ConditionalSect -> Bool
$c== :: ConditionalSect -> ConditionalSect -> Bool
Eq, Int -> ConditionalSect -> ShowS
[ConditionalSect] -> ShowS
ConditionalSect -> String
(Int -> ConditionalSect -> ShowS)
-> (ConditionalSect -> String)
-> ([ConditionalSect] -> ShowS)
-> Show ConditionalSect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConditionalSect] -> ShowS
$cshowList :: [ConditionalSect] -> ShowS
show :: ConditionalSect -> String
$cshow :: ConditionalSect -> String
showsPrec :: Int -> ConditionalSect -> ShowS
$cshowsPrec :: Int -> ConditionalSect -> ShowS
Show)
type IncludeSect = [ExtSubsetDecl]
type IgnoreSect  = [IgnoreSectContents]
data Ignore      = Ignore deriving (Ignore -> Ignore -> Bool
(Ignore -> Ignore -> Bool)
-> (Ignore -> Ignore -> Bool) -> Eq Ignore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ignore -> Ignore -> Bool
$c/= :: Ignore -> Ignore -> Bool
== :: Ignore -> Ignore -> Bool
$c== :: Ignore -> Ignore -> Bool
Eq, Int -> Ignore -> ShowS
[Ignore] -> ShowS
Ignore -> String
(Int -> Ignore -> ShowS)
-> (Ignore -> String) -> ([Ignore] -> ShowS) -> Show Ignore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ignore] -> ShowS
$cshowList :: [Ignore] -> ShowS
show :: Ignore -> String
$cshow :: Ignore -> String
showsPrec :: Int -> Ignore -> ShowS
$cshowsPrec :: Int -> Ignore -> ShowS
Show)
data IgnoreSectContents = IgnoreSectContents Ignore [(IgnoreSectContents,Ignore)]  deriving (IgnoreSectContents -> IgnoreSectContents -> Bool
(IgnoreSectContents -> IgnoreSectContents -> Bool)
-> (IgnoreSectContents -> IgnoreSectContents -> Bool)
-> Eq IgnoreSectContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IgnoreSectContents -> IgnoreSectContents -> Bool
$c/= :: IgnoreSectContents -> IgnoreSectContents -> Bool
== :: IgnoreSectContents -> IgnoreSectContents -> Bool
$c== :: IgnoreSectContents -> IgnoreSectContents -> Bool
Eq, Int -> IgnoreSectContents -> ShowS
[IgnoreSectContents] -> ShowS
IgnoreSectContents -> String
(Int -> IgnoreSectContents -> ShowS)
-> (IgnoreSectContents -> String)
-> ([IgnoreSectContents] -> ShowS)
-> Show IgnoreSectContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IgnoreSectContents] -> ShowS
$cshowList :: [IgnoreSectContents] -> ShowS
show :: IgnoreSectContents -> String
$cshow :: IgnoreSectContents -> String
showsPrec :: Int -> IgnoreSectContents -> ShowS
$cshowsPrec :: Int -> IgnoreSectContents -> ShowS
Show)

data Reference    = RefEntity EntityRef
                  | RefChar CharRef
                  deriving (Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c== :: Reference -> Reference -> Bool
Eq,Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> String
(Int -> Reference -> ShowS)
-> (Reference -> String)
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reference] -> ShowS
$cshowList :: [Reference] -> ShowS
show :: Reference -> String
$cshow :: Reference -> String
showsPrec :: Int -> Reference -> ShowS
$cshowsPrec :: Int -> Reference -> ShowS
Show)
type EntityRef    = Name
type CharRef      = Int
type PEReference  = Name

data EntityDecl   = EntityGEDecl GEDecl
                  | EntityPEDecl PEDecl
                  deriving (EntityDecl -> EntityDecl -> Bool
(EntityDecl -> EntityDecl -> Bool)
-> (EntityDecl -> EntityDecl -> Bool) -> Eq EntityDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityDecl -> EntityDecl -> Bool
$c/= :: EntityDecl -> EntityDecl -> Bool
== :: EntityDecl -> EntityDecl -> Bool
$c== :: EntityDecl -> EntityDecl -> Bool
Eq, Int -> EntityDecl -> ShowS
[EntityDecl] -> ShowS
EntityDecl -> String
(Int -> EntityDecl -> ShowS)
-> (EntityDecl -> String)
-> ([EntityDecl] -> ShowS)
-> Show EntityDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityDecl] -> ShowS
$cshowList :: [EntityDecl] -> ShowS
show :: EntityDecl -> String
$cshow :: EntityDecl -> String
showsPrec :: Int -> EntityDecl -> ShowS
$cshowsPrec :: Int -> EntityDecl -> ShowS
Show)
data GEDecl       = GEDecl Name EntityDef deriving (GEDecl -> GEDecl -> Bool
(GEDecl -> GEDecl -> Bool)
-> (GEDecl -> GEDecl -> Bool) -> Eq GEDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GEDecl -> GEDecl -> Bool
$c/= :: GEDecl -> GEDecl -> Bool
== :: GEDecl -> GEDecl -> Bool
$c== :: GEDecl -> GEDecl -> Bool
Eq, Int -> GEDecl -> ShowS
[GEDecl] -> ShowS
GEDecl -> String
(Int -> GEDecl -> ShowS)
-> (GEDecl -> String) -> ([GEDecl] -> ShowS) -> Show GEDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GEDecl] -> ShowS
$cshowList :: [GEDecl] -> ShowS
show :: GEDecl -> String
$cshow :: GEDecl -> String
showsPrec :: Int -> GEDecl -> ShowS
$cshowsPrec :: Int -> GEDecl -> ShowS
Show)
data PEDecl       = PEDecl Name PEDef deriving (PEDecl -> PEDecl -> Bool
(PEDecl -> PEDecl -> Bool)
-> (PEDecl -> PEDecl -> Bool) -> Eq PEDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PEDecl -> PEDecl -> Bool
$c/= :: PEDecl -> PEDecl -> Bool
== :: PEDecl -> PEDecl -> Bool
$c== :: PEDecl -> PEDecl -> Bool
Eq, Int -> PEDecl -> ShowS
[PEDecl] -> ShowS
PEDecl -> String
(Int -> PEDecl -> ShowS)
-> (PEDecl -> String) -> ([PEDecl] -> ShowS) -> Show PEDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PEDecl] -> ShowS
$cshowList :: [PEDecl] -> ShowS
show :: PEDecl -> String
$cshow :: PEDecl -> String
showsPrec :: Int -> PEDecl -> ShowS
$cshowsPrec :: Int -> PEDecl -> ShowS
Show)
data EntityDef    = DefEntityValue EntityValue
                  | DefExternalID ExternalID (Maybe NDataDecl)
                  deriving (EntityDef -> EntityDef -> Bool
(EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool) -> Eq EntityDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityDef -> EntityDef -> Bool
$c/= :: EntityDef -> EntityDef -> Bool
== :: EntityDef -> EntityDef -> Bool
$c== :: EntityDef -> EntityDef -> Bool
Eq, Int -> EntityDef -> ShowS
[EntityDef] -> ShowS
EntityDef -> String
(Int -> EntityDef -> ShowS)
-> (EntityDef -> String)
-> ([EntityDef] -> ShowS)
-> Show EntityDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityDef] -> ShowS
$cshowList :: [EntityDef] -> ShowS
show :: EntityDef -> String
$cshow :: EntityDef -> String
showsPrec :: Int -> EntityDef -> ShowS
$cshowsPrec :: Int -> EntityDef -> ShowS
Show)
data PEDef        = PEDefEntityValue EntityValue
                  | PEDefExternalID ExternalID deriving (PEDef -> PEDef -> Bool
(PEDef -> PEDef -> Bool) -> (PEDef -> PEDef -> Bool) -> Eq PEDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PEDef -> PEDef -> Bool
$c/= :: PEDef -> PEDef -> Bool
== :: PEDef -> PEDef -> Bool
$c== :: PEDef -> PEDef -> Bool
Eq,Int -> PEDef -> ShowS
[PEDef] -> ShowS
PEDef -> String
(Int -> PEDef -> ShowS)
-> (PEDef -> String) -> ([PEDef] -> ShowS) -> Show PEDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PEDef] -> ShowS
$cshowList :: [PEDef] -> ShowS
show :: PEDef -> String
$cshow :: PEDef -> String
showsPrec :: Int -> PEDef -> ShowS
$cshowsPrec :: Int -> PEDef -> ShowS
Show)
data ExternalID   = SYSTEM SystemLiteral
                  | PUBLIC PubidLiteral SystemLiteral deriving (ExternalID -> ExternalID -> Bool
(ExternalID -> ExternalID -> Bool)
-> (ExternalID -> ExternalID -> Bool) -> Eq ExternalID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalID -> ExternalID -> Bool
$c/= :: ExternalID -> ExternalID -> Bool
== :: ExternalID -> ExternalID -> Bool
$c== :: ExternalID -> ExternalID -> Bool
Eq,Int -> ExternalID -> ShowS
[ExternalID] -> ShowS
ExternalID -> String
(Int -> ExternalID -> ShowS)
-> (ExternalID -> String)
-> ([ExternalID] -> ShowS)
-> Show ExternalID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalID] -> ShowS
$cshowList :: [ExternalID] -> ShowS
show :: ExternalID -> String
$cshow :: ExternalID -> String
showsPrec :: Int -> ExternalID -> ShowS
$cshowsPrec :: Int -> ExternalID -> ShowS
Show)
newtype NDataDecl = NDATA Name  deriving (NDataDecl -> NDataDecl -> Bool
(NDataDecl -> NDataDecl -> Bool)
-> (NDataDecl -> NDataDecl -> Bool) -> Eq NDataDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NDataDecl -> NDataDecl -> Bool
$c/= :: NDataDecl -> NDataDecl -> Bool
== :: NDataDecl -> NDataDecl -> Bool
$c== :: NDataDecl -> NDataDecl -> Bool
Eq, Int -> NDataDecl -> ShowS
[NDataDecl] -> ShowS
NDataDecl -> String
(Int -> NDataDecl -> ShowS)
-> (NDataDecl -> String)
-> ([NDataDecl] -> ShowS)
-> Show NDataDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NDataDecl] -> ShowS
$cshowList :: [NDataDecl] -> ShowS
show :: NDataDecl -> String
$cshow :: NDataDecl -> String
showsPrec :: Int -> NDataDecl -> ShowS
$cshowsPrec :: Int -> NDataDecl -> ShowS
Show)

data TextDecl       = TextDecl (Maybe VersionInfo) EncodingDecl  deriving (TextDecl -> TextDecl -> Bool
(TextDecl -> TextDecl -> Bool)
-> (TextDecl -> TextDecl -> Bool) -> Eq TextDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDecl -> TextDecl -> Bool
$c/= :: TextDecl -> TextDecl -> Bool
== :: TextDecl -> TextDecl -> Bool
$c== :: TextDecl -> TextDecl -> Bool
Eq, Int -> TextDecl -> ShowS
[TextDecl] -> ShowS
TextDecl -> String
(Int -> TextDecl -> ShowS)
-> (TextDecl -> String) -> ([TextDecl] -> ShowS) -> Show TextDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDecl] -> ShowS
$cshowList :: [TextDecl] -> ShowS
show :: TextDecl -> String
$cshow :: TextDecl -> String
showsPrec :: Int -> TextDecl -> ShowS
$cshowsPrec :: Int -> TextDecl -> ShowS
Show)
data ExtParsedEnt i = ExtParsedEnt (Maybe TextDecl) (Content i) deriving (ExtParsedEnt i -> ExtParsedEnt i -> Bool
(ExtParsedEnt i -> ExtParsedEnt i -> Bool)
-> (ExtParsedEnt i -> ExtParsedEnt i -> Bool)
-> Eq (ExtParsedEnt i)
forall i. ExtParsedEnt i -> ExtParsedEnt i -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtParsedEnt i -> ExtParsedEnt i -> Bool
$c/= :: forall i. ExtParsedEnt i -> ExtParsedEnt i -> Bool
== :: ExtParsedEnt i -> ExtParsedEnt i -> Bool
$c== :: forall i. ExtParsedEnt i -> ExtParsedEnt i -> Bool
Eq, Int -> ExtParsedEnt i -> ShowS
[ExtParsedEnt i] -> ShowS
ExtParsedEnt i -> String
(Int -> ExtParsedEnt i -> ShowS)
-> (ExtParsedEnt i -> String)
-> ([ExtParsedEnt i] -> ShowS)
-> Show (ExtParsedEnt i)
forall i. Show i => Int -> ExtParsedEnt i -> ShowS
forall i. Show i => [ExtParsedEnt i] -> ShowS
forall i. Show i => ExtParsedEnt i -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtParsedEnt i] -> ShowS
$cshowList :: forall i. Show i => [ExtParsedEnt i] -> ShowS
show :: ExtParsedEnt i -> String
$cshow :: forall i. Show i => ExtParsedEnt i -> String
showsPrec :: Int -> ExtParsedEnt i -> ShowS
$cshowsPrec :: forall i. Show i => Int -> ExtParsedEnt i -> ShowS
Show)
data ExtPE          = ExtPE (Maybe TextDecl) [ExtSubsetDecl] deriving (ExtPE -> ExtPE -> Bool
(ExtPE -> ExtPE -> Bool) -> (ExtPE -> ExtPE -> Bool) -> Eq ExtPE
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtPE -> ExtPE -> Bool
$c/= :: ExtPE -> ExtPE -> Bool
== :: ExtPE -> ExtPE -> Bool
$c== :: ExtPE -> ExtPE -> Bool
Eq, Int -> ExtPE -> ShowS
[ExtPE] -> ShowS
ExtPE -> String
(Int -> ExtPE -> ShowS)
-> (ExtPE -> String) -> ([ExtPE] -> ShowS) -> Show ExtPE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtPE] -> ShowS
$cshowList :: [ExtPE] -> ShowS
show :: ExtPE -> String
$cshow :: ExtPE -> String
showsPrec :: Int -> ExtPE -> ShowS
$cshowsPrec :: Int -> ExtPE -> ShowS
Show)

data NotationDecl    = NOTATION Name (Either ExternalID PublicID) deriving (NotationDecl -> NotationDecl -> Bool
(NotationDecl -> NotationDecl -> Bool)
-> (NotationDecl -> NotationDecl -> Bool) -> Eq NotationDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotationDecl -> NotationDecl -> Bool
$c/= :: NotationDecl -> NotationDecl -> Bool
== :: NotationDecl -> NotationDecl -> Bool
$c== :: NotationDecl -> NotationDecl -> Bool
Eq, Int -> NotationDecl -> ShowS
[NotationDecl] -> ShowS
NotationDecl -> String
(Int -> NotationDecl -> ShowS)
-> (NotationDecl -> String)
-> ([NotationDecl] -> ShowS)
-> Show NotationDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotationDecl] -> ShowS
$cshowList :: [NotationDecl] -> ShowS
show :: NotationDecl -> String
$cshow :: NotationDecl -> String
showsPrec :: Int -> NotationDecl -> ShowS
$cshowsPrec :: Int -> NotationDecl -> ShowS
Show)
newtype PublicID     = PUBLICID PubidLiteral deriving (PublicID -> PublicID -> Bool
(PublicID -> PublicID -> Bool)
-> (PublicID -> PublicID -> Bool) -> Eq PublicID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublicID -> PublicID -> Bool
$c/= :: PublicID -> PublicID -> Bool
== :: PublicID -> PublicID -> Bool
$c== :: PublicID -> PublicID -> Bool
Eq, Int -> PublicID -> ShowS
[PublicID] -> ShowS
PublicID -> String
(Int -> PublicID -> ShowS)
-> (PublicID -> String) -> ([PublicID] -> ShowS) -> Show PublicID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublicID] -> ShowS
$cshowList :: [PublicID] -> ShowS
show :: PublicID -> String
$cshow :: PublicID -> String
showsPrec :: Int -> PublicID -> ShowS
$cshowsPrec :: Int -> PublicID -> ShowS
Show)
newtype EncodingDecl = EncodingDecl String deriving (EncodingDecl -> EncodingDecl -> Bool
(EncodingDecl -> EncodingDecl -> Bool)
-> (EncodingDecl -> EncodingDecl -> Bool) -> Eq EncodingDecl
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncodingDecl -> EncodingDecl -> Bool
$c/= :: EncodingDecl -> EncodingDecl -> Bool
== :: EncodingDecl -> EncodingDecl -> Bool
$c== :: EncodingDecl -> EncodingDecl -> Bool
Eq, Int -> EncodingDecl -> ShowS
[EncodingDecl] -> ShowS
EncodingDecl -> String
(Int -> EncodingDecl -> ShowS)
-> (EncodingDecl -> String)
-> ([EncodingDecl] -> ShowS)
-> Show EncodingDecl
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncodingDecl] -> ShowS
$cshowList :: [EncodingDecl] -> ShowS
show :: EncodingDecl -> String
$cshow :: EncodingDecl -> String
showsPrec :: Int -> EncodingDecl -> ShowS
$cshowsPrec :: Int -> EncodingDecl -> ShowS
Show)

-- | A QName is a (possibly) qualified name, in the sense of XML namespaces.
data QName    = N  Name
              | QN Namespace Name deriving (QName -> QName -> Bool
(QName -> QName -> Bool) -> (QName -> QName -> Bool) -> Eq QName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QName -> QName -> Bool
$c/= :: QName -> QName -> Bool
== :: QName -> QName -> Bool
$c== :: QName -> QName -> Bool
Eq,Int -> QName -> ShowS
[QName] -> ShowS
QName -> String
(Int -> QName -> ShowS)
-> (QName -> String) -> ([QName] -> ShowS) -> Show QName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QName] -> ShowS
$cshowList :: [QName] -> ShowS
show :: QName -> String
$cshow :: QName -> String
showsPrec :: Int -> QName -> ShowS
$cshowsPrec :: Int -> QName -> ShowS
Show)
-- | Namespaces are not defined in the XML spec itself, but at
--       http://www.w3.org/TR/xml-names
data Namespace = Namespace { Namespace -> String
nsPrefix  :: String
                           , Namespace -> String
nsURI     :: String
                           }
                 deriving (Int -> Namespace -> ShowS
[Namespace] -> ShowS
Namespace -> String
(Int -> Namespace -> ShowS)
-> (Namespace -> String)
-> ([Namespace] -> ShowS)
-> Show Namespace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Namespace] -> ShowS
$cshowList :: [Namespace] -> ShowS
show :: Namespace -> String
$cshow :: Namespace -> String
showsPrec :: Int -> Namespace -> ShowS
$cshowsPrec :: Int -> Namespace -> ShowS
Show)
instance Eq Namespace where
    Namespace
p == :: Namespace -> Namespace -> Bool
== Namespace
q  =  Namespace -> String
nsURI Namespace
p String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== Namespace -> String
nsURI Namespace
q     -- this is the W3C spec's definition!
instance Ord QName where
    compare :: QName -> QName -> Ordering
compare (N String
n)    (N String
m)    = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
n String
m
    compare (QN Namespace
p String
n) (N String
m)    = Ordering
LT
    compare (N String
n)    (QN Namespace
q String
m) = Ordering
GT
    compare (QN Namespace
p String
n) (QN Namespace
q String
m) = case String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Namespace -> String
nsPrefix Namespace
p) (Namespace -> String
nsPrefix Namespace
q) of
                                  Ordering
EQ -> String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
n String
m
                                  Ordering
r  -> Ordering
r

type Name     = String           -- non-empty string
type Names    = [Name]           -- non-empty list
type NmToken  = String           -- non-empty string
type NmTokens = [NmToken]        -- non-empty list

data AttValue    = AttValue [Either String Reference] deriving AttValue -> AttValue -> Bool
(AttValue -> AttValue -> Bool)
-> (AttValue -> AttValue -> Bool) -> Eq AttValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttValue -> AttValue -> Bool
$c/= :: AttValue -> AttValue -> Bool
== :: AttValue -> AttValue -> Bool
$c== :: AttValue -> AttValue -> Bool
Eq
instance Show AttValue where
  show :: AttValue -> String
show (AttValue [Either String Reference]
v) = (Either String Reference -> String)
-> [Either String Reference] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either String Reference -> String
decode [Either String Reference]
v
    where
      decode :: Either String Reference -> String
decode (Left  String
w)               = String
w
      decode (Right (RefEntity String
ent)) = String
"&"String -> ShowS
forall a. [a] -> [a] -> [a]
++String
entString -> ShowS
forall a. [a] -> [a] -> [a]
++String
";"
      decode (Right (RefChar Int
cref))  = String
"&"String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
crefString -> ShowS
forall a. [a] -> [a] -> [a]
++String
";"

data EntityValue = EntityValue [EV] deriving (EntityValue -> EntityValue -> Bool
(EntityValue -> EntityValue -> Bool)
-> (EntityValue -> EntityValue -> Bool) -> Eq EntityValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityValue -> EntityValue -> Bool
$c/= :: EntityValue -> EntityValue -> Bool
== :: EntityValue -> EntityValue -> Bool
$c== :: EntityValue -> EntityValue -> Bool
Eq,Int -> EntityValue -> ShowS
[EntityValue] -> ShowS
EntityValue -> String
(Int -> EntityValue -> ShowS)
-> (EntityValue -> String)
-> ([EntityValue] -> ShowS)
-> Show EntityValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityValue] -> ShowS
$cshowList :: [EntityValue] -> ShowS
show :: EntityValue -> String
$cshow :: EntityValue -> String
showsPrec :: Int -> EntityValue -> ShowS
$cshowsPrec :: Int -> EntityValue -> ShowS
Show)
data EV = EVString String
 --  -- | EVPERef PEReference
        | EVRef Reference  deriving (EV -> EV -> Bool
(EV -> EV -> Bool) -> (EV -> EV -> Bool) -> Eq EV
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EV -> EV -> Bool
$c/= :: EV -> EV -> Bool
== :: EV -> EV -> Bool
$c== :: EV -> EV -> Bool
Eq,Int -> EV -> ShowS
[EV] -> ShowS
EV -> String
(Int -> EV -> ShowS)
-> (EV -> String) -> ([EV] -> ShowS) -> Show EV
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EV] -> ShowS
$cshowList :: [EV] -> ShowS
show :: EV -> String
$cshow :: EV -> String
showsPrec :: Int -> EV -> ShowS
$cshowsPrec :: Int -> EV -> ShowS
Show)
newtype PubidLiteral  = PubidLiteral String deriving (PubidLiteral -> PubidLiteral -> Bool
(PubidLiteral -> PubidLiteral -> Bool)
-> (PubidLiteral -> PubidLiteral -> Bool) -> Eq PubidLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PubidLiteral -> PubidLiteral -> Bool
$c/= :: PubidLiteral -> PubidLiteral -> Bool
== :: PubidLiteral -> PubidLiteral -> Bool
$c== :: PubidLiteral -> PubidLiteral -> Bool
Eq,Int -> PubidLiteral -> ShowS
[PubidLiteral] -> ShowS
PubidLiteral -> String
(Int -> PubidLiteral -> ShowS)
-> (PubidLiteral -> String)
-> ([PubidLiteral] -> ShowS)
-> Show PubidLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PubidLiteral] -> ShowS
$cshowList :: [PubidLiteral] -> ShowS
show :: PubidLiteral -> String
$cshow :: PubidLiteral -> String
showsPrec :: Int -> PubidLiteral -> ShowS
$cshowsPrec :: Int -> PubidLiteral -> ShowS
Show)
newtype SystemLiteral = SystemLiteral String deriving (SystemLiteral -> SystemLiteral -> Bool
(SystemLiteral -> SystemLiteral -> Bool)
-> (SystemLiteral -> SystemLiteral -> Bool) -> Eq SystemLiteral
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemLiteral -> SystemLiteral -> Bool
$c/= :: SystemLiteral -> SystemLiteral -> Bool
== :: SystemLiteral -> SystemLiteral -> Bool
$c== :: SystemLiteral -> SystemLiteral -> Bool
Eq,Int -> SystemLiteral -> ShowS
[SystemLiteral] -> ShowS
SystemLiteral -> String
(Int -> SystemLiteral -> ShowS)
-> (SystemLiteral -> String)
-> ([SystemLiteral] -> ShowS)
-> Show SystemLiteral
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemLiteral] -> ShowS
$cshowList :: [SystemLiteral] -> ShowS
show :: SystemLiteral -> String
$cshow :: SystemLiteral -> String
showsPrec :: Int -> SystemLiteral -> ShowS
$cshowsPrec :: Int -> SystemLiteral -> ShowS
Show)
type CharData         = String
type CDSect           = CharData

instance Eq ElemTag where
    (ElemTag QName
n [Attribute]
_) == :: ElemTag -> ElemTag -> Bool
== (ElemTag QName
m [Attribute]
_)  = QName
nQName -> QName -> Bool
forall a. Eq a => a -> a -> Bool
==QName
m