git.iko.soy/ghcide
on a58751e help sign in
ghcide/src/Development/IDE/LSP/CodeAction.hs
186 lines 8.5 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 Data.List.Extra
24import qualified Data.Text as T
26-- | Generate code actions.
27codeAction
28 :: LSP.LspFuncs ()
29 -> IdeState
30 -> CodeActionParams
31 -> IO (List CAResult)
32codeAction lsp _ CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
33 -- disable logging as its quite verbose
34 -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg
35 contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
36 let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
37 pure $ List
38 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
39 | x <- xs, (title, tedit) <- suggestAction text x
40 , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
41 ]
44suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
45suggestAction contents Diagnostic{_range=_range@Range{..},..}
47-- File.hs:16:1: warning:
48-- The import of `Data.List' is redundant
49-- except perhaps to import instances from `Data.List'
50-- To import instances alone, use: import Data.List()
51 | "The import of " `T.isInfixOf` _message
52 || "The qualified import of " `T.isInfixOf` _message
53 , " is redundant" `T.isInfixOf` _message
54 = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])]
56-- File.hs:52:41: error:
57-- * Variable not in scope:
58-- suggestAcion :: Maybe T.Text -> Range -> Range
59-- * Perhaps you meant ‘suggestAction’ (line 83)
60-- File.hs:94:37: error:
61-- Not in scope: ‘T.isPrfixOf’
62-- Perhaps you meant one of these:
63-- ‘T.isPrefixOf’ (imported from Data.Text),
64-- ‘T.isInfixOf’ (imported from Data.Text),
65-- ‘T.isSuffixOf’ (imported from Data.Text)
66-- Module ‘Data.Text’ does not export ‘isPrfixOf’.
67 | renameSuggestions@(_:_) <- extractRenamableTerms _message
68 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]
70-- Foo.hs:3:8: error:
71-- * Found type wildcard `_' standing for `p -> p1 -> p'
73 | "Found type wildcard" `T.isInfixOf` _message
74 , " standing for " `T.isInfixOf` _message
75 , typeSignature <- extractWildCardTypeSignature _message
76 = [("Use type signature: ‘" <> typeSignature <> "’", [TextEdit _range typeSignature])]
78-- File.hs:22:8: error:
79-- Illegal lambda-case (use -XLambdaCase)
80-- File.hs:22:6: error:
81-- Illegal view pattern: x -> foo
82-- Use ViewPatterns to enable view patterns
83-- File.hs:26:8: error:
84-- Illegal `..' in record pattern
85-- Use RecordWildCards to permit this
86-- File.hs:53:28: error:
87-- Illegal tuple section: use TupleSections
88-- File.hs:238:29: error:
89-- * Can't make a derived instance of `Data FSATrace':
90-- You need DeriveDataTypeable to derive an instance for this class
91-- * In the data declaration for `FSATrace'
92-- C:\Neil\shake\src\Development\Shake\Command.hs:515:31: error:
93-- * Illegal equational constraint a ~ ()
94-- (Use GADTs or TypeFamilies to permit this)
95-- * In the context: a ~ ()
96-- While checking an instance declaration
97-- In the instance declaration for `Unit (m a)'
98 | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message
99 = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]
101-- src/Development/IDE/Core/Compile.hs:58:1: error:
102-- Could not find module ‘Data.Cha’
103-- Perhaps you meant Data.Char (from base-4.12.0.0)
104 | "Could not find module" `T.isInfixOf` _message
105 , "Perhaps you meant" `T.isInfixOf` _message
106 = map proposeModule $ nubOrd $ findSuggestedModules _message where
107 findSuggestedModules = map (head . T.words) . drop 2 . T.lines
108 proposeModule mod = ("replace with " <> mod, [TextEdit _range mod])
110suggestAction _ _ = []
112mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit
113mkRenameEdit contents range name =
114 if fromMaybe False maybeIsInfixFunction
115 then TextEdit range ("`" <> name <> "`")
116 else TextEdit range name
117 where
118 maybeIsInfixFunction = do
119 curr <- textInRange range <$> contents
120 pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr
122extractWildCardTypeSignature :: T.Text -> T.Text
123extractWildCardTypeSignature =
124 -- inferring when parens are actually needed around the type signature would
125 -- require understanding both the precedence of the context of the _ and of
126 -- the signature itself. Inserting them unconditionally is ugly but safe.
127 ("(" `T.append`) . (`T.append` ")") .
128 T.takeWhile (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') .
129 snd . T.breakOnEnd "standing for "
131extractRenamableTerms :: T.Text -> [T.Text]
132extractRenamableTerms msg
133 -- Account for both "Variable not in scope" and "Not in scope"
134 | "ot in scope:" `T.isInfixOf` msg = extractSuggestions msg
135 | otherwise = []
136 where
137 extractSuggestions = map getEnclosed
138 . concatMap singleSuggestions
139 . filter isKnownSymbol
140 . T.lines
141 singleSuggestions = T.splitOn "), " -- Each suggestion is comma delimited
142 isKnownSymbol t = " (imported from" `T.isInfixOf` t || " (line " `T.isInfixOf` t
143 getEnclosed = T.dropWhile (== '‘')
144 . T.dropWhileEnd (== '’')
145 . T.dropAround (\c -> c /= '‘' && c /= '’')
147-- | If a range takes up a whole line (it begins at the start of the line and there's only whitespace
148-- between the end of the range and the next newline), extend the range to take up the whole line.
149extendToWholeLineIfPossible :: Maybe T.Text -> Range -> Range
150extendToWholeLineIfPossible contents range@Range{..} =
151 let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . splitTextAtPosition _end) contents
152 extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line
153 in if extend then Range _start (Position (_line _end + 1) 0) else range
155-- | All the GHC extensions
156ghcExtensions :: Set.HashSet T.Text
157ghcExtensions = Set.fromList $ map (T.pack . show) ghcEnumerateExtensions
159splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text)
160splitTextAtPosition (Position row col) x
161 | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x
162 , (preCol, postCol) <- T.splitAt col mid
163 = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)
164 | otherwise = (x, T.empty)
166textInRange :: Range -> T.Text -> T.Text
167textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =
168 case compare startRow endRow of
169 LT ->
170 let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine
171 (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of
172 [] -> ("", [])
173 firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween)
174 maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines
175 in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine)
176 EQ ->
177 let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine)
178 in T.take (endCol - startCol) (T.drop startCol line)
179 GT -> ""
180 where
181 linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text)
183setHandlersCodeAction :: PartialHandlers
184setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
185 LSP.codeActionHandler = withResponse RspCodeAction codeAction
186 }