module Text.XML.Basic.Format where

import qualified Text.XML.Basic.Name as Name
import qualified Text.XML.Basic.Entity as Ent
import qualified Data.Map as Map

import Prelude hiding (quot)


class C object where
   run :: object -> ShowS

instance C Char where
   run :: Char -> ShowS
run Char
c =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe
         (Char -> ShowS
showChar Char
c)
         (\String
n -> ShowS
amp forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
semicolon) forall a b. (a -> b) -> a -> b
$
      forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c Map Char String
Ent.mapCharToName

{- that one causes cyclic module dependencies
   run = run . XMLChar.minimalRefFromUnicode
-}
{- that one is too simple - we always have to emit valid XML code
   run = showChar
-}

instance C object => C [object] where
   run :: [object] -> ShowS
run = forall a. (a -> ShowS) -> [a] -> ShowS
many forall object. C object => object -> ShowS
run


{-
adapted from HXT

import Text.XML.HXT.DOM.ShowXml
   (showBlank, showQuoteString,
    showEq, showLt, showGt, showSlash)
-}

nl, blank,
  eq, lt, gt, slash, amp, sharp, colon, semicolon,
  apos, quot, lpar, rpar, exclam, quest :: ShowS

nl :: ShowS
nl          = Char -> ShowS
showChar Char
'\n'
blank :: ShowS
blank       = Char -> ShowS
showChar Char
' '
eq :: ShowS
eq          = Char -> ShowS
showChar Char
'='
lt :: ShowS
lt          = Char -> ShowS
showChar Char
'<'
gt :: ShowS
gt          = Char -> ShowS
showChar Char
'>'
slash :: ShowS
slash       = Char -> ShowS
showChar Char
'/'
amp :: ShowS
amp         = Char -> ShowS
showChar Char
'&'
sharp :: ShowS
sharp       = Char -> ShowS
showChar Char
'#'
colon :: ShowS
colon       = Char -> ShowS
showChar Char
':'
semicolon :: ShowS
semicolon   = Char -> ShowS
showChar Char
';'
apos :: ShowS
apos        = Char -> ShowS
showChar Char
'\''
quot :: ShowS
quot        = Char -> ShowS
showChar Char
'\"'
lpar :: ShowS
lpar        = Char -> ShowS
showChar Char
'('
rpar :: ShowS
rpar        = Char -> ShowS
showChar Char
')'
exclam :: ShowS
exclam      = Char -> ShowS
showChar Char
'!'
quest :: ShowS
quest       = Char -> ShowS
showChar Char
'?'


angle :: ShowS -> ShowS
angle :: ShowS -> ShowS
angle ShowS
s = ShowS
lt forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
gt

{- |
Internet Explorer does not recognize &apos;
and thus we have to format it literally.
-}
stringQuoted :: String -> ShowS
stringQuoted :: String -> ShowS
stringQuoted String
s =
   if forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
'\'' String
s
     then ShowS
quot forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
quot
     else ShowS
apos forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
apos

name :: Name.C name => name -> ShowS
name :: forall name. C name => name -> ShowS
name name
n =
   String -> ShowS
showString (forall name. C name => name -> String
Name.toString name
n)

many :: (a -> ShowS) -> [a] -> ShowS
many :: forall a. (a -> ShowS) -> [a] -> ShowS
many a -> ShowS
s = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map a -> ShowS
s