diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,11 @@ +## 0.3 [2024.10.22] +* Drop support for pre-8.0 versions of GHC. +* Remove `genericLiftWithPkg`, `genericLiftWithPkgFallback`, and related + functions. These functions were only useful for defining `Generic`-based + `lift` implementations on pre-8.0 versions of GHC. Now that `lift-generics` + no longer supports these versions of GHC, they are no longer necessary or + useful. Use `genericLift` and friends instead. + ## 0.2.1 [2021.09.16] * The lifting functions have been modified to reduce splice time for constructors with many fields from quadratic to diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -16,10 +16,10 @@ https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29 "BSD 3-Clause License (Revised)" -This package provides a `GHC.Generics`-based `genericLiftWithPkg` function (intended for GHC 7.10 and earlier), as well as a `genericLift` function (only available on GHC 8.0 and later), both of which can be used for providing a `Language.Haskell.TH.Syntax.lift` implementation. See the documentation in the `Language.Haskell.TH.Lift.Generics` module to get started. - -Credit goes to Matthew Pickering for [suggesting this idea](https://ghc.haskell.org/trac/ghc/ticket/1830#comment:12). - -Note that due to API limitations, `GHC.Generics` wasn't powerful enough to come up with the entirety of a `lift` implementation prior to GHC 8.0. For this reason, `genericLiftWithPkg` requires you to produce the package name yourself, which proves to be no small feat (see the documentation for more info). +This package provides a `GHC.Generics`-based `genericLift` function, which can +be used for providing a `Language.Haskell.TH.Syntax.lift` implementation. See +the documentation in the `Language.Haskell.TH.Lift.Generics` module to get +started. -Luckily, you don't have to jump through as many hoops on GHC 8.0 and later: simply use the `genericLift` function, and life is good. +Credit goes to Matthew Pickering for [suggesting this +idea](https://ghc.haskell.org/trac/ghc/ticket/1830#comment:12). diff --git a/lift-generics.cabal b/lift-generics.cabal --- a/lift-generics.cabal +++ b/lift-generics.cabal @@ -1,30 +1,14 @@ name: lift-generics -version: 0.2.1 +version: 0.3 synopsis: GHC.Generics-based Language.Haskell.TH.Syntax.lift implementation description: This package provides a "GHC.Generics"-based @genericLift@ - function (only available on GHC 7.4 and later), as well as - a @genericLiftWithPkgFallback@ function (for code that - must support GHC 7.2 and earlier) and a - @genericLiftWithPkg@ function (for use when neither of the - above will work), all of which can be used for providing a + function, which can be used for providing a @Language.Haskell.TH.Syntax.lift@ implementation. See the documentation in the "Language.Haskell.TH.Lift.Generics" module to get started. . Credit goes to Matthew Pickering for . - . - Note that due to API limitations, "GHC.Generics" wasn't - powerful enough to come up with the entirety of a `lift` - implementation prior to GHC 8.0. For GHC 7.4 and later, we - can pluck this information out of `Typeable`. For earlier - versions, and where `Typeable` isn't available, - @genericLiftWithPkg@ requires you to produce the package - name yourself, which proves to be no small feat (see the - documentation for more info). - . - Luckily, you don't have to jump through as many hoops on GHC 7.4 and - later: simply use the @genericLift@ function, and life is good. homepage: https://github.com/RyanGlScott/lift-generics bug-reports: https://github.com/RyanGlScott/lift-generics/issues license: BSD3 @@ -35,19 +19,18 @@ copyright: (C) 2015-2017 Ryan Scott category: Language build-type: Simple -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 +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.4 - , GHC == 9.0.1 + , 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 extra-source-files: CHANGELOG.md, README.md cabal-version: >=1.10 @@ -57,15 +40,10 @@ library exposed-modules: Language.Haskell.TH.Lift.Generics - if (impl(ghc >= 7.4) && impl(ghc < 8.0)) - other-modules: Language.Haskell.TH.Lift.Generics.Internal.OuterTypeable - build-depends: base >= 4.3 && < 5 - , generic-deriving >= 1.9 && < 2 + build-depends: base >= 4.9 && < 5 , ghc-prim - , template-haskell >= 2.4 && < 2.18 - , th-compat >= 0.1 && < 0.2 - if (impl(ghc >= 7.4) && impl(ghc < 7.8)) - build-depends: tagged >= 0.5 && < 0.9 + , template-haskell >= 2.11 && < 2.23 + , th-compat >= 0.1 && < 0.2 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall @@ -75,17 +53,14 @@ main-is: Spec.hs other-modules: LiftGenericsSpec Types - Paths_lift_generics - build-depends: base >= 4.3 && < 5 - , base-compat >= 0.8.2 && < 1 - , containers >= 0.1 && < 0.7 - , th-lift-instances >= 0.1 && < 0.2 - , generic-deriving >= 1.9 && < 2 - , hspec >= 2 && < 3 + build-depends: base >= 4.9 && < 5 + , containers >= 0.1 && < 0.8 + , hspec >= 2 && < 3 , lift-generics - , mtl >= 2.1 && < 2.3 - , template-haskell >= 2.4 && < 2.18 - , th-compat >= 0.1 && < 0.2 + , mtl >= 2.1 && < 2.4 + , template-haskell >= 2.11 && < 2.23 + , th-compat >= 0.1 && < 0.2 + , th-lift-instances >= 0.1 && < 0.2 build-tool-depends: hspec-discover:hspec-discover hs-source-dirs: tests default-language: Haskell2010 diff --git a/src/Language/Haskell/TH/Lift/Generics.hs b/src/Language/Haskell/TH/Lift/Generics.hs --- a/src/Language/Haskell/TH/Lift/Generics.hs +++ b/src/Language/Haskell/TH/Lift/Generics.hs @@ -1,5 +1,6 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} +{-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MagicHash #-} @@ -7,109 +8,23 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} -#if __GLASGOW_HASKELL__ >= 708 -{-# LANGUAGE EmptyCase #-} -#endif - {-| Module: Language.Haskell.TH.Lift.Generics Copyright: (C) 2015-2017 Ryan Scott License: BSD-style (see the file LICENSE) Maintainer: Ryan Scott -"GHC.Generics"-based approach to implementing `lift`. Different sets of -functions are available for use with different GHC and @template-haskell@ -versions. - -=== General recommendations - -* If you only need to support GHC 8.0 (@base@ 4.9.0) and later, then you may -either use the \"friendly\" functions here or skip this package entirely and use -the built-in `DeriveLift` mechanism, which has the advantage of working for -GADTs and existential types. - -* If you only need to support GHC 7.4 (@base@ 4.5) and later, and you have -'Typeable' instances for the relevant type constructors (or can derive them), -then you should use the \"friendly\" functions here. - -* If you must support GHC versions before 7.4 (@base@ 4.5), or types in other -packages without 'Typeable' instances, then you should seriously consider using -the - -package to derive 'Lift' instances. If you choose to continue with this package: - - * If you have 'Typeable' instances, then you should use the \"less friendly\" - functions here. These take an argument for the package name, but they ignore it - (acting just like the friendly ones) for GHC 7.4 (@base@ 4.5) and later. - - * If you lack a 'Typeable' instance for a type constructor, then you'll - need to use the \"unfriendly\" functions. These rely solely on the - user-provided package name. On GHC 7.10, it is extremely difficult to - obtain the correct package name for an external package. - -=== A note on 'Typeable' constraints - -For relevant versions, the \"friendly\" and \"less friendly\" functions require -the type to satisfy an @OuterTypeable@ constraint. A type is @OuterTypable@ if -its /type constructor/ (applied to any /kind/ arguments) is 'Typeable'. For -example, @'Maybe' a@ is only 'Typeable' if @a@ is 'Typeable', but it is always -@OuterTypeable@. For @'Control.Applicative.Const' a b@ to be 'OuterTypeable', -the /kinds/ of @a@ and @b@ must be 'Typeable'. - -Before GHC 7.8, 'Typeable' can only be derived for types with seven -or fewer parameters, all of kind @*@. Types with more parameters that -manually instantiate the now-defunct @Typeable7@ class should work, -but there may be some loss of polymorphism in the first arguments. -Types whose 'Typeable' instances can't be derived because of kind issues -will not work with these GHC versions. +"GHC.Generics"-based approach to implementing `lift`. -} module Language.Haskell.TH.Lift.Generics ( -#if MIN_VERSION_base(4,5,0) - -- * Friendly "GHC.Generics"-based 'lift' implementations + -- * "GHC.Generics"-based 'lift' implementations -- - -- $friendlyFunctions + -- $genericLiftFunctions genericLift -# if MIN_VERSION_template_haskell(2,9,0) , genericLiftTyped , genericLiftTypedTExp , genericLiftTypedCompat -# endif - , -#endif - -- * Less friendly and unfriendly "GHC.Generics"-based 'lift' - -- implementations - -- - -- $lessFriendlyFunctions - - -- ** Less friendly implementations - -- - -- | These implementations should be used when support for versions - -- before GHC 7.4 (@base@ 4.5) is required, but a 'Data.Typeable.Typeable' - -- instance is available. The 'Data.Typeable.Typeable' instance will be used - -- to get the package name for GHC 7.4 and later. - genericLiftWithPkgFallback -#if MIN_VERSION_template_haskell(2,9,0) - , genericLiftTypedWithPkgFallback - , genericLiftTypedTExpWithPkgFallback - , genericLiftTypedCompatWithPkgFallback -#endif - - -- ** Unfriendly implementations - -- - -- | These implementations should be used when support for versions - -- before GHC 8.0 (@base@ 4.9) is required and a 'Data.Typeable.Typeable' instance - -- is /not/ available. These functions are termed "unfriendly" because - -- they're extremely hard to use under GHC 7.10 when working with types - -- defined in other packages. The only way to do so is to use a 'Typeable' - -- type in the same package to get the \"package name\", which will be a - -- hash value. - , genericLiftWithPkg -#if MIN_VERSION_template_haskell(2,9,0) - , genericLiftTypedWithPkg - , genericLiftTypedTExpWithPkg - , genericLiftTypedCompatWithPkg -#endif -- * 'Generic' classes -- -- | You shouldn't need to use any of these @@ -121,226 +36,25 @@ , Lift(..) ) where -#if MIN_VERSION_base(4,5,0) && !MIN_VERSION_base(4,9,0) -import Language.Haskell.TH.Lift.Generics.Internal.OuterTypeable -#endif - import Control.Monad (liftM, (>=>)) -import Generics.Deriving +import Data.Char (ord) +import Data.Word (Word8) +import GHC.Generics + import GHC.Base (unpackCString#) -import GHC.Exts (Double(..), Float(..), Int(..), Word(..)) -#if __GLASGOW_HASKELL__ < 708 -import GHC.Conc (pseq) -#endif +import GHC.Exts (Char(..), Double(..), Float(..), Int(..), Word(..)) import Language.Haskell.TH.Lib import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax.Compat -#if MIN_VERSION_template_haskell(2,8,0) -import Data.Char (ord) -import Data.Word (Word8) -#endif - -#if MIN_VERSION_template_haskell(2,11,0) -import GHC.Exts (Char(..)) -#endif - -#if MIN_VERSION_base(4,5,0) && !MIN_VERSION_base(4,9,0) -import qualified Data.Typeable as T -#endif - -#if MIN_VERSION_base(4,5,0) && !MIN_VERSION_base(4,9,0) -import Data.Proxy (Proxy (..)) -#endif - --- We don't want to expand this in the Haddocks! -#undef CURRENT_PACKAGE_KEY - --- $lessFriendlyFunctions --- --- API limitations of early versions of GHC (7.2 and earlier) require the user --- to produce the package name themselves. This is also occasionally necessary --- for later versions of GHC when dealing with types from other packages that --- lack 'Data.Typeable.Typeable' instances. The package name isn't always as easy to come --- up with as it sounds, especially because GHC 7.10 uses a hashed package ID --- for that name. To make things worse, if you produce the wrong package name, --- you might get bizarre compilation errors! --- --- There's no need to fear, though—in most cases it's possible to obtain the --- correct package name anyway, at least for types defined /in the current package/. --- When compiling a library with @Cabal@, the current package --- name is obtained using the CPP macro @CURRENT_PACKAGE_KEY@. When compiling --- an application, or compiling without Cabal, it takes a bit more work to get --- the name. The code sample below shows an example of how to --- properly use 'genericLiftWithPkgFallback' or 'genericLiftWithPkg' without --- shooting yourself in the foot: --- --- @ --- {-# LANGUAGE CPP, DeriveGeneric, DeriveDataTypeable #-} --- -- part of package foobar --- module Foo where --- --- import GHC.Generics --- import Data.Typeable --- import Language.Haskell.Lift.Generics --- --- #ifndef CURRENT_PACKAGE_KEY --- import Data.Version (showVersion) --- import Paths_foobar (version) --- #endif --- --- pkgName :: String --- #ifdef CURRENT_PACKAGE_KEY --- pkgName = CURRENT_PACKAGE_KEY --- #else --- pkgName = "foobar-" ++ showVersion version --- #endif --- --- data Foo = Foo Int Char String --- deriving (Generic, Typeable) --- --- instance Lift Foo where --- lift = genericLiftWithPkgFallback pkgName --- #if MIN_VERSION_template_haskell(2,9,0) --- liftTyped = genericLiftTypedCompatWithPkgFallback pkgName --- #endif --- @ --- --- As you can see, this trick only works if (1) the current package key is known --- (i.e., the 'Lift' instance is defined in the same package as the datatype), or --- (2) you're dealing with a package that has a fixed package name (e.g., @base@, --- @ghc-prim@, @template-haskell@, etc.). --- --- Once the @Lift Foo@ instance is defined, you can splice @Foo@ values directly --- into Haskell source code: --- --- @ --- {-# LANGUAGE TemplateHaskell #-} --- module Bar where --- --- import Foo --- import Language.Haskell.TH.Syntax --- --- foo :: Foo --- foo = $(lift (Foo 1 \'a\' \"baz\")) --- @ - --- | Generically produce an implementation of 'lift', given a user-provided --- (but correct!) package name. The provided package name is ignored for --- GHC 7.4 (@base@ 4.5) and later. --- --- === Note --- --- A @'Data.Typeable.Typeable' a@ instance is required for 7.4 <= GHC < 8.0 (4.5 <= @base@ < 4.9). --- --- @since 0.2.1 -#if MIN_VERSION_base (4,9,0) || !MIN_VERSION_base (4,5,0) -genericLiftWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m Exp -#else -genericLiftWithPkgFallback :: (Quote m, Generic a, GLift (Rep a), OuterTypeable a) => String -> a -> m Exp -#endif -#if MIN_VERSION_base(4,5,0) -genericLiftWithPkgFallback _pkg = genericLift -#else -genericLiftWithPkgFallback = genericLiftWithPkg -#endif - -#if MIN_VERSION_template_haskell(2,9,0) --- | Like 'genericLiftWithPkgFallback', but returns a 'Code' instead of an 'Exp'. --- --- @since 0.2.1 -# if MIN_VERSION_base (4,9,0) || !MIN_VERSION_base (4,5,0) -genericLiftTypedWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Code m a -# else -genericLiftTypedWithPkgFallback :: (Quote m, Generic a, GLift (Rep a), OuterTypeable a) => String -> a -> Code m a -# endif -# if MIN_VERSION_base(4,5,0) -genericLiftTypedWithPkgFallback _pkg = genericLiftTyped -# else -genericLiftTypedWithPkgFallback = genericLiftTypedWithPkg -# endif - --- | Like 'genericLiftWithPkgFallback', but returns a 'TExp' instead of an 'Exp'. --- --- @since 0.2.1 -# if MIN_VERSION_base (4,9,0) || !MIN_VERSION_base (4,5,0) -genericLiftTypedTExpWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m (TExp a) -# else -genericLiftTypedTExpWithPkgFallback :: (Quote m, Generic a, GLift (Rep a), OuterTypeable a) => String -> a -> m (TExp a) -# endif -# if MIN_VERSION_base(4,5,0) -genericLiftTypedTExpWithPkgFallback _pkg = genericLiftTypedTExp -# else -genericLiftTypedTExpWithPkgFallback = genericLiftTypedTExpWithPkg -# endif - --- | Like 'genericLiftWithPkg', but returns: --- --- * A 'Code' (if using @template-haskell-2.17.0.0@ or later), or --- * A 'TExp' (if using an older version of @template-haskell@) --- --- This function is ideal for implementing the 'liftTyped' method of 'Lift' --- directly, as its type changed in @template-haskell-2.17.0.0@. --- --- @since 0.2.1 -# if MIN_VERSION_base (4,9,0) || !MIN_VERSION_base (4,5,0) -genericLiftTypedCompatWithPkgFallback :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Splice m a -# else -genericLiftTypedCompatWithPkgFallback :: (Quote m, Generic a, GLift (Rep a), OuterTypeable a) => String -> a -> Splice m a -# endif -# if MIN_VERSION_template_haskell(2,17,0) -genericLiftTypedCompatWithPkgFallback = genericLiftTypedWithPkgFallback -# else -genericLiftTypedCompatWithPkgFallback = genericLiftTypedTExpWithPkgFallback -# endif -#endif - --- --- - --- | Generically produce an implementation of 'lift', given a user-provided --- (but correct!) package name. The provided package name is ignored for --- GHC 8.0 (@base@ 4.9) and later. -genericLiftWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m Exp -genericLiftWithPkg pkg = glift pkg . from - -#if MIN_VERSION_template_haskell(2,9,0) --- | Like 'genericLiftWithPkg', but returns a 'Code' instead of an 'Exp'. -genericLiftTypedWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Code m a -genericLiftTypedWithPkg pkg = unsafeCodeCoerce . genericLiftWithPkg pkg - --- | Like 'genericLiftWithPkg', but returns a 'TExp' instead of an 'Exp'. -genericLiftTypedTExpWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> m (TExp a) -genericLiftTypedTExpWithPkg pkg = unsafeTExpCoerceQuote . genericLiftWithPkg pkg - --- | Like 'genericLiftWithPkg', but returns: --- --- * A 'Code' (if using @template-haskell-2.17.0.0@ or later), or --- * A 'TExp' (if using an older version of @template-haskell@) --- --- This function is ideal for implementing the 'liftTyped' method of 'Lift' --- directly, as its type changed in @template-haskell-2.17.0.0@. -genericLiftTypedCompatWithPkg :: (Quote m, Generic a, GLift (Rep a)) => String -> a -> Splice m a -# if MIN_VERSION_template_haskell(2,17,0) -genericLiftTypedCompatWithPkg = genericLiftTypedWithPkg -# else -genericLiftTypedCompatWithPkg = genericLiftTypedTExpWithPkg -# endif -#endif - -#if MIN_VERSION_base (4,5,0) --- $friendlyFunctions --- --- The functions in this section are nice and simple, but are only available on --- GHC 7.4.1 (@base@ 4.5) and later due to API limitations of earlier GHC --- versions. The types of these functions depend slightly on the GHC version. --- In particular, before GHC 8.0 (@base@ 4.9), these functions have --- 'Data.Typeable.Typeable' constraints in addition to 'GHC.Generic.Generic' --- ones. +-- $genericLiftFunctions -- --- These functions do all of the work for you: +-- These functions leverage "GHC.Generics" to automatically implement 'lift' +-- implementations. These serve as 'Generic'-based alternatives to @DeriveLift@. +-- Here is an example of how to use them: -- -- @ -- {-# LANGUAGE DeriveGeneric #-} @@ -373,35 +87,15 @@ -- @ -- | Produce a generic definition of 'lift'. --- --- === Note --- --- A @'Data.Typeable.Typeable' a@ instance is required for GHC < 8.0 (@base@ < 4.9). -# if MIN_VERSION_base (4,9,0) genericLift :: (Quote m, Generic a, GLift (Rep a)) => a -> m Exp -genericLift = glift "" . from -# else -genericLift :: forall m a. (Quote m, Generic a, GLift (Rep a), OuterTypeable a) => a -> m Exp -genericLift = - glift (T.tyConPackage (T.typeRepTyCon (getConTR (Proxy :: Proxy a)))) - . from -# endif +genericLift = glift . from -# if MIN_VERSION_template_haskell(2,9,0) -- | Like 'genericLift', but returns a 'Code' instead of an 'Exp'. -# if MIN_VERSION_base (4,9,0) genericLiftTyped :: (Quote m, Generic a, GLift (Rep a)) => a -> Code m a -# else -genericLiftTyped :: (Quote m, Generic a, GLift (Rep a), OuterTypeable a) => a -> Code m a -# endif genericLiftTyped = unsafeCodeCoerce . genericLift -- | Like 'genericLift', but returns a 'TExp' instead of an 'Exp'. -# if MIN_VERSION_base (4,9,0) genericLiftTypedTExp :: (Quote m, Generic a, GLift (Rep a)) => a -> m (TExp a) -# else -genericLiftTypedTExp :: (Quote m, Generic a, GLift (Rep a), OuterTypeable a) => a -> m (TExp a) -# endif genericLiftTypedTExp = unsafeTExpCoerceQuote . genericLift -- | Lift 'genericLift', but returns: @@ -411,36 +105,25 @@ -- -- This function is ideal for implementing the 'liftTyped' method of 'Lift' -- directly, as its type changed in @template-haskell-2.17.0.0@. -# if MIN_VERSION_base (4,9,0) genericLiftTypedCompat :: (Quote m, Generic a, GLift (Rep a)) => a -> Splice m a -# else -genericLiftTypedCompat :: (Quote m, Generic a, GLift (Rep a), OuterTypeable a) => a -> Splice m a -# endif -# if MIN_VERSION_template_haskell(2,17,0) +#if MIN_VERSION_template_haskell(2,17,0) genericLiftTypedCompat = genericLiftTyped -# else +#else genericLiftTypedCompat = genericLiftTypedTExp -# endif -# endif #endif -- | Class of generic representation types which can be converted to Template -- Haskell expressions. class GLift f where glift :: Quote m - => String -- ^ The package name (not used on GHC 8.0 and later) - -> f a -- ^ The generic value + => f a -- ^ The generic value -> m Exp -- ^ The resulting Template Haskell expression instance (Datatype d, GLiftDatatype f) => GLift (D1 d f) where - glift _pkg d@(M1 x) = gliftWith pName mName x + glift d@(M1 x) = gliftWith pName mName x where pName, mName :: String -#if __GLASGOW_HASKELL__ >= 711 pName = packageName d -#else - pName = _pkg -#endif mName = moduleName d -- | Class of generic representation types which can be converted to Template @@ -456,17 +139,7 @@ -- While many instances for void types produce the laziest possible result -- (here, something like pure undefined), we choose to be stricter. There -- seems little if any benefit to delaying exceptions in this context. - gliftWith _ _ x = - case x of -#if __GLASGOW_HASKELL__ >= 708 - {} -#else - -- pseq ensures that we'll get the exception/non-termination - -- of v, rather than allowing GHC to "optimize" the function - -- to gliftWith _ _ _ = undefined, which it would be permitted - -- to do if we used seq or a bang pattern. - v -> v `pseq` undefined -#endif + gliftWith _ _ x = case x of {} instance (Constructor c, GLiftArgs f) => GLiftDatatype (C1 c f) where gliftWith pName mName c@(M1 x) = @@ -505,18 +178,11 @@ instance GLiftArgs UAddr where gliftArgs (UAddr a) h = return $ AppE h (LitE (StringPrimL (word8ify (unpackCString# a)))) where -#if MIN_VERSION_template_haskell(2,8,0) word8ify :: String -> [Word8] word8ify = map (fromIntegral . ord) -#else - word8ify :: String -> String - word8ify = id -#endif -#if MIN_VERSION_template_haskell(2,11,0) instance GLiftArgs UChar where gliftArgs (UChar c) h = return $ AppE h (LitE (CharPrimL (C# c))) -#endif instance GLiftArgs UDouble where gliftArgs (UDouble d) h = return $ AppE h (LitE (DoublePrimL (toRational (D# d)))) diff --git a/src/Language/Haskell/TH/Lift/Generics/Internal/OuterTypeable.hs b/src/Language/Haskell/TH/Lift/Generics/Internal/OuterTypeable.hs deleted file mode 100644 --- a/src/Language/Haskell/TH/Lift/Generics/Internal/OuterTypeable.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# language CPP #-} -{-# language FlexibleInstances #-} -{-# language UndecidableInstances #-} -{-# language ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 708 -{-# language PolyKinds #-} -#endif - -#if __GLASGOW_HASKELL__ < 710 -{-# language OverlappingInstances #-} -#endif - -module Language.Haskell.TH.Lift.Generics.Internal.OuterTypeable - ( OuterTypeable (..) - ) where -import Data.Typeable - --- | A type is @OuterTypable@ if its /type constructor/ (applied to any kind --- arguments) is 'Typeable'. For example, @'Maybe' a@ is only 'Typeable' if @a@ --- is 'Typeable', but it is always @OuterTypeable@. -class OuterTypeable a where - -- | Get the 'TypeRep' corresponding to the outermost constructor - -- of a type. - getConTR :: proxy a -> TypeRep - -#if __GLASGOW_HASKELL__ >= 708 - -# if __GLASGOW_HASKELL__ >= 710 -instance {-# OVERLAPPING #-} OuterTypeable f => OuterTypeable (f a) where -# else -instance OuterTypeable f => OuterTypeable (f a) where -# endif - getConTR _ = getConTR (Proxy :: Proxy f) - -instance Typeable a => OuterTypeable a where - getConTR = typeRep - --- Why do we need overlapping instances above? Couldn't we use --- the type family instance selection trick? No, we couldn't. We'd --- like to be able to write --- --- type family IsApp (a :: k) :: Bool where --- IsApp (f a) = 'True --- IsApp a = 'False --- --- and switch on that. Unfortunately, that type family wasn't allowed --- until TypeInType came out in GHC 8.0, which is precisely when we --- stop needing this module at all. - -#else - --- Before GHC 7.8, we didn't have polykinded Typeable, so things were --- rather less pleasant. - -instance Typeable a => OuterTypeable a where - getConTR _ = typeOf (undefined :: a) -instance Typeable1 p => OuterTypeable (p a) where - getConTR _ = typeOf1 (undefined :: p a) -instance Typeable2 p => OuterTypeable (p a b) where - getConTR _ = typeOf2 (undefined :: p a b) -instance Typeable3 p => OuterTypeable (p a b c) where - getConTR _ = typeOf3 (undefined :: p a b c) -instance Typeable4 p => OuterTypeable (p a b c d) where - getConTR _ = typeOf4 (undefined :: p a b c d) -instance Typeable5 p => OuterTypeable (p a b c d e) where - getConTR _ = typeOf5 (undefined :: p a b c d e) -instance Typeable6 p => OuterTypeable (p a b c d e f) where - getConTR _ = typeOf6 (undefined :: p a b c d e f) -instance Typeable7 p => OuterTypeable (p a b c d e f g) where - getConTR _ = typeOf7 (undefined :: p a b c d e f g) -#endif diff --git a/tests/LiftGenericsSpec.hs b/tests/LiftGenericsSpec.hs --- a/tests/LiftGenericsSpec.hs +++ b/tests/LiftGenericsSpec.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-| @@ -15,16 +14,13 @@ import Instances.TH.Lift () import Language.Haskell.TH.Syntax hiding (newName) import Language.Haskell.TH.Syntax.Compat -#if MIN_VERSION_base(4,5,0) import Language.Haskell.TH.Lift.Generics (genericLift) -# if MIN_VERSION_template_haskell(2,16,0) +#if MIN_VERSION_template_haskell(2,16,0) import Language.Haskell.TH.Lift.Generics (genericLiftTypedCompat) -# endif #endif import Test.Hspec import Types import Control.Exception (Exception, throw, evaluate) -import Data.Typeable (Typeable) main :: IO () main = hspec spec @@ -32,7 +28,7 @@ description :: String description = "should equal its lifted counterpart" -data Exc = Exc deriving (Show, Typeable, Eq) +data Exc = Exc deriving (Show, Eq) instance Exception Exc spec :: Spec @@ -59,7 +55,6 @@ describe "Ap" $ it description $ z `shouldBe` $(lift z) -#if MIN_VERSION_base(4,5,0) -- We use Tree to check that things work for types imported -- from external packages without special distinguished names. -- It proved rather tricky to find a good choice. This one's @@ -68,30 +63,7 @@ describe "Tree" $ it description $ w `shouldBe` $(genericLift w) - describe "Unit'" $ do - it description $ do - Unit' `shouldBe` $(lift Unit') - ConE 'Unit' `shouldBe` runPureQ (liftQuote Unit') - it "should throw an exception on undefined" $ - evaluate (runPureQ $ liftQuote (throw Exc :: Unit')) `shouldThrow` (== Exc) - describe "Product'" $ - it description $ - p' `shouldBe` $(lift p') - describe "Sum'" $ - it description $ - s' `shouldBe` $(lift s') - describe "Unboxed'" $ - it description $ - u' `shouldBe` $(lift u') - describe "Const'" $ - it description $ - c' `shouldBe` $(lift c') -# if __GLASGOW_HASKELL__ >= 708 - describe "Ap'" $ - it description $ - z' `shouldBe` $(lift z') -#endif -# if MIN_VERSION_template_haskell(2,16,0) +#if MIN_VERSION_template_haskell(2,16,0) describe "genericLiftTyped" $ do describe "Unit" $ it description $ do @@ -115,5 +87,4 @@ describe "Tree" $ it description $ w `shouldBe` $$(genericLiftTypedCompat w) -# endif #endif diff --git a/tests/Types.hs b/tests/Types.hs --- a/tests/Types.hs +++ b/tests/Types.hs @@ -1,18 +1,12 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -#if __GLASGOW_HASKELL__ >= 706 -{-# LANGUAGE DataKinds #-} -#endif - #if !MIN_VERSION_containers(0,5,8) -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -Wno-orphans #-} #endif {-| @@ -31,43 +25,24 @@ , Const(..) , Ap(..) , p, s, u, c, z, w -#if MIN_VERSION_base(4,5,0) - , Unit'(..) - , Product'(..) - , Sum'(..) - , Const'(..) - , Ap'(..) - , p', s', u', c', z' -#endif ) where import Data.Tree (Tree (..)) -#if MIN_VERSION_base(4,5,0) -import Data.Typeable (Typeable) -#endif import Control.Monad.State -import Generics.Deriving.TH (deriveAll) - +import GHC.Generics (Generic) import GHC.Exts import Language.Haskell.TH.Lift.Generics - ( genericLiftWithPkg -#if MIN_VERSION_base(4,5,0) - , genericLift -#endif + ( genericLift #if MIN_VERSION_template_haskell(2,16,0) - , genericLiftTypedCompatWithPkg , genericLiftTypedCompat #endif ) import Language.Haskell.TH.Syntax hiding (newName) import Language.Haskell.TH.Syntax.Compat -import Prelude () -import Prelude.Compat - newtype PureQ a = MkPureQ (State Uniq a) deriving (Functor, Applicative, Monad, MonadState Uniq) @@ -75,43 +50,29 @@ runPureQ m = case m of MkPureQ m' -> evalState m' 0 instance Quote PureQ where - newName s = state $ \i -> (mkNameU s i, i + 1) + newName str = state $ \i -> (mkNameU str i, i + 1) #if !MIN_VERSION_containers(0,5,8) -$(deriveAll ''Tree) +deriving instance Generic (Tree a) #endif data Unit = Unit - deriving (Eq, Ord, Show) -$(deriveAll ''Unit) + deriving (Eq, Generic, Ord, Show) data Product a b c d = Product a b c d - deriving (Eq, Ord, Show) -$(deriveAll ''Product) + deriving (Eq, Generic, Ord, Show) data Sum a b = Inl a | Inr b - deriving (Eq, Ord, Show) -$(deriveAll ''Sum) + deriving (Eq, Generic, Ord, Show) newtype Const a b = Const a - deriving (Eq, Ord, Show) -$(deriveAll ''Const) + deriving (Eq, Generic, Ord, Show) newtype Ap f a = Ap (f a) - deriving (Eq, Ord, Show) -$(deriveAll ''Ap) + deriving (Eq, Generic, Ord, Show) -data Unboxed a - = Unboxed a -#if MIN_VERSION_template_haskell(2,11,0) - Char# -#endif - Double# - Float# - Int# - Word# - deriving (Eq, Ord, Show) -$(deriveAll ''Unboxed) +data Unboxed a = Unboxed a Char# Double# Float# Int# Word# + deriving (Eq, Generic, Ord, Show) p :: Product Char Int Bool String p = Product 'a' 1 True "b" @@ -120,14 +81,7 @@ s = Inl 'c' u :: Unboxed Int -u = Unboxed 1 -#if MIN_VERSION_template_haskell(2,11,0) - '1'# -#endif - 1.0## - 1.0# - 1# - 1## +u = Unboxed 1 '1'# 1.0## 1.0# 1# 1## c :: Const Int a c = Const 1 @@ -138,150 +92,42 @@ w :: Tree Int w = Node 3 [Node 4 [], Node 5 []] -#if MIN_VERSION_base(4,5,0) - --- The types below are essentially the same as the ones above. However, we --- give them genericLift-based instances rather than genericLiftWithPkg ones, --- to ensure that the former work too. - -data Unit' = Unit' - deriving (Eq, Ord, Show, Typeable) -$(deriveAll ''Unit') - -data Product' a b c d = Product' a b c d - deriving (Eq, Ord, Show, Typeable) -$(deriveAll ''Product') - -data Sum' a b = Inl' a | Inr' b - deriving (Eq, Ord, Show, Typeable) -$(deriveAll ''Sum') - -newtype Const' a b = Const' a - deriving (Eq, Ord, Show, Typeable) -$(deriveAll ''Const') - -newtype Ap' f a = Ap' (f a) - deriving (Eq, Ord, Show) -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Ap' -#endif -$(deriveAll ''Ap') - -data Unboxed' a - = Unboxed' a -# if MIN_VERSION_template_haskell(2,11,0) - Char# -# endif - Double# - Float# - Int# - Word# - deriving (Eq, Ord, Show, Typeable) -$(deriveAll ''Unboxed') - -p' :: Product' Char Int Bool String -p' = Product' 'a' 1 True "b" - -s' :: Sum Char Int -s' = Inl 'c' - -u' :: Unboxed' Int -u' = Unboxed' 1 -# if MIN_VERSION_template_haskell(2,11,0) - '1'# -# endif - 1.0## - 1.0# - 1# - 1## - -c' :: Const' Int a -c' = Const' 1 - -z' :: Ap' Maybe Int -z' = Ap' (Just 3) -#endif - -pkgKey :: String -pkgKey = "main" - instance Lift Unit where - lift = genericLiftWithPkg pkgKey + lift = genericLift #if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompatWithPkg pkgKey + liftTyped = genericLiftTypedCompat #endif instance (Lift a, Lift b, Lift c, Lift d) => Lift (Product a b c d) where - lift = genericLiftWithPkg pkgKey + lift = genericLift #if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompatWithPkg pkgKey + liftTyped = genericLiftTypedCompat #endif instance (Lift a, Lift b) => Lift (Sum a b) where - lift = genericLiftWithPkg pkgKey + lift = genericLift #if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompatWithPkg pkgKey + liftTyped = genericLiftTypedCompat #endif instance Lift a => Lift (Unboxed a) where - lift = genericLiftWithPkg pkgKey -#if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompatWithPkg pkgKey -#endif - -instance Lift a => Lift (Const a b) where - lift = genericLiftWithPkg pkgKey -#if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompatWithPkg pkgKey -#endif - -instance Lift (f a) => Lift (Ap f a) where - lift = genericLiftWithPkg pkgKey -#if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompatWithPkg pkgKey -#endif - -#if MIN_VERSION_base(4,5,0) - -instance Lift Unit' where lift = genericLift -# if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompat -# endif - -instance (Lift a, Lift b, Lift c, Lift d) => Lift (Product' a b c d) where - lift = genericLift -# if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompat -# endif - -instance (Lift a, Lift b) => Lift (Sum' a b) where - lift = genericLift -# if MIN_VERSION_template_haskell(2,16,0) - liftTyped = genericLiftTypedCompat -# endif - -instance Lift a => Lift (Unboxed' a) where - lift = genericLift -# if MIN_VERSION_template_haskell(2,16,0) +#if MIN_VERSION_template_haskell(2,16,0) liftTyped = genericLiftTypedCompat -# endif +#endif -- This instance shows that we can have parametric polymorphism—we don't need -- Typeable instances for @a@ or @b@. -instance Lift a => Lift (Const' a b) where +instance Lift a => Lift (Const a b) where lift = genericLift -# if MIN_VERSION_template_haskell(2,16,0) +#if MIN_VERSION_template_haskell(2,16,0) liftTyped = genericLiftTypedCompat -# endif +#endif -# if __GLASGOW_HASKELL__ >= 708 --- This instance demonstrates some polykindedness—the arguments to Ap' aren't --- all of kind Type. This only works for GHC 7.8 and later. -instance Lift (f a) => Lift (Ap' f a) where +-- This instance demonstrates some polykindedness—the arguments to Ap aren't +-- all of kind Type. +instance Lift (f a) => Lift (Ap f a) where lift = genericLift -# if MIN_VERSION_template_haskell(2,16,0) +#if MIN_VERSION_template_haskell(2,16,0) liftTyped = genericLiftTypedCompat -# endif -# endif #endif