diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/deriving-compat.cabal b/deriving-compat.cabal --- a/deriving-compat.cabal +++ b/deriving-compat.cabal @@ -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 diff --git a/src/Data/Bounded/Deriving/Internal.hs b/src/Data/Bounded/Deriving/Internal.hs --- a/src/Data/Bounded/Deriving/Internal.hs +++ b/src/Data/Bounded/Deriving/Internal.hs @@ -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 diff --git a/src/Data/Deriving/Via/Internal.hs b/src/Data/Deriving/Via/Internal.hs --- a/src/Data/Deriving/Via/Internal.hs +++ b/src/Data/Deriving/Via/Internal.hs @@ -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) = diff --git a/src/Data/Enum/Deriving/Internal.hs b/src/Data/Enum/Deriving/Internal.hs --- a/src/Data/Enum/Deriving/Internal.hs +++ b/src/Data/Enum/Deriving/Internal.hs @@ -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 diff --git a/src/Data/Eq/Deriving/Internal.hs b/src/Data/Eq/Deriving/Internal.hs --- a/src/Data/Eq/Deriving/Internal.hs +++ b/src/Data/Eq/Deriving/Internal.hs @@ -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 $ diff --git a/src/Data/Functor/Deriving/Internal.hs b/src/Data/Functor/Deriving/Internal.hs --- a/src/Data/Functor/Deriving/Internal.hs +++ b/src/Data/Functor/Deriving/Internal.hs @@ -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 diff --git a/src/Data/Ix/Deriving/Internal.hs b/src/Data/Ix/Deriving/Internal.hs --- a/src/Data/Ix/Deriving/Internal.hs +++ b/src/Data/Ix/Deriving/Internal.hs @@ -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 diff --git a/src/Data/Ord/Deriving/Internal.hs b/src/Data/Ord/Deriving/Internal.hs --- a/src/Data/Ord/Deriving/Internal.hs +++ b/src/Data/Ord/Deriving/Internal.hs @@ -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 diff --git a/src/Text/Read/Deriving/Internal.hs b/src/Text/Read/Deriving/Internal.hs --- a/src/Text/Read/Deriving/Internal.hs +++ b/src/Text/Read/Deriving/Internal.hs @@ -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] diff --git a/src/Text/Show/Deriving/Internal.hs b/src/Text/Show/Deriving/Internal.hs --- a/src/Text/Show/Deriving/Internal.hs +++ b/src/Text/Show/Deriving/Internal.hs @@ -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