deriving-compat 0.5.4 → 0.5.5
raw patch · 11 files changed
+215/−135 lines, 11 filesdep ~th-abstractionPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: th-abstraction
API changes (from Hackage documentation)
Files
- CHANGELOG.md +3/−0
- deriving-compat.cabal +3/−3
- src/Data/Bounded/Deriving/Internal.hs +20/−12
- src/Data/Deriving/Via/Internal.hs +14/−5
- src/Data/Enum/Deriving/Internal.hs +22/−12
- src/Data/Eq/Deriving/Internal.hs +26/−18
- src/Data/Functor/Deriving/Internal.hs +26/−18
- src/Data/Ix/Deriving/Internal.hs +22/−12
- src/Data/Ord/Deriving/Internal.hs +27/−19
- src/Text/Read/Deriving/Internal.hs +26/−18
- src/Text/Show/Deriving/Internal.hs +26/−18
CHANGELOG.md view
@@ -1,3 +1,6 @@+### 0.5.5 [2019.04.26]+* Support `th-abstraction-0.3` or later.+ ### 0.5.4 [2019.01.21] * Expose `Internal` modules.
deriving-compat.cabal view
@@ -1,5 +1,5 @@ name: deriving-compat-version: 0.5.4+version: 0.5.5 synopsis: Backports of GHC deriving extensions description: Provides Template Haskell functions that mimic deriving extensions that were introduced or modified in recent versions@@ -71,7 +71,7 @@ , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4- , GHC == 8.6.3+ , GHC == 8.6.4 cabal-version: >=1.10 source-repository head@@ -120,7 +120,7 @@ other-modules: Paths_deriving_compat build-depends: containers >= 0.1 && < 0.7 , ghc-prim- , th-abstraction >= 0.2.9 && < 0.3+ , th-abstraction >= 0.2.9 && < 0.4 if flag(base-4-9) build-depends: base >= 4.9 && < 5
src/Data/Bounded/Deriving/Internal.hs view
@@ -35,14 +35,18 @@ deriveBounded name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance BoundedClass parentName ctxt vars variant+ <- buildTypeInstance BoundedClass parentName ctxt instTypes variant (:[]) `fmap` instanceD (return instanceCxt) (return instanceType) (boundedFunDecs parentName cons)@@ -74,16 +78,20 @@ makeBoundedFun bf name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have minBound/maxBound -- implemented for it, and produces errors if it can't.- buildTypeInstance BoundedClass parentName ctxt vars variant+ buildTypeInstance BoundedClass parentName ctxt instTypes variant >> makeBoundedFunForCons bf parentName cons -- | Generates a lambda expression for minBound/maxBound. for the
src/Data/Deriving/Via/Internal.hs view
@@ -109,9 +109,14 @@ Nothing -> case dataTy of ConT dataName -> do- DatatypeInfo { datatypeVars = dataVars- , datatypeVariant = dv- , datatypeCons = cons+ DatatypeInfo {+#if MIN_VERSION_th_abstraction(0,3,0)+ datatypeInstTypes = dataInstTypes+#else+ datatypeVars = dataInstTypes+#endif+ , datatypeVariant = dv+ , datatypeCons = cons } <- reifyDatatype dataName case newtypeRepType dv cons of Just newtypeRepTy ->@@ -120,7 +125,7 @@ let repTySubst = M.fromList $ zipWith (\var arg -> (varTToName var, arg))- dataVars dataArgs+ dataInstTypes dataArgs in return $ applySubstitution repTySubst etaRepTy Nothing -> etaReductionError instanceTy Nothing -> fail $ "Not a newtype: " ++ nameBase dataName@@ -149,7 +154,11 @@ tfLHSTys = map (applySubstitution lhsSubst) tfTvbTys tfRHSTys = map (applySubstitution rhsSubst) tfTvbTys tfRHSTy = applyTy (ConT tfName) tfRHSTys- tfInst <- tySynInstDCompat tfName (map pure tfLHSTys) (pure tfRHSTy)+ tfInst <- tySynInstDCompat tfName+#if MIN_VERSION_th_abstraction(0,3,0)+ Nothing+#endif+ (map pure tfLHSTys) (pure tfRHSTy) pure (Just [tfInst]) go (SigD methName methTy) =
src/Data/Enum/Deriving/Internal.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {-| Module: Data.Enum.Deriving.Internal Copyright: (C) 2015-2017 Ryan Scott@@ -37,14 +39,18 @@ deriveEnum name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance EnumClass parentName ctxt vars variant+ <- buildTypeInstance EnumClass parentName ctxt instTypes variant (:[]) `fmap` instanceD (return instanceCxt) (return instanceType) (enumFunDecs parentName instanceType cons)@@ -103,13 +109,17 @@ makeEnumFun ef name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do- (_, instanceType) <- buildTypeInstance EnumClass parentName ctxt vars variant+ (_, instanceType) <- buildTypeInstance EnumClass parentName ctxt instTypes variant makeEnumFunForCons ef parentName instanceType cons -- | Generates a lambda expression for fromEnum/toEnum/etc. for the
src/Data/Eq/Deriving/Internal.hs view
@@ -116,26 +116,30 @@ deriveEqClass eClass name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance eClass parentName ctxt vars variant+ <- buildTypeInstance eClass parentName ctxt instTypes variant (:[]) `fmap` instanceD (return instanceCxt) (return instanceType)- (eqDecs eClass vars cons)+ (eqDecs eClass instTypes cons) -- | Generates a declaration defining the primary function corresponding to a -- particular class ((==) for Eq, liftEq for Eq1, and -- liftEq2 for Eq2). eqDecs :: EqClass -> [Type] -> [ConstructorInfo] -> [Q Dec]-eqDecs eClass vars cons =+eqDecs eClass instTypes cons = [ funD (eqName eClass) [ clause []- (normalB $ makeEqForCons eClass vars cons)+ (normalB $ makeEqForCons eClass instTypes cons) [] ] ]@@ -146,28 +150,32 @@ makeEqClass eClass name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have (==)/liftEq/etc. -- implemented for it, and produces errors if it can't.- buildTypeInstance eClass parentName ctxt vars variant- >> makeEqForCons eClass vars cons+ buildTypeInstance eClass parentName ctxt instTypes variant+ >> makeEqForCons eClass instTypes cons -- | Generates a lambda expression for (==)/liftEq/etc. for the -- given constructors. All constructors must be from the same type. makeEqForCons :: EqClass -> [Type] -> [ConstructorInfo] -> Q Exp-makeEqForCons eClass vars cons = do+makeEqForCons eClass instTypes cons = do value1 <- newName "value1" value2 <- newName "value2" eqDefn <- newName "eqDefn" eqs <- newNameList "eq" $ arity eClass - let lastTyVars = map varTToName $ drop (length vars - fromEnum eClass) vars+ let lastTyVars = map varTToName $ drop (length instTypes - fromEnum eClass) instTypes tvMap = Map.fromList $ zipWith (\x y -> (x, OneName y)) lastTyVars eqs lamE (map varP $
src/Data/Functor/Deriving/Internal.hs view
@@ -217,17 +217,21 @@ deriveFunctorClass fc opts name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance fc parentName ctxt vars variant+ <- buildTypeInstance fc parentName ctxt instTypes variant (:[]) `fmap` instanceD (return instanceCxt) (return instanceType)- (functorFunDecs fc opts parentName vars cons)+ (functorFunDecs fc opts parentName instTypes cons) -- | Generates a declaration defining the primary function(s) corresponding to a -- particular class (fmap for Functor, foldr and foldMap for Foldable, and@@ -237,14 +241,14 @@ functorFunDecs :: FunctorClass -> FFTOptions -> Name -> [Type] -> [ConstructorInfo] -> [Q Dec]-functorFunDecs fc opts parentName vars cons =+functorFunDecs fc opts parentName instTypes cons = map makeFunD $ functorClassToFuns fc where makeFunD :: FunctorFun -> Q Dec makeFunD ff = funD (functorFunName ff) [ clause []- (normalB $ makeFunctorFunForCons ff opts parentName vars cons)+ (normalB $ makeFunctorFunForCons ff opts parentName instTypes cons) [] ] @@ -253,24 +257,28 @@ makeFunctorFun ff opts name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have fmap/foldr/traverse/etc. -- implemented for it, and produces errors if it can't.- buildTypeInstance (functorFunToClass ff) parentName ctxt vars variant- >> makeFunctorFunForCons ff opts parentName vars cons+ buildTypeInstance (functorFunToClass ff) parentName ctxt instTypes variant+ >> makeFunctorFunForCons ff opts parentName instTypes cons -- | Generates a lambda expression for the given constructors. -- All constructors must be from the same type. makeFunctorFunForCons :: FunctorFun -> FFTOptions -> Name -> [Type] -> [ConstructorInfo] -> Q Exp-makeFunctorFunForCons ff opts _parentName vars cons = do+makeFunctorFunForCons ff opts _parentName instTypes cons = do argNames <- mapM newName $ catMaybes [ Just "f" , guard (ff == Foldr) >> Just "z" , Just "value"@@ -279,7 +287,7 @@ z = head others -- If we're deriving foldr, this will be well defined -- and useful. Otherwise, it'll be ignored. value = last others- lastTyVar = varTToName $ last vars+ lastTyVar = varTToName $ last instTypes tvMap = Map.singleton lastTyVar $ OneName mapFun lamE (map varP argNames) . appsE
src/Data/Ix/Deriving/Internal.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ {-| Module: Data.Ix.Deriving.Internal Copyright: (C) 2015-2017 Ryan Scott@@ -34,14 +36,18 @@ deriveIx name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance IxClass parentName ctxt vars variant+ <- buildTypeInstance IxClass parentName ctxt instTypes variant (:[]) `fmap` instanceD (return instanceCxt) (return instanceType) (ixFunDecs parentName instanceType cons)@@ -82,13 +88,17 @@ makeIxFun ixf name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do- (_, instanceType) <- buildTypeInstance IxClass parentName ctxt vars variant+ (_, instanceType) <- buildTypeInstance IxClass parentName ctxt instTypes variant makeIxFunForCons ixf parentName instanceType cons -- | Generates a lambda expression for an 'Ix' method for the
src/Data/Ord/Deriving/Internal.hs view
@@ -163,23 +163,27 @@ deriveOrdClass oClass name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance oClass parentName ctxt vars variant+ <- buildTypeInstance oClass parentName ctxt instTypes variant (:[]) `fmap` instanceD (return instanceCxt) (return instanceType)- (ordFunDecs oClass vars cons)+ (ordFunDecs oClass instTypes cons) -- | Generates a declaration defining the primary function(s) corresponding to a -- particular class (compare for Ord, liftCompare for Ord1, and -- liftCompare2 for Ord2). ordFunDecs :: OrdClass -> [Type] -> [ConstructorInfo] -> [Q Dec]-ordFunDecs oClass vars cons =+ordFunDecs oClass instTypes cons = map makeFunD $ ordClassToCompare oClass : otherFuns oClass cons where makeFunD :: OrdFun -> Q Dec@@ -209,7 +213,7 @@ , Ord1Compare1 #endif ]- = makeOrdFunForCons oFun vars cons+ = makeOrdFunForCons oFun instTypes cons dispatchFun OrdLE = dispatchLT $ \lt x y -> negateExpr $ lt `appE` y `appE` x dispatchFun OrdGT = dispatchLT $ \lt x y -> lt `appE` y `appE` x dispatchFun OrdGE = dispatchLT $ \lt x y -> negateExpr $ lt `appE` x `appE` y@@ -222,25 +226,29 @@ makeOrdFun oFun matches name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do let oClass = ordFunToClass oFun others = otherFuns oClass cons -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have compare/liftCompare/etc. -- implemented for it, and produces errors if it can't.- buildTypeInstance oClass parentName ctxt vars variant >>+ buildTypeInstance oClass parentName ctxt instTypes variant >> if oFun `elem` compareFuns || oFun `elem` others- then makeOrdFunForCons oFun vars cons+ then makeOrdFunForCons oFun instTypes cons else do x <- newName "x" y <- newName "y" lamE [varP x, varP y] $- caseE (makeOrdFunForCons (ordClassToCompare oClass) vars cons+ caseE (makeOrdFunForCons (ordClassToCompare oClass) instTypes cons `appE` varE x `appE` varE y) matches where@@ -257,7 +265,7 @@ -- | Generates a lambda expression for the given constructors. -- All constructors must be from the same type. makeOrdFunForCons :: OrdFun -> [Type] -> [ConstructorInfo] -> Q Exp-makeOrdFunForCons oFun vars cons = do+makeOrdFunForCons oFun instTypes cons = do let oClass = ordFunToClass oFun v1 <- newName "v1" v2 <- newName "v2"@@ -266,7 +274,7 @@ ords <- newNameList "ord" $ arity oClass let lastTyVars :: [Name]- lastTyVars = map varTToName $ drop (length vars - fromEnum oClass) vars+ lastTyVars = map varTToName $ drop (length instTypes - fromEnum oClass) instTypes tvMap :: TyVarMap1 tvMap = Map.fromList $ zipWith (\x y -> (x, OneName y)) lastTyVars ords
src/Text/Read/Deriving/Internal.hs view
@@ -422,26 +422,30 @@ deriveReadClass rClass opts name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance rClass parentName ctxt vars variant+ <- buildTypeInstance rClass parentName ctxt instTypes variant (:[]) `fmap` instanceD (return instanceCxt) (return instanceType)- (readPrecDecs rClass opts vars cons)+ (readPrecDecs rClass opts instTypes cons) -- | Generates a declaration defining the primary function corresponding to a -- particular class (read(s)Prec for Read, liftRead(s)Prec for Read1, and -- liftRead(s)Prec2 for Read2). readPrecDecs :: ReadClass -> ReadOptions -> [Type] -> [ConstructorInfo] -> [Q Dec]-readPrecDecs rClass opts vars cons =+readPrecDecs rClass opts instTypes cons = [ funD ((if defineReadPrec then readPrecName else readsPrecName) rClass) [ clause []- (normalB $ makeReadForCons rClass defineReadPrec vars cons)+ (normalB $ makeReadForCons rClass defineReadPrec instTypes cons) [] ] ] ++ if defineReadPrec@@ -462,29 +466,33 @@ makeReadPrecClass rClass urp name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have -- read(s)Prec/liftRead(s)Prec/etc. implemented for it, and produces errors -- if it can't.- buildTypeInstance rClass parentName ctxt vars variant- >> makeReadForCons rClass urp vars cons+ buildTypeInstance rClass parentName ctxt instTypes variant+ >> makeReadForCons rClass urp instTypes cons -- | Generates a lambda expression for read(s)Prec/liftRead(s)Prec/etc. for the -- given constructors. All constructors must be from the same type. makeReadForCons :: ReadClass -> Bool -> [Type] -> [ConstructorInfo] -> Q Exp-makeReadForCons rClass urp vars cons = do+makeReadForCons rClass urp instTypes cons = do p <- newName "p" rps <- newNameList "rp" $ arity rClass rls <- newNameList "rl" $ arity rClass let rpls = zip rps rls _rpsAndRls = interleave rps rls- lastTyVars = map varTToName $ drop (length vars - fromEnum rClass) vars+ lastTyVars = map varTToName $ drop (length instTypes - fromEnum rClass) instTypes rplMap = Map.fromList $ zipWith (\x (y, z) -> (x, TwoNames y z)) lastTyVars rpls let nullaryCons, nonNullaryCons :: [ConstructorInfo]
src/Text/Show/Deriving/Internal.hs view
@@ -271,26 +271,30 @@ deriveShowClass sClass opts name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do (instanceCxt, instanceType)- <- buildTypeInstance sClass parentName ctxt vars variant+ <- buildTypeInstance sClass parentName ctxt instTypes variant (:[]) `fmap` instanceD (return instanceCxt) (return instanceType)- (showsPrecDecs sClass opts vars cons)+ (showsPrecDecs sClass opts instTypes cons) -- | Generates a declaration defining the primary function corresponding to a -- particular class (showsPrec for Show, liftShowsPrec for Show1, and -- liftShowsPrec2 for Show2). showsPrecDecs :: ShowClass -> ShowOptions -> [Type] -> [ConstructorInfo] -> [Q Dec]-showsPrecDecs sClass opts vars cons =+showsPrecDecs sClass opts instTypes cons = [ funD (showsPrecName sClass) [ clause []- (normalB $ makeShowForCons sClass opts vars cons)+ (normalB $ makeShowForCons sClass opts instTypes cons) [] ] ]@@ -301,29 +305,33 @@ makeShowsPrecClass sClass opts name = do info <- reifyDatatype name case info of- DatatypeInfo { datatypeContext = ctxt- , datatypeName = parentName- , datatypeVars = vars- , datatypeVariant = variant- , datatypeCons = cons+ DatatypeInfo { datatypeContext = ctxt+ , datatypeName = parentName+#if MIN_VERSION_th_abstraction(0,3,0)+ , datatypeInstTypes = instTypes+#else+ , datatypeVars = instTypes+#endif+ , datatypeVariant = variant+ , datatypeCons = cons } -> do -- We force buildTypeInstance here since it performs some checks for whether -- or not the provided datatype can actually have showsPrec/liftShowsPrec/etc. -- implemented for it, and produces errors if it can't.- buildTypeInstance sClass parentName ctxt vars variant- >> makeShowForCons sClass opts vars cons+ buildTypeInstance sClass parentName ctxt instTypes variant+ >> makeShowForCons sClass opts instTypes cons -- | Generates a lambda expression for showsPrec/liftShowsPrec/etc. for the -- given constructors. All constructors must be from the same type. makeShowForCons :: ShowClass -> ShowOptions -> [Type] -> [ConstructorInfo] -> Q Exp-makeShowForCons sClass opts vars cons = do+makeShowForCons sClass opts instTypes cons = do p <- newName "p" value <- newName "value" sps <- newNameList "sp" $ arity sClass sls <- newNameList "sl" $ arity sClass let spls = zip sps sls _spsAndSls = interleave sps sls- lastTyVars = map varTToName $ drop (length vars - fromEnum sClass) vars+ lastTyVars = map varTToName $ drop (length instTypes - fromEnum sClass) instTypes splMap = Map.fromList $ zipWith (\x (y, z) -> (x, TwoNames y z)) lastTyVars spls makeFun