template-haskell 2.20.0.0 → 2.21.0.0
raw patch · 7 files changed
+275/−148 lines, 7 filesdep ~basedep ~ghc-boot-th
Dependency ranges changed: base, ghc-boot-th
Files
- Language/Haskell/TH.hs +1/−0
- Language/Haskell/TH/Lib.hs +33/−15
- Language/Haskell/TH/Lib/Internal.hs +30/−23
- Language/Haskell/TH/Ppr.hs +29/−18
- Language/Haskell/TH/Syntax.hs +157/−89
- changelog.md +22/−0
- template-haskell.cabal +3/−3
Language/Haskell/TH.hs view
@@ -89,6 +89,7 @@ -- ** Types Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..), Syntax.Specificity(..),+ Syntax.BndrVis(..), FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType, BangType, VarBangType, -- ** Documentation
Language/Haskell/TH/Lib.hs view
@@ -24,7 +24,7 @@ BangTypeQ, VarBangTypeQ, StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ, FieldPatQ, RuleBndrQ, TySynEqnQ, PatSynDirQ, PatSynArgsQ, FamilyResultSigQ, DerivStrategyQ,- TyVarBndrUnit, TyVarBndrSpec,+ TyVarBndrUnit, TyVarBndrSpec, TyVarBndrVis, -- ** Constructors lifted to 'Q' -- *** Literals@@ -44,7 +44,7 @@ appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR, lamE, lam1E, lamCaseE, lamCasesE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE,- fieldExp, getFieldE, projectionE,+ fieldExp, getFieldE, projectionE, typedSpliceE, typedBracketE, -- **** Ranges fromE, fromThenE, fromToE, fromThenToE, @@ -77,9 +77,12 @@ varK, conK, tupleK, arrowK, listK, appK, starK, constraintK, -- *** Type variable binders+ DefaultBndrFlag(defaultBndrFlag), plainTV, kindedTV, plainInvisTV, kindedInvisTV,+ plainBndrTV, kindedBndrTV, specifiedSpec, inferredSpec,+ bndrReq, bndrInvis, -- *** Roles nominalR, representationalR, phantomR, inferR,@@ -192,10 +195,10 @@ ------------------------------------------------------------------------------- -- * Dec -tySynD :: Quote m => Name -> [TyVarBndr ()] -> m Type -> m Dec+tySynD :: Quote m => Name -> [TyVarBndr BndrVis] -> m Type -> m Dec tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) } -dataD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> Maybe Kind -> [m Con] -> [m DerivClause]+dataD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [m Con] -> [m DerivClause] -> m Dec dataD ctxt tc tvs ksig cons derivs = do@@ -204,7 +207,7 @@ derivs1 <- sequenceA derivs return (DataD ctxt1 tc tvs ksig cons1 derivs1) -newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> Maybe Kind -> m Con -> [m DerivClause]+newtypeD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> Maybe Kind -> m Con -> [m DerivClause] -> m Dec newtypeD ctxt tc tvs ksig con derivs = do@@ -213,14 +216,14 @@ derivs1 <- sequenceA derivs return (NewtypeD ctxt1 tc tvs ksig con1 derivs1) -typeDataD :: Quote m => Name -> [TyVarBndr ()] -> Maybe Kind -> [m Con]+typeDataD :: Quote m => Name -> [TyVarBndr BndrVis] -> Maybe Kind -> [m Con] -> m Dec typeDataD tc tvs ksig cons = do cons1 <- sequenceA cons return (TypeDataD tc tvs ksig cons1) -classD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> [FunDep] -> [m Dec] -> m Dec+classD :: Quote m => m Cxt -> Name -> [TyVarBndr BndrVis] -> [FunDep] -> [m Dec] -> m Dec classD ctxt cls tvs fds decs = do decs1 <- sequenceA decs@@ -255,16 +258,16 @@ derivs1 <- sequenceA derivs return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1) -dataFamilyD :: Quote m => Name -> [TyVarBndr ()] -> Maybe Kind -> m Dec+dataFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> Maybe Kind -> m Dec dataFamilyD tc tvs kind = pure $ DataFamilyD tc tvs kind -openTypeFamilyD :: Quote m => Name -> [TyVarBndr ()] -> FamilyResultSig+openTypeFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig -> Maybe InjectivityAnn -> m Dec openTypeFamilyD tc tvs res inj = pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj) -closedTypeFamilyD :: Quote m => Name -> [TyVarBndr ()] -> FamilyResultSig+closedTypeFamilyD :: Quote m => Name -> [TyVarBndr BndrVis] -> FamilyResultSig -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec closedTypeFamilyD tc tvs result injectivity eqns = do eqns1 <- sequenceA eqns@@ -296,13 +299,28 @@ return $ SigT t' k ---------------------------------------------------------------------------------- * Kind+-- * Type variable binders -plainTV :: Name -> TyVarBndr ()-plainTV n = PlainTV n ()+class DefaultBndrFlag flag where+ defaultBndrFlag :: flag -kindedTV :: Name -> Kind -> TyVarBndr ()-kindedTV n k = KindedTV n () k+instance DefaultBndrFlag () where+ defaultBndrFlag = ()++instance DefaultBndrFlag Specificity where+ defaultBndrFlag = SpecifiedSpec++instance DefaultBndrFlag BndrVis where+ defaultBndrFlag = BndrReq++plainTV :: DefaultBndrFlag flag => Name -> TyVarBndr flag+plainTV n = PlainTV n defaultBndrFlag++kindedTV :: DefaultBndrFlag flag => Name -> Kind -> TyVarBndr flag+kindedTV n k = KindedTV n defaultBndrFlag k++-------------------------------------------------------------------------------+-- * Kind starK :: Kind starK = StarT
Language/Haskell/TH/Lib/Internal.hs view
@@ -79,6 +79,7 @@ type TyVarBndrUnit = TyVarBndr () type TyVarBndrSpec = TyVarBndr Specificity+type TyVarBndrVis = TyVarBndr BndrVis ---------------------------------------------------------- -- * Lowercase pattern syntax functions@@ -380,6 +381,12 @@ projectionE :: Quote m => NonEmpty String -> m Exp projectionE xs = pure (ProjectionE xs) +typedSpliceE :: Quote m => m Exp -> m Exp+typedSpliceE = fmap TypedSpliceE++typedBracketE :: Quote m => m Exp -> m Exp+typedBracketE = fmap TypedBracketE+ -- ** 'arithSeqE' Shortcuts fromE :: Quote m => m Exp -> m Exp fromE x = do { a <- x; pure (ArithSeqE (FromR a)) }@@ -412,14 +419,14 @@ ; pure (FunD nm cs1) } -tySynD :: Quote m => Name -> [m (TyVarBndr ())] -> m Type -> m Dec+tySynD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m Type -> m Dec tySynD tc tvs rhs = do { tvs1 <- sequenceA tvs ; rhs1 <- rhs ; pure (TySynD tc tvs1 rhs1) } -dataD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> [m Con]+dataD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con] -> [m DerivClause] -> m Dec dataD ctxt tc tvs ksig cons derivs = do@@ -430,7 +437,7 @@ derivs1 <- sequenceA derivs pure (DataD ctxt1 tc tvs1 ksig1 cons1 derivs1) -newtypeD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> m Con+newtypeD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> m Con -> [m DerivClause] -> m Dec newtypeD ctxt tc tvs ksig con derivs = do@@ -441,7 +448,7 @@ derivs1 <- sequenceA derivs pure (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1) -typeDataD :: Quote m => Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> [m Con]+typeDataD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> [m Con] -> m Dec typeDataD tc tvs ksig cons = do@@ -450,7 +457,7 @@ cons1 <- sequenceA cons pure (TypeDataD tc tvs1 ksig1 cons1) -classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> [FunDep] -> [m Dec] -> m Dec+classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr BndrVis)] -> [FunDep] -> [m Dec] -> m Dec classD ctxt cls tvs fds decs = do tvs1 <- sequenceA tvs@@ -571,20 +578,20 @@ eqn1 <- eqn pure (TySynInstD eqn1) -dataFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> m Dec+dataFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> Maybe (m Kind) -> m Dec dataFamilyD tc tvs kind = do tvs' <- sequenceA tvs kind' <- sequenceA kind pure $ DataFamilyD tc tvs' kind' -openTypeFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> m FamilyResultSig+openTypeFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m FamilyResultSig -> Maybe InjectivityAnn -> m Dec openTypeFamilyD tc tvs res inj = do tvs' <- sequenceA tvs res' <- res pure $ OpenTypeFamilyD (TypeFamilyHead tc tvs' res' inj) -closedTypeFamilyD :: Quote m => Name -> [m (TyVarBndr ())] -> m FamilyResultSig+closedTypeFamilyD :: Quote m => Name -> [m (TyVarBndr BndrVis)] -> m FamilyResultSig -> Maybe InjectivityAnn -> [m TySynEqn] -> m Dec closedTypeFamilyD tc tvs result injectivity eqns = do tvs1 <- sequenceA tvs@@ -879,18 +886,30 @@ plainInvisTV :: Quote m => Name -> Specificity -> m (TyVarBndr Specificity) plainInvisTV n s = pure $ PlainTV n s +plainBndrTV :: Quote m => Name -> BndrVis -> m (TyVarBndr BndrVis)+plainBndrTV n v = pure $ PlainTV n v+ kindedTV :: Quote m => Name -> m Kind -> m (TyVarBndr ()) kindedTV n = fmap (KindedTV n ()) kindedInvisTV :: Quote m => Name -> Specificity -> m Kind -> m (TyVarBndr Specificity) kindedInvisTV n s = fmap (KindedTV n s) +kindedBndrTV :: Quote m => Name -> BndrVis -> m Kind -> m (TyVarBndr BndrVis)+kindedBndrTV n v = fmap (KindedTV n v)+ specifiedSpec :: Specificity specifiedSpec = SpecifiedSpec inferredSpec :: Specificity inferredSpec = InferredSpec +bndrReq :: BndrVis+bndrReq = BndrReq++bndrInvis :: BndrVis+bndrInvis = BndrInvis+ varK :: Name -> Kind varK = VarT @@ -1091,7 +1110,7 @@ Nothing -> funD nm cs -- | Variant of 'dataD' that attaches Haddock documentation.-dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr ())] -> Maybe (Q Kind)+dataD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> [(Q Con, Maybe String, [Maybe String])] -- ^ List of constructors, documentation for the constructor, and -- documentation for the arguments@@ -1105,7 +1124,7 @@ maybe dec (flip withDecDoc dec) mdoc -- | Variant of 'newtypeD' that attaches Haddock documentation.-newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr ())] -> Maybe (Q Kind)+newtypeD_doc :: Q Cxt -> Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> (Q Con, Maybe String, [Maybe String]) -- ^ The constructor, documentation for the constructor, and -- documentation for the arguments@@ -1119,7 +1138,7 @@ maybe dec (flip withDecDoc dec) mdoc -- | Variant of 'typeDataD' that attaches Haddock documentation.-typeDataD_doc :: Name -> [Q (TyVarBndr ())] -> Maybe (Q Kind)+typeDataD_doc :: Name -> [Q (TyVarBndr BndrVis)] -> Maybe (Q Kind) -> [(Q Con, Maybe String, [Maybe String])] -- ^ List of constructors, documentation for the constructor, and -- documentation for the arguments@@ -1191,15 +1210,3 @@ | nm <- get_cons_names c' , (i, Just arg_doc) <- zip [0..] arg_docs ]- where- get_cons_names :: Con -> [Name]- get_cons_names (NormalC n _) = [n]- get_cons_names (RecC n _) = [n]- get_cons_names (InfixC _ n _) = [n]- get_cons_names (ForallC _ _ cons) = get_cons_names cons- -- GadtC can have multiple names, e.g- -- > data Bar a where- -- > MkBar1, MkBar2 :: a -> Bar a- -- Will have one GadtC with [MkBar1, MkBar2] as names- get_cons_names (GadtC ns _ _) = ns- get_cons_names (RecGadtC ns _ _) = ns
Language/Haskell/TH/Ppr.hs view
@@ -232,6 +232,8 @@ pprExp _ (ImplicitParamVarE n) = text ('?' : n) pprExp _ (GetFieldE e f) = pprExp appPrec e <> text ('.': f) pprExp _ (ProjectionE xs) = parens $ hcat $ map ((char '.'<>) . text) $ toList xs+pprExp _ (TypedBracketE e) = text "[||" <> ppr e <> text "||]"+pprExp _ (TypedSpliceE e) = text "$$" <> pprExp appPrec e pprFields :: [(Name,Exp)] -> Doc pprFields = sep . punctuate comma . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e)@@ -300,27 +302,28 @@ pprLit _ (BytesPrimL {}) = pprString "<binary data>" pprLit i (RationalL rat) | withoutFactor 2 (withoutFactor 5 $ denominator rat) /= 1- -- if the denominator has prime factors other than 2 and 5, show as fraction+ -- if the denominator has prime factors other than 2 and 5+ -- or can't be represented as Double, show as fraction = parensIf (i > noPrec) $ integer (numerator rat) <+> char '/' <+> integer (denominator rat)- | rat /= 0 && (zeroes < -1 || zeroes > 7),- let (n, d) = properFraction (rat' / magnitude)- (rat', zeroes')- | abs rat < 1 = (10 * rat, zeroes - 1)- | otherwise = (rat, zeroes)+ | rat /= 0 && (zeroes < -2 || zeroes > 6),+ let (n, d) = properFraction (rat / magnitude) -- if < 0.01 or >= 100_000_000, use scientific notation = parensIf (i > noPrec && rat < 0) (integer n <> (if d == 0 then empty else char '.' <> decimals (abs d))- <> char 'e' <> integer zeroes')+ <> char 'e' <> integer zeroes) | let (n, d) = properFraction rat = parensIf (i > noPrec && rat < 0) (integer n <> char '.' <> if d == 0 then char '0' else decimals (abs d)) where zeroes :: Integer- zeroes = truncate (logBase 10 (abs (fromRational rat) :: Double)- * (1 - epsilon))- epsilon = 0.0000001+ zeroes = log10 (abs rat)+ log10 :: Rational -> Integer+ log10 x+ | x >= 10 = 1 + log10 (x / 10)+ | x < 1 = -1 + log10 (x * 10)+ | otherwise = 0 magnitude :: Rational magnitude = 10 ^^ zeroes withoutFactor :: Integer -> Integer -> Integer@@ -682,22 +685,22 @@ <+> pprName' Infix c <+> pprBangType st2 - ppr (ForallC ns ctxt (GadtC c sts ty))- = commaSepApplied c <+> dcolon <+> pprForall ns ctxt+ ppr (ForallC ns ctxt (GadtC cs sts ty))+ = commaSepApplied cs <+> dcolon <+> pprForall ns ctxt <+> pprGadtRHS sts ty - ppr (ForallC ns ctxt (RecGadtC c vsts ty))- = commaSepApplied c <+> dcolon <+> pprForall ns ctxt+ ppr (ForallC ns ctxt (RecGadtC cs vsts ty))+ = commaSepApplied cs <+> dcolon <+> pprForall ns ctxt <+> pprRecFields vsts ty ppr (ForallC ns ctxt con) = pprForall ns ctxt <+> ppr con - ppr (GadtC c sts ty)- = commaSepApplied c <+> dcolon <+> pprGadtRHS sts ty+ ppr (GadtC cs sts ty)+ = commaSepApplied cs <+> dcolon <+> pprGadtRHS sts ty - ppr (RecGadtC c vsts ty)- = commaSepApplied c <+> dcolon <+> pprRecFields vsts ty+ ppr (RecGadtC cs vsts ty)+ = commaSepApplied cs <+> dcolon <+> pprRecFields vsts ty instance Ppr PatSynDir where ppr Unidir = text "<-"@@ -946,6 +949,14 @@ pprTyVarBndr (PlainTV nm InferredSpec) = braces (ppr nm) pprTyVarBndr (KindedTV nm SpecifiedSpec k) = parens (ppr nm <+> dcolon <+> ppr k) pprTyVarBndr (KindedTV nm InferredSpec k) = braces (ppr nm <+> dcolon <+> ppr k)++instance PprFlag BndrVis where+ pprTyVarBndr (PlainTV nm vis) = pprBndrVis vis (ppr nm)+ pprTyVarBndr (KindedTV nm vis k) = pprBndrVis vis (parens (ppr nm <+> dcolon <+> ppr k))++pprBndrVis :: BndrVis -> Doc -> Doc+pprBndrVis BndrReq d = d+pprBndrVis BndrInvis d = char '@' <> d instance PprFlag flag => Ppr (TyVarBndr flag) where ppr bndr = pprTyVarBndr bndr
Language/Haskell/TH/Syntax.hs view
@@ -3,9 +3,12 @@ RankNTypes, RoleAnnotations, ScopedTypeVariables, MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds, GADTs, UnboxedTuples, UnboxedSums, TypeOperators,- Trustworthy, DeriveFunctor, BangPatterns, RecordWildCards, ImplicitParams #-}+ Trustworthy, DeriveFunctor, DeriveTraversable,+ BangPatterns, RecordWildCards, ImplicitParams #-} {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE StandaloneKindSignatures #-} ----------------------------------------------------------------------------- -- |@@ -31,6 +34,7 @@ -- $infix ) where +import qualified Data.Fixed as Fixed import Data.Data hiding (Fixity(..)) import Data.IORef import System.IO.Unsafe ( unsafePerformIO )@@ -53,7 +57,8 @@ import GHC.CString ( unpackCString# ) import GHC.Generics ( Generic ) import GHC.Types ( Int(..), Word(..), Char(..), Double(..), Float(..),- TYPE, RuntimeRep(..) )+ TYPE, RuntimeRep(..), Multiplicity (..) )+import qualified Data.Kind as Kind (Type) import GHC.Prim ( Int#, Word#, Char#, Double#, Float#, Addr# ) import GHC.Ptr ( Ptr, plusPtr ) import GHC.Lexeme ( startsVarSym, startsVarId )@@ -64,7 +69,6 @@ import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types-import GHC.Stack #if __GLASGOW_HASKELL__ >= 901 import GHC.Types ( Levity(..) )@@ -330,43 +334,14 @@ -- ----------------------------------------------------- +type TExp :: TYPE r -> Kind.Type type role TExp nominal -- See Note [Role of TExp]-newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp+newtype TExp a = TExp { unType :: Exp -- ^ Underlying untyped Template Haskell expression }--- ^ Represents an expression which has type @a@. Built on top of 'Exp', typed--- expressions allow for type-safe splicing via:------ - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if--- that expression has type @a@, then the quotation has type--- @'Q' ('TExp' a)@------ - typed splices inside of typed quotes, written as @$$(...)@ where @...@--- is an arbitrary expression of type @'Q' ('TExp' a)@------ Traditional expression quotes and splices let us construct ill-typed--- expressions:------ >>> fmap ppr $ runQ [| True == $( [| "foo" |] ) |]--- GHC.Types.True GHC.Classes.== "foo"--- >>> GHC.Types.True GHC.Classes.== "foo"--- <interactive> error:--- • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’--- • In the second argument of ‘(==)’, namely ‘"foo"’--- In the expression: True == "foo"--- In an equation for ‘it’: it = True == "foo"------ With typed expressions, the type error occurs when /constructing/ the--- Template Haskell expression:+-- ^ Typed wrapper around an 'Exp'. ----- >>> fmap ppr $ runQ [|| True == $$( [|| "foo" ||] ) ||]--- <interactive> error:--- • Couldn't match type ‘[Char]’ with ‘Bool’--- Expected type: Q (TExp Bool)--- Actual type: Q (TExp [Char])--- • In the Template Haskell quotation [|| "foo" ||]--- In the expression: [|| "foo" ||]--- In the Template Haskell splice $$([|| "foo" ||])+-- This is the typed representation of terms produced by typed quotes. -- -- Representation-polymorphic since /template-haskell-2.16.0.0/. @@ -394,21 +369,56 @@ TExp's argument must have a nominal role, not phantom as would be inferred (#8459). Consider - e :: TExp Age- e = MkAge 3+ e :: Code Q Age+ e = [|| MkAge 3 ||] foo = $(coerce e) + 4::Int The splice will evaluate to (MkAge 3) and you can't add that to-4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}+4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -} -- Code constructor +type Code :: (Kind.Type -> Kind.Type) -> TYPE r -> Kind.Type type role Code representational nominal -- See Note [Role of TExp]-newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code+newtype Code m a = Code { examineCode :: m (TExp a) -- ^ Underlying monadic value }+-- ^ Represents an expression which has type @a@, built in monadic context @m@. Built on top of 'TExp', typed+-- expressions allow for type-safe splicing via:+--+-- - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if+-- that expression has type @a@, then the quotation has type+-- @Quote m => Code m a@+--+-- - typed splices inside of typed quotes, written as @$$(...)@ where @...@+-- is an arbitrary expression of type @Quote m => Code m a@+--+-- Traditional expression quotes and splices let us construct ill-typed+-- expressions:+--+-- >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])+-- GHC.Types.True GHC.Classes.== "foo"+-- >>> GHC.Types.True GHC.Classes.== "foo"+-- <interactive> error:+-- • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’+-- • In the second argument of ‘(==)’, namely ‘"foo"’+-- In the expression: True == "foo"+-- In an equation for ‘it’: it = True == "foo"+--+-- With typed expressions, the type error occurs when /constructing/ the+-- Template Haskell expression:+--+-- >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])+-- <interactive> error:+-- • Couldn't match type ‘[Char]’ with ‘Bool’+-- Expected type: Code Q Bool+-- Actual type: Code Q [Char]+-- • In the Template Haskell quotation [|| "foo" ||]+-- In the expression: [|| "foo" ||]+-- In the Template Haskell splice $$([|| "foo" ||]) + -- | Unsafely convert an untyped code representation into a typed code -- representation. unsafeCodeCoerce :: forall (r :: RuntimeRep) (a :: TYPE r) m .@@ -957,7 +967,7 @@ -- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@ or -- @[|| ... ||]@) but not at the top level. As an example: ----- > add1 :: Int -> Q (TExp Int)+-- > add1 :: Int -> Code Q Int -- > add1 x = [|| x + 1 ||] -- -- Template Haskell has no way of knowing what value @x@ will take on at@@ -965,7 +975,7 @@ -- -- A 'Lift' instance must satisfy @$(lift x) ≡ x@ and @$$(liftTyped x) ≡ x@ -- for all @x@, where @$(...)@ and @$$(...)@ are Template Haskell splices.--- It is additionally expected that @'lift' x ≡ 'unTypeQ' ('liftTyped' x)@.+-- It is additionally expected that @'lift' x ≡ 'unTypeCode' ('liftTyped' x)@. -- -- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@ -- GHC language extension:@@ -1056,6 +1066,14 @@ liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (IntegerL (fromIntegral x))) +instance Lift (Fixed.Fixed a) where+ liftTyped x = unsafeCodeCoerce (lift x)+ lift (Fixed.MkFixed x) = do+ ex <- lift x+ return (ConE mkFixedName `AppE` ex)+ where+ mkFixedName = 'Fixed.MkFixed+ instance Integral a => Lift (Ratio a) where liftTyped x = unsafeCodeCoerce (lift x) lift x = return (LitE (RationalL (toRational x)))@@ -1125,19 +1143,8 @@ ptr :: ForeignPtr Word8 ptr = ForeignPtr (byteArrayContents# pb) (PlainPtr (unsafeCoerce# pb)) ---- We can't use a TH quote in this module because we're in the template-haskell--- package, so we conconct this quite defensive solution to make the correct name--- which will work if the package name or module name changes in future. addrToByteArrayName :: Name-addrToByteArrayName = helper- where- helper :: HasCallStack => Name- helper =- case getCallStack ?callStack of- [] -> error "addrToByteArrayName: empty call stack"- (_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray"-+addrToByteArrayName = 'addrToByteArray addrToByteArray :: Int -> Addr# -> ByteArray addrToByteArray (I# len) addr = runST $ ST $@@ -1357,23 +1364,24 @@ trueName, falseName :: Name-trueName = mkNameG DataName "ghc-prim" "GHC.Types" "True"-falseName = mkNameG DataName "ghc-prim" "GHC.Types" "False"+trueName = 'True+falseName = 'False nothingName, justName :: Name-nothingName = mkNameG DataName "base" "GHC.Maybe" "Nothing"-justName = mkNameG DataName "base" "GHC.Maybe" "Just"+nothingName = 'Nothing+justName = 'Just leftName, rightName :: Name-leftName = mkNameG DataName "base" "Data.Either" "Left"-rightName = mkNameG DataName "base" "Data.Either" "Right"+leftName = 'Left+rightName = 'Right nonemptyName :: Name-nonemptyName = mkNameG DataName "base" "GHC.Base" ":|"+nonemptyName = '(:|) oneName, manyName :: Name-oneName = mkNameG DataName "ghc-prim" "GHC.Types" "One"-manyName = mkNameG DataName "ghc-prim" "GHC.Types" "Many"+oneName = 'One+manyName = 'Many+ ----------------------------------------------------- -- -- Generic Lift implementations@@ -1488,8 +1496,9 @@ -- See #10796. varOrConE s = case nameSpace s of- Just VarName -> return (VarE s)- Just DataName -> return (ConE s)+ Just VarName -> return (VarE s)+ Just (FldName {}) -> return (VarE s)+ Just DataName -> return (ConE s) _ -> error $ "Can't construct an expression from name " ++ showName s appE x y = do { a <- x; b <- y; return (AppE a b)}@@ -1665,6 +1674,14 @@ | DataName -- ^ Data constructors | TcClsName -- ^ Type constructors and classes; Haskell has them -- in the same name space for now.+ | FldName+ { fldParent :: !String+ -- ^ The textual name of the parent of the field.+ --+ -- - For a field of a datatype, this is the name of the first constructor+ -- of the datatype (regardless of whether this constructor has this field).+ -- - For a field of a pattern synonym, this is the name of the pattern synonym.+ } deriving( Eq, Ord, Show, Data, Generic ) -- | @Uniq@ is used by GHC to distinguish names from each other.@@ -1824,6 +1841,13 @@ mkNameG_tc = mkNameG TcClsName mkNameG_d = mkNameG DataName +mkNameG_fld :: String -- ^ package+ -> String -- ^ module+ -> String -- ^ parent (first constructor of parent type)+ -> String -- ^ field name+ -> Name+mkNameG_fld pkg modu con occ = mkNameG (FldName con) pkg modu occ+ data NameIs = Alone | Applied | Infix showName :: Name -> String@@ -1847,11 +1871,11 @@ -- We may well want to distinguish them in the end. -- Ditto NameU and NameL nms = case nm of- Name occ NameS -> occString occ- Name occ (NameQ m) -> modString m ++ "." ++ occString occ- Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ- Name occ (NameU u) -> occString occ ++ "_" ++ show u- Name occ (NameL u) -> occString occ ++ "_" ++ show u+ Name occ NameS -> occString occ+ Name occ (NameQ m) -> modString m ++ "." ++ occString occ+ Name occ (NameG _ _ m) -> modString m ++ "." ++ occString occ+ Name occ (NameU u) -> occString occ ++ "_" ++ show u+ Name occ (NameL u) -> occString occ ++ "_" ++ show u pnam = classify nms @@ -2359,6 +2383,8 @@ | ImplicitParamVarE String -- ^ @{ ?x }@ ( Implicit parameter ) | GetFieldE Exp String -- ^ @{ exp.field }@ ( Overloaded Record Dot ) | ProjectionE (NonEmpty String) -- ^ @(.x)@ or @(.x.y)@ (Record projections)+ | TypedBracketE Exp -- ^ @[|| e ||]@+ | TypedSpliceE Exp -- ^ @$$e@ deriving( Show, Eq, Ord, Data, Generic ) type FieldExp = (Name,Exp)@@ -2392,22 +2418,22 @@ data Dec = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@ | ValD Pat Body [Dec] -- ^ @{ p = b where decs }@- | DataD Cxt Name [TyVarBndr ()]+ | DataD Cxt Name [TyVarBndr BndrVis] (Maybe Kind) -- Kind signature (allowed only for GADTs) [Con] [DerivClause] -- ^ @{ data Cxt x => T x = A x | B (T x) -- deriving (Z,W) -- deriving stock Eq }@- | NewtypeD Cxt Name [TyVarBndr ()]+ | NewtypeD Cxt Name [TyVarBndr BndrVis] (Maybe Kind) -- Kind signature Con [DerivClause] -- ^ @{ newtype Cxt x => T x = A (B x) -- deriving (Z,W Q) -- deriving stock Eq }@- | TypeDataD Name [TyVarBndr ()]+ | TypeDataD Name [TyVarBndr BndrVis] (Maybe Kind) -- Kind signature (allowed only for GADTs) [Con] -- ^ @{ type data T x = A x | B (T x) }@- | TySynD Name [TyVarBndr ()] Type -- ^ @{ type T x = (x,x) }@- | ClassD Cxt Name [TyVarBndr ()]+ | TySynD Name [TyVarBndr BndrVis] Type -- ^ @{ type T x = (x,x) }@+ | ClassD Cxt Name [TyVarBndr BndrVis] [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@ | InstanceD (Maybe Overlap) Cxt Type [Dec] -- ^ @{ instance {\-\# OVERLAPS \#-\}@@ -2424,7 +2450,7 @@ | PragmaD Pragma -- ^ @{ {\-\# INLINE [1] foo \#-\} }@ -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')- | DataFamilyD Name [TyVarBndr ()]+ | DataFamilyD Name [TyVarBndr BndrVis] (Maybe Kind) -- ^ @{ data family T a b c :: * }@ @@ -2548,7 +2574,7 @@ -- @TypeFamilyHead@ is defined to be the elements of the declaration -- between @type family@ and @where@. data TypeFamilyHead =- TypeFamilyHead Name [TyVarBndr ()] FamilyResultSig (Maybe InjectivityAnn)+ TypeFamilyHead Name [TyVarBndr BndrVis] FamilyResultSig (Maybe InjectivityAnn) deriving( Show, Eq, Ord, Data, Generic ) -- | One equation of a type family instance or closed type family. The@@ -2658,7 +2684,7 @@ | DecidedUnpack -- ^ Field inferred to be unpacked. deriving (Show, Eq, Ord, Data, Generic) --- | A single data constructor.+-- | A data constructor. -- -- The constructors for 'Con' can roughly be divided up into two categories: -- those for constructors with \"vanilla\" syntax ('NormalC', 'RecC', and@@ -2691,16 +2717,36 @@ -- Multiplicity annotations for data types are currently not supported -- in Template Haskell (i.e. all fields represented by Template Haskell -- will be linear).-data Con = NormalC Name [BangType] -- ^ @C Int a@- | RecC Name [VarBangType] -- ^ @C { v :: Int, w :: a }@- | InfixC BangType Name BangType -- ^ @Int :+ a@- | ForallC [TyVarBndr Specificity] Cxt Con -- ^ @forall a. Eq a => C [a]@- | GadtC [Name] [BangType]- Type -- See Note [GADT return type]- -- ^ @C :: a -> b -> T b Int@- | RecGadtC [Name] [VarBangType]- Type -- See Note [GADT return type]- -- ^ @C :: { v :: Int } -> T b Int@+data Con =+ -- | @C Int a@+ NormalC Name [BangType]++ -- | @C { v :: Int, w :: a }@+ | RecC Name [VarBangType]++ -- | @Int :+ a@+ | InfixC BangType Name BangType++ -- | @forall a. Eq a => C [a]@+ | ForallC [TyVarBndr Specificity] Cxt Con++ -- @C :: a -> b -> T b Int@+ | GadtC [Name]+ -- ^ The list of constructors, corresponding to the GADT constructor+ -- syntax @C1, C2 :: a -> T b@.+ --+ -- Invariant: the list must be non-empty.+ [BangType] -- ^ The constructor arguments+ Type -- ^ See Note [GADT return type]++ -- | @C :: { v :: Int } -> T b Int@+ | RecGadtC [Name]+ -- ^ The list of constructors, corresponding to the GADT record+ -- constructor syntax @C1, C2 :: { fld :: a } -> T b@.+ --+ -- Invariant: the list must be non-empty.+ [VarBangType] -- ^ The constructor arguments+ Type -- ^ See Note [GADT return type] deriving (Show, Eq, Ord, Data, Generic) -- Note [GADT return type]@@ -2804,10 +2850,20 @@ | InferredSpec -- ^ @{a}@ deriving( Show, Eq, Ord, Data, Generic ) +-- | The @flag@ type parameter is instantiated to one of the following types:+--+-- * 'Specificity' (examples: 'ForallC', 'ForallT')+-- * 'BndrVis' (examples: 'DataD', 'ClassD', etc.)+-- * '()', a catch-all type for other forms of binders, including 'ForallVisT', 'DataInstD', 'RuleP', and 'TyVarSig'+-- data TyVarBndr flag = PlainTV Name flag -- ^ @a@ | KindedTV Name flag Kind -- ^ @(a :: k)@- deriving( Show, Eq, Ord, Data, Generic, Functor )+ deriving( Show, Eq, Ord, Data, Generic, Functor, Foldable, Traversable ) +data BndrVis = BndrReq -- ^ @a@+ | BndrInvis -- ^ @\@a@+ deriving( Show, Eq, Ord, Data, Generic )+ -- | Type family result signature data FamilyResultSig = NoSig -- ^ no signature | KindSig Kind -- ^ @k@@@ -2897,3 +2953,15 @@ thenCmp :: Ordering -> Ordering -> Ordering thenCmp EQ o2 = o2 thenCmp o1 _ = o1++get_cons_names :: Con -> [Name]+get_cons_names (NormalC n _) = [n]+get_cons_names (RecC n _) = [n]+get_cons_names (InfixC _ n _) = [n]+get_cons_names (ForallC _ _ con) = get_cons_names con+-- GadtC can have multiple names, e.g+-- > data Bar a where+-- > MkBar1, MkBar2 :: a -> Bar a+-- Will have one GadtC with [MkBar1, MkBar2] as names+get_cons_names (GadtC ns _ _) = ns+get_cons_names (RecGadtC ns _ _) = ns
changelog.md view
@@ -1,5 +1,26 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.21.0.0++ * Shipped with GHC 9.8.1++ * Record fields now belong to separate `NameSpace`s, keyed by the parent of+ the record field. This is the name of the first constructor of the parent type,+ even if this constructor does not have the field in question. ++ This change enables TemplateHaskell support for `DuplicateRecordFields`.++ * Add support for generating typed splices and brackets in untyped Template Haskell+ Introduces `typedSpliceE :: Quote m => m Exp -> m Exp` and+ `typedBracketE :: Quote m => m Exp -> m Exp`++ * Add `BndrVis` to support invisible binders+ in type declarations (GHC Proposal #425).++ * The binder flag type in `plainTV` and `kindedTV` is generalized from `()`+ to any data type with a `DefaultBndrFlag` instance, including `()`,+ `Specificity`, and `BndrVis`.+ ## 2.20.0.0 * The `Ppr.pprInfixT` function has gained a `Precedence` argument. @@ -7,6 +28,7 @@ * Add `TypeDataD` constructor to the `Dec` type for `type data` declarations (GHC proposal #106).+ * Add `instance Lift (Fixed a)` ## 2.19.0.0
template-haskell.cabal view
@@ -3,7 +3,7 @@ -- template-haskell.cabal. name: template-haskell-version: 2.20.0.0+version: 2.21.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE@@ -55,8 +55,8 @@ Language.Haskell.TH.Lib.Map build-depends:- base >= 4.11 && < 4.19,- ghc-boot-th == 9.6.1,+ base >= 4.11 && < 4.20,+ ghc-boot-th == 9.8.1, ghc-prim, pretty == 1.1.*