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

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

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

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

    -- | Normalization of attribute values other than CDATA.

    otherNormalization :: String -> String
    otherNormalization :: String -> String
    otherNormalization = String -> String
    reduceWSSequences (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    stringTrim (String -> String) -> (String -> String) -> String -> String
    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)

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