{-# 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 (b -> MBuilder -> MBuilder
NonEmpty MBuilder -> MBuilder
MBuilder -> MBuilder -> MBuilder
(MBuilder -> MBuilder -> MBuilder)
-> (NonEmpty MBuilder -> MBuilder)
-> (forall b. Integral b => b -> MBuilder -> MBuilder)
-> Semigroup 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 :: 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
Semigroup MBuilder =>
MBuilder
-> (MBuilder -> MBuilder -> MBuilder)
-> ([MBuilder] -> MBuilder)
-> Monoid 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
$cp1Monoid :: Semigroup MBuilder
Monoid)

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

-- |Nullity predicate for 'MBuilder'.
null :: MBuilder -> Bool
null :: MBuilder -> Bool
null = Maybe Builder -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Builder -> Bool)
-> (MBuilder -> Maybe Builder) -> MBuilder -> Bool
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 (Maybe Builder -> MBuilder)
-> (ByteString -> Maybe Builder) -> ByteString -> MBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder)
-> (ByteString -> Builder) -> ByteString -> Maybe Builder
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 "" = MBuilder
forall a. Monoid a => a
mempty
  fromString s :: String
s  = Maybe Builder -> MBuilder
MBuilder (Maybe Builder -> MBuilder)
-> (String -> Maybe Builder) -> String -> MBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder)
-> (String -> Builder) -> String -> Maybe Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString (String -> MBuilder) -> String -> MBuilder
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
(<+>) b1 :: MBuilder
b1 b2 :: MBuilder
b2
  | MBuilder -> Bool
null MBuilder
b2 = MBuilder
b1
  | MBuilder -> Bool
null MBuilder
b1 = MBuilder
b2
  | Bool
otherwise = MBuilder
b1 MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> " " MBuilder -> MBuilder -> 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
($$) b1 :: MBuilder
b1 b2 :: MBuilder
b2
  | MBuilder -> Bool
null MBuilder
b2 = MBuilder
b1
  | MBuilder -> Bool
null MBuilder
b1 = MBuilder
b2
  | Bool
otherwise =  MBuilder
b1 MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> "\n" MBuilder -> MBuilder -> MBuilder
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 sep :: MBuilder
sep = [MBuilder] -> MBuilder
aux ([MBuilder] -> MBuilder)
-> ([MBuilder] -> [MBuilder]) -> [MBuilder] -> MBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MBuilder -> Bool) -> [MBuilder] -> [MBuilder]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (MBuilder -> Bool) -> MBuilder -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBuilder -> Bool
null)
  where aux :: [MBuilder] -> MBuilder
aux []     = MBuilder
forall a. Monoid a => a
mempty
        aux (x :: MBuilder
x:xs :: [MBuilder]
xs) = MBuilder
x MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> [MBuilder] -> MBuilder
forall a. Monoid a => [a] -> a
mconcat ((MBuilder -> MBuilder) -> [MBuilder] -> [MBuilder]
forall a b. (a -> b) -> [a] -> [b]
map (MBuilder
sep MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<>) [MBuilder]
xs)

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

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

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

vcatMap :: (a -> MBuilder) -> [a] -> MBuilder
vcatMap :: (a -> MBuilder) -> [a] -> MBuilder
vcatMap = ([MBuilder] -> MBuilder
vcat ([MBuilder] -> MBuilder) -> ([a] -> [MBuilder]) -> [a] -> MBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([a] -> [MBuilder]) -> [a] -> MBuilder)
-> ((a -> MBuilder) -> [a] -> [MBuilder])
-> (a -> MBuilder)
-> [a]
-> MBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> MBuilder) -> [a] -> [MBuilder]
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 p :: MBuilder
p = "(" MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> MBuilder
p MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> ")"

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

name :: QName -> MBuilder
name :: QName -> MBuilder
name = Maybe Builder -> MBuilder
MBuilder (Maybe Builder -> MBuilder)
-> (QName -> Maybe Builder) -> QName -> MBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder)
-> (QName -> Builder) -> QName -> Maybe Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
fromString (String -> Builder) -> (QName -> String) -> QName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
unQ
  where unQ :: QName -> String
unQ (QN (Namespace prefix :: String
prefix uri :: String
uri) n :: String
n) = String
prefixString -> String -> String
forall a. [a] -> [a] -> [a]
++":"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
n
        unQ (N 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 (Maybe Builder -> ByteString)
-> (MBuilder -> Maybe Builder) -> MBuilder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MBuilder -> Maybe Builder
unMB
  where aux :: Maybe Builder -> ByteString
aux Nothing  = ByteString
empty
        aux (Just b :: Builder
b) = Builder -> ByteString
toLazyByteString Builder
b

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

attdef :: AttDef -> MBuilder
attdef :: AttDef -> MBuilder
attdef (AttDef n :: QName
n t :: AttType
t d :: 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  StringType        = "CDATA"
atttype (TokenizedType t :: TokenizedType
t)  = TokenizedType -> MBuilder
tokenizedtype TokenizedType
t
atttype (EnumeratedType t :: EnumeratedType
t) = EnumeratedType -> MBuilder
enumeratedtype EnumeratedType
t

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

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

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

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

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

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

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

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

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

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

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

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

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

externalid :: ExternalID -> MBuilder
externalid :: ExternalID -> MBuilder
externalid (SYSTEM sl :: SystemLiteral
sl)   = "SYSTEM" MBuilder -> MBuilder -> MBuilder
<+> SystemLiteral -> MBuilder
systemliteral SystemLiteral
sl
externalid (PUBLIC i :: PubidLiteral
i sl :: SystemLiteral
sl) = "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 n :: String
n)            = "NDATA" MBuilder -> MBuilder -> MBuilder
<+> String -> MBuilder
text String
n

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

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

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

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

attvalue :: AttValue -> MBuilder
attvalue :: AttValue -> MBuilder
attvalue (AttValue esr :: [Either String Reference]
esr)        = "\"" MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> (Either String Reference -> MBuilder)
-> [Either String Reference] -> MBuilder
forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap Either String Reference -> MBuilder
attVal [Either String Reference]
esr MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> "\""
  where attVal :: Either String Reference -> MBuilder
attVal = (String -> MBuilder)
-> (Reference -> MBuilder) -> Either String Reference -> MBuilder
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 evs :: [EV]
evs)
  | [EV] -> Bool
containsDoubleQuote [EV]
evs    = "'"  MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> (EV -> MBuilder) -> [EV] -> MBuilder
forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap EV -> MBuilder
ev [EV]
evs MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> "'"
  | Bool
otherwise                  = "\"" MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> (EV -> MBuilder) -> [EV] -> MBuilder
forall a. (a -> MBuilder) -> [a] -> MBuilder
hcatMap EV -> MBuilder
ev [EV]
evs MBuilder -> MBuilder -> MBuilder
forall a. Semigroup a => a -> a -> a
<> "\""

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

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

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

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

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