From 1740bdda25e72770fcdd3973862058472486a1a3 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Fri, 17 Jan 2020 14:34:35 -0500
Subject: Changes for GHC#17566

See https://gitlab.haskell.org/ghc/ghc/merge_requests/2469
---
 haddock-api/src/Haddock/GhcUtils.hs | 28 ++++++++++++++++++++++++++--
 1 file changed, 26 insertions(+), 2 deletions(-)

(limited to 'haddock-api/src/Haddock/GhcUtils.hs')

diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 7350f116..b423d55f 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -55,8 +55,7 @@ moduleString = moduleNameString . moduleName
 isNameSym :: Name -> Bool
 isNameSym = isSymOcc . nameOccName
 
-getMainDeclBinder :: XRec pass Pat ~ Located (Pat pass) =>
-                     HsDecl pass -> [IdP pass]
+getMainDeclBinder :: HsDecl (GhcPass p) -> [IdP (GhcPass p)]
 getMainDeclBinder (TyClD _ d) = [tcdName d]
 getMainDeclBinder (ValD _ d) =
   case collectHsBindBinders d of
@@ -219,6 +218,31 @@ getGADTConType (ConDeclH98 {}) = panic "getGADTConType"
   -- Should only be called on ConDeclGADT
 getGADTConType (XConDecl nec) = noExtCon nec
 
+getMainDeclBinderI :: HsDecl DocNameI -> [IdP DocNameI]
+getMainDeclBinderI (TyClD _ d) = [tcdNameI d]
+getMainDeclBinderI (ValD _ d) =
+  case collectHsBindBinders d of
+    []       -> []
+    (name:_) -> [name]
+getMainDeclBinderI (SigD _ d) = sigNameNoLoc d
+getMainDeclBinderI (ForD _ (ForeignImport _ name _ _)) = [unLoc name]
+getMainDeclBinderI (ForD _ (ForeignExport _ _ _ _)) = []
+getMainDeclBinderI _ = []
+
+familyDeclLNameI :: FamilyDecl DocNameI -> Located DocName
+familyDeclLNameI (FamilyDecl { fdLName = n }) = n
+familyDeclLNameI (XFamilyDecl nec) = noExtCon nec
+
+tyClDeclLNameI :: TyClDecl DocNameI -> Located DocName
+tyClDeclLNameI (FamDecl { tcdFam = fd })     = familyDeclLNameI fd
+tyClDeclLNameI (SynDecl { tcdLName = ln })   = ln
+tyClDeclLNameI (DataDecl { tcdLName = ln })  = ln
+tyClDeclLNameI (ClassDecl { tcdLName = ln }) = ln
+tyClDeclLNameI (XTyClDecl nec) = noExtCon nec
+
+tcdNameI :: TyClDecl DocNameI -> DocName
+tcdNameI = unLoc . tyClDeclLNameI
+
 -- -------------------------------------
 
 getGADTConTypeG :: ConDecl (GhcPass p) -> LHsType (GhcPass p)
-- 
cgit v1.2.3