cabal-add integration as a CodeAction

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

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
@@ -53,6 +53,9 @@ 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
@@ -63,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
@@ -86,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 =
@@ -309,6 +332,32 @@ gotoDefinition ideState _ msgParam = do
       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
 -- ----------------------------------------------------------------