Reload .cabal files when they are modified

Author: fendor

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

@@ -586,7 +586,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
           unless (null new_deps || not checkProject) $ do
                 cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations all_targets)
                 void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do
-                    mmt <- uses GetModificationTime cfps'
+                    mmt <- uses GetPhysicalModificationTime cfps'
                     let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
                     modIfaces <- uses GetModIface cs_exist
                     -- update exports map

ghcide/src/Development/IDE/Core/FileStore.hs

@@ -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
 

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -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}
 

ghcide/src/Development/IDE/Core/Rules.hs

@@ -181,6 +181,7 @@ data Log
   | LogLoadingHieFileFail !FilePath !SomeException
   | LogLoadingHieFileSuccess !FilePath
   | LogTypecheckedFOI !NormalizedFilePath
+  | LogDependencies !NormalizedFilePath [FilePath]
   deriving Show
 
 instance Pretty Log where
@@ -205,6 +206,11 @@ instance Pretty Log where
         <+> "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 @@ loadGhcSession recorder ghcSessionDepsConfig = do
                 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))

plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE LambdaCase            #-}
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 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
 -- ----------------------------------------------------------------