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

{- |
   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 all datatypes for DTD validation

-}

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

module Text.XML.HXT.DTDValidation.TypeDefs
    ( module Text.XML.HXT.DTDValidation.TypeDefs
    , module Text.XML.HXT.DOM.Interface
    , module Text.XML.HXT.Arrow.XmlArrow
    , module Control.Arrow
    , module Control.Arrow.ArrowList
    , module Control.Arrow.ArrowIf
    , module Control.Arrow.ArrowState
    , module Control.Arrow.ArrowTree
    , module Control.Arrow.ListArrow
    , module Control.Arrow.StateListArrow
    )
where

import Control.Arrow                    -- classes
import Control.Arrow.ArrowList
import Control.Arrow.ArrowIf
import Control.Arrow.ArrowState
import Control.Arrow.ArrowTree

import Control.Arrow.ListArrow          -- arrow types
import Control.Arrow.StateListArrow

import Text.XML.HXT.Arrow.XmlArrow

import           Text.XML.HXT.DOM.Interface

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

infixr 0 $$

type XmlArrow   = LA XmlTree XmlTree
type XmlArrowS  = LA XmlTree XmlTrees

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

dtd_name
 , dtd_value
 , dtd_type
 , dtd_kind
 , dtd_modifier
 , dtd_default  :: Attributes -> String

dtd_name :: Attributes -> String
dtd_name        = String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_name
dtd_value :: Attributes -> String
dtd_value       = String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_value
dtd_type :: Attributes -> String
dtd_type        = String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_type
dtd_kind :: Attributes -> String
dtd_kind        = String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_kind
dtd_modifier :: Attributes -> String
dtd_modifier    = String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_modifier
dtd_default :: Attributes -> String
dtd_default     = String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
a_default

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

isUnparsedEntity        :: ArrowDTD a => a XmlTree XmlTree
isUnparsedEntity :: a XmlTree XmlTree
isUnparsedEntity        = a XmlTree Attributes -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
filterA (a XmlTree Attributes -> a XmlTree XmlTree)
-> a XmlTree Attributes -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
                          a XmlTree Attributes
forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
getDTDAttrl a XmlTree Attributes
-> a Attributes Attributes -> a 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) -> a Attributes Attributes
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
k_ndata)

hasDTDAttrValue         :: ArrowDTD a => String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue :: String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
an String -> Bool
p    = a XmlTree Attributes -> a XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
filterA (a XmlTree Attributes -> a XmlTree XmlTree)
-> a XmlTree Attributes -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
                          a XmlTree Attributes
forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
getDTDAttrl a XmlTree Attributes
-> a Attributes Attributes -> a 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) -> a Attributes Attributes
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> Bool
p (String -> Bool) -> (Attributes -> String) -> Attributes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
an)

isRequiredAttrKind      :: ArrowDTD a => a XmlTree XmlTree
isRequiredAttrKind :: a XmlTree XmlTree
isRequiredAttrKind      = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_kind (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_required)

isDefaultAttrKind       :: ArrowDTD a => a XmlTree XmlTree
isDefaultAttrKind :: a XmlTree XmlTree
isDefaultAttrKind       = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_kind (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_default)

isFixedAttrKind         :: ArrowDTD a => a XmlTree XmlTree
isFixedAttrKind :: a XmlTree XmlTree
isFixedAttrKind         = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_kind (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_fixed)

isMixedContentElement   :: ArrowDTD a => a XmlTree XmlTree
isMixedContentElement :: a XmlTree XmlTree
isMixedContentElement   = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_type (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v_mixed)

isEmptyElement          :: ArrowDTD a => a XmlTree XmlTree
isEmptyElement :: a XmlTree XmlTree
isEmptyElement          = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_type (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_empty)

isEnumAttrType          :: ArrowDTD a => a XmlTree XmlTree
isEnumAttrType :: a XmlTree XmlTree
isEnumAttrType          = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_type (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_enumeration)

isIdAttrType            :: ArrowDTD a => a XmlTree XmlTree
isIdAttrType :: a XmlTree XmlTree
isIdAttrType            = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_type (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_id)

isIdRefAttrType         :: ArrowDTD a => a XmlTree XmlTree
isIdRefAttrType :: a XmlTree XmlTree
isIdRefAttrType         = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_type (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
k_idref, String
k_idrefs])

isNotationAttrType      :: ArrowDTD a => a XmlTree XmlTree
isNotationAttrType :: a XmlTree XmlTree
isNotationAttrType      = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_type (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_notation)

isAttlistOfElement      :: ArrowDTD a => String -> a XmlTree XmlTree
isAttlistOfElement :: String -> a XmlTree XmlTree
isAttlistOfElement String
el   = a XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDAttlist
                          a XmlTree XmlTree -> a XmlTree XmlTree -> a XmlTree XmlTree
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_name (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
el)

valueOfDTD              :: String -> XmlTree -> String
valueOfDTD :: String -> XmlTree -> String
valueOfDTD String
n            = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (XmlTree -> [String]) -> XmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree String -> XmlTree -> [String]
forall a b. LA a b -> a -> [b]
runLA ( 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
>>^ String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
n )

valueOf                 :: String -> XmlTree -> String
valueOf :: String -> XmlTree -> String
valueOf String
n               = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (XmlTree -> [String]) -> XmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree String -> XmlTree -> [String]
forall a b. LA a b -> a -> [b]
runLA ( String -> LA XmlTree String
forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
getAttrValue String
n )

getDTDAttributes        :: XmlTree -> Attributes
getDTDAttributes :: XmlTree -> Attributes
getDTDAttributes        = [Attributes] -> Attributes
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Attributes] -> Attributes)
-> (XmlTree -> [Attributes]) -> XmlTree -> Attributes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree Attributes -> XmlTree -> [Attributes]
forall a b. LA a b -> a -> [b]
runLA LA XmlTree Attributes
forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
getDTDAttrl

isDTDDoctypeNode        :: XmlTree -> Bool
isDTDDoctypeNode :: XmlTree -> Bool
isDTDDoctypeNode        = Bool -> Bool
not (Bool -> Bool) -> (XmlTree -> Bool) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> (XmlTree -> [XmlTree]) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree XmlTree -> XmlTree -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDDoctype

isDTDElementNode        :: XmlTree -> Bool
isDTDElementNode :: XmlTree -> Bool
isDTDElementNode        = Bool -> Bool
not (Bool -> Bool) -> (XmlTree -> Bool) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> (XmlTree -> [XmlTree]) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree XmlTree -> XmlTree -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDElement

isDTDAttlistNode        :: XmlTree -> Bool
isDTDAttlistNode :: XmlTree -> Bool
isDTDAttlistNode        = Bool -> Bool
not (Bool -> Bool) -> (XmlTree -> Bool) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> (XmlTree -> [XmlTree]) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree XmlTree -> XmlTree -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDAttlist

isDTDContentNode        :: XmlTree -> Bool
isDTDContentNode :: XmlTree -> Bool
isDTDContentNode        = Bool -> Bool
not (Bool -> Bool) -> (XmlTree -> Bool) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> (XmlTree -> [XmlTree]) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree XmlTree -> XmlTree -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDContent

isDTDNameNode           :: XmlTree -> Bool
isDTDNameNode :: XmlTree -> Bool
isDTDNameNode           = Bool -> Bool
not (Bool -> Bool) -> (XmlTree -> Bool) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> (XmlTree -> [XmlTree]) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree XmlTree -> XmlTree -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isDTDName

isElemNode              :: XmlTree -> Bool
isElemNode :: XmlTree -> Bool
isElemNode              = Bool -> Bool
not (Bool -> Bool) -> (XmlTree -> Bool) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlTree] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([XmlTree] -> Bool) -> (XmlTree -> [XmlTree]) -> XmlTree -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree XmlTree -> XmlTree -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isElem

nameOfAttr              :: XmlTree -> String
nameOfAttr :: XmlTree -> String
nameOfAttr              = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (XmlTree -> [String]) -> XmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree String -> XmlTree -> [String]
forall a b. LA a b -> a -> [b]
runLA (LA XmlTree QName
forall (a :: * -> * -> *). ArrowXml a => a XmlTree QName
getAttrName LA XmlTree QName -> (QName -> String) -> LA XmlTree String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ QName -> String
qualifiedName)

nameOfElem              :: XmlTree -> String
nameOfElem :: XmlTree -> String
nameOfElem              = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (XmlTree -> [String]) -> XmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree String -> XmlTree -> [String]
forall a b. LA a b -> a -> [b]
runLA (LA XmlTree QName
forall (a :: * -> * -> *). ArrowXml a => a XmlTree QName
getElemName LA XmlTree QName -> (QName -> String) -> LA XmlTree String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ QName -> String
qualifiedName)

-- |
-- infix operator for applying an arrow to a list of trees
--
--    * 1.parameter f :  the arrow
--
--    - 2.parameter ts :  the list of trees
--
--    - returns : list of results

($$)            :: XmlArrow -> XmlTrees -> XmlTrees
LA XmlTree XmlTree
f $$ :: LA XmlTree XmlTree -> [XmlTree] -> [XmlTree]
$$ [XmlTree]
l          = LA [XmlTree] XmlTree -> [XmlTree] -> [XmlTree]
forall a b. LA a b -> a -> [b]
runLA (LA [XmlTree] XmlTree
forall (a :: * -> * -> *) b. ArrowList a => a [b] b
unlistA LA [XmlTree] XmlTree -> LA XmlTree XmlTree -> 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
>>> LA XmlTree XmlTree
f) [XmlTree]
l

-- | create an error message

msgToErr        :: (String -> String) -> LA String XmlTree
msgToErr :: (String -> String) -> LA String XmlTree
msgToErr String -> String
f      = String -> LA String XmlTree
forall (a :: * -> * -> *) b. ArrowXml a => String -> a b XmlTree
mkErr (String -> LA String XmlTree)
-> LA String String -> LA String XmlTree
forall (a :: * -> * -> *) c b d.
ArrowList a =>
(c -> a b d) -> a b c -> a b d
$< LA String String
forall (a :: * -> * -> *) b. ArrowList a => a b b
this
                  where
                  mkErr :: String -> a b XmlTree
mkErr String
"" = a b XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
                  mkErr String
s  = String -> a b XmlTree
forall (a :: * -> * -> *) n. ArrowXml a => String -> a n XmlTree
err (String -> String
f String
s)


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