master..987ed57 · typeable/xml-isogen

git.iko.soy/typeable/xml-isogen

17 files changed+98−510

unifiedsplit

.gitignore−5 CHANGELOG.md−5 README.md+1−284 ghc-802.yaml−4 ghc-822.yaml−4 ghc-844.yaml−4 shell.nix−17 src/Data/THGen/Orphans.hs−11 src/Data/THGen/XML.hs+8−7 src/Data/THGen/XML/Internal.hs+76−77 src/Text/XML/Nillable.hs−41 stack-10.0.yaml−8 stack-18.18.yaml−9 stack-19.6.yaml−9 stack.yaml+3−8 test/TestDefs.hs+9−9 xml-isogen.cabal+1−8

.gitignore−5

@@ -3,8 +3,3 @@ dist

33.stack-work

44.cabal-sandbox/

55cabal.sandbox.config

6−dist-newstyle/

7−default.nix

8−# vim backup and swap files

9−*~

10−.*.swp

CHANGELOG.md−5

@@ -1,11 +1,6 @@

11HEAD

22------

4−* Add lenient parsers support (#29)

5−* Rename Both to ParserAndGenerator (#27)

6−* Add Nillable newtype (#24)

7−* Include digits in the auto-gerenated prefix (#22)

8−

940.3.0

105------

116

README.md+1−284

@@ -6,287 +6,4 @@ TemplateHaskell generators for XML-isomorphic data types, including

66instances for parsing and rendering. A convenient DSL to define those

77types.

9−Essentially it's a haskell DSL which allows its users to generate XML parsers and generators for haskell datatypes.

10−See also [xsd-isogen](https://github.com/typeable/xsd-isogen)

11−

12−## Tutorial

13−

14−Lets go through series of examples. First things first:

15−

16−```haskell

17−{-# LANGUAGE TemplateHaskell #-}

18−{-# LANGUAGE OverloadedStrings #-}

19−{-# LANGUAGE DeriveGeneric #-}

20−

21−module Tutorial

22−where

23−

24−import Prelude hiding ((^))

25−import Control.DeepSeq -- from deepseq

26−import Data.Text

27−import Data.THGen.XML -- from xml-isogen

28−import Text.XML.Writer -- from xml-conduit-writer

29−import Text.XML.DOM.Parser -- from dom-parser

30−```

31−

32−### Records

33−

34−Lets say we want to parse and/or generate an XML file of the following form:

35−

36−```XML

37−<?xml version="1.0" encoding="UTF-8"?>

38−<person>

39− <name>

40− John

41− </name>

42− <email>

43− john@example.com

44− </email>

45−</person>

46−```

47−

48−Person has a name and an email, and email could be omitted. With `xml-isogen` it's

49−enough to write the following definition:

50−

51−```haskell

52−"Person" =:= record ParserAndGenerator

53− ! "name" [t|Text|]

54− ? "email" [t|Text|]

55−```

56−

57−At this point you can load the module into `ghci` and check what was generated for us

58−so far:

59−

60−```

61−*Tutorial> :browse

62−data XmlPerson

63− = XmlPerson {_xpName :: !Text, _xpEmail :: !(Maybe Text)}

64−xpEmail ::

65− lens-4.18.1:Control.Lens.Type.Lens' XmlPerson (Maybe Text)

66−xpName :: lens-4.18.1:Control.Lens.Type.Lens' XmlPerson Text

67−```

68−

69−We have a data type `XmlPerson` with two fields and two lenses. Note that the

70−fields have a prefix built of an underscore and all upper case characters

71−and digits of the type name.

72−

73−

74−Lets take a closer look at `XmlPerson`:

75−

76−```

77−*Tutorial> :i XmlPerson

78−data XmlPerson

79− = XmlPerson {_xpName :: !Text, _xpEmail :: !(Maybe Text)}

80− -- Defined at Tutorial.hs:13:1

81−instance Show XmlPerson -- Defined at Tutorial.hs:13:1

82−instance Eq XmlPerson -- Defined at Tutorial.hs:13:1

83−instance FromDom XmlPerson -- Defined at Tutorial.hs:13:1

84−instance ToXML XmlPerson -- Defined at Tutorial.hs:13:1

85−

86−```

87−

88−We have

89−[FromDom](https://hackage.haskell.org/package/dom-parser-3.1.0/docs/Text-XML-DOM-Parser-FromDom.html#t:FromDom)

90−and

91−[ToXML](https://hackage.haskell.org/package/xml-conduit-writer-0.1.1.2/docs/Text-XML-Writer.html#t:ToXML)

92−instance generated for us. That's because

93−we instructed `xml-isogen` to generate them using the `ParserAndGenerator` noun. You can specify

94−also `Parser` or `Generator` if you want only one of them.

95−

96−The `_xpEmail` field is optional; that's because we prefixed it with `?` modifier.

97−Here is the list of possible modifiers that affect types:

98−

99−Modifier | Description | Generated Type

100−--- | --- | ---

101−`!` | required | `a`

102−`?` | optional | `Maybe a`

103−`*` | repeated | `[a]`

104−`+` | nonempty | `NonEmpty a`

105−

106−### Supported types

107−

108−Fields in a record may have any types as long as they are instances of `Eq`, `Show`,

109−`NFData`, `FromDom` (for the parser) and `ToXml` (for the generator). Remember

110−though that TemplateHaskell requires types to be available before they are used

111−in a splice.

112−

113−You can omit field types altogether, in that case the type will be assumed to be a

114−capitalized field name with an `Xml` prefix.

115−It's your responsibility to make sure that type exists.

116−Example:

117−

118−```haskell

119−newtype XmlEmail = XmlEmail Text

120− deriving (Eq, Show, NFData, ToXML)

121−

122−instance FromDom XmlEmail where

123− fromDom = XmlEmail <$> fromDom

124−

125−"Example1" =:= record Parser

126− ! "email" -- will have type XmlEmail

127−```

128−

129−### Enumerations

130−

131−Often XML element can contain only limited number of possible values. Lets define

132−a type `Status` that can have only values `Active`, `Pending` or `Deleted`:

133−

134−```haskell

135−"Status" =:= enum ParserAndGenerator

136− & "Active"

137− & "Pending"

138− & "Deleted"

139−```

140−

141−This definition will generate the following type for us:

142−

143−```haskell

144−data XmlStatus

145− = XmlStatusActive

146− | XmlStatusPending

147− | XmlStatusDeleted

148− | UnknownXmlStatus !String

149−```

150−

151−It has all the necessary instances, so you can use it as a type for a field.

152−

153−### Append content

154−

155−Sometimes the XML you are dealing with contains a mix of elements and immediate

156−content. Something like the following:

157−

158−```XML

159−<?xml version="1.0" encoding="UTF-8"?>

160−<example>

161− <field1>

162− I am

163− </field1>

164− totally

165− <field2>

166− weird

167− </field2>

168−</example>

169−```

170−

171−You can model this with an "append content" modifier `^`. It will instruct

172−`xml-isogen` to append content of the field as it is, without wrapping it

173−into an XML element. For our case it may look like this:

174−

175−```haskell

176−"Example2" =:= record ParserAndGenerator

177− ! "field1" [t|Text|]

178− ^ "mixed" [t|Text|]

179− ! "field2" [t|Text|]

180−```

181−

182−After parsing the XML above, we'll get the following:

183−

184−```haskell

185−XmlExample2 {_xe2Field1 = "I am", _xe2Mixed = "totally", _xe2Field2 = "weird"}

186−```

187−

188−### Attributes

189−

190−`xml-isogen` also supports XML attributes using `!%` and `?%` modifiers:

191−

192−```haskell

193−"Example3" =:= record ParserAndGenerator

194− ! "field1" [t|Text|]

195− !% "attribute1" [t|Text|]

196− ?% "attribute2" [t|Text|]

197−

198−"Body" =:= record ParserAndGenerator

199− ! "root" [t|XmlExample3|]

200−```

201−

202−The following two types will be generated:

203−

204−```haskell

205−data XmlExample3

206− = XmlExample3 {_xe3Field1 :: !Text,

207− _xe3Attribute1 :: !Text,

208− _xe3Attribute2 :: !(Maybe Text)}

209−

210−newtype XmlBody = XmlBody {_xbRoot :: XmlExample3}

211−```

212−

213−The `_xe3Attribute2` is optional because we used `?%` modifier. Attributes will be

214−attached to parent XML element. Here is an example of the generated XML file:

215−

216−```XML

217−<root attribute1="world">

218− <field1>

219− hello

220− </field1>

221−</root>

222−```

223−

224−Note that attributes are attached to the parent XML element, that's why we needed

225−`XmlBody` type here.

226−

227−And here is what you get after parsing the XML:

228−

229−```haskell

230−XmlExample3 {_xe3Field1 = "hello", _xe3Attribute1 = "world", _xe3Attribute2 = Nothing}

231−```

232−

233−### Namespaces

234−

235−Often XSD schema requires XML elements to be qualified with a namespace. To instruct

236−`xml-isogen` to qualify fields, specify namespace is a curly brackets:

237−

238−```haskell

239−"Example4" =:= record ParserAndGenerator

240− ! "field1" [t|Text|]

241− ! "{http://example.com/1}field2" [t|Text|]

242− ! "{http://example.com/2}field3" [t|Text|]

243−```

244−

245−Here is the generated XML:

246−

247−```XML

248−<field1>

249− hello

250−</field1>

251−<field2 xmlns="http://example.com/1">

252− world

253−</field2>

254−<field3 xmlns="http://example.com/2">

255− !

256−</field3>

257−```

258−

259−### Nillable types

260−

261−Sometimes optional element in XML are encoded using `nil="true"` attribute instead of

262−omitting the element. (The `nil` attribute comes from `http://www.w3.org/2001/XMLSchema-instance` namespace). With `xml-isogen` you handle it using the `Nillable` type:

263−

264−```haskell

265−"Example5" =:= record ParserAndGenerator

266− ! "field" [t|Nillable Text|]

267−```

268−

269−If the field contains the value `Nothing`, like this

270−

271−```haskell

272−XmlExample5 { _xe5Field = Nillable Nothing}

273−```

274−

275−then the following XML will be generated:

276−

277−```XML

278−<field

279− xmlns:ns="http://www.w3.org/2001/XMLSchema-instance"

280− ns:nil="true"

281−/>

282−```

283−

284−## Development

285−

286−To start working with `xml-isogen` using nix use:

287−

288−```

289−nix-shell --packages cabal2nix --run "cabal2nix ." > default.nix

290−nix-shell

291−cabal v2-build

292−```

9+This is similar to XSD but is Haskell-specific.

ghc-802.yaml−4

@@ -1,7 +1,3 @@

1−nix:

2− packages:

3− - zlib

4−

51resolver: lts-9.21

73packages:

ghc-822.yaml−4

@@ -1,5 +1 @@

1−nix:

2− packages:

3− - zlib

4−

51resolver: lts-11.22

ghc-844.yaml−4

@@ -1,7 +1,3 @@

1−nix:

2− packages:

3− - zlib

4−

51resolver: lts-12.16

62extra-deps:

73- dom-parser-3.1.0

shell.nixdeleted−17

@@ -1,17 +0,0 @@

1−{ nixpkgs ? import <nixpkgs> {}, compiler ? "default" }:

2−

3−let

4−

5− inherit (nixpkgs) pkgs;

6−

7− f = import ./default.nix;

8−

9− haskellPackages = if compiler == "default"

10− then pkgs.haskellPackages

11− else pkgs.haskell.packages.${compiler};

12−

13− drv = haskellPackages.callPackage f {};

14−

15−in

16−

17− if pkgs.lib.inNixShell then drv.env else drv

src/Data/THGen/Orphans.hsdeleted−11

@@ -1,11 +0,0 @@

1−{-# OPTIONS_GHC -fno-warn-orphans #-}

2−

3−module Data.THGen.Orphans

4−where

5−

6−import Data.Scientific

7−import qualified Data.Text as Text

8−import Text.XML.Writer

9−

10−instance ToXML Scientific where

11− toXML = content . Text.pack . formatScientific Fixed Nothing

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

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

2222

2323Example 1.

2424

25−> "Color" =:= enum ParserAndGenerator

25+> "Color" =:= enum Both

2626> & "R"

2727> & "G"

2828> & "B"

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

4040

4141Example 2.

4242

43−> "Message" =:= record ParserAndGenerator

43+> "Message" =:= record Both Lens

4444> ! "author"

4545> + "recipient"

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

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

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

7979name. You can override it manually like so:

8080

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

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

8282> ...

8383

84+Second argument to @record@ either enabled lens generation for records fields

85+or disables it for use with DuplicateRecordFields and, possibly, generic-lens.

86+

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

8588in the XML tag, prefixed by its repetition kind:

8689

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

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

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

9598

96−> "Message" =:= record ParserAndGenerator

99+> "Message" =:= record Both NoLens

97100> ! "author" [t|Person|].

98101> ...

99102

@@ -109,6 +112,7 @@ module Data.THGen.XML

109112 , PrefixName(..)

110113 , ExhaustivenessName(..)

111114 , GenType(..)

115+ , GenerateLens(..)

112116 , record

113117 , enum

114118 , (!)

@@ -124,12 +128,9 @@ module Data.THGen.XML

124128 , Text

125129 , P.Int

126130 , P.Integer

127− , Nillable(..)

128131 ) where

129132

130133import Data.THGen.Enum

131−import Data.THGen.Orphans ()

132134import Data.THGen.XML.Internal

133135import Data.Text

134−import Text.XML.Nillable

135136import qualified Prelude as P

src/Data/THGen/XML/Internal.hs+76−77

@@ -5,7 +5,7 @@

55module Data.THGen.XML.Internal where

77import Control.DeepSeq

8−import Control.Lens hiding (repeated, enum, (&), Strict)

8+import Control.Lens hiding (repeated, enum, (&))

99import Control.Lens.Internal.FieldTH (makeFieldOpticsForDec)

1010import qualified Data.Char as C

1111import Data.List.NonEmpty (NonEmpty)

@@ -15,7 +15,7 @@ import Data.THGen.Compat as THC

1515import Data.THGen.Enum

1616import qualified Data.Text as T

1717import GHC.Generics (Generic)

18−import Language.Haskell.TH as TH hiding (Strict)

18+import Language.Haskell.TH as TH

1919import Prelude hiding ((+), (*), (^))

2020import qualified Text.XML as X

2121import Text.XML.DOM.Parser hiding (parseContent)

@@ -23,22 +23,27 @@ import Text.XML.DOM.Parser.Internal.Content

2323import Text.XML.ParentAttributes

2424import qualified Text.XML.Writer as XW

2525

26−data ParserMode

27− = Strict

28− | Lenient

2926

30−data GenType

31− = Parser

32− | Generator

33− | ParserAndGenerator

34− | LenientParser

35− | LenientParserAndGenerator

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

31+-}

32+data GenType = Parser | Generator | Both

3633

37−isLenientType :: GenType -> Bool

38−isLenientType = \case

39− LenientParser -> True

40− LenientParserAndGenerator -> True

41− _ -> False

34+{- | Marks the style of code generation regarding records fields

35+@LensRenaming@ - fields get renamed by prefixing the field name with

36+'_' and lowercased capital letter used in the type name.

37+e.g. for

38+

39+> "MyNewDataType" =:= record genType LensRenaming

40+> * "field1"

41+

42+field will be renamed to `_mndtField1` and lens `mndtField1` will be created.

43+

44+@NoLens@ - no field renaming and no lens generation.

45+-}

46+data GenerateLens = LensRenaming | NoLens

4247

4348data XmlFieldPlural

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

@@ -69,7 +74,7 @@ data IsoXmlDescRecordPart

6974 | IsoXmlDescRecordAttribute IsoXmlDescAttribute

7075 | IsoXmlDescRecordContent IsoXmlDescContent

7176

72−data IsoXmlDescRecord = IsoXmlDescRecord GenType [IsoXmlDescRecordPart]

77+data IsoXmlDescRecord = IsoXmlDescRecord GenType GenerateLens [IsoXmlDescRecordPart]

7378

7479makePrisms ''IsoXmlDescRecord

7580

@@ -90,26 +95,34 @@ appendField

9095 -> IsoXmlDescRecord

9196 -> IsoXmlDescPreField

9297 -> IsoXmlDescRecord

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

94− let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty

95− in IsoXmlDescRecord genType (xfield:fields)

98+appendField

99+ plural

100+ (IsoXmlDescRecord genType generateLens fields)

101+ (IsoXmlDescPreField name ty) =

102+ let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty

103+ in IsoXmlDescRecord genType generateLens (xfield:fields)

96104

97105appendAttribute

98106 :: XmlAttributePlural

99107 -> IsoXmlDescRecord

100108 -> IsoXmlDescPreAttribute

101109 -> IsoXmlDescRecord

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

103− let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty

104− in IsoXmlDescRecord genType (xattribute:fields)

110+appendAttribute

111+ plural

112+ (IsoXmlDescRecord genType generateLens fields)

113+ (IsoXmlDescPreAttribute name ty) =

114+ let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty

115+ in IsoXmlDescRecord genType generateLens (xattribute:fields)

105116

106117appendContent

107118 :: IsoXmlDescRecord

108119 -> IsoXmlDescPreContent

109120 -> IsoXmlDescRecord

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

111− let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty

112− in IsoXmlDescRecord genType (xcontent:fields)

121+appendContent

122+ (IsoXmlDescRecord genType generateLens fields)

123+ (IsoXmlDescPreContent name ty) =

124+ let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty

125+ in IsoXmlDescRecord genType generateLens (xcontent:fields)

113126

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

115128(!) = appendField XmlFieldPluralMandatory

@@ -147,11 +160,11 @@ class Description name desc | desc -> name where

147160infix 0 =:=

148161

149162instance Description PrefixName IsoXmlDescRecord where

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

151− isoXmlGenerateDatatype genType prefixName (reverse descRecordParts)

163+ prefixName =:= (IsoXmlDescRecord genType generateLens descRecordParts) =

164+ isoXmlGenerateDatatype genType generateLens prefixName (reverse descRecordParts)

152165

153−record :: GenType -> IsoXmlDescRecord

154−record gt = IsoXmlDescRecord gt []

166+record :: GenType -> GenerateLens -> IsoXmlDescRecord

167+record gt gl = IsoXmlDescRecord gt gl []

155168

156169enum :: GenType -> IsoXmlDescEnum

157170enum gt = IsoXmlDescEnum gt []

@@ -160,7 +173,7 @@ instance Description ExhaustivenessName IsoXmlDescEnum where

160173 exhaustivenessName =:= (IsoXmlDescEnum genType descEnumCons) =

161174 isoXmlGenerateEnum genType exhaustivenessName (reverse descEnumCons)

162175

163−instance (m ~ Q) => IsString (m TH.Type -> IsoXmlDescPreField) where

176+instance IsString (TH.TypeQ -> IsoXmlDescPreField) where

164177 fromString = IsoXmlDescPreField

165178

166179instance IsString IsoXmlDescPreField where

@@ -168,10 +181,10 @@ instance IsString IsoXmlDescPreField where

168181 where

169182 ty = (TH.conT . TH.mkName) ("Xml" ++ over _head C.toUpper (xmlLocalName name))

170183

171−instance (m ~ Q) => IsString (m TH.Type -> IsoXmlDescPreAttribute) where

184+instance IsString (TH.TypeQ -> IsoXmlDescPreAttribute) where

172185 fromString = IsoXmlDescPreAttribute

173186

174−instance (m ~ Q) => IsString (m Type -> IsoXmlDescPreContent) where

187+instance IsString (TH.TypeQ -> IsoXmlDescPreContent) where

175188 fromString = IsoXmlDescPreContent

176189

177190instance IsString IsoXmlDescPreAttribute where

@@ -197,7 +210,7 @@ instance IsString ExhaustivenessName where

197210 fromString strName = ExhaustivenessName strName NonExhaustive

198211

199212makeNamePrefix :: String -> String

200−makeNamePrefix = map C.toLower . filter (\c -> C.isUpper c || C.isDigit c)

213+makeNamePrefix = map C.toLower . filter C.isUpper

201214

202215funSimple :: TH.Name -> TH.ExpQ -> TH.DecQ

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

@@ -225,14 +238,11 @@ isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do

225238 (return [])

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

227240 [funSimple 'toXmlAttribute [e|T.pack . show|]]

228− genFromDomInst mode = do

241+ genFromDomInst = do

229242 TH.instanceD

230243 (return [])

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

232− [case mode of

233− Strict -> funSimple 'fromDom [e|parseContent readContent|]

234− Lenient -> funSimple 'fromDom [e|ignoreBlank $ parseContent readContent|]

235− ]

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

236246 genFromAttributeInst = do

237247 TH.instanceD

238248 (return [])

@@ -244,36 +254,36 @@ isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do

244254 toXmlAttributeInst <- genToXmlAttributeInst

245255 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]

246256 Parser -> do

247− fromDomInst <- genFromDomInst Strict

257+ fromDomInst <- genFromDomInst

248258 fromAttributeInst <- genFromAttributeInst

249259 return $ enumDecls ++ [fromDomInst, fromAttributeInst]

250− LenientParser -> do

251− fromDomInst <- genFromDomInst Lenient

252− fromAttributeInst <- genFromAttributeInst

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

254− ParserAndGenerator -> do

260+ Both -> do

255261 toXmlInst <- genToXmlInst

256262 toXmlAttributeInst <- genToXmlAttributeInst

257− fromDomInst <- genFromDomInst Strict

258− fromAttributeInst <- genFromAttributeInst

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

260− fromDomInst, fromAttributeInst]

261− LenientParserAndGenerator -> do

262− toXmlInst <- genToXmlInst

263− toXmlAttributeInst <- genToXmlAttributeInst

264− fromDomInst <- genFromDomInst Lenient

263+ fromDomInst <- genFromDomInst

265264 fromAttributeInst <- genFromAttributeInst

266265 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,

267266 fromDomInst, fromAttributeInst]

268267

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

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

268+isoXmlGenerateDatatype

269+ :: GenType

270+ -> GenerateLens

271+ -> PrefixName

272+ -> [IsoXmlDescRecordPart]

273+ -> TH.DecsQ

274+isoXmlGenerateDatatype

275+ genType

276+ generateLens

277+ (PrefixName strName' strPrefix')

278+ descRecordParts = do

271279 let

272280 isNewtype = length descRecordParts == 1

273281 strName = "Xml" ++ strName'

274282 strPrefix = "x" ++ strPrefix'

275283 name = TH.mkName strName

276− fieldName str = "_" ++ strPrefix ++ over _head C.toUpper str

284+ fieldName str = case generateLens of

285+ LensRenaming -> "_" ++ strPrefix ++ over _head C.toUpper str

286+ NoLens -> str

277287 termDecl <- do

278288 let

279289 fields = do

@@ -284,14 +294,11 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts

284294 IsoXmlDescField fieldPlural rawName fieldType = descField

285295 fieldStrName = xmlLocalName rawName

286296 fName = TH.mkName (fieldName fieldStrName)

287− fType' = case fieldPlural of

297+ fType = case fieldPlural of

288298 XmlFieldPluralMandatory -> fieldType

289299 XmlFieldPluralOptional -> [t| Maybe $fieldType |]

290300 XmlFieldPluralRepeated -> [t| [$fieldType] |]

291301 XmlFieldPluralMultiplied -> [t| NonEmpty $fieldType |]

292− fType = if isLenientType genType

293− then [t| Maybe $fType' |]

294− else fType'

295302 in if isNewtype

296303 then THC.varStrictType fName (THC.nonStrictType fType)

297304 else THC.varStrictType fName (THC.strictType fType)

@@ -318,7 +325,9 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts

318325 -- generate a newtype instead to do less allocations later

319326 then THC.newtypeD name (TH.recC name fields) [''Eq, ''Show, ''Generic]

320327 else THC.dataD name [TH.recC name fields] [''Eq, ''Show, ''Generic]

321− lensDecls <- makeFieldOpticsForDec lensRules termDecl

328+ lensDecls <- case generateLens of

329+ NoLens -> pure []

330+ LensRenaming -> makeFieldOpticsForDec lensRules termDecl

322331 nfDataInst <- do

323332 TH.instanceD

324333 (return [])

@@ -326,7 +335,7 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts

326335 [ ]

327336

328337 let

329− genFromDomInst mode = do

338+ genFromDomInst = do

330339 let

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

332341 exprRecordParts = do

@@ -340,9 +349,8 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts

340349 fieldParse = case fieldPlural of

341350 XmlFieldPluralMandatory -> [e|inElem|]

342351 _ -> [e|inElemTrav|]

343− in case mode of

344− Strict -> [e|$fieldParse $exprFieldStrName fromDom|]

345− Lenient -> [e|$fieldParse $exprFieldStrName (ignoreBlank fromDom)|]

352+ in

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

346354 IsoXmlDescRecordAttribute descAttribute ->

347355 let

348356 IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute

@@ -428,21 +436,12 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts

428436 return $ [termDecl] ++ lensDecls ++

429437 [toXmlInst, toXmlParentAttributesInst, nfDataInst]

430438 Parser -> do

431− fromDomInst <- genFromDomInst Strict

439+ fromDomInst <- genFromDomInst

432440 return $ [termDecl] ++ lensDecls ++ [fromDomInst, nfDataInst]

433− LenientParser -> do

434− fromDomInst <- genFromDomInst Lenient

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

436− ParserAndGenerator -> do

437− toXmlInst <- genToXmlInst

438− toXmlParentAttributesInst <- genToXmlParentAttributeInst

439− fromDomInst <- genFromDomInst Strict

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

441− [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

442− LenientParserAndGenerator -> do

441+ Both -> do

443442 toXmlInst <- genToXmlInst

444443 toXmlParentAttributesInst <- genToXmlParentAttributeInst

445− fromDomInst <- genFromDomInst Lenient

444+ fromDomInst <- genFromDomInst

446445 return $ [termDecl] ++ lensDecls ++

447446 [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

448447

src/Text/XML/Nillable.hsdeleted−41

@@ -1,41 +0,0 @@

1−{-# LANGUAGE MonoLocalBinds #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−

4−module Text.XML.Nillable where

5−

6−import Control.DeepSeq

7−import Control.Lens

8−import Text.XML.DOM.Parser

9−import Text.XML.ParentAttributes

10−import Text.XML.Writer

11−

12−-- | Type that can have explicit null value

13−--

14−-- Null value is indicated by "nil"="true" attribute.

15−newtype Nillable a = Nillable (Maybe a)

16− deriving

17− ( Eq, Show, Ord, Read, NFData, ToXML

18− , Functor, Applicative, Monad, Foldable, Traversable)

19−

20−_Nillable :: Prism' (Nillable a) a

21−_Nillable = coerced . _Just

22−

23−nNill :: Nillable a

24−nNill = Nillable Nothing

25−

26−nJust :: a -> Nillable a

27−nJust = Nillable . Just

28−

29−instance ToXmlParentAttributes a => ToXmlParentAttributes (Nillable a) where

30− toXmlParentAttributes (Nillable Nothing) =

31− [("{http://www.w3.org/2001/XMLSchema-instance}nil", "true")]

32− toXmlParentAttributes (Nillable (Just a)) = toXmlParentAttributes a

33−

34−instance FromDom a => FromDom (Nillable a) where

35− fromDom = do

36− nil <- parseAttributeMaybe

37− (matchName "{http://www.w3.org/2001/XMLSchema-instance}nil")

38− Right

39− case nil of

40− Just "true" -> return (Nillable Nothing)

41− _ -> Nillable . Just <$> fromDom

stack-10.0.yamldeleted−8

@@ -1,8 +0,0 @@

1−nix:

2− packages:

3− - zlib

4−

5−resolver: lts-10.0

6−extra-deps:

7−- dom-parser-3.0.0

8−- generic-arbitrary-0.1.0

stack-18.18.yamldeleted−9

@@ -1,9 +0,0 @@

1−nix:

2− packages:

3− - zlib

4−

5−resolver: lts-18.18

6−extra-deps:

7−- git: https://github.com/typeable/dom-parser.git

8− commit: 7d556ba528bfa216e99714f8a0d4d00f452803a9

9−- xml-lens-0.3.1

stack-19.6.yamldeleted−9

@@ -1,9 +0,0 @@

1−nix:

2− packages:

3− - zlib

4−

5−resolver: lts-19.6

6−extra-deps:

7−- git: https://github.com/typeable/dom-parser.git

8− commit: 7d556ba528bfa216e99714f8a0d4d00f452803a9

9−- xml-lens-0.3.1

stack.yaml+3−8

@@ -1,9 +1,4 @@

1−nix:

2− packages:

3− - zlib

4−

5−resolver: lts-20.16

1+resolver: lts-10.0

62extra-deps:

7− - git: https://github.com/typeable/dom-parser.git

8− commit: 7d556ba528bfa216e99714f8a0d4d00f452803a9

9− - xml-lens-0.3.1

3+- dom-parser-3.0.0

4+- generic-arbitrary-0.1.0

test/TestDefs.hs+9−9

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

99import Test.QuickCheck.Arbitrary.Generic

1010import Test.QuickCheck.Instances ()

1111

12−"Bar" =:= enum ParserAndGenerator

12+"Bar" =:= enum Both

1313 & "baroque"

1414 & "bartender"

1515

16−"Quux" Exhaustive =:= enum ParserAndGenerator

16+"Quux" Exhaustive =:= enum Both

1717 & "ALL"

1818 & "YOUR"

1919 & "BASE"

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

2222 & "TO"

2323 & "US"

2424

25−"Foo" =:= record ParserAndGenerator

26− ^ "Shmuux" [t|XmlQuux|]

27− + "Bar"

28− ? "Baz" [t|Text|]

29− !% "Quux"

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

25+"Foo" =:= record Both NoLens

26+ ^ "shmuux" [t|XmlQuux|]

27+ + "bar"

28+ ? "baz" [t|Text|]

29+ !% "quux"

30+ ?% "muux" [t|XmlQuux|]

3131

32−"Root" =:= record ParserAndGenerator

32+"Root" =:= record Both LensRenaming

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

3434

3535instance Arbitrary XmlRoot where

xml-isogen.cabal+1−8

@@ -1,5 +1,5 @@

11name: xml-isogen

2−version: 0.3.2

2+version: 0.3.1

33synopsis: Generate XML-isomorphic types

44description:

55 TemplateHaskell generators for XML-isomorphic data types, including

@@ -32,9 +32,7 @@ library

3232 , Data.THGen.XML

3333 , Data.THGen.XML.Internal

3434 , Text.XML.ParentAttributes

35− , Text.XML.Nillable

3635 other-modules: Data.THGen.Compat

37− , Data.THGen.Orphans

3836 , Text.XML.DOM.Parser.Internal.Content

3937 build-depends: QuickCheck >= 2.8

4038 , base >=4.8 && <5

@@ -42,22 +40,17 @@ library

4240 , deepseq

4341 , lens >= 4.13

4442 , mtl >= 2.2

45− , scientific

4643 , semigroups >= 0.18

4744 , template-haskell >= 2.10

4845 , text >= 1.2

4946 , xml-conduit >= 1.0

5047 , xml-conduit-writer >= 0.1

5148

52− ghc-options: -Wall

53−

5449 hs-source-dirs: src

5550

5651 default-language: Haskell2010

5752 default-extensions: CPP

58− , DeriveTraversable

5953 , FlexibleInstances

60− , GeneralizedNewtypeDeriving

6154 , LambdaCase

6255 , TemplateHaskell

6356 , TupleSections