@@ -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
@@ -154,18 +160,19 @@ parseSimpleType c = do
154160 unionAxis <- makeElemAxis "union"
155161 case (c $/ restrictionAxis, c $/ listAxis, c $/ unionAxis) of
156162 ([e], [], []) -> Xsd.AtomicType
157− <$> parseRestriction e
163+ <$> parseSimpleRestriction e
158164 <*> parseAnnotations c
159165 ([], [l], []) -> Xsd.ListType
160166 <$> parseList l
161167 <*> parseAnnotations c
162− -- TODO implement me
163− ([], [], [_]) -> parseError c "Not implemented: union"
168+ ([], [], [u]) -> Xsd.UnionType
169+ <$> parseUnion u
170+ <*> parseAnnotations c
164171 _ -> parseError c "Expected exactly of of restriction, list or union"
165172
166173-- | Restriction for simple type
167−parseRestriction :: Cursor -> P Xsd.Restriction
168−parseRestriction c = do
174+parseSimpleRestriction :: Cursor -> P Xsd.SimpleRestriction
175+parseSimpleRestriction c = do
169176 -- XXX: generalaze RefOr parsing
170177 tp <- case anAttribute "base" c of
171178 Nothing -> do
@@ -178,9 +185,9 @@ parseRestriction c = do
178185
179186 constraints <- parseConstrains c
180187
181− return Xsd.Restriction
182− { Xsd.restrictionBase = tp
183− , Xsd.restrictionConstraints = constraints
188+ return Xsd.SimpleRestriction
189+ { Xsd.simpleRestrictionBase = tp
190+ , Xsd.simpleRestrictionConstraints = constraints
184191 }
185192
186193parseConstrains :: Cursor -> P [Xsd.Constraint]
@@ -201,6 +208,15 @@ parseList c =
201208 _ -> parseError c "Multiple types"
202209 Just t -> Xsd.Ref <$> makeQName c t
203210
211+parseUnion :: Cursor -> P [Xsd.RefOr Xsd.SimpleType]
212+parseUnion c =
213+ case anAttribute "memberTypes" c of
214+ Just list ->
215+ mapM (fmap Xsd.Ref . makeQName c) (Text.splitOn " " list)
216+ Nothing -> do
217+ simpleTypeAxis <- makeElemAxis "simpleType"
218+ mapM (fmap Xsd.Inline . parseSimpleType) (c $/ simpleTypeAxis)
219+
204220parseComplexType :: Cursor -> P Xsd.ComplexType
205221parseComplexType c = do
206222 annotations <- parseAnnotations c
@@ -231,14 +247,29 @@ parsePlainContent c = do
231247 }
232248
233249parseSimpleContent :: Cursor -> P Xsd.SimpleContent
234−parseSimpleContent c = parseError c "not implemented"
250+parseSimpleContent c = do
251+ restrictionAxis <- makeElemAxis "restriction"
252+ extenstionAxis <- makeElemAxis "extension"
253+ case (c $/ restrictionAxis, c $/ extenstionAxis) of
254+ ([r], []) -> Xsd.SimpleContentRestriction <$> parseSimpleRestriction r
255+ ([], [e]) -> Xsd.SimpleContentExtension <$> parseSimpleExtension e
256+ _ -> parseError c "Expected one of restriction or extension"
257+
258+parseSimpleExtension :: Cursor -> P Xsd.SimpleExtension
259+parseSimpleExtension c = handleNamespaces c $ do
260+ base <- theAttribute "base" c >>= makeQName c
261+ attributes <- parseAttributes c
262+ return Xsd.SimpleExtension
263+ { Xsd.simpleExtensionBase = base
264+ , Xsd.simpleExtensionAttributes = attributes
265+ }
235266
236267parseComplexContent :: Cursor -> P Xsd.ComplexContent
237268parseComplexContent c = do
238269 restrictionAxis <- makeElemAxis "restriction"
239270 extenstionAxis <- makeElemAxis "extension"
240271 case (c $/ restrictionAxis, c $/ extenstionAxis) of
241− ([r], []) -> parseError r "not implemented"
272+ ([r], []) -> Xsd.ComplexContentRestriction <$> parseComplexRestriction r
242273 ([], [e]) -> Xsd.ComplexContentExtension <$> parseComplexExtension e
243274 _ -> parseError c "Expected one of restriction or extension"
244275
@@ -253,6 +284,17 @@ parseComplexExtension c = handleNamespaces c $ do
253284 , Xsd.complexExtensionAttributes = attributes
254285 }
255286
287+parseComplexRestriction :: Cursor -> P Xsd.ComplexRestriction
288+parseComplexRestriction c = handleNamespaces c $ do
289+ base <- theAttribute "base" c >>= makeQName c
290+ attributes <- parseAttributes c
291+ model <- parseModelGroup c
292+ return Xsd.ComplexRestriction
293+ { Xsd.complexRestrictionBase = base
294+ , Xsd.complexRestrictionModel = model
295+ , Xsd.complexRestrictionAttributes = attributes
296+ }
297+
256298parseModelGroup :: Cursor -> P (Maybe Xsd.ModelGroup)
257299parseModelGroup c = do
258300 sequenceAxis <- makeElemAxis "sequence"
@@ -275,10 +317,10 @@ parseAll :: Cursor -> P Xsd.ModelGroup
275317parseAll c = Xsd.All <$> parseElements c
276318
277319-- | Get all child elements
278−parseElements :: Cursor -> P [Xsd.Element]
320+parseElements :: Cursor -> P [Xsd.RefOr Xsd.Element]
279321parseElements c = do
280322 elementAxis <- makeElemAxis "element"
281− mapM parseElement (c $/ elementAxis)
323+ mapM parseElementOrRef (c $/ elementAxis)
282324
283325parseAttributes :: Cursor -> P [Xsd.Attribute]
284326parseAttributes c = do
@@ -287,24 +329,33 @@ parseAttributes c = do
287329
288330parseAttribute :: Cursor -> P Xsd.Attribute
289331parseAttribute c = do
290− name <- theAttribute "name" c >>= makeTargetQName
291332 use <- parseUseAttribute c
292−
293− -- XXX: generalaze RefOr parsing
294− tp <- case anAttribute "type" c of
295− Nothing -> do
296− simpleTypeAxis <- makeElemAxis "simpleType"
297− case c $/ simpleTypeAxis of
298− [s] -> Xsd.Inline <$> parseSimpleType s
299− [] -> parseError c "Attribute should have type"
300− _ -> parseError c "Multiple simple types"
301− Just t -> Xsd.Ref <$> makeQName c t
302−
303− return Xsd.Attribute
304− { Xsd.attrName = name
305− , Xsd.attrUse = use
306− , Xsd.attrType = tp
307− }
333+ case (anAttribute "name" c, anAttribute "ref" c) of
334+ (Just n, Nothing) -> do
335+ name <- makeTargetQName n
336+ tp <- case anAttribute "type" c of
337+ Nothing -> do
338+ simpleTypeAxis <- makeElemAxis "simpleType"
339+ case c $/ simpleTypeAxis of
340+ [s] -> Xsd.Inline <$> parseSimpleType s
341+ [] -> return (Xsd.Ref anySimpleType)
342+ _ -> parseError c "Multiple simple types"
343+ Just t -> Xsd.Ref <$> makeQName c t
344+ return $ Xsd.InlineAttribute $ Xsd.AttributeInline
345+ { Xsd.attributeInlineName = name
346+ , Xsd.attributeInlineUse = use
347+ , Xsd.attributeInlineType = tp
348+ }
349+ (Nothing, Just r) -> do
350+ ref <- makeQName c r
351+ return $ Xsd.RefAttribute $ Xsd.AttributeRef
352+ { Xsd.attributeRefRef = ref
353+ , Xsd.attributeRefUse = use
354+ }
355+ _ -> parseError c "Should be either name or ref"
356+ where
357+ anySimpleType =
358+ Xsd.QName (Just (Xsd.Namespace Xsd.schemaNamespace)) "anySimpleType"
308359
309360parseUseAttribute :: Cursor -> P Xsd.Use
310361parseUseAttribute c = case anAttribute "use" c of