From 36fb3fb7fb3dc7388d4cd0547faeb1eeb485d608 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 1 May 2022 09:39:54 +0100 Subject: [PATCH 1/8] remove duplicate log message --- ghcide/src/Development/IDE/Core/Shake.hs | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 67e37bd2c2..808de1d1a6 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -696,17 +696,6 @@ shakeRestart recorder IdeState{..} vfs reason acts = queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras log Debug $ LogBuildSessionRestart reason queue backlog stopTime res - - let profile = case res of - Just fp -> ", profile saved at " <> fp - _ -> "" - -- TODO: should replace with logging using a logger that sends lsp message - let msg = T.pack $ "Restarting build session " ++ reason' ++ queueMsg ++ keysMsg ++ abortMsg - reason' = "due to " ++ reason - queueMsg = " with queue " ++ show (map actionName queue) - keysMsg = " for keys " ++ show (HSet.toList backlog) ++ " " - abortMsg = "(aborting the previous one took " ++ showDuration stopTime ++ profile ++ ")" - notifyTestingLogMessage shakeExtras msg ) -- It is crucial to be masked here, otherwise we can get killed -- between spawning the new thread and updating shakeSession. @@ -719,13 +708,6 @@ shakeRestart recorder IdeState{..} vfs reason acts = sleep seconds logWith recorder Error (LogBuildSessionRestartTakingTooLong seconds) -notifyTestingLogMessage :: ShakeExtras -> T.Text -> IO () -notifyTestingLogMessage extras msg = do - (IdeTesting isTestMode) <- optTesting <$> getIdeOptionsIO extras - let notif = LSP.LogMessageParams LSP.MtLog msg - when isTestMode $ mRunLspT (lspEnv extras) $ LSP.sendNotification LSP.SWindowLogMessage notif - - -- | Enqueue an action in the existing 'ShakeSession'. -- Returns a computation to block until the action is run, propagating exceptions. -- Assumes a 'ShakeSession' is available. @@ -797,17 +779,12 @@ newSession recorder extras@ShakeExtras{..} vfsMod shakeDb acts reason = do let keysActs = pumpActionThread otSpan : map (run otSpan) (reenqueued ++ acts) res <- try @SomeException $ restore $ shakeRunDatabaseForKeys (HSet.toList <$> allPendingKeys) shakeDb keysActs - let res' = case res of - Left e -> "exception: " <> displayException e - Right _ -> "completed" - let msg = T.pack $ "Finishing build session(" ++ res' ++ ")" return $ do let exception = case res of Left e -> Just e _ -> Nothing logWith recorder Debug $ LogBuildSessionFinish exception - notifyTestingLogMessage extras msg -- Do the work in a background thread workThread <- asyncWithUnmask workRun From fa70c25c61714d00d54d633e8593d8bb9a1ba175 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 1 May 2022 09:40:09 +0100 Subject: [PATCH 2/8] Fix expectNoMoreDiagnostics --- ghcide/test/src/Development/IDE/Test.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/src/Development/IDE/Test.hs b/ghcide/test/src/Development/IDE/Test.hs index 27036b9d75..87ee301ec9 100644 --- a/ghcide/test/src/Development/IDE/Test.hs +++ b/ghcide/test/src/Development/IDE/Test.hs @@ -83,7 +83,7 @@ expectNoMoreDiagnostics timeout = expectMessages STextDocumentPublishDiagnostics timeout $ \diagsNot -> do let fileUri = diagsNot ^. params . uri actual = diagsNot ^. params . diagnostics - liftIO $ + unless (actual == List []) $ liftIO $ assertFailure $ "Got unexpected diagnostics for " <> show fileUri <> " got " From 1ee126da27754b6603cafaddb70a19cfc5dd14ef Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 1 May 2022 09:40:21 +0100 Subject: [PATCH 3/8] redundant import --- ghcide/test/exe/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index f5cd9e390c..85b9dcd3c6 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -22,7 +22,7 @@ import Control.Exception (bracket_, catch, import qualified Control.Lens as Lens import Control.Monad import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Aeson (fromJSON, toJSON) +import Data.Aeson (toJSON) import qualified Data.Aeson as A import Data.Default import Data.Foldable From 142908af6376ae15e65492d07edff121be9c48ad Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 1 May 2022 12:44:59 +0100 Subject: [PATCH 4/8] dead code --- ghcide/src/Development/IDE/Core/FileStore.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 359532e6f4..88313de8e7 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -192,12 +192,6 @@ getFileContentsImpl file = do pure $ Rope.toText . _text <$> mbVirtual pure ([], Just (time, res)) -ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a) -ideTryIOException fp act = - mapLeft - (\(e :: IOException) -> ideErrorText fp $ T.pack $ show e) - <$> try act - -- | Returns the modification time and the contents. -- For VFS paths, the modification time is the current time. getFileContents :: NormalizedFilePath -> Action (UTCTime, Maybe T.Text) From e16942bf2c026f43e08c2fa4c89f99211d1b0b10 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 1 May 2022 12:45:17 +0100 Subject: [PATCH 5/8] unnecessary do section --- ghcide/src/Development/IDE/Core/Debouncer.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Debouncer.hs b/ghcide/src/Development/IDE/Core/Debouncer.hs index f0785d56e9..d5c313c95f 100644 --- a/ghcide/src/Development/IDE/Core/Debouncer.hs +++ b/ghcide/src/Development/IDE/Core/Debouncer.hs @@ -50,9 +50,8 @@ asyncRegisterEvent d delay k fire = mask_ $ do sleep delay fire atomically $ STM.delete k d - do - prev <- atomicallyNamed "debouncer" $ STM.focus (Focus.lookup <* Focus.insert a) k d - traverse_ cancel prev + prev <- atomicallyNamed "debouncer" $ STM.focus (Focus.lookup <* Focus.insert a) k d + traverse_ cancel prev -- | Debouncer used in the DAML CLI compiler that emits events immediately. noopDebouncer :: Debouncer k From 04e1fc3a9a5559344ec708178439a622ecf5d545 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 1 May 2022 12:45:34 +0100 Subject: [PATCH 6/8] redundant log message --- ghcide/src/Development/IDE/Core/OfInterest.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index 3d50287c3b..904adc7cb8 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -107,10 +107,10 @@ addFileOfInterest state f v = do (prev, files) <- modifyVar var $ \dict -> do let (prev, new) = HashMap.alterF (, Just v) f dict pure (new, (prev, new)) - when (prev /= Just v) $ + when (prev /= Just v) $ do join $ atomically $ recordDirtyKeys (shakeExtras state) IsFileOfInterest [f] - logDebug (ideLogger state) $ - "Set files of interest to: " <> T.pack (show files) + logDebug (ideLogger state) $ + "Set files of interest to: " <> T.pack (show files) deleteFileOfInterest :: IdeState -> NormalizedFilePath -> IO () deleteFileOfInterest state f = do From efc7742328815069cae636c4f47ee8396723ab2e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 1 May 2022 12:47:32 +0100 Subject: [PATCH 7/8] waitForProgressDone to improve consistency --- ghcide/test/exe/Main.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 85b9dcd3c6..8fe50281bb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -6047,11 +6047,14 @@ ifaceErrorTest = testCase "iface-error-test-1" $ runWithExtraFiles "recomp" $ \d expectDiagnostics [("P.hs", [(DsWarning,(4,0), "Top-level binding")])] -- So what we know P has been loaded + waitForProgressDone + -- Change y from Int to B changeDoc bdoc [TextDocumentContentChangeEvent Nothing Nothing $ T.unlines ["module B where", "y :: Bool", "y = undefined"]] -- save so that we can that the error propogates to A sendNotification STextDocumentDidSave (DidSaveTextDocumentParams bdoc Nothing) + -- Check that the error propogates to A expectDiagnostics [("A.hs", [(DsError, (5, 4), "Couldn't match expected type 'Int' with actual type 'Bool'")])] @@ -6062,7 +6065,8 @@ ifaceErrorTest = testCase "iface-error-test-1" $ runWithExtraFiles "recomp" $ \d hi_exists <- liftIO $ doesFileExist $ hidir "B.hi" liftIO $ assertBool ("Couldn't find B.hi in " ++ hidir) hi_exists - pdoc <- createDoc pPath "haskell" pSource + pdoc <- openDoc pPath "haskell" + waitForProgressDone changeDoc pdoc [TextDocumentContentChangeEvent Nothing Nothing $ pSource <> "\nfoo = y :: Bool" ] -- Now in P we have -- bar = x :: Int From 7a4cc5e3a2097135d86a475e6c5260ac8c3385d3 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 1 May 2022 12:53:26 +0100 Subject: [PATCH 8/8] redundant import --- ghcide/src/Development/IDE/Core/FileStore.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 88313de8e7..76c2d4fa6f 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -28,7 +28,6 @@ import Control.Exception import Control.Monad.Extra import Control.Monad.IO.Class import qualified Data.ByteString as BS -import Data.Either.Extra import qualified Data.Rope.UTF16 as Rope import qualified Data.Text as T import Data.Time