porting to ghc9.2.2: fixing ghcutils

2 files changed, 141 insertions, 95 deletions

diff --git a/haskell-code-explorer.cabal b/haskell-code-explorer.cabal
index ba96f89..06cb5c8 100644
--- a/haskell-code-explorer.cabal
+++ b/haskell-code-explorer.cabal
@@ -28,6 +28,7 @@ library
                , blaze-html
                , deepseq
                , bytestring
+               , Cabal
                , cabal-helper
                , cereal
                , containers
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index 0f3ff1c..2a40213 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -57,8 +57,10 @@ module HaskellCodeExplorer.GhcUtils
   , hsDocsToDocH
   , subordinateNamesWithDocs
   ) where
-import Bag (bagToList)
-import ConLike (ConLike(..))
+-- import Bag (bagToList)
+import GHC.Data.Bag (bagToList)
+-- import ConLike (ConLike(..))
+import GHC.Core.ConLike (ConLike(..))
 import qualified Data.ByteString as BS
 import Data.Hashable (Hashable,hash)
 import qualified Data.ByteString.Internal as BSI
@@ -71,14 +73,17 @@ import qualified Data.HashMap.Strict as HM
 import qualified Data.List as L
 import Data.Maybe (fromMaybe, isJust, mapMaybe)
 import qualified Data.Text as T
-import DataCon (dataConWorkId, flSelector)
+-- import DataCon (dataConWorkId, flSelector)
+import GHC.Core.DataCon (dataConWorkId, flSelector)
 import Documentation.Haddock.Parser (overIdentifier, parseParas)
 import Documentation.Haddock.Types (DocH(..),
                                     Header(..),
                                     _doc
  )
-import DynFlags ()
-import FastString (mkFastString, unpackFS)
+-- import DynFlags ()
+import GHC.Driver.Session (DynFlags)
+-- import FastString (mkFastString, unpackFS)
+import GHC.Data.FastString (mkFastString, unpackFS)
 import GHC
   ( DynFlags
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
@@ -121,13 +126,13 @@ import GHC
   , tcdName
   , collectHsBindBinders
   , getLoc
-  , hsSigType
+--  , hsSigType
   , getConNames
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
   , NHsValBindsLR(..)
-  , getConArgs
+--  , getConArgs
   , unpackHDS
-  , NoExt(..)
+--  , NoExt(..)
   , extFieldOcc
 #else
   , getConDetails
@@ -153,36 +158,47 @@ import GHC
   , srcSpanEndCol
   , isExternalName
   , moduleNameString
-  , recordPatSynSelectorId
+--  , recordPatSynSelectorId
   , recordPatSynPatVar
   , isGoodSrcSpan
   , isLocalId
   , isDataFamilyDecl
   , tyFamInstDeclName
   , idType
-  , hsib_body
+--  , hsib_body
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
 #else
   , tfe_pats
 #endif
   , tfid_eqn
 #if MIN_VERSION_ghc(8,8,0)
-  , dL
-  , HasSrcSpan
-  , SrcSpanLess 
+--  , dL
+--  , HasSrcSpan
+--  , SrcSpanLess 
 #endif
   )
 
 import qualified HaskellCodeExplorer.Types as HCE
-import HscTypes (TypeEnv, lookupTypeEnv)
+-- import HscTypes (TypeEnv, lookupTypeEnv)
+import GHC.Types.TypeEnv (TypeEnv, lookupTypeEnv)
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-import HsExtension (GhcRn,IdP)
-#endif
-import IdInfo (IdDetails(..))
-import InstEnv (ClsInst(..))
-import Lexer (ParseResult(POk), mkPState, unP)
-import Module (Module(..))
-import Name
+-- import HsExtension (GhcRn,IdP)
+import GHC.Hs.Extension (GhcRn)
+import Language.Haskell.Syntax.Extension (IdP)
+#endif
+-- import IdInfo (IdDetails(..))
+import GHC.Types.Id.Info (IdDetails(..))
+-- import InstEnv (ClsInst(..))
+import GHC.Core.InstEnv (ClsInst(..))
+-- import GHC.Parser.Lexer (ParseResult(POk), mkPState, unP)
+import GHC.Parser.Lexer (
+  ParseResult(POk)
+  , unP
+  )
+-- import Module (Module(..))
+import GHC.Unit.Types (Module(..))
+-- import Name
+import GHC.Types.Name
   ( isDataConNameSpace
   , isDerivedOccName
   , isInternalName
@@ -201,63 +217,84 @@ import Name
   , occNameString
   , wiredInNameTyThing_maybe
   )
-import OccName (OccName)
-import Outputable (Outputable, ppr, showPpr, showSDoc)
-import PackageConfig (packageVersion)
-import Packages
+-- import OccName (OccName)
+import GHC.Types.Name.Occurrence (OccName)
+-- import Outputable (Outputable, ppr, showPpr, showSDoc)
+import GHC.Utils.Outputable (Outputable, ppr)
+import GHC.Driver.Ppr (showPpr, showSDoc)
+-- import PackageConfig (packageVersion)
+-- import Packages
+import Distribution.Package (packageVersion)
+import GHC.Unit.State
   ( LookupResult(..)
   , lookupModuleWithSuggestions
-  , lookupPackage
-  , packageNameString
+--  , lookupPackage
+--  , packageNameString
   )
-import Pair (pSnd)
-import Parser (parseIdentifier)
-import PatSyn (PatSyn, patSynMatcher, patSynSig)
+-- import Pair (pSnd)
+import GHC.Data.Pair (pSnd)
+-- import Parser (parseIdentifier)
+import GHC.Parser (parseIdentifier)
+-- import PatSyn (PatSyn, patSynMatcher, patSynSig)
+import GHC.Core.PatSyn (PatSyn, patSynMatcher, patSynSig)
 import Prelude hiding (id, span)
-import RdrName (GlobalRdrEnv, RdrName(..), gre_name, lookupGRE_RdrName)
-import RnEnv (dataTcOccs)
-import SrcLoc (GenLocated(..), mkRealSrcLoc, unLoc)
-import StringBuffer (StringBuffer(..), stringToStringBuffer)
+-- import RdrName (GlobalRdrEnv, RdrName(..), gre_name, lookupGRE_RdrName)
+import GHC.Types.Name.Reader (GlobalRdrEnv, RdrName(..), gre_name, lookupGRE_RdrName)
+-- import RnEnv (dataTcOccs)
+import GHC.Rename.Env (dataTcOccs)
+-- import SrcLoc (GenLocated(..), mkRealSrcLoc, unLoc)
+import GHC.Types.SrcLoc (GenLocated(..), mkRealSrcLoc, unLoc)
+-- import StringBuffer (StringBuffer(..), stringToStringBuffer)
+import GHC.Data.StringBuffer (StringBuffer(..), stringToStringBuffer)
 import System.FilePath (normalise)
-import TcEvidence (HsWrapper(..), tcCoercionKind)
-import TcType (evVarPred)
-import TyCoRep (Type(..),
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-  ArgFlag(..)
-#else
-  VisibilityFlag(..)
-#endif
+-- import TcEvidence (HsWrapper(..), tcCoercionKind)
+import GHC.Tc.Types.Evidence (HsWrapper(..), tcCoercionKind)
+-- import TcType (evVarPred)
+import GHC.Tc.Utils.TcType (evVarPred)
+import GHC.Core.TyCo.Rep (Type(..),
+
+  ArgFlag(..), mkVisFunTysMany
+
+
+
  )
-import TyCon (tyConName)
-import Type
+-- import TyCon (tyConName)
+import GHC.Core.TyCon (tyConName)
+-- import Type
+import GHC.Core.Type
   ( coreView
   , expandTypeSynonyms
   , mkForAllTy
   , mkFunTy
-  , mkFunTys
-  , mkInvForAllTys
-#if !MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-  , mkNamedBinder
-#endif
+--  , mkFunTys
+--  , mkInvForAllTys
+
+
+
   , piResultTy
-  , pprSigmaType
   , splitFunTy_maybe
-  , tidyOpenType
+  , tidyOpenType, mkVisForAllTys
   )
+import GHC.Core.TyCo.Ppr (pprSigmaType)
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-import ToIface
-import IfaceType
-#endif
-import TysWiredIn (unitTy)
-import UniqSet (emptyUniqSet, unionUniqSets,
+import GHC.CoreToIface
+-- import IfaceType
+import GHC.Iface.Type
+#endif
+-- import TysWiredIn (unitTy)
+import GHC.Builtin.Types (unitTy)
+-- import UniqSet (emptyUniqSet, unionUniqSets,
+import GHC.Types.Unique.Set (emptyUniqSet, unionUniqSets,
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
    nonDetEltsUniqSet
 #else
    uniqSetToList
 #endif
  )
-import Unique (getKey)
-import Var
+-- import Unique (getKey)
+import GHC.Types.Unique (getKey)
+-- import Var
+import GHC.Types.Var
   ( idDetails
   , isId
   , mkTyVar
@@ -266,13 +303,16 @@ import Var
   , varType
   , varUnique
   )
-import VarEnv (TidyEnv)
-import VarSet (VarSet, emptyVarSet, unionVarSet, unitVarSet
+-- import VarEnv (TidyEnv)
+import GHC.Types.Var.Env (TidyEnv)
+-- import VarSet (VarSet, emptyVarSet, unionVarSet, unitVarSet
+import GHC.Types.Var.Set (VarSet, emptyVarSet, unionVarSet, unitVarSet
 #if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
 #else
  ,varSetElems
 #endif
  )
+import GHC.Unit
 
 --------------------------------------------------------------------------------
 -- Pretty-printing
@@ -302,18 +342,18 @@ instanceDeclToText flags decl =
       T.append "instance " (toText flags cid_poly_ty)
 
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,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]
+    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]
 #elif MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
     DataFamInstD di ->
       let args =
@@ -464,9 +504,10 @@ hsPatSynDetails patDetails =
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
   case patDetails of
     InfixCon name1 name2 -> [name1, name2]
-    PrefixCon fields -> fields
+    PrefixCon _ fields -> fields
     RecCon fields -> concatMap
-        (\field -> [recordPatSynSelectorId field, recordPatSynPatVar field])
+        (\field -> [-- recordPatSynSelectorId field,
+                    recordPatSynPatVar field])
         fields
 #else
   case patDetails of
@@ -481,7 +522,7 @@ hsPatSynDetails patDetails =
 
 #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
 unwrapName :: LIEWrappedName a -> Located a
-unwrapName = ieLWrappedName
+unwrapName = undefined
 #elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
 unwrapName :: LIEWrappedName Name -> Located Name
 unwrapName = ieLWrappedName
@@ -498,11 +539,10 @@ ieLocNames :: IE Name -> [Located Name]
 
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
 ieLocNames (XIE _) = []
-ieLocNames (IEVar _ n) =
+ieLocNames (IEVar _ n) = []
 #else
-ieLocNames (IEVar n) =
+ieLocNames (IEVar n) =  [unwrapName n]
 #endif
-  [unwrapName n]
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
 ieLocNames (IEThingAbs _ n) =
 #else
@@ -515,12 +555,16 @@ ieLocNames (IEThingAll _ n) =
 ieLocNames (IEThingAll n) =
 #endif
   [unwrapName n]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
+#if MIN_VERSION_GLASGOW_HASKELL(9,2,1,0)
+ieLocNames (IEThingWith _ n _ ns) =
+  unwrapName n : (map unwrapName ns)
+#elif MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
 ieLocNames (IEThingWith _ n _ ns labels) =
+  unwrapName n : (map unwrapName ns ++ map (fmap flSelector) labels)
 #else
 ieLocNames (IEThingWith n _ ns labels) =
-#endif
   unwrapName n : (map unwrapName ns ++ map (fmap flSelector) labels)
+#endif
 ieLocNames IEModuleContents {} = []
 ieLocNames IEGroup {} = []
 ieLocNames IEDoc {} = []
@@ -558,7 +602,7 @@ lookupNameModuleAndPackage flags currentPackageId name =
                   then currentPackageId
                   else HCE.PackageId
                          (T.pack $ packageNameString packageConfig)
-                         (PackageConfig.packageVersion packageConfig)
+                         (packageVersion packageConfig)
            in Right
                 ( HCE.HaskellModuleName . T.pack . moduleNameString $ moduleName
                 , packageId)
@@ -606,13 +650,13 @@ moduleLocationInfo flags moduleNameMap currentPackageId compId moduleName =
               1
         _ ->
           case lookupModuleWithSuggestions flags moduleName Nothing of
-            LookupFound Module {moduleUnitId = unitId} _ ->
+            LookupFound Module {moduleUnit = unitId} _ ->
               case lookupPackage flags unitId of
                 Just packInfo ->
                   let packageId =
                         HCE.PackageId
                           (T.pack $ packageNameString packInfo)
-                          (PackageConfig.packageVersion packInfo)
+                          (packageVersion packInfo)
                    in HCE.ApproximateLocation
                         packageId
                         (HCE.HaskellModuleName . T.pack . moduleNameString $
@@ -700,13 +744,13 @@ nameLocationInfo flags currentPackageId compId transformation fileMap defSiteMap
     realSrcSpan :: Name -> Maybe SrcSpan -> Maybe RealSrcSpan
     realSrcSpan n mbSpan =
       case nameSrcSpan n of
-        RealSrcSpan span -> Just span
+        RealSrcSpan span _ -> Just span
         _
           | isWiredInName n ->
             case mbSpan of
               Just span ->
                 case span of
-                  RealSrcSpan s -> Just s
+                  RealSrcSpan s _ -> Just s
                   _ -> Nothing
               _ -> Nothing
         _ -> Nothing
@@ -828,7 +872,7 @@ lookupNameDocumentation name defSiteMap =
         _ -> lookupDoc HCE.types
 
 srcSpanToFilePath :: SrcSpan -> Maybe HCE.HaskellFilePath
-srcSpanToFilePath (RealSrcSpan s) =
+srcSpanToFilePath (RealSrcSpan s _) =
   Just . HCE.HaskellFilePath . T.pack . normalise . unpackFS . srcSpanFile $ s
 srcSpanToFilePath (UnhelpfulSpan _) = Nothing
 
@@ -836,7 +880,7 @@ srcSpanToLineAndColNumbers ::
      HCE.SourceCodeTransformation
   -> SrcSpan
   -> Maybe (HCE.HaskellFilePath, (Int, Int), (Int, Int))
-srcSpanToLineAndColNumbers transformation (RealSrcSpan s) =
+srcSpanToLineAndColNumbers transformation (RealSrcSpan s _) =
   let filePath =
         HCE.HaskellFilePath . T.pack . normalise . unpackFS . srcSpanFile $ s
       eitherStart =
@@ -880,9 +924,10 @@ patSynId patSyn =
         | otherwise = reqTheta
       --  required => provided => arg_1 -> ... -> arg_n -> res
       patSynTy =
-        mkInvForAllTys univTvs $
-        mkFunTys reqTheta' $
-        mkInvForAllTys exTvs $ mkFunTys provTheta $ mkFunTys argTys resTy
+        mkVisForAllTys univTvs $
+        mkVisFunTysMany reqTheta' $
+        mkVisForAllTys exTvs $ mkVisFunTysMany provTheta $
+        mkVisFunTysMany argTys resTy
    in flip setVarType patSynTy . fst . patSynMatcher $ patSyn
 
 applyWrapper :: HsWrapper -> Type -> Type
@@ -1408,10 +1453,10 @@ makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r
     isLegal '.' = True
     isLegal c = isAscii c && isAlphaNum c
 
-#if MIN_VERSION_ghc(8,8,0)
-ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a)
-ghcDL = GHC.dL
-#else
+-- #if MIN_VERSION_ghc(8,8,0)
+-- ghcDL :: GHC.RealSrcSpan a => a -> GHC.Located (GHC.SrcSpan a)
+-- ghcDL = GHC.dL
+-- #else
 ghcDL :: GHC.Located a -> GHC.Located a
 ghcDL x = x
-#endif
+-- #endif