master..56f7eaa · typeable/xml-isogen

git.iko.soy/typeable/xml-isogen

17 files changed+65−502

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+3−6 src/Data/THGen/XML/Internal.hs+53−75 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+4−4 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+3−6

@@ -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

4444> ! "author"

4545> + "recipient"

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

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

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

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

9595

96−> "Message" =:= record ParserAndGenerator

96+> "Message" =:= record Both

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

9898> ...

9999

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

124124 , Text

125125 , P.Int

126126 , P.Integer

127− , Nillable(..)

128127 ) where

129128

130129import Data.THGen.Enum

131−import Data.THGen.Orphans ()

132130import Data.THGen.XML.Internal

133131import Data.Text

134−import Text.XML.Nillable

135132import qualified Prelude as P

src/Data/THGen/XML/Internal.hs+53−75

@@ -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,10 @@ 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+data GenType = Parser | Generator | Both

3628

37−isLenientType :: GenType -> Bool

38−isLenientType = \case

39− LenientParser -> True

40− LenientParserAndGenerator -> True

41− _ -> False

29+data GenerateLens = Lens | NoLens

4230

4331data XmlFieldPlural

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

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

6957 | IsoXmlDescRecordAttribute IsoXmlDescAttribute

7058 | IsoXmlDescRecordContent IsoXmlDescContent

7159

72−data IsoXmlDescRecord = IsoXmlDescRecord GenType [IsoXmlDescRecordPart]

60+data IsoXmlDescRecord = IsoXmlDescRecord GenType GenerateLens [IsoXmlDescRecordPart]

7361

7462makePrisms ''IsoXmlDescRecord

7563

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

9078 -> IsoXmlDescRecord

9179 -> IsoXmlDescPreField

9280 -> IsoXmlDescRecord

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

94− let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty

95− 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)

9687

9788appendAttribute

9889 :: XmlAttributePlural

9990 -> IsoXmlDescRecord

10091 -> IsoXmlDescPreAttribute

10192 -> IsoXmlDescRecord

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

103− let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty

104− 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)

10599

106100appendContent

107101 :: IsoXmlDescRecord

108102 -> IsoXmlDescPreContent

109103 -> IsoXmlDescRecord

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

111− let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty

112− 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)

113109

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

115111(!) = appendField XmlFieldPluralMandatory

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

147143infix 0 =:=

148144

149145instance Description PrefixName IsoXmlDescRecord where

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

151− isoXmlGenerateDatatype genType prefixName (reverse descRecordParts)

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

147+ isoXmlGenerateDatatype genType generateLens prefixName (reverse descRecordParts)

152148

153−record :: GenType -> IsoXmlDescRecord

154−record gt = IsoXmlDescRecord gt []

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

150+record gt gl = IsoXmlDescRecord gt gl []

155151

156152enum :: GenType -> IsoXmlDescEnum

157153enum gt = IsoXmlDescEnum gt []

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

160156 exhaustivenessName =:= (IsoXmlDescEnum genType descEnumCons) =

161157 isoXmlGenerateEnum genType exhaustivenessName (reverse descEnumCons)

162158

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

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

164160 fromString = IsoXmlDescPreField

165161

166162instance IsString IsoXmlDescPreField where

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

168164 where

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

170166

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

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

172168 fromString = IsoXmlDescPreAttribute

173169

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

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

175171 fromString = IsoXmlDescPreContent

176172

177173instance IsString IsoXmlDescPreAttribute where

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

197193 fromString strName = ExhaustivenessName strName NonExhaustive

198194

199195makeNamePrefix :: String -> String

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

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

201197

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

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

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

225221 (return [])

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

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

228− genFromDomInst mode = do

224+ genFromDomInst = do

229225 TH.instanceD

230226 (return [])

231227 [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− ]

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

236229 genFromAttributeInst = do

237230 TH.instanceD

238231 (return [])

@@ -244,30 +237,28 @@ isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do

244237 toXmlAttributeInst <- genToXmlAttributeInst

245238 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]

246239 Parser -> do

247− fromDomInst <- genFromDomInst Strict

248− fromAttributeInst <- genFromAttributeInst

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

250− LenientParser -> do

251− fromDomInst <- genFromDomInst Lenient

240+ fromDomInst <- genFromDomInst

252241 fromAttributeInst <- genFromAttributeInst

253242 return $ enumDecls ++ [fromDomInst, fromAttributeInst]

254− ParserAndGenerator -> do

255− toXmlInst <- genToXmlInst

256− toXmlAttributeInst <- genToXmlAttributeInst

257− fromDomInst <- genFromDomInst Strict

258− fromAttributeInst <- genFromAttributeInst

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

260− fromDomInst, fromAttributeInst]

261− LenientParserAndGenerator -> do

243+ Both -> do

262244 toXmlInst <- genToXmlInst

263245 toXmlAttributeInst <- genToXmlAttributeInst

264− fromDomInst <- genFromDomInst Lenient

246+ fromDomInst <- genFromDomInst

265247 fromAttributeInst <- genFromAttributeInst

266248 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,

267249 fromDomInst, fromAttributeInst]

268250

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

270−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

271262 let

272263 isNewtype = length descRecordParts == 1

273264 strName = "Xml" ++ strName'

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

284275 IsoXmlDescField fieldPlural rawName fieldType = descField

285276 fieldStrName = xmlLocalName rawName

286277 fName = TH.mkName (fieldName fieldStrName)

287− fType' = case fieldPlural of

278+ fType = case fieldPlural of

288279 XmlFieldPluralMandatory -> fieldType

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

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

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

292− fType = if isLenientType genType

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

294− else fType'

295283 in if isNewtype

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

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

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

326314 [ ]

327315

328316 let

329− genFromDomInst mode = do

317+ genFromDomInst = do

330318 let

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

332320 exprRecordParts = do

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

340328 fieldParse = case fieldPlural of

341329 XmlFieldPluralMandatory -> [e|inElem|]

342330 _ -> [e|inElemTrav|]

343− in case mode of

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

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

331+ in

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

346333 IsoXmlDescRecordAttribute descAttribute ->

347334 let

348335 IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute

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

428415 return $ [termDecl] ++ lensDecls ++

429416 [toXmlInst, toXmlParentAttributesInst, nfDataInst]

430417 Parser -> do

431− fromDomInst <- genFromDomInst Strict

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

433− LenientParser -> do

434− fromDomInst <- genFromDomInst Lenient

418+ fromDomInst <- genFromDomInst

435419 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

420+ Both -> do

443421 toXmlInst <- genToXmlInst

444422 toXmlParentAttributesInst <- genToXmlParentAttributeInst

445− fromDomInst <- genFromDomInst Lenient

423+ fromDomInst <- genFromDomInst

446424 return $ [termDecl] ++ lensDecls ++

447425 [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

448426

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+4−4

@@ -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

25+"Foo" =:= record Both

2626 ^ "Shmuux" [t|XmlQuux|]

2727 + "Bar"

2828 ? "Baz" [t|Text|]

2929 !% "Quux"

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

3131

32−"Root" =:= record ParserAndGenerator

32+"Root" =:= record Both

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