@@ -73,9 +73,9 @@ attrThrowXsd name elNode = maybeThrowXsd (M.lookup name $ elementAttributes elNo
7373toElemsAndDatatypes :: XML.Cursor -> XSDMonad [XSD.Element]
7474toElemsAndDatatypes cursor = do
7575 elems <- traverse toElem (cursor $/ laxElement "element")
76− datatypes <- traverse toDatatype (cursor $/ laxElement "complexType")
76+ datatypes <- traverse toComplexType (cursor $/ laxElement "complexType")
7777 for_ datatypes $ \case
78− datatype@(ComplexType (Just name) _ _) -> tell (M.singleton name datatype)
78+ datatype@(ComplexType (Just name) _ _) -> tell (M.singleton name (TypeComplex datatype))
7979 datatype@(ComplexType Nothing _ _) ->
8080 throwXsd $ "unnamed type ref for datatype: " <> show datatype
8181 pure elems
@@ -116,44 +116,49 @@ toElem cursor = do
116116 e ->
117117 throwXsd $ "[toElem] element expected, got: " <> show e
118118
119−-- | Returns 'Just element' if encounters an element,
120119toDatatype :: Cursor -> XSDMonad Datatype
121120toDatatype cursor = do
122121 case node cursor of
123122 NodeElement el -> case nameLocalName (elementName el) of
124− "simpleType" -> do
125− error "implement simpleType"
126− "complexType" -> do
127− let sequenceAxis = laxElement "sequence"
128− let choiceAxis = laxElement "choice"
129− let allAxis = laxElement "all"
130− if P.null (cursor $// sequenceAxis)
131− then if P.null (cursor $// choiceAxis)
132− then if P.null (cursor $// allAxis)
133− then throwXsd $ "No definition found for complexType: "
134− <> show (safeHead $ cursor $// laxElement "complexType")
135− else do
136− childCursor <- maybeThrowXsd (safeHead $ cursor $// allAxis)
137− $ "More than one xs:all tag in: "
138− <> show (cursor $// laxElement "complexType")
139− let name = safeHead $ cursor $| attribute "name"
140− ComplexType name CTAll <$> toElemsAndDatatypes childCursor
141− else do
142− childCursor <- maybeThrowXsd (safeHead $ cursor $// choiceAxis)
143− $ "More than one xs:choice tag in: "
144− <> show (cursor $// laxElement "complexType")
145− let name = safeHead $ cursor $| attribute "name"
146− ComplexType name CTChoice <$> toElemsAndDatatypes childCursor
147− else do
148− childCursor <- maybeThrowXsd (safeHead $ cursor $// sequenceAxis)
149− $ "More than one xs:sequence tag in: "
150− <> show (cursor $// laxElement "complexType")
151− let name = safeHead $ cursor $| attribute "name"
152− ComplexType name CTSequence <$> toElemsAndDatatypes childCursor
153− e -> throwXsd $ "[toDatatype] xsd node not supported: " <> show e
123+ "simpleType" -> TypeSimple <$> toSimpleType cursor
124+ "complexType" -> TypeComplex <$> toComplexType cursor
125+ e -> throwXsd $ "[toDatatype] xsd node not supported: " <> show e
154126 e ->
155127 throwXsd $ "[toDatatype] element expected, got: " <> show e
156128
129+toSimpleType :: Cursor -> XSDMonad SimpleType
130+toSimpleType cursor = do
131+ error "TODO: implement toSimpleType"
132+
133+toComplexType :: Cursor -> XSDMonad ComplexType
134+toComplexType cursor = do
135+ let sequenceAxis = laxElement "sequence"
136+ let choiceAxis = laxElement "choice"
137+ let allAxis = laxElement "all"
138+ if P.null (cursor $// sequenceAxis)
139+ then if P.null (cursor $// choiceAxis)
140+ then if P.null (cursor $// allAxis)
141+ then throwXsd $ "No definition found for complexType: "
142+ <> show (safeHead $ cursor $// laxElement "complexType")
143+ else do
144+ childCursor <- maybeThrowXsd (safeHead $ cursor $// allAxis)
145+ $ "More than one xs:all tag in: "
146+ <> show (cursor $// laxElement "complexType")
147+ let name = safeHead $ cursor $| attribute "name"
148+ ComplexType name CTAll <$> toElemsAndDatatypes childCursor
149+ else do
150+ childCursor <- maybeThrowXsd (safeHead $ cursor $// choiceAxis)
151+ $ "More than one xs:choice tag in: "
152+ <> show (cursor $// laxElement "complexType")
153+ let name = safeHead $ cursor $| attribute "name"
154+ ComplexType name CTChoice <$> toElemsAndDatatypes childCursor
155+ else do
156+ childCursor <- maybeThrowXsd (safeHead $ cursor $// sequenceAxis)
157+ $ "More than one xs:sequence tag in: "
158+ <> show (cursor $// laxElement "complexType")
159+ let name = safeHead $ cursor $| attribute "name"
160+ ComplexType name CTSequence <$> toElemsAndDatatypes childCursor
161+
157162toXsd :: Document -> Either SomeException XSD
158163toXsd doc = do
159164 (el, dt) <- runWriterT $ toSchema (fromDocument doc)