@@ -138,7 +138,10 @@ genExtension base = do
138138 ]
139139 clauses <- mapM mkClause (base : map fst types)
140140 writeCode clauses
141− writeCode [""]
141+ writeCode
142+ [ " _ -> throwParserError (PEOther \"Unexpected type\")"
143+ , ""
144+ ]
142145 unless (mode == Parser) $ do
143146 writeCode
144147 [ "instance ToXML Any" <> baseTypeName <> " where"
@@ -188,18 +191,22 @@ genDependencies a = forM_ (references a) $ \name -> do
188191genSimpleType :: TypeName -> Xsd.SimpleType -> [Xsd.Annotation]-> Gen ()
189192genSimpleType tn (Xsd.AtomicType restriction ann) parentAnn = do
190193 let
191− baseName r = case Xsd.restrictionBase r of
194+ baseName r = case Xsd.simpleRestrictionBase r of
192195 Xsd.Ref n -> Just n
193196 Xsd.Inline (Xsd.AtomicType r' _) -> baseName r'
194197 Xsd.Inline (Xsd.ListType _ _) -> Nothing
198+ Xsd.Inline (Xsd.UnionType _ _) -> Nothing
195199 case baseName restriction of
196200 Just _
197201 | isEnum restriction
198− -> genEnum tn (Xsd.restrictionConstraints restriction) (parentAnn <> ann)
202+ -> genEnum tn
203+ (Xsd.simpleRestrictionConstraints restriction)
204+ (parentAnn <> ann)
199205 Just base ->
200206 genNewtype tn base (parentAnn <> ann)
201207 _ -> genUnsupported tn
202208genSimpleType typeName (Xsd.ListType _ _) _ = genUnsupported typeName
209+genSimpleType typeName (Xsd.UnionType _ _) _ = genUnsupported typeName
203210
204211genNewtype :: TypeName -> Xsd.QName -> [Xsd.Annotation] -> Gen ()
205212genNewtype tn base annots = do
@@ -227,6 +234,7 @@ genNewtype tn base annots = do
227234
228235genEnum :: TypeName -> [Xsd.Constraint] -> [Xsd.Annotation] -> Gen ()
229236genEnum tn constraints annots = do
237+ mode <- getMode
230238 let
231239 values = map toValue constraints
232240 toValue (Xsd.Enumeration v) = v
@@ -234,12 +242,12 @@ genEnum tn constraints annots = do
234242 enumName <- makeEnumName v
235243 return (" & \"" <> enumName <> "\"")
236244 writeCode $ makeComments tn annots
237− writeCode $ "\"" <> tnName tn <> "\" Exhaustive =:= enum Both"
238− : enumLines
245+ writeCode $ "\"" <> tnName tn <> "\" Exhaustive =:= enum "
246+ <> genTypeToText mode : enumLines
239247 writeCode [""]
240248
241−isEnum :: Xsd.Restriction -> Bool
242−isEnum = any isEnumConstraint . Xsd.restrictionConstraints
249+isEnum :: Xsd.SimpleRestriction -> Bool
250+isEnum = any isEnumConstraint . Xsd.simpleRestrictionConstraints
243251 where
244252 isEnumConstraint (Xsd.Enumeration _) = True
245253
@@ -257,15 +265,21 @@ genComplexType typeName t parentAnn = do
257265 writeCode [""]
258266
259267makeComments :: TypeName -> [Xsd.Annotation] -> [Text]
260−makeComments typeName annotations =
261− [ "{-"
262− , "Generated from: " <> prefix <> name
263− , ""
264− ] <> map makeDoc annotations <>
265− [ "-}"
266− , ""
267− ]
268+makeComments typeName annotations = if null annotations
269+ then
270+ [ "{-|"
271+ , generated
272+ , "-}"
273+ ]
274+ else
275+ [ "{-|"
276+ , generated
277+ , ""
278+ ] <> map makeDoc annotations <>
279+ [ "-}"
280+ ]
268281 where
282+ generated = "Generated from: " <> prefix <> name
269283 qname = tnQName typeName
270284 name = Xsd.qnName qname
271285 prefix = maybe "" ((<> ":") . Xsd.fromNamespace) (Xsd.qnNamespace qname)
@@ -280,13 +294,14 @@ genFields typeName (Xsd.ContentPlain c) =
280294genFields _ (Xsd.ContentSimple _) = return []
281295genFields typeName (Xsd.ContentComplex (Xsd.ComplexContentExtension e)) = do
282296 base <- resolveType (Xsd.complexExtensionBase e)
297+ genDependencies base
283298 baseFields <- case base of
284299 Xsd.TypeComplex t -> genFields typeName (Xsd.complexContent t)
285300 _ -> return []
286301 fields <- maybe (return []) (genFieldsForModel typeName)
287302 (Xsd.complexExtensionModel e)
288303 return (baseFields ++ fields)
289−genFields _ (Xsd.ContentComplex Xsd.ComplexContentRestriction) =
304+genFields _ (Xsd.ContentComplex (Xsd.ComplexContentRestriction _)) =
290305 return []
291306
292307genFieldsForModel :: TypeName -> Xsd.ModelGroup -> Gen [Text]
@@ -299,8 +314,9 @@ genFieldsForModel _ (Xsd.All _) = do
299314 warn "all: not implemented"
300315 return []
301316
302−genField :: TypeName -> Xsd.Element -> Gen (Maybe Text)
303−genField typeName e = do
317+genField :: TypeName -> Xsd.RefOr Xsd.Element -> Gen (Maybe Text)
318+genField _ (Xsd.Ref _) = return Nothing
319+genField typeName (Xsd.Inline e) = do
304320 fieldName <- makeFieldName typeName (Xsd.elementName e)
305321
306322 fieldTypeName <- case Xsd.elementType e of
@@ -316,13 +332,18 @@ genField typeName e = do
316332
317333 qualifier <- makeQualifier (Xsd.elementOccurs e)
318334
335+ let
336+ fieldType = if Xsd.elementNillable e
337+ then "Nillable " <> fieldTypeName
338+ else fieldTypeName
339+
319340 return $ Just $ mconcat
320341 [ " "
321342 , qualifier
322343 , " \""
323344 , fieldName
324345 , "\" [t|"
325− , fieldTypeName
346+ , fieldType
326347 , "|]"
327348 ]
328349
@@ -378,9 +399,11 @@ genHeader opts = do
378399 writeCode [""]
379400
380401 writeCode
381− [ "module " <> oModule opts <> " where"
402+ [ "{-# OPTIONS_GHC -Wno-unused-imports #-}"
403+ , "module " <> oModule opts <> " where"
382404 , ""
383405 , "import Control.DeepSeq"
406+ , "import Data.Scientific"
384407 , "import Data.THGen.XML"
385408 ]
386409 writeCode imports
@@ -391,9 +414,9 @@ genHeader opts = do
391414 ]
392415 where
393416 imports = case oMode opts of
394− Generator -> [ xmlWriter, parentAttr ]
395− Parser -> [ domParser ]
396− Both -> [ domParser, xmlWriter, parentAttr ]
417+ Generator -> [ xmlWriter, parentAttr ]
418+ Parser -> [ domParser ]
419+ ParserAndGenerator -> [ domParser, xmlWriter, parentAttr ]
397420 xmlWriter = "import Text.XML.Writer"
398421 parentAttr = "import Text.XML.ParentAttributes"
399422 domParser = "import Text.XML.DOM.Parser"