diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index afcac00308..625d1b9b1d 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -484,7 +484,25 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do packageSetup (hieYaml, cfp, opts, libDir) = do -- Parse DynFlags for the newly discovered component hscEnv <- emptyHscEnv ideNc libDir - (df, targets) <- evalGhcEnv hscEnv $ setOptions opts (hsc_dflags hscEnv) + (df', targets) <- evalGhcEnv hscEnv $ setOptions opts (hsc_dflags hscEnv) + let df = +#if MIN_VERSION_ghc(9,3,0) + case unitIdString (homeUnitId_ df') of + -- cabal uses main for the unit id of all executable packages + -- This makes multi-component sessions confused about what + -- options to use for that component. + -- Solution: hash the options and use that as part of the unit id + -- This works because there won't be any dependencies on the + -- executable unit. + "main" -> + let hash = B.unpack $ B16.encode $ H.finalize $ H.updates H.init (map B.pack $ componentOptions opts) + hashed_uid = Compat.toUnitId (Compat.stringToUnit ("main-"++hash)) + in setHomeUnitId_ hashed_uid df' + _ -> df' +#else + df' +#endif + let deps = componentDependencies opts ++ maybeToList hieYaml dep_info <- getDependencyInfo deps -- Now lookup to see whether we are combining with an existing HscEnv @@ -499,6 +517,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- We will modify the unitId and DynFlags used for -- compilation but these are the true source of -- information. + new_deps = RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info : maybe [] snd oldDeps -- Get all the unit-ids for things in this component diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index ba98e4f84f..a8e63bf4a1 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -29,6 +29,7 @@ import Data.Maybe import System.FilePath #if MIN_VERSION_ghc(9,3,0) import GHC.Types.PkgQual +import GHC.Unit.State #endif data Import @@ -135,25 +136,45 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do #else Nothing -> do #endif + + mbFile <- locateModuleFile ((homeUnitId_ dflags, importPaths dflags) : other_imports) exts targetFor isSource $ unLoc modName + case mbFile of + Nothing -> lookupInPackageDB env + Just (uid, file) -> toModLocation uid file + where + dflags = hsc_dflags env + import_paths = mapMaybe (mkImportDirs env) comp_info + other_imports = +#if MIN_VERSION_ghc(9,4,0) + -- On 9.4+ instead of bringing all the units into scope, only bring into scope the units + -- this one depends on + -- This way if you have multiple units with the same module names, we won't get confused + -- For example if unit a imports module M from unit B, when there is also a module M in unit C, + -- and unit a only depends on unit b, without this logic there is the potential to get confused + -- about which module unit a imports. + -- Without multi-component support it is hard to recontruct the dependency environment so + -- unit a will have both unit b and unit c in scope. + map (\uid -> (uid, importPaths (homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue)))) hpt_deps + ue = hsc_unit_env env + units = homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId_ dflags) ue + hpt_deps :: [UnitId] + hpt_deps = homeUnitDepends units +#else + import_paths' +#endif + -- first try to find the module as a file. If we can't find it try to find it in the package -- database. -- Here the importPaths for the current modules are added to the front of the import paths from the other components. -- This is particularly important for Paths_* modules which get generated for every component but unless you use it in -- each component will end up being found in the wrong place and cause a multi-cradle match failure. - let import_paths' = + import_paths' = #if MIN_VERSION_ghc(9,3,0) import_paths #else map snd import_paths #endif - mbFile <- locateModuleFile ((homeUnitId_ dflags, importPaths dflags) : import_paths') exts targetFor isSource $ unLoc modName - case mbFile of - Nothing -> lookupInPackageDB env - Just (uid, file) -> toModLocation uid file - where - dflags = hsc_dflags env - import_paths = mapMaybe (mkImportDirs env) comp_info toModLocation uid file = liftIO $ do loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file) #if MIN_VERSION_ghc(9,0,0) diff --git a/plugins/hls-call-hierarchy-plugin/test/Main.hs b/plugins/hls-call-hierarchy-plugin/test/Main.hs index 678b970e57..a340ae8c82 100644 --- a/plugins/hls-call-hierarchy-plugin/test/Main.hs +++ b/plugins/hls-call-hierarchy-plugin/test/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} @@ -504,25 +505,40 @@ outgoingCallMultiFileTestCase filepath queryX queryY mp = _ -> liftIO $ assertFailure "Not one element" closeDoc doc -oneCaseWithCreate :: T.Text -> Int -> Int -> (Uri -> CallHierarchyItem) -> Assertion +oneCaseWithCreate :: T.Text -> Int -> Int -> (Uri -> CallHierarchyItem -> Assertion) -> Assertion oneCaseWithCreate contents queryX queryY expected = withCanonicalTempDir $ \dir -> runSessionWithServer plugin dir $ do doc <- createDoc "A.hs" "haskell" contents waitForIndex (dir "A.hs") Test.prepareCallHierarchy (mkPrepareCallHierarchyParam doc queryX queryY) >>= \case - [item] -> liftIO $ item @?= expected (doc ^. L.uri) + [item] -> liftIO $ expected (doc ^. L.uri) item res -> liftIO $ assertFailure "Not one element" closeDoc doc -mkCallHierarchyItem' :: String -> T.Text -> SymbolKind -> Range -> Range -> Uri -> CallHierarchyItem -mkCallHierarchyItem' prefix name kind range selRange uri = - CallHierarchyItem name kind Nothing (Just "Main") uri range selRange (Just v) +mkCallHierarchyItem' :: String -> T.Text -> SymbolKind -> Range -> Range -> Uri -> CallHierarchyItem -> Assertion +mkCallHierarchyItem' prefix name kind range selRange uri c@(CallHierarchyItem name' kind' tags' detail' uri' range' selRange' xdata') = do + assertHierarchyItem name name' + assertHierarchyItem kind kind' + assertHierarchyItem tags tags' + assertHierarchyItem detail detail' + assertHierarchyItem uri uri' + assertHierarchyItem range range' + assertHierarchyItem selRange selRange' + case xdata' of + Nothing -> assertFailure ("In " ++ show c ++ ", got Nothing for data but wanted " ++ show xdata) + Just v -> case fromJSON v of + Success v -> assertBool ("In " ++ show c ++ " wanted data prefix: " ++ show xdata) (xdata `T.isPrefixOf` v) + Error err -> assertFailure ("In " ++ show c ++ " wanted data prefix: " ++ show xdata ++ " but json parsing failed with " ++ show err) where - v = toJSON $ prefix <> ":" <> T.unpack name <> ":Main:main" + tags = Nothing + detail = Just "Main" + assertHierarchyItem :: forall a. (Eq a, Show a) => a -> a -> Assertion + assertHierarchyItem = assertEqual ("In " ++ show c ++ ", got unexpected value for field") + xdata = T.pack prefix <> ":" <> name <> ":Main:main" mkCallHierarchyItemC, mkCallHierarchyItemT, mkCallHierarchyItemV :: - T.Text -> SymbolKind -> Range -> Range -> Uri -> CallHierarchyItem + T.Text -> SymbolKind -> Range -> Range -> Uri -> CallHierarchyItem -> Assertion mkCallHierarchyItemC = mkCallHierarchyItem' "c" mkCallHierarchyItemT = mkCallHierarchyItem' "t" mkCallHierarchyItemV = mkCallHierarchyItem' "v"