@@ -10,40 +10,88 @@ module Development.IDE.LSP.CodeAction
1010 ) where
1111
1212import Language.Haskell.LSP.Types
13−
13+import GHC.LanguageExtensions.Type
1414import Development.IDE.Core.Rules
1515import Development.IDE.LSP.Server
1616import qualified Data.HashMap.Strict as Map
17+import qualified Data.HashSet as Set
1718import qualified Language.Haskell.LSP.Core as LSP
18−import qualified Language.Haskell.LSP.Types as LSP
19+import Language.Haskell.LSP.VFS
1920import Language.Haskell.LSP.Messages
20−
21+import qualified Data.Rope.UTF16 as Rope
22+import Data.Char
2123import qualified Data.Text as T
2224
2325-- | Generate code actions.
2426codeAction
25− :: IdeState
27+ :: LSP.LspFuncs ()
28+ -> IdeState
2629 -> CodeActionParams
2730 -> IO (List CAResult)
28−codeAction _ CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
31+codeAction lsp _ CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
2932 -- disable logging as its quite verbose
3033 -- 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
3136 pure $ List
3237 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
33− | x <- xs, (title, edit) <- suggestAction uri x]
38+ | x <- xs, (title, tedit) <- suggestAction text x
39+ , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
40+ ]
41+
3442
43+suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
44+suggestAction contents Diagnostic{_range=_range@Range{..},..}
3545
36−suggestAction :: Uri -> Diagnostic -> [(T.Text, LSP.WorkspaceEdit)]
37−suggestAction uri Diagnostic{..}
3846-- File.hs:16:1: warning:
3947-- The import of `Data.List' is redundant
4048-- except perhaps to import instances from `Data.List'
4149-- To import instances alone, use: import Data.List()
4250 | "The import of " `T.isInfixOf` _message
4351 , " is redundant" `T.isInfixOf` _message
44− = [("Remove import", WorkspaceEdit (Just $ Map.singleton uri $ List [TextEdit _range ""]) Nothing)]
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) ""])]
55+
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]
78+
4579suggestAction _ _ = []
4680
81+
82+-- | All the GHC extensions
83+ghcExtensions :: Set.HashSet T.Text
84+ghcExtensions = Set.fromList $ map (T.pack . show) [Cpp .. StarIsType] -- use enumerate from GHC 8.8 and beyond
85+
86+
87+textAtPosition :: Position -> T.Text -> (T.Text, T.Text)
88+textAtPosition (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)
93+
94+
4795setHandlersCodeAction :: PartialHandlers
4896setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
4997 LSP.codeActionHandler = withResponse RspCodeAction codeAction