Skip to content
  • Sponsor haskell/haskell-language-server

  • Notifications You must be signed in to change notification settings
  • Fork 398

Reload .cabal files when they are modified #4630

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
31 changes: 29 additions & 2 deletions ghcide/src/Development/IDE/Core/FileStore.hs
Original file line number Diff line number Diff line change
@@ -78,7 +78,6 @@ import System.FilePath
import System.IO.Error
import System.IO.Unsafe


data Log
= LogCouldNotIdentifyReverseDeps !NormalizedFilePath
| LogTypeCheckingReverseDeps !NormalizedFilePath !(Maybe [NormalizedFilePath])
@@ -147,6 +146,29 @@ getModificationTimeImpl missingFileDiags file = do
then return (Nothing, ([], Nothing))
else return (Nothing, ([diag], Nothing))


getPhysicalModificationTimeRule :: Recorder (WithPriority Log) -> Rules ()
getPhysicalModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetPhysicalModificationTime file ->
getPhysicalModificationTimeImpl file

getPhysicalModificationTimeImpl
:: NormalizedFilePath
-> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
getPhysicalModificationTimeImpl file = do
let file' = fromNormalizedFilePath file
let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time))

alwaysRerun

liftIO $ fmap wrap (getModTime file')
`catch` \(e :: IOException) -> do
let err | isDoesNotExistError e = "File does not exist: " ++ file'
| otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e
diag = ideErrorText file (T.pack err)
if isDoesNotExistError e
then return (Nothing, ([], Nothing))
else return (Nothing, ([diag], Nothing))

-- | Interface files cannot be watched, since they live outside the workspace.
-- But interface files are private, in that only HLS writes them.
-- So we implement watching ourselves, and bypass the need for alwaysRerun.
@@ -170,7 +192,11 @@ resetFileStore ideState changes = mask $ \_ -> do
case c of
LSP.FileChangeType_Changed
-- already checked elsewhere | not $ HM.member nfp fois
-> atomically $ deleteValue (shakeExtras ideState) GetModificationTime nfp
->
atomically $ do
ks <- deleteValue (shakeExtras ideState) GetModificationTime nfp
vs <- deleteValue (shakeExtras ideState) GetPhysicalModificationTime nfp
pure $ ks ++ vs
_ -> pure []


@@ -233,6 +259,7 @@ getVersionedTextDoc doc = do
fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules recorder isWatched = do
getModificationTimeRule recorder
getPhysicalModificationTimeRule recorder
getFileContentsRule recorder
addWatchedFileRule recorder isWatched

8 changes: 8 additions & 0 deletions ghcide/src/Development/IDE/Core/RuleTypes.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
@@ -316,6 +317,13 @@ instance Hashable GetModificationTime where

instance NFData GetModificationTime

data GetPhysicalModificationTime = GetPhysicalModificationTime
deriving (Generic, Show, Eq)
deriving anyclass (Hashable, NFData)

-- | Get the modification time of a file on disk, ignoring any version in the VFS.
type instance RuleResult GetPhysicalModificationTime = FileVersion

pattern GetModificationTime :: GetModificationTime
pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}

9 changes: 8 additions & 1 deletion ghcide/src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
@@ -181,6 +181,7 @@
| LogLoadingHieFileFail !FilePath !SomeException
| LogLoadingHieFileSuccess !FilePath
| LogTypecheckedFOI !NormalizedFilePath
| LogDependencies !NormalizedFilePath [FilePath]
deriving Show

instance Pretty Log where
@@ -205,6 +206,11 @@
<+> "the HLS version being used, the plugins enabled, and if possible the codebase and file which"
<+> "triggered this warning."
]
LogDependencies nfp deps ->
vcat
[ "Add dependency" <+> pretty (fromNormalizedFilePath nfp)
, nest 2 $ pretty deps
]

templateHaskellInstructions :: T.Text
templateHaskellInstructions = "https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries"
@@ -715,7 +721,8 @@
let nfp = toNormalizedFilePath' fp
itExists <- getFileExists nfp
when itExists $ void $ do
use_ GetModificationTime nfp
use_ GetPhysicalModificationTime nfp
logWith recorder Logger.Info $ LogDependencies file deps
mapM_ addDependency deps

let cutoffHash = LBS.toStrict $ B.encode (hash (snd val))
@@ -802,7 +809,7 @@
{ source_version = ver
, old_value = m_old
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs

Check warning on line 812 in ghcide/src/Development/IDE/Core/Rules.hs

GitHub Actions / Hlint check run

Suggestion in getModIfaceFromDiskRule in module Development.IDE.Core.Rules: Use fmap ▫︎ Found: "\\ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs" ▫︎ Perhaps: "fmap (map (snd . fromJust . hirCoreFp)) . uses_ GetModIface"
, get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f
, regenerate = regenerateHiFile session f ms
}
10 changes: 9 additions & 1 deletion plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
Original file line number Diff line number Diff line change
@@ -2,6 +2,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}

module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where
@@ -154,7 +155,7 @@ descriptor recorder plId =
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
whenUriFile _uri $ \file -> do
log' Debug $ LogDocSaved _uri
restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $
restartCabalShakeSessionPhysical (shakeExtras ide) vfs file "(saved)" $
addFileOfInterest recorder ide file OnDisk
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
@@ -188,6 +189,13 @@ restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = d
keys <- actionBetweenSession
return (toKey GetModificationTime file:keys)


restartCabalShakeSessionPhysical :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO ()
restartCabalShakeSessionPhysical shakeExtras vfs file actionMsg actionBetweenSession = do
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do
keys <- actionBetweenSession
return (toKey GetModificationTime file:toKey GetPhysicalModificationTime file:keys)

-- ----------------------------------------------------------------
-- Plugin Rules
-- ----------------------------------------------------------------

Unchanged files with check annotations Beta

Just fileDiags -> do
pure $ Just $ filter diagRangeOverlaps fileDiags
where
diagRangeOverlaps = \fileDiag ->

Check warning on line 219 in ghcide/src/Development/IDE/Core/PluginUtils.hs

GitHub Actions / Hlint check run

Warning in activeDiagnosticsInRangeMT in module Development.IDE.Core.PluginUtils: Redundant lambda ▫︎ Found: "diagRangeOverlaps\n = \\ fileDiag\n -> rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)" ▫︎ Perhaps: "diagRangeOverlaps fileDiag\n = rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)"
rangesOverlap range (fileDiag ^. fdLspDiagnosticL . LSP.range)
-- | Just like 'activeDiagnosticsInRangeMT'. See the docs of 'activeDiagnosticsInRangeMT' for details.
import Data.Time (UTCTime (..))
import Data.Tuple.Extra (dupe)
import Debug.Trace
import Development.IDE.Core.FileStore (resetInterfaceStore)

Check warning on line 73 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Warning in module Development.IDE.Core.Compile: Use fewer imports ▫︎ Found: "import Development.IDE.Core.FileStore ( resetInterfaceStore )\nimport Development.IDE.Core.FileStore ( shareFilePath )\n" ▫︎ Perhaps: "import Development.IDE.Core.FileStore\n ( resetInterfaceStore, shareFilePath )\n"
import Development.IDE.Core.Preprocessor
import Development.IDE.Core.ProgressReporting (progressUpdate)
import Development.IDE.Core.RuleTypes
tcs = tcg_tcs ts :: [TyCon]
hie_asts = GHC.enrichHie all_binds (tmrRenamed tcm) top_ev_binds insts tcs
pure $ Just $

Check warning on line 826 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Suggestion in generateHieAsts in module Development.IDE.Core.Compile: Redundant $ ▫︎ Found: "Just $ hie_asts" ▫︎ Perhaps: "Just hie_asts"
#if MIN_VERSION_ghc(9,11,0)
hie_asts (tcg_type_env ts)
#else
convImport (L _ i) = (
(ideclPkgQual i)

Check warning on line 1106 in ghcide/src/Development/IDE/Core/Compile.hs

GitHub Actions / Hlint check run

Suggestion in getModSummaryFromImports in module Development.IDE.Core.Compile: Redundant bracket ▫︎ Found: "((ideclPkgQual i), reLoc $ ideclName i)" ▫︎ Perhaps: "(ideclPkgQual i, reLoc $ ideclName i)"
, reLoc $ ideclName i)
msrImports = implicit_imports ++ imps
{-# LANGUAGE DeriveAnyClass #-}

Check warning on line 1 in ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

GitHub Actions / Hlint check run

Warning in module Development.IDE.Session.Diagnostics: Use module export list ▫︎ Found: "module Development.IDE.Session.Diagnostics where" ▫︎ Perhaps: "module Development.IDE.Session.Diagnostics (\n module Development.IDE.Session.Diagnostics\n ) where" ▫︎ Note: an explicit list is usually better
module Development.IDE.Session.Diagnostics where
import Control.Applicative
surround start s end = do
guard (listToMaybe s == Just start)
guard (listToMaybe (reverse s) == Just end)
pure $ drop 1 $ take (length s - 1) s

Check warning on line 92 in ghcide/session-loader/Development/IDE/Session/Diagnostics.hs

GitHub Actions / Hlint check run

Warning in parseMultiCradleErr in module Development.IDE.Session.Diagnostics: Use drop1 ▫︎ Found: "drop 1" ▫︎ Perhaps: "drop1"
multiCradleErrMessage :: MultiCradleErr -> [String]
multiCradleErrMessage e =
[] -> error $ "GHC version could not be parsed: " <> version
((runTime, _):_)
| compileTime == runTime -> do
atomicModifyIORef' cradle_files (\xs -> (cfp:xs,()))

Check warning on line 630 in ghcide/session-loader/Development/IDE/Session.hs

GitHub Actions / Hlint check run

Warning in loadSessionWithOptions in module Development.IDE.Session: Use atomicModifyIORef'_ ▫︎ Found: "atomicModifyIORef' cradle_files (\\ xs -> (cfp : xs, ()))" ▫︎ Perhaps: "atomicModifyIORef'_ cradle_files ((:) cfp)"
session (hieYaml, toNormalizedFilePath' cfp, opts, libDir)
| otherwise -> return (([renderPackageSetupException cfp GhcVersionMismatch{..}], Nothing),[])
-- Failure case, either a cradle error or the none cradle
x <- map errMsgDiagnostic closure_errs
DriverHomePackagesNotClosed us <- pure x
pure us
isBad ci = (homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units

Check warning on line 897 in ghcide/session-loader/Development/IDE/Session.hs

GitHub Actions / Hlint check run

Suggestion in newComponentCache in module Development.IDE.Session: Redundant bracket ▫︎ Found: "(homeUnitId_ (componentDynFlags ci)) `OS.member` bad_units" ▫︎ Perhaps: "homeUnitId_ (componentDynFlags ci) `OS.member` bad_units"
-- Whenever we spin up a session on Linux, dynamically load libm.so.6
-- in. We need this in case the binary is statically linked, in which
-- case the interactive session will fail when trying to load
{-# LANGUAGE CPP #-}

Check warning on line 1 in exe/Wrapper.hs

GitHub Actions / Hlint check run

Warning in module Main: Use module export list ▫︎ Found: "module Main where" ▫︎ Perhaps: "module Main (\n module Main\n ) where" ▫︎ Note: an explicit list is usually better
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}