From c6fc26d897b147d5ac48d0d799230c5a4ddb791d Mon Sep 17 00:00:00 2001
From: alexwl <alexey.a.kiryushin@gmail.com>
Date: Fri, 12 Oct 2018 19:45:12 +0300
Subject: Fix all GHC 8.4.3 compatibility issues.  Needs a bit more testing.

---
 src/HaskellCodeExplorer/GhcUtils.hs | 110 ++++++++++++++++++++++++++++--------
 1 file changed, 87 insertions(+), 23 deletions(-)

(limited to 'src/HaskellCodeExplorer/GhcUtils.hs')

diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index 09be369..b25678d 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -73,7 +73,13 @@ import Data.Ord (comparing)
 import qualified Data.Text as T
 import DataCon (dataConWorkId, flSelector)
 import Documentation.Haddock.Parser (overIdentifier, parseParas)
-import Documentation.Haddock.Types (DocH(..), Header(..), _doc)
+import Documentation.Haddock.Types (DocH(..),
+                                    Header(..),
+                                    _doc,
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+                                    Table(..)
+#endif
+ )
 import DynFlags ()
 import FastString (mkFastString, unpackFS)
 import GHC
@@ -122,6 +128,9 @@ import GHC
   , ieLWrappedName
 #else
   , tyClGroupConcat
+#endif
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+  , FamEqn(..)
 #endif
   , tyConKind
   , nameSrcSpan
@@ -150,7 +159,7 @@ import GHC
 import qualified HaskellCodeExplorer.Types as HCE
 import HscTypes (TypeEnv, lookupTypeEnv)
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)  
-import HsExtension (GhcPs, GhcRn, GhcTc, IdP(..), Pass(..))
+import HsExtension (GhcRn,IdP)
 #endif
 import IdInfo (IdDetails(..))
 import InstEnv (ClsInst(..))
@@ -259,13 +268,28 @@ instanceToText :: DynFlags -> ClsInst -> T.Text
 instanceToText flags ClsInst {..} =
   T.append "instance " $ T.pack . showSDoc flags $ pprSigmaType (idType is_dfun)
 
---instanceDeclToText :: DynFlags -> InstDecl Name -> T.Text
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+instanceDeclToText :: DynFlags -> InstDecl GhcRn -> T.Text
+#else
+instanceDeclToText :: DynFlags -> InstDecl Name -> T.Text
+#endif
 instanceDeclToText flags decl =
   case decl of
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)        
-    _ -> ""
-#else
     ClsInstD ClsInstDecl {..} -> T.append "instance " (toText flags cid_poly_ty)
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+    DataFamInstD di ->
+      let args =
+            T.intercalate " " . map (toText flags) .  feqn_pats  .hsib_body . dfid_eqn $ di
+       in T.concat
+            ["data instance ", toText flags (unLoc $ feqn_tycon . hsib_body . dfid_eqn $ di), " ", args]
+    TyFamInstD ti ->
+      let args =
+            T.intercalate " " .
+            map (toText flags) . feqn_pats . hsib_body . tfid_eqn $
+            ti
+       in T.concat
+            ["type instance ", toText flags $ tyFamInstDeclName ti, " ", args]
+#else
     DataFamInstD di ->
       let args =
             T.intercalate " " . map (toText flags) . hsib_body $ dfid_pats di
@@ -381,6 +405,8 @@ mbIdDetails _ = Nothing
 
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
 hsGroupVals :: HsGroup GhcRn -> [GenLocated SrcSpan (HsBindLR GhcRn GhcRn)]
+#else
+hsGroupVals :: HsGroup Name -> [GenLocated SrcSpan (HsBindLR Name Name)]
 #endif
 hsGroupVals hsGroup =
   filter (isGoodSrcSpan . getLoc) $
@@ -391,7 +417,12 @@ hsGroupVals hsGroup =
 hsPatSynDetails :: HsPatSynDetails a -> [a]
 hsPatSynDetails patDetails =
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-    []
+  case patDetails of
+    InfixCon name1 name2 -> [name1, name2]    
+    PrefixCon fields -> fields
+    RecCon fields -> concatMap
+        (\field -> [recordPatSynSelectorId field, recordPatSynPatVar field])
+        fields
 #else
   case patDetails of
     InfixPatSyn name1 name2 -> [name1, name2]
@@ -404,7 +435,7 @@ hsPatSynDetails patDetails =
 
 
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
---unwrapName :: LIEWrappedName n -> Located n
+unwrapName :: LIEWrappedName a -> Located a
 unwrapName = ieLWrappedName
 #elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
 unwrapName :: LIEWrappedName Name -> Located Name
@@ -414,7 +445,11 @@ unwrapName :: Located Name -> Located Name
 unwrapName n = n
 #endif
 
---ieLocNames :: IE (IdP GhcTc) -> [Located Name]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ieLocNames :: IE pass -> [Located (IdP pass)]
+#else
+ieLocNames :: IE Name -> [Located Name]
+#endif
 ieLocNames (IEVar n) = [unwrapName n]
 ieLocNames (IEThingAbs n) = [unwrapName n]
 ieLocNames (IEThingAll n) = [unwrapName n]
@@ -932,7 +967,11 @@ collectDocs = go Nothing []
     go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
     finished decl docs rest = (decl, reverse docs) : rest
 
---ungroup :: HsGroup Name -> [LHsDecl Name]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
+#else
+ungroup :: HsGroup Name -> [LHsDecl Name]
+#endif
 ungroup group_ =
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
   mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD group_ ++  
@@ -962,7 +1001,11 @@ mkDecls field con struct = [L loc (con decl) | L loc decl <- field struct]
 sortByLoc :: [Located a] -> [Located a]
 sortByLoc = L.sortBy (comparing getLoc)
 
---classDeclDocs :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+classDeclDocs :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
+#else
+classDeclDocs :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]
+#endif
 classDeclDocs class_ = collectDocs . sortByLoc $ decls
   where
     decls = docs ++ defs ++ sigs ++ ats
@@ -971,13 +1014,21 @@ classDeclDocs class_ = collectDocs . sortByLoc $ decls
     sigs = mkDecls tcdSigs SigD class_
     ats = mkDecls tcdATs (TyClD . FamDecl) class_
 
---conDeclDocs :: ConDecl Name -> [(Name, [HsDocString], SrcSpan)]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+conDeclDocs :: ConDecl GhcRn -> [(Name, [HsDocString], SrcSpan)]
+#else
+conDeclDocs :: ConDecl Name -> [(Name, [HsDocString], SrcSpan)]
+#endif
 conDeclDocs conDecl =
   map (\(L span n) -> (n, maybe [] ((: []) . unLoc) $ con_doc conDecl, span)) .
   getConNames $
   conDecl
 
---selectorDocs :: ConDecl name -> [(PostRn name name, [HsDocString], SrcSpan)]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+selectorDocs :: ConDecl pass -> [(PostRn pass (IdP pass), [HsDocString], SrcSpan)]
+#else
+selectorDocs :: ConDecl name -> [(PostRn name name, [HsDocString], SrcSpan)]
+#endif
 selectorDocs con =
   case getConDetails con of
     RecCon (L _ flds) ->
@@ -990,15 +1041,13 @@ selectorDocs con =
         flds
     _ -> []
 
-
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)    
 subordinateNamesWithDocs :: [GenLocated SrcSpan (HsDecl GhcRn)] -> [(Name, [HsDocString], SrcSpan)]
-#endif
-subordinateNamesWithDocs _ =
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)    
-  []
 #else
-  concatMap
+subordinateNamesWithDocs :: [GenLocated SrcSpan (HsDecl Name)] -> [(Name, [HsDocString], SrcSpan)]
+#endif
+subordinateNamesWithDocs =
+    concatMap
     (\(L span tyClDecl) ->
        case tyClDecl of
          TyClD classDecl@ClassDecl {..} ->
@@ -1009,16 +1058,24 @@ subordinateNamesWithDocs _ =
            concatMap (\(L _ con) -> conDeclDocs con ++ selectorDocs con) $
            dd_cons tcdDataDefn
          InstD (DataFamInstD DataFamInstDecl {..}) ->
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)               
+           concatMap (conDeclDocs . unLoc) . dd_cons . feqn_rhs  . hsib_body $ dfid_eqn
+#else
            concatMap (conDeclDocs . unLoc) . dd_cons $ dfid_defn
-         _ -> [])
 #endif
+         _ -> [])
+
     
 isUserLSig :: LSig name -> Bool
 isUserLSig (L _ TypeSig {})    = True
 isUserLSig (L _ ClassOpSig {}) = True
 isUserLSig _ = False
 
---getMainDeclBinder :: HsDecl name -> [name]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+getMainDeclBinder :: HsDecl pass -> [IdP pass]
+#else
+getMainDeclBinder :: HsDecl name -> [name]
+#endif
 getMainDeclBinder (TyClD d) = [tcdName d]
 getMainDeclBinder (ValD d) =
   case collectHsBindBinders d of
@@ -1029,7 +1086,11 @@ getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
 getMainDeclBinder (ForD ForeignExport {}) = []
 getMainDeclBinder _ = []
 
---sigNameNoLoc :: Sig name -> [name]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+sigNameNoLoc :: Sig pass -> [IdP pass]    
+#else    
+sigNameNoLoc :: Sig name -> [name]
+#endif
 sigNameNoLoc (TypeSig      ns _)       = map unLoc ns
 sigNameNoLoc (ClassOpSig _ ns _)       = map unLoc ns
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
@@ -1042,7 +1103,7 @@ sigNameNoLoc (InlineSig    n _)        = [unLoc n]
 sigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns
 sigNameNoLoc _                         = []
 
-clsInstDeclSrcSpan :: ClsInstDecl name -> SrcSpan
+clsInstDeclSrcSpan :: ClsInstDecl a -> SrcSpan
 clsInstDeclSrcSpan ClsInstDecl {cid_poly_ty = ty} = getLoc (hsSigType ty)
 
 hsDocsToDocH :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Doc Name
@@ -1120,6 +1181,9 @@ rename dflags gre = rn
       DocEmpty -> DocEmpty
       DocString str -> DocString str
       DocHeader (Header l t) -> DocHeader $ Header l (rn t)
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)      
+      DocTable t -> DocTable (rn <$> t)
+#endif
 
 -- | Wrap an identifier that's out of scope (i.e. wasn't found in
 -- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently
-- 
cgit v1.2.3