git.iko.soy/typeable/xml-isogen
on master help sign in
Rebase and fix some NFData related issues
commit1f3fea0eec38a9af0bb11feeb6a6f8e713569e9e authorDenis Redozubov <denis.redozubov@gmail.com> dateTue 13 Mar 2018, 13:33 (9 years ago) parent86ae2ce
2 files changed+16−13
compare with master
unifiedsplit
src/Data/THGen/Enum.hs+10−2 src/Data/THGen/XML.hs+6−11
src/Data/THGen/Enum.hs+10−2
@@ -25,14 +25,17 @@ module Data.THGen.Enum
2525 ) where
2626
2727import Control.Applicative
28+import Control.DeepSeq
2829import Control.Lens (over, _head, (<&>))
2930import Control.Monad
3031import qualified Data.Char as C
3132import Data.THGen.Compat
33+import GHC.Generics (Generic)
3234import qualified Language.Haskell.TH as TH
3335import qualified Test.QuickCheck as QC
3436import qualified Text.Read as R
3537
38+
3639data Exhaustiveness = Exhaustive | NonExhaustive
3740 deriving (Eq, Ord, Show)
3841
@@ -79,7 +82,7 @@ enumGenerate (EnumDesc exh strName strVals) = do
7982 dataD
8083 name
8184 (constrs ++ unknownConstr)
82− ([''Eq, ''Ord] ++ if (exh == Exhaustive) then [''Enum, ''Bounded] else [])
85+ ([''Eq, ''Ord, ''Generic] ++ if (exh == Exhaustive) then [''Enum, ''Bounded] else [])
8386 showInstDecl <- do
8487 unknownMatch <- case exh of
8588 Exhaustive -> return []
@@ -126,4 +129,9 @@ enumGenerate (EnumDesc exh strName strVals) = do
126129 (return [])
127130 [t|QC.Arbitrary $(TH.conT name)|]
128131 [funSimple 'QC.arbitrary arbExpr]
129− return [dataDecl, readInstDecl, showInstDecl, arbInstance]
132+ nfDataInst <- do
133+ TH.instanceD
134+ (return [])
135+ [t|NFData $(TH.conT name)|]
136+ []
137+ return [dataDecl, readInstDecl, showInstDecl, arbInstance, nfDataInst]
src/Data/THGen/XML.hs+6−11
@@ -347,21 +347,16 @@ isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do
347347 XmlAttributePluralOptional -> [t| Maybe $attributeType |]
348348 in
349349 varStrictType fName (strictType fType)
350− dataD
351− name
352− [TH.recC name fields]
353− [''Eq, ''Show, ''Generic]
354− lensDecls <- makeFieldOpticsForDec lensRules dataDecl
350+ if isNewtype
351+ -- generate a newtype instead to do less allocations later
352+ then newtypeD name (TH.recC name fields) [''Eq, ''Show, ''Generic]
353+ else dataD name [TH.recC name fields] [''Eq, ''Show, ''Generic]
354+ lensDecls <- makeFieldOpticsForDec lensRules termDecl
355355 nfDataInst <- do
356356 TH.instanceD
357357 (return [])
358358 [t|NFData $(TH.conT name)|]
359359 [ ]
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
365360 fromDomInst <- do
366361 let
367362 exprHeader = [e|pure $(TH.conE name)|]
@@ -449,7 +444,7 @@ isoXmlGenerateDatatype (PrefixName strName' strPrefix') descRecordParts = do
449444 [funSimple 'toXmlParentAttributes toXmlParentAttributesExpr]
450445
451446 return $ [termDecl] ++ lensDecls ++
452− [fromDomInst, toXmlInst, toXmlParentAttributesInst]
447+ [fromDomInst, toXmlInst, toXmlParentAttributesInst, nfDataInst]
453448
454449distribPair :: Functor f => (a, f b) -> f (a, b)
455450distribPair (a, fb) = (a,) <$> fb