diff options
| -rw-r--r-- | src/HaskellCodeExplorer/GhcUtils.hs | 94 | ||||
| -rw-r--r-- | src/HaskellCodeExplorer/Preprocessor.hs | 2 |
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 = |