-- ------------------------------------------------------------

{- |
   Module     : Text.XML.HXT.DTDValidation.TypeDefs
   Copyright  : Copyright (C) 2008 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   This module provides functions for validating attributes.

   The main functions are:

    - Check if the attribute value meets the lexical constraints of its type

    - Normalization of an attribute value
-}

-- ------------------------------------------------------------

-- Special namings in source code:
--
--  - nd - XDTD node
--
--  - n  - XTag node
--

module Text.XML.HXT.DTDValidation.AttributeValueValidation
    ( checkAttributeValue
    , normalizeAttributeValue
    )
where

import Text.XML.HXT.Parser.XmlParsec
    ( parseNMToken
    , parseName
    )

import Text.XML.HXT.DTDValidation.TypeDefs

-- ------------------------------------------------------------

-- |
-- Checks if the attribute value meets the lexical constraints of its type.
--
--    * 1.parameter dtdPart :  the children of the @DOCTYPE@ node
--
--    - 2.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - returns : a function which takes an element (XTag or XDTD ATTLIST),
--                    checks if the attribute value meets the lexical constraints
--                    of its type and returns a list of errors

checkAttributeValue :: XmlTrees -> XmlTree -> XmlArrow
checkAttributeValue :: XmlTrees -> XmlTree -> XmlArrow
checkAttributeValue XmlTrees
dtdPart XmlTree
attrDecl
    | XmlTree -> Bool
isDTDAttlistNode XmlTree
attrDecl
        = forall (a :: * -> * -> *) b c d.
ArrowIf a =>
[IfThen (a b c) (a b d)] -> a b d
choiceA
          [ forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem       forall a b. a -> b -> IfThen a b
:-> ( String -> XmlArrow
checkAttrVal forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
attrName )
          , forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDAttlist forall a b. a -> b -> IfThen a b
:-> ( String -> XmlArrow
checkAttrVal forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< (forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
getDTDAttrl forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ Attributes -> String
dtd_default) )
          , forall (a :: * -> * -> *) b. ArrowList a => a b b
this             forall a b. a -> b -> IfThen a b
:-> forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
          ]
    | Bool
otherwise
        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      where
      al :: Attributes
al        = XmlTree -> Attributes
getDTDAttributes XmlTree
attrDecl
      attrName :: String
attrName  = Attributes -> String
dtd_value Attributes
al
      attrType :: String
attrType  = Attributes -> String
dtd_type  Attributes
al
      checkAttrVal :: String -> XmlArrow
checkAttrVal String
attrValue
          = String -> XmlTrees -> String -> XmlTree -> XmlArrow
checkValue String
attrType XmlTrees
dtdPart String
normalizedVal XmlTree
attrDecl
            where
            normalizedVal :: String
normalizedVal = Maybe XmlTree -> String -> String
normalizeAttributeValue (forall a. a -> Maybe a
Just XmlTree
attrDecl) String
attrValue

-- |
-- Dispatches the attibute check by the attribute type.
--
--    * 1.parameter typ :  the attribute type
--
--    - 2.parameter dtdPart :  the children of the @DOCTYPE@ node
--
--    - 3.parameter attrValue :  the normalized attribute value to be checked
--
--    - 4.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - returns : a functions which takes an element (XTag or XDTD ATTLIST),
--                        checks if the attribute value meets the lexical constraints
--                        of its type and returns a list of errors

checkValue :: String -> XmlTrees -> String -> XmlTree -> XmlArrow
checkValue :: String -> XmlTrees -> String -> XmlTree -> XmlArrow
checkValue String
typ XmlTrees
dtdPart String
attrValue XmlTree
attrDecl
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_cdata        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_enumeration  = XmlTree -> String -> XmlArrow
checkValueEnumeration XmlTree
attrDecl String
attrValue
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_entity       = XmlTrees -> XmlTree -> String -> XmlArrow
checkValueEntity XmlTrees
dtdPart XmlTree
attrDecl String
attrValue
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_entities     = XmlTrees -> XmlTree -> String -> XmlArrow
checkValueEntities XmlTrees
dtdPart XmlTree
attrDecl String
attrValue
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_id           = XmlTree -> String -> XmlArrow
checkValueId XmlTree
attrDecl String
attrValue
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_idref        = XmlTree -> String -> XmlArrow
checkValueIdref XmlTree
attrDecl String
attrValue
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_idrefs       = XmlTree -> String -> XmlArrow
checkValueIdrefs XmlTree
attrDecl String
attrValue
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_nmtoken      = XmlTree -> String -> XmlArrow
checkValueNmtoken XmlTree
attrDecl String
attrValue
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_nmtokens     = XmlTree -> String -> XmlArrow
checkValueNmtokens XmlTree
attrDecl String
attrValue
        | String
typ forall a. Eq a => a -> a -> Bool
== String
k_notation     = XmlTree -> String -> XmlArrow
checkValueEnumeration XmlTree
attrDecl String
attrValue
        | Bool
otherwise             = forall a. HasCallStack => String -> a
error (String
"Attribute type " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
typ forall a. [a] -> [a] -> [a]
++ String
" unknown.")

-- |
-- Checks the value of Enumeration attribute types. (3.3.1 \/ p.27 in Spec)
--
--    * 1.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 2.parameter attrValue :  the normalized attribute value to be checked

checkValueEnumeration :: XmlTree -> String -> XmlArrow
checkValueEnumeration :: XmlTree -> String -> XmlArrow
checkValueEnumeration XmlTree
attrDecl String
attrValue
    | XmlTree -> Bool
isDTDAttlistNode XmlTree
attrDecl
      Bool -> Bool -> Bool
&&
      String
attrValue forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
enumVals
        = forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
err ( String
"Attribute " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_value Attributes
al) forall a. [a] -> [a] -> [a]
++ String
" for element " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_name Attributes
al) forall a. [a] -> [a] -> [a]
++
                String
" must have a value from list "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
enumVals {- ++ " but has value " ++ show attrValue-} forall a. [a] -> [a] -> [a]
++ String
".")
    | Bool
otherwise
        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      where
      al :: Attributes
al        = XmlTree -> Attributes
getDTDAttributes XmlTree
attrDecl

      enumVals :: [String]
      enumVals :: [String]
enumVals = forall a b. (a -> b) -> [a] -> [b]
map (Attributes -> String
dtd_name forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Attributes
getDTDAttributes) forall a b. (a -> b) -> a -> b
$ (forall a b. LA a b -> a -> [b]
runLA forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
getChildren XmlTree
attrDecl)

-- |
-- Checks the value of ENTITY attribute types. (3.3.1 \/ p.26 in Spec)
--
--    * 1.parameter dtdPart :  the children of the @DOCTYPE@ node, to get the
--                    unparsed entity declarations
--
--    - 2.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 3.parameter attrValue :  the normalized attribute value to be checked

checkValueEntity :: XmlTrees -> XmlTree -> String -> XmlArrow
checkValueEntity :: XmlTrees -> XmlTree -> String -> XmlArrow
checkValueEntity XmlTrees
dtdPart XmlTree
attrDecl String
attrValue
    | XmlTree -> Bool
isDTDAttlistNode XmlTree
attrDecl
      Bool -> Bool -> Bool
&&
      String
attrValue forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
upEntities
        = forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
err ( String
"Entity " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
attrValue forall a. [a] -> [a] -> [a]
++ String
" of attribute " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_value Attributes
al) forall a. [a] -> [a] -> [a]
++
                String
" for element " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_name Attributes
al) forall a. [a] -> [a] -> [a]
++ String
" is not unparsed. " forall a. [a] -> [a] -> [a]
++
                String
"The following unparsed entities exist: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [String]
upEntities forall a. [a] -> [a] -> [a]
++ String
".")
    | Bool
otherwise
        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      where
      al :: Attributes
al        = XmlTree -> Attributes
getDTDAttributes XmlTree
attrDecl

      upEntities :: [String]
      upEntities :: [String]
upEntities = forall a b. (a -> b) -> [a] -> [b]
map (Attributes -> String
dtd_name forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> Attributes
getDTDAttributes) (forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isUnparsedEntity XmlArrow -> XmlTrees -> XmlTrees
$$ XmlTrees
dtdPart)

-- |
-- Checks the value of ENTITIES attribute types. (3.3.1 \/ p.26 in Spec)
--
--    * 1.parameter dtdPart :  the children of the @DOCTYPE@ node, to get the
--                    unparsed entity declarations
--
--    - 2.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 3.parameter attrValue :  the normalized attribute value to be checked

checkValueEntities ::XmlTrees -> XmlTree -> String -> XmlArrow
checkValueEntities :: XmlTrees -> XmlTree -> String -> XmlArrow
checkValueEntities XmlTrees
dtdPart XmlTree
attrDecl String
attrValue
    | XmlTree -> Bool
isDTDAttlistNode XmlTree
attrDecl
        = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
valueList
          then forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
err (String
"Attribute " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_value Attributes
al) forall a. [a] -> [a] -> [a]
++ String
" of element " forall a. [a] -> [a] -> [a]
++
                    forall a. Show a => a -> String
show (Attributes -> String
dtd_name Attributes
al) forall a. [a] -> [a] -> [a]
++ String
" must be one or more names.")
          else forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (XmlTrees -> XmlTree -> String -> XmlArrow
checkValueEntity XmlTrees
dtdPart XmlTree
attrDecl) forall a b. (a -> b) -> a -> b
$ [String]
valueList
    | Bool
otherwise
        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      where
      al :: Attributes
al        = XmlTree -> Attributes
getDTDAttributes XmlTree
attrDecl
      valueList :: [String]
valueList = String -> [String]
words String
attrValue

-- |
-- Checks the value of NMTOKEN attribute types. (3.3.1 \/ p.26 in Spec)
--
--    * 1.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 2.parameter attrValue :  the normalized attribute value to be checked

checkValueNmtoken :: XmlTree -> String -> XmlArrow
checkValueNmtoken :: XmlTree -> String -> XmlArrow
checkValueNmtoken XmlTree
attrDecl String
attrValue
    | XmlTree -> Bool
isDTDAttlistNode XmlTree
attrDecl
        = forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
attrValue forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA String XmlTree
checkNmtoken
    | Bool
otherwise
        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      where
      al :: Attributes
al        = XmlTree -> Attributes
getDTDAttributes XmlTree
attrDecl
      checkNmtoken :: LA String XmlTree
checkNmtoken
          = forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (String -> XmlTree -> XmlTrees
parseNMToken String
"")
            forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isError
            forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getErrorMsg
            forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\ String
s -> ( String
"Attribute value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
attrValue forall a. [a] -> [a] -> [a]
++ String
" of attribute " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_value Attributes
al) forall a. [a] -> [a] -> [a]
++
                          String
" for element " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_name Attributes
al) forall a. [a] -> [a] -> [a]
++ String
" must be a name token, "forall a. [a] -> [a] -> [a]
++ (String -> [String]
lines String
s) forall a. [a] -> Int -> a
!! Int
1 forall a. [a] -> [a] -> [a]
++String
".") )
            forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
            forall (a :: * -> * -> *). ArrowXml a => Int -> a String XmlTree
mkError Int
c_err

-- |
-- Checks the value of NMTOKENS attribute types. (3.3.1 \/ p.26 in Spec)
--
--    * 1.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 2.parameter attrValue :  the normalized attribute value to be checked

checkValueNmtokens :: XmlTree -> String -> XmlArrow
checkValueNmtokens :: XmlTree -> String -> XmlArrow
checkValueNmtokens XmlTree
attrDecl String
attrValue
    | XmlTree -> Bool
isDTDAttlistNode XmlTree
attrDecl
        = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
valueList
          then forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
err ( String
"Attribute "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_value Attributes
al) forall a. [a] -> [a] -> [a]
++String
" of element " forall a. [a] -> [a] -> [a]
++
                     forall a. Show a => a -> String
show (Attributes -> String
dtd_name Attributes
al) forall a. [a] -> [a] -> [a]
++ String
" must be one or more name tokens.")
          else forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (XmlTree -> String -> XmlArrow
checkValueNmtoken XmlTree
attrDecl) forall a b. (a -> b) -> a -> b
$ [String]
valueList
    | Bool
otherwise
        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
      where
      al :: Attributes
al        = XmlTree -> Attributes
getDTDAttributes XmlTree
attrDecl
      valueList :: [String]
valueList = String -> [String]
words String
attrValue

-- |
-- Checks the value of ID attribute types. (3.3.1 \/ p.25 in Spec)
--
--    * 1.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 2.parameter attrValue :  the normalized attribute value to be checked

checkValueId :: XmlTree -> String -> XmlArrow
checkValueId :: XmlTree -> String -> XmlArrow
checkValueId XmlTree
attrDecl String
attrValue
    = String -> XmlTree -> String -> XmlArrow
checkForName String
"Attribute value" XmlTree
attrDecl String
attrValue


-- |
-- Checks the value of IDREF attribute types. (3.3.1 \/ p.26 in Spec)
--
--    * 1.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 2.parameter attrValue :  the normalized attribute value to be checked

checkValueIdref :: XmlTree -> String -> XmlArrow
checkValueIdref :: XmlTree -> String -> XmlArrow
checkValueIdref XmlTree
attrDecl String
attrValue
    = String -> XmlTree -> String -> XmlArrow
checkForName String
"Attribute value" XmlTree
attrDecl String
attrValue


-- |
-- Checks the value of IDREFS attribute types. (3.3.1 \/ p.26 in Spec)
--
--    * 1.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 2.parameter attrValue :  the normalized attribute value to be checked

checkValueIdrefs :: XmlTree -> String -> XmlArrow
checkValueIdrefs :: XmlTree -> String -> XmlArrow
checkValueIdrefs XmlTree
attrDecl String
attrValue
    = forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
catA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (XmlTree -> String -> XmlArrow
checkValueIdref XmlTree
attrDecl) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall a b. (a -> b) -> a -> b
$ String
attrValue



-- -----------------------------------------------------------------------------
-- General helper functions for checking attribute values
--

-- |
-- Checks if the value of an attribute is a name.
--
--    * 1.parameter msg :  error message, should be "Entity" or "Attribute value"
--
--    - 2.parameter attrDecl :  the declaration of the attribute from the DTD
--
--    - 3.parameter attrValue :  the normalized attribute value to be checked

checkForName ::  String -> XmlTree -> String -> XmlArrow
checkForName :: String -> XmlTree -> String -> XmlArrow
checkForName String
msg XmlTree
attrDecl String
attrValue
    | XmlTree -> Bool
isDTDAttlistNode XmlTree
attrDecl
        = forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
attrValue forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA String XmlTree
checkName
    | Bool
otherwise
        = forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
    where
    al :: Attributes
al  = XmlTree -> Attributes
getDTDAttributes XmlTree
attrDecl
    checkName :: LA String XmlTree
checkName
        = forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
mkText forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL (String -> XmlTree -> XmlTrees
parseName String
"")
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isError
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall (a :: * -> * -> *). ArrowXml a => a XmlTree String
getErrorMsg
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (\String
s -> ( String
msg forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
attrValue forall a. [a] -> [a] -> [a]
++String
" of attribute " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_value Attributes
al) forall a. [a] -> [a] -> [a]
++
                       String
" for element "forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Attributes -> String
dtd_name Attributes
al) forall a. [a] -> [a] -> [a]
++String
" must be a name, " forall a. [a] -> [a] -> [a]
++ (String -> [String]
lines String
s) forall a. [a] -> Int -> a
!! Int
1 forall a. [a] -> [a] -> [a]
++ String
".") )
          forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
          forall (a :: * -> * -> *). ArrowXml a => Int -> a String XmlTree
mkError Int
c_err

-- -----------------------------------------------------------------------------

-- |
-- Normalizes an attribute value with respect to its type. (3.3.3 \/ p.29 in Spec)
--
--    * 1.parameter attrDecl :  the declaration of the attribute from the DTD. Expected
--                   is a list. If the list is empty, no declaration exists.
--
--    - 2.parameter value :  the attribute value to be normalized
--
--    - returns : the normalized value
--
normalizeAttributeValue :: Maybe XmlTree -> String -> String
normalizeAttributeValue :: Maybe XmlTree -> String -> String
normalizeAttributeValue (Just XmlTree
attrDecl) String
value
    = String -> String
normalizeAttribute String
attrType
      where
      al :: Attributes
al             = XmlTree -> Attributes
getDTDAttributes XmlTree
attrDecl
      attrType :: String
attrType = Attributes -> String
dtd_type Attributes
al

      normalizeAttribute :: String -> String
      normalizeAttribute :: String -> String
normalizeAttribute String
typ
          | String
typ forall a. Eq a => a -> a -> Bool
== String
k_cdata      = String -> String
cdataNormalization String
value
          | Bool
otherwise           = String -> String
otherNormalization String
value

-- Attribute not declared in DTD, normalization as CDATA
normalizeAttributeValue Maybe XmlTree
Nothing String
value
    = String -> String
cdataNormalization String
value

-- ------------------------------------------------------------
-- Helper functions for normalization

-- |
-- Normalization of CDATA attribute values.
-- is already done when parsing
-- during entity substituion for attribute values

cdataNormalization :: String -> String
cdataNormalization :: String -> String
cdataNormalization = forall a. a -> a
id

-- | Normalization of attribute values other than CDATA.

otherNormalization :: String -> String
otherNormalization :: String -> String
otherNormalization = String -> String
reduceWSSequences forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stringTrim forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
cdataNormalization

-- | Reduce whitespace sequences to a single whitespace.

reduceWSSequences :: String -> String
reduceWSSequences :: String -> String
reduceWSSequences String
str = [String] -> String
unwords (String -> [String]
words String
str)

-- ------------------------------------------------------------