{-# LANGUAGE CPP #-}
-- | This is a fast non-pretty-printer for turning the internal representation
--   of generic structured XML documents into Lazy ByteStrings.
--   Like in Text.Xml.HaXml.Pretty, 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.ByteStringPP
  (
  -- * 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,elem,concat,(<>))
#else
import Prelude hiding (maybe,either,elem,concat)
#endif

import Data.Maybe hiding (maybe)
import Data.List (intersperse)
--import Data.ByteString.Lazy hiding (pack,map,head,any,singleton,intersperse,join)
import Data.ByteString.Lazy.Char8 (ByteString(), concat, pack, singleton
                                  , intercalate, append, elem, empty)
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 -> ByteString) -> Maybe t -> ByteString
maybe :: forall t. (t -> ByteString) -> Maybe t -> ByteString
maybe t -> ByteString
_ Maybe t
Nothing  = ByteString
empty
maybe t -> ByteString
f (Just t
x) = t -> ByteString
f t
x


-- A simple implementation of the pretty-printing combinator interface,
-- but for plain ByteStrings:
infixl 6 <>
infixl 6 <+>
infixl 5 $$
(<>)   :: ByteString   -> ByteString -> ByteString -- Beside
hcat   :: [ByteString] -> ByteString               -- List version of <>
(<+>)  :: ByteString   -> ByteString -> ByteString -- Beside, separated by space
hsep   :: [ByteString] -> ByteString               -- List version of <+>
($$)   :: ByteString   -> ByteString -> ByteString -- Above; if there is no
                                                   -- overlap, it "dovetails"
vcat   :: [ByteString] -> ByteString       -- List version of $$
-- cat    :: [ByteString] -> ByteString    -- Either hcat or vcat
sep    :: [ByteString] -> ByteString       -- Either hsep or vcat
-- fcat   :: [ByteString] -> ByteString    -- ``Paragraph fill'' version of cat
fsep   :: [ByteString] -> ByteString       -- ``Paragraph fill'' version of sep
nest   :: Int -> ByteString -> ByteString  -- Nested

<> :: ByteString -> ByteString -> ByteString
(<>)  ByteString
b1 ByteString
b2  = ByteString
b1 ByteString -> ByteString -> ByteString
`append` ByteString
b2
<+> :: ByteString -> ByteString -> ByteString
(<+>) ByteString
b1 ByteString
b2  = ByteString
b1 ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
pack [Char]
" " ByteString -> ByteString -> ByteString
<> ByteString
b2
$$ :: ByteString -> ByteString -> ByteString
($$)  ByteString
b1 ByteString
b2  = ByteString
b1 ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
pack [Char]
"\n" ByteString -> ByteString -> ByteString
<> ByteString
b2
-- ($+$)        = ($$)

hcat :: [ByteString] -> ByteString
hcat = [ByteString] -> ByteString
Data.ByteString.Lazy.Char8.concat
hsep :: [ByteString] -> ByteString
hsep = ByteString -> [ByteString] -> ByteString
Data.ByteString.Lazy.Char8.intercalate (Char -> ByteString
singleton Char
' ')
vcat :: [ByteString] -> ByteString
vcat = ByteString -> [ByteString] -> ByteString
Data.ByteString.Lazy.Char8.intercalate (Char -> ByteString
singleton Char
'\n')
-- cat  = hcat
sep :: [ByteString] -> ByteString
sep  = [ByteString] -> ByteString
hsep
text :: [Char] -> ByteString
text :: [Char] -> ByteString
text = [Char] -> ByteString
pack
-- fsep = cat
fsep :: [ByteString] -> ByteString
fsep = [ByteString] -> ByteString
sep
nest :: CharRef -> ByteString -> ByteString
nest CharRef
_ ByteString
b = [Char] -> ByteString
pack [Char]
" " ByteString -> ByteString -> ByteString
<> ByteString
b
parens :: ByteString -> ByteString
parens :: ByteString -> ByteString
parens ByteString
p = [Char] -> ByteString
pack [Char]
"(" ByteString -> ByteString -> ByteString
<> ByteString
p ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
pack [Char]
")"


----
-- Now for the XML pretty-printing interface.
-- (Basically copied direct from Text.XML.HaXml.Pretty).

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

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

element   :: Element i -> ByteString
attribute :: Attribute -> ByteString
content   :: Content i -> ByteString

----

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

element :: forall i. Element i -> ByteString
element (Elem QName
n [Attribute]
as []) = [Char] -> ByteString
text [Char]
"<" ByteString -> ByteString -> ByteString
<> QName -> ByteString
qname QName
n ByteString -> ByteString -> ByteString
<+>
                         [ByteString] -> ByteString
fsep ((Attribute -> ByteString) -> [Attribute] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Attribute -> ByteString
attribute [Attribute]
as) ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
text [Char]
"/>"
element e :: Element i
e@(Elem QName
n [Attribute]
as [Content i]
cs)
--  | any isText cs    = text "<" <> text n <+> fsep (map attribute as) <>
--                       text ">" <> hcat (map content cs) <>
--                       text "</" <> qname n <> text ">"
    | Content i -> SDDecl
forall t. Content t -> SDDecl
isText ([Content i] -> Content i
forall a. HasCallStack => [a] -> a
head [Content i]
cs) = [Char] -> ByteString
text [Char]
"<" ByteString -> ByteString -> ByteString
<> QName -> ByteString
qname QName
n ByteString -> ByteString -> ByteString
<> [Attribute] -> ByteString
attributes [Attribute]
as ByteString -> ByteString -> ByteString
<>
                         [Char] -> ByteString
text [Char]
">" ByteString -> ByteString -> ByteString
<> [ByteString] -> ByteString
hcat ((Content i -> ByteString) -> [Content i] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Content i -> ByteString
forall i. Content i -> ByteString
content [Content i]
cs) ByteString -> ByteString -> ByteString
<>
                         [Char] -> ByteString
text [Char]
"</" ByteString -> ByteString -> ByteString
<> QName -> ByteString
qname QName
n ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
text [Char]
">"
    | SDDecl
otherwise        = [ByteString] -> ByteString
vcat [ [Char] -> ByteString
text [Char]
"<" ByteString -> ByteString -> ByteString
<> QName -> ByteString
qname QName
n ByteString -> ByteString -> ByteString
<> [Attribute] -> ByteString
attributes [Attribute]
as ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
text [Char]
">"
                              , CharRef -> ByteString -> ByteString
nest CharRef
2 ([ByteString] -> ByteString
vcat ((Content i -> ByteString) -> [Content i] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Content i -> ByteString
forall i. Content i -> ByteString
content [Content i]
cs))
                              , [Char] -> ByteString
text [Char]
"</" ByteString -> ByteString -> ByteString
<> QName -> ByteString
qname QName
n ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
text [Char]
">"
                              ]

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

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

carryelem :: Element t -> ByteString -> (ByteString, ByteString)
carryelem :: forall t. Element t -> ByteString -> (ByteString, ByteString)
carryelem (Elem QName
n [Attribute]
as []) ByteString
c
                       = ( ByteString
c ByteString -> ByteString -> ByteString
<>
                           [Char] -> ByteString
text [Char]
"<" ByteString -> ByteString -> ByteString
<> QName -> ByteString
qname QName
n ByteString -> ByteString -> ByteString
<+> [ByteString] -> ByteString
fsep ((Attribute -> ByteString) -> [Attribute] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Attribute -> ByteString
attribute [Attribute]
as)
                         , [Char] -> ByteString
text [Char]
"/>")
carryelem (Elem QName
n [Attribute]
as [Content t]
cs) ByteString
c
{-  | any isText cs    =  ( c <> element e, empty)
    | otherwise -}     =  let ([ByteString]
cs0,ByteString
d0) = (Content t -> ByteString -> (ByteString, ByteString))
-> [Content t] -> ByteString -> ([ByteString], ByteString)
forall a c b. (a -> c -> (b, c)) -> [a] -> c -> ([b], c)
carryscan Content t -> ByteString -> (ByteString, ByteString)
forall t. Content t -> ByteString -> (ByteString, ByteString)
carrycontent [Content t]
cs ByteString
empty
                          in
                          ( ByteString
c ByteString -> ByteString -> ByteString
<>
                            [Char] -> ByteString
text [Char]
"<" ByteString -> ByteString -> ByteString
<> QName -> ByteString
qname QName
n ByteString -> ByteString -> ByteString
<+> [ByteString] -> ByteString
fsep ((Attribute -> ByteString) -> [Attribute] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Attribute -> ByteString
attribute [Attribute]
as) ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
text [Char]
">" ByteString -> ByteString -> ByteString
$$
                            -- This is wrong. It includes the close tag of the previous one
                            CharRef -> ByteString -> ByteString
nest CharRef
2 ([ByteString] -> ByteString
vcat [ByteString]
cs0) ByteString -> ByteString -> ByteString
<> --- $$
                            ByteString
d0 ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
text [Char]
"</" ByteString -> ByteString -> ByteString
<> QName -> ByteString
qname QName
n
                          , [Char] -> ByteString
text [Char]
">")
carrycontent :: Content t -> ByteString -> (ByteString, ByteString)
carrycontent :: forall t. Content t -> ByteString -> (ByteString, ByteString)
carrycontent (CElem Element t
e t
_) ByteString
c   = Element t -> ByteString -> (ByteString, ByteString)
forall t. Element t -> ByteString -> (ByteString, ByteString)
carryelem Element t
e ByteString
c
carrycontent (CString SDDecl
False [Char]
s t
_) ByteString
c = (ByteString
c ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
chardata [Char]
s, ByteString
empty)
carrycontent (CString SDDecl
True  [Char]
s t
_) ByteString
c = (ByteString
c ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
cdsect [Char]
s, ByteString
empty)
carrycontent (CRef Reference
r t
_) ByteString
c    = (ByteString
c ByteString -> ByteString -> ByteString
<> Reference -> ByteString
reference Reference
r, ByteString
empty)
carrycontent (CMisc Misc
m t
_) ByteString
c   = (ByteString
c ByteString -> ByteString -> ByteString
<> Misc -> ByteString
misc Misc
m, ByteString
empty)

carryscan :: (a->c->(b,c)) -> [a] -> c -> ([b],c)
carryscan :: forall a c b. (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 -> ByteString
attribute (QName
n,AttValue
v)             = [Char] -> ByteString
text (QName -> [Char]
printableName QName
n) ByteString -> ByteString -> ByteString
<> [Char] -> ByteString
text [Char]
"=" ByteString -> ByteString -> ByteString
<> AttValue -> ByteString
attvalue AttValue
v
content :: forall i. Content i -> ByteString
content (CElem Element i
e i
_)         = Element i -> ByteString
forall i. Element i -> ByteString
element Element i
e
content (CString SDDecl
False [Char]
s i
_) = [Char] -> ByteString
chardata [Char]
s
content (CString SDDecl
True [Char]
s i
_)  = [Char] -> ByteString
cdsect [Char]
s
content (CRef Reference
r i
_)          = Reference -> ByteString
reference Reference
r
content (CMisc Misc
m i
_)         = Misc -> ByteString
misc Misc
m

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

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

qname :: QName -> ByteString
qname QName
n                        = [Char] -> ByteString
text (QName -> [Char]
printableName QName
n)

-- toWord8 :: Char -> Word8
toWord8 :: (Enum a, Enum a1) => a1 -> a
toWord8 :: forall a a1. (Enum a, Enum a1) => a1 -> a
toWord8 = CharRef -> a
forall a. Enum a => CharRef -> a
toEnum (CharRef -> a) -> (a1 -> CharRef) -> a1 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a1 -> CharRef
forall a. Enum a => a -> CharRef
fromEnum

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 [Char]
s) = Char -> Char
forall a a1. (Enum a, Enum a1) => a1 -> a
toWord8 Char
'"' Char -> ByteString -> SDDecl
`elem` [Char] -> ByteString
pack [Char]
s
          csq EV
_            = SDDecl
False