Skip to content

Commit 66a887d

Browse files
fendorjian-lin
andcommitted
Make cradle dependencies absolute paths
This patch fixes #1068 when the cabal plugin is not used. Co-authored-by: Lin Jian <me@linj.tech>
1 parent 1b02cfa commit 66a887d

File tree

3 files changed

+51
-5
lines changed

3 files changed

+51
-5
lines changed

ghcide/session-loader/Development/IDE/Session.hs

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -698,7 +698,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
698698
let ncfp = toNormalizedFilePath' (toAbsolutePath file)
699699
cachedHieYamlLocation <- HM.lookup ncfp <$> readVar filesMap
700700
hieYaml <- cradleLoc file
701-
sessionOpts (join cachedHieYamlLocation <|> hieYaml, file) `Safe.catch` \e ->
701+
let
702+
-- Each one of deps will be registered as a FileSystemWatcher in the GhcSession action
703+
-- so that we can get a workspace/didChangeWatchedFiles notification when a dep changes.
704+
-- The GlobPattern of a FileSystemWatcher can be absolute or relative.
705+
-- We use the absolute one because it is supported by more LSP clients.
706+
-- Here we make sure deps are absolute and later we use those absolute deps as GlobPattern.
707+
absolutePathsCradleDeps (eq, deps)
708+
= (eq, fmap toAbsolutePath deps)
709+
(absolutePathsCradleDeps <$> sessionOpts (join cachedHieYamlLocation <|> hieYaml, file)) `Safe.catch` \e ->
702710
return (([renderPackageSetupException file e], Nothing), maybe [] pure hieYaml)
703711

704712
returnWithVersion $ \file -> do

plugins/hls-cabal-plugin/test/CabalAdd.hs

Lines changed: 30 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -9,17 +9,26 @@ import Control.Lens.Fold ((^?))
99
import qualified Data.Maybe as Maybe
1010
import qualified Data.Text as T
1111
import qualified Data.Text.Internal.Search as T
12+
import qualified Data.Text.IO as T
1213
import Distribution.Utils.Generic (safeHead)
1314
import Ide.Plugin.Cabal.CabalAdd (hiddenPackageSuggestion)
1415
import qualified Language.LSP.Protocol.Lens as L
15-
import Language.LSP.Protocol.Types (Diagnostic (..), mkRange)
16+
import Language.LSP.Protocol.Types (Diagnostic (..),
17+
DidChangeWatchedFilesParams (..),
18+
FileChangeType (FileChangeType_Changed),
19+
FileEvent (..), filePathToUri,
20+
mkRange)
1621
import System.FilePath
17-
import Test.Hls (Session, TestTree, _R, anyMessage,
18-
assertEqual, documentContents,
22+
import Test.Hls (SMethod (SMethod_WorkspaceDidChangeWatchedFiles),
23+
Session, TestTree, _R, anyMessage,
24+
assertEqual, assertFailure,
25+
documentContents,
1926
executeCodeAction,
2027
getAllCodeActions,
2128
getDocumentEdit, liftIO, openDoc,
22-
skipManyTill, testCase, testGroup,
29+
sendNotification, skipManyTill,
30+
testCase, testGroup,
31+
type (|?) (InR),
2332
waitForDiagnosticsFrom, (@?=))
2433
import Utils
2534

@@ -141,6 +150,9 @@ cabalAddTests =
141150
, ("AAI", "0.1")
142151
, ("AWin32Console", "1.19.1")
143152
]
153+
154+
, runShiftedRootInTmpDirTestCaseSession "Reload HLS after cabal file changes - without cabal plugin" ("cabal-add-testdata" </> "cabal-add-lib")
155+
(generateReloadHlsAfterCabalChangeTestSession "cabal-add-lib.cabal" ("src" </> "MyLib.hs"))
144156
]
145157
where
146158
generateAddDependencyTestSession :: FilePath -> FilePath -> T.Text -> [Int] -> Session ()
@@ -183,3 +195,17 @@ cabalAddTests =
183195
cas <- Maybe.mapMaybe (^? _R) <$> getAllCodeActions hsdoc
184196
let selectedCas = filter (\ca -> "Add dependency" `T.isPrefixOf` (ca ^. L.title)) cas
185197
liftIO $ assertEqual "PackageYAML" [] selectedCas
198+
199+
generateReloadHlsAfterCabalChangeTestSession :: FilePath -> FilePath -> FilePath -> Session ()
200+
generateReloadHlsAfterCabalChangeTestSession cabalFile haskellFile root = do
201+
hsdoc <- openDoc haskellFile "haskell"
202+
_ <- waitForDiagnosticsFrom hsdoc
203+
cabalContent <- liftIO $ T.readFile cabalFile
204+
let fix = T.replace "build-depends: base" "build-depends: base, split"
205+
liftIO $ T.writeFile cabalFile (fix cabalContent)
206+
sendNotification SMethod_WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams
207+
[ FileEvent (filePathToUri $ root </> cabalFile) FileChangeType_Changed ]
208+
diagnostics <- waitForDiagnosticsFrom hsdoc
209+
case diagnostics of
210+
[diagnostic] -> liftIO $ assertEqual "Wrong diagnostic after HLS restarts" (Just $ InR "GHC-66111") (diagnostic ^. L.code)
211+
_ -> liftIO $ assertFailure $ "Expect one diagnostic but got " <> show (length diagnostics)

plugins/hls-cabal-plugin/test/Utils.hs

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import qualified Ide.Plugin.Cabal
1414
import Ide.Plugin.Cabal.Completion.Types
1515
import System.FilePath
1616
import Test.Hls
17+
import Test.Hls.FileSystem (copyDir, mkVirtualFileTree)
1718

1819

1920
cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log
@@ -53,6 +54,9 @@ runCabalTestCaseSession title subdir = testCase title . runCabalSession subdir
5354
runHaskellTestCaseSession :: TestName -> FilePath -> Session () -> TestTree
5455
runHaskellTestCaseSession title subdir = testCase title . runHaskellAndCabalSession subdir
5556

57+
runShiftedRootInTmpDirTestCaseSession :: TestName -> FilePath -> (FilePath -> Session ()) -> TestTree
58+
runShiftedRootInTmpDirTestCaseSession title subdir = testCase title . runShiftedRootInTmpDirSession subdir
59+
5660
runCabalSession :: FilePath -> Session a -> IO a
5761
runCabalSession subdir =
5862
failIfSessionTimeout . runSessionWithServer def cabalPlugin (testDataDir </> subdir)
@@ -61,6 +65,14 @@ runHaskellAndCabalSession :: FilePath -> Session a -> IO a
6165
runHaskellAndCabalSession subdir =
6266
failIfSessionTimeout . runSessionWithServer def (cabalPlugin <> cabalHaskellPlugin) (testDataDir </> subdir)
6367

68+
runShiftedRootInTmpDirSession :: FilePath -> (FilePath -> Session a) -> IO a
69+
runShiftedRootInTmpDirSession subdir =
70+
failIfSessionTimeout . runSessionWithTestConfig def
71+
{ testDirLocation = Right $ mkVirtualFileTree testDataDir [copyDir subdir]
72+
, testShiftRoot = True
73+
, testPluginDescriptor = cabalHaskellPlugin
74+
}
75+
6476
runCabalGoldenSession :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
6577
runCabalGoldenSession title subdir fp act = goldenWithCabalDoc def cabalPlugin title testDataDir (subdir </> fp) "golden" "cabal" act
6678

0 commit comments

Comments
 (0)