th-lift 0.6.1 → 0.8.7
raw patch · 8 files changed
Files
- CHANGELOG.md +123/−0
- COPYING +2/−1
- Changelog +0/−28
- src/Language/Haskell/TH/Lift.hs +231/−94
- src/Language/Haskell/TH/Lift/Internal.hs +39/−0
- t/Foo.hs +88/−1
- t/Test.hs +7/−0
- th-lift.cabal +50/−22
+ CHANGELOG.md view
@@ -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.
COPYING view
@@ -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.
− Changelog
@@ -1,28 +0,0 @@-2010-09-19 Mathieu Boespflug <mboes@tweag.net>-- * Support older GHCs and Cabal, thanks to Ben Millwood.--2010-08-05 Mathieu Boespflug <mboes@tweag.net>-- * 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 <mboes@tweag.net>-- * 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 <mboes@tweag.net>-- * Port to Template Haskell 2.4.- * Maintainer is now Mathieu Boespflug.--2006-09-06 Ian Lynagh <igloo@earth.li>-- * Initial release.
src/Language/Haskell/TH/Lift.hs view
@@ -1,124 +1,261 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-}-module Language.Haskell.TH.Lift (deriveLift, deriveLiftMany, deriveLift', deriveLiftMany', Lift(..)) where+{-# OPTIONS_GHC -Wno-orphans #-} -#if !(MIN_VERSION_template_haskell(2,4,0))-import Data.PackedString (PackedString, packString, unpackPS)-#endif /* MIN_VERSION_template_haskell(2,4,0) */+module Language.Haskell.TH.Lift+ ( deriveLift+ , deriveLiftMany+ , deriveLift'+ , deriveLiftMany'+ , makeLift+ , makeLift'+ , Lift(..)+ ) where -import GHC.Exts+import Control.Monad ((<=<), zipWithM)++import Data.Char (ord)+import Data.Maybe (catMaybes)++import GHC.Base (unpackCString#)+import GHC.Exts (Addr#, Char(..), Char#, Double(..), Double#, Float(..),+ Float#, Int(..), Int#, Word(..), 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 ((<=<)) -modName :: String-modName = "Language.Haskell.TH.Lift"---- | 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]-deriveLift = deriveLift' <=< reify+deriveLift name = do+ roles <- reifyDatatypeRoles name+ info <- reifyDatatype name+ fmap (:[]) $ deriveLiftOne roles info --- | Derive Lift instances for many datatypes.+-- | Derive 'Lift' instances for many datatypes. deriveLiftMany :: [Name] -> Q [Dec]-deriveLiftMany = deriveLiftMany' <=< mapM reify+deriveLiftMany names = do+ roles <- mapM reifyDatatypeRoles names+ infos <- mapM reifyDatatype names+ mapM (uncurry deriveLiftOne) $ zip roles infos --- | 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.-deriveLift' :: Info -> Q [Dec]-deriveLift' = fmap (:[]) . deriveLiftOne+deriveLift' :: [Role] -> Info -> Q [Dec]+deriveLift' roles = fmap (:[]) . deriveLiftOne roles <=< normalizeInfo -deriveLiftMany' :: [Info] -> Q [Dec]-deriveLiftMany' = mapM deriveLiftOne+deriveLiftMany' :: [([Role], Info)] -> Q [Dec]+deriveLiftMany' = mapM (\(rs, i) -> deriveLiftOne rs =<< normalizeInfo i) -deriveLiftOne :: Info -> Q Dec-deriveLiftOne i =- case i of- TyConI (DataD dcx n vsk cons _) ->- liftInstance dcx n (map unTyVarBndr vsk) (map doCons cons)- TyConI (NewtypeD dcx n vsk con _) ->- liftInstance dcx n (map unTyVarBndr vsk) [doCons con]- _ -> error (modName ++ ".deriveLift: unhandled: " ++ pprint i)- where liftInstance dcx n vs cases =- instanceD (ctxt dcx vs)- (conT ''Lift `appT` typ n (map fst vs))- [funD 'lift cases]- typ n = foldl appT (conT n) . map varT- ctxt dcx = fmap (dcx ++) . cxt . concatMap liftPred- -- Only consider *-kinded type variables, because Lift instances cannot- -- meaningfully be given to types of other kinds.-#if MIN_VERSION_template_haskell(2,8,0)- unTyVarBndr (PlainTV v) = (v, StarT)- unTyVarBndr (KindedTV v k) = (v, k)- liftPred (v, StarT) = [classP ''Lift [varT v]]- liftPred (_, _) = []-#elif MIN_VERSION_template_haskell(2,4,0)- unTyVarBndr (PlainTV v) = (v, StarK)- unTyVarBndr (KindedTV v k) = (v, k)- liftPred (v, StarK) = [classP ''Lift [varT v]]- liftPred (_, _) = []-#else /* template-haskell < 2.4.0 */- unTyVarBndr v = v- liftPred n = conT ''Lift `appT` varT n+-- | Generates a lambda expresson which behaves like 'lift' (without requiring+-- a 'Lift' instance). Example:+--+-- @+-- newtype Fix f = In { out :: f (Fix f) }+--+-- 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++-- | Like 'makeLift', but using a custom reification function.+makeLift' :: Info -> Q Exp+makeLift' = makeLiftInternal <=< normalizeInfo++makeLiftInternal :: DatatypeInfo -> Q Exp+makeLiftInternal i = withInfo i $ \_ n _ cons -> makeLiftOne n cons++deriveLiftOne :: [Role] -> DatatypeInfo -> Q Dec+deriveLiftOne roles i = withInfo i liftInstance+ where+ liftInstance dcx n tys cons = do+ -- 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+ _x <- newName "x"+ instanceD (ctxt dcx phtys tys)+ (conT ''Lift `appT` typ n tys)+ [ 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 for now. Furthermore, filter out+ -- type variables that are obviously phantom.+ ctxt dcx phtys =+ fmap (dcx ++) . cxt . concatMap liftPred . filter (`notElem` phtys)+ liftPred ty =+ case ty of+ SigT t k+ | k == Lib.starK -> mkLift t+ | otherwise -> []+ _ -> mkLift ty+ mkLift ty = [conT ''Lift `appT` (return ty)]+ unKind (SigT t k)+ | k == Lib.starK = return t+ unKind t = return t -doCons :: Con -> Q Clause-doCons (NormalC c sts) = do- let ns = zipWith (\_ i -> "x" ++ show (i :: Int)) sts [0..]- con = [| conE c |]- args = [ [| lift $(varE (mkName n)) |] | n <- ns ]- e = foldl (\e1 e2 -> [| appE $e1 $e2 |]) con args- clause [conP c (map (varP . mkName) ns)] (normalB e) []-doCons (RecC c sts) = doCons $ NormalC c [(s, t) | (_, s, t) <- sts]-doCons (InfixC sty1 c sty2) = do- let con = [| conE c |]- left = [| lift $(varE (mkName "x0")) |]- right = [| lift $(varE (mkName "x1")) |]- e = [| infixApp $left $con $right |]- clause [infixP (varP (mkName "x0")) c (varP (mkName "x1"))] (normalB e) []-doCons (ForallC _ _ c) = doCons c+makeLiftOne :: Name -> [ConstructorInfo] -> Q Exp+makeLiftOne n cons = do+ e <- newName "e"+ lam1E (varP e) $ caseE (varE e) $ consMatches n cons +consMatches :: Name -> [ConstructorInfo] -> [Q Match]+consMatches n [] = [match wildP (normalB e) []]+ where+ e = varE 'errorQuoteExp `appE`+ (stringE $ "Can't lift value of empty datatype " ++ nameBase n)+consMatches _ cons = concatMap doCons cons++doCons :: ConstructorInfo -> [Q Match]+doCons (ConstructorInfo { constructorName = c+ , constructorFields = ts+ , constructorVariant = variant+ }) = (:[]) $ do+ ns <- zipWithM (\_ i -> newName ('x':show (i :: Int))) ts [0..]+ let con = [| conE c |]+ case (variant, ns, ts) of+ (InfixConstructor, [x0, x1], [t0, 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 -> varE 'appE `appE` e1 `appE` e2) con $ zipWith liftVar ns ts+ in match (conP c (map varP ns)) (normalB e) []++-- 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.+reifyDatatypeRoles :: Name -> Q [Role]+reifyDatatypeRoles n = do+ DatatypeInfo { datatypeName = dn } <- reifyDatatype n+ qReifyRoles dn++liftVar :: Name -> Type -> Q Exp+liftVar varName (ConT tyName)+ | 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 _ = 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+ , datatypeInstTypes = vs+ , datatypeCons = cons+ , datatypeVariant = variant+ } -> do+ case variant of+ Datatype.TypeData -> typeDataError n+ _ -> return ()+ f dcx n vs cons++-- | 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 |]+ 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 |]- lift (NameU i) = [| case $( lift (I# i) ) of- I# i' -> NameU i' |]- lift (NameL i) = [| case $( lift (I# i) ) of- I# i' -> NameL i' |]- lift (NameG nameSpace pkgName modnam)- = [| NameG nameSpace pkgName modnam |]+ lift NameS = [| NameS |]+ lift (NameQ modnam) = [| NameQ modnam |]+ lift (NameU i) = [| NameU i |]+ lift (NameL i) = [| NameL i |]+ 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 |]---- These instances should really go in the template-haskell package.--instance Lift () where- lift _ = [| () |]--instance Lift Rational where- lift x = return (LitE (RationalL x))+ lift VarName = [| VarName |]+ lift DataName = [| DataName |]+ lift TcClsName = [| TcClsName |]+# 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
+ src/Language/Haskell/TH/Lift/Internal.hs view
@@ -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
t/Foo.hs view
@@ -1,13 +1,100 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++#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 -data (Eq a) => Foo a = Foo a Char | Bar a+data (Eq a) => Foo a b = Foo a Char | Bar a deriving Show newtype Rec a = Rec { field :: a } deriving Show +data Empty a++data Unboxed = Unboxed {+ primChar :: Char#,+ primDouble :: Double#,+ primFloat :: Float#,+ primInt :: Int#,+ primWord :: Word#+ } deriving Show++newtype Fix f = In { out :: f (Fix f) }+deriving instance Show (f (Fix f)) => Show (Fix f)++data family Fam a b c+data instance Fam a Int Char+ = FamPrefix1 a Char+ | FamPrefix2 a+ | FamRec { famField :: a }+ | a :%%: a+ deriving Show+data instance Fam a Bool Bool = FamInstBool a Bool+ deriving Show+ $(deriveLift ''Foo) $(deriveLift ''Rec)+$(deriveLift ''Empty)+$(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++$(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
t/Test.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE MagicHash #-} {-# LANGUAGE TemplateHaskell #-} module Main (main) where @@ -8,3 +9,9 @@ main = do print $( lift (Foo "str1" 'c') ) print $( lift (Bar "str2") ) print $( lift (Rec {field = 'a'}) )+ print $( lift (Unboxed 'a'# 1.0## 1.0# 1# 1##) )+ print $( lift (In { out = Nothing }) )+ print $( lift (FamPrefix1 "str1" 'c') )+ print $( lift (FamPrefix2 "str2") )+ print $( lift (FamRec {famField = 'a'}) )+ print $( lift ('a' :%%: 'b') )
th-lift.cabal view
@@ -1,32 +1,60 @@ Name: th-lift-Version: 0.6.1-Cabal-Version: >= 1.6-License: OtherLicense-License-File: COPYING-Copyright: Ian Lynagh, 2006+Version: 0.8.7+Cabal-Version: 1.12+License: BSD3+License-Files: COPYING, BSD3, GPL-2+Copyright: © 2006 Ian Lynagh, © 2010-2019 Mathieu Boespflug, © 2019 Ryan Scott Author: Ian Lynagh-Maintainer: Mathieu Boespflug <mboes@tweag.net>+Maintainer: Ryan Scott <ryan.gl.scott@gmail.com>+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 <https://hackage.haskell.org/package/th-orphans th-orphans> package+ provides instances for @template-haskell@ syntax types.+ .+ * The <http://hackage.haskell.org/package/th-lift-instances th-lift-instances>+ 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==6.12, GHC==7.0.1, GHC==7.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: BSD3, GPL-2, Changelog, t/Foo.hs, t/Test.hs+Extra-source-files: CHANGELOG.md +source-repository head+ type: git+ 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+ 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 - 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.10+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+ if impl(ghc >= 9.0)+ ghc-options: -fenable-th-splice-warnings+ Build-Depends: base,+ th-lift,+ template-haskell -source-repository head- type: git- location: git://github.com/mboes/th-lift