    -- | This modul exports the list of supported datatype libraries.
    -- It also exports the main functions to validate an XML instance value
    -- with respect to a datatype.

    module Text.XML.HXT.RelaxNG.DataTypeLibraries
      ( datatypeLibraries
      , datatypeEqual
      , datatypeAllows
      )
    where

    import Text.XML.HXT.DOM.Interface
        ( relaxNamespace
        )

    import Text.XML.HXT.RelaxNG.DataTypeLibUtils

    import Text.XML.HXT.RelaxNG.DataTypeLibMysql
        ( mysqlDatatypeLib )

    import Text.XML.HXT.RelaxNG.XMLSchema.DataTypeLibW3C
        ( w3cDatatypeLib )

    import Data.Maybe
        ( fromJust )

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

    -- | List of all supported datatype libraries which can be
    -- used within the Relax NG validator modul.

    datatypeLibraries :: DatatypeLibraries
    datatypeLibraries :: DatatypeLibraries
    datatypeLibraries
        = [ DatatypeLibrary
    relaxDatatypeLib
          , DatatypeLibrary
    relaxDatatypeLib'
          , DatatypeLibrary
    mysqlDatatypeLib
          , DatatypeLibrary
    w3cDatatypeLib
          ]

    {- |
    Tests whether a XML instance value matches a value-pattern.

    The following tests are performed:

       * 1. :  does the uri exist in the list of supported datatype libraries

       - 2. :  does the library support the datatype

       - 3. :  does the XML instance value match the value-pattern

    The hard work is done by the specialized 'DatatypeEqual' function
    (see also: 'DatatypeCheck') of the datatype library.
    -}

    datatypeEqual :: Uri -> DatatypeEqual
    datatypeEqual :: String -> DatatypeEqual
    datatypeEqual String
    uri String
    d String
    s1 Context
    c1 String
    s2 Context
    c2
        = if String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    uri ((DatatypeLibrary -> String) -> DatatypeLibraries -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map DatatypeLibrary -> String
    forall a b. (a, b) -> a
    fst DatatypeLibraries
    datatypeLibraries)
          then DatatypeEqual
    dtEqFct String
    d String
    s1 Context
    c1 String
    s2 Context
    c2
          else String -> Maybe String
    forall a. a -> Maybe a
    Just ( String
    "Unknown DatatypeLibrary " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    uri )
        where
        DTC DatatypeAllows
    _ DatatypeEqual
    dtEqFct AllowedDatatypes
    _ = Maybe DatatypeCheck -> DatatypeCheck
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe DatatypeCheck -> DatatypeCheck)
    -> Maybe DatatypeCheck -> DatatypeCheck
    forall a b. (a -> b) -> a -> b
    $ String -> DatatypeLibraries -> Maybe DatatypeCheck
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    uri DatatypeLibraries
    datatypeLibraries

    {- |
    Tests whether a XML instance value matches a data-pattern.

    The following tests are performed:

       * 1. :  does the uri exist in the list of supported datatype libraries

       - 2. :  does the library support the datatype

       - 3. :  does the XML instance value match the data-pattern

       - 4. :  does the XML instance value match all params

    The hard work is done by the specialized 'DatatypeAllows' function
    (see also: 'DatatypeCheck') of the datatype library.

    -}

    datatypeAllows :: Uri -> DatatypeAllows
    datatypeAllows :: String -> DatatypeAllows
    datatypeAllows String
    uri String
    d ParamList
    params String
    s1 Context
    c1
        = if String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem String
    uri ((DatatypeLibrary -> String) -> DatatypeLibraries -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map DatatypeLibrary -> String
    forall a b. (a, b) -> a
    fst DatatypeLibraries
    datatypeLibraries)
          then DatatypeAllows
    dtAllowFct String
    d ParamList
    params String
    s1 Context
    c1
          else String -> Maybe String
    forall a. a -> Maybe a
    Just ( String
    "Unknown DatatypeLibrary " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    uri )
        where
        DTC DatatypeAllows
    dtAllowFct DatatypeEqual
    _ AllowedDatatypes
    _ = Maybe DatatypeCheck -> DatatypeCheck
    forall a. HasCallStack => Maybe a -> a
    fromJust (Maybe DatatypeCheck -> DatatypeCheck)
    -> Maybe DatatypeCheck -> DatatypeCheck
    forall a b. (a -> b) -> a -> b
    $ String -> DatatypeLibraries -> Maybe DatatypeCheck
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    uri DatatypeLibraries
    datatypeLibraries

    -- --------------------------------------------------------------------------------------
    -- Relax NG build in datatype library

    relaxDatatypeLib        :: DatatypeLibrary
    relaxDatatypeLib :: DatatypeLibrary
    relaxDatatypeLib        = (String
    relaxNamespace, DatatypeAllows
    -> DatatypeEqual -> AllowedDatatypes -> DatatypeCheck
    DTC DatatypeAllows
    datatypeAllowsRelax DatatypeEqual
    datatypeEqualRelax AllowedDatatypes
    relaxDatatypes)

    -- | if there is no datatype uri, the built in datatype library is used
    relaxDatatypeLib'       :: DatatypeLibrary
    relaxDatatypeLib' :: DatatypeLibrary
    relaxDatatypeLib'       = (String
    "",             DatatypeAllows
    -> DatatypeEqual -> AllowedDatatypes -> DatatypeCheck
    DTC DatatypeAllows
    datatypeAllowsRelax DatatypeEqual
    datatypeEqualRelax AllowedDatatypes
    relaxDatatypes)

    -- | The build in Relax NG datatype lib supportes only the token and string datatype,
    -- without any params.

    relaxDatatypes :: AllowedDatatypes
    relaxDatatypes :: AllowedDatatypes
    relaxDatatypes
        = ((String, String -> String -> Bool) -> (String, [String]))
    -> [(String, String -> String -> Bool)] -> AllowedDatatypes
    forall a b. (a -> b) -> [a] -> [b]
    map ( (\ String
    x -> (String
    x, [])) (String -> (String, [String]))
    -> ((String, String -> String -> Bool) -> String)
    -> (String, String -> String -> Bool)
    -> (String, [String])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, String -> String -> Bool) -> String
    forall a b. (a, b) -> a
    fst ) [(String, String -> String -> Bool)]
    relaxDatatypeTable

    datatypeAllowsRelax :: DatatypeAllows
    datatypeAllowsRelax :: DatatypeAllows
    datatypeAllowsRelax String
    d ParamList
    p String
    v Context
    _
        = Maybe String
    -> ((String -> String -> Bool) -> Maybe String)
    -> Maybe (String -> String -> Bool)
    -> Maybe String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe String
    notAllowed' (String -> String -> Bool) -> Maybe String
    forall {p} {a}. p -> Maybe a
    allowed (Maybe (String -> String -> Bool) -> Maybe String)
    -> ([(String, String -> String -> Bool)]
        -> Maybe (String -> String -> Bool))
    -> [(String, String -> String -> Bool)]
    -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String
    -> [(String, String -> String -> Bool)]
    -> Maybe (String -> String -> Bool)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    d ([(String, String -> String -> Bool)] -> Maybe String)
    -> [(String, String -> String -> Bool)] -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [(String, String -> String -> Bool)]
    relaxDatatypeTable
        where
        notAllowed' :: Maybe String
    notAllowed'
            = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> ParamList -> String -> String
    errorMsgDataTypeNotAllowed String
    relaxNamespace String
    d ParamList
    p String
    v
        allowed :: p -> Maybe a
    allowed p
    _
            = Maybe a
    forall a. Maybe a
    Nothing

    -- | If the token datatype is used, the values have to be normalized
    -- (trailing and leading whitespaces are removed).
    -- token does not perform any changes to the values.

    datatypeEqualRelax :: DatatypeEqual
    datatypeEqualRelax :: DatatypeEqual
    datatypeEqualRelax String
    d String
    s1 Context
    _ String
    s2 Context
    _
        = Maybe String
    -> ((String -> String -> Bool) -> Maybe String)
    -> Maybe (String -> String -> Bool)
    -> Maybe String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe String
    notAllowed' (String -> String -> Bool) -> Maybe String
    checkValues (Maybe (String -> String -> Bool) -> Maybe String)
    -> ([(String, String -> String -> Bool)]
        -> Maybe (String -> String -> Bool))
    -> [(String, String -> String -> Bool)]
    -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String
    -> [(String, String -> String -> Bool)]
    -> Maybe (String -> String -> Bool)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    d ([(String, String -> String -> Bool)] -> Maybe String)
    -> [(String, String -> String -> Bool)] -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ [(String, String -> String -> Bool)]
    relaxDatatypeTable
          where
          notAllowed' :: Maybe String
    notAllowed'
              = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String -> String
    errorMsgDataTypeNotAllowed2 String
    relaxNamespace String
    d String
    s1 String
    s2
          checkValues :: (String -> String -> Bool) -> Maybe String
    checkValues String -> String -> Bool
    predicate
              = if String -> String -> Bool
    predicate String
    s1 String
    s2
                then Maybe String
    forall a. Maybe a
    Nothing
                else String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> String
    errorMsgEqual String
    d String
    s1 String
    s2

    relaxDatatypeTable :: [(String, String -> String -> Bool)]
    relaxDatatypeTable :: [(String, String -> String -> Bool)]
    relaxDatatypeTable
        = [ (String
    "string", String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    (==))
          , (String
    "token",  \ String
    s1 String
    s2 -> String -> String
    normalizeWhitespace String
    s1 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> String
    normalizeWhitespace String
    s2 )
          ]

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