template-haskell 2.10.0.0 → 2.11.0.0
raw patch · 9 files changed
+1089/−339 lines, 9 filesdep +ghc-boot-thdep ~base
Dependencies added: ghc-boot-th
Dependency ranges changed: base
Files
- Language/Haskell/TH.hs +36/−16
- Language/Haskell/TH/LanguageExtensions.hs +22/−0
- Language/Haskell/TH/Lib.hs +194/−65
- Language/Haskell/TH/Ppr.hs +233/−78
- Language/Haskell/TH/PprLib.hs +19/−15
- Language/Haskell/TH/Quote.hs +34/−65
- Language/Haskell/TH/Syntax.hs +482/−91
- changelog.md +50/−0
- template-haskell.cabal +19/−9
Language/Haskell/TH.hs view
@@ -26,9 +26,14 @@ ParentName, Arity, Unlifted,+ -- *** Language extension lookup+ Extension(..),+ extsEnabled, isExtEnabled, -- *** Name lookup lookupTypeName, -- :: String -> Q (Maybe Name) lookupValueName, -- :: String -> Q (Maybe Name)+ -- *** Fixity lookup+ reifyFixity, -- *** Instance lookup reifyInstances, isInstance,@@ -36,6 +41,8 @@ reifyRoles, -- *** Annotation lookup reifyAnnotations, AnnLookup(..),+ -- *** Constructor strictness lookup+ reifyConStrictness, -- * Typed expressions TExp, unType,@@ -48,6 +55,8 @@ -- ** Deconstructing names nameBase, -- :: Name -> String nameModule, -- :: Name -> Maybe String+ namePackage, -- :: Name -> Maybe String+ nameSpace, -- :: Name -> Maybe NameSpace -- ** Built-in names tupleTypeName, tupleDataName, -- Int -> Name unboxedTupleTypeName, unboxedTupleDataName, -- :: Int -> Name@@ -59,9 +68,10 @@ -- ** Declarations Dec(..), Con(..), Clause(..),- Strict(..), Foreign(..), Callconv(..), Safety(..), Pragma(..),+ SourceUnpackedness(..), SourceStrictness(..), DecidedStrictness(..),+ Bang(..), Strict, Foreign(..), Callconv(..), Safety(..), Pragma(..), Inline(..), RuleMatch(..), Phases(..), RuleBndr(..), AnnTarget(..),- FunDep(..), FamFlavour(..), TySynEqn(..),+ FunDep(..), FamFlavour(..), TySynEqn(..), TypeFamilyHead(..), Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, -- ** Expressions Exp(..), Match(..), Body(..), Guard(..), Stmt(..), Range(..), Lit(..),@@ -69,17 +79,19 @@ Pat(..), FieldExp, FieldPat, -- ** Types Type(..), TyVarBndr(..), TyLit(..), Kind, Cxt, Pred, Syntax.Role(..),+ FamilyResultSig(..), Syntax.InjectivityAnn(..), -- * Library functions -- ** Abbreviations- InfoQ, ExpQ, DecQ, DecsQ, ConQ, TypeQ, TyLitQ, CxtQ, PredQ, MatchQ, ClauseQ,- BodyQ, GuardQ, StmtQ, RangeQ, StrictTypeQ, VarStrictTypeQ, PatQ, FieldPatQ,- RuleBndrQ, TySynEqnQ,+ 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,+ charL, stringL, stringPrimL, charPrimL, -- *** Patterns litP, varP, tupP, conP, uInfixP, parensP, infixP, tildeP, bangP, asP, wildP, recP,@@ -90,7 +102,7 @@ normalB, guardedB, normalG, normalGE, patG, patGE, match, clause, -- *** Expressions- dyn, global, varE, conE, litE, appE, uInfixE, parensE, staticE,+ 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,@@ -105,14 +117,20 @@ bindS, letS, noBindS, parS, -- *** Types- forallT, varT, conT, appT, arrowT, equalityT, listT, tupleT, sigT, litT,- promotedT, promotedTupleT, promotedNilT, promotedConsT,+ forallT, varT, conT, appT, arrowT, infixT, uInfixT, parensT, equalityT,+ listT, tupleT, sigT, litT, promotedT, promotedTupleT, promotedNilT,+ promotedConsT, -- **** Type literals numTyLit, strTyLit, -- **** Strictness- isStrict, notStrict, strictType, varStrictType,+ noSourceUnpackedness, sourceNoUnpack, sourceUnpack,+ noSourceStrictness, sourceLazy, sourceStrict,+ isStrict, notStrict, unpacked,+ bang, bangType, varBangType, strictType, varStrictType, -- **** Class Contexts- cxt, classP, equalP, normalC, recC, infixC, forallC,+ cxt, classP, equalP,+ -- **** Constructors+ normalC, recC, infixC, forallC, gadtC, recGadtC, -- *** Kinds varK, conK, tupleK, arrowK, listK, appK, starK, constraintK,@@ -122,16 +140,18 @@ -- *** Top Level Declarations -- **** Data- valD, funD, tySynD, dataD, newtypeD,+ valD, funD, tySynD, dataD, newtypeD, -- **** Class- classD, instanceD, sigD, standaloneDerivD, defaultSigD,+ classD, instanceD, instanceWithOverlapD, Overlap(..),+ sigD, standaloneDerivD, defaultSigD,+ -- **** Role annotations roleAnnotD, -- **** Type Family / Data Family- familyNoKindD, familyKindD, dataInstD,- closedTypeFamilyNoKindD, closedTypeFamilyKindD,+ dataFamilyD, openTypeFamilyD, closedTypeFamilyD, dataInstD,+ familyNoKindD, familyKindD, closedTypeFamilyNoKindD, closedTypeFamilyKindD, newtypeInstD, tySynInstD,- typeFam, dataFam, tySynEqn,+ typeFam, dataFam, tySynEqn, injectivityAnn, noSig, kindSig, tyVarSig, -- **** Foreign Function Interface (FFI) cCall, stdCall, cApi, prim, javaScript, unsafe, safe, forImpD,
+ Language/Haskell/TH/LanguageExtensions.hs view
@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+-- |+-- Module : Language.Haskell.TH.LanguageExtensions+-- Copyright : (c) The University of Glasgow 2015+-- License : BSD-style (see the file libraries/base/LICENSE)+--+-- Maintainer : libraries@haskell.org+-- Stability : experimental+-- Portability : portable+--+-- Language extensions known to GHC+--+-----------------------------------------------------------------------------++module Language.Haskell.TH.LanguageExtensions+ ( Extension(..)+ ) where++-- This module exists primarily to avoid inserting a massive list of language+-- extensions into the already quite large Haddocks for Language.Haskell.TH++import GHC.LanguageExtensions.Type (Extension(..))
Language/Haskell/TH/Lib.hs view
@@ -2,12 +2,14 @@ -- TH.Lib contains lots of useful helper functions for -- generating and manipulating Template Haskell terms +{-# LANGUAGE CPP #-}+ module Language.Haskell.TH.Lib where -- All of the exports from this module should -- be "public" functions. The main module TH -- re-exports them all. -import Language.Haskell.TH.Syntax hiding (Role)+import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn) import qualified Language.Haskell.TH.Syntax as TH import Control.Monad( liftM, liftM2 ) import Data.Word( Word8 )@@ -16,31 +18,39 @@ -- * Type synonyms ---------------------------------------------------------- -type InfoQ = Q Info-type PatQ = Q Pat-type FieldPatQ = Q FieldPat-type ExpQ = Q Exp-type TExpQ a = Q (TExp a)-type DecQ = Q Dec-type DecsQ = Q [Dec]-type ConQ = Q Con-type TypeQ = Q Type-type TyLitQ = Q TyLit-type CxtQ = Q Cxt-type PredQ = Q Pred-type MatchQ = Q Match-type ClauseQ = Q Clause-type BodyQ = Q Body-type GuardQ = Q Guard-type StmtQ = Q Stmt-type RangeQ = Q Range-type StrictTypeQ = Q StrictType-type VarStrictTypeQ = Q VarStrictType-type FieldExpQ = Q FieldExp-type RuleBndrQ = Q RuleBndr-type TySynEqnQ = Q TySynEqn-type Role = TH.Role -- must be defined here for DsMeta to find it+type InfoQ = Q Info+type PatQ = Q Pat+type FieldPatQ = Q FieldPat+type ExpQ = Q Exp+type TExpQ a = Q (TExp a)+type DecQ = Q Dec+type DecsQ = Q [Dec]+type ConQ = Q Con+type TypeQ = Q Type+type TyLitQ = Q TyLit+type CxtQ = Q Cxt+type PredQ = Q Pred+type MatchQ = Q Match+type ClauseQ = Q Clause+type BodyQ = Q Body+type GuardQ = Q Guard+type StmtQ = Q Stmt+type RangeQ = Q Range+type SourceStrictnessQ = Q SourceStrictness+type SourceUnpackednessQ = Q SourceUnpackedness+type BangQ = Q Bang+type BangTypeQ = Q BangType+type VarBangTypeQ = Q VarBangType+type StrictTypeQ = Q StrictType+type VarStrictTypeQ = Q VarStrictType+type FieldExpQ = Q FieldExp+type RuleBndrQ = Q RuleBndr+type TySynEqnQ = Q TySynEqn +-- must be defined here for DsMeta to find it+type Role = TH.Role+type InjectivityAnn = TH.InjectivityAnn+ ---------------------------------------------------------- -- * Lowercase pattern syntax functions ----------------------------------------------------------@@ -57,6 +67,8 @@ integerL = IntegerL charL :: Char -> Lit charL = CharL+charPrimL :: Char -> Lit+charPrimL = CharPrimL stringL :: String -> Lit stringL = StringL stringPrimL :: [Word8] -> Lit@@ -199,11 +211,6 @@ dyn :: String -> ExpQ dyn s = return (VarE (mkName s)) -global :: Name -> ExpQ-{-# DEPRECATED global "Use varE instead" #-}--- Trac #8656; I have no idea why this function is duplicated-global s = return (VarE s)- varE :: Name -> ExpQ varE s = return (VarE s) @@ -300,6 +307,9 @@ staticE :: ExpQ -> ExpQ staticE = fmap StaticE +unboundVarE :: Name -> ExpQ+unboundVarE s = return (UnboundVarE s)+ -- ** 'arithSeqE' Shortcuts fromE :: ExpQ -> ExpQ fromE x = do { a <- x; return (ArithSeqE (FromR a)) }@@ -335,19 +345,21 @@ tySynD :: Name -> [TyVarBndr] -> TypeQ -> DecQ tySynD tc tvs rhs = do { rhs1 <- rhs; return (TySynD tc tvs rhs1) } -dataD :: CxtQ -> Name -> [TyVarBndr] -> [ConQ] -> [Name] -> DecQ-dataD ctxt tc tvs cons derivs =+dataD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> [ConQ] -> CxtQ -> DecQ+dataD ctxt tc tvs ksig cons derivs = do ctxt1 <- ctxt cons1 <- sequence cons- return (DataD ctxt1 tc tvs cons1 derivs)+ derivs1 <- derivs+ return (DataD ctxt1 tc tvs ksig cons1 derivs1) -newtypeD :: CxtQ -> Name -> [TyVarBndr] -> ConQ -> [Name] -> DecQ-newtypeD ctxt tc tvs con derivs =+newtypeD :: CxtQ -> Name -> [TyVarBndr] -> Maybe Kind -> ConQ -> CxtQ -> DecQ+newtypeD ctxt tc tvs ksig con derivs = do ctxt1 <- ctxt con1 <- con- return (NewtypeD ctxt1 tc tvs con1 derivs)+ derivs1 <- derivs+ return (NewtypeD ctxt1 tc tvs ksig con1 derivs1) classD :: CxtQ -> Name -> [TyVarBndr] -> [FunDep] -> [DecQ] -> DecQ classD ctxt cls tvs fds decs =@@ -357,13 +369,18 @@ return $ ClassD ctxt1 cls tvs fds decs1 instanceD :: CxtQ -> TypeQ -> [DecQ] -> DecQ-instanceD ctxt ty decs =+instanceD = instanceWithOverlapD Nothing++instanceWithOverlapD :: Maybe Overlap -> CxtQ -> TypeQ -> [DecQ] -> DecQ+instanceWithOverlapD o ctxt ty decs = do ctxt1 <- ctxt decs1 <- sequence decs ty1 <- ty- return $ InstanceD ctxt1 ty1 decs1+ return $ InstanceD o ctxt1 ty1 decs1 ++ sigD :: Name -> TypeQ -> DecQ sigD fun ty = liftM (SigD fun) $ ty @@ -420,27 +437,23 @@ pragLineD :: Int -> String -> DecQ pragLineD line file = return $ PragmaD $ LineP line file -familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ-familyNoKindD flav tc tvs = return $ FamilyD flav tc tvs Nothing--familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ-familyKindD flav tc tvs k = return $ FamilyD flav tc tvs (Just k)--dataInstD :: CxtQ -> Name -> [TypeQ] -> [ConQ] -> [Name] -> DecQ-dataInstD ctxt tc tys cons derivs =+dataInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> [ConQ] -> CxtQ -> DecQ+dataInstD ctxt tc tys ksig cons derivs = do ctxt1 <- ctxt tys1 <- sequence tys cons1 <- sequence cons- return (DataInstD ctxt1 tc tys1 cons1 derivs)+ derivs1 <- derivs+ return (DataInstD ctxt1 tc tys1 ksig cons1 derivs1) -newtypeInstD :: CxtQ -> Name -> [TypeQ] -> ConQ -> [Name] -> DecQ-newtypeInstD ctxt tc tys con derivs =+newtypeInstD :: CxtQ -> Name -> [TypeQ] -> Maybe Kind -> ConQ -> CxtQ -> DecQ+newtypeInstD ctxt tc tys ksig con derivs = do ctxt1 <- ctxt tys1 <- sequence tys con1 <- con- return (NewtypeInstD ctxt1 tc tys1 con1 derivs)+ derivs1 <- derivs+ return (NewtypeInstD ctxt1 tc tys1 ksig con1 derivs1) tySynInstD :: Name -> TySynEqnQ -> DecQ tySynInstD tc eqn =@@ -448,17 +461,59 @@ eqn1 <- eqn return (TySynInstD tc eqn1) +dataFamilyD :: Name -> [TyVarBndr] -> Maybe Kind -> DecQ+dataFamilyD tc tvs kind+ = return $ DataFamilyD tc tvs kind++openTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig+ -> Maybe InjectivityAnn -> DecQ+openTypeFamilyD tc tvs res inj+ = return $ OpenTypeFamilyD (TypeFamilyHead tc tvs res inj)++closedTypeFamilyD :: Name -> [TyVarBndr] -> FamilyResultSig+ -> Maybe InjectivityAnn -> [TySynEqnQ] -> DecQ+closedTypeFamilyD tc tvs result injectivity eqns =+ do eqns1 <- sequence eqns+ return (ClosedTypeFamilyD (TypeFamilyHead tc tvs result injectivity) eqns1)++-- These were deprecated in GHC 8.0 with a plan to remove them in 8.2. If you+-- remove this check please also:+-- 1. remove deprecated functions+-- 2. remove CPP language extension from top of this module+-- 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+#error Remove deprecated familyNoKindD, familyKindD, closedTypeFamilyNoKindD and closedTypeFamilyKindD+#endif++{-# DEPRECATED familyNoKindD, familyKindD+ "This function will be removed in the next stable release. Use openTypeFamilyD/dataFamilyD instead." #-}+familyNoKindD :: FamFlavour -> Name -> [TyVarBndr] -> DecQ+familyNoKindD flav tc tvs =+ case flav of+ TypeFam -> return $ OpenTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing)+ DataFam -> return $ DataFamilyD tc tvs Nothing++familyKindD :: FamFlavour -> Name -> [TyVarBndr] -> Kind -> DecQ+familyKindD flav tc tvs k =+ case flav of+ TypeFam ->+ return $ OpenTypeFamilyD (TypeFamilyHead tc tvs (KindSig k) Nothing)+ DataFam -> return $ DataFamilyD tc tvs (Just k)++{-# DEPRECATED closedTypeFamilyNoKindD, closedTypeFamilyKindD+ "This function will be removed in the next stable release. Use closedTypeFamilyD instead." #-} closedTypeFamilyNoKindD :: Name -> [TyVarBndr] -> [TySynEqnQ] -> DecQ closedTypeFamilyNoKindD tc tvs eqns =- do- eqns1 <- sequence eqns- return (ClosedTypeFamilyD tc tvs Nothing eqns1)+ do eqns1 <- sequence eqns+ return (ClosedTypeFamilyD (TypeFamilyHead tc tvs NoSig Nothing) eqns1) closedTypeFamilyKindD :: Name -> [TyVarBndr] -> Kind -> [TySynEqnQ] -> DecQ closedTypeFamilyKindD tc tvs kind eqns =- do- eqns1 <- sequence eqns- return (ClosedTypeFamilyD tc tvs (Just kind) eqns1)+ do eqns1 <- sequence eqns+ return (ClosedTypeFamilyD (TypeFamilyHead tc tvs (KindSig kind) Nothing)+ eqns1) roleAnnotD :: Name -> [Role] -> DecQ roleAnnotD name roles = return $ RoleAnnotD name roles@@ -486,13 +541,13 @@ cxt :: [PredQ] -> CxtQ cxt = sequence -normalC :: Name -> [StrictTypeQ] -> ConQ+normalC :: Name -> [BangTypeQ] -> ConQ normalC con strtys = liftM (NormalC con) $ sequence strtys -recC :: Name -> [VarStrictTypeQ] -> ConQ+recC :: Name -> [VarBangTypeQ] -> ConQ recC con varstrtys = liftM (RecC con) $ sequence varstrtys -infixC :: Q (Strict, Type) -> Name -> Q (Strict, Type) -> ConQ+infixC :: Q (Bang, Type) -> Name -> Q (Bang, Type) -> ConQ infixC st1 con st2 = do st1' <- st1 st2' <- st2 return $ InfixC st1' con st2'@@ -500,7 +555,12 @@ forallC :: [TyVarBndr] -> CxtQ -> ConQ -> ConQ forallC ns ctxt con = liftM2 (ForallC ns) ctxt con +gadtC :: [Name] -> [StrictTypeQ] -> TypeQ -> ConQ+gadtC cons strtys ty = liftM2 (GadtC cons) (sequence strtys) ty +recGadtC :: [Name] -> [VarStrictTypeQ] -> TypeQ -> ConQ+recGadtC cons varstrtys ty = liftM2 (RecGadtC cons) (sequence varstrtys) ty+ ------------------------------------------------------------------------------- -- * Type @@ -516,6 +576,20 @@ conT :: Name -> TypeQ conT = return . ConT +infixT :: TypeQ -> Name -> TypeQ -> TypeQ+infixT t1 n t2 = do t1' <- t1+ t2' <- t2+ return (InfixT t1' n t2')++uInfixT :: TypeQ -> Name -> TypeQ -> TypeQ+uInfixT t1 n t2 = do t1' <- t1+ t2' <- t2+ return (UInfixT t1' n t2')++parensT :: TypeQ -> TypeQ+parensT t = do t' <- t+ return (ParensT t')+ appT :: TypeQ -> TypeQ -> TypeQ appT t1 t2 = do t1' <- t1@@ -546,6 +620,9 @@ equalityT :: TypeQ equalityT = return EqualityT +wildCardT :: TypeQ+wildCardT = return WildCardT+ {-# 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 classP cla tys@@ -574,17 +651,51 @@ promotedConsT :: TypeQ promotedConsT = return PromotedConsT +noSourceUnpackedness, sourceNoUnpack, sourceUnpack :: SourceUnpackednessQ+noSourceUnpackedness = return NoSourceUnpackedness+sourceNoUnpack = return SourceNoUnpack+sourceUnpack = return SourceUnpack++noSourceStrictness, sourceLazy, sourceStrict :: SourceStrictnessQ+noSourceStrictness = return NoSourceStrictness+sourceLazy = return SourceLazy+sourceStrict = return SourceStrict++{-# DEPRECATED isStrict+ ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",+ "Example usage: 'bang noSourceUnpackedness sourceStrict'"] #-}+{-# DEPRECATED notStrict+ ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",+ "Example usage: 'bang noSourceUnpackedness noSourceStrictness'"] #-}+{-# DEPRECATED unpacked+ ["Use 'bang'. See https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0. ",+ "Example usage: 'bang sourceUnpack sourceStrict'"] #-} isStrict, notStrict, unpacked :: Q Strict-isStrict = return $ IsStrict-notStrict = return $ NotStrict-unpacked = return Unpacked+isStrict = bang noSourceUnpackedness sourceStrict+notStrict = bang noSourceUnpackedness noSourceStrictness+unpacked = bang sourceUnpack sourceStrict +bang :: SourceUnpackednessQ -> SourceStrictnessQ -> BangQ+bang u s = do u' <- u+ s' <- s+ return (Bang u' s')++bangType :: BangQ -> TypeQ -> BangTypeQ+bangType = liftM2 (,)++varBangType :: Name -> BangTypeQ -> VarBangTypeQ+varBangType v bt = do (b, t) <- bt+ return (v, b, t)++{-# DEPRECATED strictType+ "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'bangType' instead." #-} strictType :: Q Strict -> TypeQ -> StrictTypeQ-strictType = liftM2 (,)+strictType = bangType +{-# DEPRECATED varStrictType+ "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'varBangType' instead." #-} varStrictType :: Name -> StrictTypeQ -> VarStrictTypeQ-varStrictType v st = do (s, t) <- st- return (v, s, t)+varStrictType = varBangType -- * Type Literals @@ -629,6 +740,24 @@ constraintK :: Kind constraintK = ConstraintT++-------------------------------------------------------------------------------+-- * Type family result++noSig :: FamilyResultSig+noSig = NoSig++kindSig :: Kind -> FamilyResultSig+kindSig = KindSig++tyVarSig :: TyVarBndr -> FamilyResultSig+tyVarSig = TyVarSig++-------------------------------------------------------------------------------+-- * Injectivity annotation++injectivityAnn :: Name -> [Name] -> InjectivityAnn+injectivityAnn = TH.InjectivityAnn ------------------------------------------------------------------------------- -- * Role
Language/Haskell/TH/Ppr.hs view
@@ -55,20 +55,18 @@ <+> (if is_unlifted then text "unlifted" else empty) <+> text "type constructor" <+> quotes (ppr name) <+> parens (text "arity" <+> int arity)- ppr (ClassOpI v ty cls fix)- = text "Class op from" <+> ppr cls <> colon <+>- vcat [ppr_sig v ty, pprFixity v fix]- ppr (DataConI v ty tc fix)- = text "Constructor from" <+> ppr tc <> colon <+>- vcat [ppr_sig v ty, pprFixity v fix]+ ppr (ClassOpI v ty cls)+ = 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 (TyVarI v ty) = text "Type variable" <+> ppr v <+> equals <+> ppr ty- ppr (VarI v ty mb_d fix)- = vcat [ppr_sig v ty, pprFixity v fix,+ ppr (VarI v ty mb_d)+ = vcat [ppr_sig v ty, case mb_d of { Nothing -> empty; Just d -> ppr d }] ppr_sig :: Name -> Type -> Doc-ppr_sig v ty = ppr v <+> text "::" <+> ppr ty+ppr_sig v ty = pprName' Applied v <+> dcolon <+> ppr ty pprFixity :: Name -> Fixity -> Doc pprFixity _ f | f == defaultFixity = empty@@ -130,8 +128,8 @@ <+> text "->" <+> ppr e pprExp i (LamCaseE ms) = parensIf (i > noPrec) $ text "\\case" $$ nest nestDepth (ppr ms)-pprExp _ (TupE es) = parens $ sep $ punctuate comma $ map ppr es-pprExp _ (UnboxedTupE es) = hashParens $ sep $ punctuate comma $ map ppr es+pprExp _ (TupE es) = parens (commaSep es)+pprExp _ (UnboxedTupE es) = hashParens (commaSep es) -- 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,@@ -148,7 +146,7 @@ where pprDecs [] = empty pprDecs [d] = ppr d- pprDecs ds = braces $ sep $ punctuate semi $ map ppr ds+ pprDecs ds = braces (semiSep ds) pprExp i (CaseE e ms) = parensIf (i > noPrec) $ text "case" <+> ppr e <+> text "of"@@ -157,23 +155,24 @@ where pprStms [] = empty pprStms [s] = ppr s- pprStms ss = braces $ sep $ punctuate semi $ map ppr ss+ pprStms ss = braces (semiSep ss) pprExp _ (CompE []) = text "<<Empty CompExp>>" -- This will probably break with fixity declarations - would need a ';' pprExp _ (CompE ss) = text "[" <> ppr s <+> text "|"- <+> (sep $ punctuate comma $ map ppr ss')+ <+> commaSep ss' <> text "]" where s = last ss ss' = init ss pprExp _ (ArithSeqE d) = ppr d-pprExp _ (ListE es) = brackets $ sep $ punctuate comma $ map ppr es-pprExp i (SigE e t) = parensIf (i > noPrec) $ ppr e <+> text "::" <+> ppr t+pprExp _ (ListE es) = brackets (commaSep es)+pprExp i (SigE e t) = parensIf (i > noPrec) $ ppr e <+> dcolon <+> ppr t pprExp _ (RecConE nm fs) = ppr nm <> braces (pprFields fs) pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs) pprExp i (StaticE e) = parensIf (i >= appPrec) $ text "static"<+> pprExp appPrec e+pprExp _ (UnboundVarE v) = pprName' Applied v pprFields :: [(Name,Exp)] -> Doc pprFields = sep . punctuate comma . map (\(s,e) -> ppr s <+> equals <+> ppr e)@@ -185,10 +184,10 @@ ------------------------------ instance Ppr Stmt where ppr (BindS p e) = ppr p <+> text "<-" <+> ppr e- ppr (LetS ds) = text "let" <+> ppr ds+ ppr (LetS ds) = text "let" <+> (braces (semiSep ds)) ppr (NoBindS e) = ppr e ppr (ParS sss) = sep $ punctuate (text "|")- $ map (sep . punctuate comma . map ppr) sss+ $ map commaSep sss ------------------------------ instance Ppr Match where@@ -224,6 +223,7 @@ (double (fromRational x) <> text "##") pprLit i (IntegerL x) = parensIf (i > noPrec && x < 0) (integer x) pprLit _ (CharL c) = text (show c)+pprLit _ (CharPrimL c) = text (show c) <> char '#' pprLit _ (StringL s) = pprString s pprLit _ (StringPrimL s) = pprString (bytesToString s) <> char '#' pprLit i (RationalL rat) = parensIf (i > noPrec) $@@ -245,8 +245,8 @@ pprPat :: Precedence -> Pat -> Doc pprPat i (LitP l) = pprLit i l pprPat _ (VarP v) = pprName' Applied v-pprPat _ (TupP ps) = parens $ sep $ punctuate comma $ map ppr ps-pprPat _ (UnboxedTupP ps) = hashParens $ sep $ punctuate comma $ map ppr ps+pprPat _ (TupP ps) = parens (commaSep ps)+pprPat _ (UnboxedTupP ps) = hashParens (commaSep ps) pprPat i (ConP s ps) = parensIf (i >= appPrec) $ pprName' Applied s <+> sep (map (pprPat appPrec) ps) pprPat _ (ParensP p) = parens $ pprPat noPrec p@@ -267,8 +267,8 @@ = parens $ ppr nm <+> braces (sep $ punctuate comma $ map (\(s,p) -> ppr s <+> equals <+> ppr p) fs)-pprPat _ (ListP ps) = brackets $ sep $ punctuate comma $ map ppr ps-pprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> text "::" <+> ppr t+pprPat _ (ListP ps) = brackets (commaSep ps)+pprPat i (SigP p t) = parensIf (i > noPrec) $ ppr p <+> dcolon <+> ppr t pprPat _ (ViewP e p) = parens $ pprExp noPrec e <+> text "->" <+> pprPat noPrec p ------------------------------@@ -283,34 +283,34 @@ $$ where_clause ds ppr_dec _ (TySynD t xs rhs) = ppr_tySyn empty t (hsep (map ppr xs)) rhs-ppr_dec _ (DataD ctxt t xs cs decs)- = ppr_data empty ctxt t (hsep (map ppr xs)) cs decs-ppr_dec _ (NewtypeD ctxt t xs c decs)- = ppr_newtype empty ctxt t (sep (map ppr xs)) c decs+ppr_dec _ (DataD ctxt t xs ksig cs decs)+ = ppr_data empty ctxt 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_dec _ (ClassD ctxt c xs fds ds) = text "class" <+> pprCxt ctxt <+> ppr c <+> hsep (map ppr xs) <+> ppr fds $$ where_clause ds-ppr_dec _ (InstanceD ctxt i ds) = text "instance" <+> pprCxt ctxt <+> ppr i+ppr_dec _ (InstanceD o ctxt i ds) =+ text "instance" <+> maybe empty ppr_overlap o <+> pprCxt ctxt <+> ppr i $$ where_clause ds-ppr_dec _ (SigD f t) = pprPrefixOcc f <+> text "::" <+> ppr t+ppr_dec _ (SigD f t) = pprPrefixOcc f <+> dcolon <+> ppr t ppr_dec _ (ForeignD f) = ppr f ppr_dec _ (InfixD fx n) = pprFixity n fx ppr_dec _ (PragmaD p) = ppr p-ppr_dec isTop (FamilyD flav tc tvs k)- = ppr flav <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind+ppr_dec isTop (DataFamilyD tc tvs kind)+ = text "data" <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind where maybeFamily | isTop = text "family" | otherwise = empty-- maybeKind | (Just k') <- k = text "::" <+> ppr k'- | otherwise = empty-ppr_dec isTop (DataInstD ctxt tc tys cs decs)- = ppr_data maybeInst ctxt tc (sep (map pprParendType tys)) cs decs+ 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 where maybeInst | isTop = text "instance" | otherwise = empty-ppr_dec isTop (NewtypeInstD ctxt tc tys c decs)- = ppr_newtype maybeInst ctxt tc (sep (map pprParendType tys)) c decs+ppr_dec isTop (NewtypeInstD ctxt tc tys ksig c decs)+ = ppr_newtype maybeInst ctxt tc (sep (map pprParendType tys)) ksig c decs where maybeInst | isTop = text "instance" | otherwise = empty@@ -319,13 +319,15 @@ where maybeInst | isTop = text "instance" | otherwise = empty-ppr_dec _ (ClosedTypeFamilyD tc tvs mkind eqns)- = hang (hsep [ text "type family", ppr tc, hsep (map ppr tvs), maybeKind- , text "where" ])+ppr_dec isTop (OpenTypeFamilyD tfhead)+ = text "type" <+> maybeFamily <+> ppr_tf_head tfhead+ where+ maybeFamily | isTop = text "family"+ | otherwise = empty+ppr_dec _ (ClosedTypeFamilyD tfhead@(TypeFamilyHead tc _ _ _) eqns)+ = hang (text "type family" <+> ppr_tf_head tfhead <+> text "where") nestDepth (vcat (map ppr_eqn eqns)) where- maybeKind | (Just k') <- mkind = text "::" <+> ppr k'- | otherwise = empty ppr_eqn (TySynEqn lhs rhs) = ppr tc <+> sep (map pprParendType lhs) <+> text "=" <+> ppr rhs @@ -336,45 +338,79 @@ = hsep [ text "deriving instance", pprCxt cxt, ppr ty ] ppr_dec _ (DefaultSigD n ty)- = hsep [ text "default", pprPrefixOcc n, text "::", ppr ty ]+ = hsep [ text "default", pprPrefixOcc n, dcolon, ppr ty ] -ppr_data :: Doc -> Cxt -> Name -> Doc -> [Con] -> [Name] -> Doc-ppr_data maybeInst ctxt t argsDoc cs decs++ppr_overlap :: Overlap -> Doc+ppr_overlap o = text $+ case o of+ Overlaps -> "{-# OVERLAPS #-}"+ Overlappable -> "{-# OVERLAPPABLE #-}"+ Overlapping -> "{-# OVERLAPPING #-}"+ Incoherent -> "{-# INCOHERENT #-}"++ppr_data :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> [Con] -> Cxt -> Doc+ppr_data maybeInst ctxt t argsDoc ksig cs decs = sep [text "data" <+> maybeInst <+> pprCxt ctxt- <+> ppr t <+> argsDoc,+ <+> ppr t <+> argsDoc <+> ksigDoc <+> maybeWhere, nest nestDepth (sep (pref $ map ppr cs)), if null decs then empty else nest nestDepth- $ text "deriving"- <+> parens (hsep $ punctuate comma $ map ppr decs)]+ $ text "deriving" <+> ppr_cxt_preds decs] where pref :: [Doc] -> [Doc]- pref [] = [] -- No constructors; can't happen in H98- pref (d:ds) = (char '=' <+> d):map (char '|' <+>) ds+ pref xs | isGadtDecl = xs+ pref [] = [] -- No constructors; can't happen in H98+ pref (d:ds) = (char '=' <+> d):map (char '|' <+>) ds -ppr_newtype :: Doc -> Cxt -> Name -> Doc -> Con -> [Name] -> Doc-ppr_newtype maybeInst ctxt t argsDoc c decs+ maybeWhere :: Doc+ maybeWhere | isGadtDecl = text "where"+ | otherwise = empty++ isGadtDecl :: Bool+ isGadtDecl = not (null cs) && all isGadtCon cs+ where isGadtCon (GadtC _ _ _ ) = True+ isGadtCon (RecGadtC _ _ _) = True+ isGadtCon (ForallC _ _ x ) = isGadtCon x+ isGadtCon _ = False++ ksigDoc = case ksig of+ Nothing -> empty+ Just k -> dcolon <+> ppr k++ppr_newtype :: Doc -> Cxt -> Name -> Doc -> Maybe Kind -> Con -> Cxt -> Doc+ppr_newtype maybeInst ctxt t argsDoc ksig c decs = sep [text "newtype" <+> maybeInst <+> pprCxt ctxt- <+> ppr t <+> argsDoc,+ <+> ppr t <+> argsDoc <+> ksigDoc, nest 2 (char '=' <+> ppr c), if null decs then empty else nest nestDepth- $ text "deriving"- <+> parens (hsep $ punctuate comma $ map ppr decs)]+ $ text "deriving" <+> ppr_cxt_preds decs]+ where+ ksigDoc = case ksig of+ Nothing -> empty+ Just k -> dcolon <+> ppr k ppr_tySyn :: Doc -> Name -> Doc -> Type -> Doc ppr_tySyn maybeInst t argsDoc rhs = text "type" <+> maybeInst <+> ppr t <+> argsDoc <+> text "=" <+> ppr rhs +ppr_tf_head :: TypeFamilyHead -> Doc+ppr_tf_head (TypeFamilyHead tc tvs res inj)+ = ppr tc <+> hsep (map ppr tvs) <+> ppr res <+> maybeInj+ where+ maybeInj | (Just inj') <- inj = ppr inj'+ | otherwise = empty+ ------------------------------ instance Ppr FunDep where ppr (FunDep xs ys) = hsep (map ppr xs) <+> text "->" <+> hsep (map ppr ys) ppr_list [] = empty- ppr_list xs = char '|' <+> sep (punctuate (text ", ") (map ppr xs))+ ppr_list xs = char '|' <+> commaSep xs ------------------------------ instance Ppr FamFlavour where@@ -382,6 +418,17 @@ ppr TypeFam = text "type" ------------------------------+instance Ppr FamilyResultSig where+ ppr NoSig = empty+ ppr (KindSig k) = dcolon <+> ppr k+ ppr (TyVarSig bndr) = text "=" <+> ppr bndr++------------------------------+instance Ppr InjectivityAnn where+ ppr (InjectivityAnn lhs rhs) =+ char '|' <+> ppr lhs <+> text "->" <+> hsep (map ppr rhs)++------------------------------ instance Ppr Foreign where ppr (ImportF callconv safety impent as typ) = text "foreign import"@@ -389,13 +436,13 @@ <+> showtextl safety <+> text (show impent) <+> ppr as- <+> text "::" <+> ppr typ+ <+> dcolon <+> ppr typ ppr (ExportF callconv expent as typ) = text "foreign export" <+> showtextl callconv <+> text (show expent) <+> ppr as- <+> text "::" <+> ppr typ+ <+> dcolon <+> ppr typ ------------------------------ instance Ppr Pragma where@@ -410,7 +457,7 @@ = text "{-# SPECIALISE" <+> maybe empty ppr inline <+> ppr phases- <+> sep [ ppr n <+> text "::"+ <+> sep [ ppr n <+> dcolon , nest 2 $ ppr ty ] <+> text "#-}" ppr (SpecialiseInstP inst)@@ -451,7 +498,7 @@ ------------------------------ instance Ppr RuleBndr where ppr (RuleVar n) = ppr n- ppr (TypedRuleVar n ty) = parens $ ppr n <+> text "::" <+> ppr ty+ ppr (TypedRuleVar n ty) = parens $ ppr n <+> dcolon <+> ppr ty ------------------------------ instance Ppr Clause where@@ -460,26 +507,105 @@ ------------------------------ instance Ppr Con where- ppr (NormalC c sts) = ppr c <+> sep (map pprStrictType sts)+ ppr (NormalC c sts) = ppr c <+> sep (map pprBangType sts)+ ppr (RecC c vsts)- = ppr c <+> braces (sep (punctuate comma $ map pprVarStrictType vsts))- ppr (InfixC st1 c st2) = pprStrictType st1+ = ppr c <+> braces (sep (punctuate comma $ map pprVarBangType vsts))++ ppr (InfixC st1 c st2) = pprBangType st1 <+> pprName' Infix c- <+> pprStrictType st2- ppr (ForallC ns ctxt con) = text "forall" <+> hsep (map ppr ns)- <+> char '.' <+> sep [pprCxt ctxt, ppr con]+ <+> pprBangType st2 + ppr (ForallC ns ctxt (GadtC c sts ty))+ = commaSepApplied c <+> dcolon <+> pprForall ns ctxt+ <+> pprGadtRHS sts ty++ ppr (ForallC ns ctxt (RecGadtC c vsts ty))+ = commaSepApplied c <+> 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 (RecGadtC c vsts ty)+ = commaSepApplied c <+> dcolon <+> pprRecFields vsts ty++commaSepApplied :: [Name] -> Doc+commaSepApplied = commaSepWith (pprName' Applied)++pprForall :: [TyVarBndr] -> Cxt -> Doc+pprForall ns ctxt+ = text "forall" <+> hsep (map ppr ns)+ <+> char '.' <+> pprCxt ctxt++pprRecFields :: [(Name, Strict, Type)] -> Type -> Doc+pprRecFields vsts ty+ = braces (sep (punctuate comma $ map pprVarBangType vsts))+ <+> arrow <+> ppr ty++pprGadtRHS :: [(Strict, Type)] -> Type -> Doc+pprGadtRHS [] ty+ = ppr ty+pprGadtRHS sts ty+ = sep (punctuate (space <> arrow) (map pprBangType sts))+ <+> arrow <+> ppr ty+ -------------------------------pprVarStrictType :: (Name, Strict, Type) -> Doc+pprVarBangType :: VarBangType -> Doc -- Slight infelicity: with print non-atomic type with parens-pprVarStrictType (v, str, t) = ppr v <+> text "::" <+> pprStrictType (str, t)+pprVarBangType (v, bang, t) = ppr v <+> dcolon <+> pprBangType (bang, t) ------------------------------+pprBangType :: BangType -> Doc+-- Make sure we print+--+-- Con {-# UNPACK #-} a+--+-- rather than+--+-- Con {-# UNPACK #-}a+--+-- when there's no strictness annotation. If there is a strictness annotation,+-- it's okay to not put a space between it and the type.+pprBangType (bt@(Bang _ NoSourceStrictness), t) = ppr bt <+> pprParendType t+pprBangType (bt, t) = ppr bt <> pprParendType t++------------------------------+instance Ppr Bang where+ ppr (Bang su ss) = ppr su <+> ppr ss++------------------------------+instance Ppr SourceUnpackedness where+ ppr NoSourceUnpackedness = empty+ ppr SourceNoUnpack = text "{-# NOUNPACK #-}"+ ppr SourceUnpack = text "{-# UNPACK #-}"++------------------------------+instance Ppr SourceStrictness where+ ppr NoSourceStrictness = empty+ ppr SourceLazy = char '~'+ ppr SourceStrict = char '!'++------------------------------+instance Ppr DecidedStrictness where+ ppr DecidedLazy = empty+ ppr DecidedStrict = char '!'+ ppr DecidedUnpack = text "{-# UNPACK #-} !"++------------------------------+{-# DEPRECATED pprVarStrictType+ "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'pprVarBangType' instead." #-}+pprVarStrictType :: (Name, Strict, Type) -> Doc+pprVarStrictType = pprVarBangType++------------------------------+{-# DEPRECATED pprStrictType+ "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'pprBangType' instead." #-} pprStrictType :: (Strict, Type) -> Doc--- Prints with parens if not already atomic-pprStrictType (IsStrict, t) = char '!' <> pprParendType t-pprStrictType (NotStrict, t) = pprParendType t-pprStrictType (Unpacked, t) = text "{-# UNPACK #-} !" <> pprParendType t+pprStrictType = pprBangType ------------------------------ pprParendType :: Type -> Doc@@ -499,8 +625,19 @@ pprParendType StarT = char '*' pprParendType ConstraintT = text "Constraint" pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k)+pprParendType WildCardT = char '_'+pprParendType (InfixT x n y) = parens (ppr x <+> pprName' Infix n <+> ppr y)+pprParendType t@(UInfixT {}) = parens (pprUInfixT t)+pprParendType (ParensT t) = ppr t+pprParendType tuple | (TupleT n, args) <- split tuple+ , length args == n+ = parens (commaSep args) pprParendType other = parens (ppr other) +pprUInfixT :: Type -> Doc+pprUInfixT (UInfixT x n y) = pprUInfixT x <+> pprName' Infix n <+> pprUInfixT y+pprUInfixT t = ppr t+ instance Ppr Type where ppr (ForallT tvars ctxt ty) = text "forall" <+> hsep (map ppr tvars) <+> text "."@@ -517,16 +654,15 @@ 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]) = sep [pprFunArgType arg1 <+> text "~", ppr arg2] pprTyApp (ListT, [arg]) = brackets (ppr arg) pprTyApp (TupleT n, args)- | length args == n = parens (sep (punctuate comma (map ppr args)))+ | length args == n = parens (commaSep args) pprTyApp (PromotedTupleT n, args)- | length args == n = quoteParens (sep (punctuate comma (map ppr args)))+ | length args == n = quoteParens (commaSep args) pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendType args) pprFunArgType :: Type -> Doc -- Should really use a precedence argument@@ -551,7 +687,7 @@ ------------------------------ instance Ppr TyVarBndr where ppr (PlainTV nm) = ppr nm- ppr (KindedTV nm k) = parens (ppr nm <+> text "::" <+> ppr k)+ ppr (KindedTV nm k) = parens (ppr nm <+> dcolon <+> ppr k) instance Ppr Role where ppr NominalR = text "nominal"@@ -562,9 +698,13 @@ ------------------------------ pprCxt :: Cxt -> Doc pprCxt [] = empty-pprCxt [t] = ppr t <+> text "=>"-pprCxt ts = parens (sep $ punctuate comma $ map ppr ts) <+> text "=>"+pprCxt ts = ppr_cxt_preds ts <+> text "=>" +ppr_cxt_preds :: Cxt -> Doc+ppr_cxt_preds [] = empty+ppr_cxt_preds [t] = ppr t+ppr_cxt_preds ts = parens (commaSep ts)+ ------------------------------ instance Ppr Range where ppr = brackets . pprRange@@ -601,3 +741,18 @@ , parens $ int start_ln <> comma <> int start_col , text "-" , parens $ int end_ln <> comma <> int end_col ]++-- Takes a list of printable things and prints them separated by commas followed+-- by space.+commaSep :: Ppr a => [a] -> Doc+commaSep = commaSepWith ppr++-- Takes a list of things and prints them with the given pretty-printing+-- function, separated by commas followed by space.+commaSepWith :: (a -> Doc) -> [a] -> Doc+commaSepWith pprFun = sep . punctuate comma . map pprFun++-- Takes a list of printable things and prints them separated by semicolons+-- followed by space.+semiSep :: Ppr a => [a] -> Doc+semiSep = sep . punctuate semi . map ppr
Language/Haskell/TH/PprLib.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP, FlexibleInstances #-} -- | Monadic front-end to Text.PrettyPrint @@ -10,7 +10,7 @@ -- * Primitive Documents empty,- semi, comma, colon, space, equals, arrow,+ semi, comma, colon, dcolon, space, equals, arrow, lparen, rparen, lbrack, rbrack, lbrace, rbrace, -- * Converting values into documents@@ -21,13 +21,13 @@ parens, brackets, braces, quotes, doubleQuotes, -- * Combining documents- (<>), (<+>), hcat, hsep, - ($$), ($+$), vcat, - sep, cat, - fsep, fcat, + (<>), (<+>), hcat, hsep,+ ($$), ($+$), vcat,+ sep, cat,+ fsep, fcat, nest, hang, punctuate,- + -- * Predicates on documents isEmpty, @@ -41,6 +41,9 @@ 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 <+>@@ -60,6 +63,7 @@ semi :: Doc; -- ^ A ';' character comma :: Doc; -- ^ A ',' character colon :: Doc; -- ^ A ':' character+dcolon :: Doc; -- ^ A "::" string space :: Doc; -- ^ A space character equals :: Doc; -- ^ A '=' character arrow :: Doc; -- ^ A "->" string@@ -94,8 +98,8 @@ hsep :: [Doc] -> Doc; -- ^List version of '<+>' ($$) :: Doc -> Doc -> Doc; -- ^Above; if there is no- -- overlap it \"dovetails\" the two-($+$) :: Doc -> Doc -> Doc; -- ^Above, without dovetailing.+ -- overlap it \"dovetails\" the two+($+$) :: Doc -> Doc -> Doc; -- ^Above, without dovetailing. vcat :: [Doc] -> Doc; -- ^List version of '$$' cat :: [Doc] -> Doc; -- ^ Either hcat or vcat@@ -108,9 +112,9 @@ -- GHC-specific ones. -hang :: Doc -> Int -> Doc -> Doc; -- ^ @hang d1 n d2 = sep [d1, nest n d2]@-punctuate :: Doc -> [Doc] -> [Doc]; -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@-+hang :: Doc -> Int -> Doc -> Doc; -- ^ @hang d1 n d2 = sep [d1, nest n d2]@+punctuate :: Doc -> [Doc] -> [Doc]+ -- ^ @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@ -- --------------------------------------------------------------------------- -- The "implementation"@@ -150,11 +154,11 @@ fmap = liftM instance Applicative PprM where- pure = return+ pure x = PprM $ \s -> (x, s) (<*>) = ap instance Monad PprM where- return x = PprM $ \s -> (x, s)+ return = pure m >>= k = PprM $ \s -> let (x, s') = runPprM m s in runPprM (k x) s' @@ -168,6 +172,7 @@ semi = return HPJ.semi comma = return HPJ.comma colon = return HPJ.colon+dcolon = return $ HPJ.text "::" space = return HPJ.space equals = return HPJ.equals arrow = return $ HPJ.text "->"@@ -222,4 +227,3 @@ where go d' [] = [d'] go d' (e:es) = (d' <> p) : go e es-
Language/Haskell/TH/Quote.hs view
@@ -1,75 +1,44 @@ {-# LANGUAGE RankNTypes, ScopedTypeVariables #-}+{- |+Module : Language.Haskell.TH.Quote+Description : Quasi-quoting support for Template Haskell++Template Haskell supports quasiquoting, which permits users to construct+program fragments by directly writing concrete syntax. A quasiquoter is+essentially a function with takes a string to a Template Haskell AST.+This module defines the 'QuasiQuoter' datatype, which specifies a+quasiquoter @q@ which can be invoked using the syntax+@[q| ... string to parse ... |]@ when the @QuasiQuotes@ language+extension is enabled, and some utility functions for manipulating+quasiquoters. Nota bene: this package does not define any parsers,+that is up to you.+-} module Language.Haskell.TH.Quote( QuasiQuoter(..),- dataToQa, dataToExpQ, dataToPatQ,- quoteFile+ quoteFile,+ -- * For backwards compatibility+ dataToQa, dataToExpQ, dataToPatQ ) where -import Data.Data-import Language.Haskell.TH.Lib import Language.Haskell.TH.Syntax -data QuasiQuoter = QuasiQuoter { quoteExp :: String -> Q Exp,- quotePat :: String -> Q Pat,- quoteType :: String -> Q Type,- quoteDec :: String -> Q [Dec] }--dataToQa :: forall a k q. Data a- => (Name -> k)- -> (Lit -> Q q)- -> (k -> [Q q] -> Q q)- -> (forall b . Data b => b -> Maybe (Q q))- -> a- -> Q q-dataToQa mkCon mkLit appCon antiQ t =- case antiQ t of- Nothing ->- case constrRep constr of- AlgConstr _ ->- appCon (mkCon conName) conArgs- where- conName :: Name- conName =- case showConstr constr of- "(:)" -> Name (mkOccName ":") (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))- con@"[]" -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Types"))- con@('(':_) -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim") (mkModName "GHC.Tuple"))- con -> mkNameG_d (tyConPackage tycon)- (tyConModule tycon)- con- where- tycon :: TyCon- tycon = (typeRepTyCon . typeOf) t-- conArgs :: [Q q]- conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t- IntConstr n ->- mkLit $ integerL n- FloatConstr n ->- mkLit $ rationalL n- CharConstr c ->- mkLit $ charL c- where- constr :: Constr- constr = toConstr t-- Just y -> y---- | 'dataToExpQ' converts a value to a 'Q Exp' representation of the same--- value. It takes a function to handle type-specific cases.-dataToExpQ :: Data a- => (forall b . Data b => b -> Maybe (Q Exp))- -> a- -> Q Exp-dataToExpQ = dataToQa conE litE (foldl appE)---- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same--- value. It takes a function to handle type-specific cases.-dataToPatQ :: Data a- => (forall b . Data b => b -> Maybe (Q Pat))- -> a- -> Q Pat-dataToPatQ = dataToQa id litP conP+-- | The 'QuasiQuoter' type, a value @q@ of this type can be used+-- in the syntax @[q| ... string to parse ...|]@. In fact, for+-- convenience, a 'QuasiQuoter' actually defines multiple quasiquoters+-- to be used in different splice contexts; if you are only interested+-- in defining a quasiquoter to be used for expressions, you would+-- define a 'QuasiQuoter' with only 'quoteExp', and leave the other+-- fields stubbed out with errors.+data QuasiQuoter = QuasiQuoter {+ -- | Quasi-quoter for expressions, invoked by quotes like @lhs = $[q|...]@+ quoteExp :: String -> Q Exp,+ -- | Quasi-quoter for patterns, invoked by quotes like @f $[q|...] = rhs@+ quotePat :: String -> Q Pat,+ -- | Quasi-quoter for types, invoked by quotes like @f :: $[q|...]@+ quoteType :: String -> Q Type,+ -- | Quasi-quoter for declarations, invoked by top-level quotes+ quoteDec :: String -> Q [Dec]+ } -- | 'quoteFile' takes a 'QuasiQuoter' and lifts it into one that read -- the data out of a file. For example, suppose 'asmq' is an
Language/Haskell/TH/Syntax.hs view
@@ -1,6 +1,17 @@-{-# LANGUAGE CPP, DeriveDataTypeable, PolymorphicComponents,- RoleAnnotations, DeriveGeneric, FlexibleInstances #-}+{-# LANGUAGE CPP, DeriveDataTypeable,+ DeriveGeneric, FlexibleInstances, DefaultSignatures,+ RankNTypes, RoleAnnotations, ScopedTypeVariables #-} +{-# 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+ ----------------------------------------------------------------------------- -- | -- Module : Language.Haskell.Syntax@@ -15,9 +26,13 @@ -- ----------------------------------------------------------------------------- -module Language.Haskell.TH.Syntax where+module Language.Haskell.TH.Syntax+ ( module Language.Haskell.TH.Syntax+ -- * Language extensions+ , module Language.Haskell.TH.LanguageExtensions+ ) where -import Data.Data (Data(..), Typeable )+import Data.Data hiding (Fixity(..)) #if __GLASGOW_HASKELL__ < 709 import Control.Applicative( Applicative(..) ) #endif@@ -29,16 +44,29 @@ import Data.Int import Data.Word import Data.Ratio-import Numeric.Natural import GHC.Generics ( Generic )+import GHC.Lexeme ( startsVarSym, startsVarId )+import Language.Haskell.TH.LanguageExtensions +#ifdef HAS_NATURAL+import Numeric.Natural+#endif++#if HAS_MONADFAIL+import qualified Control.Monad.Fail as Fail+#endif+ ----------------------------------------------------- -- -- The Quasi class -- ----------------------------------------------------- -class Monad m => Quasi m where+#if HAS_MONADFAIL+class Fail.MonadFail m => Quasi m where+#else+class (Applicative m, Monad m) => Quasi m where+#endif qNewName :: String -> m Name -- ^ Fresh names @@ -53,14 +81,16 @@ qLookupName :: Bool -> String -> m (Maybe Name) -- True <=> type namespace, False <=> value namespace qReify :: Name -> m Info+ qReifyFixity :: Name -> m (Maybe Fixity) qReifyInstances :: Name -> [Type] -> m [Dec] -- Is (n tys) an instance? -- Returns list of matching instance Decs -- (with empty sub-Decs) -- Works for classes and type functions- qReifyRoles :: Name -> m [Role]- qReifyAnnotations :: Data a => AnnLookup -> m [a]- qReifyModule :: Module -> m ModuleInfo+ qReifyRoles :: Name -> m [Role]+ qReifyAnnotations :: Data a => AnnLookup -> m [a]+ qReifyModule :: Module -> m ModuleInfo+ qReifyConStrictness :: Name -> m [DecidedStrictness] qLocation :: m Loc @@ -77,6 +107,9 @@ qPutQ :: Typeable a => a -> m () + qIsExtEnabled :: Extension -> m Bool+ qExtsEnabled :: m [Extension]+ ----------------------------------------------------- -- The IO instance of Quasi --@@ -96,19 +129,23 @@ qReport True msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) qReport False msg = hPutStrLn stderr ("Template Haskell error: " ++ msg) - qLookupName _ _ = badIO "lookupName"- qReify _ = badIO "reify"- qReifyInstances _ _ = badIO "reifyInstances"- qReifyRoles _ = badIO "reifyRoles"- qReifyAnnotations _ = badIO "reifyAnnotations"- qReifyModule _ = badIO "reifyModule"- qLocation = badIO "currentLocation"- qRecover _ _ = badIO "recover" -- Maybe we could fix this?- qAddDependentFile _ = badIO "addDependentFile"- qAddTopDecls _ = badIO "addTopDecls"- qAddModFinalizer _ = badIO "addModFinalizer"- qGetQ = badIO "getQ"- qPutQ _ = badIO "putQ"+ qLookupName _ _ = badIO "lookupName"+ qReify _ = badIO "reify"+ qReifyFixity _ = badIO "reifyFixity"+ qReifyInstances _ _ = badIO "reifyInstances"+ qReifyRoles _ = badIO "reifyRoles"+ qReifyAnnotations _ = badIO "reifyAnnotations"+ qReifyModule _ = badIO "reifyModule"+ qReifyConStrictness _ = badIO "reifyConStrictness"+ qLocation = badIO "currentLocation"+ qRecover _ _ = badIO "recover" -- Maybe we could fix this?+ qAddDependentFile _ = badIO "addDependentFile"+ qAddTopDecls _ = badIO "addTopDecls"+ qAddModFinalizer _ = badIO "addModFinalizer"+ qGetQ = badIO "getQ"+ qPutQ _ = badIO "putQ"+ qIsExtEnabled _ = badIO "isExtEnabled"+ qExtsEnabled = badIO "extsEnabled" qRunIO m = m @@ -145,17 +182,27 @@ runQ (Q m) = m instance Monad Q where- return x = Q (return x) Q m >>= k = Q (m >>= \x -> unQ (k x))- Q m >> Q n = Q (m >> n)+ (>>) = (*>)++ return = pure++#if !HAS_MONADFAIL fail s = report True s >> Q (fail "Q monad failure")+#else+ fail = Fail.fail +instance Fail.MonadFail Q where+ fail s = report True s >> Q (Fail.fail "Q monad failure")+#endif+ instance Functor Q where fmap f (Q x) = Q (fmap f x) instance Applicative Q where pure x = Q (pure x) Q f <*> Q x = Q (f <*> x)+ Q m *> Q n = Q (m *> n) ----------------------------------------------------- --@@ -332,6 +379,15 @@ reify :: Name -> Q Info reify v = Q (qReify v) +{- | @reifyFixity nm@ attempts to find a fixity declaration for @nm@. For+example, if the function @foo@ has the fixity declaration @infixr 7 foo@, then+@reifyFixity 'foo@ would return @'Just' ('Fixity' 7 'InfixR')@. If the function+@bar@ does not have a fixity declaration, then @reifyFixity 'bar@ returns+'Nothing', so you may assume @bar@ has 'defaultFixity'.+-}+reifyFixity :: Name -> Q (Maybe Fixity)+reifyFixity nm = Q (qReifyFixity nm)+ {- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is, 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,@@ -360,6 +416,21 @@ reifyModule :: Module -> Q ModuleInfo reifyModule m = Q (qReifyModule m) +-- | @reifyConStrictness nm@ looks up the strictness information for the fields+-- of the constructor with the name @nm@. Note that the strictness information+-- that 'reifyConStrictness' returns may not correspond to what is written in+-- the source code. For example, in the following data declaration:+--+-- @+-- data Pair a = Pair a a+-- @+--+-- 'reifyConStrictness' would return @['DecidedLazy', DecidedLazy]@ under most+-- circumstances, but it would return @['DecidedStrict', DecidedStrict]@ if the+-- @-XStrictData@ language extension was enabled.+reifyConStrictness :: Name -> Q [DecidedStrictness]+reifyConStrictness n = Q (qReifyConStrictness n)+ -- | Is the list of instances returned by 'reifyInstances' nonempty? isInstance :: Name -> [Type] -> Q Bool isInstance nm tys = do { decs <- reifyInstances nm tys@@ -403,31 +474,43 @@ addModFinalizer :: Q () -> Q () addModFinalizer act = Q (qAddModFinalizer (unQ act)) --- | Get state from the Q monad.+-- | Get state from the 'Q' monad. getQ :: Typeable a => Q (Maybe a) getQ = Q qGetQ --- | Replace the state in the Q monad.+-- | Replace the state in the 'Q' monad. putQ :: Typeable a => a -> Q () putQ x = Q (qPutQ x) +-- | Determine whether the given language extension is enabled in the 'Q' monad.+isExtEnabled :: Extension -> Q Bool+isExtEnabled ext = Q (qIsExtEnabled ext)++-- | List all enabled language extensions.+extsEnabled :: Q [Extension]+extsEnabled = Q qExtsEnabled+ instance Quasi Q where- qNewName = newName- qReport = report- qRecover = recover- qReify = reify- qReifyInstances = reifyInstances- qReifyRoles = reifyRoles- qReifyAnnotations = reifyAnnotations- qReifyModule = reifyModule- qLookupName = lookupName- qLocation = location- qRunIO = runIO- qAddDependentFile = addDependentFile- qAddTopDecls = addTopDecls- qAddModFinalizer = addModFinalizer- qGetQ = getQ- qPutQ = putQ+ qNewName = newName+ qReport = report+ qRecover = recover+ qReify = reify+ qReifyFixity = reifyFixity+ qReifyInstances = reifyInstances+ qReifyRoles = reifyRoles+ qReifyAnnotations = reifyAnnotations+ qReifyModule = reifyModule+ qReifyConStrictness = reifyConStrictness+ qLookupName = lookupName+ qLocation = location+ qRunIO = runIO+ qAddDependentFile = addDependentFile+ qAddTopDecls = addTopDecls+ qAddModFinalizer = addModFinalizer+ qGetQ = getQ+ qPutQ = putQ+ qIsExtEnabled = isExtEnabled+ qExtsEnabled = extsEnabled ----------------------------------------------------@@ -450,8 +533,33 @@ -- ----------------------------------------------------- +-- | A 'Lift' instance can have any of its values turned into a Template+-- Haskell expression. This is needed when a value used within a Template+-- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@) but not+-- at the top level. As an example:+--+-- > add1 :: Int -> Q Exp+-- > add1 x = [| x + 1 |]+--+-- Template Haskell has no way of knowing what value @x@ will take on at+-- splice-time, so it requires the type of @x@ to be an instance of 'Lift'.+--+-- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@+-- GHC language extension:+--+-- > {-# LANGUAGE DeriveLift #-}+-- > module Foo where+-- >+-- > import Language.Haskell.TH.Syntax+-- >+-- > data Bar a = Bar1 a (Bar a) | Bar2 String+-- > deriving Lift class Lift t where+ -- | Turn a value into a Template Haskell expression, suitable for use in+ -- a splice. lift :: t -> Q Exp+ default lift :: Data t => t -> Q Exp+ lift = liftData -- If you add any instances here, consider updating test th/TH_Lift instance Lift Integer where@@ -487,8 +595,10 @@ 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)))@@ -572,7 +682,124 @@ leftName = mkNameG DataName "base" "Data.Either" "Left" rightName = mkNameG DataName "base" "Data.Either" "Right" +-----------------------------------------------------+--+-- Generic Lift implementations+--+----------------------------------------------------- +-- | 'dataToQa' is an internal utility function for constructing generic+-- conversion functions from types with 'Data' instances to various+-- quasi-quoting representations. See the source of 'dataToExpQ' and+-- 'dataToPatQ' for two example usages: @mkCon@, @mkLit@+-- and @appQ@ are overloadable to account for different syntax for+-- expressions and patterns; @antiQ@ allows you to override type-specific+-- cases, a common usage is just @const Nothing@, which results in+-- no overloading.+dataToQa :: forall a k q. Data a+ => (Name -> k)+ -> (Lit -> Q q)+ -> (k -> [Q q] -> Q q)+ -> (forall b . Data b => b -> Maybe (Q q))+ -> a+ -> Q q+dataToQa mkCon mkLit appCon antiQ t =+ case antiQ t of+ Nothing ->+ case constrRep constr of+ AlgConstr _ ->+ appCon (mkCon funOrConName) conArgs+ where+ funOrConName :: Name+ funOrConName =+ case showConstr constr of+ "(:)" -> Name (mkOccName ":")+ (NameG DataName+ (mkPkgName "ghc-prim")+ (mkModName "GHC.Types"))+ con@"[]" -> Name (mkOccName con)+ (NameG DataName+ (mkPkgName "ghc-prim")+ (mkModName "GHC.Types"))+ con@('(':_) -> Name (mkOccName con)+ (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.+ fun@(x:_) | startsVarSym x || startsVarId x+ -> mkNameG_v tyconPkg tyconMod fun+ con -> mkNameG_d tyconPkg tyconMod con+ where+ tycon :: TyCon+ tycon = (typeRepTyCon . typeOf) t++ tyconPkg, tyconMod :: String+ tyconPkg = tyConPackage tycon+ tyconMod = tyConModule tycon++ conArgs :: [Q q]+ conArgs = gmapQ (dataToQa mkCon mkLit appCon antiQ) t+ IntConstr n ->+ mkLit $ IntegerL n+ FloatConstr n ->+ mkLit $ RationalL n+ CharConstr c ->+ mkLit $ CharL c+ where+ constr :: Constr+ constr = toConstr t++ Just y -> y++-- | '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+-- used variant.+dataToExpQ :: Data a+ => (forall b . Data b => b -> Maybe (Q Exp))+ -> a+ -> Q Exp+dataToExpQ = dataToQa varOrConE litE (foldl appE)+ where+ -- Make sure that VarE is used if the Constr value relies on a+ -- function underneath the surface (instead of a constructor).+ -- See Trac #10796.+ varOrConE s =+ case nameSpace s of+ Just VarName -> return (VarE s)+ Just DataName -> return (ConE s)+ _ -> fail $ "Can't construct an expression from name "+ ++ showName s+ appE x y = do { a <- x; b <- y; return (AppE a b)}+ litE c = return (LitE c)++-- | 'liftData' is a variant of 'lift' in the 'Lift' type class which+-- works for any type with a 'Data' instance.+liftData :: Data a => a -> Q Exp+liftData = dataToExpQ (const Nothing)++-- | 'dataToPatQ' converts a value to a 'Q Pat' representation of the same+-- value, in the SYB style. It takes a function to handle type-specific cases,+-- alternatively, pass @const Nothing@ to get default behavior.+dataToPatQ :: Data a+ => (forall b . Data b => b -> Maybe (Q Pat))+ -> a+ -> Q Pat+dataToPatQ = dataToQa id litP conP+ where litP l = return (LitP l)+ conP n ps =+ case nameSpace n of+ Just DataName -> do+ ps' <- sequence ps+ return (ConP n ps')+ _ -> fail $ "Can't construct a pattern from name "+ ++ showName n+ ----------------------------------------------------- -- Names and uniques -----------------------------------------------------@@ -715,26 +942,78 @@ -- An original name (occurrences only, not binders) -- Need the namespace too to be sure which -- thing we are naming- deriving ( Typeable, Data, Eq, Ord, Generic )+ deriving ( Typeable, 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, Data, Typeable, Generic )+ deriving( Eq, Ord, Show, Data, Typeable, Generic ) type Uniq = Int --- | The name without its module prefix+-- | The name without its module prefix.+--+-- ==== __Examples__+--+-- >>> nameBase ''Data.Either.Either+-- "Either"+-- >>> nameBase (mkName "foo")+-- "foo"+-- >>> nameBase (mkName "Module.foo")+-- "foo" nameBase :: Name -> String nameBase (Name occ _) = occString occ --- | Module prefix of a name, if it exists+-- | Module prefix of a name, if it exists.+--+-- ==== __Examples__+--+-- >>> nameModule ''Data.Either.Either+-- Just "Data.Either"+-- >>> nameModule (mkName "foo")+-- Nothing+-- >>> nameModule (mkName "Module.foo")+-- Just "Module" nameModule :: Name -> Maybe String nameModule (Name _ (NameQ m)) = Just (modString m) nameModule (Name _ (NameG _ _ m)) = Just (modString m) nameModule _ = Nothing +-- | A name's package, if it exists.+--+-- ==== __Examples__+--+-- >>> namePackage ''Data.Either.Either+-- Just "base"+-- >>> namePackage (mkName "foo")+-- Nothing+-- >>> namePackage (mkName "Module.foo")+-- Nothing+namePackage :: Name -> Maybe String+namePackage (Name _ (NameG _ p _)) = Just (pkgString p)+namePackage _ = Nothing++-- | Returns whether a name represents an occurrence of a top-level variable+-- ('VarName'), data constructor ('DataName'), type constructor, or type class+-- ('TcClsName'). If we can't be sure, it returns 'Nothing'.+--+-- ==== __Examples__+--+-- >>> nameSpace 'Prelude.id+-- Just VarName+-- >>> nameSpace (mkName "id")+-- Nothing -- only works for top-level variable names+-- >>> nameSpace 'Data.Maybe.Just+-- Just DataName+-- >>> nameSpace ''Data.Maybe.Maybe+-- Just TcClsName+-- >>> nameSpace ''Data.Ord.Ord+-- Just TcClsName+nameSpace :: Name -> Maybe NameSpace+nameSpace (Name _ (NameG ns _ _)) = Just ns+nameSpace _ = Nothing+ {- | Generate a capturable name. Occurrences of such names will be resolved according to the Haskell scoping rules at the occurrence@@ -815,6 +1094,9 @@ mkNameG ns pkg modu occ = Name (mkOccName occ) (NameG ns (mkPkgName pkg) (mkModName modu)) +mkNameS :: String -> Name+mkNameS n = Name (mkOccName n) NameS+ mkNameG_v, mkNameG_tc, mkNameG_d :: String -> String -> String -> Name mkNameG_v = mkNameG VarName mkNameG_tc = mkNameG TcClsName@@ -941,7 +1223,6 @@ Name Type ParentName- Fixity -- | A \"plain\" type constructor. \"Fancier\" type constructors are returned using 'PrimTyConI' or 'FamilyI' as appropriate | TyConI@@ -964,7 +1245,6 @@ Name Type ParentName- Fixity {- | A \"value\" variable (as opposed to a type variable, see 'TyVarI').@@ -980,7 +1260,6 @@ Name Type (Maybe Dec)- Fixity {- | A type variable.@@ -1049,10 +1328,9 @@ @+@ and @*@, we don't know whether to parse it as @a + (b * c)@ or @(a + b) * c@. -In cases like this, use 'UInfixE' or 'UInfixP', which stand for-\"unresolved infix expression\" and \"unresolved infix pattern\". When-the compiler is given a splice containing a tree of @UInfixE@-applications such as+In cases like this, use 'UInfixE', 'UInfixP', or 'UInfixT', which stand for+\"unresolved infix expression/pattern/type\", respectively. When the compiler+is given a splice containing a tree of @UInfixE@ applications such as > UInfixE > (UInfixE e1 op1 e2)@@ -1062,12 +1340,12 @@ it will look up and the fixities of the relevant operators and reassociate the tree as necessary. - * trees will not be reassociated across 'ParensE' or 'ParensP',+ * trees will not be reassociated across 'ParensE', 'ParensP', or 'ParensT', which are of use for parsing expressions like > (a + b * c) + d * e - * 'InfixE' and 'InfixP' expressions are never reassociated.+ * 'InfixE', 'InfixP', and 'InfixT' expressions are never reassociated. * The 'UInfixE' constructor doesn't support sections. Sections such as @(a *)@ have no ambiguity, so 'InfixE' suffices. For longer@@ -1092,9 +1370,10 @@ > [| a * b + c |] :: Q Exp > [p| a : b : c |] :: Q Pat+ > [t| T + T |] :: Q Type - will never contain 'UInfixE', 'UInfixP', 'ParensE', or 'ParensP'- constructors.+ will never contain 'UInfixE', 'UInfixP', 'UInfixT', 'InfixT', 'ParensE',+ 'ParensP', or 'ParensT' constructors. -} @@ -1116,18 +1395,19 @@ | FloatPrimL Rational | DoublePrimL Rational | StringPrimL [Word8] -- ^ A primitive C-style string, type Addr#+ | CharPrimL Char deriving( Show, Eq, Ord, Data, Typeable, Generic ) -- We could add Int, Float, Double etc, as we do in HsLit, -- but that could complicate the- -- suppposedly-simple TH.Syntax literal type+ -- supposedly-simple TH.Syntax literal type -- | Pattern in Haskell given in @{}@ data Pat- = LitP Lit -- ^ @{ 5 or 'c' }@+ = LitP Lit -- ^ @{ 5 or \'c\' }@ | VarP Name -- ^ @{ x }@ | TupP [Pat] -- ^ @{ (p1,p2) }@- | UnboxedTupP [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@@@ -1157,7 +1437,7 @@ data Exp = VarE Name -- ^ @{ x }@ | ConE Name -- ^ @data T1 = C1 t1 t2; p = {C1} e1 e2 @- | LitE Lit -- ^ @{ 5 or 'c'}@+ | LitE Lit -- ^ @{ 5 or \'c\'}@ | AppE Exp Exp -- ^ @{ f x }@ | InfixE (Maybe Exp) Exp (Maybe Exp) -- ^ @{x + y} or {(x+)} or {(+ x)} or {(+)}@@@ -1174,10 +1454,10 @@ | ParensE Exp -- ^ @{ (e) }@ -- -- See "Language.Haskell.TH.Syntax#infix"- | LamE [Pat] Exp -- ^ @{ \ p1 p2 -> e }@- | LamCaseE [Match] -- ^ @{ \case m1; m2 }@+ | LamE [Pat] Exp -- ^ @{ \\ p1 p2 -> e }@+ | LamCaseE [Match] -- ^ @{ \\case m1; m2 }@ | TupE [Exp] -- ^ @{ (e1,e2) } @- | UnboxedTupE [Exp] -- ^ @{ (# e1,e2 #) } @+ | UnboxedTupE [Exp] -- ^ @{ (\# e1,e2 \#) } @ | 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 }@@@ -1200,6 +1480,7 @@ | RecConE Name [FieldExp] -- ^ @{ T { x = y, z = w } }@ | RecUpdE Exp [FieldExp] -- ^ @{ (f x) { z = w } }@ | StaticE Exp -- ^ @{ static e }@+ | UnboundVarE Name -- ^ @{ _x }@ (hole) deriving( Show, Eq, Ord, Data, Typeable, Generic ) type FieldExp = (Name,Exp)@@ -1233,16 +1514,20 @@ = FunD Name [Clause] -- ^ @{ f p1 p2 = b where decs }@ | ValD Pat Body [Dec] -- ^ @{ p = b where decs }@ | DataD Cxt Name [TyVarBndr]- [Con] [Name] -- ^ @{ data Cxt x => T x = A x | B (T x)+ (Maybe Kind) -- Kind signature (allowed only for GADTs)+ [Con] Cxt+ -- ^ @{ data Cxt x => T x = A x | B (T x) -- deriving (Z,W)}@ | NewtypeD Cxt Name [TyVarBndr]- Con [Name] -- ^ @{ newtype Cxt x => T x = A (B x)- -- deriving (Z,W)}@+ (Maybe Kind) -- Kind signature+ Con Cxt -- ^ @{ newtype Cxt x => T x = A (B x)+ -- deriving (Z,W Q)}@ | TySynD Name [TyVarBndr] Type -- ^ @{ type T x = (x,x) }@ | ClassD Cxt Name [TyVarBndr] [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@- | InstanceD Cxt Type [Dec] -- ^ @{ instance Show w => Show [w]- -- where ds }@+ | InstanceD (Maybe Overlap) Cxt Type [Dec]+ -- ^ @{ instance {\-\# OVERLAPS \#-\}+ -- Show w => Show [w] where ds }@ | SigD Name Type -- ^ @{ length :: [a] -> Int }@ | ForeignD Foreign -- ^ @{ foreign import ... } --{ foreign export ... }@@@ -1250,30 +1535,54 @@ | InfixD Fixity Name -- ^ @{ infix 3 foo }@ -- | pragmas- | PragmaD Pragma -- ^ @{ {\-# INLINE [1] foo #-\} }@+ | PragmaD Pragma -- ^ @{ {\-\# INLINE [1] foo \#-\} }@ - -- | type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')- | FamilyD FamFlavour Name- [TyVarBndr] (Maybe Kind) -- ^ @{ type family T a b c :: * }@+ -- | data families (may also appear in [Dec] of 'ClassD' and 'InstanceD')+ | DataFamilyD Name [TyVarBndr]+ (Maybe Kind)+ -- ^ @{ data family T a b c :: * }@ | DataInstD Cxt Name [Type]- [Con] [Name] -- ^ @{ data instance Cxt x => T [x] = A x- -- | B (T x)- -- deriving (Z,W)}@+ (Maybe Kind) -- Kind signature+ [Con] Cxt -- ^ @{ data instance Cxt x => T [x]+ -- = A x | B (T x) deriving (Z,W)}@+ | NewtypeInstD Cxt Name [Type]- Con [Name] -- ^ @{ newtype instance Cxt x => T [x] = A (B x)- -- deriving (Z,W)}@+ (Maybe Kind) -- Kind signature+ Con Cxt -- ^ @{ newtype instance Cxt x => T [x]+ -- = A (B x) deriving (Z,W)}@ | TySynInstD Name TySynEqn -- ^ @{ type instance ... }@ - | ClosedTypeFamilyD Name- [TyVarBndr] (Maybe Kind)- [TySynEqn] -- ^ @{ type family F a b :: * where ... }@+ -- | open type families (may also appear in [Dec] of 'ClassD' and 'InstanceD')+ | OpenTypeFamilyD TypeFamilyHead+ -- ^ @{ type family T a b c = (r :: *) | r -> a b }@ + | 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 ) +-- | Varieties of allowed instance overlap.+data Overlap = Overlappable -- ^ May be overlapped by more specific instances+ | Overlapping -- ^ May overlap a more general instance+ | Overlaps -- ^ Both 'Overlapping' and 'Overlappable'+ | Incoherent -- ^ Both 'Overlappable' and 'Overlappable', and+ -- pick an arbitrary one if multiple choices are+ -- available.+ deriving( Show, Eq, Ord, Data, Typeable, Generic )++-- | Common elements of 'OpenTypeFamilyD' and 'ClosedTypeFamilyD'.+-- By analogy with 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@.+data TypeFamilyHead =+ TypeFamilyHead Name [TyVarBndr] FamilyResultSig (Maybe InjectivityAnn)+ deriving( Show, Eq, Ord, Data, Typeable, 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.@@ -1335,28 +1644,99 @@ -- be tuples of other constraints. type Pred = Type -data Strict = IsStrict | NotStrict | Unpacked- deriving( Show, Eq, Ord, Data, Typeable, Generic )+data SourceUnpackedness+ = NoSourceUnpackedness -- ^ @C a@+ | SourceNoUnpack -- ^ @C { {\-\# NOUNPACK \#-\} } a@+ | SourceUnpack -- ^ @C { {\-\# UNPACK \#-\} } a@+ deriving (Show, Eq, Ord, Data, Typeable, Generic) -data Con = NormalC Name [StrictType] -- ^ @C Int a@- | RecC Name [VarStrictType] -- ^ @C { v :: Int, w :: a }@- | InfixC StrictType Name StrictType -- ^ @Int :+ a@- | ForallC [TyVarBndr] Cxt Con -- ^ @forall a. Eq a => C [a]@- deriving( Show, Eq, Ord, Data, Typeable, Generic )+data SourceStrictness = NoSourceStrictness -- ^ @C a@+ | SourceLazy -- ^ @C {~}a@+ | SourceStrict -- ^ @C {!}a@+ deriving (Show, Eq, Ord, Data, Typeable, Generic) -type StrictType = (Strict, Type)-type VarStrictType = (Name, Strict, Type)+-- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness'+-- refers to the strictness that the compiler chooses for a data constructor+-- field, which may be different from what is written in source code. See+-- 'reifyConStrictness' for more information.+data DecidedStrictness = DecidedLazy+ | DecidedStrict+ | DecidedUnpack+ deriving (Show, Eq, Ord, Data, Typeable, Generic) +data Con = NormalC Name [BangType] -- ^ @C Int a@+ | RecC Name [VarBangType] -- ^ @C { v :: Int, w :: a }@+ | InfixC BangType Name BangType -- ^ @Int :+ a@+ | ForallC [TyVarBndr] 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@+ deriving (Show, Eq, Ord, Data, Typeable, Generic)++-- Note [GADT return type]+-- ~~~~~~~~~~~~~~~~~~~~~~~+--+-- The return type of a GADT constructor does not necessarily match the name of+-- the data type:+--+-- type S = T+--+-- data T a where+-- MkT :: S Int+--+--+-- type S a = T+--+-- data T a where+-- MkT :: S Char Int+--+--+-- type Id a = a+-- type S a = T+--+-- data T a where+-- MkT :: Id (S Char Int)+--+--+-- That is why we allow the return type stored by a constructor to be an+-- arbitrary type. See also #11341++data Bang = Bang SourceUnpackedness SourceStrictness+ -- ^ @C { {\-\# UNPACK \#-\} !}a@+ deriving (Show, Eq, Ord, Data, Typeable, Generic)++type BangType = (Bang, Type)+type VarBangType = (Name, Bang, Type)++-- | As of @template-haskell-2.11.0.0@, 'Strict' has been replaced by 'Bang'.+type Strict = Bang++-- | As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by+-- 'BangType'.+type StrictType = BangType++-- | As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by+-- 'VarBangType'.+type VarStrictType = VarBangType+ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<type\>@ | AppT Type Type -- ^ @T a b@ | SigT Type Kind -- ^ @t :: k@ | VarT Name -- ^ @a@ | ConT Name -- ^ @T@ | PromotedT Name -- ^ @'T@+ | InfixT Type Name Type -- ^ @T + T@+ | UInfixT Type Name Type -- ^ @T + T@+ --+ -- See "Language.Haskell.TH.Syntax#infix"+ | ParensT Type -- ^ @(T)@ -- See Note [Representing concrete syntax in types] | TupleT Int -- ^ @(,), (,,), etc.@- | UnboxedTupleT Int -- ^ @(#,#), (#,,#), etc.@+ | UnboxedTupleT Int -- ^ @(\#,\#), (\#,,\#), etc.@ | ArrowT -- ^ @->@ | EqualityT -- ^ @~@ | ListT -- ^ @[]@@@ -1366,11 +1746,22 @@ | StarT -- ^ @*@ | ConstraintT -- ^ @Constraint@ | LitT TyLit -- ^ @0,1,2, etc.@+ | WildCardT -- ^ @_, deriving( Show, Eq, Ord, Data, Typeable, Generic ) data TyVarBndr = PlainTV Name -- ^ @a@ | KindedTV Name Kind -- ^ @(a :: k)@ deriving( Show, Eq, Ord, Data, Typeable, 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 )++-- | Injectivity annotation+data InjectivityAnn = InjectivityAnn Name [Name]+ deriving ( Show, Eq, Ord, Data, Typeable, Generic ) data TyLit = NumTyLit Integer -- ^ @2@ | StrTyLit String -- ^ @"Hello"@
changelog.md view
@@ -1,5 +1,55 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.11.0.0 *TBA*++ * Bundled with GHC 8.0.1++ * The compiler can now resolve infix operator fixities in types on its own.+ The `UInfixT` constructor of `Type` is analoguous to `UInfixE` for expressions+ and can contain a tree of infix type applications which will be reassociated+ according to the fixities of the operators. The `ParensT` constructor can be+ used to explicitly group expressions.++ * Add `namePackage` and `nameSpace`++ * Make `dataToQa` and `dataToExpQ` able to handle `Data` instances whose+ `toConstr` implementation relies on a function instead of a data+ constructor (#10796)++ * Add `Show` instances for `NameFlavour` and `NameSpace`++ * Remove `FamilyD` and `FamFlavour`. Add `DataFamilyD` and `OpenTypeFamilyD`+ as the representation of data families and open type families+ respectively. (#6018)++ * Add `TypeFamilyHead` for common elements of `OpenTypeFamilyD` and+ `ClosedTypeFamilyD` (#10902)++ * The `Strict` datatype was split among different datatypes: three for+ writing the strictness information of data constructors' fields as denoted+ 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)++ * Add `reifyConStrictness` to query a data constructor's `DecidedStrictness`+ values for its fields (#10697)++ * The `ClassOpI`, `DataConI`, and `VarI` constructors no longer have a+ `Fixity` field. Instead, all `Fixity` information for a given `Name` is+ now determined through the `reifyFixity` function, which returns `Just` the+ fixity if there is an explicit fixity declaration for that `Name`, and+ `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++ ## 2.10.0.0 *Mar 2015* * Bundled with GHC 7.10.1
template-haskell.cabal view
@@ -1,5 +1,5 @@ name: template-haskell-version: 2.10.0.0+version: 2.11.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE@@ -26,15 +26,15 @@ Library default-language: Haskell2010 other-extensions:+ BangPatterns+ CPP+ DefaultSignatures DeriveDataTypeable+ DeriveGeneric FlexibleInstances- MagicHash- PolymorphicComponents RankNTypes RoleAnnotations ScopedTypeVariables- TemplateHaskell- UnboxedTuples exposed-modules: Language.Haskell.TH@@ -43,14 +43,24 @@ Language.Haskell.TH.PprLib Language.Haskell.TH.Quote Language.Haskell.TH.Syntax+ Language.Haskell.TH.LanguageExtensions other-modules: Language.Haskell.TH.Lib.Map build-depends:- base == 4.8.*,- pretty == 1.1.*+ base >= 4.7 && < 4.10,+ ghc-boot-th == 8.0.*,+ pretty == 1.1.* - -- We need to set the package key to template-haskell (without a+ -- We need to set the unit ID to template-haskell (without a -- version number) as it's magic.- ghc-options: -Wall -this-package-key template-haskell+ ghc-options: -Wall++ if impl( ghc >= 7.11 )+ ghc-options: -this-unit-id template-haskell+ else+ if impl( ghc >= 7.9 )+ ghc-options: -this-package-key template-haskell+ else+ ghc-options: -package-name template-haskell