diff options
| author | Zubin Duggal <zubin.duggal@gmail.com> | 2021-08-02 22:23:51 +0530 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-03 10:18:04 -0400 |
| commit | 5155eafaef2d0cbecd58a808b5b357002a656ffe (patch) | |
| tree | 18e7936f72992a67a5e36fd29b5d48b070049eee /libraries/template-haskell | |
| parent | bd2874000ffa72f9d1f98b2223a37e6cc3c78567 (diff) | |
| download | haskell-5155eafaef2d0cbecd58a808b5b357002a656ffe.tar.gz | |
Handle OverloadedRecordDot in TH (#20185)
Diffstat (limited to 'libraries/template-haskell')
5 files changed, 16 insertions, 0 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs index f57861024c..7dcf328574 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs @@ -44,6 +44,7 @@ module Language.Haskell.TH.Lib ( appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR, lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp, + getFieldE, projectionE, -- **** Ranges fromE, fromThenE, fromToE, fromThenToE, diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs index d921a60e6b..11e53ca701 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs @@ -366,6 +366,14 @@ labelE s = pure (LabelE s) implicitParamVarE :: Quote m => String -> m Exp implicitParamVarE n = pure (ImplicitParamVarE n) +getFieldE :: Quote m => m Exp -> String -> m Exp +getFieldE e f = do + e' <- e + pure (GetFieldE e' f) + +projectionE :: Quote m => [String] -> m Exp +projectionE xs = pure (ProjectionE xs) + -- ** 'arithSeqE' Shortcuts fromE :: Quote m => m Exp -> m Exp fromE x = do { a <- x; pure (ArithSeqE (FromR a)) } diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index 6fcf48010d..7ed842ca94 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -223,6 +223,8 @@ pprExp i (StaticE e) = parensIf (i >= appPrec) $ pprExp _ (UnboundVarE v) = pprName' Applied v pprExp _ (LabelE s) = text "#" <> text s pprExp _ (ImplicitParamVarE n) = text ('?' : n) +pprExp _ (GetFieldE e f) = pprExp appPrec e <> text ('.': f) +pprExp _ (ProjectionE xs) = parens $ hcat $ map ((char '.'<>) . text) xs pprFields :: [(Name,Exp)] -> Doc pprFields = sep . punctuate comma . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e) diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index 44b33a217b..c219467337 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -2233,6 +2233,8 @@ data Exp -- or constructor name. | LabelE String -- ^ @{ #x }@ ( Overloaded label ) | ImplicitParamVarE String -- ^ @{ ?x }@ ( Implicit parameter ) + | GetFieldE Exp String -- ^ @{ exp.field }@ ( Overloaded Record Dot ) + | ProjectionE [String] -- ^ @(.x)@ or @(.x.y)@ (Record projections) deriving( Show, Eq, Ord, Data, Generic ) type FieldExp = (Name,Exp) diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index d5581297f2..f30c9df660 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -3,6 +3,9 @@ ## 2.19.0.0 * Add `DefaultD` constructor to support Haskell `default` declarations. + * Add support for Overloaded Record Dot. + Introduces `getFieldE :: Quote m => m Exp -> String -> m Exp` and + `projectionE :: Quote m => [String] -> m Exp`. ## 2.18.0.0 * The types of `ConP` and `conP` have been changed to allow for an additional list |