Merge remote-tracking branch 'upstream/master' into inlay-hints-local-binding

Author: jetjinser

.github/actions/setup-build/action.yml

@@ -31,7 +31,7 @@ runs:
         sudo chown -R $USER /usr/local/.ghcup
       shell: bash
 
-    - uses: haskell-actions/[email protected].5
+    - uses: haskell-actions/[email protected].6
       id: HaskEnvSetup
       with:
         ghc-version  : ${{ inputs.ghc   }}
@@ -116,3 +116,18 @@ runs:
     - name: "Remove freeze file"
       run: rm -f cabal.project.freeze
       shell: bash
+
+    # Make sure to clear all unneeded `ghcup`` caches.
+    # At some point, we were running out of disk space, see issue
+    # https://github.com/haskell/haskell-language-server/issues/4386 for details.
+    #
+    # Using "printf" debugging (`du -sh *` and `df -h /`) and binary searching,
+    # we figured out that `ghcup` caches are taking up a sizable portion of the
+    # disk space.
+    # Thus, we remove anything we don't need, especially caches and temporary files.
+    # For got measure, we also make sure no other tooling versions are
+    # installed besides the ones we explicitly want.
+    - name: "Remove ghcup caches"
+      if: runner.os == 'Linux'
+      run: ghcup gc --ghc-old --share-dir --hls-no-ghc --cache --tmpdirs --unset
+      shell: bash

.github/workflows/bench.yml

@@ -127,7 +127,7 @@ jobs:
         example: ['cabal', 'lsp-types']
 
     steps:
-    - uses: haskell-actions/[email protected].3
+    - uses: haskell-actions/[email protected].6
       with:
         ghc-version  : ${{ matrix.ghc   }}
         cabal-version: ${{ matrix.cabal }}

cabal.project

@@ -7,6 +7,13 @@ packages:
          ./hls-plugin-api
          ./hls-test-utils
 
+-- Only keep this until https://github.com/Bodigrim/cabal-add/issues/7
+-- is resolved
+source-repository-package
+    type: git
+    location: https://github.com/Bodigrim/cabal-add.git
+    tag: 8c004e2a4329232f9824425f5472b2d6d7958bbd
+
 index-state: 2024-06-29T00:00:00Z
 
 tests: True

docs/features.md

@@ -111,6 +111,7 @@ Completions for language pragmas.
 ## Formatting
 
 Format your code with various Haskell code formatters.
+The default Haskell code formatter is `ormolu`, and the Haskell formatter can be configured via the `formattingProvider` option.
 
 | Formatter       | Provided by                  |
 | --------------- | ---------------------------- |
@@ -119,12 +120,17 @@ Format your code with various Haskell code formatters.
 | Ormolu          | `hls-ormolu-plugin`          |
 | Stylish Haskell | `hls-stylish-haskell-plugin` |
 
+---
+
 Format your cabal files with a cabal code formatter.
+The default cabal code formatter is `cabal-gild`, which needs to be available on the `$PATH`,
+or the location needs to be explicitly provided.
+To change the cabal formatter, edit the `cabalFormattingProvider` option.
 
 | Formatter       | Provided by                  |
 |-----------------|------------------------------|
 | cabal-fmt       | `hls-cabal-fmt-plugin`       |
-
+| cabal-gild      | `hls-cabal-gild-plugin`      |
 
 ## Document symbols
 

exe/Wrapper.hs

@@ -9,7 +9,6 @@ module Main where
 
 import           Control.Monad.Extra
 import           Data.Default
-import           Data.Either.Extra                  (eitherToMaybe)
 import           Data.Foldable
 import           Data.List
 import           Data.List.Extra                    (trimEnd)
@@ -76,8 +75,11 @@ main = do
           putStrLn $ showProgramVersionOfInterest programsOfInterest
           putStrLn "Tool versions in your project"
           cradle <- findProjectCradle' recorder False
-          ghcVersion <- runExceptT $ getRuntimeGhcVersion' cradle
-          putStrLn $ showProgramVersion "ghc" $ mkVersion =<< eitherToMaybe ghcVersion
+          runExceptT (getRuntimeGhcVersion' cradle) >>= \case
+            Left err ->
+              T.hPutStrLn stderr (prettyError err NoShorten)
+            Right ghcVersion ->
+              putStrLn $ showProgramVersion "ghc" $ mkVersion ghcVersion
 
       VersionMode PrintVersion ->
           putStrLn hlsVer

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

@@ -29,6 +29,7 @@ import           Development.IDE.Graph
 import           Control.Concurrent.STM.Stats             (atomically,
                                                            modifyTVar')
 import           Data.Aeson                               (toJSON)
+import qualified Data.Aeson                               as Aeson
 import qualified Data.ByteString                          as BS
 import           Data.Maybe                               (catMaybes)
 import           Development.IDE.Core.ProgressReporting

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

@@ -73,7 +73,8 @@ module Development.IDE.Core.Shake(
     garbageCollectDirtyKeysOlderThan,
     Log(..),
     VFSModified(..), getClientConfigAction,
-    ThreadQueue(..)
+    ThreadQueue(..),
+    runWithSignal
     ) where
 
 import           Control.Concurrent.Async
@@ -123,6 +124,10 @@ import           Development.IDE.Core.FileUtils         (getModTime)
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.Core.ProgressReporting
 import           Development.IDE.Core.RuleTypes
+import           Development.IDE.Types.Options          as Options
+import qualified Language.LSP.Protocol.Message          as LSP
+import qualified Language.LSP.Server                    as LSP
+
 import           Development.IDE.Core.Tracing
 import           Development.IDE.Core.WorkerThread
 import           Development.IDE.GHC.Compat             (NameCache,
@@ -147,11 +152,11 @@ import qualified Development.IDE.Types.Exports          as ExportsMap
 import           Development.IDE.Types.KnownTargets
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Monitoring       (Monitoring (..))
-import           Development.IDE.Types.Options
 import           Development.IDE.Types.Shake
 import qualified Focus
 import           GHC.Fingerprint
 import           GHC.Stack                              (HasCallStack)
+import           GHC.TypeLits                           (KnownSymbol)
 import           HieDb.Types
 import           Ide.Logger                             hiding (Priority)
 import qualified Ide.Logger                             as Logger
@@ -165,7 +170,6 @@ import qualified Language.LSP.Protocol.Lens             as L
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
 import qualified Language.LSP.Protocol.Types            as LSP
-import qualified Language.LSP.Server                    as LSP
 import           Language.LSP.VFS                       hiding (start)
 import qualified "list-t" ListT
 import           OpenTelemetry.Eventlog                 hiding (addEvent)
@@ -1350,29 +1354,28 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti
         let uri' = filePathToUri' fp
         let delay = if null newDiags then 0.1 else 0
         registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do
-             join $ mask_ $ do
-                 lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
-                 let action = when (lastPublish /= newDiags) $ case lspEnv of
+            join $ mask_ $ do
+                lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics
+                let action = when (lastPublish /= newDiags) $ case lspEnv of
                         Nothing -> -- Print an LSP event.
                             logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (fp, ShowDiag,) newDiags)
                         Just env -> LSP.runLspT env $ do
                             liftIO $ tag "count" (show $ Prelude.length newDiags)
                             liftIO $ tag "key" (show k)
                             LSP.sendNotification SMethod_TextDocumentPublishDiagnostics $
                                 LSP.PublishDiagnosticsParams (fromNormalizedUri uri') (fmap fromIntegral ver) newDiags
-                 return action
+                return action
     where
         diagsFromRule :: Diagnostic -> Diagnostic
         diagsFromRule c@Diagnostic{_range}
             | coerce ideTesting = c & L.relatedInformation ?~
-                         [
-                        DiagnosticRelatedInformation
+                        [ DiagnosticRelatedInformation
                             (Location
                                 (filePathToUri $ fromNormalizedFilePath fp)
                                 _range
                             )
                             (T.pack $ show k)
-                            ]
+                        ]
             | otherwise = c
 
 
@@ -1444,3 +1447,19 @@ updatePositionMappingHelper ver changes mappingForUri = snd $
         EM.mapAccumRWithKey (\acc _k (delta, _) -> let new = addOldDelta delta acc in (new, (delta, acc)))
             zeroMapping
             (EM.insert ver (mkDelta changes, zeroMapping) mappingForUri)
+
+-- | sends a signal whenever shake session is run/restarted
+-- being used in cabal and hlint plugin tests to know when its time
+-- to look for file diagnostics
+kickSignal :: KnownSymbol s => Bool -> Maybe (LSP.LanguageContextEnv c) -> [NormalizedFilePath] -> Proxy s -> Action ()
+kickSignal testing lspEnv files msg = when testing $ liftIO $ mRunLspT lspEnv $
+  LSP.sendNotification (LSP.SMethod_CustomMethod msg) $
+  toJSON $ map fromNormalizedFilePath files
+
+-- | Add kick start/done signal to rule
+runWithSignal :: (KnownSymbol s0, KnownSymbol s1, IdeRule k v) => Proxy s0 -> Proxy s1 -> [NormalizedFilePath] -> k -> Action ()
+runWithSignal msgStart msgEnd files rule = do
+  ShakeExtras{ideTesting = Options.IdeTesting testing, lspEnv} <- getShakeExtras
+  kickSignal testing lspEnv files msgStart
+  void $ uses rule files
+  kickSignal testing lspEnv files msgEnd

haskell-language-server.cabal

@@ -244,7 +244,9 @@ library hls-cabal-plugin
     Ide.Plugin.Cabal.Completion.Types
     Ide.Plugin.Cabal.FieldSuggest
     Ide.Plugin.Cabal.LicenseSuggest
+    Ide.Plugin.Cabal.CabalAdd
     Ide.Plugin.Cabal.Orphans
+    Ide.Plugin.Cabal.Outline
     Ide.Plugin.Cabal.Parse
 
 
@@ -269,6 +271,12 @@ library hls-cabal-plugin
     , transformers
     , unordered-containers  >=0.2.10.0
     , containers
+    , cabal-add
+    , process
+    , aeson
+    , Cabal
+    , pretty
+
   hs-source-dirs:   plugins/hls-cabal-plugin/src
 
 test-suite hls-cabal-plugin-tests
@@ -282,6 +290,8 @@ test-suite hls-cabal-plugin-tests
     Completer
     Context
     Utils
+    Outline
+    CabalAdd
   build-depends:
     , base
     , bytestring
@@ -294,6 +304,7 @@ test-suite hls-cabal-plugin-tests
     , lens
     , lsp-types
     , text
+    , hls-plugin-api
 
 -----------------------------
 -- class plugin
@@ -714,7 +725,6 @@ library hls-hlint-plugin
     , hlint                 >= 3.5 && < 3.9
     , hls-plugin-api        == 2.9.0.1
     , lens
-    , lsp
     , mtl
     , refact
     , regex-tdfa
@@ -725,6 +735,8 @@ library hls-hlint-plugin
     , unordered-containers
     , ghc-lib-parser-ex
     , apply-refact
+    --
+    , lsp-types
 
   if flag(ghc-lib)
     cpp-options:   -DGHC_LIB

hls-test-utils/src/Test/Hls.hs

@@ -61,14 +61,17 @@ module Test.Hls
     WithPriority(..),
     Recorder,
     Priority(..),
-    TestConfig(..),
+    captureKickDiagnostics,
+    kick,
+    TestConfig(..)
     )
 where
 
 import           Control.Applicative.Combinators
 import           Control.Concurrent.Async                 (async, cancel, wait)
 import           Control.Concurrent.Extra
 import           Control.Exception.Safe
+import           Control.Lens                             ((^.))
 import           Control.Lens.Extras                      (is)
 import           Control.Monad                            (guard, unless, void)
 import           Control.Monad.Extra                      (forM)
@@ -80,7 +83,7 @@ import qualified Data.Aeson                               as A
 import           Data.ByteString.Lazy                     (ByteString)
 import           Data.Default                             (Default, def)
 import qualified Data.Map                                 as M
-import           Data.Maybe                               (fromMaybe)
+import           Data.Maybe                               (fromMaybe, mapMaybe)
 import           Data.Proxy                               (Proxy (Proxy))
 import qualified Data.Text                                as T
 import qualified Data.Text.Lazy                           as TL
@@ -114,6 +117,7 @@ import           Ide.PluginUtils                          (idePluginsToPluginDes
                                                            pluginDescToIdePlugins)
 import           Ide.Types
 import           Language.LSP.Protocol.Capabilities
+import qualified Language.LSP.Protocol.Lens               as L
 import           Language.LSP.Protocol.Message
 import qualified Language.LSP.Protocol.Message            as LSP
 import           Language.LSP.Protocol.Types              hiding (Null)
@@ -231,14 +235,14 @@ goldenWithTestConfig
   :: Pretty b
   => TestConfig b
   -> TestName
-  -> FilePath
+  -> VirtualFileTree
   -> FilePath
   -> FilePath
   -> FilePath
   -> (TextDocumentIdentifier -> Session ())
   -> TestTree
-goldenWithTestConfig config title testDataDir path desc ext act =
-  goldenGitDiff title (testDataDir </> path <.> desc <.> ext)
+goldenWithTestConfig config title tree path desc ext act =
+  goldenGitDiff title (vftOriginalRoot tree </> path <.> desc <.> ext)
   $ runSessionWithTestConfig config $ const
   $ TL.encodeUtf8 . TL.fromStrict
   <$> do
@@ -869,6 +873,17 @@ setHlsConfig config = do
   -- requests!
   skipManyTill anyMessage (void configurationRequest)
 
+captureKickDiagnostics :: Session () -> Session () -> Session [Diagnostic]
+captureKickDiagnostics start done = do
+    _ <- skipManyTill anyMessage start
+    messages <- manyTill anyMessage done
+    pure $ concat $ mapMaybe diagnostics messages
+    where
+        diagnostics :: FromServerMessage' a -> Maybe [Diagnostic]
+        diagnostics = \msg -> case msg of
+            FromServerMess SMethod_TextDocumentPublishDiagnostics diags -> Just (diags ^. L.params . L.diagnostics)
+            _ -> Nothing
+
 waitForKickDone :: Session ()
 waitForKickDone = void $ skipManyTill anyMessage nonTrivialKickDone
 
@@ -881,9 +896,11 @@ nonTrivialKickDone = kick (Proxy @"kick/done") >>= guard . not . null
 nonTrivialKickStart :: Session ()
 nonTrivialKickStart = kick (Proxy @"kick/start") >>= guard . not . null
 
+
 kick :: KnownSymbol k => Proxy k -> Session [FilePath]
 kick proxyMsg = do
   NotMess TNotificationMessage{_params} <- customNotification proxyMsg
   case fromJSON _params of
     Success x -> return x
     other     -> error $ "Failed to parse kick/done details: " <> show other
+