Use context in code actions for cabal files

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

@@ -19,21 +19,23 @@ 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.Text.Utf16.Rope.Mixed (Rope)
 import Data.Typeable
 import Development.IDE as D
 import Development.IDE.Core.Shake (restartShakeSession)
 import qualified Development.IDE.Core.Shake as Shake
 import Development.IDE.Graph (alwaysRerun)
 import qualified Development.IDE.Plugin.Completions.Logic as Ghcide
-import qualified Development.IDE.Plugin.Completions.Types as Ghcide
 import GHC.Generics
 import qualified Ide.Plugin.Cabal.Completion.Completer.Types as CompleterTypes
 import qualified Ide.Plugin.Cabal.Completion.Completions as Completions
 import qualified Ide.Plugin.Cabal.Completion.Types as Types
 import qualified Ide.Plugin.Cabal.Diagnostics as Diagnostics
-import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
 import qualified Ide.Plugin.Cabal.FieldSuggest as FieldSuggest
+import qualified Ide.Plugin.Cabal.LicenseSuggest as LicenseSuggest
 import qualified Ide.Plugin.Cabal.Parse as Parse
 import Ide.Types
 import qualified Language.LSP.Protocol.Lens as JL
@@ -84,7 +86,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
@@ -199,9 +201,27 @@ 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 misspelled fields in cabal files both for toplevel fields, and fields in stanzas.
+-- Uses same logic as completions but reacts on diagnostics from cabal.
+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 liftA2 (,) vfileM (uriToFilePath' uri) of
+ Nothing -> pure $ InL []
+ Just (vfile, path) -> do
+ let fields = mapMaybe FieldSuggest.fieldErrorName diags
+ results <- forM fields (getSuggestion vfile path)
+ pure $ InL $ map InR $ concat results
+ where
+ getSuggestion vfile fp (field,Diagnostic{ _range=_range@(Range (Position lineNr col) _) })= do
+ let -- compute where we would anticipate the cursor to be.
+ -- This is an heuristic and could be incorrect.
+ fakeLspCursorPosition = Position lineNr (col + fromIntegral (T.length field))
+ lspPrefixInfo = Ghcide.getCompletionPrefix fakeLspCursorPosition vfile
+ cabalPrefixInfo = Completions.getCabalPrefixInfo fp lspPrefixInfo
+ completions <- liftIO $ computeCompletionsAt recorder cabalPrefixInfo fp (vfile ^. VFS.file_text) (shakeExtras ide)
+ let completionTexts = (fmap (^. JL.label) completions)
+ pure $ FieldSuggest.fieldErrorAction uri field completionTexts _range
 
 -- ----------------------------------------------------------------
 -- Cabal file of Interest rules and global variable
@@ -287,32 +307,32 @@ completion recorder ide _ complParams = do
  contents <- lift $ getVirtualFile $ toNormalizedUri uri
  case (contents, uriToFilePath' uri) of
  (Just cnts, Just path) -> do
- let pref = Ghcide.getCompletionPrefix position cnts
- let res = result pref path cnts
- liftIO $ fmap InL res
+ let lspPrefixInfo = Ghcide.getCompletionPrefix position cnts
+ cabalPrefixInfo = Completions.getCabalPrefixInfo path lspPrefixInfo
+ let compls = computeCompletionsAt recorder cabalPrefixInfo path (cnts ^. VFS.file_text) (shakeExtras ide)
+ liftIO $ fmap InL compls
  _ -> pure . InR $ InR Null
- where
- result :: Ghcide.PosPrefixInfo -> FilePath -> VFS.VirtualFile -> IO [CompletionItem]
- result prefix fp cnts = do
- runMaybeT context >>= \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 Types.GetCabalDiagnostics $ 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
- completerRecorder = cmapWithPrio LogCompletions recorder
- pos = Ghcide.cursorPos prefix
- context = Completions.getContext completerRecorder prefInfo (cnts ^. VFS.file_text)
- prefInfo = Completions.getCabalPrefixInfo fp prefix
+
+computeCompletionsAt :: Recorder (WithPriority Log) -> Types.CabalPrefixInfo -> FilePath -> Rope -> ShakeExtras -> IO [CompletionItem]
+computeCompletionsAt recorder cabalPrefixInfo fp fileRope extras = do
+ runMaybeT context >>= \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 "computeCompletionsAt.gpd" extras $ useWithStaleFast Types.GetCabalDiagnostics $ toNormalizedFilePath fp
+ pure $ fmap fst mGPD
+ , cabalPrefixInfo = cabalPrefixInfo
+ , stanzaName =
+ case fst ctx of
+ Types.Stanza _ name -> name
+ _ -> Nothing
+ }
+ completions <- completer completerRecorder completerData
+ pure completions
+ where
+ completerRecorder = cmapWithPrio LogCompletions recorder
+ pos = Types.completionCursorPosition cabalPrefixInfo
+ context = Completions.getContext completerRecorder cabalPrefixInfo fileRope

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'
+ -> T.Text
+ -- ^ Original field
+ -> [T.Text]
+ -- ^ Suggestions
+ -> Range
+ -- ^ location of diagnostic
  -> [CodeAction]
-fieldErrorAction uri diag =
- mkCodeAction <$> fieldErrorSuggestion diag
+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
- -- ^ Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
- -> [(T.Text, T.Text)]
- -- ^ (Original (incorrect) license identifier, suggested replacement)
-fieldErrorSuggestion diag =
+-- then return the incorrect identifier together with original diagnostics.
+fieldErrorName ::
+ -- | Output of 'Ide.Plugin.Cabal.Diag.errorDiagnostic'
+ Diagnostic ->
+ -- | (Original (incorrect) license identifier, suggested replacement)
+ Maybe (T.Text, Diagnostic)
+fieldErrorName diag =
  mSuggestion (_message diag) >>= \case
- [original] -> [(original, "name")]
- _  -> []
+ [original] -> Just (original, diag)
+ _ -> Nothing
  where
  regex :: T.Text
  regex = "Unknown field: \"(.*)\""