template-haskell 2.19.0.0 → 2.20.0.0
raw patch · 9 files changed
+215/−139 lines, 9 filesdep −filepathdep ~basedep ~ghc-boot-th
Dependencies removed: filepath
Dependency ranges changed: base, ghc-boot-th
Files
- Language/Haskell/TH.hs +1/−1
- Language/Haskell/TH/Lib.hs +13/−5
- Language/Haskell/TH/Lib/Internal.hs +25/−2
- Language/Haskell/TH/Ppr.hs +90/−77
- Language/Haskell/TH/Syntax.hs +64/−23
- changelog.md +8/−0
- template-haskell.cabal +10/−27
- vendored-filepath/System/FilePath/Posix.hs +2/−2
- vendored-filepath/System/FilePath/Windows.hs +2/−2
Language/Haskell/TH.hs view
@@ -1,7 +1,7 @@ {- | The public face of Template Haskell For other documentation, refer to:-<http://www.haskell.org/haskellwiki/Template_Haskell>+<https://wiki.haskell.org/Template_Haskell> -} {-# LANGUAGE Safe #-}
Language/Haskell/TH/Lib.hs view
@@ -86,7 +86,7 @@ -- *** Top Level Declarations -- **** Data- valD, funD, tySynD, dataD, newtypeD,+ valD, funD, tySynD, dataD, newtypeD, typeDataD, derivClause, DerivClause(..), stockStrategy, anyclassStrategy, newtypeStrategy, viaStrategy, DerivStrategy(..),@@ -131,8 +131,8 @@ thisModule, -- ** Documentation- withDecDoc, withDecsDoc, funD_doc, dataD_doc, newtypeD_doc, dataInstD_doc,- newtypeInstD_doc, patSynD_doc+ withDecDoc, withDecsDoc, funD_doc, dataD_doc, newtypeD_doc,+ typeDataD_doc, dataInstD_doc, newtypeInstD_doc, patSynD_doc ) where @@ -140,6 +140,7 @@ ( tySynD , dataD , newtypeD+ , typeDataD , classD , pragRuleD , dataInstD@@ -178,10 +179,10 @@ import qualified Language.Haskell.TH.Lib.Internal as Internal import Language.Haskell.TH.Syntax -import Control.Applicative ( liftA2 )+import Control.Applicative (Applicative(..)) import Foreign.ForeignPtr import Data.Word-import Prelude+import Prelude hiding (Applicative(..)) -- All definitions below represent the "old" API, since their definitions are -- different in Language.Haskell.TH.Lib.Internal. Please think carefully before@@ -211,6 +212,13 @@ con1 <- con derivs1 <- sequenceA derivs return (NewtypeD ctxt1 tc tvs ksig con1 derivs1)++typeDataD :: Quote m => Name -> [TyVarBndr ()] -> Maybe Kind -> [m Con]+ -> m Dec+typeDataD tc tvs ksig cons =+ do+ cons1 <- sequenceA cons+ return (TypeDataD tc tvs ksig cons1) classD :: Quote m => m Cxt -> Name -> [TyVarBndr ()] -> [FunDep] -> [m Dec] -> m Dec classD ctxt cls tvs fds decs =
Language/Haskell/TH/Lib/Internal.hs view
@@ -20,12 +20,12 @@ import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn) import qualified Language.Haskell.TH.Syntax as TH-import Control.Applicative(liftA, liftA2)+import Control.Applicative(liftA, Applicative(..)) import qualified Data.Kind as Kind (Type) import Data.Word( Word8 ) import Data.List.NonEmpty ( NonEmpty(..) ) import GHC.Exts (TYPE)-import Prelude+import Prelude hiding (Applicative(..)) ---------------------------------------------------------- -- * Type synonyms@@ -441,6 +441,15 @@ derivs1 <- sequenceA derivs pure (NewtypeD ctxt1 tc tvs1 ksig1 con1 derivs1) +typeDataD :: Quote m => Name -> [m (TyVarBndr ())] -> Maybe (m Kind) -> [m Con]+ -> m Dec+typeDataD tc tvs ksig cons =+ do+ tvs1 <- sequenceA tvs+ ksig1 <- sequenceA ksig+ cons1 <- sequenceA cons+ pure (TypeDataD tc tvs1 ksig1 cons1)+ classD :: Quote m => m Cxt -> Name -> [m (TyVarBndr ())] -> [FunDep] -> [m Dec] -> m Dec classD ctxt cls tvs fds decs = do@@ -1033,6 +1042,7 @@ doc_loc (ValD (VarP n) _ _) = Just $ DeclDoc n doc_loc (DataD _ n _ _ _ _) = Just $ DeclDoc n doc_loc (NewtypeD _ n _ _ _ _) = Just $ DeclDoc n+ doc_loc (TypeDataD n _ _ _) = Just $ DeclDoc n doc_loc (TySynD n _ _) = Just $ DeclDoc n doc_loc (ClassD _ n _ _ _) = Just $ DeclDoc n doc_loc (SigD n _) = Just $ DeclDoc n@@ -1106,6 +1116,19 @@ newtypeD_doc ctxt tc tvs ksig con_with_docs@(con, _, _) derivs mdoc = do qAddModFinalizer $ docCons con_with_docs let dec = newtypeD ctxt tc tvs ksig con derivs+ maybe dec (flip withDecDoc dec) mdoc++-- | Variant of 'typeDataD' that attaches Haddock documentation.+typeDataD_doc :: Name -> [Q (TyVarBndr ())] -> Maybe (Q Kind)+ -> [(Q Con, Maybe String, [Maybe String])]+ -- ^ List of constructors, documentation for the constructor, and+ -- documentation for the arguments+ -> Maybe String+ -- ^ Documentation to attach to the data declaration+ -> Q Dec+typeDataD_doc tc tvs ksig cons_with_docs mdoc = do+ qAddModFinalizer $ mapM_ docCons cons_with_docs+ let dec = typeDataD tc tvs ksig (map (\(con, _, _) -> con) cons_with_docs) maybe dec (flip withDecDoc dec) mdoc -- | Variant of 'dataInstD' that attaches Haddock documentation.
Language/Haskell/TH/Ppr.hs view
@@ -23,10 +23,12 @@ nestDepth = 4 type Precedence = Int-appPrec, opPrec, unopPrec, sigPrec, noPrec :: Precedence-appPrec = 4 -- Argument of a function application-opPrec = 3 -- Argument of an infix operator-unopPrec = 2 -- Argument of an unresolved infix operator+appPrec, opPrec, unopPrec, funPrec, qualPrec, sigPrec, noPrec :: Precedence+appPrec = 6 -- Argument of a function or type application+opPrec = 5 -- Argument of an infix operator+unopPrec = 4 -- Argument of an unresolved infix operator+funPrec = 3 -- Argument of a function arrow+qualPrec = 2 -- Forall-qualified type or result of a function arrow sigPrec = 1 -- Argument of an explicit type signature noPrec = 0 -- Others @@ -220,7 +222,7 @@ pprExp _ (ArithSeqE d) = ppr d pprExp _ (ListE es) = brackets (commaSep es) pprExp i (SigE e t) = parensIf (i > noPrec) $ pprExp sigPrec e- <+> dcolon <+> ppr t+ <+> dcolon <+> pprType sigPrec t pprExp _ (RecConE nm fs) = pprName' Applied nm <> braces (pprFields fs) pprExp _ (RecUpdE e fs) = pprExp appPrec e <> braces (pprFields fs) pprExp i (StaticE e) = parensIf (i >= appPrec) $@@ -397,6 +399,8 @@ = ppr_data empty ctxt (Just t) (hsep (map ppr xs)) ksig cs decs ppr_dec _ (NewtypeD ctxt t xs ksig c decs) = ppr_newtype empty ctxt (Just t) (sep (map ppr xs)) ksig c decs+ppr_dec _ (TypeDataD t xs ksig cs)+ = ppr_type_data empty [] (Just t) (hsep (map ppr xs)) ksig cs [] ppr_dec _ (ClassD ctxt c xs fds ds) = text "class" <+> pprCxt ctxt <+> ppr c <+> hsep (map ppr xs) <+> ppr fds $$ where_clause ds@@ -493,6 +497,10 @@ -> Doc ppr_newtype maybeInst ctxt t argsDoc ksig c decs = ppr_typedef "newtype" maybeInst ctxt t argsDoc ksig [c] decs +ppr_type_data :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]+ -> Doc+ppr_type_data = ppr_typedef "type data"+ ppr_typedef :: String -> Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause] -> Doc ppr_typedef data_or_newtype maybeInst ctxt t argsDoc ksig cs decs = sep [text data_or_newtype <+> maybeInst@@ -792,60 +800,63 @@ pprStrictType = pprBangType -------------------------------pprParendType :: Type -> Doc-pprParendType (VarT v) = pprName' Applied v+pprType :: Precedence -> Type -> Doc+pprType _ (VarT v) = pprName' Applied v -- `Applied` is used here instead of `ppr` because of infix names (#13887)-pprParendType (ConT c) = pprName' Applied c-pprParendType (TupleT 0) = text "()"-pprParendType (TupleT 1) = pprParendType (ConT (tupleTypeName 1))-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 MulArrowT = text "FUN"-pprParendType ListT = text "[]"-pprParendType (LitT l) = pprTyLit l-pprParendType (PromotedT c) = text "'" <> pprName' Applied c-pprParendType (PromotedTupleT 0) = text "'()"-pprParendType (PromotedTupleT 1) = pprParendType (PromotedT (tupleDataName 1))-pprParendType (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma))-pprParendType PromotedNilT = text "'[]"-pprParendType PromotedConsT = text "'(:)"-pprParendType StarT = char '*'-pprParendType ConstraintT = text "Constraint"-pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k)-pprParendType WildCardT = char '_'-pprParendType t@(InfixT {}) = parens (pprInfixT t)-pprParendType t@(UInfixT {}) = parens (pprInfixT t)-pprParendType t@(PromotedInfixT {}) = parens (pprInfixT t)-pprParendType t@(PromotedUInfixT {}) = parens (pprInfixT t)-pprParendType (ParensT t) = ppr t-pprParendType tuple | (TupleT n, args) <- split tuple- , length args == n- = parens (commaSep args)-pprParendType (ImplicitParamT n t) = text ('?':n) <+> text "::" <+> ppr t-pprParendType EqualityT = text "(~)"-pprParendType t@(ForallT {}) = parens (ppr t)-pprParendType t@(ForallVisT {}) = parens (ppr t)-pprParendType t@(AppT {}) = parens (ppr t)-pprParendType t@(AppKindT {}) = parens (ppr t)+pprType _ (ConT c) = pprName' Applied c+pprType _ (TupleT 0) = text "()"+pprType p (TupleT 1) = pprType p (ConT (tupleTypeName 1))+pprType _ (TupleT n) = parens (hcat (replicate (n-1) comma))+pprType _ (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma+pprType _ (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar+pprType _ ArrowT = parens (text "->")+pprType _ MulArrowT = text "FUN"+pprType _ ListT = text "[]"+pprType _ (LitT l) = pprTyLit l+pprType _ (PromotedT c) = text "'" <> pprName' Applied c+pprType _ (PromotedTupleT 0) = text "'()"+pprType p (PromotedTupleT 1) = pprType p (PromotedT (tupleDataName 1))+pprType _ (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma))+pprType _ PromotedNilT = text "'[]"+pprType _ PromotedConsT = text "'(:)"+pprType _ StarT = char '*'+pprType _ ConstraintT = text "Constraint"+pprType _ (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k)+pprType _ WildCardT = char '_'+pprType p t@(InfixT {}) = pprInfixT p t+pprType p t@(UInfixT {}) = pprInfixT p t+pprType p t@(PromotedInfixT {}) = pprInfixT p t+pprType p t@(PromotedUInfixT {}) = pprInfixT p t+pprType _ (ParensT t) = parens (pprType noPrec t)+pprType p (ImplicitParamT n ty) =+ parensIf (p >= sigPrec) $ text ('?':n) <+> text "::" <+> pprType sigPrec ty+pprType _ EqualityT = text "(~)"+pprType p (ForallT tvars ctxt ty) =+ parensIf (p >= funPrec) $ sep [pprForall tvars ctxt, pprType qualPrec ty]+pprType p (ForallVisT tvars ty) =+ parensIf (p >= funPrec) $ sep [pprForallVis tvars [], pprType qualPrec ty]+pprType p t@AppT{} = pprTyApp p (split t)+pprType p t@AppKindT{} = pprTyApp p (split t) -pprInfixT :: Type -> Doc-pprInfixT = \case- (InfixT x n y) -> with x n y "" ppr- (UInfixT x n y) -> with x n y "" pprInfixT- (PromotedInfixT x n y) -> with x n y "'" ppr- (PromotedUInfixT x n y) -> with x n y "'" pprInfixT- t -> ppr t+------------------------------+pprParendType :: Type -> Doc+pprParendType = pprType appPrec++pprInfixT :: Precedence -> Type -> Doc+pprInfixT p = \case+ InfixT x n y -> with x n y "" opPrec+ UInfixT x n y -> with x n y "" unopPrec+ PromotedInfixT x n y -> with x n y "'" opPrec+ PromotedUInfixT x n y -> with x n y "'" unopPrec+ t -> pprParendType t where- with x n y prefix ppr' = ppr' x <+> text prefix <> pprName' Infix n <+> ppr' y+ with x n y prefix p' =+ parensIf+ (p >= p')+ (pprType opPrec x <+> text prefix <> pprName' Infix n <+> pprType opPrec y) instance Ppr Type where- ppr (ForallT tvars ctxt ty) = sep [pprForall tvars ctxt, ppr ty]- ppr (ForallVisT tvars ty) = sep [pprForallVis tvars [], ppr ty]- ppr ty = pprTyApp (split ty)- -- Works, in a degenerate way, for SigT, and puts parens round (ty :: kind)- -- See Note [Pretty-printing kind signatures]+ ppr = pprType noPrec instance Ppr TypeArg where ppr (TANormal ty) = parensIf (isStarT ty) (ppr ty) ppr (TyArg ki) = char '@' <> parensIf (isStarT ki) (ppr ki)@@ -866,38 +877,40 @@ type instance F Int = (Bool :: *) So we always print a SigT with parens (see #10050). -} -pprTyApp :: (Type, [TypeArg]) -> Doc-pprTyApp (MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2])- | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", ppr arg2]- | c == manyName = sep [pprFunArgType arg1 <+> text "->", ppr arg2]-pprTyApp (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) =- sep [pprFunArgType arg1 <+> text "%" <> ppr argm <+> text "->", ppr arg2]-pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "->", ppr arg2]-pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) =- sep [pprFunArgType arg1 <+> text "~", ppr arg2]-pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg)-pprTyApp (TupleT 1, args) = pprTyApp (ConT (tupleTypeName 1), args)-pprTyApp (PromotedTupleT 1, args) = pprTyApp (PromotedT (tupleDataName 1), args)-pprTyApp (TupleT n, args)+pprTyApp :: Precedence -> (Type, [TypeArg]) -> Doc+pprTyApp p app@(MulArrowT, [TANormal (PromotedT c), TANormal arg1, TANormal arg2])+ | p >= funPrec = parens (pprTyApp noPrec app)+ | c == oneName = sep [pprFunArgType arg1 <+> text "%1 ->", pprType qualPrec arg2]+ | c == manyName = sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2]+pprTyApp p (MulArrowT, [TANormal argm, TANormal arg1, TANormal arg2]) =+ parensIf (p >= funPrec) $+ sep [pprFunArgType arg1 <+> text "%" <> pprType appPrec argm <+> text "->",+ pprType qualPrec arg2]+pprTyApp p (ArrowT, [TANormal arg1, TANormal arg2]) =+ parensIf (p >= funPrec) $+ sep [pprFunArgType arg1 <+> text "->", pprType qualPrec arg2]+pprTyApp p (EqualityT, [TANormal arg1, TANormal arg2]) =+ parensIf (p >= opPrec) $+ sep [pprType opPrec arg1 <+> text "~", pprType opPrec arg2]+pprTyApp _ (ListT, [TANormal arg]) = brackets (pprType noPrec arg)+pprTyApp p (TupleT 1, args) = pprTyApp p (ConT (tupleTypeName 1), args)+pprTyApp _ (TupleT n, args) | length args == n, Just args' <- traverse fromTANormal args = parens (commaSep args')-pprTyApp (PromotedTupleT n, args)+pprTyApp p (PromotedTupleT 1, args) = pprTyApp p (PromotedT (tupleDataName 1), args)+pprTyApp _ (PromotedTupleT n, args) | length args == n, Just args' <- traverse fromTANormal args = quoteParens (commaSep args')-pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args)+pprTyApp p (fun, args) =+ parensIf (p >= appPrec) $ pprParendType fun <+> sep (map pprParendTypeArg args) fromTANormal :: TypeArg -> Maybe Type fromTANormal (TANormal arg) = Just arg fromTANormal (TyArg _) = Nothing -pprFunArgType :: Type -> Doc -- Should really use a precedence argument--- Everything except forall and (->) binds more tightly than (->)-pprFunArgType ty@(ForallT {}) = parens (ppr ty)-pprFunArgType ty@(ForallVisT {}) = parens (ppr ty)-pprFunArgType ty@(((MulArrowT `AppT` _) `AppT` _) `AppT` _) = parens (ppr ty)-pprFunArgType ty@((ArrowT `AppT` _) `AppT` _) = parens (ppr ty)-pprFunArgType ty@(SigT _ _) = parens (ppr ty)-pprFunArgType ty = ppr ty+-- Print the type to the left of @->@. Everything except forall and (->) binds more tightly than (->).+pprFunArgType :: Type -> Doc+pprFunArgType = pprType funPrec data ForallVisFlag = ForallVis -- forall a -> {...} | ForallInvis -- forall a. {...}
Language/Haskell/TH/Syntax.hs view
@@ -2,7 +2,7 @@ DeriveGeneric, FlexibleInstances, DefaultSignatures, RankNTypes, RoleAnnotations, ScopedTypeVariables, MagicHash, KindSignatures, PolyKinds, TypeApplications, DataKinds,- GADTs, UnboxedTuples, UnboxedSums, TypeInType, TypeOperators,+ GADTs, UnboxedTuples, UnboxedSums, TypeOperators, Trustworthy, DeriveFunctor, BangPatterns, RecordWildCards, ImplicitParams #-} {-# OPTIONS_GHC -fno-warn-inline-rule-shadowing #-}@@ -26,6 +26,9 @@ -- * Language extensions , module Language.Haskell.TH.LanguageExtensions , ForeignSrcLang(..)+ -- * Notes+ -- ** Unresolved Infix+ -- $infix ) where import Data.Data hiding (Fixity(..))@@ -36,7 +39,7 @@ import Control.Monad (liftM) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Fix (MonadFix (..))-import Control.Applicative (liftA2)+import Control.Applicative (Applicative(..)) import Control.Exception (BlockedIndefinitelyOnMVar (..), catch, throwIO) import Control.Exception.Base (FixIOException (..)) import Control.Concurrent.MVar (newEmptyMVar, readMVar, putMVar)@@ -57,7 +60,7 @@ import GHC.ForeignSrcLang.Type import Language.Haskell.TH.LanguageExtensions import Numeric.Natural-import Prelude+import Prelude hiding (Applicative(..)) import Foreign.ForeignPtr import Foreign.C.String import Foreign.C.Types@@ -639,7 +642,8 @@ newDeclarationGroup :: Q [Dec] newDeclarationGroup = pure [] -{- | @reifyInstances nm tys@ returns a list of visible instances of @nm tys@. That is,+{- | @reifyInstances nm tys@ returns a list of all visible instances (see below for "visible")+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, all instances of this family at the types @tys@ are returned.@@ -657,9 +661,21 @@ There is one edge case: @reifyInstances ''Typeable tys@ currently always produces an empty list (no matter what @tys@ are given). -An instance is visible if it is imported or defined in a prior top-level-declaration group. See the documentation for 'newDeclarationGroup' for more details.+In principle, the *visible* instances are+* all instances defined in a prior top-level declaration group+ (see docs on @newDeclarationGroup@), or+* all instances defined in any module transitively imported by the+ module being compiled +However, actually searching all modules transitively below the one being+compiled is unreasonably expensive, so @reifyInstances@ will report only the+instance for modules that GHC has had some cause to visit during this+compilation. This is a shortcoming: @reifyInstances@ might fail to report+instances for a type that is otherwise unusued, or instances defined in a+different component. You can work around this shortcoming by explicitly importing the modules+whose instances you want to be visible. GHC issue <https://gitlab.haskell.org/ghc/ghc/-/issues/20529#note_388980 #20529>+has some discussion around this.+ -} reifyInstances :: Name -> [Type] -> Q [InstanceDec] reifyInstances cls tys = Q (qReifyInstances cls tys)@@ -811,6 +827,7 @@ LangObjc -> "m" LangObjcxx -> "mm" LangAsm -> "s"+ LangJs -> "js" RawObject -> "a" path <- addTempFile suffix runIO $ writeFile path src@@ -1117,8 +1134,9 @@ where helper :: HasCallStack => Name helper =- case head (getCallStack ?callStack) of- (_, SrcLoc{..}) -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray"+ case getCallStack ?callStack of+ [] -> error "addrToByteArrayName: empty call stack"+ (_, SrcLoc{..}) : _ -> mkNameG_v srcLocPackage srcLocModule "addrToByteArray" addrToByteArray :: Int -> Addr# -> ByteArray@@ -1398,7 +1416,7 @@ con@('(':_) -> Name (mkOccName con) (NameG DataName (mkPkgName "ghc-prim")- (mkModName "GHC.Tuple"))+ (mkModName "GHC.Tuple.Prim")) -- Tricky case: see Note [Data for non-algebraic types] fun@(x:_) | startsVarSym x || startsVarId x@@ -1789,6 +1807,10 @@ mkNameL :: String -> Uniq -> Name mkNameL s u = Name (mkOccName s) (NameL u) +-- | Only used internally+mkNameQ :: String -> String -> Name+mkNameQ mn occ = Name (mkOccName occ) (NameQ (mkModName mn))+ -- | Used for 'x etc, but not available to the programmer mkNameG :: NameSpace -> String -> String -> String -> Name mkNameG ns pkg modu occ@@ -1870,10 +1892,13 @@ withParens thing | boxed = "(" ++ thing ++ ")" | otherwise = "(#" ++ thing ++ "#)"- tup_occ | n == 1 = if boxed then "Solo" else "Solo#"+ tup_occ | n == 1 = if boxed then solo else "Solo#" | otherwise = withParens (replicate n_commas ',') n_commas = n - 1- tup_mod = mkModName "GHC.Tuple"+ tup_mod = mkModName "GHC.Tuple.Prim"+ solo+ | space == DataName = "MkSolo"+ | otherwise = "Solo" -- Unboxed sum data and type constructors -- | Unboxed sum data constructor@@ -2070,6 +2095,7 @@ ~~~~~~~~~~~~~~~~~~~~~~~ -} {- $infix #infix#+ When implementing antiquotation for quasiquoters, one often wants to parse strings into expressions: @@ -2377,6 +2403,9 @@ Con [DerivClause] -- ^ @{ newtype Cxt x => T x = A (B x) -- deriving (Z,W Q) -- deriving stock Eq }@+ | TypeDataD Name [TyVarBndr ()]+ (Maybe Kind) -- Kind signature (allowed only for GADTs)+ [Con] -- ^ @{ type data T x = A x | B (T x) }@ | TySynD Name [TyVarBndr ()] Type -- ^ @{ type T x = (x,x) }@ | ClassD Cxt Name [TyVarBndr ()] [FunDep] [Dec] -- ^ @{ class Eq a => Ord a where ds }@@@ -2597,24 +2626,36 @@ -- be tuples of other constraints. type Pred = Type +-- | 'SourceUnpackedness' corresponds to unpack annotations found in the source code.+--+-- This may not agree with the annotations returned by 'reifyConStrictness'.+-- See 'reifyConStrictness' for more information. data SourceUnpackedness = NoSourceUnpackedness -- ^ @C a@ | SourceNoUnpack -- ^ @C { {\-\# NOUNPACK \#-\} } a@ | SourceUnpack -- ^ @C { {\-\# UNPACK \#-\} } a@ deriving (Show, Eq, Ord, Data, Generic) +-- | 'SourceStrictness' corresponds to strictness annotations found in the source code.+--+-- This may not agree with the annotations returned by 'reifyConStrictness'.+-- See 'reifyConStrictness' for more information. data SourceStrictness = NoSourceStrictness -- ^ @C a@ | SourceLazy -- ^ @C {~}a@ | SourceStrict -- ^ @C {!}a@ deriving (Show, Eq, Ord, Data, Generic) -- | 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+-- refers to the strictness annotations that the compiler chooses for a data constructor+-- field, which may be different from what is written in source code.+--+-- Note that non-unpacked strict fields are assigned 'DecidedLazy' when a bang would be inappropriate,+-- such as the field of a newtype constructor and fields that have an unlifted type.+--+-- See 'reifyConStrictness' for more information.+data DecidedStrictness = DecidedLazy -- ^ Field inferred to not have a bang.+ | DecidedStrict -- ^ Field inferred to have a bang.+ | DecidedUnpack -- ^ Field inferred to be unpacked. deriving (Show, Eq, Ord, Data, Generic) -- | A single data constructor.@@ -2740,21 +2781,21 @@ | ParensT Type -- ^ @(T)@ -- See Note [Representing concrete syntax in types]- | TupleT Int -- ^ @(,), (,,), etc.@- | UnboxedTupleT Int -- ^ @(\#,\#), (\#,,\#), etc.@- | UnboxedSumT SumArity -- ^ @(\#|\#), (\#||\#), etc.@+ | TupleT Int -- ^ @(,)@, @(,,)@, etc.+ | UnboxedTupleT Int -- ^ @(\#,\#)@, @(\#,,\#)@, etc.+ | UnboxedSumT SumArity -- ^ @(\#|\#)@, @(\#||\#)@, etc. | ArrowT -- ^ @->@ | MulArrowT -- ^ @%n ->@ -- -- Generalised arrow type with multiplicity argument | EqualityT -- ^ @~@ | ListT -- ^ @[]@- | PromotedTupleT Int -- ^ @'(), '(,), '(,,), etc.@+ | PromotedTupleT Int -- ^ @'()@, @'(,)@, @'(,,)@, etc. | PromotedNilT -- ^ @'[]@- | PromotedConsT -- ^ @(':)@+ | PromotedConsT -- ^ @'(:)@ | StarT -- ^ @*@ | ConstraintT -- ^ @Constraint@- | LitT TyLit -- ^ @0,1,2, etc.@+ | LitT TyLit -- ^ @0@, @1@, @2@, etc. | WildCardT -- ^ @_@ | ImplicitParamT String Type -- ^ @?x :: t@ deriving( Show, Eq, Ord, Data, Generic )
changelog.md view
@@ -1,5 +1,13 @@ # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell) +## 2.20.0.0++ * The `Ppr.pprInfixT` function has gained a `Precedence` argument. + * The values of named precedence levels like `Ppr.appPrec` have changed.++ * Add `TypeDataD` constructor to the `Dec` type for `type data`+ declarations (GHC proposal #106).+ ## 2.19.0.0 * Add `DefaultD` constructor to support Haskell `default` declarations.
template-haskell.cabal view
@@ -3,7 +3,7 @@ -- template-haskell.cabal. name: template-haskell-version: 2.19.0.0+version: 2.20.0.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE@@ -27,14 +27,6 @@ location: https://gitlab.haskell.org/ghc/ghc.git subdir: libraries/template-haskell ---- We give the option to vendor filepath to avoid making filepath non-reinstallable..--- see #21738 for why we are doing this now and what the plan is for the future.-Flag vendor-filepath- Description: Vendor the dependency on filepath- Default: False- Manual: True- Library default-language: Haskell2010 other-extensions:@@ -63,30 +55,21 @@ Language.Haskell.TH.Lib.Map build-depends:- base >= 4.11 && < 4.18,- ghc-boot-th == 9.4.1,+ base >= 4.11 && < 4.19,+ ghc-boot-th == 9.6.1, ghc-prim, pretty == 1.1.* - if flag(vendor-filepath)- other-modules:- System.FilePath- System.FilePath.Posix- System.FilePath.Windows- hs-source-dirs: ./vendored-filepath .- default-extensions:- ImplicitPrelude- else- build-depends: filepath- hs-source-dirs: .+ other-modules:+ System.FilePath+ System.FilePath.Posix+ System.FilePath.Windows+ hs-source-dirs: ./vendored-filepath .+ default-extensions:+ ImplicitPrelude ghc-options: -Wall -- We need to set the unit ID to template-haskell (without a -- version number) as it's magic. ghc-options: -this-unit-id template-haskell-- -- This should match the default-extensions used in 'ghc.cabal'. This way,- -- GHCi can be used to load it along with the compiler.- Default-Extensions:- NoImplicitPrelude
vendored-filepath/System/FilePath/Posix.hs view
@@ -600,7 +600,7 @@ hasLeadingPathSeparator :: FilePath -> Bool hasLeadingPathSeparator "" = False-hasLeadingPathSeparator x = isPathSeparator (head x)+hasLeadingPathSeparator (hd : _) = isPathSeparator hd -- | Add a trailing file path separator if one is not already present.@@ -824,7 +824,7 @@ where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x -- on windows, need to drop '/' which is kind of absolute, but not a drive- dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x+ dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = drop 1 x dropAbs x = dropDrive x takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]
vendored-filepath/System/FilePath/Windows.hs view
@@ -600,7 +600,7 @@ hasLeadingPathSeparator :: FilePath -> Bool hasLeadingPathSeparator "" = False-hasLeadingPathSeparator x = isPathSeparator (head x)+hasLeadingPathSeparator (hd : _) = isPathSeparator hd -- | Add a trailing file path separator if one is not already present.@@ -824,7 +824,7 @@ where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x -- on windows, need to drop '/' which is kind of absolute, but not a drive- dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = tail x+ dropAbs x | hasLeadingPathSeparator x && not (hasDrive x) = drop 1 x dropAbs x = dropDrive x takeAbs x | hasLeadingPathSeparator x && not (hasDrive x) = [pathSeparator]