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

    {- |
       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 dtdPart :: XmlTrees
    dtdPart attrDecl :: XmlTree
    attrDecl
        | XmlTree -> Bool
    isDTDAttlistNode XmlTree
    attrDecl
            = [IfThen XmlArrow XmlArrow] -> XmlArrow
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    [IfThen (a b c) (a b d)] -> a b d
    choiceA
              [ XmlArrow
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isElem       XmlArrow -> XmlArrow -> IfThen XmlArrow XmlArrow
    forall a b. a -> b -> IfThen a b
    :-> ( [Char] -> XmlArrow
    checkAttrVal ([Char] -> XmlArrow) -> LA XmlTree [Char] -> XmlArrow
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< [Char] -> LA XmlTree [Char]
    forall (a :: * -> * -> *). ArrowXml a => [Char] -> a XmlTree [Char]
    getAttrValue [Char]
    attrName )
              , XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDAttlist XmlArrow -> XmlArrow -> IfThen XmlArrow XmlArrow
    forall a b. a -> b -> IfThen a b
    :-> ( [Char] -> XmlArrow
    checkAttrVal ([Char] -> XmlArrow) -> LA XmlTree [Char] -> XmlArrow
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< (LA XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl LA XmlTree Attributes
    -> (Attributes -> [Char]) -> LA XmlTree [Char]
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ Attributes -> [Char]
    dtd_default) )
              , XmlArrow
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this             XmlArrow -> XmlArrow -> IfThen XmlArrow XmlArrow
    forall a b. a -> b -> IfThen a b
    :-> XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
              ]
        | Bool
    otherwise
            = XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
          where
          al :: Attributes
    al        = XmlTree -> Attributes
    getDTDAttributes XmlTree
    attrDecl
          attrName :: [Char]
    attrName  = Attributes -> [Char]
    dtd_value Attributes
    al
          attrType :: [Char]
    attrType  = Attributes -> [Char]
    dtd_type  Attributes
    al
          checkAttrVal :: [Char] -> XmlArrow
    checkAttrVal attrValue :: [Char]
    attrValue
              = [Char] -> XmlTrees -> [Char] -> XmlTree -> XmlArrow
    checkValue [Char]
    attrType XmlTrees
    dtdPart [Char]
    normalizedVal XmlTree
    attrDecl
                where
                normalizedVal :: [Char]
    normalizedVal = Maybe XmlTree -> [Char] -> [Char]
    normalizeAttributeValue (XmlTree -> Maybe XmlTree
    forall a. a -> Maybe a
    Just XmlTree
    attrDecl) [Char]
    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 :: [Char] -> XmlTrees -> [Char] -> XmlTree -> XmlArrow
    checkValue typ :: [Char]
    typ dtdPart :: XmlTrees
    dtdPart attrValue :: [Char]
    attrValue attrDecl :: XmlTree
    attrDecl
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_cdata        = XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_enumeration  = XmlTree -> [Char] -> XmlArrow
    checkValueEnumeration XmlTree
    attrDecl [Char]
    attrValue
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_entity       = XmlTrees -> XmlTree -> [Char] -> XmlArrow
    checkValueEntity XmlTrees
    dtdPart XmlTree
    attrDecl [Char]
    attrValue
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_entities     = XmlTrees -> XmlTree -> [Char] -> XmlArrow
    checkValueEntities XmlTrees
    dtdPart XmlTree
    attrDecl [Char]
    attrValue
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_id           = XmlTree -> [Char] -> XmlArrow
    checkValueId XmlTree
    attrDecl [Char]
    attrValue
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_idref        = XmlTree -> [Char] -> XmlArrow
    checkValueIdref XmlTree
    attrDecl [Char]
    attrValue
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_idrefs       = XmlTree -> [Char] -> XmlArrow
    checkValueIdrefs XmlTree
    attrDecl [Char]
    attrValue
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_nmtoken      = XmlTree -> [Char] -> XmlArrow
    checkValueNmtoken XmlTree
    attrDecl [Char]
    attrValue
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_nmtokens     = XmlTree -> [Char] -> XmlArrow
    checkValueNmtokens XmlTree
    attrDecl [Char]
    attrValue
            | [Char]
    typ [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    k_notation     = XmlTree -> [Char] -> XmlArrow
    checkValueEnumeration XmlTree
    attrDecl [Char]
    attrValue
            | Bool
    otherwise             = [Char] -> XmlArrow
    forall a. HasCallStack => [Char] -> a
    error ("Attribute type " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    typ [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ " 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 -> [Char] -> XmlArrow
    checkValueEnumeration attrDecl :: XmlTree
    attrDecl attrValue :: [Char]
    attrValue
        | XmlTree -> Bool
    isDTDAttlistNode XmlTree
    attrDecl
          Bool -> Bool -> Bool
    &&
          [Char]
    attrValue [Char] -> [[Char]] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [[Char]]
    enumVals
            = [Char] -> XmlArrow
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( "Attribute " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_value Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ " for element " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_name Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                    " must have a value from list "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]] -> [Char]
    forall a. Show a => a -> [Char]
    show [[Char]]
    enumVals {- ++ " but has value " ++ show attrValue-} [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ".")
        | Bool
    otherwise
            = XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
          where
          al :: Attributes
    al        = XmlTree -> Attributes
    getDTDAttributes XmlTree
    attrDecl

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

          upEntities :: [String]
          upEntities :: [[Char]]
    upEntities = (XmlTree -> [Char]) -> XmlTrees -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Attributes -> [Char]
    dtd_name (Attributes -> [Char])
    -> (XmlTree -> Attributes) -> XmlTree -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XmlTree -> Attributes
    getDTDAttributes) (XmlArrow
    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 -> [Char] -> XmlArrow
    checkValueEntities dtdPart :: XmlTrees
    dtdPart attrDecl :: XmlTree
    attrDecl attrValue :: [Char]
    attrValue
        | XmlTree -> Bool
    isDTDAttlistNode XmlTree
    attrDecl
            = if [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    valueList
              then [Char] -> XmlArrow
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ("Attribute " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_value Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ " of element " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                        [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_name Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ " must be one or more names.")
              else [XmlArrow] -> XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
    catA ([XmlArrow] -> XmlArrow)
    -> ([[Char]] -> [XmlArrow]) -> [[Char]] -> XmlArrow
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> XmlArrow) -> [[Char]] -> [XmlArrow]
    forall a b. (a -> b) -> [a] -> [b]
    map (XmlTrees -> XmlTree -> [Char] -> XmlArrow
    checkValueEntity XmlTrees
    dtdPart XmlTree
    attrDecl) ([[Char]] -> XmlArrow) -> [[Char]] -> XmlArrow
    forall a b. (a -> b) -> a -> b
    $ [[Char]]
    valueList
        | Bool
    otherwise
            = XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
          where
          al :: Attributes
    al        = XmlTree -> Attributes
    getDTDAttributes XmlTree
    attrDecl
          valueList :: [[Char]]
    valueList = [Char] -> [[Char]]
    words [Char]
    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 -> [Char] -> XmlArrow
    checkValueNmtoken attrDecl :: XmlTree
    attrDecl attrValue :: [Char]
    attrValue
        | XmlTree -> Bool
    isDTDAttlistNode XmlTree
    attrDecl
            = [Char] -> LA XmlTree [Char]
    forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
    constA [Char]
    attrValue LA XmlTree [Char] -> LA [Char] XmlTree -> XmlArrow
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> LA [Char] XmlTree
    checkNmtoken
        | Bool
    otherwise
            = XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
          where
          al :: Attributes
    al        = XmlTree -> Attributes
    getDTDAttributes XmlTree
    attrDecl
          checkNmtoken :: LA [Char] XmlTree
    checkNmtoken
              = LA [Char] XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a [Char] XmlTree
    mkText LA [Char] XmlTree -> XmlArrow -> LA [Char] XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (XmlTree -> XmlTrees) -> XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
    arrL ([Char] -> XmlTree -> XmlTrees
    parseNMToken "")
                XmlArrow -> XmlArrow -> XmlArrow
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                XmlArrow
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isError
                XmlArrow -> XmlArrow -> XmlArrow
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                LA XmlTree [Char]
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree [Char]
    getErrorMsg
                LA XmlTree [Char] -> LA [Char] XmlTree -> XmlArrow
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                ([Char] -> [Char]) -> LA [Char] [Char]
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (\ s :: [Char]
    s -> ( "Attribute value " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    attrValue [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ " of attribute " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_value Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                              " for element " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_name Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ " must be a name token, "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ([Char] -> [[Char]]
    lines [Char]
    s) [[Char]] -> Int -> [Char]
    forall a. [a] -> Int -> a
    !! 1 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++".") )
                LA [Char] [Char] -> LA [Char] XmlTree -> LA [Char] XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                Int -> LA [Char] XmlTree
    forall (a :: * -> * -> *). ArrowXml a => Int -> a [Char] 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 -> [Char] -> XmlArrow
    checkValueNmtokens attrDecl :: XmlTree
    attrDecl attrValue :: [Char]
    attrValue
        | XmlTree -> Bool
    isDTDAttlistNode XmlTree
    attrDecl
            = if [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [[Char]]
    valueList
              then [Char] -> XmlArrow
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( "Attribute "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_value Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++" of element " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                         [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_name Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ " must be one or more name tokens.")
              else [XmlArrow] -> XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
    catA ([XmlArrow] -> XmlArrow)
    -> ([[Char]] -> [XmlArrow]) -> [[Char]] -> XmlArrow
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> XmlArrow) -> [[Char]] -> [XmlArrow]
    forall a b. (a -> b) -> [a] -> [b]
    map (XmlTree -> [Char] -> XmlArrow
    checkValueNmtoken XmlTree
    attrDecl) ([[Char]] -> XmlArrow) -> [[Char]] -> XmlArrow
    forall a b. (a -> b) -> a -> b
    $ [[Char]]
    valueList
        | Bool
    otherwise
            = XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
          where
          al :: Attributes
    al        = XmlTree -> Attributes
    getDTDAttributes XmlTree
    attrDecl
          valueList :: [[Char]]
    valueList = [Char] -> [[Char]]
    words [Char]
    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 -> [Char] -> XmlArrow
    checkValueId attrDecl :: XmlTree
    attrDecl attrValue :: [Char]
    attrValue
        = [Char] -> XmlTree -> [Char] -> XmlArrow
    checkForName "Attribute value" XmlTree
    attrDecl [Char]
    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 -> [Char] -> XmlArrow
    checkValueIdref attrDecl :: XmlTree
    attrDecl attrValue :: [Char]
    attrValue
        = [Char] -> XmlTree -> [Char] -> XmlArrow
    checkForName "Attribute value" XmlTree
    attrDecl [Char]
    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 -> [Char] -> XmlArrow
    checkValueIdrefs attrDecl :: XmlTree
    attrDecl attrValue :: [Char]
    attrValue
        = [XmlArrow] -> XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
    catA ([XmlArrow] -> XmlArrow)
    -> ([Char] -> [XmlArrow]) -> [Char] -> XmlArrow
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char] -> XmlArrow) -> [[Char]] -> [XmlArrow]
    forall a b. (a -> b) -> [a] -> [b]
    map (XmlTree -> [Char] -> XmlArrow
    checkValueIdref XmlTree
    attrDecl) ([[Char]] -> [XmlArrow])
    -> ([Char] -> [[Char]]) -> [Char] -> [XmlArrow]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [[Char]]
    words ([Char] -> XmlArrow) -> [Char] -> XmlArrow
    forall a b. (a -> b) -> a -> b
    $ [Char]
    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 :: [Char] -> XmlTree -> [Char] -> XmlArrow
    checkForName msg :: [Char]
    msg attrDecl :: XmlTree
    attrDecl attrValue :: [Char]
    attrValue
        | XmlTree -> Bool
    isDTDAttlistNode XmlTree
    attrDecl
            = [Char] -> LA XmlTree [Char]
    forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
    constA [Char]
    attrValue LA XmlTree [Char] -> LA [Char] XmlTree -> XmlArrow
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> LA [Char] XmlTree
    checkName
        | Bool
    otherwise
            = XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
        where
        al :: Attributes
    al  = XmlTree -> Attributes
    getDTDAttributes XmlTree
    attrDecl
        checkName :: LA [Char] XmlTree
    checkName
            = LA [Char] XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a [Char] XmlTree
    mkText LA [Char] XmlTree -> XmlArrow -> LA [Char] XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (XmlTree -> XmlTrees) -> XmlArrow
    forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
    arrL ([Char] -> XmlTree -> XmlTrees
    parseName "")
              XmlArrow -> XmlArrow -> XmlArrow
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
              XmlArrow
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isError
              XmlArrow -> XmlArrow -> XmlArrow
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
              LA XmlTree [Char]
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree [Char]
    getErrorMsg
              LA XmlTree [Char] -> LA [Char] XmlTree -> XmlArrow
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
              ([Char] -> [Char]) -> LA [Char] [Char]
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr (\s :: [Char]
    s -> ( [Char]
    msg [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ " " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    attrValue [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++" of attribute " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_value Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                           " for element "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show (Attributes -> [Char]
    dtd_name Attributes
    al) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++" must be a name, " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ([Char] -> [[Char]]
    lines [Char]
    s) [[Char]] -> Int -> [Char]
    forall a. [a] -> Int -> a
    !! 1 [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ ".") )
              LA [Char] [Char] -> LA [Char] XmlTree -> LA [Char] XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
              Int -> LA [Char] XmlTree
    forall (a :: * -> * -> *). ArrowXml a => Int -> a [Char] 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 -> [Char] -> [Char]
    normalizeAttributeValue (Just attrDecl :: XmlTree
    attrDecl) value :: [Char]
    value
        = [Char] -> [Char]
    normalizeAttribute [Char]
    attrType
          where
          al :: Attributes
    al             = XmlTree -> Attributes
    getDTDAttributes XmlTree
    attrDecl
          attrType :: [Char]
    attrType = Attributes -> [Char]
    dtd_type Attributes
    al

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

    -- Attribute not declared in DTD, normalization as CDATA
    normalizeAttributeValue Nothing value :: [Char]
    value
        = [Char] -> [Char]
    cdataNormalization [Char]
    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 :: [Char] -> [Char]
    cdataNormalization = [Char] -> [Char]
    forall a. a -> a
    id

    -- | Normalization of attribute values other than CDATA.

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

    -- | Reduce whitespace sequences to a single whitespace.

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

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