th-lift 0.8.4 → 0.8.5
raw patch · 6 files changed
+41/−124 lines, 6 filesdep ~basedep ~template-haskelldep ~th-abstraction
Dependency ranges changed: base, template-haskell, th-abstraction
Files
- CHANGELOG.md +5/−0
- src/Language/Haskell/TH/Lift.hs +24/−81
- src/Language/Haskell/TH/Lift/Internal.hs +2/−7
- t/Foo.hs +1/−16
- t/Test.hs +1/−8
- th-lift.cabal +8/−12
CHANGELOG.md view
@@ -2,6 +2,11 @@ All notable changes to this project will be documented in this file. +## [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
src/Language/Haskell/TH/Lift.hs view
@@ -1,14 +1,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE TypeSynonymInstances #-}-#if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TemplateHaskellQuotes #-}-#else-{-# LANGUAGE TemplateHaskell #-}-#endif+{-# LANGUAGE TypeSynonymInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-} module Language.Haskell.TH.Lift ( deriveLift@@ -20,26 +16,20 @@ , Lift(..) ) where -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 Control.Monad ((<=<), zipWithM) -#if MIN_VERSION_template_haskell(2,8,0) import Data.Char (ord)-#endif /* !(MIN_VERSION_template_haskell(2,8,0)) */+import Data.Maybe (catMaybes)++import GHC.Base (unpackCString#)+import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..))+import GHC.Prim (Addr#, Char#, Double#, Float#, Int#, Word#)+ import Language.Haskell.TH 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 a 'Lift' instance for the given datatype. --@@ -64,42 +54,26 @@ -- 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. 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 -- 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: --@@ -122,25 +96,16 @@ 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)@@ -162,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@@ -198,7 +159,6 @@ 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.@@ -206,23 +166,15 @@ 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# = apps [ 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- [ varE 'litE, varE 'stringPrimL, varE 'unpackCString# ]-#endif-#if MIN_VERSION_template_haskell(2,11,0) | tyName == ''Char# = apps [ varE 'litE, varE 'charPrimL, conE 'C# ]-#endif /* !(MIN_VERSION_template_haskell(2,11,0)) */ | 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# ]@@ -247,13 +199,10 @@ , datatypeVariant = variant } -> do case variant of-#if MIN_VERSION_th_abstraction(0,5,0) Datatype.TypeData -> typeDataError n-#endif _ -> return () f dcx n vs cons -#if MIN_VERSION_th_abstraction(0,5,0) -- | 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@@ -262,57 +211,51 @@ . showString (nameBase dataName) . showString "‘, which is a ‘type data‘ declaration" $ ""-#endif +#if !MIN_VERSION_template_haskell(2,22,1) instance Lift Name where lift (Name occName nameFlavour) = [| Name occName nameFlavour |]-#if MIN_VERSION_template_haskell(2,16,0)+# if MIN_VERSION_template_haskell(2,16,0) liftTyped = unsafeSpliceCoerce . lift-#endif+# endif instance Lift OccName where lift n = [| mkOccName |] `appE` lift (occString n)-#if MIN_VERSION_template_haskell(2,16,0)+# if MIN_VERSION_template_haskell(2,16,0) liftTyped = unsafeSpliceCoerce . lift-#endif+# endif instance Lift PkgName where lift n = [| mkPkgName |] `appE` lift (pkgString n)-#if MIN_VERSION_template_haskell(2,16,0)+# if MIN_VERSION_template_haskell(2,16,0) liftTyped = unsafeSpliceCoerce . lift-#endif+# endif instance Lift ModName where lift n = [| mkModName |] `appE` lift (modString n)-#if MIN_VERSION_template_haskell(2,16,0)+# if MIN_VERSION_template_haskell(2,16,0) liftTyped = unsafeSpliceCoerce . lift-#endif+# endif 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)+# if MIN_VERSION_template_haskell(2,16,0) liftTyped = unsafeSpliceCoerce . lift-#endif+# endif instance Lift NameSpace where lift VarName = [| VarName |] lift DataName = [| DataName |] lift TcClsName = [| TcClsName |]-#if MIN_VERSION_template_haskell(2,21,0)+# if MIN_VERSION_template_haskell(2,21,0) lift (FldName parent) = [| FldName parent |]-#endif-#if MIN_VERSION_template_haskell(2,16,0)+# endif+# if MIN_VERSION_template_haskell(2,16,0) liftTyped = unsafeSpliceCoerce . lift+# endif #endif
src/Language/Haskell/TH/Lift/Internal.hs view
@@ -1,9 +1,6 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ScopedTypeVariables #-}--#if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-}-#endif+{-# LANGUAGE ScopedTypeVariables #-} -- | Helper functions used in code that "Language.Haskell.TH.Lift" generates. --@@ -30,15 +27,13 @@ -- | This is a cargo-culted version of @unsafeSpliceCoerce@ from the -- @th-compat@ library, which has been copied here to avoid incurring a library -- dependency.------ Only available when built with @template-haskell-2.9.0.0@ or later. #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-#elif MIN_VERSION_template_haskell(2,9,0)+#else unsafeSpliceCoerce :: forall a. Q Exp -> Q (TExp a) unsafeSpliceCoerce = unsafeTExpCoerce #endif
t/Foo.hs view
@@ -13,22 +13,14 @@ #endif module Foo where -import GHC.Prim (Double#, Float#, Int#, Word#)-#if MIN_VERSION_template_haskell(2,11,0)-import GHC.Prim (Char#)-#endif+import GHC.Prim (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 }@@ -37,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#,@@ -50,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@@ -60,7 +48,6 @@ deriving Show data instance Fam a Bool Bool = FamInstBool a Bool deriving Show-#endif $(deriveLift ''Foo) $(deriveLift ''Rec)@@ -72,13 +59,11 @@ 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 #endif #if MIN_VERSION_template_haskell(2,16,0)
t/Test.hs view
@@ -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
th-lift.cabal view
@@ -1,5 +1,5 @@ Name: th-lift-Version: 0.8.4+Version: 0.8.5 Cabal-Version: 1.12 License: BSD3 License-Files: COPYING, BSD3, GPL-2@@ -12,8 +12,8 @@ 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.+ 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: .@@ -26,7 +26,7 @@ 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.4, GHC==8.10.7, GHC==9.0.2, GHC==9.2.8, GHC==9.4.5, GHC==9.6.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.2, GHC==9.10.1, GHC==9.12.1 build-type: Simple Extra-source-files: CHANGELOG.md @@ -38,16 +38,12 @@ Default-Language: Haskell2010 Exposed-modules: Language.Haskell.TH.Lift Language.Haskell.TH.Lift.Internal- Other-Extensions: CPP, MagicHash, TypeSynonymInstances, FlexibleInstances- if impl(ghc >= 8.0)- Other-Extensions: TemplateHaskellQuotes- else- Other-Extensions: TemplateHaskell+ Other-Extensions: CPP, MagicHash, TypeSynonymInstances, FlexibleInstances, TemplateHaskellQuotes Hs-Source-Dirs: src- Build-Depends: base >= 4.3 && < 5,+ Build-Depends: base >= 4.9 && < 5, ghc-prim,- th-abstraction >= 0.3 && < 0.7,- template-haskell >= 2.5 && < 2.22+ th-abstraction >= 0.5 && < 0.8,+ template-haskell >= 2.11 && < 2.23 ghc-options: -Wall Test-Suite test