on master help sign in
Add namespace support
commiteadf9d18795000e0df4de95e0b30fcd00a24200f authorDmitry Bushev <bushevdv@gmail.com> dateMon 16 Apr 2018, 23:08 (8 years ago) parentcf5c4b6
2 files changed+16−6
src/Data/THGen/XML.hs+15−5 test/TestDefs.hs+1−1
src/Data/THGen/XML.hs+15−5
@@ -252,7 +252,7 @@ instance IsString (TH.TypeQ -> IsoXmlDescPreField) where
252252instance IsString IsoXmlDescPreField where
253253 fromString name = IsoXmlDescPreField name ty
254254 where
255− ty = (TH.conT . TH.mkName) ("Xml" ++ over _head C.toUpper name)
255+ ty = (TH.conT . TH.mkName) ("Xml" ++ over _head C.toUpper (xmlLocalName name))
256256
257257instance IsString (TH.TypeQ -> IsoXmlDescPreAttribute) where
258258 fromString = IsoXmlDescPreAttribute
@@ -327,7 +327,8 @@ isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do
327327 return $ case descRecordPart of
328328 IsoXmlDescRecordField descField ->
329329 let
330− IsoXmlDescField fieldPlural fieldStrName fieldType = descField
330+ IsoXmlDescField fieldPlural rawName fieldType = descField
331+ fieldStrName = xmlLocalName rawName
331332 fName = TH.mkName (fieldName fieldStrName)
332333 fType = case fieldPlural of
333334 XmlFieldPluralMandatory -> fieldType
@@ -366,7 +367,8 @@ isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do
366367 return $ case descRecordPart of
367368 IsoXmlDescRecordField descField ->
368369 let
369− IsoXmlDescField fieldPlural fieldStrName _ = descField
370+ IsoXmlDescField fieldPlural rawName _ = descField
371+ fieldStrName = xmlLocalName rawName
370372 exprFieldStrName = TH.litE (TH.stringL fieldStrName)
371373 fieldParse = case fieldPlural of
372374 XmlFieldPluralMandatory -> [e|inElem|]
@@ -393,13 +395,14 @@ isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do
393395 let
394396 exprFields = do
395397 descRecordPart <- descRecordParts
396− IsoXmlDescField fieldPlural fieldStrName _ <-
398+ IsoXmlDescField fieldPlural rawName _ <-
397399 maybeToList $ case descRecordPart of
398400 IsoXmlDescRecordField descField -> Just descField
399401 _ -> Nothing
400402 let
403+ fieldStrName = xmlLocalName rawName
401404 fName = TH.mkName (fieldName fieldStrName)
402− exprFieldStrName = TH.litE (TH.stringL fieldStrName)
405+ exprFieldStrName = TH.litE (TH.stringL rawName)
403406 exprForField = case fieldPlural of
404407 XmlFieldPluralMandatory -> [e|id|]
405408 _ -> [e|traverse|]
@@ -449,3 +452,10 @@ isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do
449452
450453distribPair :: Functor f => (a, f b) -> f (a, b)
451454distribPair (a, fb) = (a,) <$> fb
455+
456+-- | Get a local part of (possibly) fully qualified 'X.Name':
457+--
458+-- >>> xmlLocalName "{http://example.com/ns/my-namespace}my-name"
459+-- "my-name"
460+xmlLocalName :: String -> String
461+xmlLocalName = T.unpack . X.nameLocalName . fromString
test/TestDefs.hs+1−1
@@ -29,7 +29,7 @@ import Test.QuickCheck.Instances ()
2929 ?% "Muux" [t|XmlQuux|]
3030
3131"Root" =:= record
32− ! "Foo"
32+ ! "{http://example.com/ns/my-namespace}Foo"
3333
3434instance Arbitrary XmlRoot where
3535 arbitrary = genericArbitrary