From 4283feaa9e0826211f7a71d543054c989ea32965 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Sun, 13 Sep 2020 08:58:40 -0400
Subject: Introduce and use DerivClauseTys (#18662)

This switches `deriv_clause_tys` so that instead of using a list of
`LHsSigType`s to represent the types in a `deriving` clause, it now
uses a sum type. `DctSingle` represents a `deriving` clause with no
enclosing parentheses, while `DctMulti` represents a clause with
enclosing parentheses. This makes pretty-printing easier and avoids
confusion between `HsParTy` and the enclosing parentheses in
`deriving` clauses, which are different semantically.

Fixes #18662.
---
 compiler/GHC/Parser/PostProcess/Haddock.hs | 25 ++++++++++++++++++++++---
 1 file changed, 22 insertions(+), 3 deletions(-)

(limited to 'compiler/GHC/Parser')

diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs
index 7dc36db037..feb0a32351 100644
--- a/compiler/GHC/Parser/PostProcess/Haddock.hs
+++ b/compiler/GHC/Parser/PostProcess/Haddock.hs
@@ -628,15 +628,34 @@ instance HasHaddock (Located (HsDerivingClause GhcPs)) where
               Just (L l (ViaStrategy _)) -> (pure (), registerLocHdkA l)
               Just (L l _) -> (registerLocHdkA l, pure ())
         register_strategy_before
-        deriv_clause_tys' <-
-          extendHdkA (getLoc deriv_clause_tys) $
-          traverse @Located addHaddock deriv_clause_tys
+        deriv_clause_tys' <- addHaddock deriv_clause_tys
         register_strategy_after
         pure HsDerivingClause
           { deriv_clause_ext = noExtField,
             deriv_clause_strategy,
             deriv_clause_tys = deriv_clause_tys' }
 
+-- Process the types in a single deriving clause, which may come in one of the
+-- following forms:
+--
+--    1. A singular type constructor:
+--          deriving Eq -- ^ Comment on Eq
+--
+--    2. A list of comma-separated types surrounded by enclosing parentheses:
+--          deriving ( Eq  -- ^ Comment on Eq
+--                   , C a -- ^ Comment on C a
+--                   )
+instance HasHaddock (Located (DerivClauseTys GhcPs)) where
+  addHaddock (L l_dct dct) =
+    extendHdkA l_dct $
+    case dct of
+      DctSingle x ty -> do
+        ty' <- addHaddock ty
+        pure $ L l_dct $ DctSingle x ty'
+      DctMulti x tys -> do
+        tys' <- addHaddock tys
+        pure $ L l_dct $ DctMulti x tys'
+
 -- Process a single data constructor declaration, which may come in one of the
 -- following forms:
 --
-- 
cgit v1.2.1