Matching changes for #11028

1 files changed, 17 insertions, 3 deletions

diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs
index 658007ba..45deca9c 100644
--- a/haddock-api/src/Haddock/Utils.hs
+++ b/haddock-api/src/Haddock/Utils.hs
@@ -180,18 +180,32 @@ restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons })
 restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name]
 restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
   where
-    keep d | any (\n -> n `elem` names) (map unLoc $ con_names d) =
-      case con_details d of
+    keep d | any (\n -> n `elem` names) (map unLoc $ getConNames d) =
+      case getConDetails h98d of
         PrefixCon _ -> Just d
         RecCon fields
           | all field_avail (unL fields) -> Just d
-          | otherwise -> Just (d { con_details = PrefixCon (field_types (map unL (unL fields))) })
+          | otherwise -> Just (h98d { con_details = PrefixCon (field_types (map unL (unL fields))) })
           -- if we have *all* the field names available, then
           -- keep the record declaration.  Otherwise degrade to
           -- a constructor declaration.  This isn't quite right, but
           -- it's the best we can do.
         InfixCon _ _ -> Just d
       where
+        h98d = h98ConDecl d
+        h98ConDecl c@ConDeclH98{} = c
+        h98ConDecl c@ConDeclGADT{} = c'
+          where
+            (details,_res_ty,cxt,tvs) = gadtDeclDetails (con_type c)
+            c' :: ConDecl Name
+            c' = ConDeclH98
+                   { con_name = head (con_names c)
+                   , con_qvars = Just $ HsQTvs { hsq_kvs = mempty, hsq_tvs = tvs }
+                   , con_cxt = Just cxt
+                   , con_details = details
+                   , con_doc = con_doc c
+                   }
+
         field_avail :: LConDeclField Name -> Bool
         field_avail (L _ (ConDeclField fs _ _))
             = all (\f -> selectorFieldOcc (unLoc f) `elem` names) fs