@@ -160,18 +160,19 @@ parseSimpleType c = do
160 unionAxis <- makeElemAxis "union"
160 unionAxis <- makeElemAxis "union"
161 case (c $/ restrictionAxis, c $/ listAxis, c $/ unionAxis) of
161 case (c $/ restrictionAxis, c $/ listAxis, c $/ unionAxis) of
162 ([e], [], []) -> Xsd.AtomicType
162 ([e], [], []) -> Xsd.AtomicType
163− <$> parseRestriction e
163+ <$> parseSimpleRestriction e
164 <*> parseAnnotations c
164 <*> parseAnnotations c
165 ([], [l], []) -> Xsd.ListType
165 ([], [l], []) -> Xsd.ListType
166 <$> parseList l
166 <$> parseList l
167 <*> parseAnnotations c
167 <*> parseAnnotations c
168− -- TODO implement me
168+ ([], [], [u]) -> Xsd.UnionType
169− ([], [], [_]) -> parseError c "Not implemented: union"
169+ <$> parseUnion u
170+ <*> parseAnnotations c
170 _ -> parseError c "Expected exactly of of restriction, list or union"
171 _ -> parseError c "Expected exactly of of restriction, list or union"
172-- | Restriction for simple type
173-- | Restriction for simple type
173−parseRestriction :: Cursor -> P Xsd.Restriction
174+parseSimpleRestriction :: Cursor -> P Xsd.SimpleRestriction
174−parseRestriction c = do
175+parseSimpleRestriction c = do
175 -- XXX: generalaze RefOr parsing
176 -- XXX: generalaze RefOr parsing
176 tp <- case anAttribute "base" c of
177 tp <- case anAttribute "base" c of
177 Nothing -> do
178 Nothing -> do
@@ -184,9 +185,9 @@ parseRestriction c = do
185 constraints <- parseConstrains c
186 constraints <- parseConstrains c
187− return Xsd.Restriction
188+ return Xsd.SimpleRestriction
188− { Xsd.restrictionBase = tp
189+ { Xsd.simpleRestrictionBase = tp
189− , Xsd.restrictionConstraints = constraints
190+ , Xsd.simpleRestrictionConstraints = constraints
192parseConstrains :: Cursor -> P [Xsd.Constraint]
193parseConstrains :: Cursor -> P [Xsd.Constraint]
@@ -207,6 +208,15 @@ parseList c =
207 _ -> parseError c "Multiple types"
208 _ -> parseError c "Multiple types"
208 Just t -> Xsd.Ref <$> makeQName c t
209 Just t -> Xsd.Ref <$> makeQName c t
211+parseUnion :: Cursor -> P [Xsd.RefOr Xsd.SimpleType]
213+ case anAttribute "memberTypes" c of
215+ mapM (fmap Xsd.Ref . makeQName c) (Text.splitOn " " list)
217+ simpleTypeAxis <- makeElemAxis "simpleType"
218+ mapM (fmap Xsd.Inline . parseSimpleType) (c $/ simpleTypeAxis)
210parseComplexType :: Cursor -> P Xsd.ComplexType
220parseComplexType :: Cursor -> P Xsd.ComplexType
211parseComplexType c = do
221parseComplexType c = do
212 annotations <- parseAnnotations c
222 annotations <- parseAnnotations c
@@ -237,14 +247,29 @@ parsePlainContent c = do
239parseSimpleContent :: Cursor -> P Xsd.SimpleContent
249parseSimpleContent :: Cursor -> P Xsd.SimpleContent
240−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"
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
242parseComplexContent :: Cursor -> P Xsd.ComplexContent
267parseComplexContent :: Cursor -> P Xsd.ComplexContent
243parseComplexContent c = do
268parseComplexContent c = do
244 restrictionAxis <- makeElemAxis "restriction"
269 restrictionAxis <- makeElemAxis "restriction"
245 extenstionAxis <- makeElemAxis "extension"
270 extenstionAxis <- makeElemAxis "extension"
246 case (c $/ restrictionAxis, c $/ extenstionAxis) of
271 case (c $/ restrictionAxis, c $/ extenstionAxis) of
247− ([r], []) -> parseError r "not implemented"
272+ ([r], []) -> Xsd.ComplexContentRestriction <$> parseComplexRestriction r
248 ([], [e]) -> Xsd.ComplexContentExtension <$> parseComplexExtension e
273 ([], [e]) -> Xsd.ComplexContentExtension <$> parseComplexExtension e
249 _ -> parseError c "Expected one of restriction or extension"
274 _ -> parseError c "Expected one of restriction or extension"
@@ -259,6 +284,17 @@ parseComplexExtension c = handleNamespaces c $ do
259 , Xsd.complexExtensionAttributes = attributes
284 , Xsd.complexExtensionAttributes = attributes
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
262parseModelGroup :: Cursor -> P (Maybe Xsd.ModelGroup)
298parseModelGroup :: Cursor -> P (Maybe Xsd.ModelGroup)
263parseModelGroup c = do
299parseModelGroup c = do
264 sequenceAxis <- makeElemAxis "sequence"
300 sequenceAxis <- makeElemAxis "sequence"
@@ -293,24 +329,33 @@ parseAttributes c = do
294parseAttribute :: Cursor -> P Xsd.Attribute
330parseAttribute :: Cursor -> P Xsd.Attribute
295parseAttribute c = do
331parseAttribute c = do
296− name <- theAttribute "name" c >>= makeTargetQName
297 use <- parseUseAttribute c
332 use <- parseUseAttribute c
298−
333+ case (anAttribute "name" c, anAttribute "ref" c) of
299− -- XXX: generalaze RefOr parsing
334+ (Just n, Nothing) -> do
335+ name <- makeTargetQName n
300− tp <- case anAttribute "type" c of
336+ tp <- case anAttribute "type" c of
301− Nothing -> do
337+ Nothing -> do
302− simpleTypeAxis <- makeElemAxis "simpleType"
338+ simpleTypeAxis <- makeElemAxis "simpleType"
303− case c $/ simpleTypeAxis of
339+ case c $/ simpleTypeAxis of
304− [s] -> Xsd.Inline <$> parseSimpleType s
340+ [s] -> Xsd.Inline <$> parseSimpleType s
305− [] -> parseError c "Attribute should have type"
341+ [] -> return (Xsd.Ref anySimpleType)
306− _ -> parseError c "Multiple simple types"
342+ _ -> parseError c "Multiple simple types"
307− Just t -> Xsd.Ref <$> makeQName c t
343+ Just t -> Xsd.Ref <$> makeQName c t
308−
344+ return $ Xsd.InlineAttribute $ Xsd.AttributeInline
309− return Xsd.Attribute
345+ { Xsd.attributeInlineName = name
310− { Xsd.attrName = name
346+ , Xsd.attributeInlineUse = use
311− , Xsd.attrUse = use
347+ , Xsd.attributeInlineType = tp
312− , Xsd.attrType = 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
355+ _ -> parseError c "Should be either name or ref"
358+ Xsd.QName (Just (Xsd.Namespace Xsd.schemaNamespace)) "anySimpleType"
315parseUseAttribute :: Cursor -> P Xsd.Use
360parseUseAttribute :: Cursor -> P Xsd.Use
316parseUseAttribute c = case anAttribute "use" c of
361parseUseAttribute c = case anAttribute "use" c of