{-# LANGUAGE CPP                        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

-- | 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 Network.XmlRpc.Pretty (document, content, element,
                              doctypedecl, prolog, cp) where

import           Blaze.ByteString.Builder           (Builder,
                                                     fromLazyByteString,
                                                     toLazyByteString)
import           Blaze.ByteString.Builder.Char.Utf8 (fromString)
import           Data.ByteString.Lazy.Char8         (ByteString, elem, empty)
import qualified Data.ByteString.Lazy.UTF8          as BU
import           Data.Maybe                         (isNothing)
import           Data.Monoid                        (Monoid, mappend, mconcat,
                                                     mempty)
import           Data.Semigroup                     (Semigroup)
import qualified GHC.Exts                           as Ext
import           Prelude                            hiding (concat, elem, head,
                                                     maybe, null)
import qualified Prelude                            as P
import           Text.XML.HaXml.Types

-- |A 'Builder' with a recognizable empty value.
newtype MBuilder = MBuilder { MBuilder -> Maybe Builder
unMB :: Maybe Builder } deriving (NonEmpty MBuilder -> MBuilder
MBuilder -> MBuilder -> MBuilder
forall b. Integral b => b -> MBuilder -> MBuilder
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> MBuilder -> MBuilder
$cstimes :: forall b. Integral b => b -> MBuilder -> MBuilder
sconcat :: NonEmpty MBuilder -> MBuilder
$csconcat :: NonEmpty MBuilder -> MBuilder
<> :: MBuilder -> MBuilder -> MBuilder
$c<> :: MBuilder -> MBuilder -> MBuilder
Semigroup, Semigroup MBuilder
MBuilder
[MBuilder] -> MBuilder
MBuilder -> MBuilder -> MBuilder
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MBuilder] -> MBuilder
$cmconcat :: [MBuilder] -> MBuilder
mappend :: MBuilder -> MBuilder -> MBuilder
$cmappend :: MBuilder -> MBuilder -> MBuilder
mempty :: MBuilder
$cmempty :: MBuilder
Monoid)

-- |'Maybe' eliminator specialized for 'MBuilder'.
maybe :: (t -> MBuilder) -> Maybe t -> MBuilder
maybe :: forall t. (t -> MBuilder) -> Maybe t -> MBuilder
maybe t -> MBuilder
_ Maybe t
Nothing  = forall a. Monoid a => a
mempty
maybe t -> MBuilder
f (Just t
x) = t -> MBuilder
f t
x

-- |Nullity predicate for 'MBuilder'.
null :: MBuilder -> Bool
null :: MBuilder -> Bool
null = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBuilder -> Maybe Builder
unMB

-- |Helper for injecting 'ByteString's into 'MBuilder'.
fromLBS :: ByteString -> MBuilder
fromLBS :: ByteString -> MBuilder
fromLBS = Maybe Builder -> MBuilder
MBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
fromLazyByteString

-- Helper needed when using Data.Binary.Builder.
-- fromString :: String -> Builder
-- fromString = fromLazyByteString . BU.fromString

-- |Support for the OverloadedStrings extension to improve templating
-- syntax.
instance Ext.IsString MBuilder where
  fromString :: String -> MBuilder
fromString String
"" = forall a. Monoid a => a
mempty
  fromString String
s  = Maybe Builder -> MBuilder
MBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString forall a b. (a -> b) -> a -> b
$ String
s

-- Only define <> as mappend if not already provided in Prelude
#if !MIN_VERSION_base(4,11,0)
infixr 6 <>

-- |Beside.
(<>) :: MBuilder -> MBuilder -> MBuilder
(<>) = mappend
#endif

-- A simple implementation of the pretty-printing combinator interface,
-- but for plain ByteStrings:
infixr 6 <+>
infixr 5 $$

-- |Concatenate two 'MBuilder's with a single space in between
-- them. If either of the component 'MBuilder's is empty, then the
-- other is returned without any additional space.
(<+>) :: MBuilder -> MBuilder -> MBuilder
<+> :: MBuilder -> MBuilder -> MBuilder
(<+>) MBuilder
b1 MBuilder
b2
  | MBuilder -> Bool
null MBuilder
b2 = MBuilder
b1
  | MBuilder -> Bool
null MBuilder
b1 = MBuilder
b2
  | Bool
otherwise = MBuilder
b1 forall a. Semigroup a => a -> a -> a
<> MBuilder
" " forall a. Semigroup a => a -> a -> a
<> MBuilder
b2

-- |Concatenate two 'MBuilder's with a single newline in between
-- them. If either of the component 'MBuilder's is empty, then the
-- other is returned without any additional newline.
($$) :: MBuilder -> MBuilder -> MBuilder
$$ :: MBuilder -> MBuilder -> MBuilder
($$) MBuilder
b1 MBuilder
b2
  | MBuilder -> Bool
null MBuilder
b2 = MBuilder
b1
  | MBuilder -> Bool
null MBuilder
b1 = MBuilder
b2
  | Bool
otherwise =  MBuilder
b1 forall a. Semigroup a => a -> a -> a
<> MBuilder
"\n" forall a. Semigroup a => a -> a -> a
<> MBuilder
b2

-- |Concatenate a list of 'MBuilder's with a given 'MBuilder' inserted
-- between each non-empty element of the list.
intercalate :: MBuilder -> [MBuilder] -> MBuilder
intercalate :: MBuilder -> [MBuilder] -> MBuilder
intercalate MBuilder
sep = [MBuilder] -> MBuilder
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBuilder -> Bool
null)
  where aux :: [MBuilder] -> MBuilder
aux []     = forall a. Monoid a => a
mempty
        aux (MBuilder
x:[MBuilder]
xs) = MBuilder
x forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (MBuilder
sep forall a. Semigroup a => a -> a -> a
<>) [MBuilder]
xs)

-- |List version of '<+>'.
hsep :: [MBuilder] -> MBuilder
hsep :: [MBuilder] -> MBuilder
hsep = MBuilder -> [MBuilder] -> MBuilder
intercalate MBuilder
" "

-- |List version of '$$'.
vcat :: [MBuilder] -> MBuilder
vcat :: [MBuilder] -> MBuilder
vcat = MBuilder -> [MBuilder] -> MBuilder
intercalate MBuilder
"\n"

hcatMap :: (a -> MBuilder) -> [a] -> MBuilder
hcatMap :: forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap = (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map

vcatMap :: (a -> MBuilder) -> [a] -> MBuilder
vcatMap :: forall a. (a -> MBuilder) -> [a] -> MBuilder
vcatMap = ([MBuilder] -> MBuilder
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map

-- |``Paragraph fill'' version of 'sep'.
fsep :: [MBuilder] -> MBuilder
fsep :: [MBuilder] -> MBuilder
fsep = [MBuilder] -> MBuilder
hsep

-- |Bracket an 'MBuilder' with parentheses.
parens :: MBuilder -> MBuilder
parens :: MBuilder -> MBuilder
parens MBuilder
p = MBuilder
"(" forall a. Semigroup a => a -> a -> a
<> MBuilder
p forall a. Semigroup a => a -> a -> a
<> MBuilder
")"

text :: String -> MBuilder
text :: String -> MBuilder
text = Maybe Builder -> MBuilder
MBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString

name :: QName -> MBuilder
name :: QName -> MBuilder
name = Maybe Builder -> MBuilder
MBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
unQ
  where unQ :: QName -> String
unQ (QN (Namespace String
prefix String
uri) String
n) = String
prefixforall a. [a] -> [a] -> [a]
++String
":"forall a. [a] -> [a] -> [a]
++String
n
        unQ (N String
n)                         = String
n

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

-- |Render a 'Document' to a 'ByteString'.
document    :: Document i  -> ByteString
content     :: Content i   -> ByteString
element     :: Element i   -> ByteString
doctypedecl :: DocTypeDecl -> ByteString
prolog      :: Prolog      -> ByteString
cp          :: CP          -> ByteString

-- Builder variants of exported functions.
documentB    :: Document i  -> MBuilder
contentB     :: Content i   -> MBuilder
elementB     :: Element i   -> MBuilder
doctypedeclB :: DocTypeDecl -> MBuilder
prologB      :: Prolog      -> MBuilder
cpB          :: CP          -> MBuilder

xmldecl    :: XMLDecl    -> MBuilder
misc       :: Misc       -> MBuilder
sddecl     :: Bool       -> MBuilder
markupdecl :: MarkupDecl -> MBuilder
attribute  :: Attribute  -> MBuilder

-- |Run an 'MBuilder' to generate a 'ByteString'.
runMBuilder :: MBuilder -> ByteString
runMBuilder :: MBuilder -> ByteString
runMBuilder = Maybe Builder -> ByteString
aux forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBuilder -> Maybe Builder
unMB
  where aux :: Maybe Builder -> ByteString
aux Maybe Builder
Nothing  = ByteString
empty
        aux (Just Builder
b) = Builder -> ByteString
toLazyByteString Builder
b

document :: forall i. Document i -> ByteString
document    = MBuilder -> ByteString
runMBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Document i -> MBuilder
documentB
content :: forall i. Content i -> ByteString
content     = MBuilder -> ByteString
runMBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Content i -> MBuilder
contentB
element :: forall i. Element i -> ByteString
element     = MBuilder -> ByteString
runMBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i. Element i -> MBuilder
elementB
doctypedecl :: DocTypeDecl -> ByteString
doctypedecl = MBuilder -> ByteString
runMBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. DocTypeDecl -> MBuilder
doctypedeclB
prolog :: Prolog -> ByteString
prolog      = MBuilder -> ByteString
runMBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prolog -> MBuilder
prologB
cp :: CP -> ByteString
cp          = MBuilder -> ByteString
runMBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. CP -> MBuilder
cpB

documentB :: forall i. Document i -> MBuilder
documentB (Document Prolog
p SymTab EntityDef
_ Element i
e [Misc]
m) = Prolog -> MBuilder
prologB Prolog
p MBuilder -> MBuilder -> MBuilder
$$ forall i. Element i -> MBuilder
elementB Element i
e MBuilder -> MBuilder -> MBuilder
$$ forall a. (a -> MBuilder) -> [a] -> MBuilder
vcatMap Misc -> MBuilder
misc [Misc]
m

prologB :: Prolog -> MBuilder
prologB (Prolog Maybe XMLDecl
x [Misc]
m1 Maybe DocTypeDecl
dtd [Misc]
m2) = forall t. (t -> MBuilder) -> Maybe t -> MBuilder
maybe XMLDecl -> MBuilder
xmldecl Maybe XMLDecl
x MBuilder -> MBuilder -> MBuilder
$$
                               forall a. (a -> MBuilder) -> [a] -> MBuilder
vcatMap Misc -> MBuilder
misc [Misc]
m1 MBuilder -> MBuilder -> MBuilder
$$
                               forall t. (t -> MBuilder) -> Maybe t -> MBuilder
maybe DocTypeDecl -> MBuilder
doctypedeclB Maybe DocTypeDecl
dtd MBuilder -> MBuilder -> MBuilder
$$
                               forall a. (a -> MBuilder) -> [a] -> MBuilder
vcatMap Misc -> MBuilder
misc [Misc]
m2

xmldecl :: XMLDecl -> MBuilder
xmldecl (XMLDecl String
v Maybe EncodingDecl
e Maybe Bool
sd)    = MBuilder
"<?xml version='" forall a. Semigroup a => a -> a -> a
<> String -> MBuilder
text String
v forall a. Semigroup a => a -> a -> a
<> MBuilder
"'" MBuilder -> MBuilder -> MBuilder
<+>
                              forall t. (t -> MBuilder) -> Maybe t -> MBuilder
maybe EncodingDecl -> MBuilder
encodingdecl Maybe EncodingDecl
e MBuilder -> MBuilder -> MBuilder
<+>
                              forall t. (t -> MBuilder) -> Maybe t -> MBuilder
maybe Bool -> MBuilder
sddecl Maybe Bool
sd MBuilder -> MBuilder -> MBuilder
<+> MBuilder
"?>"

misc :: Misc -> MBuilder
misc (Comment String
s) = MBuilder
"<!--" MBuilder -> MBuilder -> MBuilder
<+> String -> MBuilder
text String
s MBuilder -> MBuilder -> MBuilder
<+> MBuilder
"-->"
misc (PI (String
n,String
s))  = MBuilder
"<?" forall a. Semigroup a => a -> a -> a
<> String -> MBuilder
text String
n MBuilder -> MBuilder -> MBuilder
<+> String -> MBuilder
text String
s MBuilder -> MBuilder -> MBuilder
<+> MBuilder
"?>"

sddecl :: Bool -> MBuilder
sddecl Bool
sd   | Bool
sd            = MBuilder
"standalone='yes'"
            | Bool
otherwise     = MBuilder
"standalone='no'"

doctypedeclB :: DocTypeDecl -> MBuilder
doctypedeclB (DTD QName
n Maybe ExternalID
eid [MarkupDecl]
ds)  = if forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [MarkupDecl]
ds then MBuilder
hd forall a. Semigroup a => a -> a -> a
<> MBuilder
">"
                               else MBuilder
hd MBuilder -> MBuilder -> MBuilder
<+> MBuilder
" [" MBuilder -> MBuilder -> MBuilder
$$ forall a. (a -> MBuilder) -> [a] -> MBuilder
vcatMap MarkupDecl -> MBuilder
markupdecl [MarkupDecl]
ds MBuilder -> MBuilder -> MBuilder
$$ MBuilder
"]>"
  where hd :: MBuilder
hd = MBuilder
"<!DOCTYPE" MBuilder -> MBuilder -> MBuilder
<+> QName -> MBuilder
name QName
n MBuilder -> MBuilder -> MBuilder
<+> forall t. (t -> MBuilder) -> Maybe t -> MBuilder
maybe ExternalID -> MBuilder
externalid Maybe ExternalID
eid

markupdecl :: MarkupDecl -> MBuilder
markupdecl (Element ElementDecl
e)    = ElementDecl -> MBuilder
elementdecl ElementDecl
e
markupdecl (AttList AttListDecl
a)    = AttListDecl -> MBuilder
attlistdecl AttListDecl
a
markupdecl (Entity EntityDecl
e)     = EntityDecl -> MBuilder
entitydecl EntityDecl
e
markupdecl (Notation NotationDecl
n)   = NotationDecl -> MBuilder
notationdecl NotationDecl
n
markupdecl (MarkupMisc Misc
m) = Misc -> MBuilder
misc Misc
m

elementB :: forall i. Element i -> MBuilder
elementB (Elem QName
n [Attribute]
as []) = MBuilder
"<" forall a. Semigroup a => a -> a -> a
<> (QName -> MBuilder
name QName
n MBuilder -> MBuilder -> MBuilder
<+> [MBuilder] -> MBuilder
fsep (forall a b. (a -> b) -> [a] -> [b]
map Attribute -> MBuilder
attribute [Attribute]
as)) forall a. Semigroup a => a -> a -> a
<> MBuilder
"/>"
elementB (Elem QName
n [Attribute]
as [Content i]
cs)
  | forall t. Content t -> Bool
isText (forall a. [a] -> a
P.head [Content i]
cs)  = MBuilder
"<" forall a. Semigroup a => a -> a -> a
<> (QName -> MBuilder
name QName
n MBuilder -> MBuilder -> MBuilder
<+> [MBuilder] -> MBuilder
fsep (forall a b. (a -> b) -> [a] -> [b]
map Attribute -> MBuilder
attribute [Attribute]
as)) forall a. Semigroup a => a -> a -> a
<> MBuilder
">" forall a. Semigroup a => a -> a -> a
<>
                          forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap forall i. Content i -> MBuilder
contentB [Content i]
cs forall a. Semigroup a => a -> a -> a
<> MBuilder
"</" forall a. Semigroup a => a -> a -> a
<> QName -> MBuilder
name QName
n forall a. Semigroup a => a -> a -> a
<> MBuilder
">"
  | Bool
otherwise           = MBuilder
"<" forall a. Semigroup a => a -> a -> a
<> (QName -> MBuilder
name QName
n MBuilder -> MBuilder -> MBuilder
<+> [MBuilder] -> MBuilder
fsep (forall a b. (a -> b) -> [a] -> [b]
map Attribute -> MBuilder
attribute [Attribute]
as)) forall a. Semigroup a => a -> a -> a
<> MBuilder
">" forall a. Semigroup a => a -> a -> a
<>
                          forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap forall i. Content i -> MBuilder
contentB [Content i]
cs forall a. Semigroup a => a -> a -> a
<> MBuilder
"</" forall a. Semigroup a => a -> a -> a
<> QName -> MBuilder
name QName
n forall a. Semigroup a => a -> a -> a
<> MBuilder
">"

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

attribute :: Attribute -> MBuilder
attribute (QName
n,AttValue
v) = QName -> MBuilder
name QName
n forall a. Semigroup a => a -> a -> a
<> MBuilder
"=" forall a. Semigroup a => a -> a -> a
<> AttValue -> MBuilder
attvalue AttValue
v

contentB :: forall i. Content i -> MBuilder
contentB (CElem Element i
e i
_)         = forall i. Element i -> MBuilder
elementB Element i
e
contentB (CString Bool
False String
s i
_) = String -> MBuilder
chardata String
s
contentB (CString Bool
True String
s i
_)  = String -> MBuilder
cdsect String
s
contentB (CRef Reference
r i
_)          = Reference -> MBuilder
reference Reference
r
contentB (CMisc Misc
m i
_)         = Misc -> MBuilder
misc Misc
m

elementdecl :: ElementDecl -> MBuilder
elementdecl :: ElementDecl -> MBuilder
elementdecl (ElementDecl QName
n ContentSpec
cs) = MBuilder
"<!ELEMENT" MBuilder -> MBuilder -> MBuilder
<+> QName -> MBuilder
name QName
n MBuilder -> MBuilder -> MBuilder
<+>
                                 ContentSpec -> MBuilder
contentspec ContentSpec
cs forall a. Semigroup a => a -> a -> a
<> MBuilder
">"

contentspec :: ContentSpec -> MBuilder
contentspec :: ContentSpec -> MBuilder
contentspec ContentSpec
EMPTY           = MBuilder
"EMPTY"
contentspec ContentSpec
ANY             = MBuilder
"ANY"
contentspec (Mixed Mixed
m)       = Mixed -> MBuilder
mixed Mixed
m
contentspec (ContentSpec CP
c) = CP -> MBuilder
cpB CP
c

cpB :: CP -> MBuilder
cpB (TagName QName
n Modifier
m) = QName -> MBuilder
name QName
n forall a. Semigroup a => a -> a -> a
<> Modifier -> MBuilder
modifier Modifier
m
cpB (Choice [CP]
cs Modifier
m) = MBuilder -> MBuilder
parens (MBuilder -> [MBuilder] -> MBuilder
intercalate MBuilder
"|" (forall a b. (a -> b) -> [a] -> [b]
map CP -> MBuilder
cpB [CP]
cs)) forall a. Semigroup a => a -> a -> a
<> Modifier -> MBuilder
modifier Modifier
m
cpB (Seq [CP]
cs Modifier
m)    = MBuilder -> MBuilder
parens (MBuilder -> [MBuilder] -> MBuilder
intercalate MBuilder
"," (forall a b. (a -> b) -> [a] -> [b]
map CP -> MBuilder
cpB [CP]
cs)) forall a. Semigroup a => a -> a -> a
<> Modifier -> MBuilder
modifier Modifier
m

modifier :: Modifier -> MBuilder
modifier :: Modifier -> MBuilder
modifier Modifier
None  = forall a. Monoid a => a
mempty
modifier Modifier
Query = MBuilder
"?"
modifier Modifier
Star  = MBuilder
"*"
modifier Modifier
Plus  = MBuilder
"+"

mixed :: Mixed -> MBuilder
mixed :: Mixed -> MBuilder
mixed  Mixed
PCDATA         = MBuilder
"(#PCDATA)"
mixed (PCDATAplus [QName]
ns) = MBuilder
"(#PCDATA |" MBuilder -> MBuilder -> MBuilder
<+> MBuilder -> [MBuilder] -> MBuilder
intercalate MBuilder
"|" (forall a b. (a -> b) -> [a] -> [b]
map QName -> MBuilder
name [QName]
ns) forall a. Semigroup a => a -> a -> a
<> MBuilder
")*"

attlistdecl :: AttListDecl -> MBuilder
attlistdecl :: AttListDecl -> MBuilder
attlistdecl (AttListDecl QName
n [AttDef]
ds) = MBuilder
"<!ATTLIST" MBuilder -> MBuilder -> MBuilder
<+> QName -> MBuilder
name QName
n MBuilder -> MBuilder -> MBuilder
<+>
                                 [MBuilder] -> MBuilder
fsep (forall a b. (a -> b) -> [a] -> [b]
map AttDef -> MBuilder
attdef [AttDef]
ds) forall a. Semigroup a => a -> a -> a
<> MBuilder
">"

attdef :: AttDef -> MBuilder
attdef :: AttDef -> MBuilder
attdef (AttDef QName
n AttType
t DefaultDecl
d)          = QName -> MBuilder
name QName
n MBuilder -> MBuilder -> MBuilder
<+> AttType -> MBuilder
atttype AttType
t MBuilder -> MBuilder -> MBuilder
<+> DefaultDecl -> MBuilder
defaultdecl DefaultDecl
d

atttype :: AttType -> MBuilder
atttype :: AttType -> MBuilder
atttype  AttType
StringType        = MBuilder
"CDATA"
atttype (TokenizedType TokenizedType
t)  = TokenizedType -> MBuilder
tokenizedtype TokenizedType
t
atttype (EnumeratedType EnumeratedType
t) = EnumeratedType -> MBuilder
enumeratedtype EnumeratedType
t

tokenizedtype :: TokenizedType -> MBuilder
tokenizedtype :: TokenizedType -> MBuilder
tokenizedtype TokenizedType
ID       = MBuilder
"ID"
tokenizedtype TokenizedType
IDREF    = MBuilder
"IDREF"
tokenizedtype TokenizedType
IDREFS   = MBuilder
"IDREFS"
tokenizedtype TokenizedType
ENTITY   = MBuilder
"ENTITY"
tokenizedtype TokenizedType
ENTITIES = MBuilder
"ENTITIES"
tokenizedtype TokenizedType
NMTOKEN  = MBuilder
"NMTOKEN"
tokenizedtype TokenizedType
NMTOKENS = MBuilder
"NMTOKENS"

enumeratedtype :: EnumeratedType -> MBuilder
enumeratedtype :: EnumeratedType -> MBuilder
enumeratedtype (NotationType NotationType
n) = NotationType -> MBuilder
notationtype NotationType
n
enumeratedtype (Enumeration NotationType
e)  = NotationType -> MBuilder
enumeration NotationType
e

notationtype :: [[Char]] -> MBuilder
notationtype :: NotationType -> MBuilder
notationtype NotationType
ns                = MBuilder
"NOTATION" MBuilder -> MBuilder -> MBuilder
<+>
                                 MBuilder -> MBuilder
parens (MBuilder -> [MBuilder] -> MBuilder
intercalate MBuilder
"|" (forall a b. (a -> b) -> [a] -> [b]
map String -> MBuilder
text NotationType
ns))

enumeration :: [[Char]] -> MBuilder
enumeration :: NotationType -> MBuilder
enumeration NotationType
ns                 = MBuilder -> MBuilder
parens (MBuilder -> [MBuilder] -> MBuilder
intercalate MBuilder
"|" (forall a b. (a -> b) -> [a] -> [b]
map String -> MBuilder
nmtoken NotationType
ns))

defaultdecl :: DefaultDecl -> MBuilder
defaultdecl :: DefaultDecl -> MBuilder
defaultdecl  DefaultDecl
REQUIRED       = MBuilder
"#REQUIRED"
defaultdecl  DefaultDecl
IMPLIED        = MBuilder
"#IMPLIED"
defaultdecl (DefaultTo AttValue
a Maybe FIXED
f) = forall t. (t -> MBuilder) -> Maybe t -> MBuilder
maybe (forall a b. a -> b -> a
const MBuilder
"#FIXED") Maybe FIXED
f MBuilder -> MBuilder -> MBuilder
<+> AttValue -> MBuilder
attvalue AttValue
a

reference :: Reference -> MBuilder
reference :: Reference -> MBuilder
reference (RefEntity String
er) = String -> MBuilder
entityref String
er
reference (RefChar CharRef
cr)   = forall a. Show a => a -> MBuilder
charref CharRef
cr

entityref :: [Char] -> MBuilder
entityref :: String -> MBuilder
entityref String
n                    = MBuilder
"&" forall a. Semigroup a => a -> a -> a
<> String -> MBuilder
text String
n forall a. Semigroup a => a -> a -> a
<> MBuilder
";"

charref :: (Show a) => a -> MBuilder
charref :: forall a. Show a => a -> MBuilder
charref a
c                      = MBuilder
"&#" forall a. Semigroup a => a -> a -> a
<> String -> MBuilder
text (forall a. Show a => a -> String
show a
c) forall a. Semigroup a => a -> a -> a
<> MBuilder
";"

entitydecl :: EntityDecl -> MBuilder
entitydecl :: EntityDecl -> MBuilder
entitydecl (EntityGEDecl GEDecl
d) = GEDecl -> MBuilder
gedecl GEDecl
d
entitydecl (EntityPEDecl PEDecl
d) = PEDecl -> MBuilder
pedecl PEDecl
d

gedecl :: GEDecl -> MBuilder
gedecl :: GEDecl -> MBuilder
gedecl (GEDecl String
n EntityDef
ed)           = MBuilder
"<!ENTITY" MBuilder -> MBuilder -> MBuilder
<+> String -> MBuilder
text String
n MBuilder -> MBuilder -> MBuilder
<+> EntityDef -> MBuilder
entitydef EntityDef
ed forall a. Semigroup a => a -> a -> a
<> MBuilder
">"

pedecl :: PEDecl -> MBuilder
pedecl :: PEDecl -> MBuilder
pedecl (PEDecl String
n PEDef
pd)           = MBuilder
"<!ENTITY %" forall a. Semigroup a => a -> a -> a
<> String -> MBuilder
text String
n MBuilder -> MBuilder -> MBuilder
<+> PEDef -> MBuilder
pedef PEDef
pd forall a. Semigroup a => a -> a -> a
<> MBuilder
">"

entitydef :: EntityDef -> MBuilder
entitydef :: EntityDef -> MBuilder
entitydef (DefEntityValue EntityValue
ew)  = EntityValue -> MBuilder
entityvalue EntityValue
ew
entitydef (DefExternalID ExternalID
i Maybe NDataDecl
nd) = ExternalID -> MBuilder
externalid ExternalID
i MBuilder -> MBuilder -> MBuilder
<+> forall t. (t -> MBuilder) -> Maybe t -> MBuilder
maybe NDataDecl -> MBuilder
ndatadecl Maybe NDataDecl
nd

pedef :: PEDef -> MBuilder
pedef :: PEDef -> MBuilder
pedef (PEDefEntityValue EntityValue
ew) = EntityValue -> MBuilder
entityvalue EntityValue
ew
pedef (PEDefExternalID ExternalID
eid) = ExternalID -> MBuilder
externalid ExternalID
eid

externalid :: ExternalID -> MBuilder
externalid :: ExternalID -> MBuilder
externalid (SYSTEM SystemLiteral
sl)   = MBuilder
"SYSTEM" MBuilder -> MBuilder -> MBuilder
<+> SystemLiteral -> MBuilder
systemliteral SystemLiteral
sl
externalid (PUBLIC PubidLiteral
i SystemLiteral
sl) = MBuilder
"PUBLIC" MBuilder -> MBuilder -> MBuilder
<+> PubidLiteral -> MBuilder
pubidliteral PubidLiteral
i MBuilder -> MBuilder -> MBuilder
<+> SystemLiteral -> MBuilder
systemliteral SystemLiteral
sl

ndatadecl :: NDataDecl -> MBuilder
ndatadecl :: NDataDecl -> MBuilder
ndatadecl (NDATA String
n)            = MBuilder
"NDATA" MBuilder -> MBuilder -> MBuilder
<+> String -> MBuilder
text String
n

notationdecl :: NotationDecl -> MBuilder
notationdecl :: NotationDecl -> MBuilder
notationdecl (NOTATION String
n Either ExternalID PublicID
e)    = MBuilder
"<!NOTATION" MBuilder -> MBuilder -> MBuilder
<+> String -> MBuilder
text String
n MBuilder -> MBuilder -> MBuilder
<+>
                                 forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ExternalID -> MBuilder
externalid PublicID -> MBuilder
publicid Either ExternalID PublicID
e forall a. Semigroup a => a -> a -> a
<> MBuilder
">"

publicid :: PublicID -> MBuilder
publicid :: PublicID -> MBuilder
publicid (PUBLICID PubidLiteral
p)          = MBuilder
"PUBLICID" MBuilder -> MBuilder -> MBuilder
<+> PubidLiteral -> MBuilder
pubidliteral PubidLiteral
p

encodingdecl :: EncodingDecl -> MBuilder
encodingdecl :: EncodingDecl -> MBuilder
encodingdecl (EncodingDecl String
s)  = MBuilder
"encoding='" forall a. Semigroup a => a -> a -> a
<> String -> MBuilder
text String
s forall a. Semigroup a => a -> a -> a
<> MBuilder
"'"

nmtoken :: [Char] -> MBuilder
nmtoken :: String -> MBuilder
nmtoken String
s                      = String -> MBuilder
text String
s

attvalue :: AttValue -> MBuilder
attvalue :: AttValue -> MBuilder
attvalue (AttValue [Either String Reference]
esr)        = MBuilder
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap Either String Reference -> MBuilder
attVal [Either String Reference]
esr forall a. Semigroup a => a -> a -> a
<> MBuilder
"\""
  where attVal :: Either String Reference -> MBuilder
attVal = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> MBuilder
text Reference -> MBuilder
reference

entityvalue :: EntityValue -> MBuilder
entityvalue :: EntityValue -> MBuilder
entityvalue (EntityValue [EV]
evs)
  | [EV] -> Bool
containsDoubleQuote [EV]
evs    = MBuilder
"'"  forall a. Semigroup a => a -> a -> a
<> forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap EV -> MBuilder
ev [EV]
evs forall a. Semigroup a => a -> a -> a
<> MBuilder
"'"
  | Bool
otherwise                  = MBuilder
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap EV -> MBuilder
ev [EV]
evs forall a. Semigroup a => a -> a -> a
<> MBuilder
"\""

ev :: EV -> MBuilder
ev :: EV -> MBuilder
ev (EVString String
s) = String -> MBuilder
text String
s
ev (EVRef Reference
r)    = Reference -> MBuilder
reference Reference
r

pubidliteral :: PubidLiteral -> MBuilder
pubidliteral :: PubidLiteral -> MBuilder
pubidliteral (PubidLiteral String
s)
    | Char
'"' Char -> ByteString -> Bool
`elem` ByteString
s' = MBuilder
"'" forall a. Semigroup a => a -> a -> a
<> ByteString -> MBuilder
fromLBS ByteString
s' forall a. Semigroup a => a -> a -> a
<> MBuilder
"'"
    | Bool
otherwise     = MBuilder
"\"" forall a. Semigroup a => a -> a -> a
<> ByteString -> MBuilder
fromLBS ByteString
s' forall a. Semigroup a => a -> a -> a
<> MBuilder
"\""
    where s' :: ByteString
s' = String -> ByteString
BU.fromString String
s

systemliteral :: SystemLiteral -> MBuilder
systemliteral :: SystemLiteral -> MBuilder
systemliteral (SystemLiteral String
s)
    | Char
'"' Char -> ByteString -> Bool
`elem` ByteString
s' = MBuilder
"'" forall a. Semigroup a => a -> a -> a
<> ByteString -> MBuilder
fromLBS ByteString
s' forall a. Semigroup a => a -> a -> a
<> MBuilder
"'"
    | Bool
otherwise     = MBuilder
"\"" forall a. Semigroup a => a -> a -> a
<> ByteString -> MBuilder
fromLBS ByteString
s' forall a. Semigroup a => a -> a -> a
<> MBuilder
"\""
    where s' :: ByteString
s' = String -> ByteString
BU.fromString String
s

chardata, cdsect :: [Char] -> MBuilder
chardata :: String -> MBuilder
chardata String
s                     = {-if all isSpace s then empty else-} String -> MBuilder
text String
s
cdsect :: String -> MBuilder
cdsect String
c                       = MBuilder
"<![CDATA[" forall a. Semigroup a => a -> a -> a
<> String -> MBuilder
chardata String
c forall a. Semigroup a => a -> a -> a
<> MBuilder
"]]>"

containsDoubleQuote :: [EV] -> Bool
containsDoubleQuote :: [EV] -> Bool
containsDoubleQuote [EV]
evs = 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 -> ByteString -> Bool
`elem` String -> ByteString
BU.fromString String
s
          csq EV
_            = Bool
False