commit 05229d751abaad0bc802fa62b5e88ff0da89f2c7 Author: Arnaud Spiwack <arnaud.spiwack@tweag.io> Date: Fri Nov 10 16:03:38 2023 +0100 Compatibility with GHC 9.8/TH 2.21 Adapted from https://github.com/dreixel/generic-deriving/pull/94 diff --git a/CHANGELOG.md b/CHANGELOG.md index 6e0cd83..15887d7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,6 @@ +# next [????.??.??] +* Support building with `template-haskell-2.21.*` (GHC 9.8). + # 0.2.2 * Produce an orderly error message if someone gives us `type data`. * Produce an error message much more eagerly when someone tries to diff --git a/linear-generics.cabal b/linear-generics.cabal index 363fb5b..d067ca2 100644 --- a/linear-generics.cabal +++ b/linear-generics.cabal @@ -99,7 +99,7 @@ library build-depends: base >= 4.15 && < 5 , containers >= 0.5.9 && < 0.7 , ghc-prim < 1 - , template-haskell >= 2.16 && < 2.21 + , template-haskell >= 2.16 && < 2.22 , th-abstraction >= 0.5 && < 0.7 default-language: Haskell2010 diff --git a/src/Generics/Linear/TH/Internal.hs b/src/Generics/Linear/TH/Internal.hs index cbd049e..8a5a6e4 100644 --- a/src/Generics/Linear/TH/Internal.hs +++ b/src/Generics/Linear/TH/Internal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {- | @@ -100,7 +101,7 @@ isUnsaturatedType = go 0 . dustOff -- | Given a name, check if that name is a type family. If -- so, return a list of its binders. -getTypeFamilyBinders :: Name -> Q (Maybe [TyVarBndr_ ()]) +getTypeFamilyBinders :: Name -> Q (Maybe [TyVarBndrVis]) getTypeFamilyBinders tcName = do info <- reify tcName return $ case info of @@ -325,21 +326,28 @@ reifyDataInfo name = do fail (ns ++ " Could not reify " ++ nameBase name) `recover` reifyDatatype name - variant_ <- case variant of - Datatype -> pure Datatype_ - Newtype -> pure Newtype_ - -- This isn't total, but the API requires that the data - -- family instance have at least one constructor anyways, - -- so this will always succeed. - DataInstance -> pure $ DataInstance_ (head cons) - NewtypeInstance -> pure $ NewtypeInstance_ (head cons) - TypeData -> fail $ "Cannot derive Generic instances for TypeData " ++ nameBase name + variant_ <- + case variant of + Datatype -> return Datatype_ + Newtype -> return Newtype_ + DataInstance -> return $ DataInstance_ $ headDataFamInstCon parentName cons + NewtypeInstance -> return $ NewtypeInstance_ $ headDataFamInstCon parentName cons + TypeData -> fail $ "Cannot derive Generic instances for TypeData " ++ nameBase name checkDataContext parentName ctxt pure (parentName, tys, cons, variant_) where ns :: String ns = "Generics.Linear.TH.reifyDataInfo: " + -- This isn't total, but the API requires that the data family instance have + -- at least one constructor anyways, so this will always succeed. + headDataFamInstCon :: Name -> [ConstructorInfo] -> ConstructorInfo + headDataFamInstCon dataFamName cons = + case cons of + con:_ -> con + [] -> error $ "reified data family instance without a data constructor: " + ++ nameBase dataFamName + -- | One cannot derive Generic(1) instance for anything that uses DatatypeContexts, -- so check to make sure the Cxt field of a datatype is null. checkDataContext :: Name -> Cxt -> Q () @@ -352,3 +360,10 @@ checkExistentialContext :: Name -> [TyVarBndrUnit] -> Cxt -> Q () checkExistentialContext conName vars ctxt = unless (null vars && null ctxt) $ fail $ nameBase conName ++ " must be a vanilla data constructor" + +#if !(MIN_VERSION_template_haskell(2,21,0)) && !(MIN_VERSION_th_abstraction(0,6,0)) +type TyVarBndrVis = TyVarBndrUnit + +bndrReq :: () +bndrReq = () +#endif diff --git a/tests/Generics/Deriving/Enum.hs b/tests/Generics/Deriving/Enum.hs index 7e80ead..1ddbdee 100644 --- a/tests/Generics/Deriving/Enum.hs +++ b/tests/Generics/Deriving/Enum.hs @@ -38,6 +38,7 @@ module Generics.Deriving.Enum ( import Control.Applicative (Const, ZipList) import Data.Int +import Data.Maybe (listToMaybe) import Data.Monoid (All, Any, Dual, Product, Sum) import qualified Data.Monoid as Monoid (First, Last) import Data.Word @@ -106,9 +107,7 @@ combine f (x:xs) (y:ys) = f x y : combine f xs ys findIndex :: (a -> Bool) -> [a] -> Maybe Int findIndex p xs = let l = [ i | (y,i) <- zip xs [(0::Int)..], p y] - in if (null l) - then Nothing - else Just (head l) + in listToMaybe l -------------------------------------------------------------------------------- -- Generic enum