    module Text.XML.HXT.RelaxNG.DataTypes
    where

    import           Text.XML.HXT.DOM.TypeDefs

    {- debug code
    import qualified Debug.Trace               as T
    -- -}

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

    relaxSchemaFile :: String
    relaxSchemaFile :: String
    relaxSchemaFile = String
    "Text/XML/HXT/RelaxNG/SpecificationSchema.rng"

    relaxSchemaGrammarFile :: String
    relaxSchemaGrammarFile :: String
    relaxSchemaGrammarFile = String
    "Text/XML/HXT/RelaxNG/SpecificationSchemaGrammar.rng"

    -- ------------------------------------------------------------
    -- datatypes for the simplification process

    a_numberOfErrors,
     a_relaxSimplificationChanges,
     a_output_changes,
     defineOrigName :: String

    a_numberOfErrors :: String
    a_numberOfErrors             = String
    "numberOfErrors"
    a_relaxSimplificationChanges :: String
    a_relaxSimplificationChanges = String
    "relaxSimplificationChanges"
    a_output_changes :: String
    a_output_changes             = String
    "output-pattern-transformations"
    defineOrigName :: String
    defineOrigName               = String
    "RelaxDefineOriginalName"

    type Env = [(String, XmlTree)]

    type PatternEnv = [(String, Pattern)]

    -- | Start of a context attribute value
    -- (see also: 'Text.XML.HXT.RelaxNG.Simplification.simplificationStep1')
    --
    -- The value is always followed by the original attribute name and value

    contextAttributes               :: String
    contextAttributes :: String
    contextAttributes               = String
    "RelaxContext-"

    contextAttributesDefault        :: String
    contextAttributesDefault :: String
    contextAttributesDefault        = String
    "RelaxContextDefault"

    -- | Start of base uri attribute value
    -- (see also: 'simplificationStep1' in "Text.XML.HXT.RelaxNG.Simplification")

    contextBaseAttr :: String
    contextBaseAttr :: String
    contextBaseAttr = String
    "RelaxContextBaseURI"

    -- see simplificationStep5 in Text.XML.HXT.RelaxNG.Simplification

    type OldName = String
    type NewName = String
    type NamePair = (OldName, NewName)
    type RefList = [NamePair]

    -- ------------------------------------------------------------
    -- datatype library handling

    -- | Type of all datatype libraries functions that tests whether
    -- a XML instance value matches a value-pattern.
    --
    -- Returns Just \"errorMessage\" in case of an error else Nothing.

    type DatatypeEqual  = DatatypeName -> String -> Context -> String -> Context -> Maybe String

    -- | Type of all datatype libraries functions that tests whether
    -- a XML instance value matches a data-pattern.
    --
    -- Returns Just \"errorMessage\" in case of an error else Nothing.

    type DatatypeAllows = DatatypeName -> ParamList -> String -> Context -> Maybe String

    -- | List of all supported datatype libraries

    type DatatypeLibraries = [DatatypeLibrary]

    -- | Each datatype library is identified by a URI.

    type DatatypeLibrary   = (Uri, DatatypeCheck)

    type DatatypeName      = String

    type ParamName         = String

    -- | List of all supported params for a datatype

    type AllowedParams     = [ParamName]

    -- | List of all supported datatypes and there allowed params

    type AllowedDatatypes  = [(DatatypeName, AllowedParams)]

    -- | The Constructor exports the list of supported datatypes for a library.
    -- It also exports the specialized datatype library functions to validate
    -- a XML instance value with respect to a datatype.

    data DatatypeCheck
      = DTC { DatatypeCheck -> DatatypeAllows
    dtAllowsFct    :: DatatypeAllows -- ^ function to test whether a value matches a data-pattern
            , DatatypeCheck -> DatatypeEqual
    dtEqualFct     :: DatatypeEqual -- ^ function to test whether a value matches a value-pattern
            , DatatypeCheck -> AllowedDatatypes
    dtAllowedTypes :: AllowedDatatypes -- ^ list of all supported params for a datatype
            }

    -- ------------------------------------------------------------
    -- datatypes for the validation process

    type Uri = String

    type LocalName = String

    -- | List of parameters; each parameter is a pair consisting of a local name and a value.

    type ParamList = [(LocalName, String)]

    type Prefix = String

    -- | A Context represents the context of an XML element.
    -- It consists of a base URI and a mapping from prefixes to namespace URIs.

    type Context = (Uri, [(Prefix, Uri)])

    -- | A Datatype identifies a datatype by a datatype library name and a local name.

    type Datatype = (Uri, LocalName)

    showDatatype    :: Datatype -> String
    showDatatype :: Datatype -> String
    showDatatype (String
    u, String
    ln)
             | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    u       = String
    ln
             | Bool
    otherwise    = String
    "{" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    u String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "}" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ln

    -- | Represents a name class

    data NameClass = AnyName
                   | AnyNameExcept NameClass
                   | Name Uri LocalName
                   | NsName Uri
                   | NsNameExcept Uri NameClass
                   | NameClassChoice NameClass NameClass
                   | NCError String
                   deriving (NameClass -> NameClass -> Bool
    (NameClass -> NameClass -> Bool)
    -> (NameClass -> NameClass -> Bool) -> Eq NameClass
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: NameClass -> NameClass -> Bool
    == :: NameClass -> NameClass -> Bool
    $c/= :: NameClass -> NameClass -> Bool
    /= :: NameClass -> NameClass -> Bool
    Eq, Eq NameClass
    Eq NameClass
    -> (NameClass -> NameClass -> Ordering)
    -> (NameClass -> NameClass -> Bool)
    -> (NameClass -> NameClass -> Bool)
    -> (NameClass -> NameClass -> Bool)
    -> (NameClass -> NameClass -> Bool)
    -> (NameClass -> NameClass -> NameClass)
    -> (NameClass -> NameClass -> NameClass)
    -> Ord NameClass
    NameClass -> NameClass -> Bool
    NameClass -> NameClass -> Ordering
    NameClass -> NameClass -> NameClass
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: NameClass -> NameClass -> Ordering
    compare :: NameClass -> NameClass -> Ordering
    $c< :: NameClass -> NameClass -> Bool
    < :: NameClass -> NameClass -> Bool
    $c<= :: NameClass -> NameClass -> Bool
    <= :: NameClass -> NameClass -> Bool
    $c> :: NameClass -> NameClass -> Bool
    > :: NameClass -> NameClass -> Bool
    $c>= :: NameClass -> NameClass -> Bool
    >= :: NameClass -> NameClass -> Bool
    $cmax :: NameClass -> NameClass -> NameClass
    max :: NameClass -> NameClass -> NameClass
    $cmin :: NameClass -> NameClass -> NameClass
    min :: NameClass -> NameClass -> NameClass
    Ord)

    instance Show NameClass
        where
        show :: NameClass -> String
    show NameClass
    AnyName        = String
    "AnyName"
        show (AnyNameExcept NameClass
    nameClass)
                            = String
    "AnyNameExcept: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ NameClass -> String
    forall a. Show a => a -> String
    show NameClass
    nameClass
        show (Name String
    uri String
    localName)
            | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    uri      = String
    localName
            | Bool
    otherwise     = String
    "{" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    uri String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "}" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    localName
        show (NsName String
    uri)   = String
    "{" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    uri String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "}AnyName"
        show (NsNameExcept String
    uri NameClass
    nameClass)
                            = String
    "NsNameExcept: {" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    uri String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "}" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ NameClass -> String
    forall a. Show a => a -> String
    show NameClass
    nameClass
        show (NameClassChoice NameClass
    nameClass1 NameClass
    nameClass2)
                            = String
    "NameClassChoice: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ NameClass -> String
    forall a. Show a => a -> String
    show NameClass
    nameClass1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "|" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ NameClass -> String
    forall a. Show a => a -> String
    show NameClass
    nameClass2
        show (NCError String
    string)
                             = String
    "NCError: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    string

    -- | Represents a pattern after simplification

    data Pattern = NotAllowed ErrMessage                    -- {}
                 | Empty                                    -- {epsilon}
                 | Text                                     -- symbol: text
                 | Element    NameClass Pattern             -- symbol: element with pattern for children
                 | Attribute  NameClass Pattern             -- symbol: attr    with pattern for value
                 | Choice     Pattern   Pattern             -- binary combinator, symmetric
                 | Interleave Pattern   Pattern             --   "         "    , symmetric
                 | Group      Pattern   Pattern             --   "         "
                 | After      Pattern   Pattern             --   "         "
                 | OneOrMore  Pattern                       -- unary combinator
                 | Data       Datatype  ParamList           -- value check
                 | DataExcept Datatype  ParamList Pattern
                 | List       Pattern                       -- value check
                 | Value      Datatype  String    Context   -- value check

    data Pattern' = NotAllowed'
                 | Empty'
                 | Text'
                 | Element'
                 | Attribute'
                 | Data'
                 | DataExcept'
                 | List'
                 | Value'
                 | OneOrMore'
                 | Interleave'
                 | Group'
                 | After'
                 | Choice'
                   deriving (Pattern' -> Pattern' -> Bool
    (Pattern' -> Pattern' -> Bool)
    -> (Pattern' -> Pattern' -> Bool) -> Eq Pattern'
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Pattern' -> Pattern' -> Bool
    == :: Pattern' -> Pattern' -> Bool
    $c/= :: Pattern' -> Pattern' -> Bool
    /= :: Pattern' -> Pattern' -> Bool
    Eq, Eq Pattern'
    Eq Pattern'
    -> (Pattern' -> Pattern' -> Ordering)
    -> (Pattern' -> Pattern' -> Bool)
    -> (Pattern' -> Pattern' -> Bool)
    -> (Pattern' -> Pattern' -> Bool)
    -> (Pattern' -> Pattern' -> Bool)
    -> (Pattern' -> Pattern' -> Pattern')
    -> (Pattern' -> Pattern' -> Pattern')
    -> Ord Pattern'
    Pattern' -> Pattern' -> Bool
    Pattern' -> Pattern' -> Ordering
    Pattern' -> Pattern' -> Pattern'
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Pattern' -> Pattern' -> Ordering
    compare :: Pattern' -> Pattern' -> Ordering
    $c< :: Pattern' -> Pattern' -> Bool
    < :: Pattern' -> Pattern' -> Bool
    $c<= :: Pattern' -> Pattern' -> Bool
    <= :: Pattern' -> Pattern' -> Bool
    $c> :: Pattern' -> Pattern' -> Bool
    > :: Pattern' -> Pattern' -> Bool
    $c>= :: Pattern' -> Pattern' -> Bool
    >= :: Pattern' -> Pattern' -> Bool
    $cmax :: Pattern' -> Pattern' -> Pattern'
    max :: Pattern' -> Pattern' -> Pattern'
    $cmin :: Pattern' -> Pattern' -> Pattern'
    min :: Pattern' -> Pattern' -> Pattern'
    Ord)

    ord' :: Pattern -> Pattern'
    ord' :: Pattern -> Pattern'
    ord' NotAllowed{}            = Pattern'
    NotAllowed'
    ord' Pattern
    Empty                   = Pattern'
    Empty'
    ord' Pattern
    Text                    = Pattern'
    Text'
    ord' Element{}               = Pattern'
    Element'
    ord' Attribute{}             = Pattern'
    Attribute'
    ord' Choice{}                = Pattern'
    Choice'
    ord' Interleave{}            = Pattern'
    Interleave'
    ord' Group{}                 = Pattern'
    Group'
    ord' After{}                 = Pattern'
    After'
    ord' OneOrMore{}             = Pattern'
    OneOrMore'
    ord' Data{}                  = Pattern'
    Data'
    ord' DataExcept{}            = Pattern'
    DataExcept'
    ord' List{}                  = Pattern'
    List'
    ord' Value{}                 = Pattern'
    Value'

    equiv :: Pattern -> Pattern -> Bool
    equiv :: Pattern -> Pattern -> Bool
    equiv NotAllowed{}            NotAllowed{}            = Bool
    True
    equiv Pattern
    Empty                   Pattern
    Empty                   = Bool
    True
    equiv Pattern
    Text                    Pattern
    Text                    = Bool
    True
    equiv (Element    NameClass
    nc1 Pattern
    _p1)    (Element NameClass
    nc2 Pattern
    _p2)       = NameClass
    nc1 NameClass -> NameClass -> Bool
    forall a. Eq a => a -> a -> Bool
    == NameClass
    nc2
    equiv (Attribute  NameClass
    nc1 Pattern
    _p1)    (Attribute NameClass
    nc2 Pattern
    _p2)     = NameClass
    nc1 NameClass -> NameClass -> Bool
    forall a. Eq a => a -> a -> Bool
    == NameClass
    nc2
    equiv (Choice     Pattern
    p11 Pattern
    p12)    (Choice Pattern
    p21 Pattern
    p22)        = Pattern
    p11 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21 Bool -> Bool -> Bool
    && Pattern
    p12 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p22
    equiv (Interleave Pattern
    p11 Pattern
    p12)    (Interleave Pattern
    p21 Pattern
    p22)    = Pattern
    p11 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21 Bool -> Bool -> Bool
    && Pattern
    p12 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p22
    equiv (Group      Pattern
    p11 Pattern
    p12)    (Group      Pattern
    p21 Pattern
    p22)    = Pattern
    p11 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21 Bool -> Bool -> Bool
    && Pattern
    p12 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p22
    equiv (After      Pattern
    p11 Pattern
    p12)    (After      Pattern
    p21 Pattern
    p22)    = Pattern
    p11 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21 Bool -> Bool -> Bool
    && Pattern
    p12 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p22
    equiv (OneOrMore  Pattern
    p1)         (OneOrMore  Pattern
    p2)         = Pattern
    p1  Pattern -> Pattern -> Bool
    `equiv` Pattern
    p2
    equiv (Data       Datatype
    dt1 ParamList
    pl1)    (Data       Datatype
    dt2 ParamList
    pl2)    = Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Eq a => a -> a -> Bool
    == Datatype
    dt2 Bool -> Bool -> Bool
    && ParamList
    pl1 ParamList -> ParamList -> Bool
    forall a. Eq a => a -> a -> Bool
    == ParamList
    pl2
    equiv (DataExcept Datatype
    dt1 ParamList
    pl1 Pattern
    p1) (DataExcept Datatype
    dt2 ParamList
    pl2 Pattern
    p2) = Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Eq a => a -> a -> Bool
    == Datatype
    dt2 Bool -> Bool -> Bool
    && ParamList
    pl1 ParamList -> ParamList -> Bool
    forall a. Eq a => a -> a -> Bool
    == ParamList
    pl2 Bool -> Bool -> Bool
    && Pattern
    p1 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p2
    equiv (List Pattern
    p1)               (List Pattern
    p2)               = Pattern
    p1  Pattern -> Pattern -> Bool
    `equiv` Pattern
    p2
    equiv (Value Datatype
    dt1 String
    s1 Context
    cx1)      (Value Datatype
    dt2 String
    s2 Context
    cx2)      = Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Eq a => a -> a -> Bool
    == Datatype
    dt2 Bool -> Bool -> Bool
    && String
    s1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    s2 Bool -> Bool -> Bool
    && Context
    cx1 Context -> Context -> Bool
    forall a. Eq a => a -> a -> Bool
    == Context
    cx2
    equiv Pattern
    _                       Pattern
    _                       = Bool
    False

    gt :: Pattern -> Pattern -> Bool
    gt :: Pattern -> Pattern -> Bool
    gt Pattern
    p1                      Pattern
    p2
        | Pattern -> Pattern'
    ord' Pattern
    p1 Pattern' -> Pattern' -> Bool
    forall a. Ord a => a -> a -> Bool
    > Pattern -> Pattern'
    ord' Pattern
    p2                            = Bool
    True
        | Pattern -> Pattern'
    ord' Pattern
    p1 Pattern' -> Pattern' -> Bool
    forall a. Ord a => a -> a -> Bool
    < Pattern -> Pattern'
    ord' Pattern
    p2                            = Bool
    False
    gt (Element    NameClass
    nc1 Pattern
    _p1)    (Element NameClass
    nc2 Pattern
    _p2)       = NameClass
    nc1 NameClass -> NameClass -> Bool
    forall a. Ord a => a -> a -> Bool
    > NameClass
    nc2
    gt (Attribute  NameClass
    nc1 Pattern
    _p1)    (Attribute NameClass
    nc2 Pattern
    _p2)     = NameClass
    nc1 NameClass -> NameClass -> Bool
    forall a. Ord a => a -> a -> Bool
    > NameClass
    nc2
    gt (Choice     Pattern
    p11 Pattern
    p12)    (Choice Pattern
    p21 Pattern
    p22)        = Pattern
    p11 Pattern -> Pattern -> Bool
    `gt` Pattern
    p21
                                                         Bool -> Bool -> Bool
    || Pattern
    p11 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21 Bool -> Bool -> Bool
    && Pattern
    p12 Pattern -> Pattern -> Bool
    `gt` Pattern
    p22
    gt (Interleave Pattern
    p11 Pattern
    p12)    (Interleave Pattern
    p21 Pattern
    p22)    = Pattern
    p11 Pattern -> Pattern -> Bool
    `gt` Pattern
    p21
                                                         Bool -> Bool -> Bool
    || Pattern
    p11 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21 Bool -> Bool -> Bool
    && Pattern
    p12 Pattern -> Pattern -> Bool
    `gt` Pattern
    p22
    gt (Group      Pattern
    p11 Pattern
    p12)    (Group      Pattern
    p21 Pattern
    p22)    = Pattern
    p11 Pattern -> Pattern -> Bool
    `gt` Pattern
    p21
                                                         Bool -> Bool -> Bool
    || Pattern
    p11 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21 Bool -> Bool -> Bool
    && Pattern
    p12 Pattern -> Pattern -> Bool
    `gt` Pattern
    p22
    gt (After      Pattern
    p11 Pattern
    p12)    (After      Pattern
    p21 Pattern
    p22)    = Pattern
    p11 Pattern -> Pattern -> Bool
    `gt` Pattern
    p21
                                                         Bool -> Bool -> Bool
    || Pattern
    p11 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21 Bool -> Bool -> Bool
    && Pattern
    p12 Pattern -> Pattern -> Bool
    `gt` Pattern
    p22
    gt (OneOrMore  Pattern
    p1)         (OneOrMore  Pattern
    p2)         = Pattern
    p1  Pattern -> Pattern -> Bool
    `gt` Pattern
    p2
    gt (Data Datatype
    dt1 ParamList
    pl1)          (Data Datatype
    dt2 ParamList
    pl2)          = Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Ord a => a -> a -> Bool
    > Datatype
    dt2
                                                         Bool -> Bool -> Bool
    || Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Eq a => a -> a -> Bool
    == Datatype
    dt2 Bool -> Bool -> Bool
    && ParamList
    pl1 ParamList -> ParamList -> Bool
    forall a. Eq a => a -> a -> Bool
    == ParamList
    pl2
    gt (DataExcept Datatype
    dt1 ParamList
    pl1 Pattern
    p1) (DataExcept Datatype
    dt2 ParamList
    pl2 Pattern
    p2) = Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Ord a => a -> a -> Bool
    > Datatype
    dt2
                                                         Bool -> Bool -> Bool
    || Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Eq a => a -> a -> Bool
    == Datatype
    dt2
                                                            Bool -> Bool -> Bool
    && (ParamList
    pl1 ParamList -> ParamList -> Bool
    forall a. Ord a => a -> a -> Bool
    > ParamList
    pl2 Bool -> Bool -> Bool
    || ParamList
    pl1 ParamList -> ParamList -> Bool
    forall a. Eq a => a -> a -> Bool
    == ParamList
    pl2 Bool -> Bool -> Bool
    && Pattern
    p1 Pattern -> Pattern -> Bool
    `gt` Pattern
    p2)
    gt (List Pattern
    p1)               (List Pattern
    p2)               = Pattern
    p1  Pattern -> Pattern -> Bool
    `gt` Pattern
    p2
    gt (Value Datatype
    dt1 String
    s1 Context
    cx1)      (Value Datatype
    dt2 String
    s2 Context
    cx2)      = Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Ord a => a -> a -> Bool
    > Datatype
    dt2
                                                         Bool -> Bool -> Bool
    || Datatype
    dt1 Datatype -> Datatype -> Bool
    forall a. Eq a => a -> a -> Bool
    == Datatype
    dt2
                                                            Bool -> Bool -> Bool
    && (String
    s1 String -> String -> Bool
    forall a. Ord a => a -> a -> Bool
    > String
    s2 Bool -> Bool -> Bool
    || String
    s1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    s2 Bool -> Bool -> Bool
    && Context
    cx1 Context -> Context -> Bool
    forall a. Ord a => a -> a -> Bool
    > Context
    cx2)
    gt Pattern
    _                       Pattern
    _                       = Bool
    False

    {-
    instance Show Pattern where
        show Empty                  = "empty"
        show (NotAllowed e)         = show e
        show Text                   = "text"
        show (Choice p1 p2)         = "( " ++ show p1 ++ " | " ++ show p2 ++ " )"
        show (Interleave p1 p2)     = "( " ++ show p1 ++ " & " ++ show p2 ++ " )"
        show (Group p1 p2)          = "( " ++ show p1 ++ " , " ++ show p2 ++ " )"
        show (OneOrMore p)          = show p ++ "+"
        show (List p)               = "list { " ++ show p ++ " }"
        show (Data dt pl)           = showDatatype dt ++ showPL pl
                                      where
                                      showPL []     = ""
                                      showPL l      = " {" ++ concatMap showP l ++ " }"
                                      showP (ln, v) = " " ++ ln ++ " = " ++ show v
        show (DataExcept dt pl p)   = show (Data dt pl) ++ " - (" ++ show p ++ " )"
        show (Value dt v _cx)       = showDatatype dt ++ " " ++ show v
        show (Attribute nc p)       = "attribute " ++ show nc ++ " { " ++ show p ++ " }"
        show (Element nc p)         = "element "   ++ show nc ++ " { " ++ show p ++ " }"
        show (After p1 p2)          =  "( " ++ show p1 ++ " ; " ++ show p2 ++ " )"
    -- -}

    instance Show Pattern where
        show :: Pattern -> String
    show Pattern
    Empty                  = String
    "empty"
        show (NotAllowed ErrMessage
    e)         = ErrMessage -> String
    forall a. Show a => a -> String
    show ErrMessage
    e
        show Pattern
    Text                   = String
    "text"
        show (Choice Pattern
    p1 Pattern
    p2)         = String
    "( " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " | " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p2 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " )"
        show (Interleave Pattern
    p1 Pattern
    p2)     = String
    "( " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " & " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p2 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " )"
        show (Group Pattern
    p1 Pattern
    p2)          = String
    "( " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " , " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p2 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " )"
        show (OneOrMore Pattern
    p)          = Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "+"
        show (List Pattern
    p)               = String
    "list { " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " }"
        show (Data Datatype
    dt ParamList
    pl)           = Datatype -> String
    showDatatype Datatype
    dt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ParamList -> String
    forall {a}. Show a => [(String, a)] -> String
    showPL ParamList
    pl
                                      where
                                      showPL :: [(String, a)] -> String
    showPL []     = String
    ""
                                      showPL [(String, a)]
    l      = String
    " {" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ((String, a) -> String) -> [(String, a)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (String, a) -> String
    forall {a}. Show a => (String, a) -> String
    showP [(String, a)]
    l String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " }"
                                      showP :: (String, a) -> String
    showP (String
    ln, a
    v) = String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ln String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    v
        show (DataExcept Datatype
    dt ParamList
    pl Pattern
    p)   = Pattern -> String
    forall a. Show a => a -> String
    show (Datatype -> ParamList -> Pattern
    Data Datatype
    dt ParamList
    pl) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " - (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " )"
        show (Value Datatype
    dt String
    v Context
    _cx)       = Datatype -> String
    showDatatype Datatype
    dt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    v
        show (Attribute NameClass
    nc Pattern
    _p)      = String
    "a[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ NameClass -> String
    forall a. Show a => a -> String
    show NameClass
    nc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]{...}"
        show (Element   NameClass
    nc Pattern
    _p)      = String
    "e[" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ NameClass -> String
    forall a. Show a => a -> String
    show NameClass
    nc String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "]{...}"
        show (After Pattern
    p1 Pattern
    p2)          =  String
    "( " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " ; " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Pattern -> String
    forall a. Show a => a -> String
    show Pattern
    p2 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " )"

    data ErrMessage = ErrMsg ErrLevel [String]
                      -- deriving Show

    instance Show ErrMessage where
        show :: ErrMessage -> String
    show (ErrMsg ErrLevel
    _lev [String]
    es) = (String -> String -> String) -> [String] -> String
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (\ String
    x String
    y -> String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    y) [String]
    es

    type ErrLevel   = Int

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

    -- smart constructor funtions for Pattern

    -- | smart constructor for NotAllowed

    notAllowed      :: String -> Pattern
    notAllowed :: String -> Pattern
    notAllowed      = ErrLevel -> String -> Pattern
    notAllowedN ErrLevel
    0

    notAllowed1     :: String -> Pattern
    notAllowed1 :: String -> Pattern
    notAllowed1     = ErrLevel -> String -> Pattern
    notAllowedN ErrLevel
    1

    notAllowed2     :: String -> Pattern
    notAllowed2 :: String -> Pattern
    notAllowed2     = ErrLevel -> String -> Pattern
    notAllowedN ErrLevel
    2

    notAllowedN     :: ErrLevel -> String -> Pattern
    notAllowedN :: ErrLevel -> String -> Pattern
    notAllowedN ErrLevel
    l String
    s = ErrMessage -> Pattern
    NotAllowed (ErrLevel -> [String] -> ErrMessage
    ErrMsg ErrLevel
    l [String
    s])

    -- | merge error messages
    --
    -- If error levels are different, the more important is taken,
    -- if level is 2 (max level) both error messages are taken
    -- else the 1. error mesage is taken

    mergeNotAllowed :: Pattern -> Pattern -> Pattern
    mergeNotAllowed :: Pattern -> Pattern -> Pattern
    mergeNotAllowed p1 :: Pattern
    p1@(NotAllowed (ErrMsg ErrLevel
    l1 [String]
    s1)) p2 :: Pattern
    p2@(NotAllowed (ErrMsg ErrLevel
    l2 [String]
    s2))
        | ErrLevel
    l1 ErrLevel -> ErrLevel -> Bool
    forall a. Ord a => a -> a -> Bool
    < ErrLevel
    l2   = Pattern
    p2
        | ErrLevel
    l1 ErrLevel -> ErrLevel -> Bool
    forall a. Ord a => a -> a -> Bool
    > ErrLevel
    l2   = Pattern
    p1
        | ErrLevel
    l1 ErrLevel -> ErrLevel -> Bool
    forall a. Eq a => a -> a -> Bool
    == ErrLevel
    2   = ErrMessage -> Pattern
    NotAllowed (ErrMessage -> Pattern) -> ErrMessage -> Pattern
    forall a b. (a -> b) -> a -> b
    $ ErrLevel -> [String] -> ErrMessage
    ErrMsg ErrLevel
    2 ([String]
    s1 [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    s2)
        | Bool
    otherwise = Pattern
    p1

    -- TODO : weird error when collecting error messages errors are duplicated

    mergeNotAllowed Pattern
    _p1 Pattern
    _p2
        = String -> Pattern
    notAllowed2 String
    "mergeNotAllowed with wrong patterns"

    -- | smart constructor for Choice
    --
    -- nexted choices are transformed into a sorted list

    {-
    choice' :: Pattern -> Pattern -> Pattern
    choice' p1 p2
        = T.trace ("choice:\np1=" ++ show p1 ++ "\np2=" ++ show p2) $
          T.trace ("res=" ++ show res) $ res
        where
          res = choice p1 p2
    -- -}

    choice :: Pattern -> Pattern -> Pattern
    choice :: Pattern -> Pattern -> Pattern
    choice p1 :: Pattern
    p1@(NotAllowed ErrMessage
    _) p2 :: Pattern
    p2@(NotAllowed ErrMessage
    _)      = Pattern -> Pattern -> Pattern
    mergeNotAllowed Pattern
    p1 Pattern
    p2
    choice Pattern
    p1                   (NotAllowed ErrMessage
    _)      = Pattern
    p1
    choice (NotAllowed ErrMessage
    _)    Pattern
    p2                     = Pattern
    p2
    choice (Choice Pattern
    p11 Pattern
    p12)  Pattern
    p2                     = Pattern -> Pattern -> Pattern
    choice Pattern
    p11 (Pattern -> Pattern -> Pattern
    choice Pattern
    p12 Pattern
    p2)
    choice Pattern
    p1                p2 :: Pattern
    p2@(Choice Pattern
    p21 Pattern
    p22)
        | Pattern
    p1 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p21                            = Pattern
    p2
        | Pattern
    p1 Pattern -> Pattern -> Bool
    `gt`    Pattern
    p21                            = Pattern -> Pattern -> Pattern
    choice Pattern
    p21 (Pattern -> Pattern -> Pattern
    choice Pattern
    p1 Pattern
    p22)
        | Bool
    otherwise                                 = Pattern -> Pattern -> Pattern
    Choice Pattern
    p1 Pattern
    p2
    choice Pattern
    p1                Pattern
    p2
        | Pattern
    p1 Pattern -> Pattern -> Bool
    `equiv` Pattern
    p2                             = Pattern
    p2
        | Pattern
    p1 Pattern -> Pattern -> Bool
    `gt`    Pattern
    p2                             = Pattern -> Pattern -> Pattern
    choice Pattern
    p2 Pattern
    p1
        | Bool
    otherwise                                 = Pattern -> Pattern -> Pattern
    Choice Pattern
    p1 Pattern
    p2

    -- | smart constructor for Group

    group :: Pattern -> Pattern -> Pattern
    group :: Pattern -> Pattern -> Pattern
    group p1 :: Pattern
    p1@(NotAllowed ErrMessage
    _)  p2 :: Pattern
    p2@(NotAllowed ErrMessage
    _)      = Pattern -> Pattern -> Pattern
    mergeNotAllowed Pattern
    p1 Pattern
    p2
    group Pattern
    _                   n :: Pattern
    n@(NotAllowed ErrMessage
    _)      = Pattern
    n
    group   n :: Pattern
    n@(NotAllowed ErrMessage
    _)  Pattern
    _                     = Pattern
    n
    group Pattern
    p                  Pattern
    Empty                  = Pattern
    p
    group Pattern
    Empty              Pattern
    p                      = Pattern
    p
    group Pattern
    p1                 Pattern
    p2                     = Pattern -> Pattern -> Pattern
    Group Pattern
    p1 Pattern
    p2

    -- | smart constructor for OneOrMore

    oneOrMore :: Pattern -> Pattern
    oneOrMore :: Pattern -> Pattern
    oneOrMore n :: Pattern
    n@(NotAllowed ErrMessage
    _) = Pattern
    n
    oneOrMore Pattern
    p                = Pattern -> Pattern
    OneOrMore Pattern
    p

    -- | smart constructor for Interleave
    --
    -- nested interleaves are transformed into a sorted list

    interleave :: Pattern -> Pattern -> Pattern
    interleave :: Pattern -> Pattern -> Pattern
    interleave p1 :: Pattern
    p1@(NotAllowed ErrMessage
    _) p2 :: Pattern
    p2@(NotAllowed ErrMessage
    _)  = Pattern -> Pattern -> Pattern
    mergeNotAllowed Pattern
    p1 Pattern
    p2
    interleave Pattern
    _                 p2 :: Pattern
    p2@(NotAllowed ErrMessage
    _)  = Pattern
    p2
    interleave p1 :: Pattern
    p1@(NotAllowed ErrMessage
    _) Pattern
    _                  = Pattern
    p1
    interleave Pattern
    p1                Pattern
    Empty              = Pattern
    p1
    interleave Pattern
    Empty             Pattern
    p2                 = Pattern
    p2
    interleave (Interleave Pattern
    p11 Pattern
    p12) Pattern
    p2              = Pattern -> Pattern -> Pattern
    interleave Pattern
    p11 (Pattern -> Pattern -> Pattern
    interleave Pattern
    p12 Pattern
    p2)
    interleave Pattern
    p1                p2 :: Pattern
    p2@(Interleave Pattern
    p21 Pattern
    p22)
        | Pattern
    p1 Pattern -> Pattern -> Bool
    `gt` Pattern
    p21                               = Pattern -> Pattern -> Pattern
    interleave Pattern
    p21 (Pattern -> Pattern -> Pattern
    interleave Pattern
    p1 Pattern
    p22)
        | Bool
    otherwise                                 = Pattern -> Pattern -> Pattern
    Interleave Pattern
    p1 Pattern
    p2
    interleave Pattern
    p1                Pattern
    p2
        | Pattern
    p1 Pattern -> Pattern -> Bool
    `gt` Pattern
    p2                                = Pattern -> Pattern -> Pattern
    interleave Pattern
    p2 Pattern
    p1
        | Bool
    otherwise                                 = Pattern -> Pattern -> Pattern
    Interleave Pattern
    p1 Pattern
    p2

    -- | smart constructor for After

    after :: Pattern -> Pattern -> Pattern
    after :: Pattern -> Pattern -> Pattern
    after p1 :: Pattern
    p1@(NotAllowed ErrMessage
    _) p2 :: Pattern
    p2@(NotAllowed ErrMessage
    _)       = Pattern -> Pattern -> Pattern
    mergeNotAllowed Pattern
    p1 Pattern
    p2
    after Pattern
    _                 p2 :: Pattern
    p2@(NotAllowed ErrMessage
    _)       = Pattern
    p2
    after p1 :: Pattern
    p1@(NotAllowed ErrMessage
    _) Pattern
    _                       = Pattern
    p1
    after Pattern
    p1                Pattern
    p2                      = Pattern -> Pattern -> Pattern
    After Pattern
    p1 Pattern
    p2

    -- | Possible content types of a Relax NG pattern.
    -- (see also chapter 7.2 in Relax NG specification)

    data ContentType = CTEmpty
                     | CTComplex
                     | CTSimple
                     | CTNone
         deriving (ErrLevel -> ContentType -> String -> String
    [ContentType] -> String -> String
    ContentType -> String
    (ErrLevel -> ContentType -> String -> String)
    -> (ContentType -> String)
    -> ([ContentType] -> String -> String)
    -> Show ContentType
    forall a.
    (ErrLevel -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: ErrLevel -> ContentType -> String -> String
    showsPrec :: ErrLevel -> ContentType -> String -> String
    $cshow :: ContentType -> String
    show :: ContentType -> String
    $cshowList :: [ContentType] -> String -> String
    showList :: [ContentType] -> String -> String
    Show, ContentType -> ContentType -> Bool
    (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool) -> Eq ContentType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ContentType -> ContentType -> Bool
    == :: ContentType -> ContentType -> Bool
    $c/= :: ContentType -> ContentType -> Bool
    /= :: ContentType -> ContentType -> Bool
    Eq, Eq ContentType
    Eq ContentType
    -> (ContentType -> ContentType -> Ordering)
    -> (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> Bool)
    -> (ContentType -> ContentType -> ContentType)
    -> (ContentType -> ContentType -> ContentType)
    -> Ord ContentType
    ContentType -> ContentType -> Bool
    ContentType -> ContentType -> Ordering
    ContentType -> ContentType -> ContentType
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: ContentType -> ContentType -> Ordering
    compare :: ContentType -> ContentType -> Ordering
    $c< :: ContentType -> ContentType -> Bool
    < :: ContentType -> ContentType -> Bool
    $c<= :: ContentType -> ContentType -> Bool
    <= :: ContentType -> ContentType -> Bool
    $c> :: ContentType -> ContentType -> Bool
    > :: ContentType -> ContentType -> Bool
    $c>= :: ContentType -> ContentType -> Bool
    >= :: ContentType -> ContentType -> Bool
    $cmax :: ContentType -> ContentType -> ContentType
    max :: ContentType -> ContentType -> ContentType
    $cmin :: ContentType -> ContentType -> ContentType
    min :: ContentType -> ContentType -> ContentType
    Ord)

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