template-haskell 2.14.0.0 → 2.15.0.0
raw patch · 9 files changed
+318/−114 lines, 9 filesdep ~basedep ~ghc-boot-thsetup-changed
Dependency ranges changed: base, ghc-boot-th
Files
- Language/Haskell/TH/Lib.hs +33/−11
- Language/Haskell/TH/Lib/Internal.hs +54/−19
- Language/Haskell/TH/Lib/Map.hs +2/−0
- Language/Haskell/TH/Ppr.hs +79/−32
- Language/Haskell/TH/Quote.hs +2/−1
- Language/Haskell/TH/Syntax.hs +110/−43
- Setup.hs +0/−2
- changelog.md +28/−1
- template-haskell.cabal +10/−5
Language/Haskell/TH/Lib.hs view
@@ -37,8 +37,8 @@ normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, -- *** Expressions- dyn, varE, unboundVarE, labelE, conE, litE, appE, appTypeE, uInfixE, parensE,- staticE, infixE, infixApp, sectionL, sectionR,+ dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,+ appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR, lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp, -- **** Ranges@@ -48,13 +48,14 @@ arithSeqE, fromR, fromThenR, fromToR, fromThenToR, -- **** Statements- doE, compE,- bindS, letS, noBindS, parS,+ doE, mdoE, compE,+ bindS, letS, noBindS, parS, recS, -- *** Types- forallT, varT, conT, appT, arrowT, infixT, uInfixT, parensT, equalityT,- listT, tupleT, unboxedTupleT, unboxedSumT, sigT, litT, wildCardT,- promotedT, promotedTupleT, promotedNilT, promotedConsT,+ forallT, varT, conT, appT, appKindT, arrowT, infixT, uInfixT, parensT,+ equalityT, listT, tupleT, unboxedTupleT, unboxedSumT, sigT, litT,+ wildCardT, promotedT, promotedTupleT, promotedNilT, promotedConsT,+ implicitParamT, -- **** Type literals numTyLit, strTyLit, -- **** Strictness@@ -113,6 +114,9 @@ patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn, infixPatSyn, recordPatSyn, + -- **** Implicit Parameters+ implicitParamBindD,+ -- ** Reify thisModule @@ -123,11 +127,13 @@ , dataD , newtypeD , classD+ , pragRuleD , dataInstD , newtypeInstD , dataFamilyD , openTypeFamilyD , closedTypeFamilyD+ , tySynEqn , forallC , forallT@@ -151,6 +157,7 @@ import Language.Haskell.TH.Syntax import Control.Monad (liftM2)+import Prelude -- All definitions below represent the "old" API, since their definitions are -- different in Language.Haskell.TH.Lib.Internal. Please think carefully before@@ -188,25 +195,33 @@ ctxt1 <- ctxt return $ ClassD ctxt1 cls tvs fds decs1 +pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ+pragRuleD n bndrs lhs rhs phases+ = do+ bndrs1 <- sequence bndrs+ lhs1 <- lhs+ rhs1 <- rhs+ return $ PragmaD $ RuleP n Nothing bndrs1 lhs1 rhs1 phases+ dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ] -> DecQ dataInstD ctxt tc tys ksig cons derivs = do ctxt1 <- ctxt- tys1 <- sequence tys+ ty1 <- foldl appT (conT tc) tys cons1 <- sequence cons derivs1 <- sequence derivs- return (DataInstD ctxt1 tc tys1 ksig cons1 derivs1)+ return (DataInstD ctxt1 Nothing ty1 ksig cons1 derivs1) newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> [DerivClauseQ] -> DecQ newtypeInstD ctxt tc tys ksig con derivs = do ctxt1 <- ctxt- tys1 <- sequence tys+ ty1 <- foldl appT (conT tc) tys con1 <- con derivs1 <- sequence derivs- return (NewtypeInstD ctxt1 tc tys1 ksig con1 derivs1)+ return (NewtypeInstD ctxt1 Nothing ty1 ksig con1 derivs1) dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ dataFamilyD tc tvs kind@@ -222,6 +237,13 @@ closedTypeFamilyD tc tvs result injectivity eqns = do eqns1 <- sequence eqns return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)++tySynEqn :: (Maybe [TyVarBndr]) -> TypeQ -> TypeQ -> TySynEqnQ+tySynEqn tvs lhs rhs =+ do+ lhs1 <- lhs+ rhs1 <- rhs+ return (TySynEqn tvs lhs1 rhs1) forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ forallC ns ctxt con = liftM2 (ForallC ns) ctxt con
Language/Haskell/TH/Lib/Internal.hs view
@@ -18,6 +18,7 @@ import qualified Language.Haskell.TH.Syntax as TH import Control.Monad( liftM, liftM2 ) import Data.Word( Word8 )+import Prelude ---------------------------------------------------------- -- * Type synonyms@@ -164,6 +165,9 @@ parS :: [[StmtQ]] -> StmtQ parS sss = do { sss1 <- mapM sequence sss; return (ParS sss1) } +recS :: [StmtQ] -> StmtQ+recS ss = do { ss1 <- sequence ss; return (RecS ss1) }+ ------------------------------------------------------------------------------- -- * Range @@ -304,6 +308,9 @@ doE :: [StmtQ] -> ExpQ doE ss = do { ss1 <- sequence ss; return (DoE ss1) } +mdoE :: [StmtQ] -> ExpQ+mdoE ss = do { ss1 <- sequence ss; return (MDoE ss1) }+ compE :: [StmtQ] -> ExpQ compE ss = do { ss1 <- sequence ss; return (CompE ss1) } @@ -338,6 +345,9 @@ labelE :: String -> ExpQ labelE s = return (LabelE s) +implicitParamVarE :: String -> ExpQ+implicitParamVarE n = return (ImplicitParamVarE n)+ -- ** 'arithSeqE' Shortcuts fromE :: ExpQ -> ExpQ fromE x = do { a <- x; return (ArithSeqE (FromR a)) }@@ -459,13 +469,15 @@ ty1 <- ty return $ PragmaD $ SpecialiseInstP ty1 -pragRuleD :: String -> [RuleBndrQ] -> ExpQ -> ExpQ -> Phases -> DecQ-pragRuleD n bndrs lhs rhs phases+pragRuleD :: String -> Maybe [TyVarBndrQ] -> [RuleBndrQ] -> ExpQ -> ExpQ+ -> Phases -> DecQ+pragRuleD n ty_bndrs tm_bndrs lhs rhs phases = do- bndrs1 <- sequence bndrs+ ty_bndrs1 <- traverse sequence ty_bndrs+ tm_bndrs1 <- sequence tm_bndrs lhs1 <- lhs rhs1 <- rhs- return $ PragmaD $ RuleP n bndrs1 lhs1 rhs1 phases+ return $ PragmaD $ RuleP n ty_bndrs1 tm_bndrs1 lhs1 rhs1 phases pragAnnD :: AnnTarget -> ExpQ -> DecQ pragAnnD target expr@@ -479,33 +491,35 @@ pragCompleteD :: [Name] -> Maybe Name -> DecQ pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty -dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe KindQ -> [ConQ]+dataInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> [ConQ] -> [DerivClauseQ] -> DecQ-dataInstD ctxt tc tys ksig cons derivs =+dataInstD ctxt mb_bndrs ty ksig cons derivs = do ctxt1 <- ctxt- tys1 <- sequenceA tys+ mb_bndrs1 <- traverse sequence mb_bndrs+ ty1 <- ty ksig1 <- sequenceA ksig cons1 <- sequenceA cons derivs1 <- sequenceA derivs- return (DataInstD ctxt1 tc tys1 ksig1 cons1 derivs1)+ return (DataInstD ctxt1 mb_bndrs1 ty1 ksig1 cons1 derivs1) -newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe KindQ -> ConQ+newtypeInstD :: CxtQ -> (Maybe [TyVarBndrQ]) -> TypeQ -> Maybe KindQ -> ConQ -> [DerivClauseQ] -> DecQ-newtypeInstD ctxt tc tys ksig con derivs =+newtypeInstD ctxt mb_bndrs ty ksig con derivs = do ctxt1 <- ctxt- tys1 <- sequenceA tys+ mb_bndrs1 <- traverse sequence mb_bndrs+ ty1 <- ty ksig1 <- sequenceA ksig con1 <- con derivs1 <- sequence derivs- return (NewtypeInstD ctxt1 tc tys1 ksig1 con1 derivs1)+ return (NewtypeInstD ctxt1 mb_bndrs1 ty1 ksig1 con1 derivs1) -tySynInstD :: Name -> TySynEqnQ -> DecQ-tySynInstD tc eqn =+tySynInstD :: TySynEqnQ -> DecQ+tySynInstD eqn = do eqn1 <- eqn- return (TySynInstD tc eqn1)+ return (TySynInstD eqn1) dataFamilyD :: Name -> [TyVarBndrQ] -> Maybe KindQ -> DecQ dataFamilyD tc tvs kind =@@ -562,12 +576,21 @@ do ty' <- ty return $ PatSynSigD nm ty' -tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ-tySynEqn lhs rhs =+-- | Implicit parameter binding declaration. Can only be used in let+-- and where clauses which consist entirely of implicit bindings.+implicitParamBindD :: String -> ExpQ -> DecQ+implicitParamBindD n e = do- lhs1 <- sequence lhs+ e' <- e+ return $ ImplicitParamBindD n e'++tySynEqn :: (Maybe [TyVarBndrQ]) -> TypeQ -> TypeQ -> TySynEqnQ+tySynEqn mb_bndrs lhs rhs =+ do+ mb_bndrs1 <- traverse sequence mb_bndrs+ lhs1 <- lhs rhs1 <- rhs- return (TySynEqn lhs1 rhs1)+ return (TySynEqn mb_bndrs1 lhs1 rhs1) cxt :: [PredQ] -> CxtQ cxt = sequence@@ -649,6 +672,12 @@ t2' <- t2 return $ AppT t1' t2' +appKindT :: TypeQ -> KindQ -> TypeQ+appKindT ty ki = do+ ty' <- ty+ ki' <- ki+ return $ AppKindT ty' ki'+ arrowT :: TypeQ arrowT = return ArrowT @@ -679,6 +708,12 @@ wildCardT :: TypeQ wildCardT = return WildCardT++implicitParamT :: String -> TypeQ -> TypeQ+implicitParamT n t+ = do+ t' <- t+ return $ ImplicitParamT n t' {-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-} classP :: Name -> [Q Type] -> Q Pred
Language/Haskell/TH/Lib/Map.hs view
@@ -16,6 +16,8 @@ , Language.Haskell.TH.Lib.Map.lookup ) where +import Prelude+ data Map k a = Bin {-# UNPACK #-} !Size !k a !(Map k a) !(Map k a) | Tip
Language/Haskell/TH/Ppr.hs view
@@ -179,6 +179,11 @@ pprStms [] = empty pprStms [s] = ppr s pprStms ss = braces (semiSep ss)+pprExp i (MDoE ss_) = parensIf (i > noPrec) $ text "mdo" <+> pprStms ss_+ where+ pprStms [] = empty+ pprStms [s] = ppr s+ pprStms ss = braces (semiSep ss) pprExp _ (CompE []) = text "<<Empty CompExp>>" -- This will probably break with fixity declarations - would need a ';'@@ -203,6 +208,7 @@ text "static"<+> pprExp appPrec e pprExp _ (UnboundVarE v) = pprName' Applied v pprExp _ (LabelE s) = text "#" <> text s+pprExp _ (ImplicitParamVarE n) = text ('?' : n) pprFields :: [(Name,Exp)] -> Doc pprFields = sep . punctuate comma . map (\(s,e) -> ppr s <+> equals <+> ppr e)@@ -218,6 +224,7 @@ ppr (NoBindS e) = ppr e ppr (ParS sss) = sep $ punctuate bar $ map commaSep sss+ ppr (RecS ss) = text "rec" <+> (braces (semiSep ss)) ------------------------------ instance Ppr Match where@@ -318,11 +325,11 @@ ppr_dec _ (ValD p r ds) = ppr p <+> pprBody True r $$ where_clause ds ppr_dec _ (TySynD t xs rhs)- = ppr_tySyn empty t (hsep (map ppr xs)) rhs+ = ppr_tySyn empty (Just t) (hsep (map ppr xs)) rhs ppr_dec _ (DataD ctxt t xs ksig cs decs)- = ppr_data empty ctxt t (hsep (map ppr xs)) ksig cs decs+ = ppr_data empty ctxt (Just t) (hsep (map ppr xs)) ksig cs decs ppr_dec _ (NewtypeD ctxt t xs ksig c decs)- = ppr_newtype empty ctxt t (sep (map ppr xs)) ksig c decs+ = ppr_newtype empty ctxt (Just t) (sep (map ppr xs)) ksig c decs ppr_dec _ (ClassD ctxt c xs fds ds) = text "class" <+> pprCxt ctxt <+> ppr c <+> hsep (map ppr xs) <+> ppr fds $$ where_clause ds@@ -340,18 +347,21 @@ | otherwise = empty maybeKind | (Just k') <- kind = dcolon <+> ppr k' | otherwise = empty-ppr_dec isTop (DataInstD ctxt tc tys ksig cs decs)- = ppr_data maybeInst ctxt tc (sep (map pprParendType tys)) ksig cs decs+ppr_dec isTop (DataInstD ctxt bndrs ty ksig cs decs)+ = ppr_data (maybeInst <+> ppr_bndrs bndrs)+ ctxt Nothing (ppr ty) ksig cs decs where maybeInst | isTop = text "instance" | otherwise = empty-ppr_dec isTop (NewtypeInstD ctxt tc tys ksig c decs)- = ppr_newtype maybeInst ctxt tc (sep (map pprParendType tys)) ksig c decs+ppr_dec isTop (NewtypeInstD ctxt bndrs ty ksig c decs)+ = ppr_newtype (maybeInst <+> ppr_bndrs bndrs)+ ctxt Nothing (ppr ty) ksig c decs where maybeInst | isTop = text "instance" | otherwise = empty-ppr_dec isTop (TySynInstD tc (TySynEqn tys rhs))- = ppr_tySyn maybeInst tc (sep (map pprParendType tys)) rhs+ppr_dec isTop (TySynInstD (TySynEqn mb_bndrs ty rhs))+ = ppr_tySyn (maybeInst <+> ppr_bndrs mb_bndrs)+ Nothing (ppr ty) rhs where maybeInst | isTop = text "instance" | otherwise = empty@@ -360,12 +370,12 @@ where maybeFamily | isTop = text "family" | otherwise = empty-ppr_dec _ (ClosedTypeFamilyD tfhead@(TypeFamilyHead tc _ _ _) eqns)+ppr_dec _ (ClosedTypeFamilyD tfhead eqns) = hang (text "type family" <+> ppr_tf_head tfhead <+> text "where") nestDepth (vcat (map ppr_eqn eqns)) where- ppr_eqn (TySynEqn lhs rhs)- = ppr tc <+> sep (map pprParendType lhs) <+> text "=" <+> ppr rhs+ ppr_eqn (TySynEqn mb_bndrs lhs rhs)+ = ppr_bndrs mb_bndrs <+> ppr lhs <+> text "=" <+> ppr rhs ppr_dec _ (RoleAnnotD name roles) = hsep [ text "type role", ppr name ] <+> hsep (map ppr roles) ppr_dec _ (StandaloneDerivD ds cxt ty)@@ -386,6 +396,8 @@ | otherwise = ppr pat ppr_dec _ (PatSynSigD name ty) = pprPatSynSig name ty+ppr_dec _ (ImplicitParamBindD n e)+ = hsep [text ('?' : n), text "=", ppr e] ppr_deriv_strategy :: DerivStrategy -> Doc ppr_deriv_strategy ds =@@ -403,12 +415,15 @@ Overlapping -> "{-# OVERLAPPING #-}" Incoherent -> "{-# INCOHERENT #-}" -ppr_data :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]+ppr_data :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc ppr_data maybeInst ctxt t argsDoc ksig cs decs = sep [text "data" <+> maybeInst <+> pprCxt ctxt- <+> pprName' Applied t <+> argsDoc <+> ksigDoc <+> maybeWhere,+ <+> case t of+ Just n -> pprName' Applied n <+> argsDoc+ Nothing -> argsDoc+ <+> ksigDoc <+> maybeWhere, nest nestDepth (sep (pref $ map ppr cs)), if null decs then empty@@ -435,12 +450,15 @@ Nothing -> empty Just k -> dcolon <+> ppr k -ppr_newtype :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> Con -> [DerivClause]+ppr_newtype :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause] -> Doc ppr_newtype maybeInst ctxt t argsDoc ksig c decs = sep [text "newtype" <+> maybeInst <+> pprCxt ctxt- <+> ppr t <+> argsDoc <+> ksigDoc,+ <+> case t of+ Just n -> ppr n <+> argsDoc+ Nothing -> argsDoc+ <+> ksigDoc, nest 2 (char '=' <+> ppr c), if null decs then empty@@ -464,9 +482,13 @@ Just (via@ViaStrategy{}) -> (empty, ppr_deriv_strategy via) _ -> (maybe empty ppr_deriv_strategy ds, empty) -ppr_tySyn :: Doc -> Name -> Doc -> Type -> Doc+ppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc ppr_tySyn maybeInst t argsDoc rhs- = text "type" <+> maybeInst <+> ppr t <+> argsDoc <+> text "=" <+> ppr rhs+ = text "type" <+> maybeInst+ <+> case t of+ Just n -> ppr n <+> argsDoc+ Nothing -> argsDoc+ <+> text "=" <+> ppr rhs ppr_tf_head :: TypeFamilyHead -> Doc ppr_tf_head (TypeFamilyHead tc tvs res inj)@@ -475,6 +497,10 @@ maybeInj | (Just inj') <- inj = ppr inj' | otherwise = empty +ppr_bndrs :: Maybe [TyVarBndr] -> Doc+ppr_bndrs (Just bndrs) = text "forall" <+> sep (map ppr bndrs) <> text "."+ppr_bndrs Nothing = empty+ ------------------------------ instance Ppr FunDep where ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys)@@ -526,14 +552,19 @@ <+> text "#-}" ppr (SpecialiseInstP inst) = text "{-# SPECIALISE instance" <+> ppr inst <+> text "#-}"- ppr (RuleP n bndrs lhs rhs phases)+ ppr (RuleP n ty_bndrs tm_bndrs lhs rhs phases) = sep [ text "{-# RULES" <+> pprString n <+> ppr phases- , nest 4 $ ppr_forall <+> ppr lhs+ , nest 4 $ ppr_ty_forall ty_bndrs <+> ppr_tm_forall ty_bndrs+ <+> ppr lhs , nest 4 $ char '=' <+> ppr rhs <+> text "#-}" ]- where ppr_forall | null bndrs = empty- | otherwise = text "forall"- <+> fsep (map ppr bndrs)- <+> char '.'+ where ppr_ty_forall Nothing = empty+ ppr_ty_forall (Just bndrs) = text "forall"+ <+> fsep (map ppr bndrs)+ <+> char '.'+ ppr_tm_forall Nothing | null tm_bndrs = empty+ ppr_tm_forall _ = text "forall"+ <+> fsep (map ppr tm_bndrs)+ <+> char '.' ppr (AnnP tgt expr) = text "{-# ANN" <+> target1 tgt <+> ppr expr <+> text "#-}" where target1 ModuleAnnotation = text "module"@@ -716,7 +747,11 @@ pprParendType tuple | (TupleT n, args) <- split tuple , length args == n = parens (commaSep args)-pprParendType other = parens (ppr other)+pprParendType (ImplicitParamT n t)= text ('?':n) <+> text "::" <+> ppr t+pprParendType EqualityT = text "(~)"+pprParendType t@(ForallT {}) = parens (ppr t)+pprParendType t@(AppT {}) = parens (ppr t)+pprParendType t@(AppKindT {}) = parens (ppr t) pprUInfixT :: Type -> Doc pprUInfixT (UInfixT x n y) = pprUInfixT x <+> pprName' Infix n <+> pprUInfixT y@@ -727,7 +762,13 @@ ppr ty = pprTyApp (split ty) -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind) -- See Note [Pretty-printing kind signatures]+instance Ppr TypeArg where+ ppr (TANormal ty) = ppr ty+ ppr (TyArg ki) = char '@' <> ppr ki +pprParendTypeArg :: TypeArg -> Doc+pprParendTypeArg (TANormal ty) = pprParendType ty+pprParendTypeArg (TyArg ki) = char '@' <> pprParendType ki {- Note [Pretty-printing kind signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHC's parser only recognises a kind signature in a type when there are@@ -736,16 +777,16 @@ type instance F Int = (Bool :: *) So we always print a SigT with parens (see Trac #10050). -} -pprTyApp :: (Type, [Type]) -> Doc-pprTyApp (ArrowT, [arg1,arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2]-pprTyApp (EqualityT, [arg1, arg2]) =+pprTyApp :: (Type, [TypeArg]) -> Doc+pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2]+pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "~", ppr arg2]-pprTyApp (ListT, [arg]) = brackets (ppr arg)+pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg) pprTyApp (TupleT n, args) | length args == n = parens (commaSep args) pprTyApp (PromotedTupleT n, args) | length args == n = quoteParens (commaSep args)-pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendType args)+pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args) pprFunArgType :: Type -> Doc -- Should really use a precedence argument -- Everything except forall and (->) binds more tightly than (->)@@ -754,9 +795,13 @@ pprFunArgType ty@(SigT _ _) = parens (ppr ty) pprFunArgType ty = ppr ty -split :: Type -> (Type, [Type]) -- Split into function and args+data TypeArg = TANormal Type+ | TyArg Kind++split :: Type -> (Type, [TypeArg]) -- Split into function and args split t = go t []- where go (AppT t1 t2) args = go t1 (t2:args)+ where go (AppT t1 t2) args = go t1 (TANormal t2:args)+ go (AppKindT ty ki) args = go ty (TyArg ki:args) go ty args = (ty, args) pprTyLit :: TyLit -> Doc@@ -784,6 +829,8 @@ ppr_cxt_preds :: Cxt -> Doc ppr_cxt_preds [] = empty+ppr_cxt_preds [t@ImplicitParamT{}] = parens (ppr t)+ppr_cxt_preds [t@ForallT{}] = parens (ppr t) ppr_cxt_preds [t] = ppr t ppr_cxt_preds ts = parens (commaSep ts)
Language/Haskell/TH/Quote.hs view
@@ -21,6 +21,7 @@ ) where import Language.Haskell.TH.Syntax+import Prelude -- | The 'QuasiQuoter' type, a value @q@ of this type can be used -- in the syntax @[q| ... string to parse ...|]@. In fact, for@@ -41,7 +42,7 @@ } -- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read--- the data out of a file. For example, suppose 'asmq' is an +-- the data out of a file. For example, suppose @asmq@ is an -- assembly-language quoter, so that you can write [asmq| ld r1, r2 |] -- as an expression. Then if you define @asmq_f = quoteFile asmq@, then -- the quote [asmq_f|foo.s|] will take input from file @"foo.s"@ instead
Language/Haskell/TH/Syntax.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable,+{-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, DefaultSignatures, RankNTypes, RoleAnnotations, ScopedTypeVariables, Trustworthy #-}@@ -34,6 +34,8 @@ import System.IO ( hPutStrLn, stderr ) import Data.Char ( isAlpha, isAlphaNum, isUpper ) import Data.Int+import Data.List.NonEmpty ( NonEmpty(..) )+import Data.Void ( Void, absurd ) import Data.Word import Data.Ratio import GHC.Generics ( Generic )@@ -41,6 +43,7 @@ import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions import Numeric.Natural+import Prelude import qualified Control.Monad.Fail as Fail @@ -175,7 +178,9 @@ instance Monad Q where Q m >>= k = Q (m >>= \x -> unQ (k x)) (>>) = (*>)+#if !MIN_VERSION_base(4,13,0) fail = Fail.fail+#endif instance Fail.MonadFail Q where fail s = report True s >> Q (Fail.fail "Q monad failure")@@ -376,6 +381,19 @@ if @nm@ is the name of a type class, then all instances of this class at the types @tys@ are returned. Alternatively, if @nm@ is the name of a data family or type family, all instances of this family at the types @tys@ are returned.++Note that this is a \"shallow\" test; the declarations returned merely have+instance heads which unify with @nm tys@, they need not actually be satisfiable.++ - @reifyInstances ''Eq [ 'TupleT' 2 \``AppT`\` 'ConT' ''A \``AppT`\` 'ConT' ''B ]@ contains+ the @instance (Eq a, Eq b) => Eq (a, b)@ regardless of whether @A@ and+ @B@ themselves implement 'Eq'++ - @reifyInstances ''Show [ 'VarT' ('mkName' "a") ]@ produces every available+ instance of 'Eq'++There is one edge case: @reifyInstances ''Typeable tys@ currently always+produces an empty list (no matter what @tys@ are given). -} reifyInstances :: Name -> [Type] -> Q [InstanceDec] reifyInstances cls tys = Q (qReifyInstances cls tys)@@ -396,7 +414,7 @@ -- | @reifyModule mod@ looks up information about module @mod@. To -- look up the current module, call this function with the return--- value of @thisModule@.+-- value of 'Language.Haskell.TH.Lib.thisModule'. reifyModule :: Module -> Q ModuleInfo reifyModule m = Q (qReifyModule m) @@ -473,7 +491,7 @@ -- Note that for non-C languages (for example C++) @extern "C"@ directives -- must be used to get symbols that we can access from Haskell. ----- To get better errors, it is reccomended to use #line pragmas when+-- To get better errors, it is recommended to use #line pragmas when -- emitting C files, e.g. -- -- > {-# LANGUAGE CPP #-}@@ -485,11 +503,12 @@ addForeignSource :: ForeignSrcLang -> String -> Q () addForeignSource lang src = do let suffix = case lang of- LangC -> "c"- LangCxx -> "cpp"- LangObjc -> "m"+ LangC -> "c"+ LangCxx -> "cpp"+ LangObjc -> "m" LangObjcxx -> "mm"- RawObject -> "a"+ LangAsm -> "s"+ RawObject -> "a" path <- addTempFile suffix runIO $ writeFile path src addForeignFilePath lang path@@ -687,6 +706,17 @@ -- Used in TcExpr to short-circuit the lifting for strings liftString s = return (LitE (StringL s)) +-- | @since 2.15.0.0+instance Lift a => Lift (NonEmpty a) where+ lift (x :| xs) = do+ x' <- lift x+ xs' <- lift xs+ return (InfixE (Just x') (ConE nonemptyName) (Just xs'))++-- | @since 2.15.0.0+instance Lift Void where+ lift = pure . absurd+ instance Lift () where lift () = return (ConE (tupleDataName 0)) @@ -738,6 +768,9 @@ leftName = mkNameG DataName "base" "Data.Either" "Left" rightName = mkNameG DataName "base" "Data.Either" "Right" +nonemptyName :: Name+nonemptyName = mkNameG DataName "base" "GHC.Base" ":|"+ ----------------------------------------------------- -- -- Generic Lift implementations@@ -891,7 +924,7 @@ newtype PkgName = PkgName String -- package name deriving (Show,Eq,Ord,Data,Generic) --- | Obtained from 'reifyModule' and 'thisModule'.+-- | Obtained from 'reifyModule' and 'Language.Haskell.TH.Lib.thisModule'. data Module = Module PkgName ModName -- package qualified module name deriving (Show,Eq,Ord,Data,Generic) @@ -1115,7 +1148,7 @@ > mkName "Prelude.pi" See also 'Language.Haskell.TH.Lib.dyn' for a useful combinator. The above example could-be rewritten using 'dyn' as+be rewritten using 'Language.Haskell.TH.Lib.dyn' as > f = [| pi + $(dyn "pi") |] -}@@ -1343,7 +1376,10 @@ Type ParentName - -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned using 'PrimTyConI' or 'FamilyI' as appropriate+ -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned+ -- using 'PrimTyConI' or 'FamilyI' as appropriate. At present, this reified+ -- declaration will never have derived instances attached to it (if you wish+ -- to check for an instance, see 'reifyInstances'). | TyConI Dec @@ -1353,7 +1389,8 @@ Dec [InstanceDec] - -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'. Examples: @(->)@, @Int#@.+ -- | A \"primitive\" type constructor, which can't be expressed with a 'Dec'.+ -- Examples: @(->)@, @Int#@. | PrimTyConI Name Arity@@ -1365,7 +1402,7 @@ Type ParentName - -- | A pattern synonym.+ -- | A pattern synonym | PatSynI Name PatSynType@@ -1374,9 +1411,9 @@ A \"value\" variable (as opposed to a type variable, see 'TyVarI'). The @Maybe Dec@ field contains @Just@ the declaration which- defined the variable -- including the RHS of the declaration --+ defined the variable - including the RHS of the declaration - or else @Nothing@, in the case where the RHS is unavailable to- the compiler. At present, this value is _always_ @Nothing@:+ the compiler. At present, this value is /always/ @Nothing@: returning the RHS has not yet been implemented because of lack of interest. -}@@ -1600,9 +1637,10 @@ | UnboxedSumE Exp SumAlt SumArity -- ^ @{ (\#|e|\#) }@ | CondE Exp Exp Exp -- ^ @{ if e1 then e2 else e3 }@ | MultiIfE [(Guard, Exp)] -- ^ @{ if | g1 -> e1 | g2 -> e2 }@- | LetE [Dec] Exp -- ^ @{ let x=e1; y=e2 in e3 }@+ | LetE [Dec] Exp -- ^ @{ let { x=e1; y=e2 } in e3 }@ | CaseE Exp [Match] -- ^ @{ case e of m1; m2 }@ | DoE [Stmt] -- ^ @{ do { p <- e1; e2 } }@+ | MDoE [Stmt] -- ^ @{ mdo { x <- e1 y; y <- e2 x; } }@ | CompE [Stmt] -- ^ @{ [ (x,y) | x <- xs, y <- ys ] }@ -- -- The result expression of the comprehension is@@ -1620,8 +1658,14 @@ | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@ | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ | StaticE Exp -- ^ @{ static e }@- | UnboundVarE Name -- ^ @{ _x }@ (hole)+ | UnboundVarE Name -- ^ @{ _x }@+ --+ -- This is used for holes or unresolved+ -- identifiers in AST quotes. Note that+ -- it could either have a variable name+ -- or constructor name. | LabelE String -- ^ @{ #x }@ ( Overloaded label )+ | ImplicitParamVarE String -- ^ @{ ?x }@ ( Implicit parameter ) deriving( Show, Eq, Ord, Data, Generic ) type FieldExp = (Name,Exp)@@ -1641,10 +1685,11 @@ deriving( Show, Eq, Ord, Data, Generic ) data Stmt- = BindS Pat Exp- | LetS [ Dec ]- | NoBindS Exp- | ParS [[Stmt]]+ = BindS Pat Exp -- ^ @p <- e@+ | LetS [ Dec ] -- ^ @{ let { x=e1; y=e2 } }@+ | NoBindS Exp -- ^ @e@+ | ParS [[Stmt]] -- ^ @x <- e1 | s2, s3 | s4@ (in 'CompE')+ | RecS [Stmt] -- ^ @rec { s1; s2 }@ deriving( Show, Eq, Ord, Data, Generic ) data Range = FromR Exp | FromThenR Exp Exp@@ -1685,20 +1730,20 @@ (Maybe Kind) -- ^ @{ data family T a b c :: * }@ - | DataInstD Cxt Name [Type]+ | DataInstD Cxt (Maybe [TyVarBndr]) Type (Maybe Kind) -- Kind signature [Con] [DerivClause] -- ^ @{ data instance Cxt x => T [x] -- = A x | B (T x) -- deriving (Z,W) -- deriving stock Eq }@ - | NewtypeInstD Cxt Name [Type]+ | NewtypeInstD Cxt (Maybe [TyVarBndr]) Type -- Quantified type vars (Maybe Kind) -- Kind signature Con [DerivClause] -- ^ @{ newtype instance Cxt x => T [x] -- = A (B x) -- deriving (Z,W) -- deriving stock Eq }@- | TySynInstD Name TySynEqn -- ^ @{ type instance ... }@+ | TySynInstD TySynEqn -- ^ @{ type instance ... }@ -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD') | OpenTypeFamilyD TypeFamilyHead@@ -1723,6 +1768,12 @@ -- pattern synonyms are supported. See 'PatSynArgs' for details | PatSynSigD Name PatSynType -- ^ A pattern synonym's type signature.++ | ImplicitParamBindD String Exp+ -- ^ @{ ?x = expr }@+ --+ -- Implicit parameter binding declaration. Can only be used in let+ -- and where clauses which consist entirely of implicit bindings. deriving( Show, Eq, Ord, Data, Generic ) -- | Varieties of allowed instance overlap.@@ -1746,51 +1797,51 @@ | ViaStrategy Type -- ^ @-XDerivingVia@ deriving( Show, Eq, Ord, Data, Generic ) --- | A Pattern synonym's type. Note that a pattern synonym's *fully*+-- | A pattern synonym's type. Note that a pattern synonym's /fully/ -- specified type has a peculiar shape coming with two forall -- quantifiers and two constraint contexts. For example, consider the -- pattern synonym ----- pattern P x1 x2 ... xn = <some-pattern>+-- > pattern P x1 x2 ... xn = <some-pattern> -- -- P's complete type is of the following form ----- forall universals. required constraints--- => forall existentials. provided constraints--- => t1 -> t2 -> ... -> tn -> t+-- > pattern P :: forall universals. required constraints+-- > => forall existentials. provided constraints+-- > => t1 -> t2 -> ... -> tn -> t -- -- consisting of four parts: ----- 1) the (possibly empty lists of) universally quantified type+-- 1. the (possibly empty lists of) universally quantified type -- variables and required constraints on them.--- 2) the (possibly empty lists of) existentially quantified+-- 2. the (possibly empty lists of) existentially quantified -- type variables and the provided constraints on them.--- 3) the types t1, t2, .., tn of x1, x2, .., xn, respectively--- 4) the type t of <some-pattern>, mentioning only universals.+-- 3. the types @t1@, @t2@, .., @tn@ of @x1@, @x2@, .., @xn@, respectively+-- 4. the type @t@ of @\<some-pattern\>@, mentioning only universals. -- -- Pattern synonym types interact with TH when (a) reifying a pattern -- synonym, (b) pretty printing, or (c) specifying a pattern synonym's -- type signature explicitly: ----- (a) Reification always returns a pattern synonym's *fully* specified+-- * Reification always returns a pattern synonym's /fully/ specified -- type in abstract syntax. ----- (b) Pretty printing via 'pprPatSynType' abbreviates a pattern--- synonym's type unambiguously in concrete syntax: The rule of+-- * Pretty printing via 'Language.Haskell.TH.Ppr.pprPatSynType' abbreviates+-- a pattern synonym's type unambiguously in concrete syntax: The rule of -- thumb is to print initial empty universals and the required--- context as `() =>`, if existentials and a provided context+-- context as @() =>@, if existentials and a provided context -- follow. If only universals and their required context, but no -- existentials are specified, only the universals and their -- required context are printed. If both or none are specified, so -- both (or none) are printed. ----- (c) When specifying a pattern synonym's type explicitly with+-- * When specifying a pattern synonym's type explicitly with -- 'PatSynSigD' either one of the universals, the existentials, or -- their contexts may be left empty. -- -- See the GHC user's guide for more information on pattern synonyms--- and their types: https://downloads.haskell.org/~ghc/latest/docs/html/--- users_guide/syntax-extns.html#pattern-synonyms.+-- and their types:+-- <https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/glasgow_exts.html#pattern-synonyms>. type PatSynType = Type -- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By@@ -1803,9 +1854,23 @@ deriving( Show, Eq, Ord, Data, Generic ) -- | One equation of a type family instance or closed type family. The--- arguments are the left-hand-side type patterns and the right-hand-side--- result.-data TySynEqn = TySynEqn [Type] Type+-- arguments are the left-hand-side type and the right-hand-side result.+--+-- For instance, if you had the following type family:+--+-- @+-- type family Foo (a :: k) :: k where+-- forall k (a :: k). Foo \@k a = a+-- @+--+-- The @Foo \@k a = a@ equation would be represented as follows:+--+-- @+-- 'TySynEqn' ('Just' ['PlainTV' k, 'KindedTV' a ('VarT' k)])+-- ('AppT' ('AppKindT' ('ConT' ''Foo) ('VarT' k)) ('VarT' a))+-- ('VarT' a)+-- @+data TySynEqn = TySynEqn (Maybe [TyVarBndr]) Type Type deriving( Show, Eq, Ord, Data, Generic ) data FunDep = FunDep [Name] [Name]@@ -1825,7 +1890,7 @@ data Pragma = InlineP Name Inline RuleMatch Phases | SpecialiseP Name Type (Maybe Inline) Phases | SpecialiseInstP Type- | RuleP String [RuleBndr] Exp Exp Phases+ | RuleP String (Maybe [TyVarBndr]) [RuleBndr] Exp Exp Phases | AnnP AnnTarget Exp | LineP Int String | CompleteP [Name] (Maybe Name)@@ -1985,6 +2050,7 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> => \<type\>@ | AppT Type Type -- ^ @T a b@+ | AppKindT Type Kind -- ^ @T \@k t@ | SigT Type Kind -- ^ @t :: k@ | VarT Name -- ^ @a@ | ConT Name -- ^ @T@@@ -2009,6 +2075,7 @@ | ConstraintT -- ^ @Constraint@ | LitT TyLit -- ^ @0,1,2, etc.@ | WildCardT -- ^ @_@+ | ImplicitParamT String Type -- ^ @?x :: t@ deriving( Show, Eq, Ord, Data, Generic ) data TyVarBndr = PlainTV Name -- ^ @a@
Setup.hs view
@@ -1,6 +1,4 @@ module Main (main) where- import Distribution.Simple- main :: IO () main = defaultMain
changelog.md view
@@ -1,7 +1,29 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) -## 2.14.0.0 *August 2018*+## 2.15.0.0 *May 2019 + * In `Language.Haskell.TH.Syntax`, `DataInstD`, `NewTypeInstD`, `TySynEqn`,+ and `RuleP` now all have a `Maybe [TyVarBndr]` argument, which contains a+ list of quantified type variables if an explicit `forall` is present, and+ `Nothing` otherwise. `DataInstD`, `NewTypeInstD`, `TySynEqn` also now use+ a single `Type` argument to represent the left-hand-side to avoid+ malformed type family equations and allow visible kind application.++ Correspondingly, in `Language.Haskell.TH.Lib.Internal`, `pragRuleD`,+ `dataInstD`, `newtypeInstD`, and `tySynEqn` now all have a+ `Maybe [TyVarBndrQ]` argument. Non-API-breaking versions of these+ functions can be found in `Language.Haskell.TH.Lib`. The type signature+ of `tySynEqn` has also changed from `[TypeQ] -> TypeQ -> TySynEqnQ` to+ `(Maybe [TyVarBndrQ]) -> TypeQ -> TypeQ -> TySynEqnQ`, for the same reason+ as in `Language.Haskell.TH.Syntax` above. Consequently, `tySynInstD` also+ changes from `Name -> TySynEqnQ -> DecQ` to `TySynEqnQ -> DecQ`.++ * Add `Lift` instances for `NonEmpty` and `Void`++ * `addForeignFilePath` now support assembler sources (#16180).++## 2.14.0.0 *September 2018+ * Introduce an `addForeignFilePath` function, as well as a corresponding `qAddForeignFile` class method to `Quasi`. Unlike `addForeignFile`, which takes the contents of the file as an argument, `addForeignFilePath` takes@@ -17,6 +39,11 @@ a given suffix. * Add a `ViaStrategy` constructor to `DerivStrategy`.++ * Add support for `-XImplicitParams` via `ImplicitParamT`,+ `ImplicitParamVarE`, and `ImplicitParamBindD`.++ * Add support for `-XRecursiveDo` via `MDoE` and `RecS`. ## 2.13.0.0 *March 2018*
template-haskell.cabal view
@@ -1,11 +1,11 @@ name: template-haskell-version: 2.14.0.0+version: 2.15.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE category: Template Haskell maintainer: libraries@haskell.org-bug-reports: http://ghc.haskell.org/trac/ghc/newticket?component=Template%20Haskell+bug-reports: https://gitlab.haskell.org/ghc/ghc/issues synopsis: Support library for Template Haskell build-type: Simple Cabal-Version: >= 1.10@@ -20,7 +20,7 @@ source-repository head type: git- location: http://git.haskell.org/ghc.git+ location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/template-haskell Library@@ -51,8 +51,8 @@ Language.Haskell.TH.Lib.Map build-depends:- base >= 4.9 && < 4.13,- ghc-boot-th == 8.6.*,+ base >= 4.11 && < 4.14,+ ghc-boot-th == 8.8.*, pretty == 1.1.* ghc-options: -Wall@@ -60,3 +60,8 @@ -- We need to set the unit ID to template-haskell (without a -- version number) as it's magic. ghc-options: -this-unit-id template-haskell++ -- This should match the default-extensions used in 'ghc.cabal'. This way,+ -- GHCi can be used to load it along with the compiler.+ Default-Extensions:+ NoImplicitPrelude