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

{- |
   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 (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 (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

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