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