more fixes to ghcutils

1 files changed, 24 insertions, 28 deletions

diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index 16e9e00..b408570 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -92,6 +92,7 @@ import GHC
   ( DynFlags
   , unXRec
   , UnXRec
+  , GhcPass
   , XRec
   , LConDeclField
   , recordPatSynField
@@ -137,6 +138,7 @@ import GHC
   , tcdName
   , collectHsBindBinders
   , getLoc
+  , getLocA
 --  , hsSigType
   , getConNames
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
@@ -203,8 +205,9 @@ 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)
+import GHC.Parser.Lexer
+  ( ParseResult(POk)
+  , initParserState
   , unP
   )
 -- import Module (Module(..))
@@ -233,6 +236,7 @@ import GHC.Types.Name
 import GHC.Types.Name.Occurrence (OccName)
 -- import Outputable (Outputable, ppr, showPpr, showSDoc)
 import GHC.Utils.Outputable (Outputable, ppr)
+import GHC.Driver.Config (initParserOpts)
 import GHC.Driver.Ppr (showPpr, showSDoc)
 -- import PackageConfig (packageVersion)
 -- import Packages
@@ -498,19 +502,11 @@ mbIdDetails _ = Nothing
 --  Syntax transformation
 --------------------------------------------------------------------------------
 
-#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 GhcRn -> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
 hsGroupVals hsGroup =
-  filter (isGoodSrcSpan . getLoc) $
+  filter (isGoodSrcSpan . getLocA) $
   case hs_valds hsGroup of
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
     XValBindsLR (NValBinds binds _) -> concatMap (bagToList . snd) binds
-#else
-    ValBindsOut binds _ -> concatMap (bagToList . snd) binds
-#endif
     _ -> []
 
 hsPatSynDetails :: HsPatSynDetails GhcRn -> [Name]
@@ -626,7 +622,7 @@ lookupNameModuleAndPackage state currentPackageId name =
                   then currentPackageId
                   else HCE.PackageId
                          (T.pack $ unitPackageNameString unitInfo)
-                         (packageVersion unitInfo)
+                         (unitPackageVersion unitInfo)
            in Right
                 ( HCE.HaskellModuleName . T.pack . moduleNameString $ moduleName
                 , packageId)
@@ -674,14 +670,14 @@ moduleLocationInfo flags unitState moduleNameMap currentPackageId compId moduleN
               1
               1
         _ ->
-          case lookupModuleWithSuggestions flags moduleName Nothing of
+          case lookupModuleWithSuggestions unitState moduleName Nothing of
             LookupFound Module {moduleUnit = unitId} _ ->
-              case lookupUnitId unitState unitId of
+              case lookupUnit unitState unitId of
                 Just unitInfo ->
                   let packageId =
                         HCE.PackageId
                           (T.pack $ unitPackageNameString unitInfo)
-                          (packageVersion unitInfo)
+                          (unitPackageVersion unitInfo)
                    in HCE.ApproximateLocation
                         packageId
                         (HCE.HaskellModuleName . T.pack . moduleNameString $
@@ -705,7 +701,7 @@ isDefinedInCurrentModule transformation file =
    in HCE.getHaskellFilePath file == modPath || (file `elem` includedFiles)
 
 nameLocationInfo ::
-     DynFlags
+     UnitState
   -> HCE.PackageId
   -> HCE.ComponentId
   -> HCE.SourceCodeTransformation
@@ -715,14 +711,14 @@ nameLocationInfo ::
   -> Maybe SrcSpan -- ^ Only for wired-in names
   -> Name
   -> HCE.LocationInfo
-nameLocationInfo flags currentPackageId compId transformation fileMap defSiteMap mbInstanceHead mbSrcSpan name
+nameLocationInfo unitState currentPackageId compId transformation fileMap defSiteMap mbInstanceHead mbSrcSpan name
   | Just srcSpan <- realSrcSpan name mbSrcSpan =
     let filePath =
           HCE.HaskellFilePath . T.pack . normalise . unpackFS . srcSpanFile $
           srcSpan
         approximateLocation =
           mkApproximateLocation
-            flags
+            unitState
             currentPackageId
             compId
             mbInstanceHead
@@ -743,7 +739,7 @@ nameLocationInfo flags currentPackageId compId transformation fileMap defSiteMap
                                   either
                                     (const $ HCE.HaskellModuleName "")
                                     fst
-                                    (lookupNameModuleAndPackage flags currentPackageId name)
+                                    (lookupNameModuleAndPackage unitState currentPackageId name)
                          in HCE.ExactLocation
                               { packageId = currentPackageId
                               , modulePath = modulePath
@@ -779,20 +775,20 @@ nameLocationInfo flags currentPackageId compId transformation fileMap defSiteMap
                   _ -> Nothing
               _ -> Nothing
         _ -> Nothing
-nameLocationInfo flags currentPackageId compId _transformation _fileMap _defSiteMap mbInstanceHead _mbSrcSpan name =
-  mkApproximateLocation flags currentPackageId compId mbInstanceHead name
+nameLocationInfo unitState currentPackageId compId _transformation _fileMap _defSiteMap mbInstanceHead _mbSrcSpan name =
+  mkApproximateLocation unitState currentPackageId compId mbInstanceHead name
 
 mkApproximateLocation ::
-     DynFlags
+     UnitState
   -> HCE.PackageId
   -> HCE.ComponentId
   -> Maybe T.Text
   -> Name
   -> HCE.LocationInfo
-mkApproximateLocation flags currentPackageId compId mbInstanceHead name =
+mkApproximateLocation unitState currentPackageId compId mbInstanceHead name =
   let haddockAnchor =
         Just . T.pack . makeAnchorId . T.unpack . nameToText $ name
-   in case lookupNameModuleAndPackage flags currentPackageId name of
+   in case lookupNameModuleAndPackage unitState currentPackageId name of
         Right (moduleName, packageId) ->
           HCE.ApproximateLocation
             { moduleName = moduleName
@@ -1297,8 +1293,8 @@ sigNameNoLoc (InlineSig _ n _) = [unXRec @p n]
 sigNameNoLoc (FixSig _ (FixitySig _ ns _)) = map (unXRec @p) ns
 sigNameNoLoc _                         = []
 
-clsInstDeclSrcSpan :: ClsInstDecl a -> SrcSpan
-clsInstDeclSrcSpan ClsInstDecl {cid_poly_ty = ty} = getLoc (hsSigType ty)
+clsInstDeclSrcSpan :: ClsInstDecl (GhcPass p) -> SrcSpan
+clsInstDeclSrcSpan ClsInstDecl {cid_poly_ty = ty} = getLocA ty
 #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
 clsInstDeclSrcSpan (XClsInstDecl _) = UnhelpfulSpan "XClsinstdecl"
 #endif
@@ -1323,7 +1319,7 @@ parseIdent :: DynFlags -> String -> Maybe RdrName
 parseIdent dflags str0 =
   let buffer = stringToStringBuffer str0
       realSrcLc = mkRealSrcLoc (mkFastString "<unknown file>") 0 0
-      pstate = mkPState dflags buffer realSrcLc
+      pstate = initParserState (initParserOpts dflags) buffer realSrcLc
   in case unP parseIdentifier pstate of
     POk _ name -> Just (unLoc name)
     _ -> Nothing