-- | -- This module exports the core functions from the basic validation und simplification libraries. -- It also exports some helper functions for easier access to the validation functionality. module Text.XML.HXT.RelaxNG.Validator ( validateDocumentWithRelaxSchema , validateDocumentWithRelax , validate , validateSchema , validateWithSpezification , validateSchemaWithSpezification , validateWithoutSpezification , module Text.XML.HXT.RelaxNG.Validation , module Text.XML.HXT.RelaxNG.Simplification ) where import Control.Arrow.ListArrows import Text.XML.HXT.DOM.Interface import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlIOStateArrow import Text.XML.HXT.RelaxNG.Validation import Text.XML.HXT.RelaxNG.Simplification import Text.XML.HXT.RelaxNG.Schema as S -- ------------------------------------------------------------ {- | validate a document with a Relax NG schema * 1.parameter : the option list for validation - 2.parameter : the URI of the Relax NG Schema - arrow-input : the document to be validated, namespaces must have been processed - arrow-output : the input document, or in case of validation errors, an empty document with status information in the root options evaluated by validateDocumentWithRelaxSchema: * 'a_check_restrictions' : check Relax NG schema restrictions when simplifying the schema (default: on) - 'a_validate_externalRef' : validate a Relax NG schema referenced by a externalRef-Pattern (default: on) - 'a_validate_include' : validate a Relax NG schema referenced by a include-Pattern (default: on) all other options are propagated to the read functions for schema input example: > validateDocumentWithRelaxSchema [(a_check_restrictions, "0")] "testSchema.rng" -} validateDocumentWithRelaxSchema :: Attributes -> String -> IOStateArrow s XmlTree XmlTree validateDocumentWithRelaxSchema userOptions relaxSchema = withOtherUserState () $ ( ( validate' $< validSchema ) -- try to validate, only possible if schema is o.k. `orElse` this ) `when` documentStatusOk -- only do something when document status is ok where validate' schema = setDocumentStatusFromSystemState "read and build Relax NG schema" >>> validateDocumentWithRelax schema validSchema = traceMsg 2 ( "read Relax NG schema document: " ++ show relaxSchema ) >>> readForRelax remainingOptions relaxSchema >>> perform ( let checkSchema = True in -- test option in al if checkSchema then validateWithRelaxAndHandleErrors S.relaxSchemaArrow else none ) >>> traceMsg 2 "create simplified schema" >>> createSimpleForm remainingOptions ( hasOption a_check_restrictions ) ( hasOption a_validate_externalRef ) ( hasOption a_validate_include ) >>> traceDoc "simplified schema" >>> perform ( getErrors >>> handleSimplificationErrors ) hasOption n = optionIsSet n options options = addEntries userOptions defaultOptions defaultOptions = [ ( a_check_restrictions, v_1 ) , ( a_validate_externalRef, v_1 ) , ( a_validate_include, v_1 ) ] remainingOptions = filter (not . flip hasEntry defaultOptions . fst) options handleSimplificationErrors :: IOSArrow XmlTree XmlTree handleSimplificationErrors = traceDoc "simplification errors" >>> getChildren >>> getAttrValue "desc" >>> arr ("Relax NG validation: " ++) >>> mkError c_err >>> filterErrorMsg {- | validate an XML document with respect to a Relax NG schema * 1.parameter : the valid and simplified schema as XML tree - arrow-input : the document to be validated - arrow-output : the validated and unchanged document or the empty document with status information set in the root node -} validateDocumentWithRelax :: XmlTree -> IOSArrow XmlTree XmlTree validateDocumentWithRelax schema = ( traceMsg 1 "validate document with Relax NG schema" >>> perform ( validateWithRelaxAndHandleErrors (constA schema) ) >>> setDocumentStatusFromSystemState "validate document with Relax NG schema" ) `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 :: Attributes -> String -> String -> IOSArrow n XmlTree validate al xmlDocument relaxSchema = S.relaxSchemaArrow >>> validateWithSpezification al xmlDocument relaxSchema {- | Relax NG schema validation Validates a Relax NG schema with respect to the Relax NG Spezification. * 1.parameter : list of available options (see also: 'validate') - 2.parameter : Relax NG schema file -} validateSchema :: Attributes -> String -> IOSArrow n XmlTree validateSchema al relaxSchema = validate al "" relaxSchema {- | Document validation Validates a xml document with respect to a Relax NG schema. Similar to 'validate', but the Relax NG Specification is not created. Can be used, to check a list of documents more efficiently. * 1.parameter : list of available options (see also: 'validate') - 2.parameter : XML document - 3.parameter : Relax NG schema file - arrow-input : Relax NG Specification in simple form example: > Text.XML.HXT.RelaxNG.Schema.relaxSchemaArrow > >>> > ( validateWithSpezification [] "foo.xml" "foo.rng" > &&& > validateWithSpezification [] "bar.xml" "bar.rng" > ) -} validateWithSpezification :: Attributes -> String -> String -> IOSArrow XmlTree XmlTree validateWithSpezification al xmlDocument relaxSchema = -- validation of the schema with respect to the specification -- returns a list of errors or none if the schema is correct ( validateRelax $< ( readForRelax al relaxSchema >>> getChildren ) ) `orElse` -- validation of the xml document with respect to the schema -- returns a list of errors or none if the xml document is correct validateWithoutSpezification al xmlDocument relaxSchema {- | Relax NG schema validation see 'validateSchema' and 'validateWithSpezification' * 1.parameter : list of available options (see also: 'validate') - 2.parameter : Relax NG schema file - arrow-input : Relax NG Specification in simple form -} validateSchemaWithSpezification :: Attributes -> String -> IOSArrow XmlTree XmlTree validateSchemaWithSpezification al relaxSchema = validateWithSpezification al "" relaxSchema {- | Document validation Validates a xml document with respect to a Relax NG schema, but the schema is @not@ validated with respect to a specification first. Should be used only for valid Relax NG schemes. * 1.parameter : list of available options (see also: 'validate') - 2.parameter : XML document - 3.parameter : Relax NG schema file -} validateWithoutSpezification :: Attributes -> String -> String -> IOSArrow n XmlTree validateWithoutSpezification al xmlDocument relaxSchema = readForRelax al relaxSchema >>> createSimpleForm al True True True >>> ( ( getErrors >>> perform handleSimplificationErrors ) -- issue errors in schema simplification `orElse` ( if null xmlDocument -- no errors: validate document then none else validateRelax $< ( readForRelax al xmlDocument >>> normalizeForRelaxValidation >>> getChildren ) ) )