aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/HaskellCodeExplorer/ModuleInfo.hs9
-rw-r--r--src/HaskellCodeExplorer/PackageInfo.hs29
-rw-r--r--test/Main.hs25
3 files changed, 31 insertions, 32 deletions
diff --git a/src/HaskellCodeExplorer/ModuleInfo.hs b/src/HaskellCodeExplorer/ModuleInfo.hs
index 5aeb6bd..c651945 100644
--- a/src/HaskellCodeExplorer/ModuleInfo.hs
+++ b/src/HaskellCodeExplorer/ModuleInfo.hs
@@ -28,7 +28,8 @@ import qualified Data.IntervalMap.Strict as IVM
import qualified Data.List as L
hiding ( span )
import qualified Data.Map.Strict as M
-import Data.Maybe ( fromMaybe
+import Data.Maybe ( fromJust
+ , fromMaybe
, mapMaybe
)
import qualified Data.Set as S
@@ -168,7 +169,7 @@ createModuleInfo (fileMap, defSiteMap, moduleNameMap) (flags, unitState, typeche
= let
globalRdrEnv = tcg_rdr_env . fst . tm_internals_ $ typecheckedModule
modInfo = moduleInfo typecheckedModule
- (Just (hsGroup, _, _, _)) = renamedSource typecheckedModule
+ (hsGroup, _, _, _) = fromJust $ renamedSource typecheckedModule
exportedNamesSet = S.fromList $ modInfoExportsWithSelectors modInfo
--------------------------------------------------------------------------------
-- Preprocessed source
@@ -615,8 +616,8 @@ createDeclarations flags hsGroup typeEnv exportedSet transformation =
foldAST :: Environment -> TypecheckedModule -> SourceInfo
foldAST environment typecheckedModule =
let
- (Just renamed@(_, importDecls, mbExported, _)) =
- renamedSource typecheckedModule
+ renamed@(_, importDecls, mbExported, _) =
+ fromJust $ renamedSource typecheckedModule
emptyASTState =
ASTState IVM.empty IM.empty M.empty emptyTidyEnv Nothing environment []
ASTState {..} = execState
diff --git a/src/HaskellCodeExplorer/PackageInfo.hs b/src/HaskellCodeExplorer/PackageInfo.hs
index 8e0fbdf..7558fa2 100644
--- a/src/HaskellCodeExplorer/PackageInfo.hs
+++ b/src/HaskellCodeExplorer/PackageInfo.hs
@@ -286,16 +286,15 @@ createPackageInfo packageDirectoryPath mbDistDirRelativePath sourceCodePreproces
)
([], (HM.empty, HM.empty, HM.empty))
buildComponents
- let modId = HCE.id :: HCE.ModuleInfo -> HCE.HaskellModulePath
+ let modId (HCE.ModuleInfo {..}) = id
moduleMap =
HM.fromList
. map (\modInfo -> (modId modInfo, modInfo))
$ indexedModules
references = L.foldl' addReferencesFromModule HM.empty indexedModules
- moduleId = HCE.id :: HCE.ModuleInfo -> HCE.HaskellModulePath
topLevelIdentifiersTrie =
L.foldl' addTopLevelIdentifiersFromModule HCE.emptyTrie
- . L.filter (not . isHsBoot . moduleId)
+ . L.filter (not . isHsBoot . modId)
$ indexedModules
directoryTree <- liftIO $ buildDirectoryTree
packageDirectoryAbsPath
@@ -393,11 +392,9 @@ addReferencesFromModule references modInfo@HCE.ModuleInfo {..} =
eachIdentifierOccurrence
references
modInfo
- (\occMap lineNumber startCol endCol occ ->
- let mbIdExternalId = HCE.externalId =<< maybe
- Nothing
- (`HM.lookup` idInfoMap)
- (HCE.internalId (occ :: HCE.IdentifierOccurrence))
+ (\occMap lineNumber startCol endCol (HCE.IdentifierOccurrence {..}) ->
+ let mbIdExternalId =
+ HCE.externalId =<< maybe Nothing (`HM.lookup` idInfoMap) internalId
idSrcSpan = HCE.IdentifierSrcSpan { modulePath = id
, line = lineNumber
, startColumn = startCol
@@ -452,7 +449,7 @@ indexBuildComponent
-> [String] -- ^ Command-line options for GHC
-> [String] -- ^ Modules to compile
-> LoggingT IO ([HCE.ModuleInfo], ModuleDependencies)
-indexBuildComponent sourceCodePreprocessing currentPackageId componentId deps@(fileMap, defSiteMap, modNameMap) srcDirs libSrcDirs options modules
+indexBuildComponent sourceCodePreprocessing currentPackageId@HCE.PackageId { name = pkgName } componentId deps@(fileMap, defSiteMap, modNameMap) srcDirs libSrcDirs options modules
= do
let onError ex = do
logErrorN $ T.concat
@@ -491,13 +488,13 @@ indexBuildComponent sourceCodePreprocessing currentPackageId componentId deps@(f
setTargets targets
_ <- load LoadAllTargets
modGraph <- getModuleGraph
- let topSortMods = flattenSCCs $ filterToposortToModules
- (topSortModuleGraph False modGraph Nothing)
- buildDir =
- addTrailingPathSeparator . normalise . fromMaybe "" . hiDir $ flags'
- pathsModuleName = "Paths_" ++ map
- (\c -> if c == '-' then '_' else c)
- (T.unpack (HCE.name (currentPackageId :: HCE.PackageId)))
+ let
+ topSortMods = flattenSCCs $ filterToposortToModules
+ (topSortModuleGraph False modGraph Nothing)
+ buildDir =
+ addTrailingPathSeparator . normalise . fromMaybe "" . hiDir $ flags'
+ pathsModuleName =
+ "Paths_" ++ map (\c -> if c == '-' then '_' else c) (T.unpack pkgName)
(modSumWithPath, modulesNotFound) <-
(\(mods, notFound) ->
( L.reverse
diff --git a/test/Main.hs b/test/Main.hs
index d080135..a1e774a 100644
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DuplicateRecordFields #-}
@@ -49,10 +50,10 @@ packageInfoSpec :: FilePath -> Spec
packageInfoSpec currentDir = do
eitherPackageInfo <- runIO $ buildAndIndexTestPackage currentDir
case eitherPackageInfo of
- Right packageInfo -> do
+ Right HCE.PackageInfo{id=pkgId, ..} -> do
describe "createPackageInfo" $ do
it "returns valid package id" $
- HCE.id (packageInfo :: PackageInfo ModuleInfo) `shouldBe`
+ pkgId `shouldBe`
PackageId "test-package" (makeVersion [0, 1, 0, 0])
it "returns valid list of module paths" $ do
let paths =
@@ -67,7 +68,7 @@ packageInfoSpec currentDir = do
, ())
]
(HM.map (const ()))
- (HCE.moduleMap (packageInfo :: PackageInfo ModuleInfo)) `shouldBe`
+ moduleMap `shouldBe`
paths
it "returns valid list of module names" $ do
let names =
@@ -96,25 +97,25 @@ packageInfoSpec currentDir = do
{getHaskellModulePath = "src/Lib.hs"})
])
]
- (HCE.moduleNameMap (packageInfo :: PackageInfo ModuleInfo)) `shouldBe`
+ moduleNameMap `shouldBe`
names
let mbModuleInfo =
HM.lookup
(HCE.HaskellModulePath "src/Lib.hs")
- (moduleMap (packageInfo :: HCE.PackageInfo HCE.ModuleInfo))
+ moduleMap
case mbModuleInfo of
Just modInfo -> moduleInfoSpec modInfo
Nothing -> return ()
Left e -> runIO $ putStrLn e >> return ()
moduleInfoSpec :: ModuleInfo -> Spec
-moduleInfoSpec modInfo =
+moduleInfoSpec HCE.ModuleInfo{id = _, ..} =
describe "createModuleInfo" $ do
it "returns valid module name" $
- HCE.name (modInfo :: HCE.ModuleInfo) `shouldBe`
+ name `shouldBe`
HCE.HaskellModuleName "Lib"
it "returns valid list of declarations " $
- HCE.declarations (modInfo :: HCE.ModuleInfo) `shouldBe` testDeclarations
+ declarations `shouldBe` testDeclarations
it "returns valid source code " $ do
let sourceCodeLines =
V.fromList
@@ -133,9 +134,9 @@ moduleInfoSpec modInfo =
, "mkTest i = Test i"
, ""
]
- HCE.source (modInfo :: HCE.ModuleInfo) `shouldBe` sourceCodeLines
+ source `shouldBe` sourceCodeLines
it "returns valid map of expressions" $
- HCE.exprInfoMap (modInfo :: HCE.ModuleInfo) `shouldBe` testExprInfoMap
+ exprInfoMap `shouldBe` testExprInfoMap
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
it "returns valid map of identifiers " $
let removeLocationInfo :: HCE.LocationInfo -> HCE.LocationInfo
@@ -149,10 +150,10 @@ moduleInfoSpec modInfo =
cleanup :: HCE.IdentifierInfoMap -> HCE.IdentifierInfoMap
cleanup = U.transformBi removeLocationInfo . U.transformBi removePackageVersionFromExternalId
in
- cleanup (HCE.idInfoMap (modInfo :: HCE.ModuleInfo)) `shouldBe` cleanup testIdInfoMap
+ cleanup idInfoMap `shouldBe` cleanup testIdInfoMap
#endif
it "returns valid map of identifier occurrences" $
- HCE.idOccMap (modInfo :: HCE.ModuleInfo) `shouldBe` testIdOccMap
+ idOccMap `shouldBe` testIdOccMap
stackYamlArg :: [String]
#if MIN_VERSION_GLASGOW_HASKELL(8,6,5,0)
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 10:03:15 +0000