Skip to content

Commit

Permalink
Fix language extension code action tests
Browse files Browse the repository at this point in the history
The ghcide merge includes haskell/ghcide#948
which removes the language extension code actions

This makes the associated func-test fail, because the HLS plugin does not pass
the test (only the ghcide code action did). This is because the HLS plugin uses
commands, and the tests do not wait for the command edit to be applied.

The fix is to change the HLS plugin to return a code action with edits and no commands
  • Loading branch information
pepeiborra committed Dec 28, 2020
1 parent b2e1445 commit 291f667
Showing 1 changed file with 11 additions and 23 deletions.
34 changes: 11 additions & 23 deletions plugins/default/src/Ide/Plugin/Pragmas.hs
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,6 @@ import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import Development.IDE as D
import qualified GHC.Generics as Generics
import Ide.Plugin
import Ide.Types
import Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types as J
Expand All @@ -32,19 +31,12 @@ import qualified Language.Haskell.LSP.VFS as VFS

descriptor :: PluginId -> PluginDescriptor
descriptor plId = (defaultPluginDescriptor plId)
{ pluginCommands = commands
, pluginCodeActionProvider = Just codeActionProvider
{ pluginCodeActionProvider = Just codeActionProvider
, pluginCompletionProvider = Just completion
}

-- ---------------------------------------------------------------------

commands :: [PluginCommand]
commands = [ PluginCommand "addPragma" "add the given pragma" addPragmaCmd
]

-- ---------------------------------------------------------------------

-- | Parameters for the addPragma PluginCommand.
data AddPragmaParams = AddPragmaParams
{ file :: J.Uri -- ^ Uri of the file to add the pragma to
Expand All @@ -56,9 +48,9 @@ data AddPragmaParams = AddPragmaParams
-- Pragma is added to the first line of the Uri.
-- It is assumed that the pragma name is a valid pragma,
-- thus, not validated.
addPragmaCmd :: CommandFunction AddPragmaParams
addPragmaCmd _lf _ide (AddPragmaParams uri pragmaName) = do
let
-- mkPragmaEdit :: CommandFunction AddPragmaParams
mkPragmaEdit :: Uri -> T.Text -> WorkspaceEdit
mkPragmaEdit uri pragmaName = res where
pos = J.Position 0 0
textEdits = J.List
[J.TextEdit (J.Range pos pos)
Expand All @@ -67,33 +59,29 @@ addPragmaCmd _lf _ide (AddPragmaParams uri pragmaName) = do
res = J.WorkspaceEdit
(Just $ H.singleton uri textEdits)
Nothing
return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams res))

-- ---------------------------------------------------------------------
-- | Offer to add a missing Language Pragma to the top of a file.
-- Pragmas are defined by a curated list of known pragmas, see 'possiblePragmas'.
codeActionProvider :: CodeActionProvider
codeActionProvider _ state plId docId _ (J.CodeActionContext (J.List diags) _monly) = do
codeActionProvider _ state _plId docId _ (J.CodeActionContext (J.List diags) _monly) = do
let mFile = docId ^. J.uri & uriToFilePath <&> toNormalizedFilePath'
pm <- fmap join $ runAction "addPragma" state $ getParsedModule `traverse` mFile
let dflags = ms_hspp_opts . pm_mod_summary <$> pm
-- Filter diagnostics that are from ghcmod
ghcDiags = filter (\d -> d ^. J.source == Just "typecheck") diags
-- Get all potential Pragmas for all diagnostics.
pragmas = concatMap (\d -> genPragma dflags (d ^. J.message)) ghcDiags
-- cmds <- mapM mkCommand ("FooPragma":pragmas)
cmds <- mapM mkCommand pragmas
cmds <- mapM mkCodeAction pragmas
return $ Right $ List cmds
where
mkCommand pragmaName = do
mkCodeAction pragmaName = do
let
-- | Code Action for the given command.
codeAction :: J.Command -> J.CAResult
codeAction cmd = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) Nothing (Just cmd)
codeAction = J.CACodeAction $ J.CodeAction title (Just J.CodeActionQuickFix) (Just (J.List [])) (Just edit) Nothing
title = "Add \"" <> pragmaName <> "\""
cmdParams = [toJSON (AddPragmaParams (docId ^. J.uri) pragmaName)]
cmd <- mkLspCommand plId "addPragma" title (Just cmdParams)
return $ codeAction cmd
edit = mkPragmaEdit (docId ^. J.uri) pragmaName
return codeAction

genPragma mDynflags target
| Just dynFlags <- mDynflags,
-- GHC does not export 'OnOff', so we have to view it as string
Expand Down

0 comments on commit 291f667

Please sign in to comment.