src/Development/IDE/LSP/CodeAction.hs · ghcide

git.iko.soy/ghcide

on b2380ea help sign in

ghcide/src/Development/IDE/LSP/CodeAction.hs

98 lines 4.2 kB history raw

2-- SPDX-License-Identifier: Apache-2.0

4{-# LANGUAGE OverloadedStrings #-}

5{-# LANGUAGE DuplicateRecordFields #-}

7-- | Go to the definition of a variable.

8module Development.IDE.LSP.CodeAction

9 ( setHandlersCodeAction

10 ) where

12import Language.Haskell.LSP.Types

13import GHC.LanguageExtensions.Type

14import Development.IDE.Core.Rules

15import Development.IDE.LSP.Server

16import qualified Data.HashMap.Strict as Map

17import qualified Data.HashSet as Set

18import qualified Language.Haskell.LSP.Core as LSP

19import Language.Haskell.LSP.VFS

20import Language.Haskell.LSP.Messages

21import qualified Data.Rope.UTF16 as Rope

22import Data.Char

23import qualified Data.Text as T

25-- | Generate code actions.

26codeAction

27 :: LSP.LspFuncs ()

28 -> IdeState

29 -> CodeActionParams

30 -> IO (List CAResult)

31codeAction lsp _ CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do

32 -- disable logging as its quite verbose

33 -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg

34 contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri

35 let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents

36 pure $ List

37 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing

38 | x <- xs, (title, tedit) <- suggestAction text x

39 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing

40 ]

43suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

44suggestAction contents Diagnostic{_range=_range@Range{..},..}

46-- File.hs:16:1: warning:

47-- The import of `Data.List' is redundant

48-- except perhaps to import instances from `Data.List'

49-- To import instances alone, use: import Data.List()

50 | "The import of " `T.isInfixOf` _message

51 , " is redundant" `T.isInfixOf` _message

52 , let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . textAtPosition _end) contents

53 , let extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line

54 = [("Remove import", [TextEdit (if extend then Range _start (Position (_line _end + 1) 0) else _range) ""])]

56-- File.hs:22:8: error:

57-- Illegal lambda-case (use -XLambdaCase)

58-- File.hs:22:6: error:

59-- Illegal view pattern: x -> foo

60-- Use ViewPatterns to enable view patterns

61-- File.hs:26:8: error:

62-- Illegal `..' in record pattern

63-- Use RecordWildCards to permit this

64-- File.hs:53:28: error:

65-- Illegal tuple section: use TupleSections

66-- File.hs:238:29: error:

67-- * Can't make a derived instance of `Data FSATrace':

68-- You need DeriveDataTypeable to derive an instance for this class

69-- * In the data declaration for `FSATrace'

70-- C:\Neil\shake\src\Development\Shake\Command.hs:515:31: error:

71-- * Illegal equational constraint a ~ ()

72-- (Use GADTs or TypeFamilies to permit this)

73-- * In the context: a ~ ()

74-- While checking an instance declaration

75-- In the instance declaration for `Unit (m a)'

76 | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message

77 = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]

79suggestAction _ _ = []

82-- | All the GHC extensions

83ghcExtensions :: Set.HashSet T.Text

84ghcExtensions = Set.fromList $ map (T.pack . show) [Cpp .. StarIsType] -- use enumerate from GHC 8.8 and beyond

87textAtPosition :: Position -> T.Text -> (T.Text, T.Text)

88textAtPosition (Position row col) x

89 | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x

90 , (preCol, postCol) <- T.splitAt col mid

91 = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)

92 | otherwise = (x, T.empty)

95setHandlersCodeAction :: PartialHandlers

96setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{

97 LSP.codeActionHandler = withResponse RspCodeAction codeAction

98 }