Implement \cases (Proposal 302)

This commit implements proposal 302: \cases - Multi-way lambda
expressions.

This adds a new expression heralded by \cases, which works exactly like
\case, but can match multiple apats instead of a single pat.

Updates submodule haddock to support the ITlcases token.

Closes #20768

4 files changed, 22 insertions, 7 deletions

diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
index 42fa6cd501..8e8e41df2f 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs
@@ -42,9 +42,9 @@ module Language.Haskell.TH.Lib (
     -- *** Expressions
         dyn, varE, unboundVarE, labelE, implicitParamVarE, conE, litE, staticE,
         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,
+        lamE, lam1E, lamCaseE, lamCasesE, 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 e960f35bb3..5d2a32d761 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs
@@ -300,9 +300,14 @@ lamE ps e = do ps' <- sequenceA ps
 lam1E :: Quote m => m Pat -> m Exp -> m Exp
 lam1E p e = lamE [p] e
 
+-- | Lambda-case (@\case@)
 lamCaseE :: Quote m => [m Match] -> m Exp
 lamCaseE ms = LamCaseE <$> sequenceA ms
 
+-- | Lambda-cases (@\cases@)
+lamCasesE :: Quote m => [m Clause] -> m Exp
+lamCasesE ms = LamCasesE <$> sequenceA ms
+
 tupE :: Quote m => [Maybe (m Exp)] -> m Exp
 tupE es = do { es1 <- traverse sequenceA es; pure (TupE es1)}
 
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 51e89fda2a..e2af99339f 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -154,8 +154,11 @@ pprExp _ (InfixE me1 op me2) = parens $ pprMaybeExp noPrec me1
 pprExp i (LamE [] e) = pprExp i e -- #13856
 pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat appPrec) ps)
                                            <+> text "->" <+> ppr e
-pprExp i (LamCaseE ms) = parensIf (i > noPrec)
-                       $ text "\\case" $$ braces (semiSep ms)
+pprExp i (LamCaseE ms)
+  = parensIf (i > noPrec) $ text "\\case" $$ braces (semiSep ms)
+pprExp i (LamCasesE ms)
+  = parensIf (i > noPrec) $ text "\\cases" $$ braces (semi_sep ms)
+  where semi_sep = sep . punctuate semi . map (pprClause False)
 pprExp i (TupE es)
   | [Just e] <- es
   = pprExp i (ConE (tupleDataName 1) `AppE` e)
@@ -270,6 +273,12 @@ pprBody eq body = case body of
               | otherwise = arrow
 
 ------------------------------
+pprClause :: Bool -> Clause -> Doc
+pprClause eqDoc (Clause ps rhs ds)
+  = hsep (map (pprPat appPrec) ps) <+> pprBody eqDoc rhs
+    $$ where_clause ds
+
+------------------------------
 instance Ppr Lit where
   ppr = pprLit noPrec
 
@@ -652,8 +661,7 @@ instance Ppr RuleBndr where
 
 ------------------------------
 instance Ppr Clause where
-    ppr (Clause ps rhs ds) = hsep (map (pprPat appPrec) ps) <+> pprBody True rhs
-                             $$ where_clause ds
+    ppr = pprClause True
 
 ------------------------------
 instance Ppr Con where
diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
index 08d2ea41bf..fdf2e6bf39 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs
@@ -2242,6 +2242,7 @@ type FieldPat = (Name,Pat)
 
 data Match = Match Pat Body [Dec] -- ^ @case e of { pat -> body where decs }@
     deriving( Show, Eq, Ord, Data, Generic )
+
 data Clause = Clause [Pat] Body [Dec]
                                   -- ^ @f { p1 p2 = body where decs }@
     deriving( Show, Eq, Ord, Data, Generic )
@@ -2273,6 +2274,7 @@ data Exp
                                        -- See "Language.Haskell.TH.Syntax#infix"
   | LamE [Pat] Exp                     -- ^ @{ \\ p1 p2 -> e }@
   | LamCaseE [Match]                   -- ^ @{ \\case m1; m2 }@
+  | LamCasesE [Clause]                 -- ^ @{ \\cases m1; m2 }@
   | TupE [Maybe Exp]                   -- ^ @{ (e1,e2) }  @
                                        --
                                        -- The 'Maybe' is necessary for handling