@@ -48,12 +48,12 @@ toElemsAndDatatypes cursor = do
4848 elems <- traverse toElem (cursor $/ laxElement "element")
4949 complexDatatypes <- traverse toComplexType (cursor $/ laxElement "complexType")
5050 for_ complexDatatypes $ \case
51− datatype@(ComplexType (Just name) _ _) ->
51+ datatype@(ComplexType (Just name) _ _ _) ->
5252 tell (M.singleton name (TypeComplex datatype))
53− datatype@(ComplexType Nothing _ _) ->
53+ datatype@(ComplexType Nothing _ _ _) ->
5454 throwXsd $ "unnamed type ref for datatype: " <> show datatype
5555 simpleTypes <- traverse toSimpleType (cursor $/ laxElement "simpleType")
56− for_ simpleTypes $ \simpleType@(STAtomic name _ _) ->
56+ for_ simpleTypes $ \simpleType@(STAtomic name _ _ _) ->
5757 tell (M.singleton name (TypeSimple simpleType))
5858 pure elems
5959
@@ -61,6 +61,14 @@ safeHead :: [a] -> Maybe a
6161safeHead [] = Nothing
6262safeHead (a:_) = Just a
6363
64+getDocumentation :: Cursor -> [Annotation]
65+getDocumentation cursor = Documentation <$> documentation
66+ where
67+ documentation = cursor
68+ $/ laxElement "annotation"
69+ &// laxElement "documentation"
70+ &/ content
71+
6472-- | Takes a cursor to the element itself.
6573toElem :: Cursor -> XSDMonad XSD.Element
6674toElem cursor = do
@@ -74,8 +82,8 @@ toElem cursor = do
7482 name <- attrThrowXsd "name" el
7583 $ "Expected attribute 'name' for element: " <> show (node cursor)
7684 let
77− minOc = maybe 0 (read . T.unpack) (M.lookup "minOccurs" attrs)
78− maxOc = read . T.unpack <$> M.lookup "maxOccurs" attrs
85+ minOc = maybe 0 (read . T.unpack) (M.lookup "minOccurs" attrs)
86+ maxOc = read . T.unpack <$> M.lookup "maxOccurs" attrs
7987 datatypeRef <- case mAttrType of
8088 Just dtn -> pure $ DatatypeRef dtn
8189 Nothing -> do
@@ -88,24 +96,15 @@ toElem cursor = do
8896 let name = safeHead $ childCursor $| attribute "name"
8997 InlineComplex . TypeComplex <$> toComplexType childCursor
9098 pure $ XSD.Element
91− { name = (ns, name)
92− , xtype = datatypeRef
93− , minOccurs = minOc
94− , maxOccurs = maxOc }
99+ { name = (ns, name)
100+ , xtype = datatypeRef
101+ , minOccurs = minOc
102+ , maxOccurs = maxOc
103+ , annotations = getDocumentation cursor }
95104 e -> throwXsd $ "[toElem] xsd node not supported: " <> show e
96105 e ->
97106 throwXsd $ "[toElem] element expected, got: " <> show e
98107
99−-- toDatatype :: Cursor -> XSDMonad Datatype
100−-- toDatatype cursor = do
101−-- case node cursor of
102−-- NodeElement el -> case nameLocalName (elementName el) of
103−-- "simpleType" -> TypeSimple <$> toSimpleType cursor
104−-- "complexType" -> TypeComplex <$> toComplexType cursor
105−-- e -> throwXsd $ "[toDatatype] xsd node not supported: " <> show e
106−-- e ->
107−-- throwXsd $ "[toDatatype] element expected, got: " <> show e
108−
109108toSimpleType :: Cursor -> XSDMonad SimpleType
110109toSimpleType cursor = do
111110 name <- maybeThrowXsd
@@ -126,6 +125,7 @@ toSimpleType cursor = do
126125 Left e -> throwXsd e
127126 Right simpleAtomicType ->
128127 pure $ STAtomic name simpleAtomicType
128+ (getDocumentation cursor)
129129 $ if P.null enumValues then [] else [Enumeration enumValues]
130130
131131-- | Takes a cursor to the 'xs:complexType' element.
@@ -137,6 +137,7 @@ toComplexType cursor = do
137137 let allAxis = laxElement "all"
138138 -- attributes
139139 attrs <- traverse toAttribute (cursor $// attributeAxis)
140+ let ann = getDocumentation cursor
140141 -- group model schemas
141142 if P.null (cursor $// sequenceAxis)
142143 then if P.null (cursor $// choiceAxis)
@@ -146,29 +147,33 @@ toComplexType cursor = do
146147 else do
147148 childCursor <- maybeThrowXsd (safeHead $ cursor $// allAxis)
148149 $ "Unexpected number of xs:all tags in: " <> show cursor
149− let name = safeHead $ cursor $| attribute "name"
150− ComplexType name attrs . Just . CTAll <$> toElemsAndDatatypes childCursor
150+ let
151+ name = safeHead $ cursor $| attribute "name"
152+ ComplexType name attrs ann . Just . CTAll <$> toElemsAndDatatypes childCursor
151153 else do
152154 childCursor <- maybeThrowXsd (safeHead $ cursor $// choiceAxis)
153155 $ "Unexpected number of xs:choice tags in: " <> show cursor
154− let name = safeHead $ cursor $| attribute "name"
155− ComplexType name attrs . Just . CTChoice <$> toElemsAndDatatypes childCursor
156+ let
157+ name = safeHead $ cursor $| attribute "name"
158+ ComplexType name attrs ann . Just . CTChoice <$> toElemsAndDatatypes childCursor
156159 else do
157160 childCursor <- maybeThrowXsd (safeHead $ cursor $// sequenceAxis)
158161 $ "Unexpected number of xs:sequence tags in: " <> show cursor
159− let name = safeHead $ cursor $| attribute "name"
160− ComplexType name attrs . Just . CTSequence <$> toElemsAndDatatypes childCursor
162+ let
163+ name = safeHead $ cursor $| attribute "name"
164+ ComplexType name attrs ann . Just . CTSequence <$> toElemsAndDatatypes childCursor
161165
162166toAttribute :: XML.Cursor -> XSDMonad Attribute
163167toAttribute cursor = do
164168 name <- maybeThrowXsd (safeHead $ cursor $| attribute "name")
165169 $ "No name attribute found in child <attribute> of: "
166170 <> show (cursor $| ancestor <=< ancestor)
171+ let ann = getDocumentation cursor
167172 simpleType <- case safeHead $ cursor $| attribute "type" of
168173 Just simpleAtomicType ->
169174 case fromSimpleTypeStr $ toQName simpleAtomicType of
170175 Left e -> throwXsd e
171− Right simpleAtomicType -> pure $ STAtomic name simpleAtomicType []
176+ Right simpleAtomicType -> pure $ STAtomic name simpleAtomicType ann []
172177 Nothing -> do
173178 let simpleTypeCursor = safeHead $ cursor $// laxElement "simpleType"
174179 case simpleTypeCursor of