@@ -26,6 +26,8 @@ import qualified Text.XML.Writer as XW
2626
2727data GenType = Parser | Generator | Both
2828
29+data GenerateLens = Lens | NoLens
30+
2931data XmlFieldPlural
3032 = XmlFieldPluralMandatory -- Occurs exactly 1 time (Identity)
3133 | XmlFieldPluralOptional -- Occurs 0 or 1 times (Maybe)
@@ -55,7 +57,7 @@ data IsoXmlDescRecordPart
5557 | IsoXmlDescRecordAttribute IsoXmlDescAttribute
5658 | IsoXmlDescRecordContent IsoXmlDescContent
5759
58−data IsoXmlDescRecord = IsoXmlDescRecord GenType [IsoXmlDescRecordPart]
60+data IsoXmlDescRecord = IsoXmlDescRecord GenType GenerateLens [IsoXmlDescRecordPart]
5961
6062makePrisms ''IsoXmlDescRecord
6163
@@ -76,26 +78,34 @@ appendField
7678 -> IsoXmlDescRecord
7779 -> IsoXmlDescPreField
7880 -> IsoXmlDescRecord
79−appendField plural (IsoXmlDescRecord genType fields) (IsoXmlDescPreField name ty) =
80− let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty
81− in IsoXmlDescRecord genType (xfield:fields)
81+appendField
82+ plural
83+ (IsoXmlDescRecord genType generateLens fields)
84+ (IsoXmlDescPreField name ty) =
85+ let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty
86+ in IsoXmlDescRecord genType generateLens (xfield:fields)
8287
8388appendAttribute
8489 :: XmlAttributePlural
8590 -> IsoXmlDescRecord
8691 -> IsoXmlDescPreAttribute
8792 -> IsoXmlDescRecord
88−appendAttribute plural (IsoXmlDescRecord genType fields) (IsoXmlDescPreAttribute name ty) =
89− let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty
90− in IsoXmlDescRecord genType (xattribute:fields)
93+appendAttribute
94+ plural
95+ (IsoXmlDescRecord genType generateLens fields)
96+ (IsoXmlDescPreAttribute name ty) =
97+ let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty
98+ in IsoXmlDescRecord genType generateLens (xattribute:fields)
9199
92100appendContent
93101 :: IsoXmlDescRecord
94102 -> IsoXmlDescPreContent
95103 -> IsoXmlDescRecord
96−appendContent (IsoXmlDescRecord genType fields) (IsoXmlDescPreContent name ty) =
97− let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty
98− in IsoXmlDescRecord genType (xcontent:fields)
104+appendContent
105+ (IsoXmlDescRecord genType generateLens fields)
106+ (IsoXmlDescPreContent name ty) =
107+ let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty
108+ in IsoXmlDescRecord genType generateLens (xcontent:fields)
99109
100110(!), (?), (*), (+) :: IsoXmlDescRecord -> IsoXmlDescPreField -> IsoXmlDescRecord
101111(!) = appendField XmlFieldPluralMandatory
@@ -133,11 +143,11 @@ class Description name desc | desc -> name where
133143infix 0 =:=
134144
135145instance Description PrefixName IsoXmlDescRecord where
136− prefixName =:= (IsoXmlDescRecord genType descRecordParts) =
137− isoXmlGenerateDatatype genType prefixName (reverse descRecordParts)
146+ prefixName =:= (IsoXmlDescRecord genType generateLens descRecordParts) =
147+ isoXmlGenerateDatatype genType generateLens prefixName (reverse descRecordParts)
138148
139−record :: GenType -> IsoXmlDescRecord
140−record gt = IsoXmlDescRecord gt []
149+record :: GenType -> GenerateLens -> IsoXmlDescRecord
150+record gt gl = IsoXmlDescRecord gt gl []
141151
142152enum :: GenType -> IsoXmlDescEnum
143153enum gt = IsoXmlDescEnum gt []
@@ -238,8 +248,17 @@ isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do
238248 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,
239249 fromDomInst, fromAttributeInst]
240250
241−isoXmlGenerateDatatype :: GenType -> PrefixName -> [IsoXmlDescRecordPart] -> TH.DecsQ
242−isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts = do
251+isoXmlGenerateDatatype
252+ :: GenType
253+ -> GenerateLens
254+ -> PrefixName
255+ -> [IsoXmlDescRecordPart]
256+ -> TH.DecsQ
257+isoXmlGenerateDatatype
258+ genType
259+ generateLens
260+ (PrefixName strName' strPrefix')
261+ descRecordParts = do
243262 let
244263 isNewtype = length descRecordParts == 1
245264 strName = "Xml" ++ strName'