From 10124b16538091806953d732e24ca485a0664895 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mario=20Bla=C5=BEevi=C4=87?= <blamario@protonmail.com>
Date: Sun, 7 Mar 2021 12:01:56 -0500
Subject: template-haskell: Add support for default declarations

Fixes #19373
---
 libraries/template-haskell/Language/Haskell/TH/Lib.hs          | 3 +++
 libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs | 4 ++++
 libraries/template-haskell/Language/Haskell/TH/Ppr.hs          | 2 ++
 libraries/template-haskell/Language/Haskell/TH/Syntax.hs       | 1 +
 libraries/template-haskell/changelog.md                        | 4 ++++
 5 files changed, 14 insertions(+)

(limited to 'libraries')

diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index de90df2bfd..f57861024c 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -103,6 +103,9 @@ module Language.Haskell.TH.Lib (
     -- **** Fixity
     infixLD, infixRD, infixND,
 
+    -- **** Default declaration
+    defaultD,
+
     -- **** Foreign Function Interface (FFI)
     cCall, stdCall, cApi, prim, javaScript,
     unsafe, safe, interruptible, forImpD,
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
index 472a4f8557..d921a60e6b 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -468,6 +468,9 @@ infixRD prec nm = pure (InfixD (Fixity prec InfixR) nm)
 infixND :: Quote m => Int -> Name -> m Dec
 infixND prec nm = pure (InfixD (Fixity prec InfixN) nm)
 
+defaultD :: Quote m => [m Type] -> m Dec
+defaultD tys = DefaultD <$> sequenceA tys
+
 pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec
 pragInlD name inline rm phases
   = pure $ PragmaD $ InlineP name inline rm phases
@@ -1030,6 +1033,7 @@ withDecDoc doc dec = do
     doc_loc (StandaloneDerivD _ _ _) = Nothing
     doc_loc (DefaultSigD _ _)        = Nothing
     doc_loc (ImplicitParamBindD _ _) = Nothing
+    doc_loc (DefaultD _)             = Nothing
 
 -- | Variant of 'withDecDoc' that applies the same documentation to
 -- multiple declarations. Useful for documenting quoted declarations.
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 47585b9f9d..6fcf48010d 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -361,6 +361,8 @@ ppr_dec _ (SigD f t)    = pprPrefixOcc f <+> dcolon <+> ppr t
 ppr_dec _ (KiSigD f k)  = text "type" <+> pprPrefixOcc f <+> dcolon <+> ppr k
 ppr_dec _ (ForeignD f)  = ppr f
 ppr_dec _ (InfixD fx n) = pprFixity n fx
+ppr_dec _ (DefaultD tys) =
+        text "default" <+> parens (sep $ punctuate comma $ map ppr tys)
 ppr_dec _ (PragmaD p)   = ppr p
 ppr_dec isTop (DataFamilyD tc tvs kind)
   = text "data" <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 5e0c75151e..8f8ddaf1e8 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -2289,6 +2289,7 @@ data Dec
                                   --{ foreign export ... }@
 
   | InfixD Fixity Name            -- ^ @{ infix 3 foo }@
+  | DefaultD [Type]               -- ^ @{ default (Integer, Double) }@
 
   -- | pragmas
   | PragmaD Pragma                -- ^ @{ {\-\# INLINE [1] foo \#-\} }@
diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md
index 39d1c04c3f..d5581297f2 100644
--- a/libraries/template-haskell/changelog.md
+++ b/libraries/template-haskell/changelog.md
@@ -1,5 +1,9 @@
 # Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
 
+## 2.19.0.0
+
+  * Add `DefaultD` constructor to support Haskell `default` declarations.
+
 ## 2.18.0.0
   * The types of `ConP` and `conP` have been changed to allow for an additional list
     of type applications preceding the argument patterns.
-- 
cgit v1.2.1