-- | -- 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.Validator.AttributeValueValidation ( checkAttributeValue , normalizeAttributeValue ) where import Text.XML.HXT.Parser.XmlParser ( parseNMToken , parseName ) import Text.XML.HXT.DOM.XmlTree import Text.XML.HXT.DOM.Util -- | -- 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 -> XmlFilter checkAttributeValue dtdPart attrDecl@(NTree (XDTD ATTLIST al) _) n@(NTree (XTag _ _al') _) = checkValue attrType dtdPart normalizedVal attrDecl n where attrType = lookup1 a_type al attrValue = valueOf (getAttrName al) n normalizedVal = normalizeAttributeValue (Just attrDecl) attrValue checkAttributeValue dtdPart attrDecl@(NTree (XDTD ATTLIST al) _) n@(NTree (XDTD ATTLIST al') _) = checkValue attrType dtdPart normalizedVal attrDecl n where attrType = lookup1 a_type al attrValue = lookup1 a_default al' normalizedVal = normalizeAttributeValue (Just attrDecl) attrValue checkAttributeValue _ nd n = error ("checkAttributeValue: illegeal parameter:\n" ++ show nd ++ show n) -- | -- 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 -> XmlFilter checkValue typ dtdPart attrValue attrDecl | typ == k_cdata = none | typ == k_enumeration = checkValueEnumeration attrDecl attrValue | typ == k_entity = checkValueEntity dtdPart attrDecl attrValue | typ == k_entities = checkValueEntities dtdPart attrDecl attrValue | typ == k_id = checkValueId attrDecl attrValue | typ == k_idref = checkValueIdref attrDecl attrValue | typ == k_idrefs = checkValueIdrefs attrDecl attrValue | typ == k_nmtoken = checkValueNmtoken attrDecl attrValue | typ == k_nmtokens = checkValueNmtokens attrDecl attrValue | typ == k_notation = checkValueEnumeration attrDecl attrValue | otherwise = error ("Attribute type " ++ show typ ++ " 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 -> XmlFilter checkValueEnumeration (NTree (XDTD ATTLIST al) cs) attrValue = if attrValue `elem` enumVals then none else err ("Attribute " ++ show (getAttrName al) ++ " for element " ++ show (getElemName al) ++ " must have a value from list "++ show enumVals ++ ".") where enumVals :: [String] enumVals = map (getEnumVal) cs getEnumVal :: XmlTree -> String getEnumVal (NTree (XDTD NAME al') _) = lookup1 a_name al' getEnumVal _ = "" checkValueEnumeration n _ = error ("checkValueEnumeration: illegeal parameter:\n" ++ show n) -- | -- 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 -> XmlFilter checkValueEntity dtdPart (NTree (XDTD ATTLIST al) _) attrValue = if attrValue `elem` upEntities then none else err ("Entity " ++ show attrValue ++ " of attribute " ++ show (getAttrName al) ++ " for element " ++ show (getElemName al) ++ " is not unparsed. " ++ "The following unparsed entities exist: " ++ show upEntities ++ ".") where upEntities :: [String] upEntities = map (getEnumVal) (isUnparsedEntity $$ dtdPart) getEnumVal :: XmlTree -> String getEnumVal (NTree (XDTD ENTITY al') _) = lookup1 a_name al' getEnumVal _ = "" checkValueEntity _ n _ = error ("checkValueEntity: illegeal parameter:\n" ++ show n) -- | -- 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 -> XmlFilter checkValueEntities dtdPart attrDecl@(NTree (XDTD ATTLIST al) _) attrValue = if null valueList then err ("Attribute " ++ show (getAttrName al) ++ " of element " ++ show (getElemName al) ++ " must be one or more names.") else cat (map (checkValueEntity dtdPart attrDecl) valueList) where valueList = words attrValue checkValueEntities _ n _ = error ("checkValueEntities: illegeal parameter:\n" ++ show n) -- | -- 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 -> XmlFilter checkValueNmtoken (NTree (XDTD ATTLIST al) _) attrValue = checkNmtoken parseRes where parseRes :: XmlTrees parseRes = parseNMToken "" (mkXTextTree attrValue) checkNmtoken :: XmlTrees -> XmlFilter checkNmtoken ((NTree (XError _ s) _):_) = err ("Attribute value " ++ show attrValue ++ " of attribute " ++ show (getAttrName al) ++ " for element " ++ show (getElemName al) ++ " must be a name token, "++ (lines s) !! 1 ++".") checkNmtoken _ = none checkValueNmtoken n _ = error ("checkValueNmtoken: illegeal parameter:\n" ++ show n) -- | -- 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 -> XmlFilter checkValueNmtokens attrDecl@(NTree (XDTD ATTLIST al) _) attrValue = if null valueList then err ("Attribute "++ show (getAttrName al) ++" of element " ++ show (getElemName al) ++ " must be one or more name tokens.") else cat (map (checkValueNmtoken attrDecl) valueList) where valueList = words attrValue checkValueNmtokens n _ = error ("checkValueNmtokens: illegeal parameter:\n" ++ show n) -- | -- 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 -> XmlFilter checkValueId attrDecl attrValue = checkForName "Attribute value" attrDecl 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 -> XmlFilter checkValueIdref attrDecl attrValue = checkForName "Attribute value" attrDecl 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 -> XmlFilter checkValueIdrefs attrDecl attrValue = cat (map (checkValueIdref attrDecl) (words 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 -> XmlFilter checkForName msg (NTree (XDTD ATTLIST al) _) attrValue = checkName parseRes where parseRes :: XmlTrees parseRes = parseName "" (mkXTextTree attrValue) checkName :: XmlTrees -> XmlFilter checkName ((NTree (XError _ s) _):_) = err (msg ++ " "++ show attrValue ++" of attribute " ++ show (getAttrName al) ++ " for element "++ show (getElemName al) ++" must be a name, " ++ (lines s) !! 1 ++ ".") checkName _ = none checkForName _ n _ = error ("checkForName: illegeal parameter:\n" ++ show n) -- | -- Gets the element name from an attribute list of an XDTD ATTLIST node. -- -- * 1.parameter tag : the attibute list of an XDTD ATTLIST -- -- - returns : the element name getElemName :: Attributes -> String getElemName = lookup1 a_name -- | -- Gets the attribute name from an attribute list of an XDTD ATTLIST node. -- -- * 1.parameter tag : the attibute list of an XDTD ATTLIST -- -- - returns : the attribute name getAttrName :: Attributes -> String getAttrName = lookup1 a_value -- ----------------------------------------------------------------------------- -- | -- 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 (Just (NTree (XDTD ATTLIST al) _)) value = normalizeAttribute attrType where attrType = lookup1 a_type al normalizeAttribute :: String -> String normalizeAttribute typ | typ == k_cdata = cdataNormalization value | otherwise = otherNormalization value -- Attribute not declared in DTD, normalization as CDATA normalizeAttributeValue _ value = cdataNormalization 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 = id -- | Normalization of attribute values other than CDATA. otherNormalization :: String -> String otherNormalization = reduceWSSequences . stringTrim . cdataNormalization -- | Reduce whitespace sequences to a single whitespace. reduceWSSequences :: String -> String reduceWSSequences str = unwords (words str)