aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/HaskellCodeExplorer/GhcUtils.hs94
-rw-r--r--src/HaskellCodeExplorer/Preprocessor.hs2
2 files changed, 50 insertions, 46 deletions
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index 89cd4bc..0801dc0 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE TupleSections #-}
@@ -452,13 +453,12 @@ lookupNameModuleAndPackage
-> HCE.PackageId
-> Name
-> Either T.Text (HCE.HaskellModuleName, HCE.PackageId)
-lookupNameModuleAndPackage state currentPackageId name =
- case nameModule_maybe name of
+lookupNameModuleAndPackage state currentPackageId@HCE.PackageId { name = pkgIdName } name
+ = case nameModule_maybe name of
Just Module {..} -> case lookupUnit state moduleUnit of
Just unitInfo ->
let packageId =
- if (T.pack . unitPackageNameString $ unitInfo)
- == HCE.name (currentPackageId :: HCE.PackageId)
+ if (T.pack . unitPackageNameString $ unitInfo) == pkgIdName
then currentPackageId
else HCE.PackageId (T.pack $ unitPackageNameString unitInfo)
(unitPackageVersion unitInfo)
@@ -534,11 +534,10 @@ moduleLocationInfo unitState moduleNameMap currentPackageId compId moduleName =
isDefinedInCurrentModule
:: HCE.SourceCodeTransformation -> HCE.HaskellFilePath -> Bool
-isDefinedInCurrentModule transformation file =
- let includedFiles = HM.keys $ HCE.fileIndex transformation
- modPath = HCE.getHaskellModulePath
- $ HCE.filePath (transformation :: HCE.SourceCodeTransformation)
- in HCE.getHaskellFilePath file == modPath || (file `elem` includedFiles)
+isDefinedInCurrentModule transformation@HCE.SourceCodeTransformation {..} file
+ = let includedFiles = HM.keys $ HCE.fileIndex transformation
+ modPath = HCE.getHaskellModulePath filePath
+ in HCE.getHaskellFilePath file == modPath || (file `elem` includedFiles)
nameLocationInfo
:: UnitState
@@ -551,7 +550,7 @@ nameLocationInfo
-> Maybe SrcSpan -- ^ Only for wired-in names
-> Name
-> HCE.LocationInfo
-nameLocationInfo unitState currentPackageId compId transformation fileMap defSiteMap mbInstanceHead mbSrcSpan name
+nameLocationInfo unitState currentPackageId compId transformation@HCE.SourceCodeTransformation { filePath = modulePath } fileMap defSiteMap mbInstanceHead mbSrcSpan name
| Just srcSpan <- realSrcSpan name mbSrcSpan
= let
filePath =
@@ -579,22 +578,21 @@ nameLocationInfo unitState currentPackageId compId transformation fileMap defSit
in
case (,) eitherStart eitherEnd of
(Right startLine, Right endLine) ->
- let
- modulePath = HCE.filePath
- (transformation :: HCE.SourceCodeTransformation)
- moduleName = either
- (const $ HCE.HaskellModuleName "")
- fst
- (lookupNameModuleAndPackage unitState currentPackageId name)
- in
- HCE.ExactLocation { packageId = currentPackageId
- , modulePath = modulePath
- , moduleName = moduleName
- , startLine = startLine
- , endLine = endLine
- , startColumn = srcSpanStartCol srcSpan
- , endColumn = srcSpanEndCol srcSpan
- }
+ let moduleName = either
+ (const $ HCE.HaskellModuleName "")
+ fst
+ (lookupNameModuleAndPackage unitState
+ currentPackageId
+ name
+ )
+ in HCE.ExactLocation { packageId = currentPackageId
+ , modulePath = modulePath
+ , moduleName = moduleName
+ , startLine = startLine
+ , endLine = endLine
+ , startColumn = srcSpanStartCol srcSpan
+ , endColumn = srcSpanEndCol srcSpan
+ }
_ -> approximateLocation
else case HM.lookup filePath fileMap of
Just haskellModulePath ->
@@ -675,22 +673,28 @@ occNameLocationInfo flags packageId componentId (modName, occName) =
lookupEntityLocation
:: HCE.DefinitionSiteMap -> HCE.LocatableEntity -> T.Text -> HCE.LocationInfo
lookupEntityLocation defSiteMap locatableEntity text =
- let errorMessage = T.concat
- ["Cannot find location of ", T.pack . show $ locatableEntity, " ", text]
- defSiteLocation = HCE.location :: HCE.DefinitionSite -> HCE.LocationInfo
- lookupLocation
- :: (Eq a, Hashable a)
- => (HCE.DefinitionSiteMap -> HM.HashMap a HCE.DefinitionSite)
- -> (T.Text -> a)
- -> HCE.LocationInfo
- lookupLocation selector toKey =
- maybe (HCE.UnknownLocation errorMessage) defSiteLocation
- $ HM.lookup (toKey text) (selector defSiteMap)
- in case locatableEntity of
- HCE.Val -> lookupLocation HCE.values HCE.OccName
- HCE.Typ -> lookupLocation HCE.types HCE.OccName
- HCE.Inst -> lookupLocation HCE.instances (\t -> t)
- HCE.Mod -> HCE.UnknownLocation errorMessage
+ let
+ errorMessage = T.concat
+ ["Cannot find location of ", T.pack . show $ locatableEntity, " ", text]
+ defSiteLocation HCE.DefinitionSite {..} = location
+ lookupLocation
+ :: (Eq a, Hashable a)
+ => (HCE.DefinitionSiteMap -> HM.HashMap a HCE.DefinitionSite)
+ -> (T.Text -> a)
+ -> HCE.LocationInfo
+ lookupLocation selector toKey =
+ maybe (HCE.UnknownLocation errorMessage) defSiteLocation
+ $ HM.lookup (toKey text) (selector defSiteMap)
+ in
+ case locatableEntity of
+ HCE.Val ->
+ lookupLocation (\HCE.DefinitionSiteMap { values } -> values) HCE.OccName
+ HCE.Typ ->
+ lookupLocation (\HCE.DefinitionSiteMap { types } -> types) HCE.OccName
+ HCE.Inst -> lookupLocation
+ (\HCE.DefinitionSiteMap { instances } -> instances)
+ (\t -> t)
+ HCE.Mod -> HCE.UnknownLocation errorMessage
nameDocumentation
:: HCE.SourceCodeTransformation
@@ -720,9 +724,9 @@ lookupNameDocumentation name defSiteMap =
lookupDoc selector = maybe Nothing HCE.documentation
$ HM.lookup key (selector (defSiteMap :: HCE.DefinitionSiteMap))
in case occNameNameSpace . nameOccName $ name of
- HCE.VarName -> lookupDoc HCE.values
- HCE.DataName -> lookupDoc HCE.values
- _ -> lookupDoc HCE.types
+ HCE.VarName -> lookupDoc (\HCE.DefinitionSiteMap { values } -> values)
+ HCE.DataName -> lookupDoc (\HCE.DefinitionSiteMap { values } -> values)
+ _ -> lookupDoc (\HCE.DefinitionSiteMap { types } -> types)
srcSpanToFilePath :: SrcSpan -> Maybe HCE.HaskellFilePath
srcSpanToFilePath (RealSrcSpan s _) =
diff --git a/src/HaskellCodeExplorer/Preprocessor.hs b/src/HaskellCodeExplorer/Preprocessor.hs
index abea661..eb832ce 100644
--- a/src/HaskellCodeExplorer/Preprocessor.hs
+++ b/src/HaskellCodeExplorer/Preprocessor.hs
@@ -49,7 +49,7 @@ createSourceCodeTransformation currentModulePath originalSourceCode sourceCodeAf
Left _ -> acc
totalLines = length numberedLines
pragmas = L.reverse . L.foldl' addPragma [] $ numberedLines
- pragmaPath = filePath :: LinePragma -> HaskellFilePath
+ pragmaPath LinePragma {..} = filePath
currentFileExtension =
takeExtension . T.unpack . getHaskellFilePath $ currentFilePath
standardHeaderFiles =