concrete-relaxng-parser 0.1 → 0.1.1
raw patch · 4 files changed
+36/−22 lines, 4 filesdep ~cmdargs
Dependency ranges changed: cmdargs
Files
- ParseShortXML.hs +15/−6
- Text/XML/HXT/RelaxNG/Parser.hs +13/−7
- concrete-relaxng-parser.cabal +7/−8
- xhtml-concrete.rng +1/−1
ParseShortXML.hs view
@@ -53,11 +53,11 @@ runX (pipeline (passthrough arg) (raw arg) pattern (input arg)) return () -recoveryLimit = 20+recoveryLimit = (20, []) pipeline :: Bool -> Bool -> Validator.Pattern -> String -> IOSArrow XmlTree XmlTree pipeline passthrough rawOutput pattern input =- readDocument [withValidate no] input+ readDocument [withValidate no, withInputEncoding utf8] input >>> changeChildren (\l-> if null l then [XN.mkText ""] else l) >>>@@ -72,9 +72,7 @@ >>> (if rawOutput then this - else processTopDown (none `when` (isElem >>> hasNamespaceUri terminalNamespace) - >>> - changeElemName stripOmissiblePrefix)+ else stripSyntax ) >>> fromLA (cleanupNamespaces collectPrefixUriPairs)@@ -83,10 +81,21 @@ >>> writeDocument [withIndent no, withOutputEncoding utf8] "" +stripSyntax :: IOSArrow XmlTree XmlTree+stripSyntax = processTopDown ((getChildren >>> stripSyntax) `when` (isElem >>> hasNamespaceUri syntacticNamespace) + >>>+ none `when` (isElem >>> hasNamespaceUri terminalNamespace) + >>>+ changeElemName stripOmissiblePrefix)+ loadPattern :: String -> IO Validator.Pattern loadPattern schema = fmap head $ runX (- Validator.readForRelax schema + readDocument [withInputEncoding utf8] schema+ >>>+ canonicalizeAllNodes+ >>>+ propagateAndValidateNamespaces >>> createSimpleForm True False True >>>
Text/XML/HXT/RelaxNG/Parser.hs view
@@ -59,7 +59,7 @@ data ResultDelta = StartTag XNode | Add XmlTree | EndTag | Penalty | Inferred ResultDelta deriving (Eq, Show) -type RecoveryLimits = Int+type RecoveryLimits = (Int, [QName]) pretty :: String -> Int -> RecoveryLimits -> Pattern -> String pretty _ _ _ Empty = "empty"@@ -86,22 +86,26 @@ pretty _ _ rl p = show p noRecovery :: RecoveryLimits-noRecovery = 0+noRecovery = (0, []) omissibleNamespacePrefix :: String omissibleNamespacePrefix = "omissible+" terminalNamespace :: String-terminalNamespace ="http://en.wikipedia.org/wiki/Terminal_and_nonterminal_symbols#Terminal_symbols"+terminalNamespace ="http://en.wikipedia.org/wiki/Terminal_symbol" +syntacticNamespace :: String+syntacticNamespace ="http://en.wikipedia.org/wiki/Nonterminal_symbol"+ noContext :: Context noContext = ("", []) recoveryAllowed :: QName -> RecoveryLimits -> Maybe RecoveryLimits-recoveryAllowed _ 0 = Nothing-recoveryAllowed qn rl | omissibleNamespacePrefix `isPrefixOf` namespaceUri qn = Just (pred rl)- | terminalNamespace == namespaceUri qn = Just (pred rl)- | otherwise = Nothing+recoveryAllowed _ (0, _) = Nothing+recoveryAllowed qn (rl, stk) | elem qn stk = Nothing+ | omissibleNamespacePrefix `isPrefixOf` namespaceUri qn = Just (pred rl, qn:stk)+ | namespaceUri qn `elem` [terminalNamespace, syntacticNamespace] = Just (pred rl, stk)+ | otherwise = Nothing startSet :: RecoveryLimits -> Pattern -> Set String startSet rl (Group p1 p2) = (if nullable rl p1 then startSet rl p2 else empty) `union` startSet rl p1@@ -202,6 +206,8 @@ r -> Just (minimumBy (comparing (semanticLength 0)) r) semanticLength :: Int -> [ResultDelta] -> Int+semanticLength s (StartTag node : tail) | XN.getNamespaceUri node == Just syntacticNamespace = + semanticLength s tail - 1 semanticLength s (StartTag node : tail) | XN.getNamespaceUri node == Just terminalNamespace = semanticLength s (dropContent 0 tail) where dropContent 0 (EndTag : rest) = rest
concrete-relaxng-parser.cabal view
@@ -1,5 +1,5 @@ Name: concrete-relaxng-parser-Version: 0.1+Version: 0.1.1 Cabal-Version: >= 1.10 Build-Type: Simple Synopsis: A parser driven by a standard RELAX NG schema with concrete syntax extensions.@@ -11,12 +11,12 @@ error or XML conforming to the schema. . If the input XML already conforms to the target schema, the parser acts as an ordinary RELAX NG validator. If not, it- attempts to insert the missing element tags and to parse the text nodes within the input XML into XML elements. The- target schema can be enriched by concrete syntax extensions, syntactically compatible with standard RELAX NG, to drive- the parsing process.+ attempts to insert the missing element tags and to parse the input text nodes into XML elements. The target schema can+ be enriched by concrete syntax extensions, syntactically compatible with standard RELAX NG, to drive the parsing+ process. .- The included sample RELAX NG schema @xhtml-concrete.rng@ is an extension of the regular must be used together with- James Clark's modularized RELAX NG schema for XHTML, which can be downloaded from+ The included sample RELAX NG schema @xhtml-concrete.rng@ is an extension of, and must be used together with, James+ Clark's modularized RELAX NG schema for XHTML, which can be downloaded from <http://www.thaiopensource.com/relaxng/xhtml/>. Here is an example session: . > $ cat <<END >test.xhtml.short<?xml version="1.0" encoding="UTF-8"?>@@ -60,6 +60,5 @@ Main-is: ParseShortXML.hs Other-Modules: Text.XML.HXT.RelaxNG.Parser Build-Depends: base < 5, containers >= 0.4 && < 0.6, hxt >= 9.2 && < 10, hxt-relaxng == 9.1.*,- hxt-charproperties == 9.*, hxt-tagsoup == 9.1.*, hxt-curl == 9.1.*, cmdargs == 0.9.*- GHC-options: -threaded+ hxt-charproperties == 9.*, hxt-tagsoup == 9.1.*, hxt-curl == 9.1.*, cmdargs >= 0.9 && < 0.11 default-language: Haskell2010
xhtml-concrete.rng view
@@ -1,6 +1,6 @@ <grammar ns="omissible+http://www.w3.org/1999/xhtml" xmlns:explicit="http://www.w3.org/1999/xhtml"- xmlns:terminal="http://en.wikipedia.org/wiki/Terminal_and_nonterminal_symbols#Terminal_symbols"+ xmlns:terminal="http://en.wikipedia.org/wiki/Terminal_symbol" xmlns="http://relaxng.org/ns/structure/1.0"> <include href="xhtml/xhtml-strict.rng"/>