Avoid unnecessary Target canonicalisation in Session setup

.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: |

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))]

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)

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
 

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

ghcide/test/data/symlink/some_loc/Sym.hs

@@ -0,0 +1,4 @@
+module Sym where
+
+foo :: String
+foo = ""

ghcide/test/data/symlink/src/Foo.hs

@@ -0,0 +1,4 @@
+module Foo where
+
+import Sym
+

ghcide/test/exe/Main.hs

@@ -164,6 +164,7 @@ main = do
     , pluginParsedResultTests
     , preprocessorTests
     , thTests
+    , symlinkTests
     , safeTests
     , unitTests
     , haddockTests
@@ -4051,14 +4052,25 @@ 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
     let thb = dir </> "THB.hs"
     _ <- openDoc thb "haskell"
     expectNoMoreDiagnostics 1
 
-
 -- | test that TH is reevaluated on typecheck
 thReloadingTest :: Bool -> TestTree
 thReloadingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do

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