hxt-relaxng 9.1.1 → 9.1.2

raw patch · 4 files changed

+87/−104 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• examples/hrelaxng/Validate.hs +34/−0
• hxt-relaxng.cabal +2/−1
• src/Text/XML/HXT/RelaxNG/Validation.hs +45/−27
• src/Text/XML/HXT/RelaxNG/Validator.hs +6/−76

@@ -0,0 +1,34 @@+module Validate where++import Data.Maybe++import Text.XML.HXT.Core+import Text.XML.HXT.RelaxNG++loadSchema	:: String -> IO (Maybe XmlTree)+loadSchema schema =+    runX ( validateSchemaWithRelax schema ) >>= return . listToMaybe++validateWithSchema	:: XmlTree -> XmlTree -> Maybe String+validateWithSchema schema doc+    = listToMaybe $+      runLA+      ( validateRelax' schema+        >>>+        getErrorMsg+      ) doc++main1    :: String -> String -> IO ()+main1 sf df+    = do+      schema <- loadSchema sf >>= return . fromJust+      doc    <- runX ( readDocument [ withValidate no ] df ) >>= return . head+      case validateWithSchema schema doc of+        Just e  -> putStrLn $ "Document " ++ show df ++ " is not valid for schema " ++ show sf ++ ": " ++ e+        Nothing -> putStrLn $ "Document " ++ show df ++ " is valid for schema " ++ show sf++main :: IO ()+main+    = do+      main1 "valid1.rng" "valid1.xml"+      main1 "valid1.rng" "invalid1.xml"

@@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox main description file Name:           hxt-relaxng-Version:        9.1.1+Version:        9.1.2 Synopsis:       The HXT RelaxNG validator Description:    The HXT RelaxNG validator License:        MIT@@ -25,6 +25,7 @@  examples/hparser/valid1.rng  examples/hparser/valid1.xml  examples/hrelaxng/HRelaxNG.hs+ examples/hrelaxng/Validate.hs  examples/hrelaxng/invalid1.xml  examples/hrelaxng/invalid2.rng  examples/hrelaxng/invalid3.rng

@@ -21,6 +21,7 @@     ( validateWithRelax     , validateDocWithRelax     , validateRelax+    , validateRelax'     , readForRelax     , normalizeForRelaxValidation     , contains@@ -117,8 +118,11 @@         validateWithRelax theSchema       ) -{- | Validates a xml document with respect to a Relax NG schema+{- | Validates an XML document with respect to a Relax NG schema+   and issues error messages. +   See also: `validateRelax'`+    * 1.parameter  :  Relax NG schema     - arrow-input  :  XML document@@ -126,37 +130,51 @@    - arrow-output :  the document or in case of errors none -} +-- ------------------------------------------------------------+ validateRelax :: XmlTree -> IOSArrow XmlTree XmlTree validateRelax rngSchema-    = ( fromLA-        ( ( ( constA rngSchema-              >>>-              createPatternFromXmlTree-            )-            &&&-            ( getChildren                       -- remove the root node-              >>>-              isElem                            -- and select the root element-            )+    = fromLA (validateRelax' rngSchema)+      >>>+      filterErrorMsg++{- | Validates an XML document with respect to a Relax NG schema+   This arrow is pure. It does not need IO or any configuration parameters.++   * 1.parameter  :  Relax NG schema++   - arrow-input  :  XML document++   - arrow-output :  the unchanged document or an error message+-}++validateRelax' :: XmlTree -> LA XmlTree XmlTree+validateRelax' rngSchema+    = ( ( ( constA rngSchema+            >>>+            createPatternFromXmlTree           )-          >>>-          arr2 (\ pattern xmlDoc -> childDeriv ("", []) pattern xmlDoc)-          >>>-          isA (not . nullable)-          >>>-          arr ( take 1024                      -- pattern may be recursive, so the string representation-                                               -- is truncated to 1024 chars to assure termination-                . ("when validating with Relax NG schema: " ++)-                . show-              )-          >>>-          mkError c_err+          &&&+          ( getChildren                       -- remove the root node+            >>>+            isElem                            -- and select the root element+          )         )-        `orElse`-        this+        >>>+        arr2 (\ pattern xmlDoc -> childDeriv ("", []) pattern xmlDoc)+        >>>+        isA (not . nullable)+        >>>+        arr ( take 1024                      -- pattern may be recursive, so the string representation+                                             -- is truncated to 1024 chars to assure termination+              . ("when validating with Relax NG schema: " ++)+              . show+            )+        >>>+        mkError c_err       )-      >>>-      filterErrorMsg+      `orElse`+      this  -- ------------------------------------------------------------ 

@@ -5,6 +5,7 @@ module Text.XML.HXT.RelaxNG.Validator   ( validateDocumentWithRelaxSchema   , validateDocumentWithRelax+  , validateSchemaWithRelax   , validateWithSpezification   , validateSchemaWithSpezification @@ -64,7 +65,7 @@         >>>         traceMsg 1 ( "start validating document with Relax NG schema: " ++ show relaxSchema )         >>>-        ( ( ( validate' $< validateSchema relaxSchema)    -- try to validate, only possible if schema is o.k.+        ( ( ( validate' $< validateSchemaWithRelax relaxSchema)    -- try to validate, only possible if schema is o.k.             >>>             traceMsg 1 ( "validating document with Relax NG schema done" )           )@@ -83,8 +84,8 @@           >>>           validateDocumentWithRelax schema -validateSchema                  :: String -> IOSArrow XmlTree XmlTree-validateSchema relaxSchema+validateSchemaWithRelax         :: String -> IOSArrow XmlTree XmlTree+validateSchemaWithRelax relaxSchema     = traceMsg 2 ( "read and check Relax NG schema document: " ++ show relaxSchema )       >>>       readForRelax relaxSchema@@ -153,82 +154,11 @@       )       `when` documentStatusOk                           -- only do something when document status is ok --{- |-   normalize a document for Relax NG validation,-   call the 'Text.XML.HXT.RelaxNG.Validation.validateRelax' function for doing the hard work,-   and issue errors--   * 1.parameter  : the arrow for computing the schema--   - arrow-input  : the document to be validated--   - arrow-output : nothing--}- -- ------------------------------------------------------------ -{- | Document validation--Validates a xml document with respect to a Relax NG schema.--First, the schema is validated with respect to the Relax NG Spezification. If no error is found, the xml document is validated with respect to the schema.--   * 1.parameter :  list of options; namespace progagation is always done--   - 2.parameter :  XML document--   - 3.parameter :  Relax NG schema file--available options:--    * 'a_do_not_check_restrictions' : do not check Relax NG schema restrictions (includes do-not-validate-externalRef, do-not-validate-include)--    - 'a_do_not_validate_externalRef' : do not validate a Relax NG schema referenced by a externalRef-Pattern--    - 'a_validate_externalRef' : validate a Relax NG schema referenced by a externalRef-Pattern (default)--    - 'a_do_not_validate_include' : do not validate a Relax NG schema referenced by a include-Pattern--    - 'a_validate_include' : validate a Relax NG schema referenced by a include-Pattern (default)--    - 'a_output_changes' : output Pattern transformations in case of an error--    - 'a_do_not_collect_errors' : stop Relax NG simplification after the first error has occurred--    - all 'Text.XML.HXT.Arrow.ReadDocument.readDocument' options--example:--> validate [(a_do_not_check_restrictions, "1")] "test.xml" "testSchema.rng"---} {--validate :: String -> String -> IOSArrow n XmlTree-validate xmlDocument relaxSchema-  = S.relaxSchemaArrow-    >>>-    validateWithSpezification xmlDocument relaxSchema--}--- {- | Relax NG schema validation -Validates a Relax NG schema with respect to the Relax NG Spezification.--   * 1.parameter :  Relax NG schema file---} {--validateSchema :: String -> IOSArrow n XmlTree-validateSchema relaxSchema-  = validate "" relaxSchema--}---- --------------------------------------------------------------{- | Relax NG schema validation--    see 'validateSchema' and 'validateWithSpezification'+    see 'validateSchemaWithRelax' and 'validateWithSpezification'     * 1.parameter :  Relax NG schema file @@ -253,7 +183,7 @@  validateWithSpezification :: String -> String -> IOSArrow XmlTree XmlTree validateWithSpezification xmlDocument relaxSchema-    = validDoc $< listA (validateSchema relaxSchema)+    = validDoc $< listA (validateSchemaWithRelax relaxSchema)     where     validDoc [theSchema]         | null xmlDocument