{-# LANGUAGE CPP #-}
module Text.XML.HaXml.ShowXmlLazy (showXmlLazy) where

import Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces
import Text.XML.HaXml.TypeMapping -- (toHType, toDTD, Tuple(), Defined, showHType)

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

import qualified Text.XML.HaXml.XmlContent as X
import Data.Maybe hiding (maybe)
import Data.List

-- | Convert a fully-typed XML document to a string (without DTD).
showXmlLazy :: X.XmlContent a => Bool -> a -> String
showXmlLazy :: Bool -> a -> String
showXmlLazy Bool
dtd a
x =
    case a -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
X.toContents a
x of
      [CElem Element ()
_ ()
_] -> Document () -> String
forall i. Document i -> String
document (Document () -> String) -> Document () -> String
forall a b. (a -> b) -> a -> b
$ Bool -> a -> Document ()
forall a. XmlContent a => Bool -> a -> Document ()
toXmlLazy Bool
dtd a
x
      [Content ()]
_ -> String
""


-- | Convert a fully-typed XML document to a string (with or without DTD).
toXmlLazy :: X.XmlContent a => Bool -> a -> Document ()
toXmlLazy :: Bool -> a -> Document ()
toXmlLazy Bool
dtd a
value =
    let ht :: HType
ht = a -> HType
forall a. HTypeable a => a -> HType
toHType a
value in
    Prolog -> SymTab EntityDef -> Element () -> [Misc] -> Document ()
forall i.
Prolog -> SymTab EntityDef -> Element i -> [Misc] -> Document i
Document (Maybe XMLDecl -> [Misc] -> Maybe DocTypeDecl -> [Misc] -> Prolog
Prolog (XMLDecl -> Maybe XMLDecl
forall a. a -> Maybe a
Just (String -> Maybe EncodingDecl -> Maybe Bool -> XMLDecl
XMLDecl String
"1.0" Maybe EncodingDecl
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing))
                     [] (if Bool
dtd then DocTypeDecl -> Maybe DocTypeDecl
forall a. a -> Maybe a
Just (HType -> DocTypeDecl
toDTD HType
ht) else Maybe DocTypeDecl
forall a. Maybe a
Nothing) [])
             SymTab EntityDef
forall a. SymTab a
emptyST
             ( case (HType
ht, a -> [Content ()]
forall a. XmlContent a => a -> [Content ()]
X.toContents a
value) of
                 (Tuple [HType]
_, [Content ()]
cs)       -> QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (String -> QName
N (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ HType -> ShowS
showHType HType
ht String
"") [] [Content ()]
cs
                 (Defined String
_ [HType]
_ [Constr]
_, [Content ()]
cs) -> QName -> [Attribute] -> [Content ()] -> Element ()
forall i. QName -> [Attribute] -> [Content i] -> Element i
Elem (String -> QName
N (String -> QName) -> String -> QName
forall a b. (a -> b) -> a -> b
$ HType -> ShowS
showHType HType
ht String
"-XML") [] [Content ()]
cs
                 (HType
_, [CElem Element ()
e ()])   -> Element ()
e )
             []




type Doc = String
empty :: [Char]
empty :: String
empty = String
""
($$) :: [Char] -> [Char] -> [Char]
$$ :: String -> ShowS
($$) String
a String
b = String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
vcat :: [[Char]] -> [Char]
vcat :: [String] -> String
vcat [String]
a = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> ShowS
($$) [] [String]
a
hcat :: [[a]] -> [a]
hcat :: [[a]] -> [a]
hcat = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(<>) :: [a] -> [a] -> [a]
<> :: [a] -> [a] -> [a]
(<>) = [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++)
(<+>) :: [Char] -> [Char] -> [Char]
<+> :: String -> ShowS
(<+>) String
a String
b = String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b
fsep :: [[Char]] -> [Char]
fsep :: [String] -> String
fsep = [String] -> String
vcat
text :: t -> t
text :: t -> t
text t
string = t
string
parens :: [Char] -> [Char]
parens :: ShowS
parens String
string = String
"("String -> ShowS
forall a. [a] -> [a] -> [a]
++String
stringString -> ShowS
forall a. [a] -> [a] -> [a]
++String
")"
nest :: t -> t1 -> t1
nest :: t -> t1 -> t1
nest t
_ t1
string = t1
string



either :: (t -> t1) -> (t2 -> t1) -> Either t t2 -> t1
either :: (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 -> [Char]) -> Maybe t -> [Char]
maybe :: (t -> String) -> Maybe t -> String
maybe t -> String
_ Maybe t
Nothing  = String
empty
maybe t -> String
f (Just t
x) = t -> String
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 :: Document i -> String
document (Document Prolog
p SymTab EntityDef
_ Element i
e [Misc]
m)= Prolog -> String
prolog Prolog
p String -> ShowS
$$ Element i -> String
forall i. Element i -> String
element Element i
e String -> ShowS
$$ [String] -> String
vcat ((Misc -> String) -> [Misc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Misc -> String
misc [Misc]
m)
prolog :: Prolog -> String
prolog (Prolog Maybe XMLDecl
x [Misc]
m1 Maybe DocTypeDecl
dtd [Misc]
m2)= (XMLDecl -> String) -> Maybe XMLDecl -> String
forall t. (t -> String) -> Maybe t -> String
maybe XMLDecl -> String
xmldecl Maybe XMLDecl
x String -> ShowS
$$
                             [String] -> String
vcat ((Misc -> String) -> [Misc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Misc -> String
misc [Misc]
m1) String -> ShowS
$$
                             (DocTypeDecl -> String) -> Maybe DocTypeDecl -> String
forall t. (t -> String) -> Maybe t -> String
maybe DocTypeDecl -> String
doctypedecl Maybe DocTypeDecl
dtd String -> ShowS
$$
                             [String] -> String
vcat ((Misc -> String) -> [Misc] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Misc -> String
misc [Misc]
m2)
xmldecl :: XMLDecl -> String
xmldecl (XMLDecl String
v Maybe EncodingDecl
e Maybe Bool
sd)   = ShowS
forall t. t -> t
text String
"<?xml version='" String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
forall t. t -> t
text String
v String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
forall t. t -> t
text String
"'" String -> ShowS
<+>
                             (EncodingDecl -> String) -> Maybe EncodingDecl -> String
forall t. (t -> String) -> Maybe t -> String
maybe EncodingDecl -> String
encodingdecl Maybe EncodingDecl
e String -> ShowS
<+>
                             (Bool -> String) -> Maybe Bool -> String
forall t. (t -> String) -> Maybe t -> String
maybe Bool -> String
sddecl Maybe Bool
sd String -> ShowS
<+>
                             ShowS
forall t. t -> t
text String
"?>"
misc :: Misc -> String
misc (Comment String
s)           = ShowS
forall t. t -> t
text String
"<!--" String -> ShowS
<+> ShowS
forall t. t -> t
text String
s String -> ShowS
<+> ShowS
forall t. t -> t
text String
"-->"
misc (PI (String
n,String
s))            = ShowS
forall t. t -> t
text String
"<?" String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
forall t. t -> t
text String
n String -> ShowS
<+> ShowS
forall t. t -> t
text String
s String -> ShowS
<+> ShowS
forall t. t -> t
text String
"?>"
sddecl :: Bool -> String
sddecl Bool
sd   | Bool
sd           = ShowS
forall t. t -> t
text String
"standalone='yes'"
            | Bool
otherwise    = ShowS
forall t. t -> t
text String
"standalone='no'"
doctypedecl :: DocTypeDecl -> String
doctypedecl (DTD QName
n Maybe ExternalID
eid [MarkupDecl]
ds) = if [MarkupDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MarkupDecl]
ds then
                                  String
hd String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
forall t. t -> t
text String
">"
                             else String
hd String -> ShowS
<+> ShowS
forall t. t -> t
text String
" [" String -> ShowS
$$
                                  [String] -> String
vcat ((MarkupDecl -> String) -> [MarkupDecl] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MarkupDecl -> String
markupdecl [MarkupDecl]
ds) String -> ShowS
$$ ShowS
forall t. t -> t
text String
"]>"
                           where hd :: String
hd = ShowS
forall t. t -> t
text String
"<!DOCTYPE" String -> ShowS
<+> QName -> String
qname QName
n String -> ShowS
<+>
                                      (ExternalID -> String) -> Maybe ExternalID -> String
forall t. (t -> String) -> Maybe t -> String
maybe ExternalID -> String
externalid Maybe ExternalID
eid
markupdecl :: MarkupDecl -> String
markupdecl (Element ElementDecl
e)     = ElementDecl -> String
elementdecl ElementDecl
e
markupdecl (AttList AttListDecl
a)     = AttListDecl -> String
attlistdecl AttListDecl
a
markupdecl (Entity EntityDecl
e)      = EntityDecl -> String
entitydecl EntityDecl
e
markupdecl (Notation NotationDecl
n)    = NotationDecl -> String
notationdecl NotationDecl
n
markupdecl (MarkupMisc Misc
m)  = Misc -> String
misc Misc
m
--markupdecl (MarkupPE p m)  = peref p
-- _ (ExtSubset t ds) = maybe textdecl t $$
--                              vcat (map extsubsetdecl ds)
-- _ (ExtMarkupDecl m)      = markupdecl m
-- extsubsetdecl (ExtConditionalSect c) = conditionalsect c
--extsubsetdecl (ExtPEReference p e)   = peref p

element :: Element i -> String
element (Elem QName
n [Attribute]
as []) = ShowS
forall t. t -> t
text String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
<> QName -> String
qname QName
n String -> ShowS
<+>
                         [String] -> String
fsep ((Attribute -> String) -> [Attribute] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> String
attribute [Attribute]
as) String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
forall t. t -> t
text String
"/>"
element e :: Element i
e@(Elem QName
n [Attribute]
as [Content i]
cs)
--  | any isText cs    = text "<" <> qname n <+> fsep (map attribute as) <>
--                       text ">" <> hcat (map content cs) <>
--                       text "</" <> qname n <> text ">"
    | Content i -> Bool
forall t. Content t -> Bool
isText ([Content i] -> Content i
forall a. [a] -> a
head [Content i]
cs) = ShowS
forall t. t -> t
text String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
<> QName -> String
qname QName
n String -> ShowS
<+> [String] -> String
fsep ((Attribute -> String) -> [Attribute] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> String
attribute [Attribute]
as) String -> ShowS
forall a. [a] -> [a] -> [a]
<>
                         ShowS
forall t. t -> t
text String
">" String -> ShowS
forall a. [a] -> [a] -> [a]
<> [String] -> String
forall a. [[a]] -> [a]
hcat ((Content i -> String) -> [Content i] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Content i -> String
forall i. Content i -> String
content [Content i]
cs) String -> ShowS
forall a. [a] -> [a] -> [a]
<>
                         ShowS
forall t. t -> t
text String
"</" String -> ShowS
forall a. [a] -> [a] -> [a]
<> QName -> String
qname QName
n String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
forall t. t -> t
text String
">"
    | Bool
otherwise        = let (String
d,String
c) = Element i -> String -> (String, String)
forall t. Element t -> String -> (String, String)
carryelem Element i
e String
empty
                         in String
d String -> ShowS
forall a. [a] -> [a] -> [a]
<> String
c

isText :: Content t -> Bool
isText :: Content t -> Bool
isText (CString Bool
_ String
_ t
_) = Bool
True
isText (CRef Reference
_ t
_)      = Bool
True
isText Content t
_               = Bool
False

carryelem :: Element t -> String -> (String, String)
carryelem (Elem QName
n [Attribute]
as []) String
c
                       = ( String
c String -> ShowS
forall a. [a] -> [a] -> [a]
<>
                           ShowS
forall t. t -> t
text String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
<> QName -> String
qname QName
n String -> ShowS
<+> [String] -> String
fsep ((Attribute -> String) -> [Attribute] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> String
attribute [Attribute]
as)
                         , ShowS
forall t. t -> t
text String
"/>")
carryelem (Elem QName
n [Attribute]
as [Content t]
cs) String
c
{-  | any isText cs    =  ( c <> element e, empty)
    | otherwise -}     =  let ([String]
cs0,String
d0) = (Content t -> String -> (String, String))
-> [Content t] -> String -> ([String], String)
forall a c b. (a -> c -> (b, c)) -> [a] -> c -> ([b], c)
carryscan Content t -> String -> (String, String)
forall t. Content t -> String -> (String, String)
carrycontent [Content t]
cs (ShowS
forall t. t -> t
text String
">")
                          in
                          ( String
c String -> ShowS
forall a. [a] -> [a] -> [a]
<>
                            ShowS
forall t. t -> t
text String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
<> QName -> String
qname QName
n String -> ShowS
<+> [String] -> String
fsep ((Attribute -> String) -> [Attribute] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Attribute -> String
attribute [Attribute]
as) String -> ShowS
$$
                            Int -> ShowS
forall t t1. t -> t1 -> t1
nest (Int
2 :: Int) ([String] -> String
vcat [String]
cs0) String -> ShowS
forall a. [a] -> [a] -> [a]
<> --- $$
                            String
d0 String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
forall t. t -> t
text String
"</" String -> ShowS
forall a. [a] -> [a] -> [a]
<> QName -> String
qname QName
n
                          , ShowS
forall t. t -> t
text String
">")
carrycontent :: Content t -> [Char] -> ([Char], [Char])
carryelem :: Element t -> [Char] -> ([Char], [Char])
carrycontent :: Content t -> String -> (String, String)
carrycontent (CElem Element t
e t
_) String
c   = Element t -> String -> (String, String)
forall t. Element t -> String -> (String, String)
carryelem Element t
e String
c
carrycontent (CString Bool
False String
s t
_) String
c = (String
c String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
forall t. t -> t
chardata String
s, String
empty)
carrycontent (CString Bool
True  String
s t
_) String
c = (String
c String -> ShowS
forall a. [a] -> [a] -> [a]
<> ShowS
cdsect String
s, String
empty)
carrycontent (CRef Reference
r t
_) String
c    = (String
c String -> ShowS
forall a. [a] -> [a] -> [a]
<> Reference -> String
reference Reference
r, String
empty)
carrycontent (CMisc Misc
m t
_) String
c   = (String
c String -> ShowS
forall a. [a] -> [a] -> [a]
<> Misc -> String
misc Misc
m, String
empty)

carryscan :: (a->c->(b,c)) -> [a] -> c -> ([b],c)
carryscan :: (a -> c -> (b, c)) -> [a] -> c -> ([b], c)
carryscan a -> c -> (b, c)
_ []     c
c = ([],c
c)
carryscan a -> c -> (b, c)
f (a
a:[a]
as) c
c = let (b
b, c
c0) = a -> c -> (b, c)
f a
a c
c
                           ([b]
bs,c
c1) = (a -> c -> (b, c)) -> [a] -> c -> ([b], c)
forall a c b. (a -> c -> (b, c)) -> [a] -> c -> ([b], c)
carryscan a -> c -> (b, c)
f [a]
as c
c0
                       in (b
bb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
bs, c
c1)

--carryelem e@(Elem n as cs) c
--  | isText (head cs) =
--        ( start <>
--          text ">" <> hcat (map content cs) <> text "</" <> text n
--        , text ">")
--  | otherwise =
--        let (d,c0) = foldl carrycontent (start, text ">") cs in
--        ( d <> c0 <> text "</" <> text n
--        , text ">")
--  where start = c <> text "<" <> text n <+> fsep (map attribute as)
--
--carrycontent (d,c) (CElem e)   = let (d',c') = carryelem e c in
--                                 (d $$ nest 2 d',       c')
--carrycontent (d,c) (CString _ s) = (d <> c <> chardata s, empty)
--carrycontent (d,c) (CRef r)    = (d <> c <> reference r,empty)
--carrycontent (d,c) (CMisc m)   = (d $$ c <> misc m,     empty)


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

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

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

qname :: QName -> String
qname QName
n                        = ShowS
forall t. t -> t
text (QName -> String
printableName QName
n)

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