{-# LANGUAGE CPP #-}
-- | This is a pretty-printer for turning the internal representation
--   of generic structured XML documents into the Doc type (which can
--   later be rendered using Text.PrettyPrint.HughesPJ.render).
--   Essentially there is one pp function for each type in
--   Text.Xml.HaXml.Types, so you can pretty-print as much or as little
--   of the document as you wish.

module Text.XML.HaXml.Pretty
  (
  -- * Pretty-print a whole document
    document
  -- ** Just one content
  ,   content
  -- ** Just one tagged element
  ,   element
  -- * Pretty-print just a DTD
  , doctypedecl
  -- ** The prolog
  ,   prolog
  -- ** A content particle description
  ,   cp
  ) where

#if MIN_VERSION_base(4,11,0)
import Prelude hiding (maybe,either,(<>))
#else
import Prelude hiding (maybe,either)
#endif

import Data.Maybe hiding (maybe)
import Data.List (intersperse)
--import Char (isSpace)
import Text.PrettyPrint.HughesPJ
import Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces

either :: (t -> t1) -> (t2 -> t1) -> Either t t2 -> t1
either :: forall t t1 t2. (t -> t1) -> (t2 -> t1) -> Either t t2 -> t1
either t -> t1
f t2 -> t1
_ (Left t
x)  = t -> t1
f t
x
either t -> t1
_ t2 -> t1
g (Right t2
x) = t2 -> t1
g t2
x

maybe :: (t -> Doc) -> Maybe t -> Doc
maybe :: forall t. (t -> Doc) -> Maybe t -> Doc
maybe t -> Doc
_ Maybe t
Nothing  = Doc
empty
maybe t -> Doc
f (Just t
x) = t -> Doc
f t
x

--peref p   = text "%" <> text p <> text ";"

----

document :: Document i -> Doc
prolog   :: Prolog -> Doc
xmldecl  :: XMLDecl -> Doc
misc     :: Misc -> Doc
sddecl   :: Bool -> Doc

doctypedecl :: DocTypeDecl -> Doc
markupdecl  :: MarkupDecl -> Doc
--extsubset   :: ExtSubset -> Doc
--extsubsetdecl :: ExtSubsetDecl -> Doc
cp          :: CP -> Doc

element   :: Element i -> Doc
attribute :: Attribute -> Doc                     --etc
content   :: Content i -> Doc

----

document :: forall i. Document i -> Doc
document (Document Prolog
p SymTab EntityDef
_ Element i
e [Misc]
m)= Prolog -> Doc
prolog Prolog
p Doc -> Doc -> Doc
$$ Element i -> Doc
forall i. Element i -> Doc
element Element i
e Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Misc -> Doc) -> [Misc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Misc -> Doc
misc [Misc]
m)
prolog :: Prolog -> Doc
prolog (Prolog Maybe XMLDecl
x [Misc]
m1 Maybe DocTypeDecl
dtd [Misc]
m2)= (XMLDecl -> Doc) -> Maybe XMLDecl -> Doc
forall t. (t -> Doc) -> Maybe t -> Doc
maybe XMLDecl -> Doc
xmldecl Maybe XMLDecl
x Doc -> Doc -> Doc
$$
                             [Doc] -> Doc
vcat ((Misc -> Doc) -> [Misc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Misc -> Doc
misc [Misc]
m1) Doc -> Doc -> Doc
$$
                             (DocTypeDecl -> Doc) -> Maybe DocTypeDecl -> Doc
forall t. (t -> Doc) -> Maybe t -> Doc
maybe DocTypeDecl -> Doc
doctypedecl Maybe DocTypeDecl
dtd Doc -> Doc -> Doc
$$
                             [Doc] -> Doc
vcat ((Misc -> Doc) -> [Misc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Misc -> Doc
misc [Misc]
m2)
xmldecl :: XMLDecl -> Doc
xmldecl (XMLDecl VersionInfo
v Maybe EncodingDecl
e Maybe SDDecl
sd)   = VersionInfo -> Doc
text VersionInfo
"<?xml version='" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
v Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"'" Doc -> Doc -> Doc
<+>
                             (EncodingDecl -> Doc) -> Maybe EncodingDecl -> Doc
forall t. (t -> Doc) -> Maybe t -> Doc
maybe EncodingDecl -> Doc
encodingdecl Maybe EncodingDecl
e Doc -> Doc -> Doc
<+>
                             (SDDecl -> Doc) -> Maybe SDDecl -> Doc
forall t. (t -> Doc) -> Maybe t -> Doc
maybe SDDecl -> Doc
sddecl Maybe SDDecl
sd Doc -> Doc -> Doc
<+>
                             VersionInfo -> Doc
text VersionInfo
"?>"
misc :: Misc -> Doc
misc (Comment VersionInfo
s)           = VersionInfo -> Doc
text VersionInfo
"<!--" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
s Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"-->"
misc (PI (VersionInfo
n,VersionInfo
s))            = VersionInfo -> Doc
text VersionInfo
"<?" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
n Doc -> Doc -> Doc
<+> VersionInfo -> Doc
text VersionInfo
s Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"?>"
sddecl :: SDDecl -> Doc
sddecl SDDecl
sd   | SDDecl
sd           = VersionInfo -> Doc
text VersionInfo
"standalone='yes'"
            | SDDecl
otherwise    = VersionInfo -> Doc
text VersionInfo
"standalone='no'"
doctypedecl :: DocTypeDecl -> Doc
doctypedecl (DTD QName
n Maybe ExternalID
eid [MarkupDecl]
ds) = if [MarkupDecl] -> SDDecl
forall a. [a] -> SDDecl
forall (t :: * -> *) a. Foldable t => t a -> SDDecl
null [MarkupDecl]
ds then
                                  Doc
hd Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
">"
                             else Doc
hd Doc -> Doc -> Doc
<+> VersionInfo -> Doc
text VersionInfo
" [" Doc -> Doc -> Doc
$$
                                  [Doc] -> Doc
vcat ((MarkupDecl -> Doc) -> [MarkupDecl] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map MarkupDecl -> Doc
markupdecl [MarkupDecl]
ds) Doc -> Doc -> Doc
$$ VersionInfo -> Doc
text VersionInfo
"]>"
                           where hd :: Doc
hd = VersionInfo -> Doc
text VersionInfo
"<!DOCTYPE" Doc -> Doc -> Doc
<+> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<+>
                                      (ExternalID -> Doc) -> Maybe ExternalID -> Doc
forall t. (t -> Doc) -> Maybe t -> Doc
maybe ExternalID -> Doc
externalid Maybe ExternalID
eid
markupdecl :: MarkupDecl -> Doc
markupdecl (Element ElementDecl
e)     = ElementDecl -> Doc
elementdecl ElementDecl
e
markupdecl (AttList AttListDecl
a)     = AttListDecl -> Doc
attlistdecl AttListDecl
a
markupdecl (Entity EntityDecl
e)      = EntityDecl -> Doc
entitydecl EntityDecl
e
markupdecl (Notation NotationDecl
n)    = NotationDecl -> Doc
notationdecl NotationDecl
n
markupdecl (MarkupMisc Misc
m)  = Misc -> Doc
misc Misc
m
--markupdecl (MarkupPE p m)  = peref p

--extsubset (ExtSubset t ds) = maybe textdecl t $$
--                             vcat (map extsubsetdecl ds)
--extmarkupdecl (ExtMarkupDecl m)      = markupdecl m
--extsubsetdecl (ExtConditionalSect c) = conditionalsect c
-- -- extsubsetdecl (ExtPEReference p e)   = peref p

element :: forall i. Element i -> Doc
element (Elem QName
n [Attribute]
as []) = VersionInfo -> Doc
text VersionInfo
"<" Doc -> Doc -> Doc
<> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<+>
                         [Doc] -> Doc
fsep ((Attribute -> Doc) -> [Attribute] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Doc
attribute [Attribute]
as) Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"/>"
element e :: Element i
e@(Elem QName
n [Attribute]
as [Content i]
cs)
    | (Content i -> SDDecl) -> [Content i] -> SDDecl
forall (t :: * -> *) a.
Foldable t =>
(a -> SDDecl) -> t a -> SDDecl
all Content i -> SDDecl
forall t. Content t -> SDDecl
isText [Content i]
cs    = VersionInfo -> Doc
text VersionInfo
"<" Doc -> Doc -> Doc
<> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((Attribute -> Doc) -> [Attribute] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Doc
attribute [Attribute]
as) Doc -> Doc -> Doc
<>
                         VersionInfo -> Doc
text VersionInfo
">" Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat ((Content i -> Doc) -> [Content i] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content i -> Doc
forall i. Content i -> Doc
content [Content i]
cs) Doc -> Doc -> Doc
<>
                         VersionInfo -> Doc
text VersionInfo
"</" Doc -> Doc -> Doc
<> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
">"
    | SDDecl
otherwise        = [Doc] -> Doc
vcat [ VersionInfo -> Doc
text VersionInfo
"<" Doc -> Doc -> Doc
<> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<> [Attribute] -> Doc
attributes [Attribute]
as Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
">"
                              , CharRef -> Doc -> Doc
nest CharRef
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ((Content i -> Doc) -> [Content i] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content i -> Doc
forall i. Content i -> Doc
content [Content i]
cs)
                              , VersionInfo -> Doc
text VersionInfo
"</" Doc -> Doc -> Doc
<> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
">"
                              ]

attributes :: [Attribute] -> Doc
attributes [] = Doc
empty
attributes as :: [Attribute]
as@(Attribute
_:[Attribute]
_) = VersionInfo -> Doc
text VersionInfo
" " Doc -> Doc -> Doc
<> [Doc] -> Doc
fsep ((Attribute -> Doc) -> [Attribute] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Doc
attribute [Attribute]
as)

isText :: Content t -> Bool
isText :: forall t. Content t -> SDDecl
isText (CString SDDecl
_ VersionInfo
_ t
_) = SDDecl
True
isText (CRef Reference
_ t
_)      = SDDecl
True
isText Content t
_               = SDDecl
False

carryelem    ::  Element t  -> Doc -> (Doc, Doc)
carrycontent ::  Content t  -> Doc -> (Doc, Doc)
spancontent  :: [Content a] -> Doc -> ([Doc],Doc)

carryelem :: forall t. Element t -> Doc -> (Doc, Doc)
carryelem (Elem QName
n [Attribute]
as []) Doc
c = ( Doc
c Doc -> Doc -> Doc
<>
                               VersionInfo -> Doc
text VersionInfo
"<" Doc -> Doc -> Doc
<> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((Attribute -> Doc) -> [Attribute] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Doc
attribute [Attribute]
as)
                             , VersionInfo -> Doc
text VersionInfo
"/>")
carryelem (Elem QName
n [Attribute]
as [Content t]
cs) Doc
c =  let ([Doc]
cs0,Doc
d0) = [Content t] -> Doc -> ([Doc], Doc)
forall a. [Content a] -> Doc -> ([Doc], Doc)
spancontent [Content t]
cs (VersionInfo -> Doc
text VersionInfo
">") in
                              ( Doc
c Doc -> Doc -> Doc
<>
                                VersionInfo -> Doc
text VersionInfo
"<"Doc -> Doc -> Doc
<>QName -> Doc
qname QName
n Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((Attribute -> Doc) -> [Attribute] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> Doc
attribute [Attribute]
as) Doc -> Doc -> Doc
$$
                                CharRef -> Doc -> Doc
nest CharRef
2 ([Doc] -> Doc
vcat [Doc]
cs0) Doc -> Doc -> Doc
<>
                                Doc
d0 Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"</" Doc -> Doc -> Doc
<> QName -> Doc
qname QName
n
                              , VersionInfo -> Doc
text VersionInfo
">")

carrycontent :: forall t. Content t -> Doc -> (Doc, Doc)
carrycontent (CElem Element t
e t
_) Doc
c         = Element t -> Doc -> (Doc, Doc)
forall t. Element t -> Doc -> (Doc, Doc)
carryelem Element t
e Doc
c
carrycontent (CString SDDecl
False VersionInfo
s t
_) Doc
c = (Doc
c Doc -> Doc -> Doc
<> VersionInfo -> Doc
chardata VersionInfo
s, Doc
empty)
carrycontent (CString SDDecl
True  VersionInfo
s t
_) Doc
c = (Doc
c Doc -> Doc -> Doc
<> VersionInfo -> Doc
cdsect VersionInfo
s, Doc
empty)
carrycontent (CRef Reference
r t
_) Doc
c          = (Doc
c Doc -> Doc -> Doc
<> Reference -> Doc
reference Reference
r, Doc
empty)
carrycontent (CMisc Misc
m t
_) Doc
c         = (Doc
c Doc -> Doc -> Doc
<> Misc -> Doc
misc Misc
m, Doc
empty)

spancontent :: forall a. [Content a] -> Doc -> ([Doc], Doc)
spancontent []     Doc
c = ([],Doc
c)
spancontent (Content a
a:[Content a]
as) Doc
c | Content a -> SDDecl
forall t. Content t -> SDDecl
isText Content a
a  = let ([Content a]
ts,[Content a]
rest) = (Content a -> SDDecl) -> [Content a] -> ([Content a], [Content a])
forall a. (a -> SDDecl) -> [a] -> ([a], [a])
span Content a -> SDDecl
forall t. Content t -> SDDecl
isText (Content a
aContent a -> [Content a] -> [Content a]
forall a. a -> [a] -> [a]
:[Content a]
as)
                                       formatted :: Doc
formatted = Doc
c Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat ((Content a -> Doc) -> [Content a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Content a -> Doc
forall i. Content i -> Doc
content [Content a]
ts)
                                   in  [Content a] -> Doc -> ([Doc], Doc)
forall a. [Content a] -> Doc -> ([Doc], Doc)
spancontent [Content a]
rest Doc
formatted
                     | SDDecl
otherwise = let (Doc
b, Doc
c0) = Content a -> Doc -> (Doc, Doc)
forall t. Content t -> Doc -> (Doc, Doc)
carrycontent Content a
a Doc
c
                                       ([Doc]
bs,Doc
c1) = [Content a] -> Doc -> ([Doc], Doc)
forall a. [Content a] -> Doc -> ([Doc], Doc)
spancontent [Content a]
as Doc
c0
                                   in  (Doc
bDoc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[Doc]
bs, Doc
c1)

attribute :: Attribute -> Doc
attribute (QName
n,AttValue
v)             = QName -> Doc
qname QName
n Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"=" Doc -> Doc -> Doc
<> AttValue -> Doc
attvalue AttValue
v
content :: forall i. Content i -> Doc
content (CElem Element i
e i
_)         = Element i -> Doc
forall i. Element i -> Doc
element Element i
e
content (CString SDDecl
False VersionInfo
s i
_) = VersionInfo -> Doc
chardata VersionInfo
s
content (CString SDDecl
True VersionInfo
s i
_)  = VersionInfo -> Doc
cdsect VersionInfo
s
content (CRef Reference
r i
_)          = Reference -> Doc
reference Reference
r
content (CMisc Misc
m i
_)         = Misc -> Doc
misc Misc
m

elementdecl :: ElementDecl -> Doc
elementdecl :: ElementDecl -> Doc
elementdecl (ElementDecl QName
n ContentSpec
cs) = VersionInfo -> Doc
text VersionInfo
"<!ELEMENT" Doc -> Doc -> Doc
<+> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<+>
                                 ContentSpec -> Doc
contentspec ContentSpec
cs Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
">"
contentspec :: ContentSpec -> Doc
contentspec :: ContentSpec -> Doc
contentspec ContentSpec
EMPTY              = VersionInfo -> Doc
text VersionInfo
"EMPTY"
contentspec ContentSpec
ANY                = VersionInfo -> Doc
text VersionInfo
"ANY"
contentspec (Mixed Mixed
m)          = Mixed -> Doc
mixed Mixed
m
contentspec (ContentSpec CP
c)    = CP -> Doc
cp CP
c
--contentspec (ContentPE p cs)   = peref p
cp :: CP -> Doc
cp (TagName QName
n Modifier
m)       = Doc -> Doc
parens (QName -> Doc
qname QName
n) Doc -> Doc -> Doc
<> Modifier -> Doc
modifier Modifier
m
cp (Choice [CP]
cs Modifier
m)       = Doc -> Doc
parens ([Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (VersionInfo -> Doc
text VersionInfo
"|") ((CP -> Doc) -> [CP] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CP -> Doc
cp [CP]
cs))) Doc -> Doc -> Doc
<>
                           Modifier -> Doc
modifier Modifier
m
cp (Seq [CP]
cs Modifier
m)          = Doc -> Doc
parens ([Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (VersionInfo -> Doc
text VersionInfo
",") ((CP -> Doc) -> [CP] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map CP -> Doc
cp [CP]
cs))) Doc -> Doc -> Doc
<>
                           Modifier -> Doc
modifier Modifier
m
--cp (CPPE p c)          = peref p
modifier :: Modifier -> Doc
modifier :: Modifier -> Doc
modifier Modifier
None          = Doc
empty
modifier Modifier
Query         = VersionInfo -> Doc
text VersionInfo
"?"
modifier Modifier
Star          = VersionInfo -> Doc
text VersionInfo
"*"
modifier Modifier
Plus          = VersionInfo -> Doc
text VersionInfo
"+"
mixed :: Mixed -> Doc
mixed :: Mixed -> Doc
mixed  Mixed
PCDATA          = VersionInfo -> Doc
text VersionInfo
"(#PCDATA)"
mixed (PCDATAplus [QName]
ns)  = VersionInfo -> Doc
text VersionInfo
"(#PCDATA |" Doc -> Doc -> Doc
<+>
                         [Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (VersionInfo -> Doc
text VersionInfo
"|") ((QName -> Doc) -> [QName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map QName -> Doc
qname [QName]
ns)) Doc -> Doc -> Doc
<>
                         VersionInfo -> Doc
text VersionInfo
")*"

attlistdecl :: AttListDecl -> Doc
attlistdecl :: AttListDecl -> Doc
attlistdecl (AttListDecl QName
n [AttDef]
ds) = VersionInfo -> Doc
text VersionInfo
"<!ATTLIST" Doc -> Doc -> Doc
<+> QName -> Doc
qname QName
n Doc -> Doc -> Doc
<+>
                                 [Doc] -> Doc
fsep ((AttDef -> Doc) -> [AttDef] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map AttDef -> Doc
attdef [AttDef]
ds) Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
">"
attdef :: AttDef -> Doc
attdef :: AttDef -> Doc
attdef (AttDef QName
n AttType
t DefaultDecl
d)          = QName -> Doc
qname QName
n Doc -> Doc -> Doc
<+> AttType -> Doc
atttype AttType
t Doc -> Doc -> Doc
<+> DefaultDecl -> Doc
defaultdecl DefaultDecl
d
atttype :: AttType -> Doc
atttype :: AttType -> Doc
atttype  AttType
StringType            = VersionInfo -> Doc
text VersionInfo
"CDATA"
atttype (TokenizedType TokenizedType
t)      = TokenizedType -> Doc
tokenizedtype TokenizedType
t
atttype (EnumeratedType EnumeratedType
t)     = EnumeratedType -> Doc
enumeratedtype EnumeratedType
t
tokenizedtype :: TokenizedType -> Doc
tokenizedtype :: TokenizedType -> Doc
tokenizedtype TokenizedType
ID               = VersionInfo -> Doc
text VersionInfo
"ID"
tokenizedtype TokenizedType
IDREF            = VersionInfo -> Doc
text VersionInfo
"IDREF"
tokenizedtype TokenizedType
IDREFS           = VersionInfo -> Doc
text VersionInfo
"IDREFS"
tokenizedtype TokenizedType
ENTITY           = VersionInfo -> Doc
text VersionInfo
"ENTITY"
tokenizedtype TokenizedType
ENTITIES         = VersionInfo -> Doc
text VersionInfo
"ENTITIES"
tokenizedtype TokenizedType
NMTOKEN          = VersionInfo -> Doc
text VersionInfo
"NMTOKEN"
tokenizedtype TokenizedType
NMTOKENS         = VersionInfo -> Doc
text VersionInfo
"NMTOKENS"
enumeratedtype :: EnumeratedType -> Doc
enumeratedtype :: EnumeratedType -> Doc
enumeratedtype (NotationType NotationType
n)= NotationType -> Doc
notationtype NotationType
n
enumeratedtype (Enumeration NotationType
e) = NotationType -> Doc
enumeration NotationType
e
notationtype :: [String] -> Doc
notationtype :: NotationType -> Doc
notationtype NotationType
ns                = VersionInfo -> Doc
text VersionInfo
"NOTATION" Doc -> Doc -> Doc
<+>
                                 Doc -> Doc
parens ([Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (VersionInfo -> Doc
text VersionInfo
"|") ((VersionInfo -> Doc) -> NotationType -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VersionInfo -> Doc
text NotationType
ns)))
enumeration :: [String] -> Doc
enumeration :: NotationType -> Doc
enumeration NotationType
ns                 = Doc -> Doc
parens ([Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
intersperse (VersionInfo -> Doc
text VersionInfo
"|") ((VersionInfo -> Doc) -> NotationType -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VersionInfo -> Doc
nmtoken NotationType
ns)))
defaultdecl :: DefaultDecl -> Doc
defaultdecl :: DefaultDecl -> Doc
defaultdecl  DefaultDecl
REQUIRED          = VersionInfo -> Doc
text VersionInfo
"#REQUIRED"
defaultdecl  DefaultDecl
IMPLIED           = VersionInfo -> Doc
text VersionInfo
"#IMPLIED"
defaultdecl (DefaultTo AttValue
a Maybe FIXED
f)    = (FIXED -> Doc) -> Maybe FIXED -> Doc
forall t. (t -> Doc) -> Maybe t -> Doc
maybe (Doc -> FIXED -> Doc
forall a b. a -> b -> a
const (VersionInfo -> Doc
text VersionInfo
"#FIXED")) Maybe FIXED
f Doc -> Doc -> Doc
<+> AttValue -> Doc
attvalue AttValue
a
--conditionalsect (IncludeSect i)= text "<![INCLUDE [" <+>
--                                 vcat (map extsubsetdecl i) <+> text "]]>"
--conditionalsect (IgnoreSect i) = text "<![IGNORE [" <+>
--                                 fsep (map ignoresectcontents i) <+> text "]]>"
--ignore (Ignore)                = empty
--ignoresectcontents (IgnoreSectContents i is)
--                               = ignore i <+> vcat (map internal is)
--                          where internal (ics,i) = text "<![[" <+>
--                                                   ignoresectcontents ics <+>
--                                                   text "]]>" <+> ignore i
reference :: Reference -> Doc
reference :: Reference -> Doc
reference (RefEntity VersionInfo
er)       = VersionInfo -> Doc
entityref VersionInfo
er
reference (RefChar CharRef
cr)         = CharRef -> Doc
forall a. Show a => a -> Doc
charref CharRef
cr
entityref :: String -> Doc
entityref :: VersionInfo -> Doc
entityref VersionInfo
n                    = VersionInfo -> Doc
text VersionInfo
"&" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
n Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
";"
charref :: (Show a) => a -> Doc
charref :: forall a. Show a => a -> Doc
charref a
c                      = VersionInfo -> Doc
text VersionInfo
"&#" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text (a -> VersionInfo
forall a. Show a => a -> VersionInfo
show a
c) Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
";"
entitydecl :: EntityDecl -> Doc
entitydecl :: EntityDecl -> Doc
entitydecl (EntityGEDecl GEDecl
d)    = GEDecl -> Doc
gedecl GEDecl
d
entitydecl (EntityPEDecl PEDecl
d)    = PEDecl -> Doc
pedecl PEDecl
d
gedecl :: GEDecl -> Doc
gedecl :: GEDecl -> Doc
gedecl (GEDecl VersionInfo
n EntityDef
ed)           = VersionInfo -> Doc
text VersionInfo
"<!ENTITY" Doc -> Doc -> Doc
<+> VersionInfo -> Doc
text VersionInfo
n Doc -> Doc -> Doc
<+> EntityDef -> Doc
entitydef EntityDef
ed Doc -> Doc -> Doc
<>
                                 VersionInfo -> Doc
text VersionInfo
">"
pedecl :: PEDecl -> Doc
pedecl :: PEDecl -> Doc
pedecl (PEDecl VersionInfo
n PEDef
pd)           = VersionInfo -> Doc
text VersionInfo
"<!ENTITY %" Doc -> Doc -> Doc
<+> VersionInfo -> Doc
text VersionInfo
n Doc -> Doc -> Doc
<+> PEDef -> Doc
pedef PEDef
pd Doc -> Doc -> Doc
<>
                                 VersionInfo -> Doc
text VersionInfo
">"
entitydef :: EntityDef -> Doc
entitydef :: EntityDef -> Doc
entitydef (DefEntityValue EntityValue
ew)  = EntityValue -> Doc
entityvalue EntityValue
ew
entitydef (DefExternalID ExternalID
i Maybe NDataDecl
nd) = ExternalID -> Doc
externalid ExternalID
i Doc -> Doc -> Doc
<+> (NDataDecl -> Doc) -> Maybe NDataDecl -> Doc
forall t. (t -> Doc) -> Maybe t -> Doc
maybe NDataDecl -> Doc
ndatadecl Maybe NDataDecl
nd
pedef :: PEDef -> Doc
pedef :: PEDef -> Doc
pedef (PEDefEntityValue EntityValue
ew)    = EntityValue -> Doc
entityvalue EntityValue
ew
pedef (PEDefExternalID ExternalID
eid)    = ExternalID -> Doc
externalid ExternalID
eid
externalid :: ExternalID -> Doc
externalid :: ExternalID -> Doc
externalid (SYSTEM SystemLiteral
sl)         = VersionInfo -> Doc
text VersionInfo
"SYSTEM" Doc -> Doc -> Doc
<+> SystemLiteral -> Doc
systemliteral SystemLiteral
sl
externalid (PUBLIC PubidLiteral
i SystemLiteral
sl)       = VersionInfo -> Doc
text VersionInfo
"PUBLIC" Doc -> Doc -> Doc
<+> PubidLiteral -> Doc
pubidliteral PubidLiteral
i Doc -> Doc -> Doc
<+>
                                 SystemLiteral -> Doc
systemliteral SystemLiteral
sl
ndatadecl :: NDataDecl -> Doc
ndatadecl :: NDataDecl -> Doc
ndatadecl (NDATA VersionInfo
n)            = VersionInfo -> Doc
text VersionInfo
"NDATA" Doc -> Doc -> Doc
<+> VersionInfo -> Doc
text VersionInfo
n
--textdecl (TextDecl vi ed)      = text "<?xml" <+> maybe text vi <+>
--                                 encodingdecl ed <+> text "?>"
--extparsedent (ExtParsedEnt t c)= maybe textdecl t <+> content c
--extpe (ExtPE t esd)            = maybe textdecl t <+>
--                                 vcat (map extsubsetdecl esd)
notationdecl :: NotationDecl -> Doc
notationdecl :: NotationDecl -> Doc
notationdecl (NOTATION VersionInfo
n Either ExternalID PublicID
e)    = VersionInfo -> Doc
text VersionInfo
"<!NOTATION" Doc -> Doc -> Doc
<+> VersionInfo -> Doc
text VersionInfo
n Doc -> Doc -> Doc
<+>
                                 (ExternalID -> Doc)
-> (PublicID -> Doc) -> Either ExternalID PublicID -> Doc
forall t t1 t2. (t -> t1) -> (t2 -> t1) -> Either t t2 -> t1
either ExternalID -> Doc
externalid PublicID -> Doc
publicid Either ExternalID PublicID
e Doc -> Doc -> Doc
<>
                                 VersionInfo -> Doc
text VersionInfo
">"
publicid :: PublicID -> Doc
publicid :: PublicID -> Doc
publicid (PUBLICID PubidLiteral
p)          = VersionInfo -> Doc
text VersionInfo
"PUBLIC" Doc -> Doc -> Doc
<+> PubidLiteral -> Doc
pubidliteral PubidLiteral
p
encodingdecl :: EncodingDecl -> Doc
encodingdecl :: EncodingDecl -> Doc
encodingdecl (EncodingDecl VersionInfo
s)  = VersionInfo -> Doc
text VersionInfo
"encoding='" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
s Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"'"
nmtoken :: String -> Doc
nmtoken :: VersionInfo -> Doc
nmtoken VersionInfo
s                      = VersionInfo -> Doc
text VersionInfo
s
attvalue :: AttValue -> Doc
attvalue :: AttValue -> Doc
attvalue (AttValue [Either VersionInfo Reference]
esr)        = VersionInfo -> Doc
text VersionInfo
"\"" Doc -> Doc -> Doc
<>
                                 [Doc] -> Doc
hcat ((Either VersionInfo Reference -> Doc)
-> [Either VersionInfo Reference] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ((VersionInfo -> Doc)
-> (Reference -> Doc) -> Either VersionInfo Reference -> Doc
forall t t1 t2. (t -> t1) -> (t2 -> t1) -> Either t t2 -> t1
either VersionInfo -> Doc
text Reference -> Doc
reference) [Either VersionInfo Reference]
esr) Doc -> Doc -> Doc
<>
                                 VersionInfo -> Doc
text VersionInfo
"\""
entityvalue :: EntityValue -> Doc
entityvalue :: EntityValue -> Doc
entityvalue (EntityValue [EV]
evs)
  | [EV] -> SDDecl
containsDoubleQuote [EV]
evs    = VersionInfo -> Doc
text VersionInfo
"'"  Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat ((EV -> Doc) -> [EV] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map EV -> Doc
ev [EV]
evs) Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"'"
  | SDDecl
otherwise                  = VersionInfo -> Doc
text VersionInfo
"\"" Doc -> Doc -> Doc
<> [Doc] -> Doc
hcat ((EV -> Doc) -> [EV] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map EV -> Doc
ev [EV]
evs) Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"\""
ev :: EV -> Doc
ev :: EV -> Doc
ev (EVString VersionInfo
s)                = VersionInfo -> Doc
text VersionInfo
s
--ev (EVPERef p e)               = peref p
ev (EVRef Reference
r)                   = Reference -> Doc
reference Reference
r
pubidliteral :: PubidLiteral -> Doc
pubidliteral :: PubidLiteral -> Doc
pubidliteral (PubidLiteral VersionInfo
s)
    | Char
'"' Char -> VersionInfo -> SDDecl
forall a. Eq a => a -> [a] -> SDDecl
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> SDDecl
`elem` VersionInfo
s             = VersionInfo -> Doc
text VersionInfo
"'" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
s Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"'"
    | SDDecl
otherwise                = VersionInfo -> Doc
text VersionInfo
"\"" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
s Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"\""
systemliteral :: SystemLiteral -> Doc
systemliteral :: SystemLiteral -> Doc
systemliteral (SystemLiteral VersionInfo
s)
    | Char
'"' Char -> VersionInfo -> SDDecl
forall a. Eq a => a -> [a] -> SDDecl
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> SDDecl
`elem` VersionInfo
s             = VersionInfo -> Doc
text VersionInfo
"'" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
s Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"'"
    | SDDecl
otherwise                = VersionInfo -> Doc
text VersionInfo
"\"" Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
s Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"\""
chardata :: String -> Doc
chardata :: VersionInfo -> Doc
chardata VersionInfo
s                     = {-if all isSpace s then empty else-} VersionInfo -> Doc
text VersionInfo
s
cdsect :: String -> Doc
cdsect :: VersionInfo -> Doc
cdsect VersionInfo
c                       = VersionInfo -> Doc
text VersionInfo
"<![CDATA[" Doc -> Doc -> Doc
<> VersionInfo -> Doc
chardata VersionInfo
c Doc -> Doc -> Doc
<> VersionInfo -> Doc
text VersionInfo
"]]>"

qname :: QName -> Doc
qname QName
n                        = VersionInfo -> Doc
text (QName -> VersionInfo
printableName QName
n)

----
containsDoubleQuote :: [EV] -> Bool
containsDoubleQuote :: [EV] -> SDDecl
containsDoubleQuote [EV]
evs = (EV -> SDDecl) -> [EV] -> SDDecl
forall (t :: * -> *) a.
Foldable t =>
(a -> SDDecl) -> t a -> SDDecl
any EV -> SDDecl
csq [EV]
evs
    where csq :: EV -> SDDecl
csq (EVString VersionInfo
s) = Char
'"' Char -> VersionInfo -> SDDecl
forall a. Eq a => a -> [a] -> SDDecl
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> SDDecl
`elem` VersionInfo
s
          csq EV
_            = SDDecl
False