git.iko.soy/ghcide
on cc4865f help sign in
ghcide/src/Development/IDE/LSP/CodeAction.hs
176 lines 8.0 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 || "The qualified import of " `T.isInfixOf` _message
52 , " is redundant" `T.isInfixOf` _message
53 = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])]
55-- File.hs:52:41: error:
56-- * Variable not in scope:
57-- suggestAcion :: Maybe T.Text -> Range -> Range
58-- * Perhaps you meant ‘suggestAction’ (line 83)
59-- File.hs:94:37: error:
60-- Not in scope: ‘T.isPrfixOf’
61-- Perhaps you meant one of these:
62-- ‘T.isPrefixOf’ (imported from Data.Text),
63-- ‘T.isInfixOf’ (imported from Data.Text),
64-- ‘T.isSuffixOf’ (imported from Data.Text)
65-- Module ‘Data.Text’ does not export ‘isPrfixOf’.
66 | renameSuggestions@(_:_) <- extractRenamableTerms _message
67 = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ]
69-- Foo.hs:3:8: error:
70-- * Found type wildcard `_' standing for `p -> p1 -> p'
72 | "Found type wildcard" `T.isInfixOf` _message
73 , " standing for " `T.isInfixOf` _message
74 , typeSignature <- extractWildCardTypeSignature _message
75 = [("Use type signature: ‘" <> typeSignature <> "’", [TextEdit _range typeSignature])]
77-- File.hs:22:8: error:
78-- Illegal lambda-case (use -XLambdaCase)
79-- File.hs:22:6: error:
80-- Illegal view pattern: x -> foo
81-- Use ViewPatterns to enable view patterns
82-- File.hs:26:8: error:
83-- Illegal `..' in record pattern
84-- Use RecordWildCards to permit this
85-- File.hs:53:28: error:
86-- Illegal tuple section: use TupleSections
87-- File.hs:238:29: error:
88-- * Can't make a derived instance of `Data FSATrace':
89-- You need DeriveDataTypeable to derive an instance for this class
90-- * In the data declaration for `FSATrace'
91-- C:\Neil\shake\src\Development\Shake\Command.hs:515:31: error:
92-- * Illegal equational constraint a ~ ()
93-- (Use GADTs or TypeFamilies to permit this)
94-- * In the context: a ~ ()
95-- While checking an instance declaration
96-- In the instance declaration for `Unit (m a)'
97 | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message
98 = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]
100suggestAction _ _ = []
102mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit
103mkRenameEdit contents range name =
104 if fromMaybe False maybeIsInfixFunction
105 then TextEdit range ("`" <> name <> "`")
106 else TextEdit range name
107 where
108 maybeIsInfixFunction = do
109 curr <- textInRange range <$> contents
110 pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr
112extractWildCardTypeSignature :: T.Text -> T.Text
113extractWildCardTypeSignature =
114 -- inferring when parens are actually needed around the type signature would
115 -- require understanding both the precedence of the context of the _ and of
116 -- the signature itself. Inserting them unconditionally is ugly but safe.
117 ("(" `T.append`) . (`T.append` ")") .
118 T.takeWhile (/='’') . T.dropWhile (=='‘') . T.dropWhile (/='‘') .
119 snd . T.breakOnEnd "standing for "
121extractRenamableTerms :: T.Text -> [T.Text]
122extractRenamableTerms msg
123 -- Account for both "Variable not in scope" and "Not in scope"
124 | "ot in scope:" `T.isInfixOf` msg = extractSuggestions msg
125 | otherwise = []
126 where
127 extractSuggestions = map getEnclosed
128 . concatMap singleSuggestions
129 . filter isKnownSymbol
130 . T.lines
131 singleSuggestions = T.splitOn "), " -- Each suggestion is comma delimited
132 isKnownSymbol t = " (imported from" `T.isInfixOf` t || " (line " `T.isInfixOf` t
133 getEnclosed = T.dropWhile (== '‘')
134 . T.dropWhileEnd (== '’')
135 . T.dropAround (\c -> c /= '‘' && c /= '’')
137-- | If a range takes up a whole line (it begins at the start of the line and there's only whitespace
138-- between the end of the range and the next newline), extend the range to take up the whole line.
139extendToWholeLineIfPossible :: Maybe T.Text -> Range -> Range
140extendToWholeLineIfPossible contents range@Range{..} =
141 let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . splitTextAtPosition _end) contents
142 extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line
143 in if extend then Range _start (Position (_line _end + 1) 0) else range
145-- | All the GHC extensions
146ghcExtensions :: Set.HashSet T.Text
147ghcExtensions = Set.fromList $ map (T.pack . show) ghcEnumerateExtensions
149splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text)
150splitTextAtPosition (Position row col) x
151 | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x
152 , (preCol, postCol) <- T.splitAt col mid
153 = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)
154 | otherwise = (x, T.empty)
156textInRange :: Range -> T.Text -> T.Text
157textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =
158 case compare startRow endRow of
159 LT ->
160 let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine
161 (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of
162 [] -> ("", [])
163 firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween)
164 maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines
165 in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine)
166 EQ ->
167 let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine)
168 in T.take (endCol - startCol) (T.drop startCol line)
169 GT -> ""
170 where
171 linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text)
173setHandlersCodeAction :: PartialHandlers
174setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
175 LSP.codeActionHandler = withResponse RspCodeAction codeAction
176 }