on master help sign in
.travis.yml+2−1
since splitsnapshots
unifiedsplit
@@ -5,7 +5,8 @@ language: generic
5env:
5env:
6 - STACK_YAML=stack.yaml
6 - STACK_YAML=stack.yaml
7 - STACK_YAML=ghc-802.yaml
7 - STACK_YAML=ghc-802.yaml
8− - STACK_YAML=ghc-821.yaml
8+ - STACK_YAML=ghc-822.yaml
9+ - STACK_YAML=ghc-844.yaml
9
10
10cache:
11cache:
11 directories:
12 directories:
CHANGELOG.md+11−1
@@ -1,7 +1,17 @@
1+HEAD
2+------
3+
4+0.3.0
5+------
6+
7+* Add namespaces support
8+* Builds with GHC 8.4
9+* Derive NFData for all generated datatypes
10+
10.2.1
110.2.1
2------
12------
3
13
4−* Workaround bug in 8.2.1: attributes generation did not work on 8.2.1 only
14+* Workaround for the GHC 8.2.1 attribute generation bug
5
15
6* Add tests checking run-time behaviour of generated code
16* Add tests checking run-time behaviour of generated code
7
17
ghc-802.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-9.0
1+resolver: lts-9.21
2
2
3packages:
3packages:
4- .
4- .
ghc-821.yamldeleted−8
@@ -1,8 +0,0 @@
1−resolver: nightly-2017-09-14
2−
3−packages:
4−- .
5−
6−extra-deps:
7−- dom-parser-3.0.0
8−- generic-arbitrary-0.1.0
ghc-822.yamlnew file+1
@@ -0,0 +1 @@
1+resolver: lts-11.22
ghc-844.yamlnew file+3
@@ -0,0 +1,3 @@
1+resolver: lts-12.16
2+extra-deps:
3+- dom-parser-3.1.0
releasenew file+35
@@ -0,0 +1,35 @@
1+#!/bin/bash
2+
3+set -o xtrace
4+
5+dist=`stack path --dist-dir --stack-yaml ./stack.yaml 2> /dev/null`
6+
7+echo -e "\033[1;36mTesting library...\033[0m"
8+stack test 2> /dev/null
9+
10+echo -e "\033[1;36mRunning sdist...\033[0m"
11+cabal sdist
12+
13+echo -e "\033[1;36mGenerating documentation...\033[0m"
14+stack haddock 2> /dev/null
15+
16+if [ "$?" -eq "0" ]; then
17+ echo -e "\033[1;32mUploading package to Hackage...\033[0m"
18+ read -p "Hackage username: " username
19+ read -p "Hackage password: " -s password
20+ echo ""
21+ cabal upload -u $username -p $password dist/$1-$2.tar.gz
22+
23+ docdir=$dist/doc/html
24+ cd $docdir
25+ doc=$1-$2-docs
26+
27+ echo -e "Compressing documentation from \033[1;34m$docdir\033[0m for \033[1;35m$1\033[0m-\033[1;33m$2\033[1;30m"
28+ cp -r $1 $doc
29+ tar -c -v -z --format=ustar -f $doc.tar.gz $doc
30+ echo -e "\033[1;32mUploading documentation to Hackage...\033[0m"
31+ curl -X PUT -H 'Content-Type: application/x-tar' -H 'Content-Encoding: gzip' --data-binary "@$doc.tar.gz" "https://$username:$password@hackage.haskell.org/package/$1-$2/docs"
32+ exit $?
33+else
34+ echo -e "\033[1;31mNot in a stack-powered project\033[0m"
35+fi
src/Data/THGen/Compat.hs+23
@@ -2,6 +2,8 @@
2
2
3module Data.THGen.Compat
3module Data.THGen.Compat
4 ( dataD
4 ( dataD
5+ , newtypeD
6+ , nonStrictType
5 , strictType
7 , strictType
6 , varStrictType
8 , varStrictType
7 ) where
9 ) where
@@ -21,6 +23,27 @@ dataD name cons derivs = TH.dataD (return []) name [] Nothing cons derivCls
21dataD name = TH.dataD (return []) name []
23dataD name = TH.dataD (return []) name []
22#endif
24#endif
23
25
26+newtypeD :: TH.Name -> TH.ConQ -> [TH.Name] -> TH.DecQ
27+#if MIN_VERSION_template_haskell(2,12,0)
28+newtypeD name cons derivs = TH.newtypeD (return []) name [] Nothing cons [derivCls]
29+ where
30+ derivCls = TH.derivClause Nothing $ fmap TH.conT derivs
31+#elif MIN_VERSION_template_haskell(2,11,0)
32+newtypeD name cons derivs = TH.newtypeD (return []) name [] Nothing cons derivCls
33+ where
34+ derivCls = traverse TH.conT derivs
35+#else
36+newtypeD name = TH.newtypeD (return []) name []
37+#endif
38+
39+#if MIN_VERSION_template_haskell(2,11,0)
40+nonStrictType :: TH.TypeQ -> TH.BangTypeQ
41+nonStrictType = TH.bangType (TH.bang TH.noSourceUnpackedness TH.noSourceStrictness)
42+#else
43+nonStrictType :: TH.TypeQ -> TH.StrictTypeQ
44+nonStrictType = TH.strictType TH.notStrict
45+#endif
46+
24#if MIN_VERSION_template_haskell(2,11,0)
47#if MIN_VERSION_template_haskell(2,11,0)
25strictType :: TH.TypeQ -> TH.BangTypeQ
48strictType :: TH.TypeQ -> TH.BangTypeQ
26strictType = TH.bangType (TH.bang TH.noSourceUnpackedness TH.sourceStrict)
49strictType = TH.bangType (TH.bang TH.noSourceUnpackedness TH.sourceStrict)
src/Data/THGen/Enum.hs+10−2
@@ -25,14 +25,17 @@ module Data.THGen.Enum
25 ) where
25 ) where
26
26
27import Control.Applicative
27import Control.Applicative
28+import Control.DeepSeq
28import Control.Lens (over, _head, (<&>))
29import Control.Lens (over, _head, (<&>))
29import Control.Monad
30import Control.Monad
30import qualified Data.Char as C
31import qualified Data.Char as C
31import Data.THGen.Compat
32import Data.THGen.Compat
33+import GHC.Generics (Generic)
32import qualified Language.Haskell.TH as TH
34import qualified Language.Haskell.TH as TH
33import qualified Test.QuickCheck as QC
35import qualified Test.QuickCheck as QC
34import qualified Text.Read as R
36import qualified Text.Read as R
35
37
38+
36data Exhaustiveness = Exhaustive | NonExhaustive
39data Exhaustiveness = Exhaustive | NonExhaustive
37 deriving (Eq, Ord, Show)
40 deriving (Eq, Ord, Show)
38
41
@@ -79,7 +82,7 @@ enumGenerate (EnumDesc exh strName strVals) = do
79 dataD
82 dataD
80 name
83 name
81 (constrs ++ unknownConstr)
84 (constrs ++ unknownConstr)
82− ([''Eq, ''Ord] ++ if (exh == Exhaustive) then [''Enum, ''Bounded] else [])
85+ ([''Eq, ''Ord, ''Generic] ++ if (exh == Exhaustive) then [''Enum, ''Bounded] else [])
83 showInstDecl <- do
86 showInstDecl <- do
84 unknownMatch <- case exh of
87 unknownMatch <- case exh of
85 Exhaustive -> return []
88 Exhaustive -> return []
@@ -126,4 +129,9 @@ enumGenerate (EnumDesc exh strName strVals) = do
126 (return [])
129 (return [])
127 [t|QC.Arbitrary $(TH.conT name)|]
130 [t|QC.Arbitrary $(TH.conT name)|]
128 [funSimple 'QC.arbitrary arbExpr]
131 [funSimple 'QC.arbitrary arbExpr]
132+ nfDataInst <- do
133+ TH.instanceD
134+ (return [])
135+ [t|NFData $(TH.conT name)|]
136+ []
129− return [dataDecl, readInstDecl, showInstDecl, arbInstance]
137+ return [dataDecl, readInstDecl, showInstDecl, arbInstance, nfDataInst]
src/Data/THGen/XML.hs+20−327
@@ -1,5 +1,4 @@
1−{-# LANGUAGE UndecidableInstances #-}
1+{-# LANGUAGE NoImplicitPrelude #-}
2−{-# LANGUAGE FunctionalDependencies #-}
3
2
4{- |
3{- |
5
4
@@ -23,7 +22,7 @@ wrapper around the field type:
23
22
24Example 1.
23Example 1.
25
24
26−> "Color" =:= enum
25+> "Color" =:= enum Both
27> & "R"
26> & "R"
28> & "G"
27> & "G"
29> & "B"
28> & "B"
@@ -41,7 +40,7 @@ to be either @R@, @G@ or @B@.
41
40
42Example 2.
41Example 2.
43
42
44−> "Message" =:= record
43+> "Message" =:= record Both
45> ! "author"
44> ! "author"
46> + "recipient"
45> + "recipient"
47> ? "message" [t|Text|]
46> ? "message" [t|Text|]
@@ -68,10 +67,10 @@ enumeration is exhaustive (contains only the listed constructors) or
68non-exhaustive (also contains a constructor for unknown values; this
67non-exhaustive (also contains a constructor for unknown values; this
69is the default):
68is the default):
70
69
71−> "Enum1" Exhaustive =:= enum
70+> "Enum1" Exhaustive =:= enum Generator
72> ...
71> ...
73
72
74−> "Enum2" NonExhaustive =:= enum
73+> "Enum2" NonExhaustive =:= enum Generator
75> ...
74> ...
76
75
77To define a record, use the `record` function followed by the name of
76To define a record, use the `record` function followed by the name of
@@ -79,7 +78,7 @@ the data type to be generated. The prefix for the record fields is
79inferred automatically by taking all of the uppercase letters in the
78inferred automatically by taking all of the uppercase letters in the
80name. You can override it manually like so:
79name. You can override it manually like so:
81
80
82−> "Reference" "ref" =:= record
81+> "Reference" "ref" =:= record Parser
83> ...
82> ...
84
83
85To describe a record field you must supply its name as it appears
84To describe a record field you must supply its name as it appears
@@ -94,10 +93,14 @@ The type of the field is inferred automatically from its name, so
94if the field is called @"author"@ its type will be @Author@. You can
93if the field is called @"author"@ its type will be @Author@. You can
95override the type by specifying it in quasiquotes like so:
94override the type by specifying it in quasiquotes like so:
96
95
97−> "Message" =:= record
96+> "Message" =:= record Both
98−> ! "author" [t|Person|]
97+> ! "author" [t|Person|].
99> ...
98> ...
100
99
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+
101-}
104-}
102
105
103
106
@@ -105,6 +108,7 @@ module Data.THGen.XML
105 ( Exhaustiveness(..)
108 ( Exhaustiveness(..)
106 , PrefixName(..)
109 , PrefixName(..)
107 , ExhaustivenessName(..)
110 , ExhaustivenessName(..)
111+ , GenType(..)
108 , record
112 , record
109 , enum
113 , enum
110 , (!)
114 , (!)
@@ -114,326 +118,15 @@ module Data.THGen.XML
114 , (!%)
118 , (!%)
115 , (?%)
119 , (?%)
116 , (&)
120 , (&)
121+ , (^)
117 , (=:=)
122 , (=:=)
118 -- Re-exports
123 -- Re-exports
119− , T.Text
124+ , Text
120− , Int
125+ , P.Int
121− , Integer
126+ , P.Integer
122 ) where
127 ) where
123
128
124−import Control.Lens hiding (repeated, enum, (&))
125−import Control.Lens.Internal.FieldTH (makeFieldOpticsForDec)
126−import qualified Data.Char as C
127−import Data.List.NonEmpty (NonEmpty)
128−import Data.Maybe (maybeToList, mapMaybe)
129−import Data.String
130−import Data.THGen.Compat
131import Data.THGen.Enum
129import Data.THGen.Enum
132−import qualified Data.Text as T
130+import Data.THGen.XML.Internal
131+import Data.Text
133−import qualified Language.Haskell.TH as TH
132+import qualified Prelude as P
134−import Prelude hiding ((+), (*))
135−import Text.XML.DOM.Parser
136−import Text.XML.ParentAttributes
137−import qualified Text.XML.Writer as XW
138−import qualified Text.XML as X
139−
140−data XmlFieldPlural
141− = XmlFieldPluralMandatory -- Occurs exactly 1 time (Identity)
142− | XmlFieldPluralOptional -- Occurs 0 or 1 times (Maybe)
143− | XmlFieldPluralRepeated -- Occurs 0 or more times (List)
144− | XmlFieldPluralMultiplied -- Occurs 1 or more times (NonEmpty)
145−
146−data XmlAttributePlural
147− = XmlAttributePluralMandatory -- Occurs exactly 1 time (Identity)
148− | XmlAttributePluralOptional -- Occurs 0 or 1 times (Maybe)
149−
150−data PrefixName = PrefixName String String
151−
152−data IsoXmlDescPreField = IsoXmlDescPreField String TH.TypeQ
153−
154−data IsoXmlDescPreAttribute = IsoXmlDescPreAttribute String TH.TypeQ
155−
156−data IsoXmlDescField = IsoXmlDescField XmlFieldPlural String TH.TypeQ
157−
158−data IsoXmlDescAttribute = IsoXmlDescAttribute XmlAttributePlural String TH.TypeQ
159−
160−data IsoXmlDescRecordPart
161− = IsoXmlDescRecordField IsoXmlDescField
162− | IsoXmlDescRecordAttribute IsoXmlDescAttribute
163−
164−newtype IsoXmlDescRecord = IsoXmlDescRecord [IsoXmlDescRecordPart]
165−
166−makePrisms ''IsoXmlDescRecord
167−
168−data ExhaustivenessName = ExhaustivenessName String Exhaustiveness
169−
170−newtype IsoXmlDescEnumCon
171− = IsoXmlDescEnumCon { unIsoXmlDescEnumCon :: String }
172−
173−instance IsString IsoXmlDescEnumCon where
174− fromString = IsoXmlDescEnumCon
175−
176−data IsoXmlDescEnum = IsoXmlDescEnum [IsoXmlDescEnumCon]
177−
178−makePrisms ''IsoXmlDescEnum
179−
180−appendField
181− :: XmlFieldPlural
182− -> IsoXmlDescRecord
183− -> IsoXmlDescPreField
184− -> IsoXmlDescRecord
185−appendField plural xrec (IsoXmlDescPreField name ty) =
186− let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty
187− in over _IsoXmlDescRecord (xfield:) xrec
188−
189−appendAttribute
190− :: XmlAttributePlural
191− -> IsoXmlDescRecord
192− -> IsoXmlDescPreAttribute
193− -> IsoXmlDescRecord
194−appendAttribute plural xrec (IsoXmlDescPreAttribute name ty) =
195− let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty
196− in over _IsoXmlDescRecord (xattribute:) xrec
197−
198−(!), (?), (*), (+) :: IsoXmlDescRecord -> IsoXmlDescPreField -> IsoXmlDescRecord
199−(!) = appendField XmlFieldPluralMandatory
200−(?) = appendField XmlFieldPluralOptional
201−(*) = appendField XmlFieldPluralRepeated
202−(+) = appendField XmlFieldPluralMultiplied
203−
204−(!%), (?%) :: IsoXmlDescRecord -> IsoXmlDescPreAttribute -> IsoXmlDescRecord
205−(!%) = appendAttribute XmlAttributePluralMandatory
206−(?%) = appendAttribute XmlAttributePluralOptional
207−
208−infixl 2 !
209−infixl 2 ?
210−infixl 2 *
211−infixl 2 +
212−infixl 2 !%
213−infixl 2 ?%
214−
215−appendEnumCon :: IsoXmlDescEnum -> IsoXmlDescEnumCon -> IsoXmlDescEnum
216−appendEnumCon xenum xenumcon =
217− over _IsoXmlDescEnum (xenumcon:) xenum
218−
219−(&) :: IsoXmlDescEnum -> IsoXmlDescEnumCon -> IsoXmlDescEnum
220−(&) = appendEnumCon
221−
222−infixl 2 &
223−
224−class Description name desc | desc -> name where
225− (=:=) :: name -> desc -> TH.DecsQ
226−
227−infix 0 =:=
228−
229−instance Description PrefixName IsoXmlDescRecord where
230− prefixName =:= descRecord =
231− let descRecordParts = descRecord ^. _IsoXmlDescRecord
232− in isoXmlGenerateRecord prefixName (reverse descRecordParts)
233−
234−record :: IsoXmlDescRecord
235−record = IsoXmlDescRecord []
236−
237−enum :: IsoXmlDescEnum
238−enum = IsoXmlDescEnum []
239−
240−instance Description ExhaustivenessName IsoXmlDescEnum where
241− exhaustivenessName =:= descEnum =
242− let descEnumCons = descEnum ^. _IsoXmlDescEnum
243− in isoXmlGenerateEnum exhaustivenessName (reverse descEnumCons)
244−
245−instance IsString (TH.TypeQ -> IsoXmlDescPreField) where
246− fromString = IsoXmlDescPreField
247−
248−instance IsString IsoXmlDescPreField where
249− fromString name = IsoXmlDescPreField name ty
250− where
251− ty = (TH.conT . TH.mkName) ("Xml" ++ over _head C.toUpper name)
252−
253−instance IsString (TH.TypeQ -> IsoXmlDescPreAttribute) where
254− fromString = IsoXmlDescPreAttribute
255−
256−instance IsString IsoXmlDescPreAttribute where
257− fromString name = IsoXmlDescPreAttribute name ty
258− where
259− ty = (TH.conT . TH.mkName) ("Xml" ++ over _head C.toUpper name)
260−
261−instance s ~ String => IsString (s -> PrefixName) where
262− fromString = PrefixName
263−
264−instance IsString PrefixName where
265− fromString strName = PrefixName strName (makeNamePrefix strName)
266−
267−instance e ~ Exhaustiveness => IsString (e -> ExhaustivenessName) where
268− fromString = ExhaustivenessName
269−
270−instance IsString ExhaustivenessName where
271− fromString strName = ExhaustivenessName strName NonExhaustive
272−
273−makeNamePrefix :: String -> String
274−makeNamePrefix = map C.toLower . filter C.isUpper
275−
276−funSimple :: TH.Name -> TH.ExpQ -> TH.DecQ
277−funSimple name body = TH.funD name [ TH.clause [] (TH.normalB body) [] ]
278−
279−isoXmlGenerateEnum
280− :: ExhaustivenessName -> [IsoXmlDescEnumCon] -> TH.DecsQ
281−isoXmlGenerateEnum (ExhaustivenessName strName' exh) enumCons = do
282− let
283− strName = "Xml" ++ strName'
284− strVals = map unIsoXmlDescEnumCon enumCons
285− enumDesc = EnumDesc exh strName strVals
286− name = TH.mkName strName
287− enumDecls <- enumGenerate enumDesc
288− toXmlInst <- do
289− TH.instanceD
290− (return [])
291− [t|XW.ToXML $(TH.conT name)|]
292− [funSimple 'XW.toXML [e|XW.toXML . T.pack . show|]]
293− toXmlAttributeInst <- do
294− TH.instanceD
295− (return [])
296− [t|ToXmlAttribute $(TH.conT name)|]
297− [funSimple 'toXmlAttribute [e|T.pack . show|]]
298− fromDomInst <- do
299− TH.instanceD
300− (return [])
301− [t|FromDom $(TH.conT name)|]
302− [funSimple 'fromDom [e|parseContent readContent|]]
303− fromAttributeInst <- do
304− TH.instanceD
305− (return [])
306− [t|FromAttribute $(TH.conT name)|]
307− [funSimple 'fromAttribute [e|readContent|]]
308− return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,
309− fromDomInst, fromAttributeInst]
310−
311−isoXmlGenerateRecord :: PrefixName -> [IsoXmlDescRecordPart] -> TH.DecsQ
312−isoXmlGenerateRecord (PrefixName strName' strPrefix') descRecordParts = do
313− let
314− strName = "Xml" ++ strName'
315− strPrefix = "x" ++ strPrefix'
316− name = TH.mkName strName
317− fieldName str = "_" ++ strPrefix ++ over _head C.toUpper str
318− dataDecl <- do
319− let
320− fields = do
321− descRecordPart <- descRecordParts
322− return $ case descRecordPart of
323− IsoXmlDescRecordField descField ->
324− let
325− IsoXmlDescField fieldPlural fieldStrName fieldType = descField
326− fName = TH.mkName (fieldName fieldStrName)
327− fType = case fieldPlural of
328− XmlFieldPluralMandatory -> fieldType
329− XmlFieldPluralOptional -> [t| Maybe $fieldType |]
330− XmlFieldPluralRepeated -> [t| [$fieldType] |]
331− XmlFieldPluralMultiplied -> [t| NonEmpty $fieldType |]
332− in
333− varStrictType fName (strictType fType)
334− IsoXmlDescRecordAttribute descAttribute ->
335− let
336− IsoXmlDescAttribute
337− attributePlural attributeStrName attributeType = descAttribute
338− fName = TH.mkName (fieldName attributeStrName)
339− fType = case attributePlural of
340− XmlAttributePluralMandatory -> attributeType
341− XmlAttributePluralOptional -> [t| Maybe $attributeType |]
342− in
343− varStrictType fName (strictType fType)
344− dataD
345− name
346− [TH.recC name fields]
347− [''Eq, ''Show]
348− lensDecls <- makeFieldOpticsForDec lensRules dataDecl
349− fromDomInst <- do
350− let
351− exprHeader = [e|pure $(TH.conE name)|]
352− exprRecordParts = do
353− descRecordPart <- descRecordParts
354− return $ case descRecordPart of
355− IsoXmlDescRecordField descField ->
356− let
357− IsoXmlDescField fieldPlural fieldStrName _ = descField
358− exprFieldStrName = TH.litE (TH.stringL fieldStrName)
359− fieldParse = case fieldPlural of
360− XmlFieldPluralMandatory -> [e|inElem|]
361− _ -> [e|inElemTrav|]
362− in
363− [e|$fieldParse $exprFieldStrName fromDom|]
364− IsoXmlDescRecordAttribute descAttribute ->
365− let
366− IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute
367− exprAttributeStrName = TH.litE (TH.stringL attributeStrName)
368− attributeParse = case attributePlural of
369− XmlAttributePluralMandatory -> [e|parseAttribute|]
370− XmlAttributePluralOptional -> [e|parseAttributeMaybe|]
371− in
372− [e|$attributeParse $exprAttributeStrName fromAttribute|]
373− fromDomExpr = foldl (\e fe -> [e| $e <*> $fe |]) exprHeader exprRecordParts
374− TH.instanceD
375− (return [])
376− [t|FromDom $(TH.conT name)|]
377− [ funSimple 'fromDom fromDomExpr ]
378−
379− toXmlInst <- do
380− objName <- TH.newName strPrefix
381− let
382− exprFields = do
383− descRecordPart <- descRecordParts
384− IsoXmlDescField fieldPlural fieldStrName _ <-
385− maybeToList $ case descRecordPart of
386− IsoXmlDescRecordField descField -> Just descField
387− _ -> Nothing
388− let
389− fName = TH.mkName (fieldName fieldStrName)
390− exprFieldStrName = TH.litE (TH.stringL fieldStrName)
391− exprForField = case fieldPlural of
392− XmlFieldPluralMandatory -> [e|id|]
393− _ -> [e|traverse|]
394− exprFieldValue = [e|$(TH.varE fName) $(TH.varE objName)|]
395− exprFieldRender =
396− [e|(\a -> XW.elementA $exprFieldStrName (toXmlParentAttributes a) a)|]
397− return [e|$exprForField $exprFieldRender $exprFieldValue|]
398− toXmlExpr
399− = TH.lamE [if null exprFields then TH.wildP else TH.varP objName]
400− $ foldr (\fe e -> [e|$fe *> $e|]) [e|return ()|] exprFields
401− TH.instanceD
402− (return [])
403− [t|XW.ToXML $(TH.conT name)|]
404− [funSimple 'XW.toXML toXmlExpr]
405−
406− toXmlParentAttributesInst <- do
407− objName <- TH.newName strPrefix
408− let
409− exprAttributes = do
410− descRecordPart <- descRecordParts
411− IsoXmlDescAttribute attributePlural attributeStrName _ <-
412− maybeToList $ case descRecordPart of
413− IsoXmlDescRecordAttribute descAttribute -> Just descAttribute
414− _ -> Nothing
415− let
416− fName = TH.mkName (fieldName attributeStrName)
417− exprAttrStrName = TH.litE (TH.stringL attributeStrName)
418− exprAttrValue = [e|$(TH.varE fName) $(TH.varE objName)|]
419− exprAttrWrap = case attributePlural of
420− XmlAttributePluralMandatory -> [e|Just . toXmlAttribute|]
421− XmlAttributePluralOptional -> [e|fmap toXmlAttribute|]
422− return [e|($exprAttrStrName, $exprAttrWrap $exprAttrValue)|]
423− toXmlParentAttributesExpr
424− = TH.lamE [if null exprAttributes then TH.wildP else TH.varP objName]
425− $ [e|mapMaybe distribPair $(TH.listE exprAttributes)|]
426−#if __GLASGOW_HASKELL__ < 800
427− TH.instanceD
428−#else
429− TH.instanceWithOverlapD (Just TH.Overlapping)
430−#endif
431− (return [])
432− [t|ToXmlParentAttributes $(TH.conT name)|]
433− [funSimple 'toXmlParentAttributes toXmlParentAttributesExpr]
434−
435− return $ [dataDecl] ++ lensDecls ++
436− [fromDomInst, toXmlInst, toXmlParentAttributesInst]
437−
438−distribPair :: Functor f => (a, f b) -> f (a, b)
439−distribPair (a, fb) = (a,) <$> fb
src/Data/THGen/XML/Internal.hsnew file+416
@@ -0,0 +1,416 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE UndecidableInstances #-}
3+{-# LANGUAGE FunctionalDependencies #-}
4+
5+module Data.THGen.XML.Internal where
6+
7+import Control.DeepSeq
8+import Control.Lens hiding (repeated, enum, (&))
9+import Control.Lens.Internal.FieldTH (makeFieldOpticsForDec)
10+import qualified Data.Char as C
11+import Data.List.NonEmpty (NonEmpty)
12+import Data.Maybe (maybeToList, mapMaybe)
13+import Data.String
14+import Data.THGen.Compat as THC
15+import Data.THGen.Enum
16+import qualified Data.Text as T
17+import GHC.Generics (Generic)
18+import Language.Haskell.TH as TH
19+import Prelude hiding ((+), (*), (^))
20+import qualified Text.XML as X
21+import Text.XML.DOM.Parser hiding (parseContent)
22+import Text.XML.DOM.Parser.Internal.Content
23+import Text.XML.ParentAttributes
24+import qualified Text.XML.Writer as XW
25+
26+
27+data GenType = Parser | Generator | Both
28+
29+data XmlFieldPlural
30+ = XmlFieldPluralMandatory -- Occurs exactly 1 time (Identity)
31+ | XmlFieldPluralOptional -- Occurs 0 or 1 times (Maybe)
32+ | XmlFieldPluralRepeated -- Occurs 0 or more times (List)
33+ | XmlFieldPluralMultiplied -- Occurs 1 or more times (NonEmpty)
34+
35+data XmlAttributePlural
36+ = XmlAttributePluralMandatory -- Occurs exactly 1 time (Identity)
37+ | XmlAttributePluralOptional -- Occurs 0 or 1 times (Maybe)
38+
39+data PrefixName = PrefixName String String
40+
41+data IsoXmlDescPreField = IsoXmlDescPreField String TH.TypeQ
42+
43+data IsoXmlDescPreAttribute = IsoXmlDescPreAttribute String TH.TypeQ
44+
45+data IsoXmlDescPreContent = IsoXmlDescPreContent String TH.TypeQ
46+
47+data IsoXmlDescField = IsoXmlDescField XmlFieldPlural String TH.TypeQ
48+
49+data IsoXmlDescAttribute = IsoXmlDescAttribute XmlAttributePlural String TH.TypeQ
50+
51+data IsoXmlDescContent = IsoXmlDescContent String TH.TypeQ
52+
53+data IsoXmlDescRecordPart
54+ = IsoXmlDescRecordField IsoXmlDescField
55+ | IsoXmlDescRecordAttribute IsoXmlDescAttribute
56+ | IsoXmlDescRecordContent IsoXmlDescContent
57+
58+data IsoXmlDescRecord = IsoXmlDescRecord GenType [IsoXmlDescRecordPart]
59+
60+makePrisms ''IsoXmlDescRecord
61+
62+data ExhaustivenessName = ExhaustivenessName String Exhaustiveness
63+
64+newtype IsoXmlDescEnumCon
65+ = IsoXmlDescEnumCon { unIsoXmlDescEnumCon :: String }
66+
67+instance IsString IsoXmlDescEnumCon where
68+ fromString = IsoXmlDescEnumCon
69+
70+data IsoXmlDescEnum = IsoXmlDescEnum GenType [IsoXmlDescEnumCon]
71+
72+makePrisms ''IsoXmlDescEnum
73+
74+appendField
75+ :: XmlFieldPlural
76+ -> IsoXmlDescRecord
77+ -> IsoXmlDescPreField
78+ -> IsoXmlDescRecord
79+appendField plural (IsoXmlDescRecord genType fields) (IsoXmlDescPreField name ty) =
80+ let xfield = IsoXmlDescRecordField $ IsoXmlDescField plural name ty
81+ in IsoXmlDescRecord genType (xfield:fields)
82+
83+appendAttribute
84+ :: XmlAttributePlural
85+ -> IsoXmlDescRecord
86+ -> IsoXmlDescPreAttribute
87+ -> IsoXmlDescRecord
88+appendAttribute plural (IsoXmlDescRecord genType fields) (IsoXmlDescPreAttribute name ty) =
89+ let xattribute = IsoXmlDescRecordAttribute $ IsoXmlDescAttribute plural name ty
90+ in IsoXmlDescRecord genType (xattribute:fields)
91+
92+appendContent
93+ :: IsoXmlDescRecord
94+ -> IsoXmlDescPreContent
95+ -> IsoXmlDescRecord
96+appendContent (IsoXmlDescRecord genType fields) (IsoXmlDescPreContent name ty) =
97+ let xcontent = IsoXmlDescRecordContent $ IsoXmlDescContent name ty
98+ in IsoXmlDescRecord genType (xcontent:fields)
99+
100+(!), (?), (*), (+) :: IsoXmlDescRecord -> IsoXmlDescPreField -> IsoXmlDescRecord
101+(!) = appendField XmlFieldPluralMandatory
102+(?) = appendField XmlFieldPluralOptional
103+(*) = appendField XmlFieldPluralRepeated
104+(+) = appendField XmlFieldPluralMultiplied
105+
106+(!%), (?%) :: IsoXmlDescRecord -> IsoXmlDescPreAttribute -> IsoXmlDescRecord
107+(!%) = appendAttribute XmlAttributePluralMandatory
108+(?%) = appendAttribute XmlAttributePluralOptional
109+
110+(^) :: IsoXmlDescRecord -> IsoXmlDescPreContent -> IsoXmlDescRecord
111+(^) = appendContent
112+
113+infixl 2 !
114+infixl 2 ?
115+infixl 2 *
116+infixl 2 +
117+infixl 2 !%
118+infixl 2 ?%
119+infixl 2 ^
120+
121+appendEnumCon :: IsoXmlDescEnum -> IsoXmlDescEnumCon -> IsoXmlDescEnum
122+appendEnumCon (IsoXmlDescEnum genType enumCons) xenumcon =
123+ IsoXmlDescEnum genType (xenumcon:enumCons)
124+
125+(&) :: IsoXmlDescEnum -> IsoXmlDescEnumCon -> IsoXmlDescEnum
126+(&) = appendEnumCon
127+
128+infixl 2 &
129+
130+class Description name desc | desc -> name where
131+ (=:=) :: name -> desc -> TH.DecsQ
132+
133+infix 0 =:=
134+
135+instance Description PrefixName IsoXmlDescRecord where
136+ prefixName =:= (IsoXmlDescRecord genType descRecordParts) =
137+ isoXmlGenerateDatatype genType prefixName (reverse descRecordParts)
138+
139+record :: GenType -> IsoXmlDescRecord
140+record gt = IsoXmlDescRecord gt []
141+
142+enum :: GenType -> IsoXmlDescEnum
143+enum gt = IsoXmlDescEnum gt []
144+
145+instance Description ExhaustivenessName IsoXmlDescEnum where
146+ exhaustivenessName =:= (IsoXmlDescEnum genType descEnumCons) =
147+ isoXmlGenerateEnum genType exhaustivenessName (reverse descEnumCons)
148+
149+instance IsString (TH.TypeQ -> IsoXmlDescPreField) where
150+ fromString = IsoXmlDescPreField
151+
152+instance IsString IsoXmlDescPreField where
153+ fromString name = IsoXmlDescPreField name ty
154+ where
155+ ty = (TH.conT . TH.mkName) ("Xml" ++ over _head C.toUpper (xmlLocalName name))
156+
157+instance IsString (TH.TypeQ -> IsoXmlDescPreAttribute) where
158+ fromString = IsoXmlDescPreAttribute
159+
160+instance IsString (TH.TypeQ -> IsoXmlDescPreContent) where
161+ fromString = IsoXmlDescPreContent
162+
163+instance IsString IsoXmlDescPreAttribute where
164+ fromString name = IsoXmlDescPreAttribute name ty
165+ where
166+ ty = (TH.conT . TH.mkName) ("Xml" ++ over _head C.toUpper name)
167+
168+instance IsString IsoXmlDescPreContent where
169+ fromString name = IsoXmlDescPreContent name ty
170+ where
171+ ty = (TH.conT . TH.mkName) ("Xml" ++ over _head C.toUpper name)
172+
173+instance s ~ String => IsString (s -> PrefixName) where
174+ fromString = PrefixName
175+
176+instance IsString PrefixName where
177+ fromString strName = PrefixName strName (makeNamePrefix strName)
178+
179+instance e ~ Exhaustiveness => IsString (e -> ExhaustivenessName) where
180+ fromString = ExhaustivenessName
181+
182+instance IsString ExhaustivenessName where
183+ fromString strName = ExhaustivenessName strName NonExhaustive
184+
185+makeNamePrefix :: String -> String
186+makeNamePrefix = map C.toLower . filter C.isUpper
187+
188+funSimple :: TH.Name -> TH.ExpQ -> TH.DecQ
189+funSimple name body = TH.funD name [ TH.clause [] (TH.normalB body) [] ]
190+
191+isoXmlGenerateEnum
192+ :: GenType
193+ -> ExhaustivenessName
194+ -> [IsoXmlDescEnumCon]
195+ -> TH.DecsQ
196+isoXmlGenerateEnum genType (ExhaustivenessName strName' exh) enumCons = do
197+ let
198+ strName = "Xml" ++ strName'
199+ strVals = map unIsoXmlDescEnumCon enumCons
200+ enumDesc = EnumDesc exh strName strVals
201+ name = TH.mkName strName
202+ enumDecls <- enumGenerate enumDesc
203+ let
204+ genToXmlInst = do
205+ TH.instanceD
206+ (return [])
207+ [t|XW.ToXML $(TH.conT name)|]
208+ [funSimple 'XW.toXML [e|XW.toXML . T.pack . show|]]
209+ genToXmlAttributeInst = do
210+ TH.instanceD
211+ (return [])
212+ [t|ToXmlAttribute $(TH.conT name)|]
213+ [funSimple 'toXmlAttribute [e|T.pack . show|]]
214+ genFromDomInst = do
215+ TH.instanceD
216+ (return [])
217+ [t|FromDom $(TH.conT name)|]
218+ [funSimple 'fromDom [e|parseContent readContent|]]
219+ genFromAttributeInst = do
220+ TH.instanceD
221+ (return [])
222+ [t|FromAttribute $(TH.conT name)|]
223+ [funSimple 'fromAttribute [e|readContent|]]
224+ case genType of
225+ Generator -> do
226+ toXmlInst <- genToXmlInst
227+ toXmlAttributeInst <- genToXmlAttributeInst
228+ return $ enumDecls ++ [toXmlInst, toXmlAttributeInst]
229+ Parser -> do
230+ fromDomInst <- genFromDomInst
231+ fromAttributeInst <- genFromAttributeInst
232+ return $ enumDecls ++ [fromDomInst, fromAttributeInst]
233+ Both -> do
234+ toXmlInst <- genToXmlInst
235+ toXmlAttributeInst <- genToXmlAttributeInst
236+ fromDomInst <- genFromDomInst
237+ fromAttributeInst <- genFromAttributeInst
238+ return $ enumDecls ++ [toXmlInst, toXmlAttributeInst,
239+ fromDomInst, fromAttributeInst]
240+
241+isoXmlGenerateDatatype :: GenType -> PrefixName -> [IsoXmlDescRecordPart] -> TH.DecsQ
242+isoXmlGenerateDatatype genType (PrefixName strName' strPrefix') descRecordParts = do
243+ let
244+ isNewtype = length descRecordParts == 1
245+ strName = "Xml" ++ strName'
246+ strPrefix = "x" ++ strPrefix'
247+ name = TH.mkName strName
248+ fieldName str = "_" ++ strPrefix ++ over _head C.toUpper str
249+ termDecl <- do
250+ let
251+ fields = do
252+ descRecordPart <- descRecordParts
253+ return $ case descRecordPart of
254+ IsoXmlDescRecordField descField ->
255+ let
256+ IsoXmlDescField fieldPlural rawName fieldType = descField
257+ fieldStrName = xmlLocalName rawName
258+ fName = TH.mkName (fieldName fieldStrName)
259+ fType = case fieldPlural of
260+ XmlFieldPluralMandatory -> fieldType
261+ XmlFieldPluralOptional -> [t| Maybe $fieldType |]
262+ XmlFieldPluralRepeated -> [t| [$fieldType] |]
263+ XmlFieldPluralMultiplied -> [t| NonEmpty $fieldType |]
264+ in if isNewtype
265+ then THC.varStrictType fName (THC.nonStrictType fType)
266+ else THC.varStrictType fName (THC.strictType fType)
267+ IsoXmlDescRecordAttribute descAttribute ->
268+ let
269+ IsoXmlDescAttribute
270+ attributePlural attributeStrName attributeType = descAttribute
271+ fName = TH.mkName (fieldName attributeStrName)
272+ fType = case attributePlural of
273+ XmlAttributePluralMandatory -> attributeType
274+ XmlAttributePluralOptional -> [t| Maybe $attributeType |]
275+ in if isNewtype
276+ then THC.varStrictType fName (THC.nonStrictType fType)
277+ else THC.varStrictType fName (THC.strictType fType)
278+ IsoXmlDescRecordContent descContent ->
279+ let
280+ IsoXmlDescContent contentStrName contentType = descContent
281+ fName = TH.mkName (fieldName contentStrName)
282+ fType = contentType
283+ in if isNewtype
284+ then THC.varStrictType fName (THC.nonStrictType fType)
285+ else THC.varStrictType fName (THC.strictType fType)
286+ if isNewtype
287+ -- generate a newtype instead to do less allocations later
288+ then THC.newtypeD name (TH.recC name fields) [''Eq, ''Show, ''Generic]
289+ else THC.dataD name [TH.recC name fields] [''Eq, ''Show, ''Generic]
290+ lensDecls <- makeFieldOpticsForDec lensRules termDecl
291+ nfDataInst <- do
292+ TH.instanceD
293+ (return [])
294+ [t|NFData $(TH.conT name)|]
295+ [ ]
296+
297+ let
298+ genFromDomInst = do
299+ let
300+ exprHeader = [e|pure $(TH.conE name)|]
301+ exprRecordParts = do
302+ descRecordPart <- descRecordParts
303+ return $ case descRecordPart of
304+ IsoXmlDescRecordField descField ->
305+ let
306+ IsoXmlDescField fieldPlural rawName _ = descField
307+ fieldStrName = xmlLocalName rawName
308+ exprFieldStrName = TH.litE (TH.stringL fieldStrName)
309+ fieldParse = case fieldPlural of
310+ XmlFieldPluralMandatory -> [e|inElem|]
311+ _ -> [e|inElemTrav|]
312+ in
313+ [e|$fieldParse $exprFieldStrName fromDom|]
314+ IsoXmlDescRecordAttribute descAttribute ->
315+ let
316+ IsoXmlDescAttribute attributePlural attributeStrName _ = descAttribute
317+ exprAttributeStrName = TH.litE (TH.stringL attributeStrName)
318+ attributeParse = case attributePlural of
319+ XmlAttributePluralMandatory -> [e|parseAttribute|]
320+ XmlAttributePluralOptional -> [e|parseAttributeMaybe|]
321+ in
322+ [e|$attributeParse $exprAttributeStrName fromAttribute|]
323+ IsoXmlDescRecordContent _ -> [e|parseContent fromAttribute|]
324+ fromDomExpr = foldl (\e fe -> [e| $e <*> $fe |]) exprHeader exprRecordParts
325+ TH.instanceD
326+ (return [])
327+ [t|FromDom $(TH.conT name)|]
328+ [ funSimple 'fromDom fromDomExpr ]
329+
330+ genToXmlInst = do
331+ objName <- TH.newName strPrefix
332+ let
333+ exprFields = do
334+ descRecordPart <- descRecordParts
335+ case descRecordPart of
336+ IsoXmlDescRecordField (IsoXmlDescField fieldPlural rawName _) -> do
337+ let
338+ fieldStrName = xmlLocalName rawName
339+ fName = TH.mkName (fieldName fieldStrName)
340+ exprFieldStrName = TH.litE (TH.stringL rawName)
341+ exprForField = case fieldPlural of
342+ XmlFieldPluralMandatory -> [e|id|]
343+ _ -> [e|traverse|]
344+ exprFieldValue = [e|$(TH.varE fName) $(TH.varE objName)|]
345+ exprFieldRender =
346+ [e|(\a ->
347+ XW.elementA $exprFieldStrName (toXmlParentAttributes a) a)|]
348+ return [e|$exprForField $exprFieldRender $exprFieldValue|]
349+ IsoXmlDescRecordContent (IsoXmlDescContent rawName _) -> do
350+ let
351+ fieldStrName = xmlLocalName rawName
352+ fName = TH.mkName (fieldName fieldStrName)
353+ exprFieldValue = [e|$(TH.varE fName) $(TH.varE objName)|]
354+ return [e|XW.content . toXmlAttribute $ $exprFieldValue|]
355+ _ -> []
356+ toXmlExpr
357+ = TH.lamE [if null exprFields then TH.wildP else TH.varP objName]
358+ $ foldr (\fe e -> [e|$fe *> $e|]) [e|return ()|] exprFields
359+ TH.instanceD
360+ (return [])
361+ [t|XW.ToXML $(TH.conT name)|]
362+ [funSimple 'XW.toXML toXmlExpr]
363+ genToXmlParentAttributeInst = do
364+ objName <- TH.newName strPrefix
365+ let
366+ exprAttributes = do
367+ descRecordPart <- descRecordParts
368+ IsoXmlDescAttribute attributePlural attributeStrName _ <-
369+ maybeToList $ case descRecordPart of
370+ IsoXmlDescRecordAttribute descAttribute -> Just descAttribute
371+ _ -> Nothing
372+ let
373+ fName = TH.mkName (fieldName attributeStrName)
374+ exprAttrStrName = TH.litE (TH.stringL attributeStrName)
375+ exprAttrValue = [e|$(TH.varE fName) $(TH.varE objName)|]
376+ exprAttrWrap = case attributePlural of
377+ XmlAttributePluralMandatory -> [e|Just . toXmlAttribute|]
378+ XmlAttributePluralOptional -> [e|fmap toXmlAttribute|]
379+ return [e|($exprAttrStrName, $exprAttrWrap $exprAttrValue)|]
380+ toXmlParentAttributesExpr
381+ = TH.lamE [if null exprAttributes then TH.wildP else TH.varP objName]
382+ $ [e|mapMaybe distribPair $(TH.listE exprAttributes)|]
383+#if __GLASGOW_HASKELL__ < 800
384+ TH.instanceD
385+#else
386+ TH.instanceWithOverlapD (Just TH.Overlapping)
387+#endif
388+ (return [])
389+ [t|ToXmlParentAttributes $(TH.conT name)|]
390+ [funSimple 'toXmlParentAttributes toXmlParentAttributesExpr]
391+
392+ case genType of
393+ Generator -> do
394+ toXmlInst <- genToXmlInst
395+ toXmlParentAttributesInst <- genToXmlParentAttributeInst
396+ return $ [termDecl] ++ lensDecls ++
397+ [toXmlInst, toXmlParentAttributesInst, nfDataInst]
398+ Parser -> do
399+ fromDomInst <- genFromDomInst
400+ return $ [termDecl] ++ lensDecls ++ [fromDomInst, nfDataInst]
401+ Both -> do
402+ toXmlInst <- genToXmlInst
403+ toXmlParentAttributesInst <- genToXmlParentAttributeInst
404+ fromDomInst <- genFromDomInst
405+ return $ [termDecl] ++ lensDecls ++
406+ [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]
407+
408+distribPair :: Functor f => (a, f b) -> f (a, b)
409+distribPair (a, fb) = (a,) <$> fb
410+
411+-- | Get a local part of (possibly) fully qualified 'X.Name':
412+--
413+-- >>> xmlLocalName "{http://example.com/ns/my-namespace}my-name"
414+-- "my-name"
415+xmlLocalName :: String -> String
416+xmlLocalName = T.unpack . X.nameLocalName . fromString
src/Text/XML/DOM/Parser/Internal/Content.hsnew file+28
@@ -0,0 +1,28 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Text.XML.DOM.Parser.Internal.Content where
3+import Control.Lens
4+import Control.Monad.Reader
5+import Data.Text as T
6+import Text.XML
7+import Text.XML.DOM.Parser hiding (getCurrentContent, parseContent)
8+
9+-- Get current content. If there are more than one content
10+-- they are intercalate with space like in xpath `text()`
11+--
12+getCurrentContent :: (Monad m) => DomParserT Identity m Text
13+getCurrentContent
14+ = T.intercalate " "
15+ . (\e -> [T.strip cs| (NodeContent cs) <- e])
16+ . elementNodes
17+ . runIdentity
18+ . _pdElements
19+ <$> ask
20+
21+parseContent
22+ :: (Monad m)
23+ => (Text -> Either Text a)
24+ -- ^ Content parser, return error msg if value is not parsed
25+ -> DomParserT Identity m a
26+parseContent parse
27+ = getCurrentContent
28+ >>= either (throwParserError . PEContentWrongFormat) return . parse
stack.yaml+1−5
@@ -1,8 +1,4 @@
1−resolver: lts-6.35
1+resolver: lts-10.0
2−
3−packages:
4−- .
5−
6extra-deps:
2extra-deps:
7- dom-parser-3.0.0
3- dom-parser-3.0.0
8- generic-arbitrary-0.1.0
4- generic-arbitrary-0.1.0
test/TestDefs.hs+7−11
@@ -4,17 +4,16 @@
4
4
5module TestDefs where
5module TestDefs where
6
6
7−import Data.List.NonEmpty
7+-- import Data.List.NonEmpty
8import Data.THGen.XML
8import Data.THGen.XML
9−import GHC.Generics (Generic)
10import Test.QuickCheck.Arbitrary.Generic
9import Test.QuickCheck.Arbitrary.Generic
11import Test.QuickCheck.Instances ()
10import Test.QuickCheck.Instances ()
12
11
13−"Bar" =:= enum
12+"Bar" =:= enum Both
14 & "baroque"
13 & "baroque"
15 & "bartender"
14 & "bartender"
16
15
17−"Quux" Exhaustive =:= enum
16+"Quux" Exhaustive =:= enum Both
18 & "ALL"
17 & "ALL"
19 & "YOUR"
18 & "YOUR"
20 & "BASE"
19 & "BASE"
@@ -23,23 +22,20 @@ import Test.QuickCheck.Instances ()
23 & "TO"
22 & "TO"
24 & "US"
23 & "US"
25
24
26−"Foo" =:= record
25+"Foo" =:= record Both
26+ ^ "Shmuux" [t|XmlQuux|]
27 + "Bar"
27 + "Bar"
28 ? "Baz" [t|Text|]
28 ? "Baz" [t|Text|]
29 !% "Quux"
29 !% "Quux"
30 ?% "Muux" [t|XmlQuux|]
30 ?% "Muux" [t|XmlQuux|]
31
31
32−"Root" =:= record
32+"Root" =:= record Both
33− ! "Foo"
33+ ! "{http://example.com/ns/my-namespace}Foo"
34−
35−deriving instance Generic XmlRoot
36
34
37instance Arbitrary XmlRoot where
35instance Arbitrary XmlRoot where
38 arbitrary = genericArbitrary
36 arbitrary = genericArbitrary
39 shrink = genericShrink
37 shrink = genericShrink
40
38
41−deriving instance Generic XmlFoo
42−
43instance Arbitrary XmlFoo where
39instance Arbitrary XmlFoo where
44 arbitrary = genericArbitrary
40 arbitrary = genericArbitrary
45 shrink = genericShrink
41 shrink = genericShrink
xml-isogen.cabal+7−2
@@ -1,5 +1,5 @@
1name: xml-isogen
1name: xml-isogen
2−version: 0.2.1
2+version: 0.3.1
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
@@ -18,7 +18,8 @@ cabal-version: >=1.22
18homepage: https://github.com/typeable/xml-isogen
18homepage: https://github.com/typeable/xml-isogen
19tested-with: GHC == 7.10.3
19tested-with: GHC == 7.10.3
20 , GHC == 8.0.2
20 , GHC == 8.0.2
21− , GHC == 8.2.1
21+ , GHC == 8.2.2
22+ , GHC == 8.4.1
22extra-source-files: CHANGELOG.md
23extra-source-files: CHANGELOG.md
23 , README.md
24 , README.md
24
25
@@ -29,11 +30,14 @@ source-repository head
29library
30library
30 exposed-modules: Data.THGen.Enum
31 exposed-modules: Data.THGen.Enum
31 , Data.THGen.XML
32 , Data.THGen.XML
33+ , Data.THGen.XML.Internal
32 , Text.XML.ParentAttributes
34 , Text.XML.ParentAttributes
33 other-modules: Data.THGen.Compat
35 other-modules: Data.THGen.Compat
36+ , Text.XML.DOM.Parser.Internal.Content
34 build-depends: QuickCheck >= 2.8
37 build-depends: QuickCheck >= 2.8
35 , base >=4.8 && <5
38 , base >=4.8 && <5
36 , dom-parser >= 2.0.0
39 , dom-parser >= 2.0.0
40+ , deepseq
37 , lens >= 4.13
41 , lens >= 4.13
38 , mtl >= 2.2
42 , mtl >= 2.2
39 , semigroups >= 0.18
43 , semigroups >= 0.18
@@ -60,6 +64,7 @@ test-suite spec
60 build-depends: base
64 build-depends: base
61 , QuickCheck
65 , QuickCheck
62 , data-default
66 , data-default
67+ , deepseq
63 , dom-parser
68 , dom-parser
64 , generic-arbitrary
69 , generic-arbitrary
65 , hspec
70 , hspec