master..440b8be · xml-isogen

git.iko.soy/xml-isogen

on 440b8be help sign in

src/Data/THGen/XML.hs+7−12

since splitsnapshots

unifiedsplit

@@ -22,7 +22,7 @@ wrapper around the field type:

23Example 1.

25−> "Color" =:= enum Both

25+> "Color" =:= enum

26> & "R"

27> & "G"

28> & "B"

@@ -40,7 +40,7 @@ to be either @R@, @G@ or @B@.

41Example 2.

43−> "Message" =:= record Both

43+> "Message" =:= record

44> ! "author"

45> + "recipient"

46> ? "message" [t|Text|]

@@ -67,10 +67,10 @@ enumeration is exhaustive (contains only the listed constructors) or

67non-exhaustive (also contains a constructor for unknown values; this

68is the default):

70−> "Enum1" Exhaustive =:= enum Generator

70+> "Enum1" Exhaustive =:= enum

71> ...

73−> "Enum2" NonExhaustive =:= enum Generator

73+> "Enum2" NonExhaustive =:= enum

74> ...

76To define a record, use the `record` function followed by the name of

@@ -78,7 +78,7 @@ the data type to be generated. The prefix for the record fields is

78inferred automatically by taking all of the uppercase letters in the

79name. You can override it manually like so:

81−> "Reference" "ref" =:= record Parser

81+> "Reference" "ref" =:= record

82> ...

84To describe a record field you must supply its name as it appears

@@ -93,14 +93,10 @@ The type of the field is inferred automatically from its name, so

93if the field is called @"author"@ its type will be @Author@. You can

94override the type by specifying it in quasiquotes like so:

96−> "Message" =:= record Both

96+> "Message" =:= record

97−> ! "author" [t|Person|].

97+> ! "author" [t|Person|]

98> ...

100−Both @record@ and @enum@ take a @GenType@ argument which tells it to generate

101−generator, parser or both. It's being used to optimize compilation time by

102−skipping the unnecessary TH instance generation.

103−

104-}

100-}

105

101

106

102

@@ -108,7 +104,6 @@ module Data.THGen.XML

108 ( Exhaustiveness(..)

104 ( Exhaustiveness(..)

109 , PrefixName(..)

105 , PrefixName(..)

110 , ExhaustivenessName(..)

106 , ExhaustivenessName(..)

111− , GenType(..)

112 , record

107 , record

113 , enum

108 , enum

114 , (!)

109 , (!)

src/Data/THGen/XML/Internal.hs+140−173

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE UndecidableInstances #-}

1{-# LANGUAGE UndecidableInstances #-}

3{-# LANGUAGE FunctionalDependencies #-}

2{-# LANGUAGE FunctionalDependencies #-}

@@ -24,8 +23,6 @@ import Text.XML.ParentAttributes

24import qualified Text.XML.Writer as XW

23import qualified Text.XML.Writer as XW

27−data GenType = Parser | Generator | Both

28−

29data XmlFieldPlural

26data XmlFieldPlural

30 = XmlFieldPluralMandatory -- Occurs exactly 1 time (Identity)

27 = XmlFieldPluralMandatory -- Occurs exactly 1 time (Identity)

31 | XmlFieldPluralOptional -- Occurs 0 or 1 times (Maybe)

28 | XmlFieldPluralOptional -- Occurs 0 or 1 times (Maybe)

@@ -55,7 +52,7 @@ data IsoXmlDescRecordPart

55 | IsoXmlDescRecordAttribute IsoXmlDescAttribute

52 | IsoXmlDescRecordAttribute IsoXmlDescAttribute

56 | IsoXmlDescRecordContent IsoXmlDescContent

53 | IsoXmlDescRecordContent IsoXmlDescContent

58−data IsoXmlDescRecord = IsoXmlDescRecord GenType [IsoXmlDescRecordPart]

55+newtype IsoXmlDescRecord = IsoXmlDescRecord [IsoXmlDescRecordPart]

60makePrisms ''IsoXmlDescRecord

57makePrisms ''IsoXmlDescRecord

@@ -67,7 +64,7 @@ newtype IsoXmlDescEnumCon

67instance IsString IsoXmlDescEnumCon where

64instance IsString IsoXmlDescEnumCon where

68 fromString = IsoXmlDescEnumCon

65 fromString = IsoXmlDescEnumCon

70−data IsoXmlDescEnum = IsoXmlDescEnum GenType [IsoXmlDescEnumCon]

67+data IsoXmlDescEnum = IsoXmlDescEnum [IsoXmlDescEnumCon]

72makePrisms ''IsoXmlDescEnum

69makePrisms ''IsoXmlDescEnum

@@ -76,26 +73,26 @@ appendField

76 -> IsoXmlDescRecord

73 -> IsoXmlDescRecord

77 -> IsoXmlDescPreField

74 -> IsoXmlDescPreField

78 -> IsoXmlDescRecord

75 -> IsoXmlDescRecord

79−appendField plural (IsoXmlDescRecord genType fields) (IsoXmlDescPreField name ty) =

76+appendField plural xrec (IsoXmlDescPreField name ty) =

80 let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty

77 let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty

81− in IsoXmlDescRecord genType (xfield:fields)

78+ in over _IsoXmlDescRecord (xfield:) xrec

83appendAttribute

80appendAttribute

84 :: XmlAttributePlural

81 :: XmlAttributePlural

85 -> IsoXmlDescRecord

82 -> IsoXmlDescRecord

86 -> IsoXmlDescPreAttribute

83 -> IsoXmlDescPreAttribute

87 -> IsoXmlDescRecord

84 -> IsoXmlDescRecord

88−appendAttribute plural (IsoXmlDescRecord genType fields) (IsoXmlDescPreAttribute name ty) =

85+appendAttribute plural xrec (IsoXmlDescPreAttribute name ty) =

89 let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty

86 let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty

90− in IsoXmlDescRecord genType (xattribute:fields)

87+ in over _IsoXmlDescRecord (xattribute:) xrec

92appendContent

89appendContent

93 :: IsoXmlDescRecord

90 :: IsoXmlDescRecord

94 -> IsoXmlDescPreContent

91 -> IsoXmlDescPreContent

95 -> IsoXmlDescRecord

92 -> IsoXmlDescRecord

96−appendContent (IsoXmlDescRecord genType fields) (IsoXmlDescPreContent name ty) =

93+appendContent xrec (IsoXmlDescPreContent name ty) =

97 let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty

94 let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty

98− in IsoXmlDescRecord genType (xcontent:fields)

95+ in over _IsoXmlDescRecord (xcontent:) xrec

100(!), (?), (*), (+) :: IsoXmlDescRecord -> IsoXmlDescPreField -> IsoXmlDescRecord

97(!), (?), (*), (+) :: IsoXmlDescRecord -> IsoXmlDescPreField -> IsoXmlDescRecord

101(!) = appendField XmlFieldPluralMandatory

98(!) = appendField XmlFieldPluralMandatory

@@ -119,8 +116,8 @@ infixl 2 ?%

119infixl 2 ^

116infixl 2 ^

120

117

121appendEnumCon :: IsoXmlDescEnum -> IsoXmlDescEnumCon -> IsoXmlDescEnum

118appendEnumCon :: IsoXmlDescEnum -> IsoXmlDescEnumCon -> IsoXmlDescEnum

122−appendEnumCon (IsoXmlDescEnum genType enumCons) xenumcon =

119+appendEnumCon xenum xenumcon =

123− IsoXmlDescEnum genType (xenumcon:enumCons)

120+ over _IsoXmlDescEnum (xenumcon:) xenum

124

121

125(&) :: IsoXmlDescEnum -> IsoXmlDescEnumCon -> IsoXmlDescEnum

122(&) :: IsoXmlDescEnum -> IsoXmlDescEnumCon -> IsoXmlDescEnum

126(&) = appendEnumCon

123(&) = appendEnumCon

@@ -133,18 +130,20 @@ class Description name desc | desc -> name where

133infix 0 =:=

130infix 0 =:=

134

131

135instance Description PrefixName IsoXmlDescRecord where

132instance Description PrefixName IsoXmlDescRecord where

136− prefixName =:= (IsoXmlDescRecord genType descRecordParts) =

133+ prefixName =:= descRecord =

134+ let descRecordParts = descRecord ^. _IsoXmlDescRecord

137− isoXmlGenerateDatatype genType prefixName (reverse descRecordParts)

135+ in isoXmlGenerateDatatype prefixName (reverse descRecordParts)

138

136

139−record :: GenType -> IsoXmlDescRecord

137+record :: IsoXmlDescRecord

140−record gt = IsoXmlDescRecord gt []

138+record = IsoXmlDescRecord []

141

139

142−enum :: GenType -> IsoXmlDescEnum

140+enum :: IsoXmlDescEnum

143−enum gt = IsoXmlDescEnum gt []

141+enum = IsoXmlDescEnum []

144

142

145instance Description ExhaustivenessName IsoXmlDescEnum where

143instance Description ExhaustivenessName IsoXmlDescEnum where

146− exhaustivenessName =:= (IsoXmlDescEnum genType descEnumCons) =

144+ exhaustivenessName =:= descEnum =

145+ let descEnumCons = descEnum ^. _IsoXmlDescEnum

147− isoXmlGenerateEnum genType exhaustivenessName (reverse descEnumCons)

146+ in isoXmlGenerateEnum exhaustivenessName (reverse descEnumCons)

148

147

149instance IsString (TH.TypeQ -> IsoXmlDescPreField) where

148instance IsString (TH.TypeQ -> IsoXmlDescPreField) where

150 fromString = IsoXmlDescPreField

149 fromString = IsoXmlDescPreField

@@ -189,57 +188,39 @@ funSimple :: TH.Name -> TH.ExpQ -> TH.DecQ

189funSimple name body = TH.funD name [ TH.clause [] (TH.normalB body) [] ]

188funSimple name body = TH.funD name [ TH.clause [] (TH.normalB body) [] ]

190

189

191isoXmlGenerateEnum

190isoXmlGenerateEnum

192− :: GenType

193− -> ExhaustivenessName

194− -> [IsoXmlDescEnumCon]

191+ :: ExhaustivenessName -> [IsoXmlDescEnumCon] -> TH.DecsQ

195− -> TH.DecsQ

196−isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do

192+isoXmlGenerateEnum (ExhaustivenessName strName' exh) enumCons = do

197 let

193 let

198 strName = "Xml" ++ strName'

194 strName = "Xml" ++ strName'

199 strVals = map unIsoXmlDescEnumCon enumCons

195 strVals = map unIsoXmlDescEnumCon enumCons

200 enumDesc = EnumDesc exh strName strVals

196 enumDesc = EnumDesc exh strName strVals

201 name = TH.mkName strName

197 name = TH.mkName strName

202 enumDecls <- enumGenerate enumDesc

198 enumDecls <- enumGenerate enumDesc

203− let

199+ toXmlInst <- do

204− genToXmlInst = do

205− TH.instanceD

200+ TH.instanceD

206− (return [])

201+ (return [])

207− [t|XW.ToXML $(TH.conT name)|]

202+ [t|XW.ToXML $(TH.conT name)|]

208− [funSimple 'XW.toXML [e|XW.toXML . T.pack . show|]]

203+ [funSimple 'XW.toXML [e|XW.toXML . T.pack . show|]]

209− genToXmlAttributeInst = do

204+ toXmlAttributeInst <- do

210− TH.instanceD

205+ TH.instanceD

211− (return [])

206+ (return [])

212− [t|ToXmlAttribute $(TH.conT name)|]

207+ [t|ToXmlAttribute $(TH.conT name)|]

213− [funSimple 'toXmlAttribute [e|T.pack . show|]]

208+ [funSimple 'toXmlAttribute [e|T.pack . show|]]

214− genFromDomInst = do

209+ fromDomInst <- do

215− TH.instanceD

210+ TH.instanceD

216− (return [])

211+ (return [])

217− [t|FromDom $(TH.conT name)|]

212+ [t|FromDom $(TH.conT name)|]

218− [funSimple 'fromDom [e|parseContent readContent|]]

213+ [funSimple 'fromDom [e|parseContent readContent|]]

219− genFromAttributeInst = do

214+ fromAttributeInst <- do

220− TH.instanceD

215+ TH.instanceD

221− (return [])

216+ (return [])

222− [t|FromAttribute $(TH.conT name)|]

217+ [t|FromAttribute $(TH.conT name)|]

223− [funSimple 'fromAttribute [e|readContent|]]

218+ [funSimple 'fromAttribute [e|readContent|]]

224− case genType of

225− Generator -> do

226− toXmlInst <- genToXmlInst

227− toXmlAttributeInst <- genToXmlAttributeInst

228− return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]

219+ return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,

229− Parser -> do

230− fromDomInst <- genFromDomInst

231− fromAttributeInst <- genFromAttributeInst

232− return $ enumDecls ++ [fromDomInst, fromAttributeInst]

233− Both -> do

234− toXmlInst <- genToXmlInst

235− toXmlAttributeInst <- genToXmlAttributeInst

236− fromDomInst <- genFromDomInst

237− fromAttributeInst <- genFromAttributeInst

238− return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,

239− fromDomInst, fromAttributeInst]

220+ fromDomInst, fromAttributeInst]

240−

221+

241−isoXmlGenerateDatatype :: GenType -> PrefixName -> [IsoXmlDescRecordPart] -> TH.DecsQ

222+isoXmlGenerateDatatype :: PrefixName -> [IsoXmlDescRecordPart] -> TH.DecsQ

242−isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts = do

223+isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do

243 let

224 let

244 isNewtype = length descRecordParts == 1

225 isNewtype = length descRecordParts == 1

245 strName = "Xml" ++ strName'

226 strName = "Xml" ++ strName'

@@ -293,117 +274,103 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts

293 (return [])

274 (return [])

294 [t|NFData $(TH.conT name)|]

275 [t|NFData $(TH.conT name)|]

295 [ ]

276 [ ]

277+ fromDomInst <- do

278+ let

279+ exprHeader = [e|pure $(TH.conE name)|]

280+ exprRecordParts = do

281+ descRecordPart <- descRecordParts

282+ return $ case descRecordPart of

283+ IsoXmlDescRecordField descField ->

284+ let

285+ IsoXmlDescField fieldPlural rawName _ = descField

286+ fieldStrName = xmlLocalName rawName

287+ exprFieldStrName = TH.litE (TH.stringL fieldStrName)

288+ fieldParse = case fieldPlural of

289+ XmlFieldPluralMandatory -> [e|inElem|]

290+ _ -> [e|inElemTrav|]

291+ in

292+ [e|$fieldParse $exprFieldStrName fromDom|]

293+ IsoXmlDescRecordAttribute descAttribute ->

294+ let

295+ IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute

296+ exprAttributeStrName = TH.litE (TH.stringL attributeStrName)

297+ attributeParse = case attributePlural of

298+ XmlAttributePluralMandatory -> [e|parseAttribute|]

299+ XmlAttributePluralOptional -> [e|parseAttributeMaybe|]

300+ in

301+ [e|$attributeParse $exprAttributeStrName fromAttribute|]

302+ IsoXmlDescRecordContent _ -> [e|parseContent fromAttribute|]

303+ fromDomExpr = foldl (\e fe -> [e| $e <*> $fe |]) exprHeader exprRecordParts

304+ TH.instanceD

305+ (return [])

306+ [t|FromDom $(TH.conT name)|]

307+ [ funSimple 'fromDom fromDomExpr ]

296

308

297− let

309+ toXmlInst <- do

298− genFromDomInst = do

299− let

300− exprHeader = [e|pure $(TH.conE name)|]

301− exprRecordParts = do

302− descRecordPart <- descRecordParts

303− return $ case descRecordPart of

304− IsoXmlDescRecordField descField ->

305− let

306− IsoXmlDescField fieldPlural rawName _ = descField

307− fieldStrName = xmlLocalName rawName

308− exprFieldStrName = TH.litE (TH.stringL fieldStrName)

309− fieldParse = case fieldPlural of

310− XmlFieldPluralMandatory -> [e|inElem|]

311− _ -> [e|inElemTrav|]

312− in

313− [e|$fieldParse $exprFieldStrName fromDom|]

314− IsoXmlDescRecordAttribute descAttribute ->

315− let

316− IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute

317− exprAttributeStrName = TH.litE (TH.stringL attributeStrName)

318− attributeParse = case attributePlural of

319− XmlAttributePluralMandatory -> [e|parseAttribute|]

320− XmlAttributePluralOptional -> [e|parseAttributeMaybe|]

321− in

322− [e|$attributeParse $exprAttributeStrName fromAttribute|]

323− IsoXmlDescRecordContent _ -> [e|parseContent fromAttribute|]

324− fromDomExpr = foldl (\e fe -> [e| $e <*> $fe |]) exprHeader exprRecordParts

325− TH.instanceD

326− (return [])

327− [t|FromDom $(TH.conT name)|]

328− [ funSimple 'fromDom fromDomExpr ]

329−

330− genToXmlInst = do

331− objName <- TH.newName strPrefix

310+ objName <- TH.newName strPrefix

332− let

311+ let

333− exprFields = do

312+ exprFields = do

334− descRecordPart <- descRecordParts

313+ descRecordPart <- descRecordParts

335− case descRecordPart of

314+ case descRecordPart of

336− IsoXmlDescRecordField (IsoXmlDescField fieldPlural rawName _) -> do

315+ IsoXmlDescRecordField (IsoXmlDescField fieldPlural rawName _) -> do

337− let

316+ let

338− fieldStrName = xmlLocalName rawName

317+ fieldStrName = xmlLocalName rawName

339− fName = TH.mkName (fieldName fieldStrName)

318+ fName = TH.mkName (fieldName fieldStrName)

340− exprFieldStrName = TH.litE (TH.stringL rawName)

319+ exprFieldStrName = TH.litE (TH.stringL rawName)

341− exprForField = case fieldPlural of

320+ exprForField = case fieldPlural of

342− XmlFieldPluralMandatory -> [e|id|]

321+ XmlFieldPluralMandatory -> [e|id|]

343− _ -> [e|traverse|]

322+ _ -> [e|traverse|]

344− exprFieldValue = [e|$(TH.varE fName) $(TH.varE objName)|]

323+ exprFieldValue = [e|$(TH.varE fName) $(TH.varE objName)|]

345− exprFieldRender =

324+ exprFieldRender =

346− [e|(\a ->

325+ [e|(\a ->

347− XW.elementA $exprFieldStrName (toXmlParentAttributes a) a)|]

326+ XW.elementA $exprFieldStrName (toXmlParentAttributes a) a)|]

348− return [e|$exprForField $exprFieldRender $exprFieldValue|]

327+ return [e|$exprForField $exprFieldRender $exprFieldValue|]

349− IsoXmlDescRecordContent (IsoXmlDescContent rawName _) -> do

328+ IsoXmlDescRecordContent (IsoXmlDescContent rawName _) -> do

350− let

329+ let

351− fieldStrName = xmlLocalName rawName

330+ fieldStrName = xmlLocalName rawName

352− fName = TH.mkName (fieldName fieldStrName)

331+ fName = TH.mkName (fieldName fieldStrName)

353− exprFieldValue = [e|$(TH.varE fName) $(TH.varE objName)|]

332+ exprFieldValue = [e|$(TH.varE fName) $(TH.varE objName)|]

354− return [e|XW.content . toXmlAttribute $ $exprFieldValue|]

333+ return [e|XW.content . toXmlAttribute $ $exprFieldValue|]

355− _ -> []

334+ _ -> []

356− toXmlExpr

335+ toXmlExpr

357− = TH.lamE [if null exprFields then TH.wildP else TH.varP objName]

336+ = TH.lamE [if null exprFields then TH.wildP else TH.varP objName]

358− $ foldr (\fe e -> [e|$fe *> $e|]) [e|return ()|] exprFields

337+ $ foldr (\fe e -> [e|$fe *> $e|]) [e|return ()|] exprFields

359− TH.instanceD

338+ TH.instanceD

360− (return [])

339+ (return [])

361− [t|XW.ToXML $(TH.conT name)|]

340+ [t|XW.ToXML $(TH.conT name)|]

362− [funSimple 'XW.toXML toXmlExpr]

341+ [funSimple 'XW.toXML toXmlExpr]

363− genToXmlParentAttributeInst = do

342+

343+ toXmlParentAttributesInst <- do

364− objName <- TH.newName strPrefix

344+ objName <- TH.newName strPrefix

365− let

345+ let

366− exprAttributes = do

346+ exprAttributes = do

367− descRecordPart <- descRecordParts

347+ descRecordPart <- descRecordParts

368− IsoXmlDescAttribute attributePlural attributeStrName _ <-

348+ IsoXmlDescAttribute attributePlural attributeStrName _ <-

369− maybeToList $ case descRecordPart of

349+ maybeToList $ case descRecordPart of

370− IsoXmlDescRecordAttribute descAttribute -> Just descAttribute

350+ IsoXmlDescRecordAttribute descAttribute -> Just descAttribute

371− _ -> Nothing

351+ _ -> Nothing

372− let

352+ let

373− fName = TH.mkName (fieldName attributeStrName)

353+ fName = TH.mkName (fieldName attributeStrName)

374− exprAttrStrName = TH.litE (TH.stringL attributeStrName)

354+ exprAttrStrName = TH.litE (TH.stringL attributeStrName)

375− exprAttrValue = [e|$(TH.varE fName) $(TH.varE objName)|]

355+ exprAttrValue = [e|$(TH.varE fName) $(TH.varE objName)|]

376− exprAttrWrap = case attributePlural of

356+ exprAttrWrap = case attributePlural of

377− XmlAttributePluralMandatory -> [e|Just . toXmlAttribute|]

357+ XmlAttributePluralMandatory -> [e|Just . toXmlAttribute|]

378− XmlAttributePluralOptional -> [e|fmap toXmlAttribute|]

358+ XmlAttributePluralOptional -> [e|fmap toXmlAttribute|]

379− return [e|($exprAttrStrName, $exprAttrWrap $exprAttrValue)|]

359+ return [e|($exprAttrStrName, $exprAttrWrap $exprAttrValue)|]

380− toXmlParentAttributesExpr

360+ toXmlParentAttributesExpr

381− = TH.lamE [if null exprAttributes then TH.wildP else TH.varP objName]

361+ = TH.lamE [if null exprAttributes then TH.wildP else TH.varP objName]

382− $ [e|mapMaybe distribPair $(TH.listE exprAttributes)|]

362+ $ [e|mapMaybe distribPair $(TH.listE exprAttributes)|]

383#if __GLASGOW_HASKELL__ < 800

363#if __GLASGOW_HASKELL__ < 800

384− TH.instanceD

364+ TH.instanceD

385#else

365#else

386− TH.instanceWithOverlapD (Just TH.Overlapping)

366+ TH.instanceWithOverlapD (Just TH.Overlapping)

387#endif

367#endif

388− (return [])

368+ (return [])

389− [t|ToXmlParentAttributes $(TH.conT name)|]

369+ [t|ToXmlParentAttributes $(TH.conT name)|]

390− [funSimple 'toXmlParentAttributes toXmlParentAttributesExpr]

370+ [funSimple 'toXmlParentAttributes toXmlParentAttributesExpr]

391−

371+

392− case genType of

393− Generator -> do

394− toXmlInst <- genToXmlInst

395− toXmlParentAttributesInst <- genToXmlParentAttributeInst

396− return $ [termDecl] ++ lensDecls ++

397− [toXmlInst, toXmlParentAttributesInst, nfDataInst]

398− Parser -> do

399− fromDomInst <- genFromDomInst

400− return $ [termDecl] ++ lensDecls ++ [fromDomInst, nfDataInst]

372+ return $ [termDecl] ++ lensDecls ++

401− Both -> do

402− toXmlInst <- genToXmlInst

403− toXmlParentAttributesInst <- genToXmlParentAttributeInst

404− fromDomInst <- genFromDomInst

405− return $ [termDecl] ++ lensDecls ++

406− [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

373+ [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

407

374

408distribPair :: Functor f => (a, f b) -> f (a, b)

375distribPair :: Functor f => (a, f b) -> f (a, b)

409distribPair (a, fb) = (a,) <$> fb

376distribPair (a, fb) = (a,) <$> fb

test/TestDefs.hs+4−4

@@ -9,11 +9,11 @@ import Data.THGen.XML

9import Test.QuickCheck.Arbitrary.Generic

10import Test.QuickCheck.Instances ()

12−"Bar" =:= enum Both

12+"Bar" =:= enum

13 & "baroque"

14 & "bartender"

16−"Quux" Exhaustive =:= enum Both

16+"Quux" Exhaustive =:= enum

17 & "ALL"

18 & "YOUR"

19 & "BASE"

@@ -22,14 +22,14 @@ import Test.QuickCheck.Instances ()

22 & "TO"

23 & "US"

25−"Foo" =:= record Both

25+"Foo" =:= record

26 ^ "Shmuux" [t|XmlQuux|]

27 + "Bar"

28 ? "Baz" [t|Text|]

29 !% "Quux"

30 ?% "Muux" [t|XmlQuux|]

32−"Root" =:= record Both

32+"Root" =:= record

33 ! "{http://example.com/ns/my-namespace}Foo"

35instance Arbitrary XmlRoot where