git.iko.soy/ghcide
on f455375 help sign in
ghcide/src/Development/IDE/LSP/CodeAction.hs
159 lines 7.2 kB history raw
1-- Copyright (c) 2019 The DAML Authors. All rights reserved.
2-- SPDX-License-Identifier: Apache-2.0
4{-# LANGUAGE DuplicateRecordFields #-}
6-- | Go to the definition of a variable.
7module Development.IDE.LSP.CodeAction
8 ( setHandlersCodeAction
9 ) where
11import Language.Haskell.LSP.Types
12import Development.IDE.GHC.Compat
13import Development.IDE.Core.Rules
14import Development.IDE.LSP.Server
15import qualified Data.HashMap.Strict as Map
16import qualified Data.HashSet as Set
17import qualified Language.Haskell.LSP.Core as LSP
18import Language.Haskell.LSP.VFS
19import Language.Haskell.LSP.Messages
20import qualified Data.Rope.UTF16 as Rope
21import Data.Char
22import Data.Maybe
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 = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])]
54-- File.hs:52:41: error:
55-- * Variable not in scope:
56-- suggestAcion :: Maybe T.Text -> Range -> Range
57-- * Perhaps you meant ‘suggestAction’ (line 83)
58-- File.hs:94:37: error:
59-- Not in scope: ‘T.isPrfixOf’
60-- Perhaps you meant one of these:
61-- ‘T.isPrefixOf’ (imported from Data.Text),
62-- ‘T.isInfixOf’ (imported from Data.Text),
63-- ‘T.isSuffixOf’ (imported from Data.Text)
64-- Module ‘Data.Text’ does not export ‘isPrfixOf’.
65 | renameSuggestions@(_:_) <- extractRenamableTerms _message
66 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]
68-- File.hs:22:8: error:
69-- Illegal lambda-case (use -XLambdaCase)
70-- File.hs:22:6: error:
71-- Illegal view pattern: x -> foo
72-- Use ViewPatterns to enable view patterns
73-- File.hs:26:8: error:
74-- Illegal `..' in record pattern
75-- Use RecordWildCards to permit this
76-- File.hs:53:28: error:
77-- Illegal tuple section: use TupleSections
78-- File.hs:238:29: error:
79-- * Can't make a derived instance of `Data FSATrace':
80-- You need DeriveDataTypeable to derive an instance for this class
81-- * In the data declaration for `FSATrace'
82-- C:\Neil\shake\src\Development\Shake\Command.hs:515:31: error:
83-- * Illegal equational constraint a ~ ()
84-- (Use GADTs or TypeFamilies to permit this)
85-- * In the context: a ~ ()
86-- While checking an instance declaration
87-- In the instance declaration for `Unit (m a)'
88 | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message
89 = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]
91suggestAction _ _ = []
93mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit
94mkRenameEdit contents range name =
95 if fromMaybe False maybeIsInfixFunction
96 then TextEdit range ("`" <> name <> "`")
97 else TextEdit range name
98 where
99 maybeIsInfixFunction = do
100 curr <- textInRange range <$> contents
101 pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr
104extractRenamableTerms :: T.Text -> [T.Text]
105extractRenamableTerms msg
106 -- Account for both "Variable not in scope" and "Not in scope"
107 | "ot in scope:" `T.isInfixOf` msg = extractSuggestions msg
108 | otherwise = []
109 where
110 extractSuggestions = map getEnclosed
111 . concatMap singleSuggestions
112 . filter isKnownSymbol
113 . T.lines
114 singleSuggestions = T.splitOn "), " -- Each suggestion is comma delimited
115 isKnownSymbol t = " (imported from" `T.isInfixOf` t || " (line " `T.isInfixOf` t
116 getEnclosed = T.dropWhile (== '‘')
117 . T.dropWhileEnd (== '’')
118 . T.dropAround (\c -> c /= '‘' && c /= '’')
120-- | If a range takes up a whole line (it begins at the start of the line and there's only whitespace
121-- between the end of the range and the next newline), extend the range to take up the whole line.
122extendToWholeLineIfPossible :: Maybe T.Text -> Range -> Range
123extendToWholeLineIfPossible contents range@Range{..} =
124 let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . splitTextAtPosition _end) contents
125 extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line
126 in if extend then Range _start (Position (_line _end + 1) 0) else range
128-- | All the GHC extensions
129ghcExtensions :: Set.HashSet T.Text
130ghcExtensions = Set.fromList $ map (T.pack . show) ghcEnumerateExtensions
132splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text)
133splitTextAtPosition (Position row col) x
134 | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x
135 , (preCol, postCol) <- T.splitAt col mid
136 = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)
137 | otherwise = (x, T.empty)
139textInRange :: Range -> T.Text -> T.Text
140textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =
141 case compare startRow endRow of
142 LT ->
143 let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine
144 (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of
145 [] -> ("", [])
146 firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween)
147 maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines
148 in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine)
149 EQ ->
150 let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine)
151 in T.take (endCol - startCol) (T.drop startCol line)
152 GT -> ""
153 where
154 linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text)
156setHandlersCodeAction :: PartialHandlers
157setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
158 LSP.codeActionHandler = withResponse RspCodeAction codeAction
159 }