content: -- | 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
      = [ relaxDatatypeLib
        , relaxDatatypeLib'
        , mysqlDatatypeLib
        , 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 d s1 c1 s2 c2
      = if elem uri (map fst datatypeLibraries)
        then dtEqFct d s1 c1 s2 c2
        else Just ( "Unknown DatatypeLibrary " ++ show uri )
      where
      DTC _ dtEqFct _ = fromJust $ lookup uri 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 d params s1 c1
      = if elem uri (map fst datatypeLibraries)
        then dtAllowFct d params s1 c1
        else Just ( "Unknown DatatypeLibrary " ++ show uri )
      where
      DTC dtAllowFct _ _ = fromJust $ lookup uri datatypeLibraries
  
  
  -- --------------------------------------------------------------------------------------
  -- Relax NG build in datatype library
  
  relaxDatatypeLib        :: DatatypeLibrary
  relaxDatatypeLib        = (relaxNamespace, DTC datatypeAllowsRelax datatypeEqualRelax relaxDatatypes)
  
  -- | if there is no datatype uri, the built in datatype library is used
  relaxDatatypeLib'       :: DatatypeLibrary
  relaxDatatypeLib'       = ("",             DTC datatypeAllowsRelax datatypeEqualRelax relaxDatatypes)
  
  -- | The build in Relax NG datatype lib supportes only the token and string datatype,
  -- without any params.
  
  relaxDatatypes :: AllowedDatatypes
  relaxDatatypes
      = map ( (\ x -> (x, [])) . fst ) relaxDatatypeTable
  
  datatypeAllowsRelax :: DatatypeAllows
  datatypeAllowsRelax d p v _
      = maybe notAllowed' allowed . lookup d $ relaxDatatypeTable
      where
      notAllowed'
          = Just $ errorMsgDataTypeNotAllowed relaxNamespace d p v
      allowed _
          = 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 d s1 _ s2 _
      = maybe notAllowed' checkValues . lookup d $ relaxDatatypeTable
        where
        notAllowed'
            = Just $ errorMsgDataTypeNotAllowed2 relaxNamespace d s1 s2
        checkValues predicate
            = if predicate s1 s2
              then Nothing
              else Just $ errorMsgEqual d s1 s2
  
  relaxDatatypeTable :: [(String, String -> String -> Bool)]
  relaxDatatypeTable
      = [ ("string", (==))
        , ("token",  \ s1 s2 -> normalizeWhitespace s1 == normalizeWhitespace s2 )
        ]
  
  
  -- --------------------------------------------------------------------------------------
  