----------------------------------------------------------------------
-- |
-- Module      : XML
--
-- Utilities for creating XML documents.
----------------------------------------------------------------------
module GF.Data.XML (XML(..), Attr, comments, showXMLDoc, showsXMLDoc, showsXML, bottomUpXML) where

import GF.Data.Utilities

data XML = Data String | CData String | Tag String [Attr] [XML] | ETag String [Attr] | Comment String | Empty
 deriving (Eq XML
Eq XML
-> (XML -> XML -> Ordering)
-> (XML -> XML -> Bool)
-> (XML -> XML -> Bool)
-> (XML -> XML -> Bool)
-> (XML -> XML -> Bool)
-> (XML -> XML -> XML)
-> (XML -> XML -> XML)
-> Ord XML
XML -> XML -> Bool
XML -> XML -> Ordering
XML -> XML -> XML
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: XML -> XML -> XML
$cmin :: XML -> XML -> XML
max :: XML -> XML -> XML
$cmax :: XML -> XML -> XML
>= :: XML -> XML -> Bool
$c>= :: XML -> XML -> Bool
> :: XML -> XML -> Bool
$c> :: XML -> XML -> Bool
<= :: XML -> XML -> Bool
$c<= :: XML -> XML -> Bool
< :: XML -> XML -> Bool
$c< :: XML -> XML -> Bool
compare :: XML -> XML -> Ordering
$ccompare :: XML -> XML -> Ordering
$cp1Ord :: Eq XML
Ord,XML -> XML -> Bool
(XML -> XML -> Bool) -> (XML -> XML -> Bool) -> Eq XML
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XML -> XML -> Bool
$c/= :: XML -> XML -> Bool
== :: XML -> XML -> Bool
$c== :: XML -> XML -> Bool
Eq,Int -> XML -> ShowS
[XML] -> ShowS
XML -> String
(Int -> XML -> ShowS)
-> (XML -> String) -> ([XML] -> ShowS) -> Show XML
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XML] -> ShowS
$cshowList :: [XML] -> ShowS
show :: XML -> String
$cshow :: XML -> String
showsPrec :: Int -> XML -> ShowS
$cshowsPrec :: Int -> XML -> ShowS
Show)

type Attr = (String,String)

comments :: [String] -> [XML]
comments :: [String] -> [XML]
comments = (String -> XML) -> [String] -> [XML]
forall a b. (a -> b) -> [a] -> [b]
map String -> XML
Comment

showXMLDoc :: XML -> String
showXMLDoc :: XML -> String
showXMLDoc XML
xml = XML -> ShowS
showsXMLDoc XML
xml String
""

showsXMLDoc :: XML -> ShowS
showsXMLDoc :: XML -> ShowS
showsXMLDoc XML
xml = String -> ShowS
showString String
header ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XML -> ShowS
showsXML XML
xml
  where header :: String
header = String
"<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"

showsXML :: XML -> ShowS
showsXML :: XML -> ShowS
showsXML = Int -> XML -> ShowS
showsX Int
0 where
  showsX :: Int -> XML -> ShowS
showsX Int
i XML
x = Int -> ShowS
ind Int
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. case XML
x of
    (Data String
s) -> String -> ShowS
showString String
s
    (CData String
s) -> String -> ShowS
showString String
"<![CDATA[" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> ShowS
showString String
"]]>"
    (ETag String
t [Attr]
as) -> Char -> ShowS
showChar Char
'<' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attr] -> ShowS
showsAttrs [Attr]
as ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"/>"
    (Tag String
t [Attr]
as [XML]
cs) -> 
      Char -> ShowS
showChar Char
'<' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attr] -> ShowS
showsAttrs [Attr]
as ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'>' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
      [ShowS] -> ShowS
concatS ((XML -> ShowS) -> [XML] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> XML -> ShowS
showsX (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) [XML]
cs) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
ind Int
i ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
      String -> ShowS
showString String
"</" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'>'
    (Comment String
c) -> String -> ShowS
showString String
"<!-- " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
c ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" -->"
    (XML
Empty) -> ShowS
forall a. a -> a
id
  ind :: Int -> ShowS
ind Int
i = String -> ShowS
showString (String
"\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
i) Char
' ')

showsAttrs :: [Attr] -> ShowS
showsAttrs :: [Attr] -> ShowS
showsAttrs = [ShowS] -> ShowS
concatS ([ShowS] -> ShowS) -> ([Attr] -> [ShowS]) -> [Attr] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS) -> [ShowS] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> ShowS
showChar Char
' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ([ShowS] -> [ShowS]) -> ([Attr] -> [ShowS]) -> [Attr] -> [ShowS]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Attr -> ShowS) -> [Attr] -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map Attr -> ShowS
showsAttr

showsAttr :: Attr -> ShowS
showsAttr :: Attr -> ShowS
showsAttr (String
n,String
v) = String -> ShowS
showString String
n ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"=\"" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (ShowS
escape String
v) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
"\""

escape :: String -> String
escape :: ShowS
escape = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escChar
  where
  escChar :: Char -> String
escChar Char
'<'  = String
"&lt;"
  escChar Char
'>'  = String
"&gt;"
  escChar Char
'&'  = String
"&amp;"
  escChar Char
'"'  = String
"&quot;"
  escChar Char
c    = [Char
c]

bottomUpXML :: (XML -> XML) -> XML -> XML
bottomUpXML :: (XML -> XML) -> XML -> XML
bottomUpXML XML -> XML
f (Tag String
n [Attr]
attrs [XML]
cs) = XML -> XML
f (String -> [Attr] -> [XML] -> XML
Tag String
n [Attr]
attrs ((XML -> XML) -> [XML] -> [XML]
forall a b. (a -> b) -> [a] -> [b]
map ((XML -> XML) -> XML -> XML
bottomUpXML XML -> XML
f) [XML]
cs))
bottomUpXML XML -> XML
f XML
x = XML -> XML
f XML
x