master..56f7eaa · typeable/xml-isogen

git.iko.soy/typeable/xml-isogen

on 56f7eaa help sign in

.gitignore−5

since splitsnapshots

unifiedsplit

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

3.stack-work

4.cabal-sandbox/

5cabal.sandbox.config

6−dist-newstyle/

7−default.nix

8−# vim backup and swap files

9−*~

10−.*.swp

CHANGELOG.md−5

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

1HEAD

2------

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−

90.3.0

40.3.0

10------

5------

README.md+1−284

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

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

7types.

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

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

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

ghc-802.yaml−4

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

1−nix:

2− packages:

3− - zlib

4−

5resolver: lts-9.21

1resolver: lts-9.21

7packages:

3packages:

ghc-822.yaml−4

@@ -1,5 +1 @@

1−nix:

2− packages:

3− - zlib

4−

5resolver: lts-11.22

1resolver: lts-11.22

ghc-844.yaml−4

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

1−nix:

2− packages:

3− - zlib

4−

5resolver: lts-12.16

1resolver: lts-12.16

6extra-deps:

2extra-deps:

7- dom-parser-3.1.0

3- 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:

23Example 1.

25−> "Color" =:= enum ParserAndGenerator

25+> "Color" =:= enum Both

26> & "R"

27> & "G"

28> & "B"

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

41Example 2.

43−> "Message" =:= record ParserAndGenerator

43+> "Message" =:= record Both

44> ! "author"

45> + "recipient"

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

@@ -93,7 +93,7 @@ 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 ParserAndGenerator

96+> "Message" =:= record Both

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

98> ...

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

124 , Text

125 , P.Int

126 , P.Integer

127− , Nillable(..)

128 ) where

127 ) where

129

128

130import Data.THGen.Enum

129import Data.THGen.Enum

131−import Data.THGen.Orphans ()

132import Data.THGen.XML.Internal

130import Data.THGen.XML.Internal

133import Data.Text

131import Data.Text

134−import Text.XML.Nillable

135import qualified Prelude as P

132import qualified Prelude as P

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

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

5module Data.THGen.XML.Internal where

7import Control.DeepSeq

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

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

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

10import qualified Data.Char as C

11import Data.List.NonEmpty (NonEmpty)

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

15import Data.THGen.Enum

16import qualified Data.Text as T

17import GHC.Generics (Generic)

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

18+import Language.Haskell.TH as TH

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

20import qualified Text.XML as X

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

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

23import Text.XML.ParentAttributes

24import qualified Text.XML.Writer as XW

26−data ParserMode

27− = Strict

28− | Lenient

30−data GenType

27+data GenType = Parser | Generator | Both

31− = Parser

32− | Generator

33− | ParserAndGenerator

34− | LenientParser

35− | LenientParserAndGenerator

37−isLenientType :: GenType -> Bool

29+data GenerateLens = Lens | NoLens

38−isLenientType = \case

39− LenientParser -> True

40− LenientParserAndGenerator -> True

41− _ -> False

43data XmlFieldPlural

31data XmlFieldPlural

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

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

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

69 | IsoXmlDescRecordAttribute IsoXmlDescAttribute

57 | IsoXmlDescRecordAttribute IsoXmlDescAttribute

70 | IsoXmlDescRecordContent IsoXmlDescContent

58 | IsoXmlDescRecordContent IsoXmlDescContent

72−data IsoXmlDescRecord = IsoXmlDescRecord GenType [IsoXmlDescRecordPart]

60+data IsoXmlDescRecord = IsoXmlDescRecord GenType GenerateLens [IsoXmlDescRecordPart]

74makePrisms ''IsoXmlDescRecord

62makePrisms ''IsoXmlDescRecord

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

90 -> IsoXmlDescRecord

78 -> IsoXmlDescRecord

91 -> IsoXmlDescPreField

79 -> IsoXmlDescPreField

92 -> IsoXmlDescRecord

80 -> IsoXmlDescRecord

81+appendField

82+ plural

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

83+ (IsoXmlDescRecord genType generateLens fields)

84+ (IsoXmlDescPreField name ty) =

94− let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty

85+ let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty

95− in IsoXmlDescRecord genType (xfield:fields)

86+ in IsoXmlDescRecord genType generateLens (xfield:fields)

97appendAttribute

88appendAttribute

98 :: XmlAttributePlural

89 :: XmlAttributePlural

99 -> IsoXmlDescRecord

90 -> IsoXmlDescRecord

100 -> IsoXmlDescPreAttribute

91 -> IsoXmlDescPreAttribute

101 -> IsoXmlDescRecord

92 -> IsoXmlDescRecord

93+appendAttribute

94+ plural

95+ (IsoXmlDescRecord genType generateLens fields)

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

96+ (IsoXmlDescPreAttribute name ty) =

103− let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty

97+ let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty

104− in IsoXmlDescRecord genType (xattribute:fields)

98+ in IsoXmlDescRecord genType generateLens (xattribute:fields)

105

106appendContent

100appendContent

107 :: IsoXmlDescRecord

101 :: IsoXmlDescRecord

108 -> IsoXmlDescPreContent

102 -> IsoXmlDescPreContent

109 -> IsoXmlDescRecord

103 -> IsoXmlDescRecord

104+appendContent

105+ (IsoXmlDescRecord genType generateLens fields)

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

106+ (IsoXmlDescPreContent name ty) =

111− let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty

107+ let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty

112− in IsoXmlDescRecord genType (xcontent:fields)

108+ in IsoXmlDescRecord genType generateLens (xcontent:fields)

113

109

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

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

115(!) = appendField XmlFieldPluralMandatory

111(!) = appendField XmlFieldPluralMandatory

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

147infix 0 =:=

143infix 0 =:=

148

144

149instance Description PrefixName IsoXmlDescRecord where

145instance Description PrefixName IsoXmlDescRecord where

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

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

151− isoXmlGenerateDatatype genType prefixName (reverse descRecordParts)

147+ isoXmlGenerateDatatype genType generateLens prefixName (reverse descRecordParts)

152

148

153−record :: GenType -> IsoXmlDescRecord

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

154−record gt = IsoXmlDescRecord gt []

150+record gt gl = IsoXmlDescRecord gt gl []

155

151

156enum :: GenType -> IsoXmlDescEnum

152enum :: GenType -> IsoXmlDescEnum

157enum gt = IsoXmlDescEnum gt []

153enum gt = IsoXmlDescEnum gt []

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

160 exhaustivenessName =:= (IsoXmlDescEnum genType descEnumCons) =

156 exhaustivenessName =:= (IsoXmlDescEnum genType descEnumCons) =

161 isoXmlGenerateEnum genType exhaustivenessName (reverse descEnumCons)

157 isoXmlGenerateEnum genType exhaustivenessName (reverse descEnumCons)

162

158

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

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

164 fromString = IsoXmlDescPreField

160 fromString = IsoXmlDescPreField

165

161

166instance IsString IsoXmlDescPreField where

162instance IsString IsoXmlDescPreField where

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

168 where

164 where

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

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

170

166

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

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

172 fromString = IsoXmlDescPreAttribute

168 fromString = IsoXmlDescPreAttribute

173

169

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

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

175 fromString = IsoXmlDescPreContent

171 fromString = IsoXmlDescPreContent

176

172

177instance IsString IsoXmlDescPreAttribute where

173instance IsString IsoXmlDescPreAttribute where

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

197 fromString strName = ExhaustivenessName strName NonExhaustive

193 fromString strName = ExhaustivenessName strName NonExhaustive

198

194

199makeNamePrefix :: String -> String

195makeNamePrefix :: String -> String

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

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

201

197

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

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

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

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

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

225 (return [])

221 (return [])

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

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

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

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

228− genFromDomInst mode = do

224+ genFromDomInst = do

229 TH.instanceD

225 TH.instanceD

230 (return [])

226 (return [])

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

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

232− [case mode of

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

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

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

235− ]

236 genFromAttributeInst = do

229 genFromAttributeInst = do

237 TH.instanceD

230 TH.instanceD

238 (return [])

231 (return [])

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

244 toXmlAttributeInst <- genToXmlAttributeInst

237 toXmlAttributeInst <- genToXmlAttributeInst

245 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]

238 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]

246 Parser -> do

239 Parser -> do

247− fromDomInst <- genFromDomInst Strict

240+ fromDomInst <- genFromDomInst

248− fromAttributeInst <- genFromAttributeInst

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

250− LenientParser -> do

251− fromDomInst <- genFromDomInst Lenient

252 fromAttributeInst <- genFromAttributeInst

241 fromAttributeInst <- genFromAttributeInst

253 return $ enumDecls ++ [fromDomInst, fromAttributeInst]

242 return $ enumDecls ++ [fromDomInst, fromAttributeInst]

254− ParserAndGenerator -> do

243+ Both -> 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

262 toXmlInst <- genToXmlInst

244 toXmlInst <- genToXmlInst

263 toXmlAttributeInst <- genToXmlAttributeInst

245 toXmlAttributeInst <- genToXmlAttributeInst

264− fromDomInst <- genFromDomInst Lenient

246+ fromDomInst <- genFromDomInst

265 fromAttributeInst <- genFromAttributeInst

247 fromAttributeInst <- genFromAttributeInst

266 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,

248 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,

267 fromDomInst, fromAttributeInst]

249 fromDomInst, fromAttributeInst]

268

250

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

251+isoXmlGenerateDatatype

252+ :: GenType

253+ -> GenerateLens

254+ -> PrefixName

255+ -> [IsoXmlDescRecordPart]

256+ -> TH.DecsQ

257+isoXmlGenerateDatatype

258+ genType

259+ generateLens

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

260+ (PrefixName strName' strPrefix')

261+ descRecordParts = do

271 let

262 let

272 isNewtype = length descRecordParts == 1

263 isNewtype = length descRecordParts == 1

273 strName = "Xml" ++ strName'

264 strName = "Xml" ++ strName'

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

284 IsoXmlDescField fieldPlural rawName fieldType = descField

275 IsoXmlDescField fieldPlural rawName fieldType = descField

285 fieldStrName = xmlLocalName rawName

276 fieldStrName = xmlLocalName rawName

286 fName = TH.mkName (fieldName fieldStrName)

277 fName = TH.mkName (fieldName fieldStrName)

287− fType' = case fieldPlural of

278+ fType = case fieldPlural of

288 XmlFieldPluralMandatory -> fieldType

279 XmlFieldPluralMandatory -> fieldType

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

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

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

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

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

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

292− fType = if isLenientType genType

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

294− else fType'

295 in if isNewtype

283 in if isNewtype

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

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

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

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

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

326 [ ]

314 [ ]

327

315

328 let

316 let

329− genFromDomInst mode = do

317+ genFromDomInst = do

330 let

318 let

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

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

332 exprRecordParts = do

320 exprRecordParts = do

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

340 fieldParse = case fieldPlural of

328 fieldParse = case fieldPlural of

341 XmlFieldPluralMandatory -> [e|inElem|]

329 XmlFieldPluralMandatory -> [e|inElem|]

342 _ -> [e|inElemTrav|]

330 _ -> [e|inElemTrav|]

343− in case mode of

331+ in

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

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

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

346 IsoXmlDescRecordAttribute descAttribute ->

333 IsoXmlDescRecordAttribute descAttribute ->

347 let

334 let

348 IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute

335 IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute

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

428 return $ [termDecl] ++ lensDecls ++

415 return $ [termDecl] ++ lensDecls ++

429 [toXmlInst, toXmlParentAttributesInst, nfDataInst]

416 [toXmlInst, toXmlParentAttributesInst, nfDataInst]

430 Parser -> do

417 Parser -> do

431− fromDomInst <- genFromDomInst Strict

418+ fromDomInst <- genFromDomInst

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

433− LenientParser -> do

434− fromDomInst <- genFromDomInst Lenient

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

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

436− ParserAndGenerator -> do

420+ Both -> do

437− toXmlInst <- genToXmlInst

438− toXmlParentAttributesInst <- genToXmlParentAttributeInst

439− fromDomInst <- genFromDomInst Strict

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

441− [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

442− LenientParserAndGenerator -> do

443 toXmlInst <- genToXmlInst

421 toXmlInst <- genToXmlInst

444 toXmlParentAttributesInst <- genToXmlParentAttributeInst

422 toXmlParentAttributesInst <- genToXmlParentAttributeInst

445− fromDomInst <- genFromDomInst Lenient

423+ fromDomInst <- genFromDomInst

446 return $ [termDecl] ++ lensDecls ++

424 return $ [termDecl] ++ lensDecls ++

447 [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

425 [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

448

426

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

6extra-deps:

2extra-deps:

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

3+- dom-parser-3.0.0

8− commit: 7d556ba528bfa216e99714f8a0d4d00f452803a9

4+- generic-arbitrary-0.1.0

9− - xml-lens-0.3.1

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 ParserAndGenerator

12+"Bar" =:= enum Both

13 & "baroque"

14 & "bartender"

16−"Quux" Exhaustive =:= enum ParserAndGenerator

16+"Quux" Exhaustive =:= enum Both

17 & "ALL"

18 & "YOUR"

19 & "BASE"

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

22 & "TO"

23 & "US"

25−"Foo" =:= record ParserAndGenerator

25+"Foo" =:= record Both

26 ^ "Shmuux" [t|XmlQuux|]

27 + "Bar"

28 ? "Baz" [t|Text|]

29 !% "Quux"

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

32−"Root" =:= record ParserAndGenerator

32+"Root" =:= record Both

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

35instance Arbitrary XmlRoot where

xml-isogen.cabal+1−8

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

1name: xml-isogen

2−version: 0.3.2

2+version: 0.3.1

3synopsis: Generate XML-isomorphic types

4description:

5 TemplateHaskell generators for XML-isomorphic data types, including

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

32 , Data.THGen.XML

33 , Data.THGen.XML.Internal

34 , Text.XML.ParentAttributes

35− , Text.XML.Nillable

36 other-modules: Data.THGen.Compat

35 other-modules: Data.THGen.Compat

37− , Data.THGen.Orphans

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

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

39 build-depends: QuickCheck >= 2.8

37 build-depends: QuickCheck >= 2.8

40 , base >=4.8 && <5

38 , base >=4.8 && <5

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

42 , deepseq

40 , deepseq

43 , lens >= 4.13

41 , lens >= 4.13

44 , mtl >= 2.2

42 , mtl >= 2.2

45− , scientific

46 , semigroups >= 0.18

43 , semigroups >= 0.18

47 , template-haskell >= 2.10

44 , template-haskell >= 2.10

48 , text >= 1.2

45 , text >= 1.2

49 , xml-conduit >= 1.0

46 , xml-conduit >= 1.0

50 , xml-conduit-writer >= 0.1

47 , xml-conduit-writer >= 0.1

52− ghc-options: -Wall

53−

54 hs-source-dirs: src

49 hs-source-dirs: src

56 default-language: Haskell2010

51 default-language: Haskell2010

57 default-extensions: CPP

52 default-extensions: CPP

58− , DeriveTraversable

59 , FlexibleInstances

53 , FlexibleInstances

60− , GeneralizedNewtypeDeriving

61 , LambdaCase

54 , LambdaCase

62 , TemplateHaskell

55 , TemplateHaskell

63 , TupleSections

56 , TupleSections