diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,7 +2,19 @@ All notable changes to this project will be documented in this file. -## [0.8] +## [0.8.1] - 2019-12-06 + +* Support GHC 8.10/`template-haskell-2.16`. +* Derive implementations of `liftTyped` (in addition to `lift`) when using + `template-haskell-2.16` or later. +* Fix a bug in which derived `Lift` instances for data types containing + `Addr#` would fail to typecheck. + +## [0.8.0.1] - 2019-05-09 + +* Support GHC 8.8/`template-haskell-2.15`. + +## [0.8] - 2019-04-26 * Remove `Lift ()`, `Ratio`, `Identity` and `Const ()` instances. These are now provided in [`th-lift-instances` package](http://hackage.haskell.org/package/th-lift-instances) diff --git a/COPYING b/COPYING --- a/COPYING +++ b/COPYING @@ -1,5 +1,6 @@ -Copyright (c) Ian Lynagh, 2006. +Copyright (c) Ian Lynagh, 2006; Mathieu Boespflug, 2010-2019; Ryan Scott +2019. This package can be used under either the GPL v2, as in ./GPL-2, or the 3-clause BSD, as in ./BSD3, license. diff --git a/src/Language/Haskell/TH/Lift.hs b/src/Language/Haskell/TH/Lift.hs --- a/src/Language/Haskell/TH/Lift.hs +++ b/src/Language/Haskell/TH/Lift.hs @@ -28,16 +28,9 @@ import GHC.Prim (Char#) #endif /* !(MIN_VERSION_template_haskell(2,11,0)) */ -import Control.Applicative #if MIN_VERSION_template_haskell(2,8,0) import Data.Char (ord) #endif /* !(MIN_VERSION_template_haskell(2,8,0)) */ -#if MIN_VERSION_base(4,8,0) -import Data.Functor.Identity -#endif -#if !(MIN_VERSION_template_haskell(2,10,0)) -import Data.Ratio (Ratio) -#endif /* !(MIN_VERSION_template_haskell(2,10,0)) */ import Language.Haskell.TH import Language.Haskell.TH.Datatype import qualified Language.Haskell.TH.Lib as Lib (starK) @@ -47,7 +40,28 @@ import Data.Maybe (catMaybes) #endif /* MIN_VERSION_template_haskell(2,9,0) */ --- | Derive Lift instances for the given datatype. +-- | Derive a 'Lift' instance for the given datatype. +-- +-- Note that 'deriveLift' uses a very simple technique for inferring the +-- instance context: it simply takes all visible type variables from the data +-- type declaration and adds a 'Lift' constraint for each one. For instance, +-- in the following example: +-- +-- @ +-- data Foo a b = ... +-- $(deriveLift ''Foo) +-- @ +-- +-- The following instance would be generated: +-- +-- @ +-- instance (Lift a, Lift b) => Lift (Foo a b) where ... +-- @ +-- +-- This will not work in all situations, however. For instance, there could +-- conceivably be type variables that are not of the appropriate kind. For +-- these other situations, the 'makeLift' function can provide a more +-- fine-grained approach that allows specifying the instance context precisely. deriveLift :: Name -> Q [Dec] #if MIN_VERSION_template_haskell(2,9,0) deriveLift name = do @@ -58,7 +72,7 @@ deriveLift = fmap (:[]) . deriveLiftOne <=< reifyDatatype #endif --- | Derive Lift instances for many datatypes. +-- | Derive 'Lift' instances for many datatypes. deriveLiftMany :: [Name] -> Q [Dec] #if MIN_VERSION_template_haskell(2,9,0) deriveLiftMany names = do @@ -69,7 +83,7 @@ deriveLiftMany = mapM deriveLiftOne <=< mapM reifyDatatype #endif --- | Obtain Info values through a custom reification function. This is useful +-- | Obtain 'Info' values through a custom reification function. This is useful -- when generating instances for datatypes that have not yet been declared. #if MIN_VERSION_template_haskell(2,9,0) deriveLift' :: [Role] -> Info -> Q [Dec] @@ -94,6 +108,9 @@ -- instance Lift (f (Fix f)) => Lift (Fix f) where -- lift = $(makeLift ''Fix) -- @ +-- +-- This can be useful when 'deriveLift' is not clever enough to infer the +-- correct instance context, such as in the example above. makeLift :: Name -> Q Exp makeLift = makeLiftInternal <=< reifyDatatype @@ -125,7 +142,11 @@ #endif instanceD (ctxt dcx phtys tys) (conT ''Lift `appT` typ n tys) - [funD 'lift [clause [] (normalB (makeLiftOne n cons)) []]] + [ funD 'lift [clause [] (normalB (makeLiftOne n cons)) []] +#if MIN_VERSION_template_haskell(2,16,0) + , funD 'liftTyped [clause [] (normalB [| unsafeTExpCoerce . lift |]) []] +#endif + ] typ n = foldl appT (conT n) . map unKind -- Only consider *-kinded type variables, because Lift instances cannot -- meaningfully be given to types of other kinds. Further, filter out type @@ -187,7 +208,9 @@ liftVar varName (ConT tyName) #if MIN_VERSION_template_haskell(2,8,0) | tyName == ''Addr# = apps - [ varE 'litE, varE 'stringPrimL, varE 'map, [| fromIntegral . ord |] + [ varE 'litE, varE 'stringPrimL + , varE 'map `appE` + infixApp (varE 'fromIntegral) (varE '(.)) (varE 'ord) , varE 'unpackCString# ] #else /* !(MIN_VERSION_template_haskell(2,8,0)) */ | tyName == ''Addr# = apps @@ -232,17 +255,27 @@ instance Lift Name where lift (Name occName nameFlavour) = [| Name occName nameFlavour |] +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeTExpCoerce . lift +#endif -#if MIN_VERSION_template_haskell(2,4,0) instance Lift OccName where lift n = [| mkOccName |] `appE` lift (occString n) +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeTExpCoerce . lift +#endif instance Lift PkgName where lift n = [| mkPkgName |] `appE` lift (pkgString n) +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeTExpCoerce . lift +#endif instance Lift ModName where lift n = [| mkModName |] `appE` lift (modString n) -#endif /* MIN_VERSION_template_haskell(2,4,0) */ +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeTExpCoerce . lift +#endif instance Lift NameFlavour where lift NameS = [| NameS |] @@ -258,8 +291,14 @@ #endif /* __GLASGOW_HASKELL__ < 710 */ lift (NameG nameSpace' pkgName modnam) = [| NameG nameSpace' pkgName modnam |] +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeTExpCoerce . lift +#endif instance Lift NameSpace where lift VarName = [| VarName |] lift DataName = [| DataName |] lift TcClsName = [| TcClsName |] +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeTExpCoerce . lift +#endif diff --git a/t/Foo.hs b/t/Foo.hs --- a/t/Foo.hs +++ b/t/Foo.hs @@ -15,6 +15,9 @@ #endif import Language.Haskell.TH.Lift +#if MIN_VERSION_template_haskell(2,16,0) +import Language.Haskell.TH.Syntax (unsafeTExpCoerce) +#endif -- Phantom type parameters can't be dealt with poperly on GHC < 7.8. #if MIN_VERSION_template_haskell(2,9,0) @@ -61,9 +64,42 @@ $(deriveLift ''Unboxed) instance Lift (f (Fix f)) => Lift (Fix f) where lift = $(makeLift ''Fix) +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeTExpCoerce . lift +#endif #if MIN_VERSION_template_haskell(2,7,0) $(deriveLift 'FamPrefix1) instance (Eq a, Lift a) => Lift (Fam a Bool Bool) where lift = $(makeLift 'FamInstBool) +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeTExpCoerce . lift +#endif +#endif + +#if MIN_VERSION_template_haskell(2,16,0) +-- One can also implement Lift instances (on template-haskell-2.16+) by only +-- defining liftTyped and using the default definition of lift in terms of +-- liftTyped. +newtype Fix2 f = In2 { out2 :: f (Fix2 f) } +deriving instance Show (f (Fix2 f)) => Show (Fix2 f) + +data family Fam2 a b c +data instance Fam2 a Int Char + = Fam2Prefix1 a Char + | Fam2Prefix2 a + | Fam2Rec { fam2Field :: a } + | a :%%%: a + deriving Show +data instance Fam2 a Bool Bool = Fam2InstBool a Bool + deriving Show + +$(pure []) + +instance Lift (f (Fix2 f)) => Lift (Fix2 f) where + liftTyped = unsafeTExpCoerce . $(makeLift ''Fix2) +instance Lift a => Lift (Fam2 a Int Char) where + liftTyped = unsafeTExpCoerce . $(makeLift 'Fam2Prefix1) +instance (Eq a, Lift a) => Lift (Fam2 a Bool Bool) where + liftTyped = unsafeTExpCoerce . $(makeLift 'Fam2InstBool) #endif diff --git a/th-lift.cabal b/th-lift.cabal --- a/th-lift.cabal +++ b/th-lift.cabal @@ -1,27 +1,38 @@ Name: th-lift -Version: 0.8.0.1 +Version: 0.8.1 Cabal-Version: 1.12 License: BSD3 License-Files: COPYING, BSD3, GPL-2 -Copyright: © 2006 Ian Lynagh, © 2010-2018 Mathieu Boespflug +Copyright: © 2006 Ian Lynagh, © 2010-2019 Mathieu Boespflug, © 2019 Ryan Scott Author: Ian Lynagh -Maintainer: Mathieu Boespflug -Homepage: http://github.com/mboes/th-lift +Maintainer: Ryan Scott +Homepage: http://github.com/RyanGlScott/th-lift Synopsis: Derive Template Haskell's Lift class for datatypes. Description: - Derive Template Haskell's Lift class for datatypes using @TemplateHaskell@ + Derive Template Haskell's @Lift@ class for datatypes using @TemplateHaskell@. + The functionality in this package has largely been subsumed by the + @DeriveLift@ language extension, which is available in GHC 8.0 and later + versions. This package can still be useful as a uniform way to derive + @Lift@ instances that is backwards-compatible with older GHCs. . - * package provides instances for @template-haskell@ syntax types + The following libraries are related: . - * package provides @Lift@ (compat) instances for types in @base@, @text@, @bytestring@, @vector@ etc. + * The package + provides instances for @template-haskell@ syntax types. + . + * The + package provides @Lift@ instances for types in @base@, @text@, + @bytestring@, @vector@, etc. Some of these instances are only provided for + old versions of their respective libraries, as the same @Lift@ instances + are also present upstream on newer versions. Category: Language -Tested-With: GHC==7.0.4, GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1 +Tested-With: GHC==7.0.4, GHC==7.2.2, GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.1, GHC==8.10.1 build-type: Simple Extra-source-files: CHANGELOG.md source-repository head type: git - location: git://github.com/mboes/th-lift + location: https://github.com/RyanGlScott/th-lift Library Default-Language: Haskell2010 @@ -35,7 +46,8 @@ Build-Depends: base >= 4.3 && < 5, ghc-prim, th-abstraction >= 0.2.3 && < 0.4, - template-haskell >= 2.4 && < 2.16 + template-haskell >= 2.5 && < 2.17 + ghc-options: -Wall Test-Suite test Default-Language: Haskell2010