diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 8a86340c4e..c5cbc73da2 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -139,8 +139,9 @@ jobs: sed -i.bak -e 's/Paths_haskell_language_server/Paths_hls/g' \ src/**/*.hs exe/*.hs + # repeating builds to workaround segfaults in windows and ghc-8.8.4 - name: Build - run: cabal build + run: cabal build || cabal build || cabal build - name: Set test options run: | diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 39643d1ab8..fb35e46e61 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -462,7 +462,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do -> IO (IdeResult HscEnvEq, [FilePath]) sessionOpts (hieYaml, file) = do v <- fromMaybe HM.empty . Map.lookup hieYaml <$> readVar fileToFlags - cfp <- canonicalizePath file + cfp <- makeAbsolute file case HM.lookup (toNormalizedFilePath' cfp) v of Just (opts, old_di) -> do deps_ok <- checkDependencyInfo old_di @@ -483,7 +483,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do -- before attempting to do so. let getOptions :: FilePath -> IO (IdeResult HscEnvEq, [FilePath]) getOptions file = do - ncfp <- toNormalizedFilePath' <$> canonicalizePath file + ncfp <- toNormalizedFilePath' <$> makeAbsolute file cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap hieYaml <- cradleLoc file sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e -> @@ -553,11 +553,11 @@ fromTargetId is exts (GHC.TargetModule mod) env dep = do , i <- is , boot <- ["", "-boot"] ] - locs <- mapM (fmap toNormalizedFilePath' . canonicalizePath) fps + locs <- mapM (fmap toNormalizedFilePath' . makeAbsolute) fps return [TargetDetails (TargetModule mod) env dep locs] -- For a 'TargetFile' we consider all the possible module names fromTargetId _ _ (GHC.TargetFile f _) env deps = do - nf <- toNormalizedFilePath' <$> canonicalizePath f + nf <- toNormalizedFilePath' <$> makeAbsolute f return [TargetDetails (TargetFile nf) env deps [nf]] toFlagsMap :: TargetDetails -> [(NormalizedFilePath, (IdeResult HscEnvEq, DependencyInfo))] diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index a57ace4056..4c5358bf31 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -138,7 +138,7 @@ import Ide.Plugin.Config import qualified Language.LSP.Server as LSP import Language.LSP.Types (SMethod (SCustomMethod)) import Language.LSP.VFS -import System.Directory (canonicalizePath, makeAbsolute) +import System.Directory (makeAbsolute) import Data.Default (def, Default) import Ide.Plugin.Properties (HasProperty, KeyNameProxy, @@ -769,7 +769,7 @@ getModIfaceFromDiskAndIndexRule = hie_loc = Compat.ml_hie_file $ ms_location ms hash <- liftIO $ Util.getFileHash hie_loc mrow <- liftIO $ HieDb.lookupHieFileFromSource hiedb (fromNormalizedFilePath f) - hie_loc' <- liftIO $ traverse (canonicalizePath . HieDb.hieModuleHieFile) mrow + hie_loc' <- liftIO $ traverse (makeAbsolute . HieDb.hieModuleHieFile) mrow case mrow of Just row | hash == HieDb.modInfoHash (HieDb.hieModInfo row) diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index fd1ea67c57..0383ffc59e 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -29,7 +29,7 @@ import Development.IDE.GHC.Util (lookupPackageConfig) import Development.IDE.Graph.Classes import Development.IDE.Types.Exports (ExportsMap, createExportsMap) import OpenTelemetry.Eventlog (withSpan) -import System.Directory (canonicalizePath) +import System.Directory (makeAbsolute) import System.FilePath -- | An 'HscEnv' with equality. Two values are considered equal @@ -58,9 +58,9 @@ newHscEnvEq cradlePath hscEnv0 deps = do let relativeToCradle = (takeDirectory cradlePath ) hscEnv = removeImportPaths hscEnv0 - -- Canonicalize import paths since we also canonicalize targets + -- Make Absolute since targets are also absolute importPathsCanon <- - mapM canonicalizePath $ relativeToCradle <$> importPaths (hsc_dflags hscEnv0) + mapM makeAbsolute $ relativeToCradle <$> importPaths (hsc_dflags hscEnv0) newHscEnvEqWithImportPaths (Just $ Set.fromList importPathsCanon) hscEnv deps diff --git a/ghcide/test/data/symlink/hie.yaml b/ghcide/test/data/symlink/hie.yaml new file mode 100644 index 0000000000..cfadaebc17 --- /dev/null +++ b/ghcide/test/data/symlink/hie.yaml @@ -0,0 +1,10 @@ + +cradle: + direct: + arguments: + - -i + - -isrc + - -iother_loc/ + - other_loc/Sym.hs + - src/Foo.hs + - -Wall diff --git a/ghcide/test/data/symlink/other_loc/.gitkeep b/ghcide/test/data/symlink/other_loc/.gitkeep new file mode 100644 index 0000000000..e69de29bb2 diff --git a/ghcide/test/data/symlink/some_loc/Sym.hs b/ghcide/test/data/symlink/some_loc/Sym.hs new file mode 100644 index 0000000000..1039f52bfd --- /dev/null +++ b/ghcide/test/data/symlink/some_loc/Sym.hs @@ -0,0 +1,4 @@ +module Sym where + +foo :: String +foo = "" diff --git a/ghcide/test/data/symlink/src/Foo.hs b/ghcide/test/data/symlink/src/Foo.hs new file mode 100644 index 0000000000..dbafb2181a --- /dev/null +++ b/ghcide/test/data/symlink/src/Foo.hs @@ -0,0 +1,4 @@ +module Foo where + +import Sym + diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index e198c402a7..75bd665013 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -164,6 +164,7 @@ main = do , pluginParsedResultTests , preprocessorTests , thTests + , symlinkTests , safeTests , unitTests , haddockTests @@ -4051,6 +4052,18 @@ thTests = expectDiagnostics [ ( cPath, [(DsWarning, (3, 0), "Top-level binding with no type signature: a :: A")] ) ] ] +-- | Tests for projects that use symbolic links one way or another +symlinkTests :: TestTree +symlinkTests = + testGroup "Projects using Symlinks" + [ testCase "Module is symlinked" $ runWithExtraFiles "symlink" $ \dir -> do + liftIO $ createFileLink (dir "some_loc" "Sym.hs") (dir "other_loc" "Sym.hs") + let fooPath = dir "src" "Foo.hs" + _ <- openDoc fooPath "haskell" + expectDiagnosticsWithTags [("src" "Foo.hs", [(DsWarning, (2, 0), "The import of 'Sym' is redundant", Just DtUnnecessary)])] + pure () + ] + -- | Test that all modules have linkables thLoadingTest :: TestTree thLoadingTest = testCase "Loading linkables" $ runWithExtraFiles "THLoading" $ \dir -> do @@ -4058,7 +4071,6 @@ thLoadingTest = testCase "Loading linkables" $ runWithExtraFiles "THLoading" $ \ _ <- openDoc thb "haskell" expectNoMoreDiagnostics 1 - -- | test that TH is reevaluated on typecheck thReloadingTest :: Bool -> TestTree thReloadingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 02df4b2f06..15c4e9ed00 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -23,6 +23,7 @@ import Data.Char (isLower) import qualified Data.HashMap.Strict as HashMap import Data.List (intercalate, isPrefixOf, minimumBy) import Data.Maybe (maybeToList) +import Data.Ord (comparing) import Data.String (IsString) import qualified Data.Text as T import Development.IDE (GetParsedModule (GetParsedModule), @@ -41,10 +42,9 @@ import Language.LSP.Types hiding SemanticTokenRelative (length), SemanticTokensEdit (_start)) import Language.LSP.VFS (virtualFileText) -import System.Directory (canonicalizePath) +import System.Directory (makeAbsolute) import System.FilePath (dropExtension, splitDirectories, takeFileName) -import Data.Ord (comparing) -- |Plugin descriptor descriptor :: PluginId -> PluginDescriptor IdeState @@ -121,8 +121,8 @@ pathModuleNames state normFilePath filePath | otherwise = do session <- runAction "ModuleName.ghcSession" state $ use_ GhcSession normFilePath srcPaths <- evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags - paths <- mapM canonicalizePath srcPaths - mdlPath <- canonicalizePath filePath + paths <- mapM makeAbsolute srcPaths + mdlPath <- makeAbsolute filePath let prefixes = filter (`isPrefixOf` mdlPath) paths pure (map (moduleNameFrom mdlPath) prefixes) where