From bded47067419a5cb4851ef8e3051852b3086c794 Mon Sep 17 00:00:00 2001 From: Fendor Date: Tue, 16 Nov 2021 11:45:49 +0100 Subject: [PATCH 1/5] Add test-case for projects that use symbolic links In particular, this test checks whether modules that are actually symbolic lins can be found by ghcide. This is known to be broken, as Session.hs canonicalises Targets, e.g. saves the location of the symbolic link. When we later try to load that module, we can't find it, as it won't be part of the known targets since it is not canonicalized. --- ghcide/test/data/symlink/hie.yaml | 10 ++++++++++ ghcide/test/data/symlink/other_loc/.gitkeep | 0 ghcide/test/data/symlink/some_loc/Sym.hs | 4 ++++ ghcide/test/data/symlink/src/Foo.hs | 4 ++++ ghcide/test/exe/Main.hs | 13 +++++++++++++ 5 files changed, 31 insertions(+) create mode 100644 ghcide/test/data/symlink/hie.yaml create mode 100644 ghcide/test/data/symlink/other_loc/.gitkeep create mode 100644 ghcide/test/data/symlink/some_loc/Sym.hs create mode 100644 ghcide/test/data/symlink/src/Foo.hs 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 d021feea49..7a42bcc834 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 @@ -4055,6 +4056,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" + [ expectFailBecause "Filetargets are canonicalised and can't be found" $ 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 TH is reevaluated on typecheck thReloadingTest :: Bool -> TestTree thReloadingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do From 38d3fcc27198606af70b9b5207ae3e22fadb463f Mon Sep 17 00:00:00 2001 From: Fendor Date: Tue, 16 Nov 2021 11:45:38 +0100 Subject: [PATCH 2/5] Dont canonicalise Targets during session setup Canonicalising Targets makes it harder later to actually find the targets during import analysis, as ghcide only looks for modules in the import paths and checks for existence in the known target Map. However, import analysis doesn't canonicalise target candidates, thus the lookup in the known target Map will always fail. We no longer canonicalise Targets, so import analysis will succeed loading modules that are actually symbolic links. --- ghcide/session-loader/Development/IDE/Session.hs | 4 ++-- ghcide/test/exe/Main.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 39643d1ab8..6fbfcadc49 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -553,11 +553,11 @@ fromTargetId is exts (GHC.TargetModule mod) env dep = do , i <- is , boot <- ["", "-boot"] ] - locs <- mapM (fmap toNormalizedFilePath' . canonicalizePath) fps + let locs = map toNormalizedFilePath' 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 + let nf = toNormalizedFilePath' f return [TargetDetails (TargetFile nf) env deps [nf]] toFlagsMap :: TargetDetails -> [(NormalizedFilePath, (IdeResult HscEnvEq, DependencyInfo))] diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 7a42bcc834..07b0f9a876 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4060,7 +4060,7 @@ thTests = symlinkTests :: TestTree symlinkTests = testGroup "Projects using Symlinks" - [ expectFailBecause "Filetargets are canonicalised and can't be found" $ testCase "Module is symlinked" $ runWithExtraFiles "symlink" $ \dir -> do + [ 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" From cc76fcc8e86136b9dd8e435b548cb7bbbca46971 Mon Sep 17 00:00:00 2001 From: Fendor Date: Tue, 16 Nov 2021 14:15:14 +0100 Subject: [PATCH 3/5] Prefer makeAbsolute over canonicalizePath --- ghcide/session-loader/Development/IDE/Session.hs | 8 ++++---- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 6 +++--- .../hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs | 8 ++++---- 3 files changed, 11 insertions(+), 11 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 6fbfcadc49..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"] ] - let locs = map toNormalizedFilePath' 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 - let nf = toNormalizedFilePath' 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/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/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 From d42d632f92f797ce51a84d8bbfdb86a067b2fd75 Mon Sep 17 00:00:00 2001 From: Fendor Date: Wed, 17 Nov 2021 16:38:09 +0100 Subject: [PATCH 4/5] Use makeAbsolute to read HIE files from disk --- ghcide/src/Development/IDE/Core/Rules.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 1dc0c0f2a2..3715353970 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -139,7 +139,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, @@ -759,7 +759,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) From b3e834cdf83e5108826bcb0fb2ea7f30586540a2 Mon Sep 17 00:00:00 2001 From: Javier Neira Date: Mon, 29 Nov 2021 15:11:28 +0100 Subject: [PATCH 5/5] Restore repeated builds the ghcide build fails for win and ghc-8.8 with segfaults --- .github/workflows/test.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index e921a9b85e..9f3e7b4646 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: |