template-haskell 2.11.1.0 → 2.12.0.0
raw patch · 7 files changed
+641/−265 lines, 7 filesdep ~basedep ~ghc-boot-th
Dependency ranges changed: base, ghc-boot-th
Files
- Language/Haskell/TH.hs +7/−80
- Language/Haskell/TH/Lib.hs +182/−14
- Language/Haskell/TH/Ppr.hs +105/−31
- Language/Haskell/TH/PprLib.hs +2/−6
- Language/Haskell/TH/Syntax.hs +311/−122
- changelog.md +31/−9
- template-haskell.cabal +3/−3
Language/Haskell/TH.hs view
@@ -20,10 +20,10 @@ -- *** Reify reify, -- :: Name -> Q Info reifyModule,- thisModule, Info(..), ModuleInfo(..), InstanceDec, ParentName,+ SumAlt, SumArity, Arity, Unlifted, -- *** Language extension lookup@@ -60,6 +60,8 @@ -- ** Built-in names tupleTypeName, tupleDataName, -- Int -> Name unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name+ unboxedSumTypeName, -- :: SumArity -> Name+ unboxedSumDataName, -- :: SumAlt -> SumArity -> Name -- * The algebraic data types -- | The lowercase versions (/syntax operators/) of these constructors are@@ -73,94 +75,19 @@ Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..), FunDep(..), FamFlavour(..), TySynEqn(..), TypeFamilyHead(..), Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence,+ PatSynDir(..), PatSynArgs(..), -- ** Expressions Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..), -- ** Patterns Pat(..), FieldExp, FieldPat, -- ** Types Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),- FamilyResultSig(..), Syntax.InjectivityAnn(..),+ FamilyResultSig(..), Syntax.InjectivityAnn(..), PatSynType, -- * Library functions- -- ** Abbreviations- InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, MatchQ,- ClauseQ, BodyQ, GuardQ, StmtQ, RangeQ, SourceStrictnessQ,- SourceUnpackednessQ, BangTypeQ, VarBangTypeQ, StrictTypeQ,- VarStrictTypeQ, PatQ, FieldPatQ, RuleBndrQ, TySynEqnQ,-- -- ** Constructors lifted to 'Q'- -- *** Literals- intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,- charL, stringL, stringPrimL, charPrimL,- -- *** Patterns- litP, varP, tupP, conP, uInfixP, parensP, infixP,- tildeP, bangP, asP, wildP, recP,- listP, sigP, viewP,- fieldPat,-- -- *** Pattern Guards- normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,-- -- *** Expressions- dyn, varE, conE, litE, appE, uInfixE, parensE, staticE,- infixE, infixApp, sectionL, sectionR,- lamE, lam1E, lamCaseE, tupE, condE, multiIfE, letE, caseE, appsE,- listE, sigE, recConE, recUpdE, stringE, fieldExp,- -- **** Ranges- fromE, fromThenE, fromToE, fromThenToE,-- -- ***** Ranges with more indirection- arithSeqE,- fromR, fromThenR, fromToR, fromThenToR,- -- **** Statements- doE, compE,- bindS, letS, noBindS, parS,-- -- *** Types- forallT, varT, conT, appT, arrowT, infixT, uInfixT, parensT, equalityT,- listT, tupleT, sigT, litT, promotedT, promotedTupleT, promotedNilT,- promotedConsT,- -- **** Type literals- numTyLit, strTyLit,- -- **** Strictness- noSourceUnpackedness, sourceNoUnpack, sourceUnpack,- noSourceStrictness, sourceLazy, sourceStrict,- isStrict, notStrict, unpacked,- bang, bangType, varBangType, strictType, varStrictType,- -- **** Class Contexts- cxt, classP, equalP,- -- **** Constructors- normalC, recC, infixC, forallC, gadtC, recGadtC,-- -- *** Kinds- varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,-- -- *** Roles- nominalR, representationalR, phantomR, inferR,-- -- *** Top Level Declarations- -- **** Data- valD, funD, tySynD, dataD, newtypeD,- -- **** Class- classD, instanceD, instanceWithOverlapD, Overlap(..),- sigD, standaloneDerivD, defaultSigD,-- -- **** Role annotations- roleAnnotD,- -- **** Type Family / Data Family- dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,- familyNoKindD, familyKindD, closedTypeFamilyNoKindD, closedTypeFamilyKindD,- newtypeInstD, tySynInstD,- typeFam, dataFam, tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,- -- **** Foreign Function Interface (FFI)- cCall, stdCall, cApi, prim, javaScript,- unsafe, safe, forImpD,- -- **** Pragmas- ruleVar, typedRuleVar,- pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,- pragLineD,+ module Language.Haskell.TH.Lib, - -- * Pretty-printer+ -- * Pretty-printer Ppr(..), pprint, pprExp, pprLit, pprPat, pprParendType ) where
Language/Haskell/TH/Lib.hs view
@@ -4,11 +4,113 @@ {-# LANGUAGE CPP #-} -module Language.Haskell.TH.Lib where+module Language.Haskell.TH.Lib ( -- All of the exports from this module should -- be "public" functions. The main module TH -- re-exports them all. + -- * Library functions+ -- ** Abbreviations+ InfoQ, ExpQ, TExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ,+ DerivClauseQ, MatchQ, ClauseQ, BodyQ, GuardQ, StmtQ, RangeQ,+ SourceStrictnessQ, SourceUnpackednessQ, BangQ, BangTypeQ, VarBangTypeQ,+ StrictTypeQ, VarStrictTypeQ, FieldExpQ, PatQ, FieldPatQ, RuleBndrQ,+ TySynEqnQ, PatSynDirQ, PatSynArgsQ,++ -- ** Constructors lifted to 'Q'+ -- *** Literals+ intPrimL, wordPrimL, floatPrimL, doublePrimL, integerL, rationalL,+ charL, stringL, stringPrimL, charPrimL,+ -- *** Patterns+ litP, varP, tupP, unboxedTupP, unboxedSumP, conP, uInfixP, parensP,+ infixP, tildeP, bangP, asP, wildP, recP,+ listP, sigP, viewP,+ fieldPat,++ -- *** Pattern Guards+ normalB, guardedB, normalG, normalGE, patG, patGE, match, clause,++ -- *** Expressions+ dyn, varE, unboundVarE, conE, litE, appE, appTypeE, uInfixE, parensE,+ staticE, infixE, infixApp, sectionL, sectionR,+ lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE,+ letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,+ -- **** Ranges+ fromE, fromThenE, fromToE, fromThenToE,++ -- ***** Ranges with more indirection+ arithSeqE,+ fromR, fromThenR, fromToR, fromThenToR,+ -- **** Statements+ doE, compE,+ bindS, letS, noBindS, parS,++ -- *** Types+ forallT, varT, conT, appT, arrowT, infixT, uInfixT, parensT, equalityT,+ listT, tupleT, unboxedTupleT, unboxedSumT, sigT, litT, wildCardT,+ promotedT, promotedTupleT, promotedNilT, promotedConsT,+ -- **** Type literals+ numTyLit, strTyLit,+ -- **** Strictness+ noSourceUnpackedness, sourceNoUnpack, sourceUnpack,+ noSourceStrictness, sourceLazy, sourceStrict,+ isStrict, notStrict, unpacked,+ bang, bangType, varBangType, strictType, varStrictType,+ -- **** Class Contexts+ cxt, classP, equalP,+ -- **** Constructors+ normalC, recC, infixC, forallC, gadtC, recGadtC,++ -- *** Kinds+ varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,++ -- *** Type variable binders+ plainTV, kindedTV,++ -- *** Roles+ nominalR, representationalR, phantomR, inferR,++ -- *** Top Level Declarations+ -- **** Data+ valD, funD, tySynD, dataD, newtypeD,+ derivClause, DerivClause(..), DerivStrategy(..),+ -- **** Class+ classD, instanceD, instanceWithOverlapD, Overlap(..),+ sigD, standaloneDerivD, standaloneDerivWithStrategyD, defaultSigD,++ -- **** Role annotations+ roleAnnotD,+ -- **** Type Family / Data Family+ dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,+ familyNoKindD, familyKindD, closedTypeFamilyNoKindD, closedTypeFamilyKindD,+ newtypeInstD, tySynInstD,+ typeFam, dataFam, tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig,++ -- **** Fixity+ infixLD, infixRD, infixND,++ -- **** Foreign Function Interface (FFI)+ cCall, stdCall, cApi, prim, javaScript,+ unsafe, safe, interruptible, forImpD,++ -- **** Functional dependencies+ funDep,++ -- **** Pragmas+ ruleVar, typedRuleVar,+ valueAnnotation, typeAnnotation, moduleAnnotation,+ pragInlD, pragSpecD, pragSpecInlD, pragSpecInstD, pragRuleD, pragAnnD,+ pragLineD, pragCompleteD,++ -- **** Pattern Synonyms+ patSynD, patSynSigD, unidir, implBidir, explBidir, prefixPatSyn,+ infixPatSyn, recordPatSyn,++ -- ** Reify+ thisModule++ ) where+ import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn) import qualified Language.Haskell.TH.Syntax as TH import Control.Monad( liftM, liftM2 )@@ -30,6 +132,7 @@ type TyLitQ = Q TyLit type CxtQ = Q Cxt type PredQ = Q Pred+type DerivClauseQ = Q DerivClause type MatchQ = Q Match type ClauseQ = Q Clause type BodyQ = Q Body@@ -46,6 +149,8 @@ type FieldExpQ = Q FieldExp type RuleBndrQ = Q RuleBndr type TySynEqnQ = Q TySynEqn+type PatSynDirQ = Q PatSynDir+type PatSynArgsQ = Q PatSynArgs -- must be defined here for DsMeta to find it type Role = TH.Role@@ -78,12 +183,19 @@ litP :: Lit -> PatQ litP l = return (LitP l)+ varP :: Name -> PatQ varP v = return (VarP v)+ tupP :: [PatQ] -> PatQ tupP ps = do { ps1 <- sequence ps; return (TupP ps1)}+ unboxedTupP :: [PatQ] -> PatQ unboxedTupP ps = do { ps1 <- sequence ps; return (UnboxedTupP ps1)}++unboxedSumP :: PatQ -> SumAlt -> SumArity -> PatQ+unboxedSumP p alt arity = do { p1 <- p; return (UnboxedSumP p1 alt arity) }+ conP :: Name -> [PatQ] -> PatQ conP n ps = do ps' <- sequence ps return (ConP n ps')@@ -223,6 +335,9 @@ appE :: ExpQ -> ExpQ -> ExpQ appE x y = do { a <- x; b <- y; return (AppE a b)} +appTypeE :: ExpQ -> TypeQ -> ExpQ+appTypeE x t = do { a <- x; s <- t; return (AppTypeE a s) }+ parensE :: ExpQ -> ExpQ parensE x = do { x' <- x; return (ParensE x') } @@ -264,6 +379,9 @@ unboxedTupE :: [ExpQ] -> ExpQ unboxedTupE es = do { es1 <- sequence es; return (UnboxedTupE es1)} +unboxedSumE :: ExpQ -> SumAlt -> SumArity -> ExpQ+unboxedSumE e alt arity = do { e1 <- e; return (UnboxedSumE e1 alt arity) }+ condE :: ExpQ -> ExpQ -> ExpQ -> ExpQ condE x y z = do { a <- x; b <- y; c <- z; return (CondE a b c)} @@ -345,20 +463,22 @@ tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) } -dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> CxtQ -> DecQ+dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]+ -> DecQ dataD ctxt tc tvs ksig cons derivs = do ctxt1 <- ctxt cons1 <- sequence cons- derivs1 <- derivs+ derivs1 <- sequence derivs return (DataD ctxt1 tc tvs ksig cons1 derivs1) -newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> CxtQ -> DecQ+newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> [DerivClauseQ]+ -> DecQ newtypeD ctxt tc tvs ksig con derivs = do ctxt1 <- ctxt con1 <- con- derivs1 <- derivs+ derivs1 <- sequence derivs return (NewtypeD ctxt1 tc tvs ksig con1 derivs1) classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ@@ -437,22 +557,27 @@ pragLineD :: Int -> String -> DecQ pragLineD line file = return $ PragmaD $ LineP line file -dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> CxtQ -> DecQ+pragCompleteD :: [Name] -> Maybe Name -> DecQ+pragCompleteD cls mty = return $ PragmaD $ CompleteP cls mty++dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> [DerivClauseQ]+ -> DecQ dataInstD ctxt tc tys ksig cons derivs = do ctxt1 <- ctxt tys1 <- sequence tys cons1 <- sequence cons- derivs1 <- derivs+ derivs1 <- sequence derivs return (DataInstD ctxt1 tc tys1 ksig cons1 derivs1) -newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> CxtQ -> DecQ+newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> [DerivClauseQ]+ -> DecQ newtypeInstD ctxt tc tys ksig con derivs = do ctxt1 <- ctxt tys1 <- sequence tys con1 <- con- derivs1 <- derivs+ derivs1 <- sequence derivs return (NewtypeInstD ctxt1 tc tys1 ksig con1 derivs1) tySynInstD :: Name -> TySynEqnQ -> DecQ@@ -483,7 +608,7 @@ -- 3. remove the FamFlavour data type from Syntax module -- 4. make sure that all references to FamFlavour are gone from DsMeta, -- Convert, TcSplice (follows from 3)-#if __GLASGOW_HASKELL__ > 800+#if __GLASGOW_HASKELL__ >= 804 #error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD #endif @@ -519,11 +644,14 @@ roleAnnotD name roles = return $ RoleAnnotD name roles standaloneDerivD :: CxtQ -> TypeQ -> DecQ-standaloneDerivD ctxtq tyq =+standaloneDerivD = standaloneDerivWithStrategyD Nothing++standaloneDerivWithStrategyD :: Maybe DerivStrategy -> CxtQ -> TypeQ -> DecQ+standaloneDerivWithStrategyD ds ctxtq tyq = do ctxt <- ctxtq ty <- tyq- return $ StandaloneDerivD ctxt ty+ return $ StandaloneDerivD ds ctxt ty defaultSigD :: Name -> TypeQ -> DecQ defaultSigD n tyq =@@ -531,6 +659,20 @@ ty <- tyq return $ DefaultSigD n ty +-- | Pattern synonym declaration+patSynD :: Name -> PatSynArgsQ -> PatSynDirQ -> PatQ -> DecQ+patSynD name args dir pat = do+ args' <- args+ dir' <- dir+ pat' <- pat+ return (PatSynD name args' dir' pat')++-- | Pattern synonym type signature+patSynSigD :: Name -> TypeQ -> DecQ+patSynSigD nm ty =+ do ty' <- ty+ return $ PatSynSigD nm ty'+ tySynEqn :: [TypeQ] -> TypeQ -> TySynEqnQ tySynEqn lhs rhs = do@@ -541,6 +683,10 @@ cxt :: [PredQ] -> CxtQ cxt = sequence +derivClause :: Maybe DerivStrategy -> [PredQ] -> DerivClauseQ+derivClause ds p = do p' <- cxt p+ return $ DerivClause ds p'+ normalC :: Name -> [BangTypeQ] -> ConQ normalC con strtys = liftM (NormalC con) $ sequence strtys @@ -611,6 +757,9 @@ unboxedTupleT :: Int -> TypeQ unboxedTupleT i = return (UnboxedTupleT i) +unboxedSumT :: SumArity -> TypeQ+unboxedSumT arity = return (UnboxedSumT arity)+ sigT :: TypeQ -> Kind -> TypeQ sigT t k = do@@ -706,8 +855,6 @@ strTyLit :: String -> TyLitQ strTyLit s = return (StrTyLit s) -- ------------------------------------------------------------------------------- -- * Kind @@ -817,6 +964,27 @@ moduleAnnotation :: AnnTarget moduleAnnotation = ModuleAnnotation++-------------------------------------------------------------------------------+-- * Pattern Synonyms (sub constructs)++unidir, implBidir :: PatSynDirQ+unidir = return Unidir+implBidir = return ImplBidir++explBidir :: [ClauseQ] -> PatSynDirQ+explBidir cls = do+ cls' <- sequence cls+ return (ExplBidir cls')++prefixPatSyn :: [Name] -> PatSynArgsQ+prefixPatSyn args = return $ PrefixPatSyn args++recordPatSyn :: [Name] -> PatSynArgsQ+recordPatSyn sels = return $ RecordPatSyn sels++infixPatSyn :: Name -> Name -> PatSynArgsQ+infixPatSyn arg1 arg2 = return $ InfixPatSyn arg1 arg2 -------------------------------------------------------------- -- * Useful helper function
Language/Haskell/TH/Ppr.hs view
@@ -10,8 +10,9 @@ import Language.Haskell.TH.PprLib import Language.Haskell.TH.Syntax import Data.Word ( Word8 )-import Data.Char ( toLower, chr, ord, isSymbol )+import Data.Char ( toLower, chr) import GHC.Show ( showMultiLineString )+import GHC.Lexeme( startsVarSym ) import Data.Ratio ( numerator, denominator ) nestDepth :: Int@@ -19,10 +20,10 @@ type Precedence = Int appPrec, unopPrec, opPrec, noPrec :: Precedence-appPrec = 3 -- Argument of a function application-opPrec = 2 -- Argument of an infix operator-unopPrec = 1 -- Argument of an unresolved infix operator-noPrec = 0 -- Others+appPrec = 3 -- Argument of a function application+opPrec = 2 -- Argument of an infix operator+unopPrec = 1 -- Argument of an unresolved infix operator+noPrec = 0 -- Others parensIf :: Bool -> Doc -> Doc parensIf True d = parens d@@ -59,6 +60,7 @@ = text "Class op from" <+> ppr cls <> colon <+> ppr_sig v ty ppr (DataConI v ty tc) = text "Constructor from" <+> ppr tc <> colon <+> ppr_sig v ty+ ppr (PatSynI nm ty) = pprPatSynSig nm ty ppr (TyVarI v ty) = text "Type variable" <+> ppr v <+> equals <+> ppr ty ppr (VarI v ty mb_d)@@ -75,7 +77,25 @@ ppr_fix InfixL = text "infixl" ppr_fix InfixN = text "infix" +-- | Pretty prints a pattern synonym type signature+pprPatSynSig :: Name -> PatSynType -> Doc+pprPatSynSig nm ty+ = text "pattern" <+> pprPrefixOcc nm <+> dcolon <+> pprPatSynType ty +-- | Pretty prints a pattern synonym's type; follows the usual+-- conventions to print a pattern synonym type compactly, yet+-- unambiguously. See the note on 'PatSynType' and the section on+-- pattern synonyms in the GHC user's guide for more information.+pprPatSynType :: PatSynType -> Doc+pprPatSynType ty@(ForallT uniTys reqs ty'@(ForallT exTys provs ty''))+ | null exTys, null provs = ppr (ForallT uniTys reqs ty'')+ | null uniTys, null reqs = noreqs <+> ppr ty'+ | null reqs = forall uniTys <+> noreqs <+> ppr ty'+ | otherwise = ppr ty+ where noreqs = text "() =>"+ forall tvs = text "forall" <+> (hsep (map ppr tvs)) <+> text "."+pprPatSynType ty = ppr ty+ ------------------------------ instance Ppr Module where ppr (Module pkg m) = text (pkgString pkg) <+> text (modString m)@@ -95,12 +115,9 @@ isSymOcc n = case nameBase n of [] -> True -- Empty name; weird- (c:_) -> isSymbolASCII c || (ord c > 0x7f && isSymbol c)+ (c:_) -> startsVarSym c -- c.f. OccName.startsVarSym in GHC itself -isSymbolASCII :: Char -> Bool-isSymbolASCII c = c `elem` "!#$%&*+./<=>?@\\^|~-"- pprInfixExp :: Exp -> Doc pprInfixExp (VarE v) = pprName' Infix v pprInfixExp (ConE v) = pprName' Infix v@@ -112,6 +129,8 @@ pprExp i (LitE l) = pprLit i l pprExp i (AppE e1 e2) = parensIf (i >= appPrec) $ pprExp opPrec e1 <+> pprExp appPrec e2+pprExp i (AppTypeE e t)+ = parensIf (i >= appPrec) $ pprExp opPrec e <+> char '@' <> pprParendType t pprExp _ (ParensE e) = parens (pprExp noPrec e) pprExp i (UInfixE e1 op e2) = parensIf (i > unopPrec) $ pprExp unopPrec e1@@ -130,6 +149,7 @@ $ text "\\case" $$ nest nestDepth (ppr ms) pprExp _ (TupE es) = parens (commaSep es) pprExp _ (UnboxedTupE es) = hashParens (commaSep es)+pprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity -- Nesting in Cond is to avoid potential problems in do statments pprExp i (CondE guard true false) = parensIf (i > noPrec) $ sep [text "if" <+> ppr guard,@@ -165,7 +185,7 @@ -- one, we simply treat it like a normal list. then text "[" <> ppr s <> text "]" else text "[" <> ppr s- <+> text "|"+ <+> bar <+> commaSep ss' <> text "]" where s = last ss@@ -191,7 +211,7 @@ ppr (BindS p e) = ppr p <+> text "<-" <+> ppr e ppr (LetS ds) = text "let" <+> (braces (semiSep ds)) ppr (NoBindS e) = ppr e- ppr (ParS sss) = sep $ punctuate (text "|")+ ppr (ParS sss) = sep $ punctuate bar $ map commaSep sss ------------------------------@@ -202,8 +222,8 @@ ------------------------------ pprGuarded :: Doc -> (Guard, Exp) -> Doc pprGuarded eqDoc (guard, expr) = case guard of- NormalG guardExpr -> char '|' <+> ppr guardExpr <+> eqDoc <+> ppr expr- PatG stmts -> char '|' <+> vcat (punctuate comma $ map ppr stmts) $$+ NormalG guardExpr -> bar <+> ppr guardExpr <+> eqDoc <+> ppr expr+ PatG stmts -> bar <+> vcat (punctuate comma $ map ppr stmts) $$ nest nestDepth (eqDoc <+> ppr expr) ------------------------------@@ -252,6 +272,7 @@ pprPat _ (VarP v) = pprName' Applied v pprPat _ (TupP ps) = parens (commaSep ps) pprPat _ (UnboxedTupP ps) = hashParens (commaSep ps)+pprPat _ (UnboxedSumP p alt arity) = unboxedSumBars (ppr p) alt arity pprPat i (ConP s ps) = parensIf (i >= appPrec) $ pprName' Applied s <+> sep (map (pprPat appPrec) ps) pprPat _ (ParensP p) = parens $ pprPat noPrec p@@ -335,16 +356,33 @@ where ppr_eqn (TySynEqn lhs rhs) = ppr tc <+> sep (map pprParendType lhs) <+> text "=" <+> ppr rhs- ppr_dec _ (RoleAnnotD name roles) = hsep [ text "type role", ppr name ] <+> hsep (map ppr roles)--ppr_dec _ (StandaloneDerivD cxt ty)- = hsep [ text "deriving instance", pprCxt cxt, ppr ty ]-+ppr_dec _ (StandaloneDerivD ds cxt ty)+ = hsep [ text "deriving"+ , maybe empty ppr_deriv_strategy ds+ , text "instance"+ , pprCxt cxt+ , ppr ty ] ppr_dec _ (DefaultSigD n ty) = hsep [ text "default", pprPrefixOcc n, dcolon, ppr ty ]+ppr_dec _ (PatSynD name args dir pat)+ = text "pattern" <+> pprNameArgs <+> ppr dir <+> pprPatRHS+ where+ pprNameArgs | InfixPatSyn a1 a2 <- args = ppr a1 <+> ppr name <+> ppr a2+ | otherwise = ppr name <+> ppr args+ pprPatRHS | ExplBidir cls <- dir = hang (ppr pat <+> text "where")+ nestDepth (ppr name <+> ppr cls)+ | otherwise = ppr pat+ppr_dec _ (PatSynSigD name ty)+ = pprPatSynSig name ty +ppr_deriv_strategy :: DerivStrategy -> Doc+ppr_deriv_strategy ds = text $+ case ds of+ StockStrategy -> "stock"+ AnyclassStrategy -> "anyclass"+ NewtypeStrategy -> "newtype" ppr_overlap :: Overlap -> Doc ppr_overlap o = text $@@ -354,7 +392,8 @@ Overlapping -> "{-# OVERLAPPING #-}" Incoherent -> "{-# INCOHERENT #-}" -ppr_data :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> [Con] -> Cxt -> Doc+ppr_data :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]+ -> Doc ppr_data maybeInst ctxt t argsDoc ksig cs decs = sep [text "data" <+> maybeInst <+> pprCxt ctxt@@ -363,12 +402,12 @@ if null decs then empty else nest nestDepth- $ text "deriving" <+> ppr_cxt_preds decs]+ $ vcat $ map ppr_deriv_clause decs] where pref :: [Doc] -> [Doc] pref xs | isGadtDecl = xs pref [] = [] -- No constructors; can't happen in H98- pref (d:ds) = (char '=' <+> d):map (char '|' <+>) ds+ pref (d:ds) = (char '=' <+> d):map (bar <+>) ds maybeWhere :: Doc maybeWhere | isGadtDecl = text "where"@@ -385,7 +424,8 @@ Nothing -> empty Just k -> dcolon <+> ppr k -ppr_newtype :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> Con -> Cxt -> Doc+ppr_newtype :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> Con -> [DerivClause]+ -> Doc ppr_newtype maybeInst ctxt t argsDoc ksig c decs = sep [text "newtype" <+> maybeInst <+> pprCxt ctxt@@ -394,12 +434,17 @@ if null decs then empty else nest nestDepth- $ text "deriving" <+> ppr_cxt_preds decs]+ $ vcat $ map ppr_deriv_clause decs] where ksigDoc = case ksig of Nothing -> empty Just k -> dcolon <+> ppr k +ppr_deriv_clause :: DerivClause -> Doc+ppr_deriv_clause (DerivClause ds ctxt)+ = text "deriving" <+> maybe empty ppr_deriv_strategy ds+ <+> ppr_cxt_preds ctxt+ ppr_tySyn :: Doc -> Name -> Doc -> Type -> Doc ppr_tySyn maybeInst t argsDoc rhs = text "type" <+> maybeInst <+> ppr t <+> argsDoc <+> text "=" <+> ppr rhs@@ -415,7 +460,7 @@ instance Ppr FunDep where ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys) ppr_list [] = empty- ppr_list xs = char '|' <+> commaSep xs+ ppr_list xs = bar <+> commaSep xs ------------------------------ instance Ppr FamFlavour where@@ -431,7 +476,7 @@ ------------------------------ instance Ppr InjectivityAnn where ppr (InjectivityAnn lhs rhs) =- char '|' <+> ppr lhs <+> text "->" <+> hsep (map ppr rhs)+ bar <+> ppr lhs <+> text "->" <+> hsep (map ppr rhs) ------------------------------ instance Ppr Foreign where@@ -482,6 +527,9 @@ target1 (ValueAnnotation v) = ppr v ppr (LineP line file) = text "{-# LINE" <+> int line <+> text (show file) <+> text "#-}"+ ppr (CompleteP cls mty)+ = text "{-# COMPLETE" <+> (fsep $ punctuate comma $ map ppr cls)+ <+> maybe empty (\ty -> dcolon <+> ppr ty) mty ------------------------------ instance Ppr Inline where@@ -538,13 +586,28 @@ ppr (RecGadtC c vsts ty) = commaSepApplied c <+> dcolon <+> pprRecFields vsts ty +instance Ppr PatSynDir where+ ppr Unidir = text "<-"+ ppr ImplBidir = text "="+ ppr (ExplBidir _) = text "<-"+ -- the ExplBidir's clauses are pretty printed together with the+ -- entire pattern synonym; so only print the direction here.++instance Ppr PatSynArgs where+ ppr (PrefixPatSyn args) = sep $ map ppr args+ ppr (InfixPatSyn a1 a2) = ppr a1 <+> ppr a2+ ppr (RecordPatSyn sels) = braces $ sep (punctuate comma (map ppr sels))+ commaSepApplied :: [Name] -> Doc commaSepApplied = commaSepWith (pprName' Applied) pprForall :: [TyVarBndr] -> Cxt -> Doc-pprForall ns ctxt- = text "forall" <+> hsep (map ppr ns)- <+> char '.' <+> pprCxt ctxt+pprForall tvs cxt+ -- even in the case without any tvs, there could be a non-empty+ -- context cxt (e.g., in the case of pattern synonyms, where there+ -- are multiple forall binders and contexts).+ | [] <- tvs = pprCxt cxt+ | otherwise = text "forall" <+> hsep (map ppr tvs) <+> char '.' <+> pprCxt cxt pprRecFields :: [(Name, Strict, Type)] -> Type -> Doc pprRecFields vsts ty@@ -619,6 +682,7 @@ pprParendType (TupleT 0) = text "()" pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma)) pprParendType (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma+pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar pprParendType ArrowT = parens (text "->") pprParendType ListT = text "[]" pprParendType (LitT l) = pprTyLit l@@ -644,9 +708,7 @@ pprUInfixT t = ppr t instance Ppr Type where- ppr (ForallT tvars ctxt ty)- = text "forall" <+> hsep (map ppr tvars) <+> text "."- <+> sep [pprCxt ctxt, ppr ty]+ ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty] ppr ty = pprTyApp (split ty) -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind) -- See Note [Pretty-printing kind signatures]@@ -761,3 +823,15 @@ -- followed by space. semiSep :: Ppr a => [a] -> Doc semiSep = sep . punctuate semi . map ppr++-- Prints out the series of vertical bars that wraps an expression or pattern+-- used in an unboxed sum.+unboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc+unboxedSumBars d alt arity = hashParens $+ bars (alt-1) <> d <> bars (arity - alt)+ where+ bars i = hsep (replicate i bar)++-- Text containing the vertical bar character.+bar :: Doc+bar = char '|'
Language/Haskell/TH/PprLib.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, FlexibleInstances #-}+{-# LANGUAGE FlexibleInstances #-} -- | Monadic front-end to Text.PrettyPrint @@ -41,9 +41,6 @@ import Control.Monad (liftM, liftM2, ap) import Language.Haskell.TH.Lib.Map ( Map ) import qualified Language.Haskell.TH.Lib.Map as Map ( lookup, insert, empty )-#if __GLASGOW_HASKELL__ < 709-import Control.Applicative( Applicative(..) )-#endif infixl 6 <> infixl 6 <+>@@ -140,7 +137,7 @@ show (Name occ (NameU u)) = occString occ ++ "_" ++ show (I# u) show (Name occ NameS) = occString occ show (Name occ (NameG ns m)) = modString m ++ "." ++ occString occ- + data Name = Name OccName NameFlavour data NameFlavour@@ -158,7 +155,6 @@ (<*>) = ap instance Monad PprM where- return = pure m >>= k = PprM $ \s -> let (x, s') = runPprM m s in runPprM (k x) s'
Language/Haskell/TH/Syntax.hs view
@@ -1,13 +1,10 @@ {-# LANGUAGE CPP, DeriveDataTypeable, DeriveGeneric, FlexibleInstances, DefaultSignatures,- RankNTypes, RoleAnnotations, ScopedTypeVariables #-}+ RankNTypes, RoleAnnotations, ScopedTypeVariables,+ Trustworthy #-} {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-} -#if MIN_VERSION_base(4,8,0)-#define HAS_NATURAL-#endif- #if MIN_VERSION_base(4,9,0) # define HAS_MONADFAIL 1 #endif@@ -30,12 +27,10 @@ ( module Language.Haskell.TH.Syntax -- * Language extensions , module Language.Haskell.TH.LanguageExtensions+ , ForeignSrcLang(..) ) where import Data.Data hiding (Fixity(..))-#if __GLASGOW_HASKELL__ < 709-import Control.Applicative( Applicative(..) )-#endif import Data.IORef import System.IO.Unsafe ( unsafePerformIO ) import Control.Monad (liftM)@@ -46,11 +41,9 @@ import Data.Ratio import GHC.Generics ( Generic ) import GHC.Lexeme ( startsVarSym, startsVarId )+import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions--#ifdef HAS_NATURAL import Numeric.Natural-#endif #if HAS_MONADFAIL import qualified Control.Monad.Fail as Fail@@ -65,7 +58,7 @@ #if HAS_MONADFAIL class Fail.MonadFail m => Quasi m where #else-class (Applicative m, Monad m) => Quasi m where+class Monad m => Quasi m where #endif qNewName :: String -> m Name -- ^ Fresh names@@ -101,6 +94,8 @@ qAddTopDecls :: [Dec] -> m () + qAddForeignFile :: ForeignSrcLang -> String -> m ()+ qAddModFinalizer :: Q () -> m () qGetQ :: Typeable a => m (Maybe a)@@ -122,9 +117,8 @@ ----------------------------------------------------- instance Quasi IO where- qNewName s = do { n <- readIORef counter- ; writeIORef counter (n+1)- ; return (mkNameU s n) }+ qNewName s = do { n <- atomicModifyIORef' counter (\x -> (x + 1, x))+ ; pure (mkNameU s n) } qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg)@@ -141,6 +135,7 @@ qRecover _ _ = badIO "recover" -- Maybe we could fix this? qAddDependentFile _ = badIO "addDependentFile" qAddTopDecls _ = badIO "addTopDecls"+ qAddForeignFile _ _ = badIO "addForeignFile" qAddModFinalizer _ = badIO "addModFinalizer" qGetQ = badIO "getQ" qPutQ _ = badIO "putQ"@@ -184,9 +179,6 @@ instance Monad Q where Q m >>= k = Q (m >>= \x -> unQ (k x)) (>>) = (*>)-- return = pure- #if !HAS_MONADFAIL fail s = report True s >> Q (fail "Q monad failure") #else@@ -469,6 +461,26 @@ addTopDecls :: [Dec] -> Q () addTopDecls ds = Q (qAddTopDecls ds) +-- | Emit a foreign file which will be compiled and linked to the object for+-- the current module. Currently only languages that can be compiled with+-- the C compiler are supported, and the flags passed as part of -optc will+-- be also applied to the C compiler invocation that will compile them.+--+-- 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+-- emitting C files, e.g.+--+-- > {-# LANGUAGE CPP #-}+-- > ...+-- > addForeignFile LangC $ unlines+-- > [ "#line " ++ show (__LINE__ + 1) ++ " " ++ show __FILE__+-- > , ...+-- > ]+addForeignFile :: ForeignSrcLang -> String -> Q ()+addForeignFile lang str = Q (qAddForeignFile lang str)+ -- | Add a finalizer that will run in the Q monad after the current module has -- been type checked. This only makes sense when run within a top-level splice. --@@ -512,6 +524,7 @@ qRunIO = runIO qAddDependentFile = addDependentFile qAddTopDecls = addTopDecls+ qAddForeignFile = addForeignFile qAddModFinalizer = addModFinalizer qGetQ = getQ qPutQ = putQ@@ -601,10 +614,8 @@ instance Lift Word64 where lift x = return (LitE (IntegerL (fromIntegral x))) -#ifdef HAS_NATURAL instance Lift Natural where lift x = return (LitE (IntegerL (fromIntegral x)))-#endif instance Integral a => Lift (Ratio a) where lift x = return (LitE (RationalL (toRational x)))@@ -731,15 +742,12 @@ (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Tuple"))- -- It is possible for a Data instance to be defined such- -- that toConstr uses a Constr defined using a function,- -- not a data constructor. In such a case, we must take- -- care to build the Name using mkNameG_v (for values),- -- not mkNameG_d (for data constructors).- -- See Trac #10796.++ -- Tricky case: see Note [Data for non-algebraic types] fun@(x:_) | startsVarSym x || startsVarId x -> mkNameG_v tyconPkg tyconMod fun con -> mkNameG_d tyconPkg tyconMod con+ where tycon :: TyCon tycon = (typeRepTyCon . typeOf) t@@ -762,6 +770,34 @@ Just y -> y ++{- Note [Data for non-algebraic types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Class Data was originally intended for algebraic data types. But+it is possible to use it for abstract types too. For example, in+package `text` we find++ instance Data Text where+ ...+ toConstr _ = packConstr++ packConstr :: Constr+ packConstr = mkConstr textDataType "pack" [] Prefix++Here `packConstr` isn't a real data constructor, it's an ordinary+function. Two complications++* In such a case, we must take care to build the Name using+ mkNameG_v (for values), not mkNameG_d (for data constructors).+ See Trac #10796.++* The pseudo-constructor is named only by its string, here "pack".+ But 'dataToQa' needs the TyCon of its defining module, and has+ to assume it's defined in the same module as the TyCon itself.+ But nothing enforces that; Trac #12596 shows what goes wrong if+ "pack" is defined in a different module than the data type "Text".+ -}+ -- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the -- same value, in the SYB style. It is generalized to take a function -- override type-specific cases; see 'liftData' for a more commonly@@ -811,17 +847,17 @@ ----------------------------------------------------- newtype ModName = ModName String -- Module name- deriving (Show,Eq,Ord,Typeable,Data,Generic)+ deriving (Show,Eq,Ord,Data,Generic) newtype PkgName = PkgName String -- package name- deriving (Show,Eq,Ord,Typeable,Data,Generic)+ deriving (Show,Eq,Ord,Data,Generic) -- | Obtained from 'reifyModule' and 'thisModule'. data Module = Module PkgName ModName -- package qualified module name- deriving (Show,Eq,Ord,Typeable,Data,Generic)+ deriving (Show,Eq,Ord,Data,Generic) newtype OccName = OccName String- deriving (Show,Eq,Ord,Typeable,Data,Generic)+ deriving (Show,Eq,Ord,Data,Generic) mkModName :: String -> ModName mkModName s = ModName s@@ -932,7 +968,7 @@ (such as @let x = ...@ or @\x -> ...@), but names constructed using @lookupValueName@, @lookupTypeName@, @'f@, @''T@ may not. -}-data Name = Name OccName NameFlavour deriving (Typeable, Data, Eq, Generic)+data Name = Name OccName NameFlavour deriving (Data, Eq, Generic) instance Ord Name where -- check if unique is different before looking at strings@@ -948,13 +984,13 @@ -- An original name (occurrences only, not binders) -- Need the namespace too to be sure which -- thing we are naming- deriving ( Typeable, Data, Eq, Ord, Show, Generic )+ deriving ( Data, Eq, Ord, Show, Generic ) data NameSpace = VarName -- ^ Variables | DataName -- ^ Data constructors | TcClsName -- ^ Type constructors and classes; Haskell has them -- in the same name space for now.- deriving( Eq, Ord, Show, Data, Typeable, Generic )+ deriving( Eq, Ord, Show, Data, Generic ) type Uniq = Int @@ -1178,23 +1214,61 @@ -- | Unboxed tuple type constructor unboxedTupleTypeName :: Int -> Name -unboxedTupleDataName 0 = error "unboxedTupleDataName 0"-unboxedTupleDataName 1 = error "unboxedTupleDataName 1"-unboxedTupleDataName n = mk_unboxed_tup_name (n-1) DataName--unboxedTupleTypeName 0 = error "unboxedTupleTypeName 0"-unboxedTupleTypeName 1 = error "unboxedTupleTypeName 1"-unboxedTupleTypeName n = mk_unboxed_tup_name (n-1) TcClsName+unboxedTupleDataName n = mk_unboxed_tup_name n DataName+unboxedTupleTypeName n = mk_unboxed_tup_name n TcClsName mk_unboxed_tup_name :: Int -> NameSpace -> Name-mk_unboxed_tup_name n_commas space- = Name occ (NameG space (mkPkgName "ghc-prim") tup_mod)+mk_unboxed_tup_name n space+ = Name (mkOccName tup_occ) (NameG space (mkPkgName "ghc-prim") tup_mod) where- occ = mkOccName ("(#" ++ replicate n_commas ',' ++ "#)")- tup_mod = mkModName "GHC.Tuple"+ tup_occ | n == 1 = "Unit#" -- See Note [One-tuples] in TysWiredIn+ | otherwise = "(#" ++ replicate n_commas ',' ++ "#)"+ n_commas = n - 1+ tup_mod = mkModName "GHC.Tuple" +-- Unboxed sum data and type constructors+-- | Unboxed sum data constructor+unboxedSumDataName :: SumAlt -> SumArity -> Name+-- | Unboxed sum type constructor+unboxedSumTypeName :: SumArity -> Name +unboxedSumDataName alt arity+ | alt > arity+ = error $ prefix ++ "Index out of bounds." ++ debug_info + | alt <= 0+ = error $ prefix ++ "Alt must be > 0." ++ debug_info++ | arity < 2+ = error $ prefix ++ "Arity must be >= 2." ++ debug_info++ | otherwise+ = Name (mkOccName sum_occ)+ (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Prim"))++ where+ prefix = "unboxedSumDataName: "+ debug_info = " (alt: " ++ show alt ++ ", arity: " ++ show arity ++ ")"++ -- Synced with the definition of mkSumDataConOcc in TysWiredIn+ sum_occ = '(' : '#' : bars nbars_before ++ '_' : bars nbars_after ++ "#)"+ bars i = replicate i '|'+ nbars_before = alt - 1+ nbars_after = arity - alt++unboxedSumTypeName arity+ | arity < 2+ = error $ "unboxedSumTypeName: Arity must be >= 2."+ ++ " (arity: " ++ show arity ++ ")"++ | otherwise+ = Name (mkOccName sum_occ)+ (NameG TcClsName (mkPkgName "ghc-prim") (mkModName "GHC.Prim"))++ where+ -- Synced with the definition of mkSumTyConOcc in TysWiredIn+ sum_occ = '(' : '#' : replicate (arity - 1) '|' ++ "#)"+ ----------------------------------------------------- -- Locations -----------------------------------------------------@@ -1205,7 +1279,7 @@ , loc_module :: String , loc_start :: CharPos , loc_end :: CharPos }- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) type CharPos = (Int, Int) -- ^ Line and character position @@ -1252,6 +1326,11 @@ Type ParentName + -- | A pattern synonym.+ | PatSynI+ Name+ PatSynType+ {- | A \"value\" variable (as opposed to a type variable, see 'TyVarI'). @@ -1277,19 +1356,32 @@ | TyVarI -- Scoped type variable Name Type -- What it is bound to- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) -- | Obtained from 'reifyModule' in the 'Q' Monad. data ModuleInfo = -- | Contains the import list of the module. ModuleInfo [Module]- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) {- | In 'ClassOpI' and 'DataConI', name of the parent class or type -} type ParentName = Name +-- | In 'UnboxedSumE' and 'UnboxedSumP', the number associated with a+-- particular data constructor. 'SumAlt's are one-indexed and should never+-- exceed the value of its corresponding 'SumArity'. For example:+--+-- * @(\#_|\#)@ has 'SumAlt' 1 (out of a total 'SumArity' of 2)+--+-- * @(\#|_\#)@ has 'SumAlt' 2 (out of a total 'SumArity' of 2)+type SumAlt = Int++-- | In 'UnboxedSumE', 'UnboxedSumT', and 'UnboxedSumP', the total number of+-- 'SumAlt's. For example, @(\#|\#)@ has a 'SumArity' of 2.+type SumArity = Int+ -- | In 'PrimTyConI', arity of the type constructor type Arity = Int @@ -1307,9 +1399,9 @@ type InstanceDec = Dec data Fixity = Fixity Int FixityDirection- deriving( Eq, Ord, Show, Data, Typeable, Generic )+ deriving( Eq, Ord, Show, Data, Generic ) data FixityDirection = InfixL | InfixR | InfixN- deriving( Eq, Ord, Show, Data, Typeable, Generic )+ deriving( Eq, Ord, Show, Data, Generic ) -- | Highest allowed operator precedence for 'Fixity' constructor (answer: 9) maxPrecedence :: Int@@ -1402,7 +1494,7 @@ | DoublePrimL Rational | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr# | CharPrimL Char- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) -- We could add Int, Float, Double etc, as we do in HsLit, -- but that could complicate the@@ -1410,41 +1502,43 @@ -- | Pattern in Haskell given in @{}@ data Pat- = LitP Lit -- ^ @{ 5 or \'c\' }@- | VarP Name -- ^ @{ x }@- | TupP [Pat] -- ^ @{ (p1,p2) }@- | UnboxedTupP [Pat] -- ^ @{ (\# p1,p2 \#) }@- | ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@- | InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@- | UInfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@- --- -- See "Language.Haskell.TH.Syntax#infix"- | ParensP Pat -- ^ @{(p)}@- --- -- See "Language.Haskell.TH.Syntax#infix"- | TildeP Pat -- ^ @{ ~p }@- | BangP Pat -- ^ @{ !p }@- | AsP Name Pat -- ^ @{ x \@ p }@- | WildP -- ^ @{ _ }@- | RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@- | ListP [ Pat ] -- ^ @{ [1,2,3] }@- | SigP Pat Type -- ^ @{ p :: t }@- | ViewP Exp Pat -- ^ @{ e -> p }@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ = LitP Lit -- ^ @{ 5 or \'c\' }@+ | VarP Name -- ^ @{ x }@+ | TupP [Pat] -- ^ @{ (p1,p2) }@+ | UnboxedTupP [Pat] -- ^ @{ (\# p1,p2 \#) }@+ | UnboxedSumP Pat SumAlt SumArity -- ^ @{ (\#|p|\#) }@+ | ConP Name [Pat] -- ^ @data T1 = C1 t1 t2; {C1 p1 p1} = e@+ | InfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@+ | UInfixP Pat Name Pat -- ^ @foo ({x :+ y}) = e@+ --+ -- See "Language.Haskell.TH.Syntax#infix"+ | ParensP Pat -- ^ @{(p)}@+ --+ -- See "Language.Haskell.TH.Syntax#infix"+ | TildeP Pat -- ^ @{ ~p }@+ | BangP Pat -- ^ @{ !p }@+ | AsP Name Pat -- ^ @{ x \@ p }@+ | WildP -- ^ @{ _ }@+ | RecP Name [FieldPat] -- ^ @f (Pt { pointx = x }) = g x@+ | ListP [ Pat ] -- ^ @{ [1,2,3] }@+ | SigP Pat Type -- ^ @{ p :: t }@+ | ViewP Exp Pat -- ^ @{ e -> p }@+ deriving( Show, Eq, Ord, Data, Generic ) type FieldPat = (Name,Pat) data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Clause = Clause [Pat] Body [Dec] -- ^ @f { p1 p2 = body where decs }@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Exp = VarE Name -- ^ @{ x }@ | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @ | LitE Lit -- ^ @{ 5 or \'c\'}@ | AppE Exp Exp -- ^ @{ f x }@+ | AppTypeE Exp Type -- ^ @{ f \@Int } | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@ @@ -1464,6 +1558,7 @@ | LamCaseE [Match] -- ^ @{ \\case m1; m2 }@ | TupE [Exp] -- ^ @{ (e1,e2) } @ | UnboxedTupE [Exp] -- ^ @{ (\# e1,e2 \#) } @+ | 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 }@@@ -1487,7 +1582,7 @@ | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ | StaticE Exp -- ^ @{ static e }@ | UnboundVarE Name -- ^ @{ _x }@ (hole)- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) type FieldExp = (Name,Exp) @@ -1498,36 +1593,38 @@ -- | e3 = e4 } -- where ds@ | NormalB Exp -- ^ @f p { = e } where ds@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Guard = NormalG Exp -- ^ @f x { | odd x } = x@ | PatG [Stmt] -- ^ @f x { | Just y <- x, Just z <- y } = z@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Stmt = BindS Pat Exp | LetS [ Dec ] | NoBindS Exp | ParS [[Stmt]]- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Range = FromR Exp | FromThenR Exp Exp | FromToR Exp Exp | FromThenToR Exp Exp Exp- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Dec = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@ | ValD Pat Body [Dec] -- ^ @{ p = b where decs }@ | DataD Cxt Name [TyVarBndr] (Maybe Kind) -- Kind signature (allowed only for GADTs)- [Con] Cxt+ [Con] [DerivClause] -- ^ @{ data Cxt x => T x = A x | B (T x)- -- deriving (Z,W)}@+ -- deriving (Z,W)+ -- deriving stock Eq }@ | NewtypeD Cxt Name [TyVarBndr] (Maybe Kind) -- Kind signature- Con Cxt -- ^ @{ newtype Cxt x => T x = A (B x)- -- deriving (Z,W Q)}@+ Con [DerivClause] -- ^ @{ newtype Cxt x => T x = A (B x)+ -- deriving (Z,W Q)+ -- deriving stock Eq }@ | TySynD Name [TyVarBndr] Type -- ^ @{ type T x = (x,x) }@ | ClassD Cxt Name [TyVarBndr] [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@@@ -1550,14 +1647,18 @@ | DataInstD Cxt Name [Type] (Maybe Kind) -- Kind signature- [Con] Cxt -- ^ @{ data instance Cxt x => T [x]- -- = A x | B (T x) deriving (Z,W)}@+ [Con] [DerivClause] -- ^ @{ data instance Cxt x => T [x]+ -- = A x | B (T x)+ -- deriving (Z,W)+ -- deriving stock Eq }@ | NewtypeInstD Cxt Name [Type]- (Maybe Kind) -- Kind signature- Con Cxt -- ^ @{ newtype instance Cxt x => T [x]- -- = A (B x) deriving (Z,W)}@- | TySynInstD Name TySynEqn -- ^ @{ type instance ... }@+ (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 ... }@ -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD') | OpenTypeFamilyD TypeFamilyHead@@ -1566,11 +1667,24 @@ | ClosedTypeFamilyD TypeFamilyHead [TySynEqn] -- ^ @{ type family F a b = (r :: *) | r -> a where ... }@ - | RoleAnnotD Name [Role] -- ^ @{ type role T nominal representational }@- | StandaloneDerivD Cxt Type -- ^ @{ deriving instance Ord a => Ord (Foo a) }@- | DefaultSigD Name Type -- ^ @{ default size :: Data a => a -> Int }@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ | RoleAnnotD Name [Role] -- ^ @{ type role T nominal representational }@+ | StandaloneDerivD (Maybe DerivStrategy) Cxt Type+ -- ^ @{ deriving stock instance Ord a => Ord (Foo a) }@+ | DefaultSigD Name Type -- ^ @{ default size :: Data a => a -> Int }@ + -- | Pattern Synonyms+ | PatSynD Name PatSynArgs PatSynDir Pat+ -- ^ @{ pattern P v1 v2 .. vn <- p }@ unidirectional or+ -- @{ pattern P v1 v2 .. vn = p }@ implicit bidirectional or+ -- @{ pattern P v1 v2 .. vn <- p+ -- where P v1 v2 .. vn = e }@ explicit bidirectional+ --+ -- also, besides prefix pattern synonyms, both infix and record+ -- pattern synonyms are supported. See 'PatSynArgs' for details++ | PatSynSigD Name PatSynType -- ^ A pattern synonym's type signature.+ deriving( Show, Eq, Ord, Data, Generic )+ -- | Varieties of allowed instance overlap. data Overlap = Overlappable -- ^ May be overlapped by more specific instances | Overlapping -- ^ May overlap a more general instance@@ -1578,39 +1692,97 @@ | Incoherent -- ^ Both 'Overlappable' and 'Overlappable', and -- pick an arbitrary one if multiple choices are -- available.- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) --- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'.--- By analogy with with "head" for type classes and type class instances as+-- | A single @deriving@ clause at the end of a datatype.+data DerivClause = DerivClause (Maybe DerivStrategy) Cxt+ -- ^ @{ deriving stock (Eq, Ord) }@+ deriving( Show, Eq, Ord, Data, Generic )++-- | What the user explicitly requests when deriving an instance.+data DerivStrategy = StockStrategy -- ^ A \"standard\" derived instance+ | AnyclassStrategy -- ^ @-XDeriveAnyClass@+ | NewtypeStrategy -- ^ @-XGeneralizedNewtypeDeriving@+ deriving( Show, Eq, Ord, Data, Generic )++-- | 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>+--+-- P's complete type is of the following form+--+-- 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+-- variables and required constraints on them.+-- 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.+--+-- 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+-- type in abstract syntax.+--+-- (b) Pretty printing via '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+-- 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+-- '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.+type PatSynType = Type++-- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'. By+-- analogy with "head" for type classes and type class instances as -- defined in /Type classes: an exploration of the design space/, the--- @TypeFamilyHead@ is defined to be the elements of the declaration between--- @type family@ and @where@.+-- @TypeFamilyHead@ is defined to be the elements of the declaration+-- between @type family@ and @where@. data TypeFamilyHead = TypeFamilyHead Name [TyVarBndr] FamilyResultSig (Maybe InjectivityAnn)- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ 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- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data FunDep = FunDep [Name] [Name]- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data FamFlavour = TypeFam | DataFam- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Foreign = ImportF Callconv Safety String Name Type | ExportF Callconv String Name Type- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) -- keep Callconv in sync with module ForeignCall in ghc/compiler/prelude/ForeignCall.hs data Callconv = CCall | StdCall | CApi | Prim | JavaScript- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Safety = Unsafe | Safe | Interruptible- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data Pragma = InlineP Name Inline RuleMatch Phases | SpecialiseP Name Type (Maybe Inline) Phases@@ -1618,30 +1790,32 @@ | RuleP String [RuleBndr] Exp Exp Phases | AnnP AnnTarget Exp | LineP Int String- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ | CompleteP [Name] (Maybe Name)+ -- ^ @{ {\-\# COMPLETE C_1, ..., C_i [ :: T ] \#-} }@+ deriving( Show, Eq, Ord, Data, Generic ) data Inline = NoInline | Inline | Inlinable- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) data RuleMatch = ConLike | FunLike- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) data Phases = AllPhases | FromPhase Int | BeforePhase Int- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) data RuleBndr = RuleVar Name | TypedRuleVar Name Type- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) data AnnTarget = ModuleAnnotation | TypeAnnotation Name | ValueAnnotation Name- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) type Cxt = [Pred] -- ^ @(Eq a, Ord b)@ @@ -1654,12 +1828,12 @@ = NoSourceUnpackedness -- ^ @C a@ | SourceNoUnpack -- ^ @C { {\-\# NOUNPACK \#-\} } a@ | SourceUnpack -- ^ @C { {\-\# UNPACK \#-\} } a@- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) data SourceStrictness = NoSourceStrictness -- ^ @C a@ | SourceLazy -- ^ @C {~}a@ | SourceStrict -- ^ @C {!}a@- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) -- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness' -- refers to the strictness that the compiler chooses for a data constructor@@ -1668,7 +1842,7 @@ data DecidedStrictness = DecidedLazy | DecidedStrict | DecidedUnpack- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) data Con = NormalC Name [BangType] -- ^ @C Int a@ | RecC Name [VarBangType] -- ^ @C { v :: Int, w :: a }@@@ -1680,7 +1854,7 @@ | RecGadtC [Name] [VarBangType] Type -- See Note [GADT return type] -- ^ @C :: { v :: Int } -> T b Int@- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) -- Note [GADT return type] -- ~~~~~~~~~~~~~~~~~~~~~~~@@ -1712,7 +1886,7 @@ data Bang = Bang SourceUnpackedness SourceStrictness -- ^ @C { {\-\# UNPACK \#-\} !}a@- deriving (Show, Eq, Ord, Data, Typeable, Generic)+ deriving (Show, Eq, Ord, Data, Generic) type BangType = (Bang, Type) type VarBangType = (Name, Bang, Type)@@ -1728,6 +1902,20 @@ -- 'VarBangType'. type VarStrictType = VarBangType +-- | A pattern synonym's directionality.+data PatSynDir+ = Unidir -- ^ @pattern P x {<-} p@+ | ImplBidir -- ^ @pattern P x {=} p@+ | ExplBidir [Clause] -- ^ @pattern P x {<-} p where P x = e@+ deriving( Show, Eq, Ord, Data, Generic )++-- | A pattern synonym's argument type.+data PatSynArgs+ = PrefixPatSyn [Name] -- ^ @pattern P {x y z} = p@+ | InfixPatSyn Name Name -- ^ @pattern {x P y} = p@+ | RecordPatSyn [Name] -- ^ @pattern P { {x,y,z} } = p@+ deriving( Show, Eq, Ord, Data, Generic )+ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<type\>@ | AppT Type Type -- ^ @T a b@ | SigT Type Kind -- ^ @t :: k@@@ -1743,6 +1931,7 @@ -- See Note [Representing concrete syntax in types] | TupleT Int -- ^ @(,), (,,), etc.@ | UnboxedTupleT Int -- ^ @(\#,\#), (\#,,\#), etc.@+ | UnboxedSumT SumArity -- ^ @(\#|\#), (\#||\#), etc.@ | ArrowT -- ^ @->@ | EqualityT -- ^ @~@ | ListT -- ^ @[]@@@ -1753,37 +1942,37 @@ | ConstraintT -- ^ @Constraint@ | LitT TyLit -- ^ @0,1,2, etc.@ | WildCardT -- ^ @_,- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) data TyVarBndr = PlainTV Name -- ^ @a@ | KindedTV Name Kind -- ^ @(a :: k)@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) -- | Type family result signature data FamilyResultSig = NoSig -- ^ no signature | KindSig Kind -- ^ @k@ | TyVarSig TyVarBndr -- ^ @= r, = (r :: k)@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) -- | Injectivity annotation data InjectivityAnn = InjectivityAnn Name [Name]- deriving ( Show, Eq, Ord, Data, Typeable, Generic )+ deriving ( Show, Eq, Ord, Data, Generic ) data TyLit = NumTyLit Integer -- ^ @2@ | StrTyLit String -- ^ @"Hello"@- deriving ( Show, Eq, Ord, Data, Typeable, Generic )+ deriving ( Show, Eq, Ord, Data, Generic ) -- | Role annotations data Role = NominalR -- ^ @nominal@ | RepresentationalR -- ^ @representational@ | PhantomR -- ^ @phantom@ | InferR -- ^ @_@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) -- | Annotation target for reifyAnnotations data AnnLookup = AnnLookupModule Module | AnnLookupName Name- deriving( Show, Eq, Ord, Data, Typeable, Generic )+ deriving( Show, Eq, Ord, Data, Generic ) -- | To avoid duplication between kinds and types, they -- are defined to be the same. Naturally, you would never
changelog.md view
@@ -1,14 +1,39 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) -## 2.11.1.0 Jan 2017+## 2.12.0.0 *July 2017* - * Bundled with GHC 8.0.2+ * Bundled with GHC 8.2.1. - * Fix pretty-printing of list comprehensions with only one statement. Previously this was rendered as `[Foo|]` instead of `Foo]`.+ * Add support for pattern synonyms. This introduces one new constructor to+ `Info` (`PatSynI`), two new constructors to `Dec` (`PatSynD` and+ `PatSynSigD`), and two new data types (`PatSynDir` and `PatSynArgs`),+ among other changes. (#8761) + * Add support for unboxed sums. (#12478) -## 2.11.0.0 May 2016+ * Add support for visible type applications. (#12530) + * Add support for attaching deriving strategies to `deriving` statements+ (#10598)++ * Add support for `COMPLETE` pragmas. (#13098)++ * `unboxedTupleTypeName` and `unboxedTupleDataName` now work for unboxed+ 0-tuples and 1-tuples (#12977)++ * `Language.Haskell.TH` now reexports all of `Language.Haskell.TH.Lib`.+ (#12992). This causes `Language.Haskell.TH` to export more types and+ functions that it did before:+ - `TExp`, `BangQ`, and `FieldExpQ`+ - `unboxedTupP`, `unboxedTupE` and `unboundVarE`+ - `infixLD`, `infixRD`, and `infixND`+ - `unboxedTupleT` and `wildCardT`+ - `plainTV` and `kindedTV`+ - `interruptible` and `funDep`+ - `valueAnnotation`, `typeAnnotation`, and `moduleAnnotation`++## 2.11.0.0 *May 2016*+ * Bundled with GHC 8.0.1 * The compiler can now resolve infix operator fixities in types on its own.@@ -37,9 +62,8 @@ in Haskell source code (`SourceUnpackedness` and `SourceStrictness`, as well as `Bang`), and one for strictness information after a constructor is compiled (`DecidedStrictness`). `Strict`, `StrictType` and `VarStrictType`- have been deprecated in favor of `Bang`, `BangType` and `VarBangType`, and- three functions (`isStrict`, `isLazy`, and `unpack`) were removed because- they no longer serve any use in this new design. (#10697)+ have been deprecated in favor of `Bang`, `BangType` and `VarBangType`.+ (#10697) * Add `reifyConStrictness` to query a data constructor's `DecidedStrictness` values for its fields (#10697)@@ -51,8 +75,6 @@ `Nothing` otherwise (#10704 and #11345) * Add `MonadFail Q` instance for GHC 8.0 and later (#11661)-- * TODO: document API changes and important bugfixes * Add support for OVERLAP(S/PED/PING) pragmas on instances
template-haskell.cabal view
@@ -1,5 +1,5 @@ name: template-haskell-version: 2.11.1.0+version: 2.12.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE@@ -49,8 +49,8 @@ Language.Haskell.TH.Lib.Map build-depends:- base >= 4.7 && < 4.10,- ghc-boot-th == 8.0.*,+ base >= 4.8 && < 4.11,+ ghc-boot-th == 8.2.*, pretty == 1.1.* -- We need to set the unit ID to template-haskell (without a