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

    {- |
       Module     : Text.XML.HXT.DTDValidation.Validation
       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 XML documents represented as
       XmlTree.

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

       Note: The validation process has been split into validation and transformation!
       If @validate@ did not report any errors, @transform@
       should be called, to change the document the way a validating parser
       is expected to do.

    -}

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

    module Text.XML.HXT.DTDValidation.Validation
        ( getDTDSubset
        , generalEntitiesDefined
        , validate
        , validateDTD
        , validateDoc
        , removeDoublicateDefs
        , transform
        )

    where

    import           Text.XML.HXT.DTDValidation.TypeDefs

    import qualified Text.XML.HXT.DTDValidation.DocTransformation as DocTransformation
    import qualified Text.XML.HXT.DTDValidation.DocValidation     as DocValidation
    import qualified Text.XML.HXT.DTDValidation.DTDValidation     as DTDValidation
    import qualified Text.XML.HXT.DTDValidation.IdValidation      as IdValidation

    -- |
    -- Main validation filter. Check if the DTD and the document are valid.
    --
    --
    --    - returns : a function which expects a complete document as XmlTree input
    --                     and returns a list of all errors found.

    validate        :: XmlArrow
    validate :: XmlArrow
    validate        = XmlArrow
    validateDTD XmlArrow -> XmlArrow -> XmlArrow
    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
    <+> XmlArrow
    validateDoc

    -- |
    -- Check if the DTD is valid.
    --
    --
    --    - returns : a function which expects an XmlTree from the parser as input
    --                     and returns a list of all errors found in the DTD.

    validateDTD     :: XmlArrow
    validateDTD :: XmlArrow
    validateDTD     = [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
    getDTDSubset        XmlArrow -> XmlArrow -> IfThen XmlArrow XmlArrow
    forall a b. a -> b -> IfThen a b
    :-> XmlArrow
    DTDValidation.validateDTD
                      , 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
    :-> String -> XmlArrow
    forall n. String -> LA n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
    err String
    "Can't validate DTD: There is no DOCTYPE declaration in the document."
                      ]
    -- |
    -- Check if the document corresponds to the given DTD.
    --
    --
    --    - returns : a function which expects a complete document as XmlTree input
    --                     and returns a list of all errors found in the content part.

    validateDoc     :: XmlArrow
    validateDoc :: XmlArrow
    validateDoc
        = [XmlTree] -> XmlArrow
    validateDoc' ([XmlTree] -> XmlArrow) -> LA XmlTree [XmlTree] -> 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 [XmlTree]
    getDTD
        where
        validateDoc' :: [XmlTree] -> XmlArrow
    validateDoc' []             = String -> XmlArrow
    forall n. String -> LA n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
    err String
    "Can't validate document: There is no DOCTYPE declaration in the document."
        validateDoc' (XmlTree
    dtdPart:[XmlTree]
    _)    = XmlTree -> XmlArrow
    DocValidation.validateDoc XmlTree
    dtdPart
                                      XmlArrow -> XmlArrow -> XmlArrow
    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
    <+>
                                      XmlTree -> XmlArrow
    IdValidation.validateIds  XmlTree
    dtdPart

    getDTD          :: XmlArrowS
    getDTD :: LA XmlTree [XmlTree]
    getDTD          = 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
    getDTDSubset
                              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
    removeDoublicateDefs
                            )

    -- |
    -- filter for transforming a document with respect to the given DTD.
    --
    -- Validating parsers
    -- are expected to  normalize attribute values and add default values.
    -- This function should be called after a successful validation.
    --
    --
    --    - returns : a function which expects a complete XML document tree
    --                and returns the transformed XmlTree

    transform       :: XmlArrow
    transform :: XmlArrow
    transform       = [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
    isRoot      XmlArrow -> XmlArrow -> IfThen XmlArrow XmlArrow
    forall a b. a -> b -> IfThen a b
    :-> ([XmlTree] -> XmlArrow
    transformDoc ([XmlTree] -> XmlArrow) -> LA XmlTree [XmlTree] -> 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 [XmlTree]
    getDTD)
                      , 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
    :-> String -> XmlArrow
    forall n. String -> LA n XmlTree
    forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
    fatal String
    "Can't transform document: No document root given"
                      ]
                      where
                      transformDoc :: [XmlTree] -> XmlArrow
    transformDoc []       = XmlArrow
    forall b. LA b b
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this
                      transformDoc [XmlTree]
    dtd      = XmlTree -> XmlArrow
    DocTransformation.transform ([XmlTree] -> XmlTree
    forall a. HasCallStack => [a] -> a
    head [XmlTree]
    dtd)

    -- |
    -- 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
    DTDValidation.removeDoublicateDefs

    --
    -- selects the DTD part of a document
    -- but only, if there is more than the internal part for the 4 predefined XML entities

    getDTDSubset            :: XmlArrow
    getDTDSubset :: XmlArrow
    getDTDSubset            = 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
    >>>
                              ( LA XmlTree Attributes -> XmlArrow
    forall b c. LA b c -> LA b b
    forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
    filterA (LA XmlTree Attributes -> XmlArrow)
    -> LA XmlTree Attributes -> XmlArrow
    forall a b. (a -> b) -> a -> b
    $ XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDDoctype XmlArrow -> LA XmlTree Attributes -> LA XmlTree Attributes
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> LA XmlTree Attributes
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
    getDTDAttrl LA XmlTree Attributes
    -> LA Attributes Attributes -> LA XmlTree Attributes
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (Attributes -> Bool) -> LA Attributes Attributes
    forall b. (b -> Bool) -> LA b b
    forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
    isA (String -> Attributes -> Bool
    forall k v. Eq k => k -> AssocList k v -> Bool
    hasEntry String
    a_name) )

    generalEntitiesDefined  :: XmlArrow
    generalEntitiesDefined :: XmlArrow
    generalEntitiesDefined  = XmlArrow
    getDTDSubset
                              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 -> XmlArrow
    forall (t :: * -> *) b c. Tree t => LA (t b) c -> LA (t b) c
    forall (a :: * -> * -> *) (t :: * -> *) b c.
    (ArrowTree a, Tree t) =>
    a (t b) c -> a (t b) c
    deep XmlArrow
    forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
    isDTDEntity

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