Use context in code actions for cabal files

dyniec · dyniec · commit 00be14bf7b42 · 2024-06-08T17:17:33.000+01:00
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
@@ -264,7 +264,6 @@ library hls-cabal-plugin
     , lsp-types             ^>=2.3
     , regex-tdfa            ^>=1.3.1
     , text
-    , text-rope
     , transformers
     , unordered-containers  >=0.2.10.0
     , containers
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
@@ -18,6 +18,8 @@ import           Data.Hashable
 import           Data.HashMap.Strict                         (HashMap)
 import qualified Data.HashMap.Strict                         as HashMap
 import qualified Data.List.NonEmpty                          as NE
+import           Data.Maybe                                  (mapMaybe)
+import qualified Data.Text                                   as T
 import qualified Data.Text.Encoding                          as Encoding
 import           Data.Typeable
 import           Development.IDE                             as D
@@ -36,9 +38,9 @@ import           Ide.Plugin.Cabal.Completion.Types           (ParseCabalFields (
                                                               ParseCabalFile (..))
 import qualified Ide.Plugin.Cabal.Completion.Types           as Types
 import qualified Ide.Plugin.Cabal.Diagnostics                as Diagnostics
+import qualified Ide.Plugin.Cabal.FieldSuggest               as FieldSuggest
 import qualified Ide.Plugin.Cabal.LicenseSuggest             as LicenseSuggest
 import           Ide.Plugin.Cabal.Orphans                    ()
-import qualified Ide.Plugin.Cabal.FieldSuggest               as FieldSuggest
 import qualified Ide.Plugin.Cabal.Parse                      as Parse
 import           Ide.Types
 import qualified Language.LSP.Protocol.Lens                  as JL
@@ -89,7 +91,7 @@ descriptor recorder plId =
         mconcat
           [ mkPluginHandler LSP.SMethod_TextDocumentCodeAction licenseSuggestCodeAction
           , mkPluginHandler LSP.SMethod_TextDocumentCompletion $ completion recorder
-          , mkPluginHandler LSP.SMethod_TextDocumentCodeAction fieldSuggestCodeAction
+          , mkPluginHandler LSP.SMethod_TextDocumentCodeAction $ fieldSuggestCodeAction recorder
           ]
     , pluginNotificationHandlers =
         mconcat
@@ -230,9 +232,34 @@ licenseSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumen
 licenseSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) =
   pure $ InL $ diags >>= (fmap InR . LicenseSuggest.licenseErrorAction uri)
 
-fieldSuggestCodeAction :: PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
-fieldSuggestCodeAction _ _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range CodeActionContext{_diagnostics=diags}) =
-  pure $ InL $ diags >>= (fmap InR . FieldSuggest.fieldErrorAction uri)
+-- | CodeActions for correcting field names with typos in them.
+--
+-- Provides CodeActions that fix typos in field names, in both stanzas and top-level field names.
+-- The suggestions are computed based on the completion context, where we "move" a fake cursor
+-- to the end of the field name and trigger cabal file completions. The completions are then
+-- suggested to the user.
+fieldSuggestCodeAction :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'LSP.Method_TextDocumentCodeAction
+fieldSuggestCodeAction recorder ide _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _ CodeActionContext{_diagnostics=diags}) = do
+  vfileM <- lift (getVirtualFile $ toNormalizedUri uri)
+  case (,) <$> vfileM <*> uriToFilePath' uri of
+    Nothing -> pure $ InL []
+    Just (vfile, path) -> do
+      mFields <- liftIO $ runIdeAction "cabal-plugin.fields" (shakeExtras ide) $ useWithStaleFast ParseCabalFields $ toNormalizedFilePath path
+      case mFields of
+        Nothing ->
+          pure $ InL []
+        Just (fields, _) -> do
+          let errorFields = mapMaybe FieldSuggest.fieldErrorName diags
+          results <- forM errorFields (getSuggestion fields vfile path)
+          pure $ InL $ map InR $ concat results
+  where
+    getSuggestion fields vfile fp (field,Diagnostic{ _range=_range@(Range (Position lineNr col) _) })= do
+      let -- Compute where we would anticipate the cursor to be.
+          fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length field))
+          lspPrefixInfo = Ghcide.getCompletionPrefix fakeLspCursorPosition vfile
+      completions <- liftIO $ produceCompletions recorder lspPrefixInfo fp fields (shakeExtras ide)
+      let completionTexts = (fmap (^. JL.label) completions)
+      pure $ FieldSuggest.fieldErrorAction uri field completionTexts _range
 
 -- ----------------------------------------------------------------
 -- Cabal file of Interest rules and global variable
@@ -326,32 +353,31 @@ completion recorder ide _ complParams = do
           pure . InR $ InR Null
         Just (fields, _) -> do
           let pref = Ghcide.getCompletionPrefix position cnts
-          let res = produceCompletions pref path fields
+          let res = produceCompletions recorder pref path fields (shakeExtras ide)
           liftIO $ fmap InL res
     Nothing -> pure . InR $ InR Null
- where
-  completerRecorder = cmapWithPrio LogCompletions recorder
 
-  produceCompletions :: Ghcide.PosPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> IO [CompletionItem]
-  produceCompletions prefix fp fields = do
-    runMaybeT (context fields) >>= \case
-      Nothing -> pure []
-      Just ctx -> do
-        logWith recorder Debug $ LogCompletionContext ctx pos
-        let completer = Completions.contextToCompleter ctx
-        let completerData = CompleterTypes.CompleterData
-              { getLatestGPD = do
-                mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" (shakeExtras ide) $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp
-                pure $ fmap fst mGPD
-              , cabalPrefixInfo = prefInfo
-              , stanzaName =
-                case fst ctx of
-                  Types.Stanza _ name -> name
-                  _                   -> Nothing
-              }
-        completions <- completer completerRecorder completerData
-        pure completions
-   where
-    pos = Ghcide.cursorPos prefix
-    context fields = Completions.getContext completerRecorder prefInfo fields
-    prefInfo = Completions.getCabalPrefixInfo fp prefix
+produceCompletions :: Recorder (WithPriority Log) -> Ghcide.PosPrefixInfo -> FilePath -> [Syntax.Field Syntax.Position] -> ShakeExtras -> IO [CompletionItem]
+produceCompletions recorder prefix fp fields extras = do
+  runMaybeT (context fields) >>= \case
+    Nothing -> pure []
+    Just ctx -> do
+      logWith recorder Debug $ LogCompletionContext ctx pos
+      let completer = Completions.contextToCompleter ctx
+      let completerData = CompleterTypes.CompleterData
+            { getLatestGPD = do
+              mGPD <- runIdeAction "cabal-plugin.modulesCompleter.gpd" extras $ useWithStaleFast ParseCabalFile $ toNormalizedFilePath fp
+              pure $ fmap fst mGPD
+            , cabalPrefixInfo = prefInfo
+            , stanzaName =
+              case fst ctx of
+                Types.Stanza _ name -> name
+                _                   -> Nothing
+            }
+      completions <- completer completerRecorder completerData
+      pure completions
+  where
+  pos = Ghcide.cursorPos prefix
+  context fields = Completions.getContext completerRecorder prefInfo fields
+  prefInfo = Completions.getCabalPrefixInfo fp prefix
+  completerRecorder = cmapWithPrio LogCompletions recorder
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/FieldSuggest.hs
@@ -3,65 +3,65 @@
 {-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE OverloadedStrings   #-}
+
 module Ide.Plugin.Cabal.FieldSuggest
-( fieldErrorSuggestion
-, fieldErrorAction
-  -- * Re-exports
-, T.Text
-, Diagnostic(..)
-)
+  ( fieldErrorName,
+    fieldErrorAction,
+    -- * Re-exports
+    T.Text,
+    Diagnostic (..),
+  )
 where
 
 import qualified Data.Map.Strict             as Map
 import qualified Data.Text                   as T
-import           Language.LSP.Protocol.Types (CodeAction (CodeAction),
+import           Language.LSP.Protocol.Types (CodeAction (..),
                                               CodeActionKind (..),
-                                              Diagnostic (..),
-                                              Position (Position),
-                                              Range (Range),
-                                              TextEdit (TextEdit), Uri,
-                                              WorkspaceEdit (WorkspaceEdit))
+                                              Diagnostic (..), Position (..),
+                                              Range (..), TextEdit (..), Uri,
+                                              WorkspaceEdit (..))
 import           Text.Regex.TDFA
 
--- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
---   if it represents an "Unknown field"-error along
---   with a incorrect field, then return a 'CodeAction' for replacing the
---   the incorrect field with the suggestion.
---   It should be context sensitive, but for now it isn't
+-- | Generate all code action for given file, error field in position and suggestions
 fieldErrorAction
   :: Uri
   -- ^ File for which the diagnostic was generated
-  -> Diagnostic
-  -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
-  ->  [CodeAction]
-fieldErrorAction uri diag =
-  mkCodeAction <$> fieldErrorSuggestion diag
+  -> T.Text
+  -- ^ Original field
+  -> [T.Text]
+  -- ^ Suggestions
+  -> Range
+  -- ^ Location of diagnostic
+  -> [CodeAction]
+fieldErrorAction uri original suggestions range =
+  fmap mkCodeAction  suggestions
   where
-    mkCodeAction (original, suggestion) =
+    mkCodeAction suggestion =
       let
         -- Range returned by cabal here represents fragment from start of
         -- offending identifier to end of line, we modify it to the end of identifier
-        adjustRange (Range rangeFrom@(Position line col) _) =
-          Range rangeFrom (Position line (col + fromIntegral (T.length original)))
-        title = "Replace with " <> suggestion
-        tedit = [TextEdit (adjustRange $ _range diag) suggestion]
+        adjustRange (Range rangeFrom@(Position lineNr col) _) =
+          Range rangeFrom (Position lineNr (col + fromIntegral (T.length original)))
+        title = "Replace with " <> suggestion'
+        tedit = [TextEdit (adjustRange range ) suggestion']
         edit  = WorkspaceEdit (Just $ Map.singleton uri tedit) Nothing Nothing
       in CodeAction title (Just CodeActionKind_QuickFix) (Just []) Nothing Nothing (Just edit) Nothing Nothing
+      where
+        -- dropping colon from the end of suggestion
+        suggestion' = T.dropEnd 1 suggestion
 
 -- | Given a diagnostic returned by 'Ide.Plugin.Cabal.Diag.errorDiagnostic',
 --   if it represents an "Unknown field"- error with incorrect identifier
---   then return the suggestion (for now placeholder "name")
---   along with the incorrect identifier.
---
-fieldErrorSuggestion
-  :: Diagnostic
+--   then return the incorrect identifier together with original diagnostics.
+fieldErrorName ::
+  Diagnostic ->
   -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
-  -> [(T.Text, T.Text)]
-  -- ^ (Original (incorrect) license identifier, suggested replacement)
-fieldErrorSuggestion diag =
+  Maybe (T.Text, Diagnostic)
+  -- ^ Original (incorrect) field name with the suggested replacement
+fieldErrorName diag =
   mSuggestion (_message diag) >>= \case
-    [original] -> [(original, "name")]
-    _                      -> []
+    [original] -> Just (original, diag)
+    _ -> Nothing
   where
     regex :: T.Text
     regex = "Unknown field: \"(.*)\""
diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/LicenseSuggest.hs
@@ -72,7 +72,7 @@ licenseErrorSuggestion ::
   T.Text
   -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
   -> [(T.Text, T.Text)]
-  -- ^ (Original (incorrect) license identifier, suggested replacement)
+  -- ^ Original (incorrect) license identifier with the suggested replacement
 licenseErrorSuggestion msg =
    (getMatch <$> msg =~~ regex) >>= \case
           [original] ->
