diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,123 @@ +# Change Log + +All notable changes to this project will be documented in this file. + +## [0.8.7] - 2026.01.03 + +* Support building with `template-haskell-2.24.*`. +* Remove unnecessary `ghc-prim` dependency. + +## [0.8.6] - 2024.12.05 + +* Support building with `template-haskell-2.23.0`. + +## [0.8.5] - 2024.10.22 + +* Support building with `template-haskell-2.22.1`. +* Drop support for pre-8.0 versions of GHC. + +## [0.8.4] - 2023.08.01 + +* Add support for the `FldName` `NameSpace`, which was introduced in + `template-haskell-2.21.0.0` (GHC 9.8). + +## [0.8.3] - 2023.02.27 + +* Support building with `th-abstraction-0.5.*`. +* Require `th-abstraction-0.3.0.0` or later. + +## [0.8.2] - 2020-09-29 + +* Allow building with `template-haskell-2.17.0.0` (GHC 9.0). +* Make `deriveLift` work for unlifted newtypes. + +## [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) +- Use `TemplateHaskellQuotes` where available + +## [0.7.11] - 2018-08-27 + +* Support for GHC 8.6. + +## [0.7.10] - 2018-02-01 + +* Add support for data families + +## [0.7.9] - 2018-02-01 + +* `Lift` instances for `Identity` and `Const`. + +## [0.7.8] - 2018-02-01 + +* GHC 8.4 compatibility. + +## [0.7.7] - 2015-04-19 + +* GHC 8.2 compatibility. + +## [0.7.6] - 2015-01-18 + +* GHC 8.1 compatibility. + +## [0.7.5] - 2015-11-19 + +* Added `makeLift`, for cases when it's necessary to write the + instance manually. (Thanks to Ryan Scott). +* Support empty datatypes and unboxed types. + +## [0.7] - 2014-12-07 + +* Support GHC 7.9 and hopefully 7.10, thanks to Richard Eisenberg. +* On versions of GHC that support role inference, don't constrain + phantom type variables. +* Get rid of some orphan instances when using GHC >= 7.9. + +## [0.6] - 2013-12-09 + +* Support GHC 7.8, thanks to Michael Snoyberg. +* Support existentially quantified type variables in datatype + declarations. +* Handle exotic kinds properly. + +## [0.5.2] - 2010-09-19 + +* Support older GHCs and Cabal, thanks to Ben Millwood. + +## [0.5] - 2010-08-05 + +* Support for contexts in datatypes, thanks to Ben Millwood. +* `deriveLiftWith` becomes `deriveLift'` and takes an `Info` + structure rather than a custom reification function. +* Add `deriveLiftMany` to derive many `Lift` instances in one go. + +## [0.4] - 2010-08-02 + +* Add support for newtypes and records syntax, thanks to a patch by + Ben Millwood. +* Add support for infix constructors. +* `deriveLift` returns a list of declarations. +* New `deriveLiftWith` function with custom reification, following + a feature request by Jonas Duregård. + +## [0.3] - 2010-03-24 + +* Port to Template Haskell 2.4. +* Maintainer is now Mathieu Boespflug. + +## [0.2] - 2006-09-06 + +Initial release by Ian Lynagh. 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/Changelog b/Changelog deleted file mode 100644 --- a/Changelog +++ /dev/null @@ -1,52 +0,0 @@ -2015-01-18 Mathieu Boespflug - - * GHC 8.1 compatibility. - -2015-11-19 Mathieu Boespflug - - * Added makeLift, for cases when it's necessary to write the - instance manually. (Thanks to Ryan Scott). - * Support empty datatypes and unboxed types. - -2014-12-07 Mathieu Boespflug - - * Support GHC 7.9 and hopefully 7.10, thanks to Richard Eisenberg. - * On versions of GHC that support role inference, don't constrain - phantom type variables. - * Get rid of some orphan instances when using GHC >= 7.9. - -2013-12-09 Mathieu Boespflug - - * Support GHC 7.8, thanks to Michael Snoyberg. - * Support existentially quantified type variables in datatype - declarations. - * Handle exotic kinds properly. - -2010-09-19 Mathieu Boespflug - - * Support older GHCs and Cabal, thanks to Ben Millwood. - -2010-08-05 Mathieu Boespflug - - * Support for contexts in datatypes, thanks to Ben Millwood. - * deriveLiftWith becomes deriveLift' and takes an Info structure - rather than a custom reification function. - * Add deriveLiftMany to derive many Lift instances in one go. - -2010-08-02 Mathieu Boespflug - - * Add support for newtypes and records syntax, thanks to a patch - by Ben Millwood. - * Add support for infix constructors. - * deriveLift returns a list of declarations. - * New deriveLiftWith function with custom reification, following a - feature request by Jonas Duregård. - -2010-03-24 Mathieu Boespflug - - * Port to Template Haskell 2.4. - * Maintainer is now Mathieu Boespflug. - -2006-09-06 Ian Lynagh - - * Initial release. 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 @@ -1,10 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} module Language.Haskell.TH.Lift ( deriveLift @@ -16,75 +16,64 @@ , Lift(..) ) where -#if !(MIN_VERSION_template_haskell(2,4,0)) -import Data.PackedString (PackedString, packString, unpackPS) -#endif /* MIN_VERSION_template_haskell(2,4,0) */ +import Control.Monad ((<=<), zipWithM) +import Data.Char (ord) +import Data.Maybe (catMaybes) + import GHC.Base (unpackCString#) -import GHC.Exts (Double(..), Float(..), Int(..), Word(..)) -import GHC.Prim (Addr#, Double#, Float#, Int#, Word#) -#if MIN_VERSION_template_haskell(2,11,0) -import GHC.Exts (Char(..)) -import GHC.Prim (Char#) -#endif /* !(MIN_VERSION_template_haskell(2,11,0)) */ +import GHC.Exts (Addr#, Char(..), Char#, Double(..), Double#, Float(..), + Float#, Int(..), Int#, Word(..), Word#) -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 Language.Haskell.TH.Datatype as Datatype import qualified Language.Haskell.TH.Lib as Lib (starK) +import Language.Haskell.TH.Lift.Internal import Language.Haskell.TH.Syntax -import Control.Monad ((<=<), zipWithM) -#if MIN_VERSION_template_haskell(2,9,0) -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 roles <- reifyDatatypeRoles name info <- reifyDatatype name fmap (:[]) $ deriveLiftOne roles info -#else -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 roles <- mapM reifyDatatypeRoles names infos <- mapM reifyDatatype names mapM (uncurry deriveLiftOne) $ zip roles infos -#else -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] deriveLift' roles = fmap (:[]) . deriveLiftOne roles <=< normalizeInfo deriveLiftMany' :: [([Role], Info)] -> Q [Dec] deriveLiftMany' = mapM (\(rs, i) -> deriveLiftOne rs =<< normalizeInfo i) -#else -deriveLift' :: Info -> Q [Dec] -deriveLift' = fmap (:[]) . deriveLiftOne <=< normalizeInfo -deriveLiftMany' :: [Info] -> Q [Dec] -deriveLiftMany' = mapM (deriveLiftOne <=< normalizeInfo) -#endif - -- | Generates a lambda expresson which behaves like 'lift' (without requiring -- a 'Lift' instance). Example: -- @@ -94,6 +83,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 @@ -104,32 +96,29 @@ makeLiftInternal :: DatatypeInfo -> Q Exp makeLiftInternal i = withInfo i $ \_ n _ cons -> makeLiftOne n cons -#if MIN_VERSION_template_haskell(2,9,0) deriveLiftOne :: [Role] -> DatatypeInfo -> Q Dec deriveLiftOne roles i = withInfo i liftInstance -#else -deriveLiftOne :: DatatypeInfo -> Q Dec -deriveLiftOne i = withInfo i liftInstance -#endif where liftInstance dcx n tys cons = do -#if MIN_VERSION_template_haskell(2,9,0) -- roles <- reifyDatatypeRoles n -- Compute the set of phantom variables. let phtys = catMaybes $ zipWith (\t role -> if role == PhantomR then Just t else Nothing) tys roles -#else /* MIN_VERSION_template_haskell(2,9,0) */ - let phtys = [] -#endif + _x <- newName "x" 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) + , let rhs = varE 'unsafeSpliceCoerce `appE` + (varE 'lift `appE` varE _x) in + funD 'liftTyped [clause [varP _x] (normalB rhs) []] +#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 - -- variables that are obviously phantom. + -- Only consider *-kinded type variables for now. Furthermore, filter out + -- type variables that are obviously phantom. ctxt dcx phtys = fmap (dcx ++) . cxt . concatMap liftPred . filter (`notElem` phtys) liftPred ty = @@ -138,11 +127,7 @@ | k == Lib.starK -> mkLift t | otherwise -> [] _ -> mkLift ty -#if MIN_VERSION_template_haskell(2,10,0) mkLift ty = [conT ''Lift `appT` (return ty)] -#else - mkLift ty = [classP ''Lift [return ty]] -#endif unKind (SigT t k) | k == Lib.starK = return t unKind t = return t @@ -155,7 +140,8 @@ consMatches :: Name -> [ConstructorInfo] -> [Q Match] consMatches n [] = [match wildP (normalB e) []] where - e = [| errorQExp $(stringE ("Can't lift value of empty datatype " ++ nameBase n)) |] + e = varE 'errorQuoteExp `appE` + (stringE $ "Can't lift value of empty datatype " ++ nameBase n) consMatches _ cons = concatMap doCons cons doCons :: ConstructorInfo -> [Q Match] @@ -167,13 +153,12 @@ let con = [| conE c |] case (variant, ns, ts) of (InfixConstructor, [x0, x1], [t0, t1]) -> - let e = [| infixApp $(liftVar x0 t0) $con $(liftVar x1 t1) |] + let e = varE 'infixApp `appE` liftVar x0 t0 `appE` con `appE` liftVar x1 t1 in match (infixP (varP x0) c (varP x1)) (normalB e) [] (_, _, _) -> - let e = foldl (\e1 e2 -> [| appE $e1 $e2 |]) con $ zipWith liftVar ns ts + let e = foldl (\e1 e2 -> varE 'appE `appE` e1 `appE` e2) con $ zipWith liftVar ns ts in match (conP c (map varP ns)) (normalB e) [] -#if MIN_VERSION_template_haskell(2,9,0) -- Reify the roles of a data type. Note that the argument Name may correspond -- to that of a data family instance constructor, so we need to go through -- reifyDatatype to determine what the parent data family Name is. @@ -181,97 +166,96 @@ reifyDatatypeRoles n = do DatatypeInfo { datatypeName = dn } <- reifyDatatype n qReifyRoles dn -#endif liftVar :: Name -> Type -> Q Exp liftVar varName (ConT tyName) -#if MIN_VERSION_template_haskell(2,8,0) - | tyName == ''Addr# = [| litE (stringPrimL (map (fromIntegral . ord) - (unpackCString# $var))) |] -#else /* !(MIN_VERSION_template_haskell(2,8,0)) */ - | tyName == ''Addr# = [| litE (stringPrimL (unpackCString# $var)) |] -#endif -#if MIN_VERSION_template_haskell(2,11,0) - | tyName == ''Char# = [| litE (charPrimL (C# $var)) |] -#endif /* !(MIN_VERSION_template_haskell(2,11,0)) */ - | tyName == ''Double# = [| litE (doublePrimL (toRational (D# $var))) |] - | tyName == ''Float# = [| litE (floatPrimL (toRational (F# $var))) |] - | tyName == ''Int# = [| litE (intPrimL (toInteger (I# $var))) |] - | tyName == ''Word# = [| litE (wordPrimL (toInteger (W# $var))) |] + | tyName == ''Addr# = apps + [ varE 'litE, varE 'stringPrimL + , varE 'map `appE` + infixApp (varE 'fromIntegral) (varE '(.)) (varE 'ord) + , varE 'unpackCString# ] + | tyName == ''Char# = apps [ varE 'litE, varE 'charPrimL, conE 'C# ] + | tyName == ''Double# = apps [ varE 'litE, varE 'doublePrimL, varE 'toRational, conE 'D# ] + | tyName == ''Float# = apps [ varE 'litE, varE 'floatPrimL, varE 'toRational, conE 'F# ] + | tyName == ''Int# = apps [ varE 'litE, varE 'intPrimL, varE 'toInteger, conE 'I# ] + | tyName == ''Word# = apps [ varE 'litE, varE 'wordPrimL, varE 'toInteger, conE 'W# ] + where + apps = foldr appE var + var :: Q Exp var = varE varName -liftVar varName _ = [| lift $(varE varName) |] +liftVar varName _ = varE 'lift `appE` varE varName + withInfo :: DatatypeInfo -> (Cxt -> Name -> [Type] -> [ConstructorInfo] -> Q a) -> Q a withInfo i f = case i of - DatatypeInfo { datatypeContext = dcx - , datatypeName = n - , datatypeVars = vs - , datatypeCons = cons - } -> + DatatypeInfo { datatypeContext = dcx + , datatypeName = n + , datatypeInstTypes = vs + , datatypeCons = cons + , datatypeVariant = variant + } -> do + case variant of + Datatype.TypeData -> typeDataError n + _ -> return () f dcx n vs cons --- A type-restricted version of error that ensures makeLift always returns a --- value of type Q Exp, even when used on an empty datatype. -errorQExp :: String -> Q Exp -errorQExp = error -{-# INLINE errorQExp #-} +-- | We cannot define implementations for @lift@ at the term level for +-- @type data@ declarations, which only exist at the type level. +typeDataError :: Name -> Q a +typeDataError dataName = fail + . showString "Cannot derive instance for ‘" + . showString (nameBase dataName) + . showString "‘, which is a ‘type data‘ declaration" + $ "" +#if !MIN_VERSION_template_haskell(2,23,0) instance Lift Name where lift (Name occName nameFlavour) = [| Name occName nameFlavour |] +# if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeSpliceCoerce . lift +# endif -#if MIN_VERSION_template_haskell(2,4,0) instance Lift OccName where - lift n = [| mkOccName $(lift $ occString n) |] + lift n = [| mkOccName |] `appE` lift (occString n) +# if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeSpliceCoerce . lift +# endif instance Lift PkgName where - lift n = [| mkPkgName $(lift $ pkgString n) |] + lift n = [| mkPkgName |] `appE` lift (pkgString n) +# if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeSpliceCoerce . lift +# endif instance Lift ModName where - lift n = [| mkModName $(lift $ modString n) |] - -#else /* MIN_VERSION_template_haskell(2,4,0) */ -instance Lift PackedString where - lift ps = [| packString $(lift $ unpackPS ps) |] + lift n = [| mkModName |] `appE` lift (modString n) +# if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeSpliceCoerce . lift +# endif -#endif /* MIN_VERSION_template_haskell(2,4,0) */ instance Lift NameFlavour where lift NameS = [| NameS |] lift (NameQ modnam) = [| NameQ modnam |] -#if __GLASGOW_HASKELL__ >= 710 lift (NameU i) = [| NameU i |] lift (NameL i) = [| NameL i |] -#else /* __GLASGOW_HASKELL__ < 710 */ - lift (NameU i) = [| case $( lift (I# i) ) of - I# i' -> NameU i' |] - lift (NameL i) = [| case $( lift (I# i) ) of - I# i' -> NameL i' |] -#endif /* __GLASGOW_HASKELL__ < 710 */ lift (NameG nameSpace' pkgName modnam) = [| NameG nameSpace' pkgName modnam |] +# if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeSpliceCoerce . lift +# endif instance Lift NameSpace where lift VarName = [| VarName |] lift DataName = [| DataName |] lift TcClsName = [| TcClsName |] - -#if !(MIN_VERSION_template_haskell(2,10,0)) --- These instances should really go in the template-haskell package. - -instance Lift () where - lift _ = [| () |] - -instance Integral a => Lift (Ratio a) where - lift x = return (LitE (RationalL (toRational x))) -#endif - -#if MIN_VERSION_base(4,8,0) -instance Lift a => Lift (Identity a) where - lift = appE (conE 'Identity) . lift . runIdentity +# if MIN_VERSION_template_haskell(2,21,0) + lift (FldName parent) = [| FldName parent |] +# endif +# if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeSpliceCoerce . lift +# endif #endif - -instance Lift a => Lift (Const a b) where - lift = appE (conE 'Const) . lift . getConst diff --git a/src/Language/Haskell/TH/Lift/Internal.hs b/src/Language/Haskell/TH/Lift/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Language/Haskell/TH/Lift/Internal.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- | Helper functions used in code that "Language.Haskell.TH.Lift" generates. +-- +-- Note: this is an internal module, and as such, the API presented here is not +-- guaranteed to be stable, even between minor releases of this library. +module Language.Haskell.TH.Lift.Internal where + +#if MIN_VERSION_template_haskell(2,16,0) +import GHC.Exts (RuntimeRep, TYPE) +#endif + +import Language.Haskell.TH.Syntax + +-- | A type-restricted version of 'error' that ensures 'makeLift' always +-- returns a value of type @q 'Exp'@ (where @q@ is an instance of 'Quote'), +-- even when used on an empty datatype. +#if MIN_VERSION_template_haskell(2,17,0) +errorQuoteExp :: Quote q => String -> q Exp +#else +errorQuoteExp :: String -> Q Exp +#endif +errorQuoteExp = error + +-- | This is a cargo-culted version of @unsafeSpliceCoerce@ from the +-- @th-compat@ library, which has been copied here to avoid incurring a library +-- dependency. +#if MIN_VERSION_template_haskell(2,17,0) +unsafeSpliceCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m. Quote m => m Exp -> Code m a +unsafeSpliceCoerce = unsafeCodeCoerce +#elif MIN_VERSION_template_haskell(2,16,0) +unsafeSpliceCoerce :: forall (r :: RuntimeRep) (a :: TYPE r). Q Exp -> Q (TExp a) +unsafeSpliceCoerce = unsafeTExpCoerce +#else +unsafeSpliceCoerce :: forall a. Q Exp -> Q (TExp a) +unsafeSpliceCoerce = unsafeTExpCoerce +#endif diff --git a/t/Foo.hs b/t/Foo.hs --- a/t/Foo.hs +++ b/t/Foo.hs @@ -7,21 +7,20 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -module Foo where -import GHC.Prim (Double#, Float#, Int#, Word#) -#if MIN_VERSION_template_haskell(2,11,0) -import GHC.Prim (Char#) +#if __GLASGOW_HASKELL__ >= 810 +{-# LANGUAGE UnliftedNewtypes #-} #endif +module Foo where +import GHC.Exts (Char#, Double#, Float#, Int#, Word#) + import Language.Haskell.TH.Lift +#if MIN_VERSION_template_haskell(2,16,0) +import Language.Haskell.TH.Lift.Internal (unsafeSpliceCoerce) +#endif --- Phantom type parameters can't be dealt with poperly on GHC < 7.8. -#if MIN_VERSION_template_haskell(2,9,0) data (Eq a) => Foo a b = Foo a Char | Bar a -#else -data (Eq a) => Foo a = Foo a Char | Bar a -#endif deriving Show newtype Rec a = Rec { field :: a } @@ -30,10 +29,7 @@ data Empty a data Unboxed = Unboxed { --- Template Haskell couldn't handle unlifted chars on GHC < 8.0 -#if MIN_VERSION_template_haskell(2,11,0) primChar :: Char#, -#endif primDouble :: Double#, primFloat :: Float#, primInt :: Int#, @@ -43,7 +39,6 @@ newtype Fix f = In { out :: f (Fix f) } deriving instance Show (f (Fix f)) => Show (Fix f) -#if MIN_VERSION_template_haskell(2,7,0) data family Fam a b c data instance Fam a Int Char = FamPrefix1 a Char @@ -53,7 +48,6 @@ deriving Show data instance Fam a Bool Bool = FamInstBool a Bool deriving Show -#endif $(deriveLift ''Foo) $(deriveLift ''Rec) @@ -61,9 +55,46 @@ $(deriveLift ''Unboxed) instance Lift (f (Fix f)) => Lift (Fix f) where lift = $(makeLift ''Fix) +#if MIN_VERSION_template_haskell(2,16,0) + liftTyped = unsafeSpliceCoerce . 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 = unsafeSpliceCoerce . lift +#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 = unsafeSpliceCoerce . $(makeLift ''Fix2) +instance Lift a => Lift (Fam2 a Int Char) where + liftTyped = unsafeSpliceCoerce . $(makeLift 'Fam2Prefix1) +instance (Eq a, Lift a) => Lift (Fam2 a Bool Bool) where + liftTyped = unsafeSpliceCoerce . $(makeLift 'Fam2InstBool) +#endif + +#if __GLASGOW_HASKELL__ >= 810 +-- Regression test for #43 +newtype T43 = MkT43 Int# +$(deriveLift ''T43) #endif diff --git a/t/Test.hs b/t/Test.hs --- a/t/Test.hs +++ b/t/Test.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} module Main (main) where @@ -10,15 +9,9 @@ main = do print $( lift (Foo "str1" 'c') ) print $( lift (Bar "str2") ) print $( lift (Rec {field = 'a'}) ) - print $( lift (Unboxed -#if MIN_VERSION_template_haskell(2,11,0) - 'a'# -#endif - 1.0## 1.0# 1# 1##) ) + print $( lift (Unboxed 'a'# 1.0## 1.0# 1# 1##) ) print $( lift (In { out = Nothing }) ) -#if MIN_VERSION_template_haskell(2,7,0) print $( lift (FamPrefix1 "str1" 'c') ) print $( lift (FamPrefix2 "str2") ) print $( lift (FamRec {famField = 'a'}) ) print $( lift ('a' :%%: 'b') ) -#endif diff --git a/th-lift.cabal b/th-lift.cabal --- a/th-lift.cabal +++ b/th-lift.cabal @@ -1,50 +1,60 @@ Name: th-lift -Version: 0.7.11 -Cabal-Version: >= 1.8 +Version: 0.8.7 +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. + 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. As such, this package is only useful as a way to backport bugfixes + to @DeriveLift@ in later GHC versions back to older GHCs. + . + The following libraries are related: + . + * 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.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.2 +Tested-With: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.5, GHC==8.8.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.8, GHC==9.4.8, GHC==9.6.6, GHC==9.8.4, GHC==9.10.3, GHC==9.12.2, GHC==9.14.1 build-type: Simple -Extra-source-files: Changelog +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 - Exposed-modules: Language.Haskell.TH.Lift - Extensions: CPP, TemplateHaskell, MagicHash, TypeSynonymInstances, FlexibleInstances - Hs-Source-Dirs: src - Build-Depends: base >= 3 && < 5, - ghc-prim, - th-abstraction >= 0.2.3 - - ghc-options: -Wall - if impl(ghc < 6.12) - Build-Depends: packedstring == 0.1.*, - template-haskell >= 2.2 && < 2.4 - else - Build-Depends: template-haskell >= 2.4 && < 2.15 + Default-Language: Haskell2010 + Exposed-modules: Language.Haskell.TH.Lift + Language.Haskell.TH.Lift.Internal + Other-Extensions: CPP, MagicHash, TypeSynonymInstances, FlexibleInstances, TemplateHaskellQuotes + Hs-Source-Dirs: src + Build-Depends: base >= 4.9 && < 5, + th-abstraction >= 0.5 && < 0.8, + template-haskell >= 2.11 && < 2.25 + ghc-options: -Wall Test-Suite test + Default-Language: Haskell2010 Type: exitcode-stdio-1.0 Main-Is: Test.hs Hs-Source-Dirs: t other-modules: Foo ghc-options: -Wall - Build-Depends: base >= 3 && < 5, - ghc-prim, - th-lift - if impl(ghc < 6.12) - Build-Depends: packedstring == 0.1.*, - template-haskell >= 2.2 && < 2.4 - else - Build-Depends: template-haskell >= 2.4 && < 2.15 + if impl(ghc >= 9.0) + ghc-options: -fenable-th-splice-warnings + Build-Depends: base, + th-lift, + template-haskell +