git.iko.soy/typeable/xml-isogen
on master help sign in
Merge pull request #29 from typeable/add_lenient_parser
e8f06b2Evgenii Akentev
.gitignore+2−1
compare with master
unifiedsplit
@@ -3,7 +3,8 @@ dist
3.stack-work
3.stack-work
4.cabal-sandbox/
4.cabal-sandbox/
5cabal.sandbox.config
5cabal.sandbox.config
6−
6+dist-newstyle/
7+default.nix
7# vim backup and swap files
8# vim backup and swap files
8*~
9*~
9.*.swp
10.*.swp
CHANGELOG.md+1
@@ -1,6 +1,7 @@
1HEAD
1HEAD
2------
2------
3
3
4+* Add lenient parsers support (#29)
4* Rename Both to ParserAndGenerator (#27)
5* Rename Both to ParserAndGenerator (#27)
5* Add Nillable newtype (#24)
6* Add Nillable newtype (#24)
6* Include digits in the auto-gerenated prefix (#22)
7* Include digits in the auto-gerenated prefix (#22)
README.md+10
@@ -280,3 +280,13 @@ then the following XML will be generated:
280 ns:nil="true"
280 ns:nil="true"
281/>
281/>
282```
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+```
shell.nixnew file+17
@@ -0,0 +1,17 @@
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/XML/Internal.hs+54−13
@@ -5,7 +5,7 @@
5module Data.THGen.XML.Internal where
5module Data.THGen.XML.Internal where
6
6
7import Control.DeepSeq
7import Control.DeepSeq
8−import Control.Lens hiding (repeated, enum, (&))
8+import Control.Lens hiding (repeated, enum, (&), Strict)
9import Control.Lens.Internal.FieldTH (makeFieldOpticsForDec)
9import Control.Lens.Internal.FieldTH (makeFieldOpticsForDec)
10import qualified Data.Char as C
10import qualified Data.Char as C
11import Data.List.NonEmpty (NonEmpty)
11import Data.List.NonEmpty (NonEmpty)
@@ -15,7 +15,7 @@ import Data.THGen.Compat as THC
15import Data.THGen.Enum
15import Data.THGen.Enum
16import qualified Data.Text as T
16import qualified Data.Text as T
17import GHC.Generics (Generic)
17import GHC.Generics (Generic)
18−import Language.Haskell.TH as TH
18+import Language.Haskell.TH as TH hiding (Strict)
19import Prelude hiding ((+), (*), (^))
19import Prelude hiding ((+), (*), (^))
20import qualified Text.XML as X
20import qualified Text.XML as X
21import Text.XML.DOM.Parser hiding (parseContent)
21import Text.XML.DOM.Parser hiding (parseContent)
@@ -23,8 +23,22 @@ import Text.XML.DOM.Parser.Internal.Content
23import Text.XML.ParentAttributes
23import Text.XML.ParentAttributes
24import qualified Text.XML.Writer as XW
24import qualified Text.XML.Writer as XW
25
25
26+data ParserMode
27+ = Strict
28+ | Lenient
26
29
30+data GenType
31+ = Parser
32+ | Generator
27−data GenType = Parser | Generator | ParserAndGenerator
33+ | ParserAndGenerator
34+ | LenientParser
35+ | LenientParserAndGenerator
36+
37+isLenientType :: GenType -> Bool
38+isLenientType = \case
39+ LenientParser -> True
40+ LenientParserAndGenerator -> True
41+ _ -> False
28
42
29data XmlFieldPlural
43data XmlFieldPlural
30 = XmlFieldPluralMandatory -- Occurs exactly 1 time (Identity)
44 = XmlFieldPluralMandatory -- Occurs exactly 1 time (Identity)
@@ -211,11 +225,14 @@ isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do
211 (return [])
225 (return [])
212 [t|ToXmlAttribute $(TH.conT name)|]
226 [t|ToXmlAttribute $(TH.conT name)|]
213 [funSimple 'toXmlAttribute [e|T.pack . show|]]
227 [funSimple 'toXmlAttribute [e|T.pack . show|]]
214− genFromDomInst = do
228+ genFromDomInst mode = do
215 TH.instanceD
229 TH.instanceD
216 (return [])
230 (return [])
217 [t|FromDom $(TH.conT name)|]
231 [t|FromDom $(TH.conT name)|]
232+ [case mode of
233+ Strict -> funSimple 'fromDom [e|parseContent readContent|]
218− [funSimple 'fromDom [e|parseContent readContent|]]
234+ Lenient -> funSimple 'fromDom [e|ignoreBlank $ parseContent readContent|]
235+ ]
219 genFromAttributeInst = do
236 genFromAttributeInst = do
220 TH.instanceD
237 TH.instanceD
221 (return [])
238 (return [])
@@ -227,13 +244,24 @@ isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do
227 toXmlAttributeInst <- genToXmlAttributeInst
244 toXmlAttributeInst <- genToXmlAttributeInst
228 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]
245 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]
229 Parser -> do
246 Parser -> do
230− fromDomInst <- genFromDomInst
247+ fromDomInst <- genFromDomInst Strict
248+ fromAttributeInst <- genFromAttributeInst
249+ return $ enumDecls ++ [fromDomInst, fromAttributeInst]
250+ LenientParser -> do
251+ fromDomInst <- genFromDomInst Lenient
231 fromAttributeInst <- genFromAttributeInst
252 fromAttributeInst <- genFromAttributeInst
232 return $ enumDecls ++ [fromDomInst, fromAttributeInst]
253 return $ enumDecls ++ [fromDomInst, fromAttributeInst]
233 ParserAndGenerator -> do
254 ParserAndGenerator -> do
234 toXmlInst <- genToXmlInst
255 toXmlInst <- genToXmlInst
235 toXmlAttributeInst <- genToXmlAttributeInst
256 toXmlAttributeInst <- genToXmlAttributeInst
236− fromDomInst <- genFromDomInst
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
237 fromAttributeInst <- genFromAttributeInst
265 fromAttributeInst <- genFromAttributeInst
238 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,
266 return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,
239 fromDomInst, fromAttributeInst]
267 fromDomInst, fromAttributeInst]
@@ -256,11 +284,14 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts
256 IsoXmlDescField fieldPlural rawName fieldType = descField
284 IsoXmlDescField fieldPlural rawName fieldType = descField
257 fieldStrName = xmlLocalName rawName
285 fieldStrName = xmlLocalName rawName
258 fName = TH.mkName (fieldName fieldStrName)
286 fName = TH.mkName (fieldName fieldStrName)
259− fType = case fieldPlural of
287+ fType' = case fieldPlural of
260 XmlFieldPluralMandatory -> fieldType
288 XmlFieldPluralMandatory -> fieldType
261 XmlFieldPluralOptional -> [t| Maybe $fieldType |]
289 XmlFieldPluralOptional -> [t| Maybe $fieldType |]
262 XmlFieldPluralRepeated -> [t| [$fieldType] |]
290 XmlFieldPluralRepeated -> [t| [$fieldType] |]
263 XmlFieldPluralMultiplied -> [t| NonEmpty $fieldType |]
291 XmlFieldPluralMultiplied -> [t| NonEmpty $fieldType |]
292+ fType = if isLenientType genType
293+ then [t| Maybe $fType' |]
294+ else fType'
264 in if isNewtype
295 in if isNewtype
265 then THC.varStrictType fName (THC.nonStrictType fType)
296 then THC.varStrictType fName (THC.nonStrictType fType)
266 else THC.varStrictType fName (THC.strictType fType)
297 else THC.varStrictType fName (THC.strictType fType)
@@ -295,7 +326,7 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts
295 [ ]
326 [ ]
296
327
297 let
328 let
298− genFromDomInst = do
329+ genFromDomInst mode = do
299 let
330 let
300 exprHeader = [e|pure $(TH.conE name)|]
331 exprHeader = [e|pure $(TH.conE name)|]
301 exprRecordParts = do
332 exprRecordParts = do
@@ -309,8 +340,9 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts
309 fieldParse = case fieldPlural of
340 fieldParse = case fieldPlural of
310 XmlFieldPluralMandatory -> [e|inElem|]
341 XmlFieldPluralMandatory -> [e|inElem|]
311 _ -> [e|inElemTrav|]
342 _ -> [e|inElemTrav|]
312− in
343+ in case mode of
344+ Strict -> [e|$fieldParse $exprFieldStrName fromDom|]
313− [e|$fieldParse $exprFieldStrName fromDom|]
345+ Lenient -> [e|$fieldParse $exprFieldStrName (ignoreBlank fromDom)|]
314 IsoXmlDescRecordAttribute descAttribute ->
346 IsoXmlDescRecordAttribute descAttribute ->
315 let
347 let
316 IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute
348 IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute
@@ -396,12 +428,21 @@ isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts
396 return $ [termDecl] ++ lensDecls ++
428 return $ [termDecl] ++ lensDecls ++
397 [toXmlInst, toXmlParentAttributesInst, nfDataInst]
429 [toXmlInst, toXmlParentAttributesInst, nfDataInst]
398 Parser -> do
430 Parser -> do
399− fromDomInst <- genFromDomInst
431+ fromDomInst <- genFromDomInst Strict
432+ return $ [termDecl] ++ lensDecls ++ [fromDomInst, nfDataInst]
433+ LenientParser -> do
434+ fromDomInst <- genFromDomInst Lenient
400 return $ [termDecl] ++ lensDecls ++ [fromDomInst, nfDataInst]
435 return $ [termDecl] ++ lensDecls ++ [fromDomInst, nfDataInst]
401 ParserAndGenerator -> do
436 ParserAndGenerator -> do
402 toXmlInst <- genToXmlInst
437 toXmlInst <- genToXmlInst
403 toXmlParentAttributesInst <- genToXmlParentAttributeInst
438 toXmlParentAttributesInst <- genToXmlParentAttributeInst
404− fromDomInst <- genFromDomInst
439+ fromDomInst <- genFromDomInst Strict
440+ return $ [termDecl] ++ lensDecls ++
441+ [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]
442+ LenientParserAndGenerator -> do
443+ toXmlInst <- genToXmlInst
444+ toXmlParentAttributesInst <- genToXmlParentAttributeInst
445+ fromDomInst <- genFromDomInst Lenient
405 return $ [termDecl] ++ lensDecls ++
446 return $ [termDecl] ++ lensDecls ++
406 [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]
447 [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]
407
448
xml-isogen.cabal+1−1
@@ -1,5 +1,5 @@
1name: xml-isogen
1name: xml-isogen
2−version: 0.3.1
2+version: 0.3.2
3synopsis: Generate XML-isomorphic types
3synopsis: Generate XML-isomorphic types
4description:
4description:
5 TemplateHaskell generators for XML-isomorphic data types, including
5 TemplateHaskell generators for XML-isomorphic data types, including