    {- This module contains code for escaping/unescaping text in attributes
       and elements in the HaXml Element type, replacing characters by character
       references or vice-versa.  Two uses are envisaged for this:

       (1) stopping HaXml generating incorrect XML when a character is included
           which is also the appropriate XML terminating character, for example
           when an attribute includes a double quote.
       (2) representing XML which contains non-ASCII characters as ASCII.
       -}
    module Text.XML.HaXml.Escape(
       xmlEscape,
          -- :: XmlEscaper -> Element i -> Element i
       xmlUnEscape,
          -- :: XmlEscaper -> Element i -> Element i
       xmlEscapeContent,
          -- :: XmlEscaper -> [Content i] -> [Content i]
       xmlUnEscapeContent,
          -- :: XmlEscaper -> [Content i] -> [Content i]

       XmlEscaper,
          -- Something describing a particular set of escapes.

       stdXmlEscaper,
          -- Standard boilerplate escaper, escaping everything that is
          -- nonprintable, non-ASCII, or might conceivably cause problems by
          -- parsing XML, for example quotes, < signs, and ampersands.

       mkXmlEscaper,
          -- :: [(Char,String)] -> (Char -> Bool) -> XmlEscaper
          -- The first argument contains a list of characters, with their
          --    corresponding character reference names.
          --    For example [('\60',"lt"),('\62',"gt"),('\38',"amp"),
          --       ('\39',"apos"),('\34',"quot")] will give you the "standard"
          --       XML escapes listed in section 4.6 of the XML standard, so that
          --       "&quot;" will automatically get translated into a double
          --       quotation mark.
          --
          --       It's the caller's responsibility to see that the reference
          --       names ("lt","gt","amp","apos" and "quot" in the above example)
          --       are valid XML reference names.  A sequence of letters, digits,
          --       "." or ":" characters should be fine so long as the first one
          --       isn't a digit.
          --
          -- The second argument is a function applied to each text character.
          --    If it returns True, that means we should escape this character.

          -- Policy: on escaping, we expand all characters for which the
          -- (Char -> Bool) function returns True, either giving the corresponding
          -- character reference name if one was supplied, or else using a
          -- hexadecimal CharRef.
          --
          -- on unescaping, we translate all the references we understand
          --   (hexadecimal,decimal, and the ones in the [(Char,String)] list,
          --   and leave the others alone.

       ) where

    import Data.Char
    -- import Numeric
    import Text.XML.HaXml.Types

    #if __GLASGOW_HASKELL__ >= 604 || __NHC__ >= 118 || defined(__HUGS__)
    -- emulate older finite map interface using Data.Map, if it is available
    import qualified Data.Map as Map
    type FiniteMap a b = Map.Map a b
    listToFM :: Ord a => [(a,b)] -> FiniteMap a b
    listToFM :: forall a b. Ord a => [(a, b)] -> FiniteMap a b
    listToFM = [(a, b)] -> Map a b
    forall a b. Ord a => [(a, b)] -> FiniteMap a b
    Map.fromList
    lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
    lookupFM :: forall a b. Ord a => FiniteMap a b -> a -> Maybe b
    lookupFM = (a -> FiniteMap a b -> Maybe b) -> FiniteMap a b -> a -> Maybe b
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip a -> FiniteMap a b -> Maybe b
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup
    #elif __GLASGOW_HASKELL__ >= 504 || __NHC__ > 114
    -- real finite map, if it is available
    import Data.FiniteMap
    #else
    -- otherwise, a very simple and inefficient implementation of a finite map
    type FiniteMap a b = [(a,b)]
    listToFM :: Eq a => [(a,b)] -> FiniteMap a b
    listToFM = id
    lookupFM :: Eq a => FiniteMap a b -> a -> Maybe b
    lookupFM fm k = lookup k fm
    #endif

    -- ------------------------------------------------------------------------
    -- Data types
    -- ------------------------------------------------------------------------

    data XmlEscaper = XmlEscaper {
       XmlEscaper -> FiniteMap Char String
    toEscape :: FiniteMap Char String,
       XmlEscaper -> FiniteMap String Char
    fromEscape :: FiniteMap String Char,
       XmlEscaper -> Char -> Bool
    isEscape :: Char -> Bool
       }

    -- ------------------------------------------------------------------------
    -- Escaping
    -- ------------------------------------------------------------------------

    xmlEscape :: XmlEscaper -> Element i -> Element i
    xmlEscape :: forall i. XmlEscaper -> Element i -> Element i
    xmlEscape XmlEscaper
    xmlEscaper Element i
    element =
       Element i -> Element i
    forall i. Element i -> Element i
    compressElement (XmlEscaper -> Element i -> Element i
    forall i. XmlEscaper -> Element i -> Element i
    escapeElement XmlEscaper
    xmlEscaper Element i
    element)

    xmlEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
    xmlEscapeContent :: forall i. XmlEscaper -> [Content i] -> [Content i]
    xmlEscapeContent XmlEscaper
    xmlEscaper [Content i]
    cs =
       [Content i] -> [Content i]
    forall i. [Content i] -> [Content i]
    compressContent (XmlEscaper -> [Content i] -> [Content i]
    forall i. XmlEscaper -> [Content i] -> [Content i]
    escapeContent XmlEscaper
    xmlEscaper [Content i]
    cs)

    escapeElement :: XmlEscaper -> Element i -> Element i
    escapeElement :: forall i. XmlEscaper -> Element i -> Element i
    escapeElement XmlEscaper
    xmlEscaper (Elem QName
    name [Attribute]
    attributes [Content i]
    content) =
       QName -> [Attribute] -> [Content i] -> Element i
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem QName
    name (XmlEscaper -> [Attribute] -> [Attribute]
    escapeAttributes XmlEscaper
    xmlEscaper [Attribute]
    attributes)
          (XmlEscaper -> [Content i] -> [Content i]
    forall i. XmlEscaper -> [Content i] -> [Content i]
    escapeContent XmlEscaper
    xmlEscaper [Content i]
    content)

    escapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute]
    escapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute]
    escapeAttributes XmlEscaper
    xmlEscaper =
       (Attribute -> Attribute) -> [Attribute] -> [Attribute]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (QName
    name,AttValue
    av) -> (QName
    name,XmlEscaper -> AttValue -> AttValue
    escapeAttValue XmlEscaper
    xmlEscaper AttValue
    av))

    escapeAttValue :: XmlEscaper -> AttValue -> AttValue
    escapeAttValue :: XmlEscaper -> AttValue -> AttValue
    escapeAttValue XmlEscaper
    xmlEscaper (AttValue [Either String Reference]
    attValList) =
       [Either String Reference] -> AttValue
    AttValue (
          (Either String Reference -> [Either String Reference])
    -> [Either String Reference] -> [Either String Reference]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap
                (\ Either String Reference
    av -> case Either String Reference
    av of
                   Right Reference
    _ -> [Either String Reference
    av]
                   Left String
    s ->
                      (Char -> Either String Reference)
    -> String -> [Either String Reference]
    forall a b. (a -> b) -> [a] -> [b]
    map
                         (\ Char
    c -> if XmlEscaper -> Char -> Bool
    isEscape XmlEscaper
    xmlEscaper Char
    c
                            then
                               Reference -> Either String Reference
    forall a b. b -> Either a b
    Right (XmlEscaper -> Char -> Reference
    mkEscape XmlEscaper
    xmlEscaper Char
    c)
                            else
                               String -> Either String Reference
    forall a b. a -> Either a b
    Left [Char
    c]
                            )
                         String
    s
                   )
                [Either String Reference]
    attValList
          )

    escapeContent :: XmlEscaper -> [Content i] -> [Content i]
    escapeContent :: forall i. XmlEscaper -> [Content i] -> [Content i]
    escapeContent XmlEscaper
    xmlEscaper =
       (Content i -> [Content i]) -> [Content i] -> [Content i]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap
              (\ Content i
    content -> case Content i
    content of
                 (CString Bool
    b String
    str i
    i) ->
                    (Char -> Content i) -> String -> [Content i]
    forall a b. (a -> b) -> [a] -> [b]
    map
                       (\ Char
    c -> if XmlEscaper -> Char -> Bool
    isEscape XmlEscaper
    xmlEscaper Char
    c
                          then
                             Reference -> i -> Content i
    forall i. Reference -> i -> Content i
    CRef (XmlEscaper -> Char -> Reference
    mkEscape XmlEscaper
    xmlEscaper Char
    c) i
    i
                          else
                             Bool -> String -> i -> Content i
    forall i. Bool -> String -> i -> Content i
    CString Bool
    b [Char
    c] i
    i
                          )
                       String
    str
                 (CElem Element i
    element i
    i) -> [Element i -> i -> Content i
    forall i. Element i -> i -> Content i
    CElem (XmlEscaper -> Element i -> Element i
    forall i. XmlEscaper -> Element i -> Element i
    escapeElement XmlEscaper
    xmlEscaper Element i
    element) i
    i]
                 Content i
    _ -> [Content i
    content]
                 )

    mkEscape :: XmlEscaper -> Char -> Reference
    mkEscape :: XmlEscaper -> Char -> Reference
    mkEscape (XmlEscaper {toEscape :: XmlEscaper -> FiniteMap Char String
    toEscape = FiniteMap Char String
    toescape}) Char
    ch =
       case FiniteMap Char String -> Char -> Maybe String
    forall a b. Ord a => FiniteMap a b -> a -> Maybe b
    lookupFM FiniteMap Char String
    toescape Char
    ch of
          Maybe String
    Nothing  -> Int -> Reference
    RefChar (Char -> Int
    ord Char
    ch)
          Just String
    str -> String -> Reference
    RefEntity String
    str
    --    where
    --       _ = showIntAtBase 16 intToDigit
    --       -- It should be, but in GHC it isn't.

    -- ------------------------------------------------------------------------
    -- Unescaping
    -- ------------------------------------------------------------------------

    xmlUnEscape :: XmlEscaper -> Element i -> Element i
    xmlUnEscape :: forall i. XmlEscaper -> Element i -> Element i
    xmlUnEscape XmlEscaper
    xmlEscaper Element i
    element =
       Element i -> Element i
    forall i. Element i -> Element i
    compressElement (XmlEscaper -> Element i -> Element i
    forall i. XmlEscaper -> Element i -> Element i
    unEscapeElement XmlEscaper
    xmlEscaper Element i
    element)

    xmlUnEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
    xmlUnEscapeContent :: forall i. XmlEscaper -> [Content i] -> [Content i]
    xmlUnEscapeContent XmlEscaper
    xmlEscaper [Content i]
    cs =
       [Content i] -> [Content i]
    forall i. [Content i] -> [Content i]
    compressContent (XmlEscaper -> [Content i] -> [Content i]
    forall i. XmlEscaper -> [Content i] -> [Content i]
    unEscapeContent XmlEscaper
    xmlEscaper [Content i]
    cs)

    unEscapeElement :: XmlEscaper -> Element i -> Element i
    unEscapeElement :: forall i. XmlEscaper -> Element i -> Element i
    unEscapeElement XmlEscaper
    xmlEscaper (Elem QName
    name [Attribute]
    attributes [Content i]
    content) =
       QName -> [Attribute] -> [Content i] -> Element i
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem QName
    name (XmlEscaper -> [Attribute] -> [Attribute]
    unEscapeAttributes XmlEscaper
    xmlEscaper [Attribute]
    attributes)
          (XmlEscaper -> [Content i] -> [Content i]
    forall i. XmlEscaper -> [Content i] -> [Content i]
    unEscapeContent XmlEscaper
    xmlEscaper [Content i]
    content)

    unEscapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute]
    unEscapeAttributes :: XmlEscaper -> [Attribute] -> [Attribute]
    unEscapeAttributes XmlEscaper
    xmlEscaper =
       (Attribute -> Attribute) -> [Attribute] -> [Attribute]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (QName
    name,AttValue
    av) -> (QName
    name,XmlEscaper -> AttValue -> AttValue
    unEscapeAttValue XmlEscaper
    xmlEscaper AttValue
    av))

    unEscapeAttValue :: XmlEscaper -> AttValue -> AttValue
    unEscapeAttValue :: XmlEscaper -> AttValue -> AttValue
    unEscapeAttValue XmlEscaper
    xmlEscaper (AttValue [Either String Reference]
    attValList) =
       [Either String Reference] -> AttValue
    AttValue (
          (Either String Reference -> Either String Reference)
    -> [Either String Reference] -> [Either String Reference]
    forall a b. (a -> b) -> [a] -> [b]
    map
             (\ Either String Reference
    av -> case Either String Reference
    av of
                Left String
    _ -> Either String Reference
    av
                Right Reference
    ref -> case XmlEscaper -> Reference -> Maybe Char
    unEscapeChar XmlEscaper
    xmlEscaper Reference
    ref of
                   Just Char
    c -> String -> Either String Reference
    forall a b. a -> Either a b
    Left [Char
    c]
                   Maybe Char
    Nothing -> Either String Reference
    av
                )
             [Either String Reference]
    attValList
          )

    unEscapeContent :: XmlEscaper -> [Content i] -> [Content i]
    unEscapeContent :: forall i. XmlEscaper -> [Content i] -> [Content i]
    unEscapeContent XmlEscaper
    xmlEscaper =
       (Content i -> Content i) -> [Content i] -> [Content i]
    forall a b. (a -> b) -> [a] -> [b]
    map
          (\ Content i
    cntnt -> case Content i
    cntnt of
             CRef Reference
    ref i
    i -> case XmlEscaper -> Reference -> Maybe Char
    unEscapeChar XmlEscaper
    xmlEscaper Reference
    ref of
                Just Char
    c -> Bool -> String -> i -> Content i
    forall i. Bool -> String -> i -> Content i
    CString Bool
    False [Char
    c] i
    i
                Maybe Char
    Nothing -> Content i
    cntnt
             CElem Element i
    element i
    i -> Element i -> i -> Content i
    forall i. Element i -> i -> Content i
    CElem (XmlEscaper -> Element i -> Element i
    forall i. XmlEscaper -> Element i -> Element i
    unEscapeElement XmlEscaper
    xmlEscaper Element i
    element) i
    i
             Content i
    _ -> Content i
    cntnt
             )

    unEscapeChar :: XmlEscaper -> Reference -> Maybe Char
    unEscapeChar :: XmlEscaper -> Reference -> Maybe Char
    unEscapeChar XmlEscaper
    xmlEscaper Reference
    ref =
       case Reference
    ref of
          RefChar Int
    i      -> Char -> Maybe Char
    forall a. a -> Maybe a
    Just (Int -> Char
    chr Int
    i)
          RefEntity String
    name -> FiniteMap String Char -> String -> Maybe Char
    forall a b. Ord a => FiniteMap a b -> a -> Maybe b
    lookupFM (XmlEscaper -> FiniteMap String Char
    fromEscape XmlEscaper
    xmlEscaper) String
    name

    -- ------------------------------------------------------------------------
    -- After escaping and unescaping we rebuild the lists, compressing
    -- adjacent identical character data.
    -- ------------------------------------------------------------------------

    compressElement :: Element i -> Element i
    compressElement :: forall i. Element i -> Element i
    compressElement (Elem QName
    name [Attribute]
    attributes [Content i]
    content) =
       QName -> [Attribute] -> [Content i] -> Element i
    forall i. QName -> [Attribute] -> [Content i] -> Element i
    Elem QName
    name ([Attribute] -> [Attribute]
    compressAttributes [Attribute]
    attributes) ([Content i] -> [Content i]
    forall i. [Content i] -> [Content i]
    compressContent [Content i]
    content)

    compressAttributes :: [(QName,AttValue)] -> [(QName,AttValue)]
    compressAttributes :: [Attribute] -> [Attribute]
    compressAttributes =
       (Attribute -> Attribute) -> [Attribute] -> [Attribute]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (QName
    name,AttValue
    av) -> (QName
    name,AttValue -> AttValue
    compressAttValue AttValue
    av))

    compressAttValue :: AttValue -> AttValue
    compressAttValue :: AttValue -> AttValue
    compressAttValue (AttValue [Either String Reference]
    l) = [Either String Reference] -> AttValue
    AttValue ([Either String Reference] -> [Either String Reference]
    compress [Either String Reference]
    l)
       where
          compress :: [Either String Reference] -> [Either String Reference]
          compress :: [Either String Reference] -> [Either String Reference]
    compress [] = []
          compress (Right Reference
    ref : [Either String Reference]
    es) = Reference -> Either String Reference
    forall a b. b -> Either a b
    Right Reference
    ref Either String Reference
    -> [Either String Reference] -> [Either String Reference]
    forall a. a -> [a] -> [a]
    : [Either String Reference] -> [Either String Reference]
    compress [Either String Reference]
    es
          compress ( ls :: Either String Reference
    ls@(Left String
    s1) : [Either String Reference]
    es) =
             case [Either String Reference] -> [Either String Reference]
    compress [Either String Reference]
    es of
                (Left String
    s2 : [Either String Reference]
    es2) -> String -> Either String Reference
    forall a b. a -> Either a b
    Left (String
    s1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s2) Either String Reference
    -> [Either String Reference] -> [Either String Reference]
    forall a. a -> [a] -> [a]
    : [Either String Reference]
    es2
                [Either String Reference]
    es2 -> Either String Reference
    ls Either String Reference
    -> [Either String Reference] -> [Either String Reference]
    forall a. a -> [a] -> [a]
    : [Either String Reference]
    es2

    compressContent :: [Content i] -> [Content i]
    compressContent :: forall i. [Content i] -> [Content i]
    compressContent [] = []
    compressContent (csb :: Content i
    csb@(CString Bool
    b1 String
    s1 i
    i1) : [Content i]
    cs) =
       case [Content i] -> [Content i]
    forall i. [Content i] -> [Content i]
    compressContent [Content i]
    cs of
          (CString Bool
    b2 String
    s2 i
    _) : [Content i]
    cs2
              | Bool
    b1 Bool -> Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool
    b2
              -> Bool -> String -> i -> Content i
    forall i. Bool -> String -> i -> Content i
    CString Bool
    b1 (String
    s1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s2) i
    i1Content i -> [Content i] -> [Content i]
    forall a. a -> [a] -> [a]
    : [Content i]
    cs2
          [Content i]
    cs2 -> Content i
    csb Content i -> [Content i] -> [Content i]
    forall a. a -> [a] -> [a]
    : [Content i]
    cs2
    compressContent (CElem Element i
    element i
    i : [Content i]
    cs) =
       Element i -> i -> Content i
    forall i. Element i -> i -> Content i
    CElem (Element i -> Element i
    forall i. Element i -> Element i
    compressElement Element i
    element) i
    i Content i -> [Content i] -> [Content i]
    forall a. a -> [a] -> [a]
    : [Content i] -> [Content i]
    forall i. [Content i] -> [Content i]
    compressContent [Content i]
    cs
    compressContent (Content i
    c : [Content i]
    cs) = Content i
    c Content i -> [Content i] -> [Content i]
    forall a. a -> [a] -> [a]
    : [Content i] -> [Content i]
    forall i. [Content i] -> [Content i]
    compressContent [Content i]
    cs

    -- ------------------------------------------------------------------------
    -- Making XmlEscaper values.
    -- ------------------------------------------------------------------------

    stdXmlEscaper :: XmlEscaper
    stdXmlEscaper :: XmlEscaper
    stdXmlEscaper = [(Char, String)] -> (Char -> Bool) -> XmlEscaper
    mkXmlEscaper
       [(Char
    '\60',String
    "lt"),(Char
    '\62',String
    "gt"),(Char
    '\38',String
    "amp"),(Char
    '\39',String
    "apos"),(Char
    '\34',String
    "quot")]
       (\ Char
    ch ->
          let
             i :: Int
    i = Char -> Int
    ord Char
    ch
          in
             Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10 Bool -> Bool -> Bool
    || (Int
    10Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <Int
    i Bool -> Bool -> Bool
    && Int
    iInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <Int
    32) Bool -> Bool -> Bool
    || Int
    i Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    127 Bool -> Bool -> Bool
    ||
                case Char
    ch of
                   Char
    '\'' -> Bool
    True
                   Char
    '\"' -> Bool
    True
                   Char
    '&' -> Bool
    True
                   Char
    '<' -> Bool
    True
                   Char
    '>' -> Bool
    True
                   Char
    _ -> Bool
    False
          )

    mkXmlEscaper :: [(Char,String)] -> (Char -> Bool) -> XmlEscaper
    mkXmlEscaper :: [(Char, String)] -> (Char -> Bool) -> XmlEscaper
    mkXmlEscaper [(Char, String)]
    escapes Char -> Bool
    isescape =
       XmlEscaper {
          toEscape :: FiniteMap Char String
    toEscape = [(Char, String)] -> FiniteMap Char String
    forall a b. Ord a => [(a, b)] -> FiniteMap a b
    listToFM [(Char, String)]
    escapes,
          fromEscape :: FiniteMap String Char
    fromEscape = [(String, Char)] -> FiniteMap String Char
    forall a b. Ord a => [(a, b)] -> FiniteMap a b
    listToFM (((Char, String) -> (String, Char))
    -> [(Char, String)] -> [(String, Char)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\ (Char
    c,String
    str) -> (String
    str,Char
    c)) [(Char, String)]
    escapes),
          isEscape :: Char -> Bool
    isEscape = Char -> Bool
    isescape
          }