@@ -24,8 +24,26 @@ import Text.XML.ParentAttributes
2424import qualified Text.XML.Writer as XW
2525
2626
27+-- | Marks the type of code generation:
28+-- Parser - generate only instances for xml parsing (@FromDom@)
29+-- Generator - generate only @ToXML@ instances
30+-- Both - generate @FromDom@ and @ToXML@ instances
2731data GenType = Parser | Generator | Both
2832
33+{- | Marks the style of code generation regarding records fields
34+@LensRenaming@ - fields get renamed by prefixing the field name with
35+'_' and lowercased capital letter used in the type name.
36+e.g. for
37+
38+> "MyNewDataType" =:= record genType LensRenaming
39+> * "field1"
40+
41+field will be renamed to `_mndtField1` and lens `mndtField1` will be created.
42+
43+@NoLens@ - no field renaming and no lens generation.
44+-}
45+data GenerateLens = LensRenaming | NoLens
46+
2947data XmlFieldPlural
3048 = XmlFieldPluralMandatory -- Occurs exactly 1 time (Identity)
3149 | XmlFieldPluralOptional -- Occurs 0 or 1 times (Maybe)
@@ -55,7 +73,7 @@ data IsoXmlDescRecordPart
5573 | IsoXmlDescRecordAttribute IsoXmlDescAttribute
5674 | IsoXmlDescRecordContent IsoXmlDescContent
5775
58−data IsoXmlDescRecord = IsoXmlDescRecord GenType [IsoXmlDescRecordPart]
76+data IsoXmlDescRecord = IsoXmlDescRecord GenType GenerateLens [IsoXmlDescRecordPart]
5977
6078makePrisms ''IsoXmlDescRecord
6179
@@ -76,26 +94,34 @@ appendField
7694 -> IsoXmlDescRecord
7795 -> IsoXmlDescPreField
7896 -> IsoXmlDescRecord
79−appendField plural (IsoXmlDescRecord genType fields) (IsoXmlDescPreField name ty) =
80− let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty
81− in IsoXmlDescRecord genType (xfield:fields)
97+appendField
98+ plural
99+ (IsoXmlDescRecord genType generateLens fields)
100+ (IsoXmlDescPreField name ty) =
101+ let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty
102+ in IsoXmlDescRecord genType generateLens (xfield:fields)
82103
83104appendAttribute
84105 :: XmlAttributePlural
85106 -> IsoXmlDescRecord
86107 -> IsoXmlDescPreAttribute
87108 -> IsoXmlDescRecord
88−appendAttribute plural (IsoXmlDescRecord genType fields) (IsoXmlDescPreAttribute name ty) =
89− let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty
90− in IsoXmlDescRecord genType (xattribute:fields)
109+appendAttribute
110+ plural
111+ (IsoXmlDescRecord genType generateLens fields)
112+ (IsoXmlDescPreAttribute name ty) =
113+ let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty
114+ in IsoXmlDescRecord genType generateLens (xattribute:fields)
91115
92116appendContent
93117 :: IsoXmlDescRecord
94118 -> IsoXmlDescPreContent
95119 -> IsoXmlDescRecord
96−appendContent (IsoXmlDescRecord genType fields) (IsoXmlDescPreContent name ty) =
97− let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty
98− in IsoXmlDescRecord genType (xcontent:fields)
120+appendContent
121+ (IsoXmlDescRecord genType generateLens fields)
122+ (IsoXmlDescPreContent name ty) =
123+ let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty
124+ in IsoXmlDescRecord genType generateLens (xcontent:fields)
99125
100126(!), (?), (*), (+) :: IsoXmlDescRecord -> IsoXmlDescPreField -> IsoXmlDescRecord
101127(!) = appendField XmlFieldPluralMandatory
@@ -133,11 +159,11 @@ class Description name desc | desc -> name where
133159infix 0 =:=
134160
135161instance Description PrefixName IsoXmlDescRecord where
136− prefixName =:= (IsoXmlDescRecord genType descRecordParts) =
137− isoXmlGenerateDatatype genType prefixName (reverse descRecordParts)
162+ prefixName =:= (IsoXmlDescRecord genType generateLens descRecordParts) =
163+ isoXmlGenerateDatatype genType generateLens prefixName (reverse descRecordParts)
138164
139−record :: GenType -> IsoXmlDescRecord
140−record gt = IsoXmlDescRecord gt []
165+record :: GenType -> GenerateLens -> IsoXmlDescRecord
166+record gt gl = IsoXmlDescRecord gt gl []
141167
142168enum :: GenType -> IsoXmlDescEnum
143169enum gt = IsoXmlDescEnum gt []
@@ -238,14 +264,25 @@ isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do
238264 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,
239265 fromDomInst, fromAttributeInst]
240266
241−isoXmlGenerateDatatype :: GenType -> PrefixName -> [IsoXmlDescRecordPart] -> TH.DecsQ
242−isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts = do
267+isoXmlGenerateDatatype
268+ :: GenType
269+ -> GenerateLens
270+ -> PrefixName
271+ -> [IsoXmlDescRecordPart]
272+ -> TH.DecsQ
273+isoXmlGenerateDatatype
274+ genType
275+ generateLens
276+ (PrefixName strName' strPrefix')
277+ descRecordParts = do
243278 let
244279 isNewtype = length descRecordParts == 1
245280 strName = "Xml" ++ strName'
246281 strPrefix = "x" ++ strPrefix'
247282 name = TH.mkName strName
248− fieldName str = "_" ++ strPrefix ++ over _head C.toUpper str
283+ fieldName str = case generateLens of
284+ LensRenaming -> "_" ++ strPrefix ++ over _head C.toUpper str
285+ NoLens -> str
249286 termDecl <- do
250287 let
251288 fields = do