    -- |
    -- 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
                                  )
          )
        )