git.iko.soy/typeable/xml-isogen
on master help sign in
Rebase and fix some NFData related issues
1f3fea0Denis Redozubov
src/Data/THGen/Enum.hs+10−2
compare with master
unifiedsplit
@@ -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+6−11
@@ -347,21 +347,16 @@ isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do
347 XmlAttributePluralOptional -> [t| Maybe $attributeType |]
347 XmlAttributePluralOptional -> [t| Maybe $attributeType |]
348 in
348 in
349 varStrictType fName (strictType fType)
349 varStrictType fName (strictType fType)
350− dataD
350+ if isNewtype
351− name
351+ -- generate a newtype instead to do less allocations later
352+ then newtypeD name (TH.recC name fields) [''Eq, ''Show, ''Generic]
352− [TH.recC name fields]
353+ else dataD name [TH.recC name fields] [''Eq, ''Show, ''Generic]
353− [''Eq, ''Show, ''Generic]
354− lensDecls <- makeFieldOpticsForDec lensRules dataDecl
354+ lensDecls <- makeFieldOpticsForDec lensRules termDecl
355 nfDataInst <- do
355 nfDataInst <- do
356 TH.instanceD
356 TH.instanceD
357 (return [])
357 (return [])
358 [t|NFData $(TH.conT name)|]
358 [t|NFData $(TH.conT name)|]
359 [ ]
359 [ ]
360− if isNewtype
361− -- generate a newtype instead to do less allocations later
362− then newtypeD name (TH.recC name fields) [''Eq, ''Show]
363− else dataD name [TH.recC name fields] [''Eq, ''Show]
364− lensDecls <- makeFieldOpticsForDec lensRules termDecl
365 fromDomInst <- do
360 fromDomInst <- do
366 let
361 let
367 exprHeader = [e|pure $(TH.conE name)|]
362 exprHeader = [e|pure $(TH.conE name)|]
@@ -449,7 +444,7 @@ isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do
449 [funSimple 'toXmlParentAttributes toXmlParentAttributesExpr]
444 [funSimple 'toXmlParentAttributes toXmlParentAttributesExpr]
450
445
451 return $ [termDecl] ++ lensDecls ++
446 return $ [termDecl] ++ lensDecls ++
452− [fromDomInst, toXmlInst, toXmlParentAttributesInst]
447+ [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]
453
448
454distribPair :: Functor f => (a, f b) -> f (a, b)
449distribPair :: Functor f => (a, f b) -> f (a, b)
455distribPair (a, fb) = (a,) <$> fb
450distribPair (a, fb) = (a,) <$> fb