deriving-compat 0.3 → 0.3.1
raw patch · 8 files changed
+64/−37 lines, 8 filesdep ~deriving-compatPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: deriving-compat
API changes (from Hackage documentation)
Files
- CHANGELOG.md +4/−0
- deriving-compat.cabal +2/−2
- src/Data/Deriving/Internal.hs +6/−0
- src/Data/Eq/Deriving/Internal.hs +4/−2
- src/Data/Functor/Deriving/Internal.hs +29/−20
- src/Data/Ord/Deriving/Internal.hs +4/−2
- src/Text/Read/Deriving/Internal.hs +9/−7
- src/Text/Show/Deriving/Internal.hs +6/−4
CHANGELOG.md view
@@ -1,3 +1,7 @@+### 0.3.1+* Allow deriving `Functor` and `Foldable` instances for datatypes containing unboxed tuples+* Microoptimization in derived instances of higher-order versions of `Eq`, `Ord`, `Read`, and `Show`+ ## 0.3 * Added `Data.Eq.Deriving`, which allows deriving `Eq`, `Eq1`, and `Eq2` with TH. * Added `Data.Ord.Deriving`, which allows deriving `Ord`, `Ord1`, and `Ord2` with TH.
deriving-compat.cabal view
@@ -1,5 +1,5 @@ name: deriving-compat-version: 0.3+version: 0.3.1 synopsis: Backports of GHC deriving extensions description: Provides Template Haskell functions that mimic deriving extensions that were introduced or modified in recent versions@@ -137,7 +137,7 @@ Types.ReadShow build-depends: base-compat >= 0.8.1 && < 1 , base-orphans >= 0.5 && < 1- , deriving-compat == 0.3+ , deriving-compat == 0.3.1 , hspec >= 1.8 , QuickCheck >= 2 && < 3
src/Data/Deriving/Internal.hs view
@@ -55,6 +55,12 @@ import Language.Haskell.TH.Ppr (pprint) import Language.Haskell.TH.Syntax +-- Ensure, beyond a shadow of a doubt, that the instances are in-scope+import Data.Functor ()+import Data.Functor.Classes ()+import Data.Foldable ()+import Data.Traversable ()+ #ifndef CURRENT_PACKAGE_KEY import Data.Version (showVersion) import Paths_deriving_compat (version)
src/Data/Eq/Deriving/Internal.hs view
@@ -284,8 +284,10 @@ if any (`mentionsName` tyVarNames) lhsArgs || itf && any (`mentionsName` tyVarNames) tyArgs then outOfPlaceTyVarError eClass conName- else appsE $ [ varE . eqName $ toEnum numLastArgs]- ++ map (makeCaseForType eClass tvMap conName) rhsArgs+ else if any (`mentionsName` tyVarNames) rhsArgs+ then appsE $ [ varE . eqName $ toEnum numLastArgs]+ ++ map (makeCaseForType eClass tvMap conName) rhsArgs+ else varE eqValName #else makeCaseForType eClass tvMap conName ty = do let varNames = Map.keys tvMap
src/Data/Functor/Deriving/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-| Module: Data.Functor.Deriving.Internal@@ -261,8 +262,29 @@ mentionsTyArgs :: Bool mentionsTyArgs = any (`mentionsName` tyVarNames) tyArgs - makeFunctorFunTuple :: Type -> Name -> Q (Either Exp Exp)- makeFunctorFunTuple fieldTy fieldName =+ makeFunctorFunTuple :: ([Q Pat] -> Q Pat) -> (Int -> Name) -> Int+ -> Q (Either Exp Exp)+ makeFunctorFunTuple mkTupP mkTupleDataName n = do+ args <- mapM newName $ catMaybes [ Just "x"+ , guard (ff == Foldr) >> Just "z"+ ]+ xs <- newNameList "_tup" n++ let x = head args+ z = last args+ fmap Right $ lamE (map varP args) $ caseE (varE x)+ [ match (mkTupP $ map varP xs)+ (normalB $ functorFunCombine ff+ (mkTupleDataName n)+ z+ xs+ (zipWithM makeFunctorFunTupleField tyArgs xs)+ )+ []+ ]++ makeFunctorFunTupleField :: Type -> Name -> Q (Either Exp Exp)+ makeFunctorFunTupleField fieldTy fieldName = makeFunctorFunForType ff tvMap conName covariant fieldTy `appEitherE` varE fieldName @@ -281,25 +303,12 @@ where covFunctorFun :: Bool -> Type -> Q Exp covFunctorFun cov = fmap fromEither . makeFunctorFunForType ff tvMap conName cov+#if MIN_VERSION_template_haskell(2,6,0)+ UnboxedTupleT n+ | n > 0 && mentionsTyArgs -> makeFunctorFunTuple unboxedTupP unboxedTupleDataName n+#endif TupleT n- | n > 0 && mentionsTyArgs -> do- args <- mapM newName $ catMaybes [ Just "x"- , guard (ff == Foldr) >> Just "z"- ]- xs <- newNameList "_tup" n-- let x = head args- z = last args- fmap Right $ lamE (map varP args) $ caseE (varE x)- [ match (tupP $ map varP xs)- (normalB $ functorFunCombine ff- (tupleDataName n)- z- xs- (zipWithM makeFunctorFunTuple tyArgs xs)- )- []- ]+ | n > 0 && mentionsTyArgs -> makeFunctorFunTuple tupP tupleDataName n _ -> do itf <- isTyFamily tyCon if any (`mentionsName` tyVarNames) lhsArgs || (itf && mentionsTyArgs)
src/Data/Ord/Deriving/Internal.hs view
@@ -411,8 +411,10 @@ if any (`mentionsName` tyVarNames) lhsArgs || itf && any (`mentionsName` tyVarNames) tyArgs then outOfPlaceTyVarError oClass conName- else appsE $ [ varE . ordFunName oFun $ toEnum numLastArgs]- ++ map (makeOrdFunForType oFun tvMap conName) rhsArgs+ else if any (`mentionsName` tyVarNames) rhsArgs+ then appsE $ [ varE . ordFunName oFun $ toEnum numLastArgs]+ ++ map (makeOrdFunForType oFun tvMap conName) rhsArgs+ else varE $ ordFunName oFun 0 #else makeOrdFunForType oFun tvMap conName ty = do let varNames = Map.keys tvMap
src/Text/Read/Deriving/Internal.hs view
@@ -695,13 +695,15 @@ if any (`mentionsName` tyVarNames) lhsArgs || itf && any (`mentionsName` tyVarNames) tyArgs then outOfPlaceTyVarError rClass conName- else do- readExp <- appsE $ [ varE . readsOrReadName urp rl $ toEnum numLastArgs]- ++ zipWith (\b -> fmap fst- . makeReadForType rClass urp tvMap conName tyExpName b)- (cycle [False,True])- (interleave rhsArgs rhsArgs)- return (readExp, VarE tyExpName)+ else if any (`mentionsName` tyVarNames) rhsArgs+ then do+ readExp <- appsE $ [ varE . readsOrReadName urp rl $ toEnum numLastArgs]+ ++ zipWith (\b -> fmap fst+ . makeReadForType rClass urp tvMap conName tyExpName b)+ (cycle [False,True])+ (interleave rhsArgs rhsArgs)+ return (readExp, VarE tyExpName)+ else return (VarE $ readsOrReadName urp rl Read, VarE tyExpName) #else makeReadForType rClass urp tvMap conName tyExpName _ ty = do let varNames = Map.keys tvMap
src/Text/Show/Deriving/Internal.hs view
@@ -550,10 +550,12 @@ if any (`mentionsName` tyVarNames) lhsArgs || itf && any (`mentionsName` tyVarNames) tyArgs then outOfPlaceTyVarError sClass conName- else appsE $ [ varE . showsPrecOrListName sl $ toEnum numLastArgs]- ++ zipWith (makeShowForType sClass conName tvMap)- (cycle [False,True])- (interleave rhsArgs rhsArgs)+ else if any (`mentionsName` tyVarNames) rhsArgs+ then appsE $ [ varE . showsPrecOrListName sl $ toEnum numLastArgs]+ ++ zipWith (makeShowForType sClass conName tvMap)+ (cycle [False,True])+ (interleave rhsArgs rhsArgs)+ else varE $ if sl then showListValName else showsPrecValName #else makeShowForType sClass conName tvMap _ ty = do let varNames = Map.keys tvMap