hxt-relaxng 9.1.0 → 9.1.1
raw patch · 7 files changed
+139/−48 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- examples/hrelaxng/Makefile +11/−1
- examples/hrelaxng/simple-qualified.rng +32/−0
- examples/hrelaxng/simple-unqualified.rng +32/−0
- examples/hrelaxng/simple.xml +6/−0
- hxt-relaxng.cabal +6/−3
- src/Text/XML/HXT/RelaxNG/CreatePattern.hs +36/−34
- src/Text/XML/HXT/RelaxNG/Simplification.hs +16/−10
examples/hrelaxng/Makefile view
@@ -65,7 +65,17 @@ $(prog) ./valid1.xml ./invalid3.rng || true @echo -EX = $(wildcard *valid*.xml *valid*.rng)+example6 :+ @echo "===> Validate a valid xml file with a valid Relax NG schema with name prefixes" ; echo ; sleep 1+ $(prog) ./simple.xml ./simple-qualified.rng+ @echo++example6a :+ @echo "===> Validate a valid xml file with a valid Relax NG schema without name prefixes" ; echo ; sleep 1+ $(prog) ./simple.xml ./simple-unqualified.rng+ @echo++EX = $(wildcard *valid*.xml *valid*.rng simple*.xml simple*.rng) dist : [ -d $(DIST_DIR) ] || mkdir -p $(DIST_DIR)
+ examples/hrelaxng/simple-qualified.rng view
@@ -0,0 +1,32 @@+<?xml version="1.0" encoding="UTF-8"?>+<rng:grammar+ xmlns:rng="http://relaxng.org/ns/structure/1.0"+ datatypeLibrary="http://www.w3.org/2001/XMLSchema-datatypes">+ <rng:start>+ <rng:ref name="simple.object"/>+ </rng:start>+ <rng:define name="simple.object">+ <rng:element name="object">+ <rng:interleave>+ <rng:ref name="simple.colour"/>+ <rng:ref name="simple.name"/>+ <rng:ref name="simple.material"/>+ </rng:interleave>+ </rng:element>+ </rng:define>+ <rng:define name="simple.colour">+ <rng:element name="colour">+ <rng:data type="token"/>+ </rng:element>+ </rng:define>+ <rng:define name="simple.name">+ <rng:element name="name">+ <rng:data type="token"/>+ </rng:element>+ </rng:define>+ <rng:define name="simple.material">+ <rng:element name="material">+ <rng:data type="token"/>+ </rng:element>+ </rng:define>+</rng:grammar>
+ examples/hrelaxng/simple-unqualified.rng view
@@ -0,0 +1,32 @@+<?xml version="1.0" encoding="UTF-8"?>+<grammar+ xmlns="http://relaxng.org/ns/structure/1.0"+ datatypeLibrary="http://www.w3.org/2001/XMLSchema-datatypes">+ <start>+ <ref name="simple.object"/>+ </start>+ <define name="simple.object">+ <element name="object">+ <interleave>+ <ref name="simple.colour"/>+ <ref name="simple.name"/>+ <ref name="simple.material"/>+ </interleave>+ </element>+ </define>+ <define name="simple.colour">+ <element name="colour">+ <data type="token"/>+ </element>+ </define>+ <define name="simple.name">+ <element name="name">+ <data type="token"/>+ </element>+ </define>+ <define name="simple.material">+ <element name="material">+ <data type="token"/>+ </element>+ </define>+</grammar>
+ examples/hrelaxng/simple.xml view
@@ -0,0 +1,6 @@+<?xml version="1.0" encoding="utf-8"?>+<object>+ <colour>red</colour>+ <name>die</name>+ <material>plastic</material>+</object>
hxt-relaxng.cabal view
@@ -1,16 +1,16 @@ -- arch-tag: Haskell XML Toolbox main description file Name: hxt-relaxng-Version: 9.1.0+Version: 9.1.1 Synopsis: The HXT RelaxNG validator Description: The HXT RelaxNG validator-License: OtherLicense+License: MIT License-file: LICENSE Author: Uwe Schmidt, Martin Schmidt, Torben Kuseler Maintainer: Uwe Schmidt <uwe@fh-wedel.de> Stability: Stable Category: XML Homepage: http://www.fh-wedel.de/~si/HXmlToolbox/index.html-Copyright: Copyright (c) 2005-2010 Uwe Schmidt+Copyright: Copyright (c) 2005-2011 Uwe Schmidt Build-type: Simple Cabal-version: >=1.6 @@ -33,6 +33,9 @@ examples/hrelaxng/valid1.xml examples/hrelaxng/valid2.rng examples/hrelaxng/valid2.xml+ examples/hrelaxng/simple.xml+ examples/hrelaxng/simple-qualified.rng+ examples/hrelaxng/simple-unqualified.rng library exposed-modules:
src/Text/XML/HXT/RelaxNG/CreatePattern.hs view
@@ -28,7 +28,9 @@ import Data.List ( isPrefixOf )-+{-+import qualified Debug.Trace as T+-} -- ------------------------------------------------------------ -- | Creates the 'Pattern' datastructure from a simplified Relax NG schema.@@ -49,25 +51,24 @@ createPatternFromXml :: Env -> LA XmlTree Pattern createPatternFromXml env- = choiceA [- isRoot :-> processRoot env,- isRngEmpty :-> constA Empty,- isRngNotAllowed :-> mkNotAllowed,- isRngText :-> constA Text,- isRngChoice :-> mkRelaxChoice env,- isRngInterleave :-> mkRelaxInterleave env,- isRngGroup :-> mkRelaxGroup env,- isRngOneOrMore :-> mkRelaxOneOrMore env,- isRngList :-> mkRelaxList env,- isRngData :-> mkRelaxData env,- isRngValue :-> mkRelaxValue,- isRngAttribute :-> mkRelaxAttribute env,- isRngElement :-> mkRelaxElement env,- isRngRef :-> mkRelaxRef env,- this :-> mkRelaxError ""+ = choiceA+ [ isRoot :-> processRoot env+ , isRngEmpty :-> constA Empty+ , isRngNotAllowed :-> mkNotAllowed+ , isRngText :-> constA Text+ , isRngChoice :-> mkRelaxChoice env+ , isRngInterleave :-> mkRelaxInterleave env+ , isRngGroup :-> mkRelaxGroup env+ , isRngOneOrMore :-> mkRelaxOneOrMore env+ , isRngList :-> mkRelaxList env+ , isRngData :-> mkRelaxData env+ , isRngValue :-> mkRelaxValue+ , isRngAttribute :-> mkRelaxAttribute env+ , isRngElement :-> mkRelaxElement env+ , isRngRef :-> mkRelaxRef env+ , this :-> mkRelaxError "internal HXT RelaxNG error" ] - processRoot :: Env -> LA XmlTree Pattern processRoot env = getChildren@@ -75,7 +76,7 @@ choiceA [ isRngRelaxError :-> (mkRelaxError $< getRngAttrDescr), isRngGrammar :-> (processGrammar env),- this :-> (mkRelaxError "no grammar-pattern in schema")+ this :-> (mkRelaxError "no grammar-pattern in schema") ] @@ -83,11 +84,11 @@ processGrammar env = getChildren >>>- choiceA [- isRngDefine :-> none,- isRngRelaxError :-> (mkRelaxError $< getAttrValue "desc"),- isRngStart :-> (getChildren >>> createPatternFromXml env),- this :-> (mkRelaxError "no start-pattern in schema")+ choiceA+ [ isRngDefine :-> none+ , isRngRelaxError :-> (mkRelaxError $< getAttrValue "desc")+ , isRngStart :-> (getChildren >>> createPatternFromXml env)+ , this :-> (mkRelaxError "no start-pattern in schema") ] @@ -119,25 +120,26 @@ -- | Creates an error message. mkRelaxError :: String -> LA XmlTree Pattern mkRelaxError errStr- = choiceA [- isRngRelaxError :-> (getRngAttrDescr >>> arr notAllowed),- isElem :-> ( getName+ = choiceA+ [ isRngRelaxError :-> (getRngAttrDescr >>> arr notAllowed)+ , isElem :-> ( getName >>> arr (\n -> notAllowed $ "Pattern " ++ n ++- " is not allowed in Relax NG schema"+ " is not allowed in Relax NG schema" +++ " (" ++ errStr ++ ")" )- ),- isAttr :-> ( getName+ )+ , isAttr :-> ( getName >>> arr (\n -> notAllowed $ "Attribute " ++ n ++ " is not allowed in Relax NG schema" )- ),- isError :-> (getErrorMsg >>> arr notAllowed),- this :-> (arr (\e -> notAllowed $ if errStr /= ""+ )+ , isError :-> ( getErrorMsg >>> arr notAllowed )++ , this :-> arr ( \e -> notAllowed $ if errStr /= "" then errStr else "Can't create pattern from " ++ show e)- ) ]
src/Text/XML/HXT/RelaxNG/Simplification.hs view
@@ -744,7 +744,7 @@ >>> ( -- A choice, group or interleave element is transformed so -- that it has exactly two child elements.- ((wrapPattern2Two $< getName) >>> simplificationStep4)+ ((wrapPattern2Two $< getQName) >>> simplificationStep4) `when` ( isChoiceGroupInterleave >>>@@ -1152,26 +1152,29 @@ createPatternElems :: String -> String -> IOSArrow XmlTree XmlTree createPatternElems pattern name- = ( ( (listA (getElems pattern name >>> getRngAttrCombine))+ = ( ( listA (getElems pattern name >>> getRngAttrCombine) >>> checkPatternCombine pattern name ) -- After determining this unique value, the combine attributes are removed. &&&- (listA (getElems pattern name >>> removeAttr "combine")))- >>> -- ((errorCode::Int,errorMessage::String), result::XmlTrees)+ listA (getElems pattern name >>> removeAttr "combine"))+ >>> -- ((errorCode::Int, errorMessage::String), result::XmlTrees) choiceA- [ isA (\ ((code,_) , _) -> code == 0)+ [ isA (\ ((code, _) , _) -> code == 0) :-> (mkRelaxError "" $< arr (snd . fst))- , isA (\ ((code,str) , _) -> code == 1 && str == "")++ , isA (\ ((code, str) , _) -> code == 1 && str == "") :-> arrL snd- , isA (\ ((code,str) , _) -> code == 1 && str /= "")++ , isA (\ ((code, str) , _) -> code == 1 && str /= "") :-> ( createPatternElem pattern name $<< ( arr (snd . fst) &&& (arr snd) ) )+ , this :-> ( mkRelaxError ""@@ -1188,7 +1191,7 @@ (arrL (const trees) >>> getChildren) ) >>>- wrapPattern2Two combine+ (wrapPattern2Two $< getQName) ) checkPatternCombine :: (ArrowXml a) => String -> String -> a [String] (Int, String)@@ -1198,12 +1201,14 @@ (isA (\ cl -> length cl == 1)) :-> constA (1, "")+ , (isA (\ cl -> (length $ elemIndices "" cl) > 1)) :-> constA ( 0 , "More than one " ++ pattern ++ "-Pattern: " ++ show name ++ " without an combine-attribute in the same grammar" )+ , (isA (\ cl -> (length $ nub $ deleteBy (==) "" cl) > 1)) :-> arr (\ cl -> ( 0@@ -1213,6 +1218,7 @@ show name ++ " in the same grammar" ) )+ , -- ok -> combine value is returned this :->@@ -2180,11 +2186,11 @@ `guards` this -wrapPattern2Two :: (ArrowXml a) => String -> a XmlTree XmlTree+wrapPattern2Two :: (ArrowXml a) => QName -> a XmlTree XmlTree wrapPattern2Two name = choiceA [ noOfChildren (> 2)- :-> ( replaceChildren ( (mkRngElement name none+ :-> ( replaceChildren ( (mkElement name none (getChildren >>. take 2) ) <+>