    {-# LANGUAGE FlexibleContexts #-}

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

    {- |
       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 the DTD of XML documents
       represented as XmlTree.

       Unlike other popular XML validation tools the validation process returns
       a list of errors instead of aborting after the first error was found.

       Unlike validation of the document, the DTD branch is traversed four times:

        - Validation of Notations

        - Validation of Unparsed Entities

        - Validation of Element declarations

        - Validation of Attribute declarations

    -}

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

    module Text.XML.HXT.DTDValidation.DTDValidation
        ( removeDoublicateDefs
        , validateDTD
        )
    where

    import           Text.XML.HXT.DTDValidation.AttributeValueValidation
    import           Text.XML.HXT.DTDValidation.TypeDefs

    -- |
    -- Validate a DTD.
    --
    --    - returns : a functions which takes the DTD subset of the XmlTree, checks
    --                  if the DTD is valid and returns a list of errors

    validateDTD :: XmlArrow
    validateDTD :: XmlArrow
    validateDTD -- dtdPart
        = XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDDoctype
          XmlArrow -> XmlArrow -> XmlArrow
    forall b c d. LA b c -> LA b d -> LA b d
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    a b c -> a b d -> a b d
    `guards`
          ( XmlArrow -> LA XmlTree [XmlTree]
    forall b c. LA b c -> LA b [c]
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
    listA 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
            LA XmlTree [XmlTree] -> LA [XmlTree] 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 [XmlTree] XmlTree
    validateParts ([[Char]] -> [[Char]] -> LA [XmlTree] XmlTree)
    -> LA [XmlTree] ([[Char]], [[Char]]) -> LA [XmlTree] XmlTree
    forall c1 c2 b d. (c1 -> c2 -> LA b d) -> LA b (c1, c2) -> LA b d
    forall (a :: * -> * -> *) c1 c2 b d.
    ArrowList a =>
    (c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d
    $<< (LA [XmlTree] [[Char]]
    getNotationNames LA [XmlTree] [[Char]]
    -> LA [XmlTree] [[Char]] -> LA [XmlTree] ([[Char]], [[Char]])
    forall b c c'. LA b c -> LA b c' -> LA b (c, c')
    forall (a :: * -> * -> *) b c c'.
    Arrow a =>
    a b c -> a b c' -> a b (c, c')
    &&& LA [XmlTree] [[Char]]
    getElemNames) )
          )
        where
        validateParts :: [[Char]] -> [[Char]] -> LA [XmlTree] XmlTree
    validateParts [[Char]]
    notationNames [[Char]]
    elemNames
            = LA [XmlTree] XmlTree
    validateNotations
              LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
              [[Char]] -> LA [XmlTree] XmlTree
    validateEntities [[Char]]
    notationNames
              LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
              [[Char]] -> LA [XmlTree] XmlTree
    validateElements [[Char]]
    elemNames
              LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
              [[Char]] -> [[Char]] -> LA [XmlTree] XmlTree
    validateAttributes [[Char]]
    elemNames [[Char]]
    notationNames

        getNotationNames    :: LA [XmlTree] [String]
        getNotationNames :: LA [XmlTree] [[Char]]
    getNotationNames    = LA [XmlTree] [Char] -> LA [XmlTree] [[Char]]
    forall b c. LA b c -> LA b [c]
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
    listA (LA [XmlTree] [Char] -> LA [XmlTree] [[Char]])
    -> LA [XmlTree] [Char] -> LA [XmlTree] [[Char]]
    forall a b. (a -> b) -> a -> b
    $ LA [XmlTree] XmlTree
    forall b. LA [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA LA [XmlTree] XmlTree -> LA XmlTree [Char] -> LA [XmlTree] [Char]
    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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDNotation XmlArrow -> LA XmlTree [Char] -> LA XmlTree [Char]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> [Char] -> LA XmlTree [Char]
    forall (a :: * -> * -> *). ArrowDTD a => [Char] -> a XmlTree [Char]
    getDTDAttrValue [Char]
    a_name

        getElemNames        :: LA [XmlTree] [String]
        getElemNames :: LA [XmlTree] [[Char]]
    getElemNames        = LA [XmlTree] [Char] -> LA [XmlTree] [[Char]]
    forall b c. LA b c -> LA b [c]
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
    listA (LA [XmlTree] [Char] -> LA [XmlTree] [[Char]])
    -> LA [XmlTree] [Char] -> LA [XmlTree] [[Char]]
    forall a b. (a -> b) -> a -> b
    $ LA [XmlTree] XmlTree
    forall b. LA [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA LA [XmlTree] XmlTree -> LA XmlTree [Char] -> LA [XmlTree] [Char]
    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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDElement  XmlArrow -> LA XmlTree [Char] -> LA XmlTree [Char]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> [Char] -> LA XmlTree [Char]
    forall (a :: * -> * -> *). ArrowDTD a => [Char] -> a XmlTree [Char]
    getDTDAttrValue [Char]
    a_name

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

    checkName       :: String -> SLA [String] XmlTree XmlTree -> SLA [String] XmlTree XmlTree
    checkName :: [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    name SLA [[Char]] XmlTree XmlTree
    msg
        = SLA [[Char]] XmlTree [[Char]]
    -> SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree
    forall b c d.
    SLA [[Char]] b c
    -> SLA [[Char]] b d -> SLA [[Char]] b d -> SLA [[Char]] b d
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    a b c -> a b d -> a b d -> a b d
    ifA ( SLA [[Char]] XmlTree [[Char]]
    forall b. SLA [[Char]] b [[Char]]
    forall s (a :: * -> * -> *) b. ArrowState s a => a b s
    getState
                SLA [[Char]] XmlTree [[Char]]
    -> SLA [[Char]] [[Char]] [[Char]] -> SLA [[Char]] XmlTree [[Char]]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                ([[Char]] -> Bool) -> SLA [[Char]] [[Char]] [[Char]]
    forall b. (b -> Bool) -> SLA [[Char]] b b
    forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
    isA ([Char]
    name [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`)
              )
          SLA [[Char]] XmlTree XmlTree
    msg
          (([[Char]] -> [[Char]]) -> SLA [[Char]] XmlTree [[Char]]
    forall b. ([[Char]] -> [[Char]]) -> SLA [[Char]] b [[Char]]
    forall s (a :: * -> * -> *) b. ArrowState s a => (s -> s) -> a b s
    nextState ([Char]
    name[Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :) SLA [[Char]] XmlTree [[Char]]
    -> SLA [[Char]] [[Char]] XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> SLA [[Char]] [[Char]] XmlTree
    forall b c. SLA [[Char]] b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none)

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

    -- |
    -- Validation of Notations, checks if all notation names are unique.
    -- Validity constraint: Unique Notation Name (4.7 \/ p.44 in Spec)
    --
    --    * 1.parameter dtdPart :  the children of the @DOCTYPE@ node
    --
    --    - returns : a list of errors

    validateNotations :: LA XmlTrees XmlTree
    validateNotations :: LA [XmlTree] XmlTree
    validateNotations
        = [[Char]] -> SLA [[Char]] [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall (a :: * -> * -> *) s b c.
    ArrowList a =>
    s -> SLA s b c -> a b c
    fromSLA [] ( SLA [[Char]] [XmlTree] XmlTree
    forall b. SLA [[Char]] [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
                       SLA [[Char]] [XmlTree] XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] [XmlTree] XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                       SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDNotation
                       SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                       (Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueNotation (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree Attributes -> SLA [[Char]] XmlTree XmlTree
    forall c b d.
    (c -> SLA [[Char]] b d) -> SLA [[Char]] b c -> SLA [[Char]] b d
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< SLA [[Char]] XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl)
                     )
          where
          checkForUniqueNotation :: Attributes -> SLA [String] XmlTree XmlTree
          checkForUniqueNotation :: Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueNotation Attributes
    al
              = [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    name (SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> SLA [[Char]] XmlTree XmlTree
    forall n. [Char] -> SLA [[Char]] n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "Notation "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    name [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " was already specified." )
              where
              name :: [Char]
    name = Attributes -> [Char]
    dtd_name Attributes
    al

    -- |
    -- Validation of Entities.
    --
    -- 1. Issues a warning if entities are declared multiple times.
    --
    --    Optional warning: (4.2 \/ p.35 in Spec)
    --
    --
    -- 2. Validates that a notation is declared for an unparsed entity.
    --
    --    Validity constraint: Notation Declared (4.2.2 \/ p.36 in Spec)
    --
    --    * 1.parameter dtdPart :  the children of the @DOCTYPE@ node
    --
    --    - 2.parameter notationNames :  list of all notation names declared in the DTD
    --
    --    - returns : a list of errors

    validateEntities        :: [String] -> LA XmlTrees XmlTree
    validateEntities :: [[Char]] -> LA [XmlTree] XmlTree
    validateEntities [[Char]]
    notationNames
        = ( [[Char]] -> SLA [[Char]] [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall (a :: * -> * -> *) s b c.
    ArrowList a =>
    s -> SLA s b c -> a b c
    fromSLA [] ( SLA [[Char]] [XmlTree] XmlTree
    forall b. SLA [[Char]] [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
                         SLA [[Char]] [XmlTree] XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] [XmlTree] XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                         SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDEntity
                         SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                         (Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueEntity (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree Attributes -> SLA [[Char]] XmlTree XmlTree
    forall c b d.
    (c -> SLA [[Char]] b d) -> SLA [[Char]] b c -> SLA [[Char]] b d
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< SLA [[Char]] XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl)
                       )
          )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          ( LA [XmlTree] XmlTree
    forall b. LA [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
            LA [XmlTree] XmlTree -> XmlArrow -> LA [XmlTree] XmlTree
    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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isUnparsedEntity
            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
    >>>
            (Attributes -> XmlArrow
    checkNotationDecl (Attributes -> XmlArrow) -> LA XmlTree Attributes -> 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)
          )
          where

          -- Check if entities are declared multiple times

          checkForUniqueEntity      :: Attributes -> SLA [String] XmlTree XmlTree
          checkForUniqueEntity :: Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueEntity Attributes
    al
              = [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    name (SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> SLA [[Char]] XmlTree XmlTree
    forall n. [Char] -> SLA [[Char]] n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    warn ( [Char]
    "Entity "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    name [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " was already specified. " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                        [Char]
    "First declaration will be used." )
              where
              name :: [Char]
    name = Attributes -> [Char]
    dtd_name Attributes
    al

          -- Find unparsed entities for which no notation is specified

          checkNotationDecl         :: Attributes -> XmlArrow
          checkNotationDecl :: Attributes -> XmlArrow
    checkNotationDecl Attributes
    al
              | [Char]
    notationName [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    notationNames
                  = XmlArrow
    forall b c. LA b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
              | Bool
    otherwise
                  = [Char] -> XmlArrow
    forall n. [Char] -> LA n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "The notation " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    notationName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " must be declared " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                          [Char]
    "when referenced in the unparsed entity declaration for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                          [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    upEntityName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "."
                        )
              where
              notationName :: [Char]
    notationName = [Char] -> Attributes -> [Char]
    forall k e. Eq k => k -> AssocList k [e] -> [e]
    lookup1 [Char]
    k_ndata Attributes
    al
              upEntityName :: [Char]
    upEntityName = Attributes -> [Char]
    dtd_name  Attributes
    al

    -- |
    -- Validation of Element declarations.
    --
    -- 1. Validates that an element is not declared multiple times.
    --
    --    Validity constraint: Unique Element Type Declaration (3.2 \/ p.21 in Spec)
    --
    --
    -- 2. Validates that an element name only appears once in a mixed-content declaration.
    --
    --    Validity constraint: No Duplicate Types (3.2 \/ p.21 in Spec)
    --
    --
    -- 3. Issues a warning if an element mentioned in a content model is not declared in the
    --    DTD.
    --
    --    Optional warning: (3.2 \/ p.21 in Spec)
    --
    --    * 1.parameter dtdPart :  the children of the @DOCTYPE@ node
    --
    --    - 2.parameter elemNames :  list of all element names declared in the DTD
    --
    --    - returns : a list of errors

    validateElements        :: [String] -> LA XmlTrees XmlTree
    validateElements :: [[Char]] -> LA [XmlTree] XmlTree
    validateElements [[Char]]
    elemNames -- dtdPart
        = ( [[Char]] -> SLA [[Char]] [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall (a :: * -> * -> *) s b c.
    ArrowList a =>
    s -> SLA s b c -> a b c
    fromSLA [] ( SLA [[Char]] [XmlTree] XmlTree
    forall b. SLA [[Char]] [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
                         SLA [[Char]] [XmlTree] XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] [XmlTree] XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                         SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDElement
                         SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                         (Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueElement (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree Attributes -> SLA [[Char]] XmlTree XmlTree
    forall c b d.
    (c -> SLA [[Char]] b d) -> SLA [[Char]] b c -> SLA [[Char]] b d
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< SLA [[Char]] XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl)
                       )
          )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          ( LA [XmlTree] XmlTree
    forall b. LA [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
            LA [XmlTree] XmlTree -> XmlArrow -> LA [XmlTree] XmlTree
    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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isMixedContentElement
            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
    >>>
            (Attributes -> XmlArrow
    checkMixedContent (Attributes -> XmlArrow) -> LA XmlTree Attributes -> 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] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          ( LA [XmlTree] XmlTree
    forall b. LA [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
            LA [XmlTree] XmlTree -> XmlArrow -> LA [XmlTree] XmlTree
    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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDElement
            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
    >>>
            ([[Char]] -> Attributes -> XmlArrow
    checkContentModel [[Char]]
    elemNames (Attributes -> XmlArrow) -> LA XmlTree Attributes -> 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)
          )
          where

          -- Validates that an element is not declared multiple times

          checkForUniqueElement :: Attributes -> SLA [String] XmlTree XmlTree
          checkForUniqueElement :: Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueElement Attributes
    al
              = [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    name (SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> SLA [[Char]] XmlTree XmlTree
    forall n. [Char] -> SLA [[Char]] n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "Element type " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    name [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                      [Char]
    " must not be declared more than once." )
              where
              name :: [Char]
    name = Attributes -> [Char]
    dtd_name Attributes
    al

          -- Validates that an element name only appears once in a mixed-content declaration

          checkMixedContent :: Attributes -> XmlArrow
          checkMixedContent :: Attributes -> XmlArrow
    checkMixedContent Attributes
    al
              = [[Char]] -> SLA [[Char]] XmlTree XmlTree -> XmlArrow
    forall (a :: * -> * -> *) s b c.
    ArrowList a =>
    s -> SLA s b c -> a b c
    fromSLA [] ( SLA [[Char]] XmlTree XmlTree
    forall (t :: * -> *) b. Tree t => SLA [[Char]] (t b) (t b)
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                             SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                             SLA [[Char]] XmlTree XmlTree
    forall (t :: * -> *) b. Tree t => SLA [[Char]] (t b) (t b)
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                             SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                             SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDName
                             SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                             (Attributes -> SLA [[Char]] XmlTree XmlTree
    check (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree Attributes -> SLA [[Char]] XmlTree XmlTree
    forall c b d.
    (c -> SLA [[Char]] b d) -> SLA [[Char]] b c -> SLA [[Char]] b d
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< SLA [[Char]] XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl)
                           )
                where
                elemName :: [Char]
    elemName = Attributes -> [Char]
    dtd_name Attributes
    al
                check :: Attributes -> SLA [[Char]] XmlTree XmlTree
    check Attributes
    al'
                    = [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    name (SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                      [Char] -> SLA [[Char]] XmlTree XmlTree
    forall n. [Char] -> SLA [[Char]] n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "The element type " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    name [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                             [Char]
    " was already specified in the mixed-content model of the element declaration " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                             [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    elemName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "." )
                    where
                    name :: [Char]
    name = Attributes -> [Char]
    dtd_name Attributes
    al'

          -- Issues a warning if an element mentioned in a content model is not
          -- declared in the DTD.
          checkContentModel :: [String] -> Attributes -> XmlArrow
          checkContentModel :: [[Char]] -> Attributes -> XmlArrow
    checkContentModel [[Char]]
    names Attributes
    al
              | [Char]
    cm [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]
    v_children, [Char]
    v_mixed]
                  = 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 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
    checkContent
              | Bool
    otherwise
                  = XmlArrow
    forall b c. LA b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
              where
              elemName :: [Char]
    elemName = Attributes -> [Char]
    dtd_name Attributes
    al
              cm :: [Char]
    cm       = Attributes -> [Char]
    dtd_type Attributes
    al

              checkContent :: XmlArrow
              checkContent :: XmlArrow
    checkContent
                  = [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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDName    XmlArrow -> XmlArrow -> IfThen XmlArrow XmlArrow
    forall a b. a -> b -> IfThen a b
    :-> ( Attributes -> XmlArrow
    forall {a :: * -> * -> *} {b}.
    ArrowXml a =>
    Attributes -> a b XmlTree
    checkName' (Attributes -> XmlArrow) -> LA XmlTree Attributes -> 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 )
                    , XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDContent XmlArrow -> XmlArrow -> IfThen XmlArrow XmlArrow
    forall a b. a -> b -> IfThen a b
    :-> ( 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 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
    checkContent )
                    , 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
                    ]
                  where
                  checkName' :: Attributes -> a b XmlTree
    checkName' Attributes
    al'
                      | [Char]
    childElemName [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    names
                          = a b XmlTree
    forall b c. a b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
                      | Bool
    otherwise
                          = [Char] -> a b XmlTree
    forall n. [Char] -> a n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    warn ( [Char]
    "The element type "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    childElemName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                   [Char]
    ", used in content model of element "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    elemName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                   [Char]
    ", is not declared."
                                 )
                      where
                      childElemName :: [Char]
    childElemName = Attributes -> [Char]
    dtd_name Attributes
    al'

    -- |
    -- Validation of Attribute declarations.
    --
    -- (1) Issues a warning if an attribute is declared for an element type not itself
    --    decared.
    --
    --    Optinal warning: (3.3 \/ p. 24 in Spec)
    --
    --
    -- 2. Issues a warning if more than one definition is provided for the same
    --    attribute of a given element type. Fist declaration is binding, later
    --    definitions are ignored.
    --
    --    Optional warning: (3.3 \/ p.24 in Spec)
    --
    --
    -- 3. Issues a warning if the same Nmtoken occures more than once in enumerated
    --    attribute types of a single element type.
    --
    --    Optional warning: (3.3.1 \/ p.27 in Spec)
    --
    --
    -- 4. Validates that an element type has not more than one ID attribute defined.
    --
    --    Validity constraint: One ID per Element Type (3.3.1 \/ p.26 in Spec)
    --
    --
    -- 5. Validates that an element type has not more than one NOTATION attribute defined.
    --
    --    Validity constraint: One Notation per Element Type (3.3.1 \/ p.27 in Spec)
    --
    --
    -- 6. Validates that an ID attributes has the type #IMPLIED or #REQUIRED.
    --
    --    Validity constraint: ID Attribute Default (3.3.1 \/ p.26 in Spec)
    --
    --
    -- 7. Validates that all referenced notations are declared.
    --
    --    Validity constraint: Notation Attributes (3.3.1 \/ p.27 in Spec)
    --
    --
    -- 8. Validates that notations are not declared for EMPTY elements.
    --
    --    Validity constraint: No Notation on Empty Element (3.3.1 \/p.27 in Spec)
    --
    --
    -- 9. Validates that the default value matches the lexical constraints of it's type.
    --
    --    Validity constraint: Attribute default legal (3.3.2 \/ p.28 in Spec)
    --
    --
    --    * 1.parameter dtdPart :  the children of the @DOCTYPE@ node
    --
    --    - 2.parameter elemNames :  list of all element names declared in the DTD
    --
    --    - 3.parameter notationNames :  list of all notation names declared in the DTD
    --
    --    - returns : a list of errors

    validateAttributes :: [String] -> [String] -> LA XmlTrees XmlTree
    validateAttributes :: [[Char]] -> [[Char]] -> LA [XmlTree] XmlTree
    validateAttributes [[Char]]
    elemNames [[Char]]
    notationNames
        = -- 1. Find attributes for which no elements are declared
          ( XmlArrow -> (Attributes -> XmlArrow) -> LA [XmlTree] XmlTree
    forall {cat :: * -> * -> *} {c}.
    ArrowDTD cat =>
    cat XmlTree XmlTree
    -> (Attributes -> cat XmlTree c) -> cat [XmlTree] c
    runCheck XmlArrow
    forall b. LA b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this ([[Char]] -> Attributes -> XmlArrow
    checkDeclaredElements [[Char]]
    elemNames) )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          -- 2. Find attributes which are declared more than once
          ( SLA [[Char]] XmlTree XmlTree
    -> (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> LA [XmlTree] XmlTree
    forall {a :: * -> * -> *} {a} {c}.
    ArrowList a =>
    SLA [a] XmlTree XmlTree
    -> (Attributes -> SLA [a] XmlTree c) -> a [XmlTree] c
    runNameCheck SLA [[Char]] XmlTree XmlTree
    forall b. SLA [[Char]] b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueAttributeDeclaration )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          -- 3. Find enumerated attribute types which nmtokens are declared more than once
          ( XmlArrow -> (Attributes -> XmlArrow) -> LA [XmlTree] XmlTree
    forall {cat :: * -> * -> *} {c}.
    ArrowDTD cat =>
    cat XmlTree XmlTree
    -> (Attributes -> cat XmlTree c) -> cat [XmlTree] c
    runCheck (XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isEnumAttrType XmlArrow -> XmlArrow -> XmlArrow
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
    `orElse` XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isNotationAttrType) Attributes -> XmlArrow
    checkEnumeratedTypes )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          -- 4. Validate that there exists only one ID attribute for an element
          ( SLA [[Char]] XmlTree XmlTree
    -> (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> LA [XmlTree] XmlTree
    forall {a :: * -> * -> *} {a} {c}.
    ArrowList a =>
    SLA [a] XmlTree XmlTree
    -> (Attributes -> SLA [a] XmlTree c) -> a [XmlTree] c
    runNameCheck SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isIdAttrType Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueId )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          -- 5. Validate that there exists only one NOTATION attribute for an element
          ( SLA [[Char]] XmlTree XmlTree
    -> (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> LA [XmlTree] XmlTree
    forall {a :: * -> * -> *} {a} {c}.
    ArrowList a =>
    SLA [a] XmlTree XmlTree
    -> (Attributes -> SLA [a] XmlTree c) -> a [XmlTree] c
    runNameCheck SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isNotationAttrType Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueNotation )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          -- 6. Validate that ID attributes have the type #IMPLIED or #REQUIRED
          ( XmlArrow -> (Attributes -> XmlArrow) -> LA [XmlTree] XmlTree
    forall {cat :: * -> * -> *} {c}.
    ArrowDTD cat =>
    cat XmlTree XmlTree
    -> (Attributes -> cat XmlTree c) -> cat [XmlTree] c
    runCheck XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isIdAttrType Attributes -> XmlArrow
    checkIdKindConstraint )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          -- 7. Validate that all referenced notations are declared
          ( XmlArrow -> (Attributes -> XmlArrow) -> LA [XmlTree] XmlTree
    forall {cat :: * -> * -> *} {c}.
    ArrowDTD cat =>
    cat XmlTree XmlTree
    -> (Attributes -> cat XmlTree c) -> cat [XmlTree] c
    runCheck XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isNotationAttrType ([[Char]] -> Attributes -> XmlArrow
    checkNotationDeclaration [[Char]]
    notationNames) )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          -- 8. Validate that notations are not declared for EMPTY elements
          ( [[Char]] -> LA [XmlTree] XmlTree
    checkNoNotationForEmptyElements ([[Char]] -> LA [XmlTree] XmlTree)
    -> LA [XmlTree] [[Char]] -> LA [XmlTree] XmlTree
    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] [Char] -> LA [XmlTree] [[Char]]
    forall b c. LA b c -> LA b [c]
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
    listA ( LA [XmlTree] XmlTree
    forall b. LA [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
                                                       LA [XmlTree] XmlTree -> LA XmlTree [Char] -> LA [XmlTree] [Char]
    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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isEmptyElement
                                                       XmlArrow -> LA XmlTree [Char] -> LA XmlTree [Char]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                                                       [Char] -> LA XmlTree [Char]
    forall (a :: * -> * -> *). ArrowDTD a => [Char] -> a XmlTree [Char]
    getDTDAttrValue [Char]
    a_name
                                                     )
          )
          LA [XmlTree] XmlTree
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall b c. LA b c -> LA b c -> LA b c
    forall (a :: * -> * -> *) b c.
    ArrowPlus a =>
    a b c -> a b c -> a b c
    <+>
          -- 9. Validate that the default value matches the lexical constraints of it's type
          ( [XmlTree] -> LA [XmlTree] XmlTree
    checkDefaultValueTypes ([XmlTree] -> LA [XmlTree] XmlTree)
    -> LA [XmlTree] [XmlTree] -> LA [XmlTree] XmlTree
    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] [XmlTree]
    forall b. LA b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this )

          where
          -- ------------------------------------------------------------
          -- control structures

          runCheck :: cat XmlTree XmlTree
    -> (Attributes -> cat XmlTree c) -> cat [XmlTree] c
    runCheck cat XmlTree XmlTree
    select Attributes -> cat XmlTree c
    check
              = cat [XmlTree] XmlTree
    forall b. cat [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA cat [XmlTree] XmlTree -> cat XmlTree c -> cat [XmlTree] c
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> cat XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDAttlist
                cat XmlTree XmlTree -> cat XmlTree c -> cat XmlTree c
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                cat XmlTree XmlTree
    select
                cat XmlTree XmlTree -> cat XmlTree c -> cat XmlTree c
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                (Attributes -> cat XmlTree c
    check (Attributes -> cat XmlTree c)
    -> cat XmlTree Attributes -> cat XmlTree c
    forall c b d. (c -> cat b d) -> cat b c -> cat b d
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< cat XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl)

          runNameCheck :: SLA [a] XmlTree XmlTree
    -> (Attributes -> SLA [a] XmlTree c) -> a [XmlTree] c
    runNameCheck SLA [a] XmlTree XmlTree
    select Attributes -> SLA [a] XmlTree c
    check
              = [a] -> SLA [a] [XmlTree] c -> a [XmlTree] c
    forall (a :: * -> * -> *) s b c.
    ArrowList a =>
    s -> SLA s b c -> a b c
    fromSLA [] (SLA [a] [XmlTree] c -> a [XmlTree] c)
    -> SLA [a] [XmlTree] c -> a [XmlTree] c
    forall a b. (a -> b) -> a -> b
    $ SLA [a] XmlTree XmlTree
    -> (Attributes -> SLA [a] XmlTree c) -> SLA [a] [XmlTree] c
    forall {cat :: * -> * -> *} {c}.
    ArrowDTD cat =>
    cat XmlTree XmlTree
    -> (Attributes -> cat XmlTree c) -> cat [XmlTree] c
    runCheck SLA [a] XmlTree XmlTree
    select Attributes -> SLA [a] XmlTree c
    check

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

          -- 1. Find attributes for which no elements are declared

          checkDeclaredElements :: [String] -> Attributes -> XmlArrow
          checkDeclaredElements :: [[Char]] -> Attributes -> XmlArrow
    checkDeclaredElements [[Char]]
    elemNames' Attributes
    al
              | [Char]
    en [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    elemNames'
                  = XmlArrow
    forall b c. LA b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
              | Bool
    otherwise
                  = [Char] -> XmlArrow
    forall n. [Char] -> LA n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    warn ( [Char]
    "The element type \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    en [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\" used in dclaration "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                           [Char]
    "of attribute \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    an [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\" is not declared."
                         )
              where
              en :: [Char]
    en = Attributes -> [Char]
    dtd_name Attributes
    al
              an :: [Char]
    an = Attributes -> [Char]
    dtd_value Attributes
    al

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

          -- 2. Find attributes which are declared more than once

          checkForUniqueAttributeDeclaration ::  Attributes -> SLA [String] XmlTree XmlTree
          checkForUniqueAttributeDeclaration :: Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueAttributeDeclaration Attributes
    al
              = [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    name (SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> SLA [[Char]] XmlTree XmlTree
    forall n. [Char] -> SLA [[Char]] n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    warn ( [Char]
    "Attribute \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    aname [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\" for element type \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                       [Char]
    ename [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\" is already declared. First "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                       [Char]
    "declaration will be used." )
              where
              ename :: [Char]
    ename = Attributes -> [Char]
    dtd_name Attributes
    al
              aname :: [Char]
    aname = Attributes -> [Char]
    dtd_value Attributes
    al
              name :: [Char]
    name  = [Char]
    ename [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "|" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    aname

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

          -- 3. Find enumerated attribute types which nmtokens are declared more than once

          checkEnumeratedTypes :: Attributes -> XmlArrow
          checkEnumeratedTypes :: Attributes -> XmlArrow
    checkEnumeratedTypes Attributes
    al
              = [[Char]] -> SLA [[Char]] XmlTree XmlTree -> XmlArrow
    forall (a :: * -> * -> *) s b c.
    ArrowList a =>
    s -> SLA s b c -> a b c
    fromSLA [] ( SLA [[Char]] XmlTree XmlTree
    forall (t :: * -> *) b. Tree t => SLA [[Char]] (t b) (t b)
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                             SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                             SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDName
                             SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                             (Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueType (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree Attributes -> SLA [[Char]] XmlTree XmlTree
    forall c b d.
    (c -> SLA [[Char]] b d) -> SLA [[Char]] b c -> SLA [[Char]] b d
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< SLA [[Char]] XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl)
                           )
              where
              checkForUniqueType :: Attributes -> SLA [String] XmlTree XmlTree
              checkForUniqueType :: Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueType Attributes
    al'
                  = [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    nmtoken (SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                    [Char] -> SLA [[Char]] XmlTree XmlTree
    forall n. [Char] -> SLA [[Char]] n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    warn ( [Char]
    "Nmtoken \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    nmtoken [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\" should not "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                           [Char]
    "occur more than once in attribute \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Attributes -> [Char]
    dtd_value Attributes
    al [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                           [Char]
    "\" for element \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Attributes -> [Char]
    dtd_name Attributes
    al [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\"." )
                  where
                  nmtoken :: [Char]
    nmtoken = Attributes -> [Char]
    dtd_name Attributes
    al'

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

          -- 4. Validate that there exists only one ID attribute for an element

          checkForUniqueId :: Attributes -> SLA [String] XmlTree XmlTree
          checkForUniqueId :: Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueId Attributes
    al
              = [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    ename (SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> SLA [[Char]] XmlTree XmlTree
    forall n. [Char] -> SLA [[Char]] n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "Element \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ename [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\" already has attribute of type "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                      [Char]
    "ID, another attribute \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Attributes -> [Char]
    dtd_value Attributes
    al [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\" of type ID is "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                      [Char]
    "not permitted." )
              where
              ename :: [Char]
    ename = Attributes -> [Char]
    dtd_name Attributes
    al

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

          -- 5. Validate that there exists only one NOTATION attribute for an element

          checkForUniqueNotation :: Attributes -> SLA [String] XmlTree XmlTree
          checkForUniqueNotation :: Attributes -> SLA [[Char]] XmlTree XmlTree
    checkForUniqueNotation Attributes
    al
              = [Char]
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    checkName [Char]
    ename (SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                [Char] -> SLA [[Char]] XmlTree XmlTree
    forall n. [Char] -> SLA [[Char]] n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "Element \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ename [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\" already has attribute of type "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                      [Char]
    "NOTATION, another attribute \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Attributes -> [Char]
    dtd_value Attributes
    al [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "\" of type NOTATION "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                      [Char]
    "is not permitted." )
              where
              ename :: [Char]
    ename = Attributes -> [Char]
    dtd_name Attributes
    al

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

          -- 6. Validate that ID attributes have the type #IMPLIED or #REQUIRED

          checkIdKindConstraint :: Attributes -> XmlArrow
          checkIdKindConstraint :: Attributes -> XmlArrow
    checkIdKindConstraint Attributes
    al
              | [Char]
    attKind [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]
    k_implied, [Char]
    k_required]
                  = XmlArrow
    forall b c. LA b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
              | Bool
    otherwise
                  = [Char] -> XmlArrow
    forall n. [Char] -> LA n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "ID attribute \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Attributes -> [Char]
    dtd_value Attributes
    al [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\" must have a declared default "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                          [Char]
    "of \"#IMPLIED\" or \"REQUIRED\"")
              where
              attKind :: [Char]
    attKind = Attributes -> [Char]
    dtd_kind Attributes
    al

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

          -- 7. Validate that all referenced notations are declared

          checkNotationDeclaration :: [String] -> Attributes -> XmlArrow
          checkNotationDeclaration :: [[Char]] -> Attributes -> XmlArrow
    checkNotationDeclaration [[Char]]
    notations Attributes
    al
              = 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
                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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDName
                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
    >>>
                (Attributes -> XmlArrow
    checkNotations (Attributes -> XmlArrow) -> LA XmlTree Attributes -> 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)
              where
              checkNotations :: Attributes -> XmlArrow
              checkNotations :: Attributes -> XmlArrow
    checkNotations Attributes
    al'
                  | [Char]
    notation [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    notations
                      = XmlArrow
    forall b c. LA b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
                  | Bool
    otherwise
                      = [Char] -> XmlArrow
    forall n. [Char] -> LA n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "The notation \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    notation [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\" must be declared when "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                              [Char]
    "referenced in the notation type list for attribute \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Attributes -> [Char]
    dtd_value Attributes
    al [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                              [Char]
    "\" of element \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Attributes -> [Char]
    dtd_name Attributes
    al [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\"."
                            )
                  where
                  notation :: [Char]
    notation = Attributes -> [Char]
    dtd_name Attributes
    al'

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

          -- 8. Validate that notations are not declared for EMPTY elements

          checkNoNotationForEmptyElements :: [String] -> LA XmlTrees XmlTree
          checkNoNotationForEmptyElements :: [[Char]] -> LA [XmlTree] XmlTree
    checkNoNotationForEmptyElements [[Char]]
    emptyElems
              = LA [XmlTree] XmlTree
    forall b. LA [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
                LA [XmlTree] XmlTree -> XmlArrow -> LA [XmlTree] XmlTree
    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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDAttlist
                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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isNotationAttrType
                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
    >>>
                (Attributes -> XmlArrow
    checkNoNotationForEmptyElement (Attributes -> XmlArrow) -> LA XmlTree Attributes -> 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)
              where
              checkNoNotationForEmptyElement :: Attributes -> XmlArrow
              checkNoNotationForEmptyElement :: Attributes -> XmlArrow
    checkNoNotationForEmptyElement Attributes
    al
                  | [Char]
    ename [Char] -> [[Char]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [[Char]]
    emptyElems
                      = [Char] -> XmlArrow
    forall n. [Char] -> LA n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => [Char] -> a n XmlTree
    err ( [Char]
    "Attribute \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Attributes -> [Char]
    dtd_value Attributes
    al [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\" of type NOTATION must not be "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                              [Char]
    "declared on the element \""[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ename [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "\" declared EMPTY."
                            )
                  | Bool
    otherwise
                      = XmlArrow
    forall b c. LA b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
                  where
                  ename :: [Char]
    ename = Attributes -> [Char]
    dtd_name Attributes
    al

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

          -- 9. Validate that default values meet the lexical constraints of the attribute types

          checkDefaultValueTypes :: XmlTrees -> LA XmlTrees XmlTree
          checkDefaultValueTypes :: [XmlTree] -> LA [XmlTree] XmlTree
    checkDefaultValueTypes [XmlTree]
    dtdPart'
              = LA [XmlTree] XmlTree
    forall b. LA [b] b
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA LA [XmlTree] XmlTree -> XmlArrow -> LA [XmlTree] XmlTree
    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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDAttlist
                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 :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDefaultAttrKind
                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
    >>>
                ([XmlTree] -> XmlTree -> XmlArrow
    checkAttributeValue [XmlTree]
    dtdPart' (XmlTree -> XmlArrow) -> XmlArrow -> 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
    $< XmlArrow
    forall b. LA b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this)

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

    -- |
    -- Removes doublicate declarations from the DTD, which first declaration is
    -- binding. This is the case for ATTLIST and ENTITY declarations.
    --
    --    - returns : A function that replaces the children of DOCTYPE nodes by a list
    --               where all multiple declarations are removed.

    removeDoublicateDefs :: XmlArrow
    removeDoublicateDefs :: XmlArrow
    removeDoublicateDefs
        = XmlArrow -> XmlArrow
    forall (t :: * -> *) b. Tree t => LA (t b) (t b) -> LA (t b) (t b)
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b) -> a (t b) (t b)
    replaceChildren
          ( [[Char]] -> SLA [[Char]] XmlTree XmlTree -> XmlArrow
    forall (a :: * -> * -> *) s b c.
    ArrowList a =>
    s -> SLA s b c -> a b c
    fromSLA [] ( SLA [[Char]] XmlTree XmlTree
    forall (t :: * -> *) b. Tree t => SLA [[Char]] (t b) (t b)
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                         SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree -> SLA [[Char]] XmlTree XmlTree
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                         [IfThen
       (SLA [[Char]] XmlTree XmlTree) (SLA [[Char]] XmlTree XmlTree)]
    -> SLA [[Char]] XmlTree XmlTree
    forall b c d.
    [IfThen (SLA [[Char]] b c) (SLA [[Char]] b d)] -> SLA [[Char]] b d
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    [IfThen (a b c) (a b d)] -> a b d
    choiceA [ SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDAttlist SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree
    -> IfThen
         (SLA [[Char]] XmlTree XmlTree) (SLA [[Char]] XmlTree XmlTree)
    forall a b. a -> b -> IfThen a b
    :-> (Attributes -> SLA [[Char]] XmlTree XmlTree
    removeDoubleAttlist (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree Attributes -> SLA [[Char]] XmlTree XmlTree
    forall c b d.
    (c -> SLA [[Char]] b d) -> SLA [[Char]] b c -> SLA [[Char]] b d
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< SLA [[Char]] XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl)
                                 , SLA [[Char]] XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDEntity  SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree
    -> IfThen
         (SLA [[Char]] XmlTree XmlTree) (SLA [[Char]] XmlTree XmlTree)
    forall a b. a -> b -> IfThen a b
    :-> (Attributes -> SLA [[Char]] XmlTree XmlTree
    removeDoubleEntity  (Attributes -> SLA [[Char]] XmlTree XmlTree)
    -> SLA [[Char]] XmlTree Attributes -> SLA [[Char]] XmlTree XmlTree
    forall c b d.
    (c -> SLA [[Char]] b d) -> SLA [[Char]] b c -> SLA [[Char]] b d
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< SLA [[Char]] XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl)
                                 , SLA [[Char]] XmlTree XmlTree
    forall b. SLA [[Char]] b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this         SLA [[Char]] XmlTree XmlTree
    -> SLA [[Char]] XmlTree XmlTree
    -> IfThen
         (SLA [[Char]] XmlTree XmlTree) (SLA [[Char]] XmlTree XmlTree)
    forall a b. a -> b -> IfThen a b
    :-> SLA [[Char]] XmlTree XmlTree
    forall b. SLA [[Char]] b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this
                                 ]
                       )
          )
          XmlArrow -> XmlArrow -> XmlArrow
    forall b c. LA b b -> LA b c -> LA b b
    forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
    `when`
          XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDDoctype
        where
        checkName' :: a -> a d d
    checkName' a
    n'
            = a d [a] -> a d d -> a d d -> a d d
    forall b c d. a b c -> a b d -> a b d -> a b d
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    a b c -> a b d -> a b d -> a b d
    ifA ( a d [a]
    forall b. a b [a]
    forall s (a :: * -> * -> *) b. ArrowState s a => a b s
    getState
                    a d [a] -> a [a] [a] -> a d [a]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    ([a] -> Bool) -> a [a] [a]
    forall b. (b -> Bool) -> a b b
    forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
    isA (a
    n' a -> [a] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem`)
                  )
              a d d
    forall b c. a b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
              (a d d
    forall b. a b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this a d d -> a d d -> a d d
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> a d [a] -> a d d
    forall b c. a b c -> a b b
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
    perform (([a] -> [a]) -> a d [a]
    forall b. ([a] -> [a]) -> a b [a]
    forall s (a :: * -> * -> *) b. ArrowState s a => (s -> s) -> a b s
    nextState (a
    n'a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :)))

        removeDoubleAttlist :: Attributes -> SLA [String] XmlTree XmlTree
        removeDoubleAttlist :: Attributes -> SLA [[Char]] XmlTree XmlTree
    removeDoubleAttlist Attributes
    al
            = [Char] -> SLA [[Char]] XmlTree XmlTree
    forall {a} {a :: * -> * -> *} {d}.
    (Eq a, ArrowIf a, ArrowState [a] a) =>
    a -> a d d
    checkName' [Char]
    elemAttr
            where
            elemAttr :: [Char]
    elemAttr = [Char]
    elemName [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "|" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    attrName
            attrName :: [Char]
    attrName = Attributes -> [Char]
    dtd_value Attributes
    al
            elemName :: [Char]
    elemName = Attributes -> [Char]
    dtd_name Attributes
    al

        removeDoubleEntity  :: Attributes -> SLA [String] XmlTree XmlTree
        removeDoubleEntity :: Attributes -> SLA [[Char]] XmlTree XmlTree
    removeDoubleEntity Attributes
    al
            = [Char] -> SLA [[Char]] XmlTree XmlTree
    forall {a} {a :: * -> * -> *} {d}.
    (Eq a, ArrowIf a, ArrowState [a] a) =>
    a -> a d d
    checkName' (Attributes -> [Char]
    dtd_name Attributes
    al)

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