git.iko.soy/typeable/xsd-parser
on master help sign in
Parse element refs (#10)

Element can have a ref attribute, in that case it doesn't have type or name. It's just a reference to an element defined somewhere else

commit58cfd04980fb66590334be9fe80ef4c163669f1b authorYuras <shumovichy@gmail.com> dateFri 14 Feb 2020, 11:23 (7 years ago) parentfb680f3
6 files changed+57−44
compare with master
unifiedsplit
src/Xsd.hs+1−1 src/Xsd/Parser.hs+9−3 src/Xsd/Types.hs+10−4 test/Spec.hs+4−3 xsts-test/Main.hs+1−1 xsts.md+32−32
src/Xsd.hs+1−1
@@ -113,7 +113,7 @@ xsdToSchema xsd = Schema
113113 go res [] = res
114114 go (ts, es) (c:cs) = case c of
115115 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
117117 _ -> go (ts, es) cs
118118
119119fetchXsd :: URI -> IO Xsd
src/Xsd/Parser.hs+9−3
@@ -48,7 +48,7 @@ parseChild :: Cursor -> P (Maybe Xsd.Child)
4848parseChild c = do
4949 name <- getElementName c
5050 case name of
51− "element" -> Just . Xsd.ChildElement <$> parseElement c
51+ "element" -> Just . Xsd.ChildElement <$> parseElementOrRef c
5252 "simpleType" -> Just <$> parseTopSimpleType c
5353 "complexType" -> Just <$> parseTopComplexType c
5454 "include" -> Just . Xsd.ChildInclude <$> parseInclude c
@@ -81,6 +81,12 @@ parseImport c = do
8181 , Xsd.importNamespace = namespace
8282 }
8383
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+
8490parseElement :: Cursor -> P Xsd.Element
8591parseElement c = handleNamespaces c $ do
8692 name <- theAttribute "name" c
@@ -275,10 +281,10 @@ parseAll :: Cursor -> P Xsd.ModelGroup
275281parseAll c = Xsd.All <$> parseElements c
276282
277283-- | Get all child elements
278−parseElements :: Cursor -> P [Xsd.Element]
284+parseElements :: Cursor -> P [Xsd.RefOr Xsd.Element]
279285parseElements c = do
280286 elementAxis <- makeElemAxis "element"
281− mapM parseElement (c $/ elementAxis)
287+ mapM parseElementOrRef (c $/ elementAxis)
282288
283289parseAttributes :: Cursor -> P [Xsd.Attribute]
284290parseAttributes c = do
src/Xsd/Types.hs+10−4
@@ -15,6 +15,7 @@ module Xsd.Types
1515, ComplexContent(..)
1616, ComplexExtension(..)
1717, RefOr(..)
18+, refOr
1819, Element(..)
1920, MaxOccurs(..)
2021, Attribute(..)
@@ -48,7 +49,7 @@ newtype Namespace = Namespace
4849 deriving (Show, Eq, Ord)
4950
5051data Child
51− = ChildElement Element
52+ = ChildElement (RefOr Element)
5253 | ChildType QName Type
5354 | ChildImport Import
5455 | ChildInclude Include
@@ -129,9 +130,9 @@ data SimpleContent = SimpleContent
129130 deriving (Show, Eq)
130131
131132data ModelGroup
132− = Sequence [Element]
133− | Choice [Element]
134− | All [Element]
133+ = Sequence [RefOr Element]
134+ | Choice [RefOr Element]
135+ | All [RefOr Element]
135136 deriving (Show, Eq)
136137
137138data Attribute = Attribute
@@ -160,6 +161,11 @@ data RefOr t
160161 | Inline t
161162 deriving (Show, Eq)
162163
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+
163169data Constraint
164170 = Enumeration Text
165171 deriving (Show, Eq)
test/Spec.hs+4−3
@@ -6,6 +6,7 @@ module Spec
66where
77
88import Data.Text (Text)
9+import Data.Maybe
910import Data.Either
1011import Data.Map (Map)
1112import qualified Data.Map as Map
@@ -259,8 +260,8 @@ spec = do
259260 Xsd.ContentPlain plain = Xsd.complexContent t
260261 Just (Xsd.Sequence elems) = Xsd.plainContentModel plain
261262 res `shouldSatisfy` isRight
262− map Xsd.elementName elems `shouldBe`
263− map (Xsd.QName Nothing) ["firstName", "lastName"]
263+ mapMaybe (Xsd.refOr (const Nothing) (Just . Xsd.elementName)) elems
264+ `shouldBe` map (Xsd.QName Nothing) ["firstName", "lastName"]
264265
265266 context "when it contains complexContent" $ do
266267 context "when it's an extenstion" $ do
@@ -305,7 +306,7 @@ spec = do
305306 ]
306307 ]
307308 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
309310 res `shouldSatisfy` isRight
310311 Xsd.elementName e `shouldBe`
311312 Xsd.QName Nothing "person"
xsts-test/Main.hs+1−1
@@ -54,7 +54,7 @@ dumpResults stats = IO.withFile "xsts.md" IO.WriteMode $ \h -> do
5454 ]
5555
5656expectedFailures :: Int
57−expectedFailures = 5080
57+expectedFailures = 4066
5858
5959main :: IO ()
6060main = do
xsts.md+32−32
@@ -6,10 +6,10 @@ against the schemata.
66Test set | Total tests | Passed tests
77--- | --- | ---
88yearMonthDuration | 25 | 9
9−XSImportReference | 1 | 1
9+XSImportReference | 1 | 0
1010XPathDefaultNSonKeyKeyRefUnique | 13 | 11
1111XML11Support | 11 | 11
12−wildcard | 17 | 9
12+wildcard | 17 | 15
1313VC | 6 | 5
1414unsignedIntegers | 8 | 8
1515UnitsLength | 8 | 7
@@ -17,8 +17,8 @@ union | 19 | 6
1717CTA | 6 | 4
1818TypeAlternativeTests | 23 | 9
1919time | 1 | 1
20−TargetNS | 2 | 0
21−substitutionGroup | 5 | 2
20+TargetNS | 2 | 1
21+substitutionGroup | 5 | 3
2222rf-whiteSpace | 2 | 2
2323RestrictionOfComplexTypes | 13 | 11
2424RegularExpression | 8 | 8
@@ -32,27 +32,27 @@ gMonthDay | 1 | 1
3232gYear | 1 | 1
3333gYearMonth | 1 | 1
3434float | 2 | 2
35−explicitTimezone | 18 | 6
35+explicitTimezone | 18 | 10
3636EDCWildcard | 2 | 2
3737double | 2 | 2
38−DefaultFixed | 5 | 2
38+DefaultFixed | 5 | 5
3939defaultAttributesApply | 17 | 14
4040dayTimeDuration | 24 | 8
41−dateTimeStamp | 28 | 7
41+dateTimeStamp | 28 | 9
4242date | 1 | 1
4343CyclicDependencies_Redefine_Include_Import_Override | 5 | 0
44−constraintsOnAttribute | 16 | 10
44+constraintsOnAttribute | 16 | 9
4545ConditionalInclusion | 3 | 2
4646assertion | 51 | 42
4747Assert | 35 | 25
4848anyAttribute | 9 | 7
4949allGroup | 9 | 8
5050IRI | 1 | 0
51−substitution-groups | 6 | 0
51+substitution-groups | 6 | 6
5252Zone | 9 | 5
5353Zone | 20 | 16
5454XmlVersions | 13 | 13
55−Wild | 84 | 52
55+Wild | 84 | 57
5656VC | 24 | 9
5757TargetNS | 4 | 0
5858Subsgroup | 6 | 3
@@ -60,29 +60,29 @@ Simple | 58 | 31
6060Override | 30 | 21
6161Open | 51 | 34
6262Missing | 6 | 5
63−Id | 32 | 7
64−CTA | 44 | 13
63+Id | 32 | 15
64+CTA | 44 | 15
6565Complex | 25 | 11
66−Assert | 34 | 2
67−All | 62 | 29
68−BoeingXSDTestCases | 6 | 0
69−MS-Wildcards2006-07-15 | 315 | 210
70−MS-SimpleType2006-07-15 | 333 | 146
71−MS-Schema2006-07-15 | 124 | 56
66+Assert | 34 | 12
67+All | 62 | 27
68+BoeingXSDTestCases | 6 | 6
69+MS-Wildcards2006-07-15 | 315 | 212
70+MS-SimpleType2006-07-15 | 333 | 169
71+MS-Schema2006-07-15 | 124 | 55
7272MS-Regex2006-07-15 | 2590 | 1988
73−MS-Particles2006-07-15 | 855 | 491
73+MS-Particles2006-07-15 | 855 | 511
7474MS-Notations2006-07-15 | 116 | 40
75−MS-ModelGroups2006-07-15 | 391 | 221
76−MS-IdentityConstraint2006-07-15 | 844 | 231
77−MS-Group2006-07-15 | 218 | 69
78−MS-Errata102006-07-15 | 19 | 10
79−MS-Element2006-07-15 | 355 | 150
80−MS-DataTypes2006-07-15 | 2247 | 1084
81−MS-ComplexType2006-07-15 | 550 | 270
82−MS-Attribute2006-07-15 | 279 | 137
75+MS-ModelGroups2006-07-15 | 391 | 222
76+MS-IdentityConstraint2006-07-15 | 844 | 571
77+MS-Group2006-07-15 | 218 | 122
78+MS-Errata102006-07-15 | 19 | 17
79+MS-Element2006-07-15 | 355 | 198
80+MS-DataTypes2006-07-15 | 2247 | 1482
81+MS-ComplexType2006-07-15 | 550 | 303
82+MS-Attribute2006-07-15 | 279 | 138
8383MS-AttributeGroup2006-07-15 | 114 | 64
84−MS-Annotations2006-07-15 | 80 | 50
85−MS-Additional2006-07-15 | 253 | 157
84+MS-Annotations2006-07-15 | 80 | 51
85+MS-Additional2006-07-15 | 253 | 165
8686Wildcard | 26 | 22
8787Schema | 6 | 6
8888SType | 138 | 123
@@ -90,11 +90,11 @@ Notation | 13 | 8
9090MGroupDef | 19 | 8
9191MGroup | 40 | 24
9292IdConstrDefs | 27 | 19
93−ElemDecl | 227 | 133
93+ElemDecl | 227 | 155
9494CType | 31 | 15
9595AttrUse | 4 | 1
96−AttrDecl | 83 | 73
96+AttrDecl | 83 | 78
9797AGroupDef | 13 | 6
98−suntest | 52 | 19
98+suntest | 52 | 22
9999NIST2004-01-14 | 3953 | 3873
100100introspection | 1 | 0