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

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

    relaxDatatypeLib        :: DatatypeLibrary
    relaxDatatypeLib :: DatatypeLibrary
    relaxDatatypeLib        = (Uri
    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'       = ("",             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
        = ((Uri, Uri -> Uri -> Bool) -> (Uri, [Uri]))
    -> [(Uri, Uri -> Uri -> Bool)] -> AllowedDatatypes
    forall a b. (a -> b) -> [a] -> [b]
    map ( (\ x :: Uri
    x -> (Uri
    x, [])) (Uri -> (Uri, [Uri]))
    -> ((Uri, Uri -> Uri -> Bool) -> Uri)
    -> (Uri, Uri -> Uri -> Bool)
    -> (Uri, [Uri])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Uri, Uri -> Uri -> Bool) -> Uri
    forall a b. (a, b) -> a
    fst ) [(Uri, Uri -> Uri -> Bool)]
    relaxDatatypeTable

    datatypeAllowsRelax :: DatatypeAllows
    datatypeAllowsRelax :: DatatypeAllows
    datatypeAllowsRelax d :: Uri
    d p :: ParamList
    p v :: Uri
    v _
        = Maybe Uri
    -> ((Uri -> Uri -> Bool) -> Maybe Uri)
    -> Maybe (Uri -> Uri -> Bool)
    -> Maybe Uri
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe Uri
    notAllowed' (Uri -> Uri -> Bool) -> Maybe Uri
    forall p a. p -> Maybe a
    allowed (Maybe (Uri -> Uri -> Bool) -> Maybe Uri)
    -> ([(Uri, Uri -> Uri -> Bool)] -> Maybe (Uri -> Uri -> Bool))
    -> [(Uri, Uri -> Uri -> Bool)]
    -> Maybe Uri
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Uri -> [(Uri, Uri -> Uri -> Bool)] -> Maybe (Uri -> Uri -> Bool)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Uri
    d ([(Uri, Uri -> Uri -> Bool)] -> Maybe Uri)
    -> [(Uri, Uri -> Uri -> Bool)] -> Maybe Uri
    forall a b. (a -> b) -> a -> b
    $ [(Uri, Uri -> Uri -> Bool)]
    relaxDatatypeTable
        where
        notAllowed' :: Maybe Uri
    notAllowed'
            = Uri -> Maybe Uri
    forall a. a -> Maybe a
    Just (Uri -> Maybe Uri) -> Uri -> Maybe Uri
    forall a b. (a -> b) -> a -> b
    $ Uri -> Uri -> ParamList -> Uri -> Uri
    errorMsgDataTypeNotAllowed Uri
    relaxNamespace Uri
    d ParamList
    p Uri
    v
        allowed :: p -> Maybe a
    allowed _
            = 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 d :: Uri
    d s1 :: Uri
    s1 _ s2 :: Uri
    s2 _
        = Maybe Uri
    -> ((Uri -> Uri -> Bool) -> Maybe Uri)
    -> Maybe (Uri -> Uri -> Bool)
    -> Maybe Uri
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Maybe Uri
    notAllowed' (Uri -> Uri -> Bool) -> Maybe Uri
    checkValues (Maybe (Uri -> Uri -> Bool) -> Maybe Uri)
    -> ([(Uri, Uri -> Uri -> Bool)] -> Maybe (Uri -> Uri -> Bool))
    -> [(Uri, Uri -> Uri -> Bool)]
    -> Maybe Uri
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Uri -> [(Uri, Uri -> Uri -> Bool)] -> Maybe (Uri -> Uri -> Bool)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Uri
    d ([(Uri, Uri -> Uri -> Bool)] -> Maybe Uri)
    -> [(Uri, Uri -> Uri -> Bool)] -> Maybe Uri
    forall a b. (a -> b) -> a -> b
    $ [(Uri, Uri -> Uri -> Bool)]
    relaxDatatypeTable
          where
          notAllowed' :: Maybe Uri
    notAllowed'
              = Uri -> Maybe Uri
    forall a. a -> Maybe a
    Just (Uri -> Maybe Uri) -> Uri -> Maybe Uri
    forall a b. (a -> b) -> a -> b
    $ Uri -> Uri -> Uri -> Uri -> Uri
    errorMsgDataTypeNotAllowed2 Uri
    relaxNamespace Uri
    d Uri
    s1 Uri
    s2
          checkValues :: (Uri -> Uri -> Bool) -> Maybe Uri
    checkValues predicate :: Uri -> Uri -> Bool
    predicate
              = if Uri -> Uri -> Bool
    predicate Uri
    s1 Uri
    s2
                then Maybe Uri
    forall a. Maybe a
    Nothing
                else Uri -> Maybe Uri
    forall a. a -> Maybe a
    Just (Uri -> Maybe Uri) -> Uri -> Maybe Uri
    forall a b. (a -> b) -> a -> b
    $ Uri -> Uri -> Uri -> Uri
    errorMsgEqual Uri
    d Uri
    s1 Uri
    s2

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

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