[Git][ghc/ghc][wip/T14030] Implement the "Derive Lift instances for data types in templste-haskell" proposal (#14030)
Sebastian Graf (@sgraf812)
gitlab at gitlab.haskell.org
Tue Jun 11 06:55:04 UTC 2024
Sebastian Graf pushed to branch wip/T14030 at Glasgow Haskell Compiler / GHC
Commits:
82e2a9e8 by Sebastian Graf at 2024-06-11T08:52:08+02:00
Implement the "Derive Lift instances for data types in templste-haskell" proposal (#14030)
After #22229 had been fixed, we can finally derive the `Lift` instance for the
TH AST, as proposed by Ryan Scott in
https://mail.haskell.org/pipermail/libraries/2015-September/026117.html.
Fixes #14030, #14296, #21759 and #24560.
- - - - -
3 changed files:
- libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
- libraries/template-haskell/changelog.md
- libraries/template-haskell/template-haskell.cabal.in
Changes:
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Lift.hs
=====================================
@@ -12,6 +12,8 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedSums #-}
{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE DeriveLift #-}
+{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}
-- | This module gives the definition of the 'Lift' class.
@@ -39,7 +41,7 @@ module GHC.Internal.TH.Lift
where
import GHC.Internal.TH.Syntax
-import GHC.Internal.TH.Lib () -- See wrinkle (W4) of Note [Tracking dependencies on primitives]
+import GHC.Internal.TH.Lib (litE) -- See wrinkle (W4) of Note [Tracking dependencies on primitives]
import GHC.Internal.Lexeme ( startsVarSym, startsVarId )
import GHC.Internal.Data.Either
@@ -52,7 +54,7 @@ import GHC.Internal.Integer
import GHC.Internal.Real
import GHC.Internal.Word
import GHC.Internal.Int
-import GHC.Internal.Data.Data
+import GHC.Internal.Data.Data hiding (Fixity)
import GHC.Internal.Natural
-- | A 'Lift' instance can have any of its values turned into a Template
@@ -424,6 +426,116 @@ rightName = 'Right
nonemptyName :: Name
nonemptyName = '(:|)
+-----------------------------------------------------
+--
+-- Lifting the TH AST
+--
+-----------------------------------------------------
+
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift ModName
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift NameSpace
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift NamespaceSpecifier
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift PkgName
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift NameFlavour
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift OccName
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Name
+
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Specificity
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift a => Lift (TyVarBndr a)
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift TyLit
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Type
+
+-- | @since template-haskell-2.22.1.0
+instance Lift Bytes where
+ lift = litE . BytesPrimL
+ liftTyped = unsafeCodeCoerce . lift
+-- | @since template-haskell-2.22.1.0
+
+deriving instance Lift Lit
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Pat
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Clause
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift DerivClause
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift DerivStrategy
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Overlap
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift FunDep
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Safety
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Callconv
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Foreign
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift FixityDirection
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Fixity
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Inline
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift RuleMatch
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Phases
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift RuleBndr
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift AnnTarget
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Pragma
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift SourceStrictness
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift SourceUnpackedness
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Bang
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Con
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift TySynEqn
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift FamilyResultSig
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift InjectivityAnn
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift BndrVis
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift TypeFamilyHead
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Role
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift PatSynArgs
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift PatSynDir
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Dec
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Range
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Exp
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Match
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Guard
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Stmt
+-- | @since template-haskell-2.22.1.0
+deriving instance Lift Body
+
-----------------------------------------------------
--
-- Generic Lift implementations
=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -1,5 +1,9 @@
# Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
+## 2.22.1.0
+
+ * `Lift` instances were added for the `template-haskell` AST.
+
## 2.22.0.0
* The kind of `Code` was changed from `forall r. (Type -> Type) -> TYPE r -> Type`
=====================================
libraries/template-haskell/template-haskell.cabal.in
=====================================
@@ -3,7 +3,7 @@
-- template-haskell.cabal.
name: template-haskell
-version: 2.22.0.0
+version: 2.22.1.0
-- NOTE: Don't forget to update ./changelog.md
license: BSD3
license-file: LICENSE
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82e2a9e8d3339c4a21cddc015a42e369d723902b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/82e2a9e8d3339c4a21cddc015a42e369d723902b
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240611/1c175fbf/attachment-0001.html>
More information about the ghc-commits
mailing list