5ee3f5c...master · typeable/xml-isogen

git.iko.soy/typeable/xml-isogen

17 files changed+500−38

since splitsnapshots

unifiedsplit

.gitignore+5 CHANGELOG.md+5 README.md+284−1 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+15−7 src/Data/THGen/XML/Internal.hs+64−22 src/Text/XML/Nillable.hs+41 stack-10.0.yaml+8 stack-18.18.yaml+9 stack-19.6.yaml+9 stack.yaml+8−3 test/TestDefs.hs+4−4 xml-isogen.cabal+8−1

.gitignore+5

@@ -3,3 +3,8 @@ 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,6 +1,11 @@

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)

490.3.0

510------

611

README.md+284−1

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

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

77types.

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

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

ghc-802.yaml+4

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

1+nix:

2+ packages:

3+ - zlib

15resolver: lts-9.21

37packages:

ghc-822.yaml+4

@@ -1 +1,5 @@

1+nix:

2+ packages:

3+ - zlib

15resolver: lts-11.22

ghc-844.yaml+4

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

1+nix:

2+ packages:

3+ - zlib

15resolver: lts-12.16

26extra-deps:

37- dom-parser-3.1.0

shell.nixnew file+17

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

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

3+let

5+ inherit (nixpkgs) pkgs;

7+ f = import ./default.nix;

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.hsnew file+11

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

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

3+module Data.THGen.Orphans

4+where

6+import Data.Scientific

7+import qualified Data.Text as Text

8+import Text.XML.Writer

10+instance ToXML Scientific where

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

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

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

2222

2323Example 1.

2424

25−> "Color" =:= enum

25+> "Color" =:= enum ParserAndGenerator

2626> & "R"

2727> & "G"

2828> & "B"

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

4040

4141Example 2.

4242

43−> "Message" =:= record

43+> "Message" =:= record ParserAndGenerator

4444> ! "author"

4545> + "recipient"

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

@@ -67,10 +67,10 @@ enumeration is exhaustive (contains only the listed constructors) or

6767non-exhaustive (also contains a constructor for unknown values; this

6868is the default):

6969

70−> "Enum1" Exhaustive =:= enum

70+> "Enum1" Exhaustive =:= enum Generator

7171> ...

7272

73−> "Enum2" NonExhaustive =:= enum

73+> "Enum2" NonExhaustive =:= enum Generator

7474> ...

7575

7676To define a record, use the `record` function followed by the name of

@@ -78,7 +78,7 @@ 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

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

8282> ...

8383

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

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

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

96+> "Message" =:= record ParserAndGenerator

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

9898> ...

9999

100+Both @record@ and @enum@ take a @GenType@ argument which tells it to generate

101+generator, parser or both. It's being used to optimize compilation time by

102+skipping the unnecessary TH instance generation.

103+

100104-}

101105

102106

@@ -104,6 +108,7 @@ module Data.THGen.XML

104108 ( Exhaustiveness(..)

105109 , PrefixName(..)

106110 , ExhaustivenessName(..)

111+ , GenType(..)

107112 , record

108113 , enum

109114 , (!)

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

119124 , Text

120125 , P.Int

121126 , P.Integer

127+ , Nillable(..)

122128 ) where

123129

124130import Data.THGen.Enum

131+import Data.THGen.Orphans ()

125132import Data.THGen.XML.Internal

126133import Data.Text

134+import Text.XML.Nillable

127135import qualified Prelude as P

src/Data/THGen/XML/Internal.hs+64−22

@@ -1,10 +1,11 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE UndecidableInstances #-}

23{-# LANGUAGE FunctionalDependencies #-}

45module Data.THGen.XML.Internal where

67import Control.DeepSeq

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

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

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

910import qualified Data.Char as C

1011import Data.List.NonEmpty (NonEmpty)

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

1415import Data.THGen.Enum

1516import qualified Data.Text as T

1617import GHC.Generics (Generic)

17−import Language.Haskell.TH as TH

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

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

1920import qualified Text.XML as X

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

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

2223import Text.XML.ParentAttributes

2324import qualified Text.XML.Writer as XW

2425

26+data ParserMode

27+ = Strict

28+ | Lenient

2529

26−data GenType = Parser | Generator | Both

30+data GenType

31+ = Parser

32+ | Generator

33+ | ParserAndGenerator

34+ | LenientParser

35+ | LenientParserAndGenerator

36+

37+isLenientType :: GenType -> Bool

38+isLenientType = \case

39+ LenientParser -> True

40+ LenientParserAndGenerator -> True

41+ _ -> False

2742

2843data XmlFieldPlural

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

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

145160 exhaustivenessName =:= (IsoXmlDescEnum genType descEnumCons) =

146161 isoXmlGenerateEnum genType exhaustivenessName (reverse descEnumCons)

147162

148−instance IsString (TH.TypeQ -> IsoXmlDescPreField) where

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

149164 fromString = IsoXmlDescPreField

150165

151166instance IsString IsoXmlDescPreField where

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

153168 where

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

155170

156−instance IsString (TH.TypeQ -> IsoXmlDescPreAttribute) where

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

157172 fromString = IsoXmlDescPreAttribute

158173

159−instance IsString (TH.TypeQ -> IsoXmlDescPreContent) where

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

160175 fromString = IsoXmlDescPreContent

161176

162177instance IsString IsoXmlDescPreAttribute where

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

182197 fromString strName = ExhaustivenessName strName NonExhaustive

183198

184199makeNamePrefix :: String -> String

185−makeNamePrefix = map C.toLower . filter C.isUpper

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

186201

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

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

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

210225 (return [])

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

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

213− genFromDomInst = do

228+ genFromDomInst mode = do

214229 TH.instanceD

215230 (return [])

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

217− [funSimple 'fromDom [e|parseContent readContent|]]

232+ [case mode of

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

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

235+ ]

218236 genFromAttributeInst = do

219237 TH.instanceD

220238 (return [])

@@ -226,13 +244,24 @@ isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do

226244 toXmlAttributeInst <- genToXmlAttributeInst

227245 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]

228246 Parser -> do

229− fromDomInst <- genFromDomInst

247+ fromDomInst <- genFromDomInst Strict

248+ fromAttributeInst <- genFromAttributeInst

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

250+ LenientParser -> do

251+ fromDomInst <- genFromDomInst Lenient

230252 fromAttributeInst <- genFromAttributeInst

231253 return $ enumDecls ++ [fromDomInst, fromAttributeInst]

232− Both -> do

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

233262 toXmlInst <- genToXmlInst

234263 toXmlAttributeInst <- genToXmlAttributeInst

235− fromDomInst <- genFromDomInst

264+ fromDomInst <- genFromDomInst Lenient

236265 fromAttributeInst <- genFromAttributeInst

237266 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,

238267 fromDomInst, fromAttributeInst]

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

255284 IsoXmlDescField fieldPlural rawName fieldType = descField

256285 fieldStrName = xmlLocalName rawName

257286 fName = TH.mkName (fieldName fieldStrName)

258− fType = case fieldPlural of

287+ fType' = case fieldPlural of

259288 XmlFieldPluralMandatory -> fieldType

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

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

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

292+ fType = if isLenientType genType

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

294+ else fType'

263295 in if isNewtype

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

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

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

294326 [ ]

295327

296328 let

297− genFromDomInst = do

329+ genFromDomInst mode = do

298330 let

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

300332 exprRecordParts = do

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

308340 fieldParse = case fieldPlural of

309341 XmlFieldPluralMandatory -> [e|inElem|]

310342 _ -> [e|inElemTrav|]

311− in

312− [e|$fieldParse $exprFieldStrName fromDom|]

343+ in case mode of

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

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

313346 IsoXmlDescRecordAttribute descAttribute ->

314347 let

315348 IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute

@@ -379,11 +412,11 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts

379412 toXmlParentAttributesExpr

380413 = TH.lamE [if null exprAttributes then TH.wildP else TH.varP objName]

381414 $ [e|mapMaybe distribPair $(TH.listE exprAttributes)|]

382− #if __GLASGOW_HASKELL__ < 800

415+#if __GLASGOW_HASKELL__ < 800

383416 TH.instanceD

384− #else

417+#else

385418 TH.instanceWithOverlapD (Just TH.Overlapping)

386− #endif

419+#endif

387420 (return [])

388421 [t|ToXmlParentAttributes $(TH.conT name)|]

389422 [funSimple 'toXmlParentAttributes toXmlParentAttributesExpr]

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

395428 return $ [termDecl] ++ lensDecls ++

396429 [toXmlInst, toXmlParentAttributesInst, nfDataInst]

397430 Parser -> do

398− fromDomInst <- genFromDomInst

431+ fromDomInst <- genFromDomInst Strict

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

400− Both -> do

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

401443 toXmlInst <- genToXmlInst

402444 toXmlParentAttributesInst <- genToXmlParentAttributeInst

403− fromDomInst <- genFromDomInst

445+ fromDomInst <- genFromDomInst Lenient

404446 return $ [termDecl] ++ lensDecls ++

405447 [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]

406448

src/Text/XML/Nillable.hsnew file+41

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

1+{-# LANGUAGE MonoLocalBinds #-}

2+{-# LANGUAGE OverloadedStrings #-}

4+module Text.XML.Nillable where

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.yamlnew file+8

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

1+nix:

2+ packages:

3+ - zlib

5+resolver: lts-10.0

6+extra-deps:

7+- dom-parser-3.0.0

8+- generic-arbitrary-0.1.0

stack-18.18.yamlnew file+9

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

1+nix:

2+ packages:

3+ - zlib

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.yamlnew file+9

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

1+nix:

2+ packages:

3+ - zlib

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+8−3

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

1−resolver: lts-10.0

1+nix:

2+ packages:

3+ - zlib

5+resolver: lts-20.16

26extra-deps:

3−- dom-parser-3.0.0

4−- generic-arbitrary-0.1.0

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

8+ commit: 7d556ba528bfa216e99714f8a0d4d00f452803a9

9+ - xml-lens-0.3.1

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

12+"Bar" =:= enum ParserAndGenerator

1313 & "baroque"

1414 & "bartender"

1515

16−"Quux" Exhaustive =:= enum

16+"Quux" Exhaustive =:= enum ParserAndGenerator

1717 & "ALL"

1818 & "YOUR"

1919 & "BASE"

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

2222 & "TO"

2323 & "US"

2424

25−"Foo" =:= record

25+"Foo" =:= record ParserAndGenerator

2626 ^ "Shmuux" [t|XmlQuux|]

2727 + "Bar"

2828 ? "Baz" [t|Text|]

2929 !% "Quux"

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

3131

32−"Root" =:= record

32+"Root" =:= record ParserAndGenerator

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

3434

3535instance Arbitrary XmlRoot where

xml-isogen.cabal+8−1

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

11name: xml-isogen

2−version: 0.3.1

2+version: 0.3.2

33synopsis: Generate XML-isomorphic types

44description:

55 TemplateHaskell generators for XML-isomorphic data types, including

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

3232 , Data.THGen.XML

3333 , Data.THGen.XML.Internal

3434 , Text.XML.ParentAttributes

35+ , Text.XML.Nillable

3536 other-modules: Data.THGen.Compat

37+ , Data.THGen.Orphans

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

3739 build-depends: QuickCheck >= 2.8

3840 , base >=4.8 && <5

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

4042 , deepseq

4143 , lens >= 4.13

4244 , mtl >= 2.2

45+ , scientific

4346 , semigroups >= 0.18

4447 , template-haskell >= 2.10

4548 , text >= 1.2

4649 , xml-conduit >= 1.0

4750 , xml-conduit-writer >= 0.1

4851

52+ ghc-options: -Wall

53+

4954 hs-source-dirs: src

5055

5156 default-language: Haskell2010

5257 default-extensions: CPP

58+ , DeriveTraversable

5359 , FlexibleInstances

60+ , GeneralizedNewtypeDeriving

5461 , LambdaCase

5562 , TemplateHaskell

5663 , TupleSections