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

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

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

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

checkName       :: String -> SLA [String] XmlTree XmlTree -> SLA