aboutsummaryrefslogtreecommitdiff
path: root/src/HaskellCodeExplorer
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaskellCodeExplorer')
-rw-r--r--src/HaskellCodeExplorer/GhcUtils.hs52
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