Merge branch 'master' into inlay-hints-record-wildcards

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

@@ -31,7 +31,7 @@ runs:
         sudo chown -R $USER /usr/local/.ghcup
       shell: bash
 
-    - uses: haskell-actions/setup@v2.7.5
+    - uses: haskell-actions/setup@v2.7.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/setup@v2.7.3
+    - uses: haskell-actions/setup@v2.7.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

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

haskell-language-server.cabal

@@ -244,6 +244,7 @@ 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
@@ -270,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
@@ -284,6 +291,7 @@ test-suite hls-cabal-plugin-tests
     Context
     Utils
     Outline
+    CabalAdd
   build-depends:
     , base
     , bytestring
@@ -296,6 +304,7 @@ test-suite hls-cabal-plugin-tests
     , lens
     , lsp-types
     , text
+    , hls-plugin-api
 
 -----------------------------
 -- class plugin

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

@@ -4,7 +4,7 @@
 {-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE TypeFamilies          #-}
 
-module Ide.Plugin.Cabal (descriptor, Log (..)) where
+module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where
 
 import           Control.Concurrent.Strict
 import           Control.DeepSeq
@@ -17,12 +17,14 @@ import qualified Data.ByteString                             as BS
 import           Data.Hashable
 import           Data.HashMap.Strict                         (HashMap)
 import qualified Data.HashMap.Strict                         as HashMap
+import           Data.List                                   (find)
 import qualified Data.List.NonEmpty                          as NE
 import qualified Data.Maybe                                  as Maybe
 import qualified Data.Text                                   as T
 import qualified Data.Text.Encoding                          as Encoding
 import           Data.Typeable
 import           Development.IDE                             as D
+import           Development.IDE.Core.PluginUtils
 import           Development.IDE.Core.Shake                  (restartShakeSession)
 import qualified Development.IDE.Core.Shake                  as Shake
 import           Development.IDE.Graph                       (Key, alwaysRerun)
@@ -31,6 +33,7 @@ import           Development.IDE.Types.Shake                 (toKey)
 import qualified Distribution.Fields                         as Syntax
 import qualified Distribution.Parsec.Position                as Syntax
 import           GHC.Generics
+import           Ide.Plugin.Cabal.Completion.CabalFields     as CabalFields
 import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
 import qualified Ide.Plugin.Cabal.Completion.Completions     as Completions
 import           Ide.Plugin.Cabal.Completion.Types           (ParseCabalCommonSections (ParseCabalCommonSections),
@@ -43,12 +46,16 @@ import qualified Ide.Plugin.Cabal.LicenseSuggest             as LicenseSuggest
 import           Ide.Plugin.Cabal.Orphans                    ()
 import           Ide.Plugin.Cabal.Outline
 import qualified Ide.Plugin.Cabal.Parse                      as Parse
+import           Ide.Plugin.Error
 import           Ide.Types
 import qualified Language.LSP.Protocol.Lens                  as JL
 import qualified Language.LSP.Protocol.Message               as LSP
 import           Language.LSP.Protocol.Types
 import qualified Language.LSP.VFS                            as VFS
 
+import qualified Data.Text                                   ()
+import qualified Ide.Plugin.Cabal.CabalAdd                   as CabalAdd
+
 data Log
   = LogModificationTime NormalizedFilePath FileVersion
   | LogShake Shake.Log
@@ -59,6 +66,7 @@ data Log
   | LogFOI (HashMap NormalizedFilePath FileOfInterestStatus)
   | LogCompletionContext Types.Context Position
   | LogCompletions Types.Log
+  | LogCabalAdd CabalAdd.Log
   deriving (Show)
 
 instance Pretty Log where
@@ -82,6 +90,25 @@ instance Pretty Log where
         <+> "for cursor position:"
         <+> pretty position
     LogCompletions logs -> pretty logs
+    LogCabalAdd logs -> pretty logs
+
+-- | Some actions with cabal files originate from haskell files.
+-- This descriptor allows to hook into the diagnostics of haskell source files, and
+-- allows us to provide code actions and commands that interact with `.cabal` files.
+haskellInteractionDescriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
+haskellInteractionDescriptor recorder plId =
+  (defaultPluginDescriptor plId "Provides the cabal-add code action in haskell files")
+    { pluginHandlers =
+        mconcat
+          [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction cabalAddCodeAction
+          ]
+    , pluginCommands = [PluginCommand CabalAdd.cabalAddCommand "add a dependency to a cabal file" (CabalAdd.command cabalAddRecorder)]
+    , pluginRules = pure ()
+    , pluginNotificationHandlers = mempty
+    }
+    where
+      cabalAddRecorder = cmapWithPrio LogCabalAdd recorder
+
 
 descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
 descriptor recorder plId =
@@ -93,6 +120,7 @@ descriptor recorder plId =
           , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
           , mkPluginHandler LSP.SMethod_TextDocumentDocumentSymbol moduleOutline
           , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
+          , mkPluginHandler LSP.SMethod_TextDocumentDefinition gotoDefinition
           ]
     , pluginNotificationHandlers =
         mconcat
@@ -277,6 +305,59 @@ fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentif
       let completionTexts = fmap (^. JL.label) completions
       pure $ FieldSuggest.fieldErrorAction uri fieldName completionTexts _range
 
+-- | CodeActions for going to definitions.
+--
+-- Provides a CodeAction for going to a definition when clicking on an identifier.
+-- The definition is found by traversing the sections and comparing their name to
+-- the clicked identifier.
+--
+-- TODO: Support more definitions than sections.
+gotoDefinition :: PluginMethodHandler IdeState LSP.Method_TextDocumentDefinition
+gotoDefinition ideState _ msgParam = do
+    nfp <- getNormalizedFilePathE uri
+    cabalFields <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalFields nfp
+    case CabalFields.findTextWord cursor cabalFields of
+      Nothing ->
+        pure $ InR $ InR Null
+      Just cursorText -> do
+        commonSections <- runActionE "cabal-plugin.commonSections" ideState $ useE ParseCabalCommonSections nfp
+        case find (isSectionArgName cursorText) commonSections of
+          Nothing ->
+            pure $ InR $ InR Null
+          Just commonSection -> do
+            pure $ InL $ Definition $ InL $ Location uri $ CabalFields.getFieldLSPRange commonSection
+    where
+      cursor = Types.lspPositionToCabalPosition (msgParam ^. JL.position)
+      uri = msgParam ^. JL.textDocument . JL.uri
+      isSectionArgName name (Syntax.Section _ sectionArgName _) = name == CabalFields.onelineSectionArgs sectionArgName
+      isSectionArgName _ _ = False
+
+cabalAddCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
+cabalAddCodeAction state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
+  maxCompls <- fmap maxCompletions . liftIO $ runAction "cabal.cabal-add" state getClientConfigAction
+  let suggestions = take maxCompls $ concatMap CabalAdd.hiddenPackageSuggestion diags
+  case suggestions of
+    [] -> pure $ InL []
+    _ ->
+      case uriToFilePath uri of
+        Nothing -> pure $ InL []
+        Just haskellFilePath -> do
+          mbCabalFile <- liftIO $ CabalAdd.findResponsibleCabalFile haskellFilePath
+          case mbCabalFile of
+            Nothing -> pure $ InL []
+            Just cabalFilePath -> do
+              verTxtDocId <- lift $ pluginGetVersionedTextDoc $ TextDocumentIdentifier (filePathToUri cabalFilePath)
+              mbGPD <- liftIO $ runAction "cabal.cabal-add" state $ useWithStale ParseCabalFile $ toNormalizedFilePath cabalFilePath
+              case mbGPD of
+                Nothing -> pure $ InL []
+                Just (gpd, _) -> do
+                  actions <- liftIO $ CabalAdd.addDependencySuggestCodeAction plId verTxtDocId
+                                                                              suggestions
+                                                                              haskellFilePath cabalFilePath
+                                                                              gpd
+                  pure $ InL $ fmap InR actions
+
+
 -- ----------------------------------------------------------------
 -- Cabal file of Interest rules and global variable
 -- ----------------------------------------------------------------