git.iko.soy/typeable/xsd-parser
on master help sign in
Parse element refs (#10)
58cfd04Yuras
src/Xsd.hs+1−1
compare with master
unifiedsplit
@@ -113,7 +113,7 @@ xsdToSchema xsd = Schema
113 go res [] = res
113 go res [] = res
114 go (ts, es) (c:cs) = case c of
114 go (ts, es) (c:cs) = case c of
115 ChildType n t -> go ((n, t):ts, es) cs
115 ChildType n t -> go ((n, t):ts, es) cs
116− ChildElement e -> go (ts, (elementName e, e):es) cs
116+ ChildElement (Inline e) -> go (ts, (elementName e, e):es) cs
117 _ -> go (ts, es) cs
117 _ -> go (ts, es) cs
118
118
119fetchXsd :: URI -> IO Xsd
119fetchXsd :: URI -> IO Xsd
src/Xsd/Parser.hs+9−3
@@ -48,7 +48,7 @@ parseChild :: Cursor -> P (Maybe Xsd.Child)
48parseChild c = do
48parseChild c = do
49 name <- getElementName c
49 name <- getElementName c
50 case name of
50 case name of
51− "element" -> Just . Xsd.ChildElement <$> parseElement c
51+ "element" -> Just . Xsd.ChildElement <$> parseElementOrRef c
52 "simpleType" -> Just <$> parseTopSimpleType c
52 "simpleType" -> Just <$> parseTopSimpleType c
53 "complexType" -> Just <$> parseTopComplexType c
53 "complexType" -> Just <$> parseTopComplexType c
54 "include" -> Just . Xsd.ChildInclude <$> parseInclude c
54 "include" -> Just . Xsd.ChildInclude <$> parseInclude c
@@ -81,6 +81,12 @@ parseImport c = do
81 , Xsd.importNamespace = namespace
81 , Xsd.importNamespace = namespace
82 }
82 }
83
83
84+parseElementOrRef :: Cursor -> P (Xsd.RefOr Xsd.Element)
85+parseElementOrRef c = do
86+ case anAttribute "ref" c of
87+ Nothing -> Xsd.Inline <$> parseElement c
88+ Just ref -> Xsd.Ref <$> makeQName c ref
89+
84parseElement :: Cursor -> P Xsd.Element
90parseElement :: Cursor -> P Xsd.Element
85parseElement c = handleNamespaces c $ do
91parseElement c = handleNamespaces c $ do
86 name <- theAttribute "name" c
92 name <- theAttribute "name" c
@@ -275,10 +281,10 @@ parseAll :: Cursor -> P Xsd.ModelGroup
275parseAll c = Xsd.All <$> parseElements c
281parseAll c = Xsd.All <$> parseElements c
276
282
277-- | Get all child elements
283-- | Get all child elements
278−parseElements :: Cursor -> P [Xsd.Element]
284+parseElements :: Cursor -> P [Xsd.RefOr Xsd.Element]
279parseElements c = do
285parseElements c = do
280 elementAxis <- makeElemAxis "element"
286 elementAxis <- makeElemAxis "element"
281− mapM parseElement (c $/ elementAxis)
287+ mapM parseElementOrRef (c $/ elementAxis)
282
288
283parseAttributes :: Cursor -> P [Xsd.Attribute]
289parseAttributes :: Cursor -> P [Xsd.Attribute]
284parseAttributes c = do
290parseAttributes c = do
src/Xsd/Types.hs+10−4
@@ -15,6 +15,7 @@ module Xsd.Types
15, ComplexContent(..)
15, ComplexContent(..)
16, ComplexExtension(..)
16, ComplexExtension(..)
17, RefOr(..)
17, RefOr(..)
18+, refOr
18, Element(..)
19, Element(..)
19, MaxOccurs(..)
20, MaxOccurs(..)
20, Attribute(..)
21, Attribute(..)
@@ -48,7 +49,7 @@ newtype Namespace = Namespace
48 deriving (Show, Eq, Ord)
49 deriving (Show, Eq, Ord)
49
50
50data Child
51data Child
51− = ChildElement Element
52+ = ChildElement (RefOr Element)
52 | ChildType QName Type
53 | ChildType QName Type
53 | ChildImport Import
54 | ChildImport Import
54 | ChildInclude Include
55 | ChildInclude Include
@@ -129,9 +130,9 @@ data SimpleContent = SimpleContent
129 deriving (Show, Eq)
130 deriving (Show, Eq)
130
131
131data ModelGroup
132data ModelGroup
132− = Sequence [Element]
133+ = Sequence [RefOr Element]
133− | Choice [Element]
134+ | Choice [RefOr Element]
134− | All [Element]
135+ | All [RefOr Element]
135 deriving (Show, Eq)
136 deriving (Show, Eq)
136
137
137data Attribute = Attribute
138data Attribute = Attribute
@@ -160,6 +161,11 @@ data RefOr t
160 | Inline t
161 | Inline t
161 deriving (Show, Eq)
162 deriving (Show, Eq)
162
163
164+refOr :: (QName -> a) -> (t -> a) -> RefOr t -> a
165+refOr f g ref = case ref of
166+ Ref name -> f name
167+ Inline t -> g t
168+
163data Constraint
169data Constraint
164 = Enumeration Text
170 = Enumeration Text
165 deriving (Show, Eq)
171 deriving (Show, Eq)
test/Spec.hs+4−3
@@ -6,6 +6,7 @@ module Spec
6where
6where
7
7
8import Data.Text (Text)
8import Data.Text (Text)
9+import Data.Maybe
9import Data.Either
10import Data.Either
10import Data.Map (Map)
11import Data.Map (Map)
11import qualified Data.Map as Map
12import qualified Data.Map as Map
@@ -259,8 +260,8 @@ spec = do
259 Xsd.ContentPlain plain = Xsd.complexContent t
260 Xsd.ContentPlain plain = Xsd.complexContent t
260 Just (Xsd.Sequence elems) = Xsd.plainContentModel plain
261 Just (Xsd.Sequence elems) = Xsd.plainContentModel plain
261 res `shouldSatisfy` isRight
262 res `shouldSatisfy` isRight
262− map Xsd.elementName elems `shouldBe`
263+ mapMaybe (Xsd.refOr (const Nothing) (Just . Xsd.elementName)) elems
263− map (Xsd.QName Nothing) ["firstName", "lastName"]
264+ `shouldBe` map (Xsd.QName Nothing) ["firstName", "lastName"]
264
265
265 context "when it contains complexContent" $ do
266 context "when it contains complexContent" $ do
266 context "when it's an extenstion" $ do
267 context "when it's an extenstion" $ do
@@ -305,7 +306,7 @@ spec = do
305 ]
306 ]
306 ]
307 ]
307 res = Xsd.parse Xsd.defaultConfig doc
308 res = Xsd.parse Xsd.defaultConfig doc
308− Right [Xsd.ChildElement e] = fmap Xsd.children res
309+ Right [Xsd.ChildElement (Xsd.Inline e)] = fmap Xsd.children res
309 res `shouldSatisfy` isRight
310 res `shouldSatisfy` isRight
310 Xsd.elementName e `shouldBe`
311 Xsd.elementName e `shouldBe`
311 Xsd.QName Nothing "person"
312 Xsd.QName Nothing "person"
xsts-test/Main.hs+1−1
@@ -54,7 +54,7 @@ dumpResults stats = IO.withFile "xsts.md" IO.WriteMode $ \h -> do
54 ]
54 ]
55
55
56expectedFailures :: Int
56expectedFailures :: Int
57−expectedFailures = 5080
57+expectedFailures = 4066
58
58
59main :: IO ()
59main :: IO ()
60main = do
60main = do
xsts.md+32−32
@@ -6,10 +6,10 @@ against the schemata.
6Test set | Total tests | Passed tests
6Test set | Total tests | Passed tests
7--- | --- | ---
7--- | --- | ---
8yearMonthDuration | 25 | 9
8yearMonthDuration | 25 | 9
9−XSImportReference | 1 | 1
9+XSImportReference | 1 | 0
10XPathDefaultNSonKeyKeyRefUnique | 13 | 11
10XPathDefaultNSonKeyKeyRefUnique | 13 | 11
11XML11Support | 11 | 11
11XML11Support | 11 | 11
12−wildcard | 17 | 9
12+wildcard | 17 | 15
13VC | 6 | 5
13VC | 6 | 5
14unsignedIntegers | 8 | 8
14unsignedIntegers | 8 | 8
15UnitsLength | 8 | 7
15UnitsLength | 8 | 7
@@ -17,8 +17,8 @@ union | 19 | 6
17CTA | 6 | 4
17CTA | 6 | 4
18TypeAlternativeTests | 23 | 9
18TypeAlternativeTests | 23 | 9
19time | 1 | 1
19time | 1 | 1
20−TargetNS | 2 | 0
20+TargetNS | 2 | 1
21−substitutionGroup | 5 | 2
21+substitutionGroup | 5 | 3
22rf-whiteSpace | 2 | 2
22rf-whiteSpace | 2 | 2
23RestrictionOfComplexTypes | 13 | 11
23RestrictionOfComplexTypes | 13 | 11
24RegularExpression | 8 | 8
24RegularExpression | 8 | 8
@@ -32,27 +32,27 @@ gMonthDay | 1 | 1
32gYear | 1 | 1
32gYear | 1 | 1
33gYearMonth | 1 | 1
33gYearMonth | 1 | 1
34float | 2 | 2
34float | 2 | 2
35−explicitTimezone | 18 | 6
35+explicitTimezone | 18 | 10
36EDCWildcard | 2 | 2
36EDCWildcard | 2 | 2
37double | 2 | 2
37double | 2 | 2
38−DefaultFixed | 5 | 2
38+DefaultFixed | 5 | 5
39defaultAttributesApply | 17 | 14
39defaultAttributesApply | 17 | 14
40dayTimeDuration | 24 | 8
40dayTimeDuration | 24 | 8
41−dateTimeStamp | 28 | 7
41+dateTimeStamp | 28 | 9
42date | 1 | 1
42date | 1 | 1
43CyclicDependencies_Redefine_Include_Import_Override | 5 | 0
43CyclicDependencies_Redefine_Include_Import_Override | 5 | 0
44−constraintsOnAttribute | 16 | 10
44+constraintsOnAttribute | 16 | 9
45ConditionalInclusion | 3 | 2
45ConditionalInclusion | 3 | 2
46assertion | 51 | 42
46assertion | 51 | 42
47Assert | 35 | 25
47Assert | 35 | 25
48anyAttribute | 9 | 7
48anyAttribute | 9 | 7
49allGroup | 9 | 8
49allGroup | 9 | 8
50IRI | 1 | 0
50IRI | 1 | 0
51−substitution-groups | 6 | 0
51+substitution-groups | 6 | 6
52Zone | 9 | 5
52Zone | 9 | 5
53Zone | 20 | 16
53Zone | 20 | 16
54XmlVersions | 13 | 13
54XmlVersions | 13 | 13
55−Wild | 84 | 52
55+Wild | 84 | 57
56VC | 24 | 9
56VC | 24 | 9
57TargetNS | 4 | 0
57TargetNS | 4 | 0
58Subsgroup | 6 | 3
58Subsgroup | 6 | 3
@@ -60,29 +60,29 @@ Simple | 58 | 31
60Override | 30 | 21
60Override | 30 | 21
61Open | 51 | 34
61Open | 51 | 34
62Missing | 6 | 5
62Missing | 6 | 5
63−Id | 32 | 7
63+Id | 32 | 15
64−CTA | 44 | 13
64+CTA | 44 | 15
65Complex | 25 | 11
65Complex | 25 | 11
66−Assert | 34 | 2
66+Assert | 34 | 12
67−All | 62 | 29
67+All | 62 | 27
68−BoeingXSDTestCases | 6 | 0
68+BoeingXSDTestCases | 6 | 6
69−MS-Wildcards2006-07-15 | 315 | 210
69+MS-Wildcards2006-07-15 | 315 | 212
70−MS-SimpleType2006-07-15 | 333 | 146
70+MS-SimpleType2006-07-15 | 333 | 169
71−MS-Schema2006-07-15 | 124 | 56
71+MS-Schema2006-07-15 | 124 | 55
72MS-Regex2006-07-15 | 2590 | 1988
72MS-Regex2006-07-15 | 2590 | 1988
73−MS-Particles2006-07-15 | 855 | 491
73+MS-Particles2006-07-15 | 855 | 511
74MS-Notations2006-07-15 | 116 | 40
74MS-Notations2006-07-15 | 116 | 40
75−MS-ModelGroups2006-07-15 | 391 | 221
75+MS-ModelGroups2006-07-15 | 391 | 222
76−MS-IdentityConstraint2006-07-15 | 844 | 231
76+MS-IdentityConstraint2006-07-15 | 844 | 571
77−MS-Group2006-07-15 | 218 | 69
77+MS-Group2006-07-15 | 218 | 122
78−MS-Errata102006-07-15 | 19 | 10
78+MS-Errata102006-07-15 | 19 | 17
79−MS-Element2006-07-15 | 355 | 150
79+MS-Element2006-07-15 | 355 | 198
80−MS-DataTypes2006-07-15 | 2247 | 1084
80+MS-DataTypes2006-07-15 | 2247 | 1482
81−MS-ComplexType2006-07-15 | 550 | 270
81+MS-ComplexType2006-07-15 | 550 | 303
82−MS-Attribute2006-07-15 | 279 | 137
82+MS-Attribute2006-07-15 | 279 | 138
83MS-AttributeGroup2006-07-15 | 114 | 64
83MS-AttributeGroup2006-07-15 | 114 | 64
84−MS-Annotations2006-07-15 | 80 | 50
84+MS-Annotations2006-07-15 | 80 | 51
85−MS-Additional2006-07-15 | 253 | 157
85+MS-Additional2006-07-15 | 253 | 165
86Wildcard | 26 | 22
86Wildcard | 26 | 22
87Schema | 6 | 6
87Schema | 6 | 6
88SType | 138 | 123
88SType | 138 | 123
@@ -90,11 +90,11 @@ Notation | 13 | 8
90MGroupDef | 19 | 8
90MGroupDef | 19 | 8
91MGroup | 40 | 24
91MGroup | 40 | 24
92IdConstrDefs | 27 | 19
92IdConstrDefs | 27 | 19
93−ElemDecl | 227 | 133
93+ElemDecl | 227 | 155
94CType | 31 | 15
94CType | 31 | 15
95AttrUse | 4 | 1
95AttrUse | 4 | 1
96−AttrDecl | 83 | 73
96+AttrDecl | 83 | 78
97AGroupDef | 13 | 6
97AGroupDef | 13 | 6
98−suntest | 52 | 19
98+suntest | 52 | 22
99NIST2004-01-14 | 3953 | 3873
99NIST2004-01-14 | 3953 | 3873
100introspection | 1 | 0
100introspection | 1 | 0