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

    {- |
       Module     : Text.XML.HXT.DTDValidation.XmlRE
       Copyright  : Copyright (C) 2008 Uwe Schmidt
       License    : MIT

       Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
       Stability  : experimental
       Portability: portable

       A module for regular expression matching, adapted for XML DTDs.

       This module is based on the module RE.

    -}

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

    module Text.XML.HXT.DTDValidation.XmlRE
        ( RE

        , checkRE
        , matches
        , printRE

        , re_unit
        , re_zero
        , re_sym
        , re_rep
        , re_plus
        , re_opt
        , re_seq
        , re_alt
        , re_dot
        )
    where

    -- import           Debug.Trace                         (trace)

    import           Data.List                           (foldl')

    import           Text.XML.HXT.DTDValidation.RE       hiding (matches)

    import           Text.XML.HXT.Arrow.Edit             (removeComment,
                                                          removeWhiteSpace)
    import qualified Text.XML.HXT.DOM.XmlNode            as XN
    import           Text.XML.HXT.DTDValidation.TypeDefs

    -- |
    -- Derives a regular expression with respect to a list of elements.
    --
    --    * 1.parameter re :  regular expression
    --
    --    - 2.parameter list :  list of elements to which the regular expression is applied
    --
    --    - returns : the derived regular expression

    matches :: RE String -> XmlTrees -> RE String
    matches :: RE String -> XmlTrees -> RE String
    matches RE String
    re XmlTrees
    list
        = (RE String -> XmlTree -> RE String)
    -> RE String -> XmlTrees -> RE String
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' RE String -> XmlTree -> RE String
    delta RE String
    re (XmlArrow
    removeUnimportantStuff XmlArrow -> XmlTrees -> XmlTrees
    $$ XmlTrees
    list)
          where
          removeUnimportantStuff :: XmlArrow
          removeUnimportantStuff :: XmlArrow
    removeUnimportantStuff = 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)
    processBottomUp (XmlArrow
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    removeWhiteSpace XmlArrow -> XmlArrow -> XmlArrow
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> XmlArrow
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    removeComment)

          -- trace of growth of REs
          -- delta' re el = delta (trace (("RE : " ++) . (++ "\n" ) . show $ re) re) el

    -- |
    -- Derives a regular expression with respect to one element.
    --
    -- L(delta e x) = x \ L(e)
    --
    --    * 1.parameter re :  regular expression to be derived
    --
    --    - 2.parameter el :  the element on which the regular expression is applied
    --
    --    - returns : the derived regular expression

    delta :: RE String -> XmlTree -> RE String
    delta :: RE String -> XmlTree -> RE String
    delta RE String
    re XmlTree
    el
        | Bool -> Bool
    not (XmlTree -> Bool
    allowed XmlTree
    el) = RE String
    re
        | Bool
    otherwise        = case RE String
    re of
            RE_ZERO String
    m                -> String -> RE String
    forall a. String -> RE a
    re_zero String
    m
            RE String
    RE_UNIT                  -> String -> RE String
    forall a. String -> RE a
    re_zero (XmlTree -> String
    elemName XmlTree
    el String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " unexpected.")
            RE_SYM String
    sym
                | String
    sym String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    k_pcdata    -> if ((XmlTree -> Bool
    forall a. XmlNode a => a -> Bool
    XN.isText XmlTree
    el) Bool -> Bool -> Bool
    || (XmlTree -> Bool
    forall a. XmlNode a => a -> Bool
    XN.isCdata XmlTree
    el))
                                        then RE String
    forall a. RE a
    re_unit
                                        else String -> RE String
    forall a. String -> RE a
    re_zero (String
    "Character data expected, but "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ XmlTree -> String
    elemName XmlTree
    el String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " found.")
                | XmlTree -> String -> Bool
    expectedNode XmlTree
    el String
    sym -> RE String
    forall a. RE a
    re_unit
                | Bool
    otherwise           -> String -> RE String
    forall a. String -> RE a
    re_zero (String
    "Element "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    sym String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " expected, but "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ XmlTree -> String
    elemName XmlTree
    el String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " found.")
            RE_REP RE String
    e                  -> RE String -> RE String -> RE String
    forall a. RE a -> RE a -> RE a
    re_seq (RE String -> XmlTree -> RE String
    delta RE String
    e XmlTree
    el) (RE String -> RE String
    forall a. RE a -> RE a
    re_rep RE String
    e)
            RE_PLUS RE String
    e                 -> RE String -> RE String -> RE String
    forall a. RE a -> RE a -> RE a
    re_seq (RE String -> XmlTree -> RE String
    delta RE String
    e XmlTree
    el) (RE String -> RE String
    forall a. RE a -> RE a
    re_rep RE String
    e)
            RE_OPT RE String
    e                  -> RE String -> XmlTree -> RE String
    delta RE String
    e XmlTree
    el
            RE_SEQ RE String
    e RE String
    f
                | RE String -> Bool
    forall a. RE a -> Bool
    nullable RE String
    e          -> RE String -> RE String -> RE String
    forall a. Ord a => RE a -> RE a -> RE a
    re_alt (RE String -> RE String -> RE String
    forall a. RE a -> RE a -> RE a
    re_seq (RE String -> XmlTree -> RE String
    delta RE String
    e XmlTree
    el) RE String
    f) (RE String -> XmlTree -> RE String
    delta RE String
    f XmlTree
    el)
                | Bool
    otherwise           -> RE String -> RE String -> RE String
    forall a. RE a -> RE a -> RE a
    re_seq (RE String -> XmlTree -> RE String
    delta RE String
    e XmlTree
    el) RE String
    f
            RE_ALT RE String
    e RE String
    f                -> RE String -> RE String -> RE String
    forall a. Ord a => RE a -> RE a -> RE a
    re_alt (RE String -> XmlTree -> RE String
    delta RE String
    e XmlTree
    el) (RE String -> XmlTree -> RE String
    delta RE String
    f XmlTree
    el)
            RE String
    RE_DOT                    -> RE String
    forall a. RE a
    re_unit

        where
        expectedNode        :: XmlTree -> String -> Bool
        expectedNode :: XmlTree -> String -> Bool
    expectedNode XmlTree
    n String
    sym
            | XmlTree -> Bool
    forall a. XmlNode a => a -> Bool
    XN.isElem XmlTree
    n   = XmlTree -> String
    nameOfElem XmlTree
    n String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    sym
            | Bool
    otherwise     = Bool
    False

        elemName            :: XmlTree -> String
        elemName :: XmlTree -> String
    elemName XmlTree
    n
            | XmlTree -> Bool
    forall a. XmlNode a => a -> Bool
    XN.isElem XmlTree
    n   = String
    "element "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show (XmlTree -> String
    nameOfElem XmlTree
    n)
            | Bool
    otherwise     = String
    "character data"

        allowed     :: XmlTree -> Bool
        allowed :: XmlTree -> Bool
    allowed XmlTree
    n   = XmlTree -> Bool
    forall a. XmlNode a => a -> Bool
    XN.isElem XmlTree
    n Bool -> Bool -> Bool
    || XmlTree -> Bool
    forall a. XmlNode a => a -> Bool
    XN.isText XmlTree
    n Bool -> Bool -> Bool
    || XmlTree -> Bool
    forall a. XmlNode a => a -> Bool
    XN.isCdata XmlTree
    n

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