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

    {- |
       Module     : Text.XML.HXT.DTDValidation.RE
       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 based on derivatives of regular expressions.

       The code was taken from Joe English (<http://www.flightlab.com/~joe/sgml/validate.html>).
       Tested and extended by Martin Schmidt.

       Further references for the algorithm:

       Janusz A. Brzozowski.

            Derivatives of Regular Expressions. Journal of the ACM, Volume 11, Issue 4, 1964.

       Mark Hopkins.

            Regular Expression Package. Posted to comp.compilers, 1994.
            Available per FTP at <ftp://iecc.com/pub/file/regex.tar.gz>.
    -}

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

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

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

        , checkRE
        , matches
        , nullable
        , printRE
      )
    where

    -- |
    -- Data type for regular expressions.

    data RE a =
            RE_ZERO String          --' L(0)   = {} (empty set)
            | RE_UNIT               --' L(1)   = { [] } (empty sequence)
            | RE_SYM a              --' L(x)   = { [x] }
            | RE_DOT                --' accept any single symbol
            | RE_REP (RE a)         --' L(e*)  = { [] } `union` L(e+)
            | RE_PLUS (RE a)        --' L(e+)  = { x ++ y | x <- L(e), y <- L(e*) }
            | RE_OPT (RE a)         --' L(e?)  = L(e) `union` { [] }
            | RE_SEQ (RE a) (RE a)  --' L(e,f) = { x ++ y | x <- L(e), y <- L(f) }
            | RE_ALT (RE a) (RE a)  --' L(e|f) = L(e) `union` L(f)
            deriving (Show, Eq)

    -- ------------------------------------------------------------
    -- Constructor functions to simplify regular expressions when constructing them.

    -- |
    -- Constructs a regular expression for an empty set.
    --
    --    * 1.parameter errMsg :  error message
    --
    --    - returns : regular expression for an empty set

    re_zero                 :: String -> RE a
    re_zero m               = RE_ZERO m

    -- |
    -- Constructs a regular expression for an empty sequence.
    --
    --    - returns : regular expression for an empty sequence

    re_unit                 :: RE a
    re_unit                 = RE_UNIT

    -- |
    -- Constructs a regular expression for accepting a symbol
    --
    --    * 1.parameter sym :  the symbol to be accepted
    --
    --    - returns : regular expression for accepting a symbol

    re_sym                  :: a -> RE a
    re_sym x                = RE_SYM x

    -- |
    -- Constructs a regular expression for accepting any singel symbol
    --
    --    - returns : regular expression for accepting any singel symbol

    re_dot                  :: RE a
    re_dot                  = RE_DOT

    -- |
    -- Constructs an optional repetition (*) of a regular expression
    --
    --    * 1.parameter re_a :  regular expression to be repeted
    --
    --    - returns : new regular expression

    re_rep                  :: RE a -> RE a
    re_rep RE_UNIT          = RE_UNIT
    re_rep (RE_ZERO _)      = RE_UNIT
    re_rep e@(RE_REP _)     = RE_REP (rem_rep e)            -- remove nested reps
    re_rep e@(RE_ALT _ _)   = RE_REP (rem_rep e)            -- remove nested reps in alternatives
    re_rep e                = RE_REP e

    -- |
    -- remove redundant nested *'s in RE
    -- theoretically this is unneccessary,
    -- but without this simplification the runtime can increase exponentally
    -- when computing deltas, e.g. for a** or (a|b*)* which is the same as (a|b)*

    rem_rep                 :: RE a -> RE a
    rem_rep (RE_ALT e1 e2)  = RE_ALT (rem_rep e1) (rem_rep e2)
    rem_rep (RE_REP e1)     = rem_rep e1
    rem_rep e1              = e1

    -- |
    -- Constructs a repetition (+) of a regular expression
    --
    --    * 1.parameter re_a :  regular expression to be repeted
    --
    --    - returns : new regular expression

    re_plus                 :: RE a -> RE a
    re_plus RE_UNIT         = RE_UNIT
    re_plus (RE_ZERO m)     = RE_ZERO m
    re_plus e               = RE_PLUS e

    -- |
    -- Constructs an option (?) of a regular expression
    --
    --    * 1.parameter re_a :  regular expression to be optional
    --
    --    - returns : new regular expression

    re_opt                  :: RE a -> RE a
    re_opt RE_UNIT          = RE_UNIT
    re_opt (RE_ZERO _)      = RE_UNIT
    re_opt e                = RE_OPT e

    -- |
    -- Constructs a sequence (,) of two regular expressions
    --
    --    * 1.parameter re_a :  first regular expression in sequence
    --
    --    - 2.parameter re_b :  second regular expression in sequence
    --
    --    - returns : new regular expression

    re_seq                  :: RE a -> RE a -> RE a
    re_seq (RE_ZERO m) _    = RE_ZERO m
    re_seq RE_UNIT f        = f
    re_seq _ (RE_ZERO m)    = RE_ZERO m
    re_seq e RE_UNIT        = e
    re_seq e f              = RE_SEQ e f

    -- |
    -- Constructs an alternative (|) of two regular expressions
    --
    --    * 1.parameter re_a :  first regular expression of alternative
    --
    --    - 2.parameter re_b :  second regular expression of alternative
    --
    --    - returns : new regular expression

    re_alt                  :: RE a -> RE a -> RE a
    re_alt (RE_ZERO _) f    = f
    re_alt e (RE_ZERO _)    = e
    re_alt e f              = RE_ALT e f

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

    -- |
    -- Checks if a regular expression matches the empty sequence.
    --
    -- nullable e == [] `in` L(e)
    --
    -- This check indicates if a regular expression fits to a sentence or not.
    --
    --    * 1.parameter re :  regular expression to be checked
    --
    --    - returns : true if regular expression matches the empty sequence,
    --                otherwise false

    nullable                ::  (Show a) => RE a -> Bool
    nullable (RE_ZERO _)    = False
    nullable RE_UNIT        = True
    nullable (RE_SYM _)     = False
    nullable (RE_REP _)     = True
    nullable (RE_PLUS e)    = nullable e
    nullable (RE_OPT _)     = True
    nullable (RE_SEQ e f)   = nullable e && nullable f
    nullable (RE_ALT e f)   = nullable e || nullable f
    nullable RE_DOT         = False

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

    delta :: (Eq a, Show a) => RE a -> a -> RE a
    delta re x = case re of
            RE_ZERO _               -> re                                   -- re_zero m
            RE_UNIT                 -> re_zero ("Symbol " ++ show x ++ " unexpected.")
            RE_SYM sym
                    | x == sym      -> re_unit
                    | otherwise     -> re_zero ("Symbol " ++ show sym ++ " expected, but symbol " ++ show x ++ " found.")
            RE_REP  e               -> re_seq (delta e x) re                -- (re_rep e)
            RE_PLUS e               -> re_seq (delta e x) (re_rep e)
            RE_OPT  e               -> delta e x
            RE_SEQ  e f
                    | nullable e    -> re_alt (re_seq (delta e x) f) (delta f x)
                    | otherwise     -> re_seq (delta e x) f
            RE_ALT  e f             -> re_alt (delta e x) (delta f x)
            RE_DOT                  -> re_unit

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

    matches :: (Eq a, Show a) => RE a -> [a] -> RE a
    matches e = foldl delta e

    -- |
    -- Checks if an input matched a regular expression. The function should be
    -- called after matches.
    --
    -- Was the sentence used in @matches@ in the language of the regular expression?
    -- -> matches e s == s `in` L(e)?
    --
    --    * 1.parameter re :  the derived regular expression
    --
    --    - returns : empty String if input matched the regular expression, otherwise
    --               an error message is returned

    checkRE :: (Show a) => RE a -> String
    checkRE (RE_UNIT)       = ""
    checkRE (RE_ZERO m)     = m
    checkRE re
            | nullable re   = ""
            | otherwise     = "Input must match " ++ printRE re

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

    -- |
    -- Constructs a string representation of a regular expression.
    --
    --    * 1.parameter re :  a regular expression
    --
    --    - returns : the string representation of the regular expression

    printRE :: (Show a) => RE a -> String
    printRE re'
        = "( " ++ printRE1 re' ++ " )"
          where
          printRE1 :: (Show a) => RE a -> String
          printRE1 re = case re of
              RE_ZERO m                             -> "ERROR: " ++ m
              RE_UNIT                               -> ""
              RE_SYM sym                            -> show sym
              RE_DOT                                -> "."
              RE_REP e
                  | isSingle e                      -> printRE1 e ++ "*"
                  | otherwise                       -> "(" ++ printRE1 e ++ ")*"
              RE_PLUS e
                  | isSingle e                      -> printRE1 e ++ "+"
                  | otherwise                       -> "(" ++ printRE1 e ++ ")+"
              RE_OPT e
                  | isSingle e                      -> printRE1 e ++ "?"
                  | otherwise                       -> "(" ++ printRE1 e ++ ")?"
              RE_SEQ e f
                  | isAlt e  && not (isAlt f)       -> "(" ++ printRE1 e ++ ") , " ++ printRE1 f
                  | not (isAlt e) && isAlt f        -> printRE1 e ++ " , (" ++ printRE1 f ++ ")"
                  | isAlt e  && isAlt f             -> "(" ++ printRE1 e ++ ") , (" ++ printRE1 f ++ ")"
                  | otherwise                       -> printRE1 e ++ " , " ++ printRE1 f
              RE_ALT e f
                  | isSeq e  && not (isSeq f)       -> "(" ++ printRE1 e ++ ") | " ++ printRE1 f
                  | not (isSeq e) && isSeq f        -> printRE1 e ++ " | (" ++ printRE1 f ++ ")"
                  | isSeq e  && isSeq f             -> "(" ++ printRE1 e ++ ") | (" ++ printRE1 f ++ ")"
                  | otherwise                       -> printRE1 e ++ " | " ++ printRE1 f

          isSingle :: RE a -> Bool
          isSingle (RE_ZERO _)    = True
          isSingle RE_UNIT        = True
          isSingle (RE_SYM _)     = True
          isSingle _              = False

          isSeq :: RE a -> Bool
          isSeq (RE_SEQ _ _)      = True
          isSeq _                 = False

          isAlt :: RE a -> Bool
          isAlt (RE_ALT _ _)      = True
          isAlt _                 = False