Merge branch 'master' into ekg

Author: pepeiborra

.github/workflows/flags.yml

@@ -64,10 +64,6 @@ jobs:
       - name: Build `hls-graph` with flags
         run: cabal v2-build hls-graph --flags="embed-files stm-stats"
 
-      - if: matrix.ghc != '8.6.5' && matrix.ghc != '8.8.4'
-        name: Build `hie-compat` with flags
-        run: cabal v2-build hie-compat --flags="ghc-lib"
-
       - name: Build `ghcide` with flags
         run: cabal v2-build ghcide --flags="ghc-patched-unboxed-bytecode test-exe executable bench-exe"
 

cabal-ghc90.project

@@ -40,7 +40,6 @@ write-ghc-environment-files: never
 index-state: 2022-04-27T09:22:49Z
 
 constraints:
-  hls-hlint-plugin +ghc-lib
 
 -- although we are not building all plugins cabal solver phase is run for all packages
 -- this way we track explicitly all transitive dependencies which need support for ghc-9

cabal-ghc92.project

@@ -50,8 +50,6 @@ constraints:
     -retrie
     -splice
     -tactic,
-  hls-hlint-plugin +ghc-lib,
-  -- # Use ghc-lib force instead of ghc itself
   ghc-lib-parser-ex -auto,
   hlint +ghc-lib,
   stylish-haskell +ghc-lib

cabal.project

@@ -37,15 +37,19 @@ optional-packages: vendored/*/*.cabal
 tests: true
 
 package *
-  ghc-options: -haddock
+  -- ghc 8.10 cannot build ghc-lib 9.2 with --haddock
+  -- ghc-options: -haddock
   test-show-details: direct
 
 write-ghc-environment-files: never
 
-index-state: 2022-03-08T10:53:01Z
+index-state: 2022-04-27T09:22:49Z
 
 constraints:
-    hyphenation +embed
+    hyphenation +embed,
+    -- remove this when hlint sets ghc-lib to true by default
+    -- https://github.com/ndmitchell/hlint/issues/1376
+    hlint +ghc-lib
 
 -- This is benign and won't affect our ability to release to Hackage, 
 -- because we only depend on `ekg-wai` when a non-default flag

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

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
@@ -192,12 +191,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)

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

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

@@ -706,17 +706,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.
@@ -729,13 +718,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.
@@ -807,17 +789,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

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
@@ -6075,11 +6075,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'")])]
@@ -6090,7 +6093,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

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 "

hie-compat/hie-compat.cabal

@@ -25,7 +25,7 @@ library
   build-depends:
      base < 4.17, array, bytestring, containers, directory, filepath, transformers
   if flag(ghc-lib)
-    build-depends: ghc-lib
+    build-depends: ghc-lib < 9.0
   else
     build-depends: ghc, ghc-boot
   if (impl(ghc >= 9.0) && impl(ghc < 9.1))

plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal

@@ -15,6 +15,7 @@ extra-source-files:
   LICENSE
   README.md
   test/testdata/*.hs
+  test/testdata/*.txt
   test/testdata/*.yaml
 
 library

plugins/hls-hlint-plugin/hls-hlint-plugin.cabal

@@ -26,17 +26,9 @@ flag pedantic
   manual:      True
 
 flag ghc-lib
-  default:     False
-  manual:      True
-  description:
-    Force dependency on ghc-lib-parser even if GHC API in the ghc package is supported
-
-flag hlint34
-  default:     True
-  manual:      False
-  description:
-    Hlint-3.4 doesn't support versions ghc-lib < 9.0.1 nor ghc <= 8.6, so we can use hlint-3.2 for backwards compat
-    This flag can be removed when all dependencies support ghc-lib-9.0.* and we drop support for ghc-8.6
+   default:     True
+   manual:      True
+   description: Use ghc-lib types (requires hlint to be built with ghc-lib)
 
 library
   exposed-modules:    Ide.Plugin.Hlint
@@ -56,7 +48,7 @@ library
     , ghc-exactprint        >=0.6.3.4
     , ghcide                ^>=1.7
     , hashable
-    , hlint
+    , hlint                 < 3.5
     , hls-plugin-api        ^>=1.4
     , hslogger
     , lens
@@ -69,41 +61,11 @@ library
     , transformers
     , unordered-containers
     , apply-refact          >=0.9.0.0
-    -- can be removed if https://github.com/ndmitchell/hlint/pull/1325#issue-1077062712 is merged
-    -- and https://github.com/haskell/haskell-language-server/pull/2464#issue-1077133441 is updated
-    -- accordingly
+    , ghc-lib
+    , ghc-lib-parser
     , ghc-lib-parser-ex
 
-  if (flag(hlint34))
-    -- This mirrors the logic in hlint.cabal for hlint-3.3
-    -- https://github.com/ndmitchell/hlint/blob/d3576de4529d8df6cca5a345f5b7e04474ff7bff/hlint.cabal#L79-L88
-    -- so we can make sure that we do the same thing as hlint
-    build-depends: hlint      ^>=3.4
-
-    if (!flag(ghc-lib) && impl(ghc >=9.0.1) && impl(ghc <9.1.0))
-      build-depends: ghc      ==9.0.*
-    else
-      build-depends:
-        , ghc-lib            ^>=9.2
-        , ghc-lib-parser-ex  ^>=9.2
-        , ghc-lib-parser     ^>=9.2
-
-      cpp-options:   -DHLINT_ON_GHC_LIB
-
-  else
-    -- This mirrors the logic in hlint.cabal for hlint-3.2
-    -- https://github.com/ndmitchell/hlint/blob/c7354e473c7d09213c8adc3dc94bf50a6eb4a42d/hlint.cabal#L79-L88
-    build-depends: hlint        ^>=3.2
-    if (!flag(ghc-lib) && impl(ghc >=8.10.1) && impl(ghc < 8.11.0))
-      build-depends: ghc >=8.10 && <9.0
-    else
-      build-depends:
-        , ghc
-        , ghc-lib            ^>=8.10.7.20210828
-        , ghc-lib-parser-ex  ^>=8.10
-
-      cpp-options:   -DHLINT_ON_GHC_LIB
-
+  cpp-options:   -DHLINT_ON_GHC_LIB
   ghc-options:
     -Wall -Wredundant-constraints -Wno-name-shadowing
     -Wno-unticked-promoted-constructors

plugins/hls-hlint-plugin/test/Main.hs

@@ -371,7 +371,7 @@ disableHlint = sendConfigurationChanged $ toJSON $ def { Plugin.plugins = Map.fr
 -- Although a given hlint version supports one direct ghc, we could use several versions of hlint
 -- each one supporting a different ghc version. It should be a temporary situation though.
 knownBrokenForHlintOnGhcLib :: String -> TestTree -> TestTree
-knownBrokenForHlintOnGhcLib = knownBrokenForGhcVersions [GHC86, GHC88, GHC90, GHC92]
+knownBrokenForHlintOnGhcLib = expectFailBecause
 
 -- 1's based
 data Point = Point {

stack-lts16.yaml

@@ -103,12 +103,10 @@ flags:
     pedantic: true
   retrie:
     BuildExecutable: false
-  # Stack doesn't support automatic flags.
-  # Until the formatters support ghc-lib-9, we need this flag disabled
-  hls-hlint-plugin:
-    hlint34: false
   hyphenation:
     embed: true
+  hlint:
+    ghc-lib: true
 
 nix:
   packages: [icu libcxx zlib]

stack-lts19.yaml

@@ -67,12 +67,10 @@ flags:
   retrie:
     BuildExecutable: false
   # Stack doesn't support automatic flags.
-  # Until the formatters support ghc-lib-9, we need this flag disabled
-  hls-hlint-plugin:
-    hlint34: true
-    ghc-lib: true
   hyphenation:
     embed: true
+  hlint:
+    ghc-lib: true
 
 nix:
   packages: [ icu libcxx zlib ]

stack.yaml

@@ -82,9 +82,6 @@ flags:
   retrie:
     BuildExecutable: false
   # Stack doesn't support automatic flags.
-  hls-hlint-plugin:
-    hlint34: true
-    ghc-lib: true
   # Use ghc-lib force instead of ghc itself
   ghc-lib-parser-ex:
     auto: false