git.iko.soy/ghcide
on master help sign in
More code actions for hie-core (#1948)
42221e6Neil Mitchell
src/Development/IDE/LSP/CodeAction.hs+57−9
compare with master
unifiedsplit
@@ -10,40 +10,88 @@ module Development.IDE.LSP.CodeAction
10 ) where
10 ) where
11
11
12import Language.Haskell.LSP.Types
12import Language.Haskell.LSP.Types
13−
13+import GHC.LanguageExtensions.Type
14import Development.IDE.Core.Rules
14import Development.IDE.Core.Rules
15import Development.IDE.LSP.Server
15import Development.IDE.LSP.Server
16import qualified Data.HashMap.Strict as Map
16import qualified Data.HashMap.Strict as Map
17+import qualified Data.HashSet as Set
17import qualified Language.Haskell.LSP.Core as LSP
18import qualified Language.Haskell.LSP.Core as LSP
18−import qualified Language.Haskell.LSP.Types as LSP
19+import Language.Haskell.LSP.VFS
19import Language.Haskell.LSP.Messages
20import Language.Haskell.LSP.Messages
20−
21+import qualified Data.Rope.UTF16 as Rope
22+import Data.Char
21import qualified Data.Text as T
23import qualified Data.Text as T
22
24
23-- | Generate code actions.
25-- | Generate code actions.
24codeAction
26codeAction
27+ :: LSP.LspFuncs ()
25− :: IdeState
28+ -> IdeState
26 -> CodeActionParams
29 -> CodeActionParams
27 -> IO (List CAResult)
30 -> 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
29 -- disable logging as its quite verbose
32 -- disable logging as its quite verbose
30 -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg
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
31 pure $ List
36 pure $ List
32 [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
37 [ 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+
34
42
43+suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
44+suggestAction contents Diagnostic{_range=_range@Range{..},..}
35
45
36−suggestAction :: Uri -> Diagnostic -> [(T.Text, LSP.WorkspaceEdit)]
37−suggestAction uri Diagnostic{..}
38-- File.hs:16:1: warning:
46-- File.hs:16:1: warning:
39-- The import of `Data.List' is redundant
47-- The import of `Data.List' is redundant
40-- except perhaps to import instances from `Data.List'
48-- except perhaps to import instances from `Data.List'
41-- To import instances alone, use: import Data.List()
49-- To import instances alone, use: import Data.List()
42 | "The import of " `T.isInfixOf` _message
50 | "The import of " `T.isInfixOf` _message
43 , " is redundant" `T.isInfixOf` _message
51 , " 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+
45suggestAction _ _ = []
79suggestAction _ _ = []
46
80
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+
47setHandlersCodeAction :: PartialHandlers
95setHandlersCodeAction :: PartialHandlers
48setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
96setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
49 LSP.codeActionHandler = withResponse RspCodeAction codeAction
97 LSP.codeActionHandler = withResponse RspCodeAction codeAction
src/Development/IDE/LSP/Definition.hs+1−1
@@ -40,5 +40,5 @@ gotoDefinition ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos)
40
40
41setHandlersDefinition :: PartialHandlers
41setHandlersDefinition :: PartialHandlers
42setHandlersDefinition = PartialHandlers $ \WithMessage{..} x -> return x{
42setHandlersDefinition = PartialHandlers $ \WithMessage{..} x -> return x{
43− LSP.definitionHandler = withResponse RspDefinition gotoDefinition
43+ LSP.definitionHandler = withResponse RspDefinition $ const gotoDefinition
44 }
44 }
src/Development/IDE/LSP/Hover.hs+1−1
@@ -44,5 +44,5 @@ onHover ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = do
44
44
45setHandlersHover :: PartialHandlers
45setHandlersHover :: PartialHandlers
46setHandlersHover = PartialHandlers $ \WithMessage{..} x -> return x{
46setHandlersHover = PartialHandlers $ \WithMessage{..} x -> return x{
47− LSP.hoverHandler = withResponse RspHover onHover
47+ LSP.hoverHandler = withResponse RspHover $ const onHover
48 }
48 }
src/Development/IDE/LSP/LanguageServer.hs+5−5
@@ -66,7 +66,7 @@ runLanguageServer options userHandlers getIdeState = do
66 clientMsgBarrier <- newBarrier
66 clientMsgBarrier <- newBarrier
67
67
68 let withResponse wrap f = Just $ \r -> writeChan clientMsgChan $ Response r wrap f
68 let withResponse wrap f = Just $ \r -> writeChan clientMsgChan $ Response r wrap f
69− let withNotification old f = Just $ \r -> writeChan clientMsgChan $ Notification r (\ide x -> f ide x >> whenJust old ($ r))
69+ let withNotification old f = Just $ \r -> writeChan clientMsgChan $ Notification r (\lsp ide x -> f lsp ide x >> whenJust old ($ r))
70 let PartialHandlers parts =
70 let PartialHandlers parts =
71 setHandlersIgnore <> -- least important
71 setHandlersIgnore <> -- least important
72 setHandlersDefinition <> setHandlersHover <> setHandlersCodeAction <> -- useful features someone may override
72 setHandlersDefinition <> setHandlersHover <> setHandlersCodeAction <> -- useful features someone may override
@@ -94,14 +94,14 @@ runLanguageServer options userHandlers getIdeState = do
94 msg <- readChan clientMsgChan
94 msg <- readChan clientMsgChan
95 case msg of
95 case msg of
96 Notification x@NotificationMessage{_params} act -> do
96 Notification x@NotificationMessage{_params} act -> do
97− catch (act ide _params) $ \(e :: SomeException) ->
97+ catch (act lspFuncs ide _params) $ \(e :: SomeException) ->
98 logError (ideLogger ide) $ T.pack $
98 logError (ideLogger ide) $ T.pack $
99 "Unexpected exception on notification, please report!\n" ++
99 "Unexpected exception on notification, please report!\n" ++
100 "Message: " ++ show x ++ "\n" ++
100 "Message: " ++ show x ++ "\n" ++
101 "Exception: " ++ show e
101 "Exception: " ++ show e
102 Response x@RequestMessage{_id, _params} wrap act ->
102 Response x@RequestMessage{_id, _params} wrap act ->
103 catch (do
103 catch (do
104− res <- act ide _params
104+ res <- act lspFuncs ide _params
105 sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Just res) Nothing
105 sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Just res) Nothing
106 ) $ \(e :: SomeException) -> do
106 ) $ \(e :: SomeException) -> do
107 logError (ideLogger ide) $ T.pack $
107 logError (ideLogger ide) $ T.pack $
@@ -126,8 +126,8 @@ setHandlersIgnore = PartialHandlers $ \_ x -> return x
126-- | A message that we need to deal with - the pieces are split up with existentials to gain additional type safety
126-- | A message that we need to deal with - the pieces are split up with existentials to gain additional type safety
127-- and defer precise processing until later (allows us to keep at a higher level of abstraction slightly longer)
127-- and defer precise processing until later (allows us to keep at a higher level of abstraction slightly longer)
128data Message
128data Message
129− = forall m req resp . (Show m, Show req) => Response (RequestMessage m req resp) (ResponseMessage resp -> FromServerMessage) (IdeState -> req -> IO resp)
129+ = forall m req resp . (Show m, Show req) => Response (RequestMessage m req resp) (ResponseMessage resp -> FromServerMessage) (LSP.LspFuncs () -> IdeState -> req -> IO resp)
130− | forall m req . (Show m, Show req) => Notification (NotificationMessage m req) (IdeState -> req -> IO ())
130+ | forall m req . (Show m, Show req) => Notification (NotificationMessage m req) (LSP.LspFuncs () -> IdeState -> req -> IO ())
131
131
132
132
133modifyOptions :: LSP.Options -> LSP.Options
133modifyOptions :: LSP.Options -> LSP.Options
src/Development/IDE/LSP/Notifications.hs+4−4
@@ -32,24 +32,24 @@ whenUriFile ide uri act = case LSP.uriToFilePath uri of
32setHandlersNotifications :: PartialHandlers
32setHandlersNotifications :: PartialHandlers
33setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
33setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
34 {LSP.didOpenTextDocumentNotificationHandler = withNotification (LSP.didOpenTextDocumentNotificationHandler x) $
34 {LSP.didOpenTextDocumentNotificationHandler = withNotification (LSP.didOpenTextDocumentNotificationHandler x) $
35− \ide (DidOpenTextDocumentParams TextDocumentItem{_uri}) -> do
35+ \_ ide (DidOpenTextDocumentParams TextDocumentItem{_uri}) -> do
36 setSomethingModified ide
36 setSomethingModified ide
37 whenUriFile ide _uri $ \file ->
37 whenUriFile ide _uri $ \file ->
38 modifyFilesOfInterest ide (S.insert file)
38 modifyFilesOfInterest ide (S.insert file)
39 logInfo (ideLogger ide) $ "Opened text document: " <> getUri _uri
39 logInfo (ideLogger ide) $ "Opened text document: " <> getUri _uri
40
40
41 ,LSP.didChangeTextDocumentNotificationHandler = withNotification (LSP.didChangeTextDocumentNotificationHandler x) $
41 ,LSP.didChangeTextDocumentNotificationHandler = withNotification (LSP.didChangeTextDocumentNotificationHandler x) $
42− \ide (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> do
42+ \_ ide (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> do
43 setSomethingModified ide
43 setSomethingModified ide
44 logInfo (ideLogger ide) $ "Modified text document: " <> getUri _uri
44 logInfo (ideLogger ide) $ "Modified text document: " <> getUri _uri
45
45
46 ,LSP.didSaveTextDocumentNotificationHandler = withNotification (LSP.didSaveTextDocumentNotificationHandler x) $
46 ,LSP.didSaveTextDocumentNotificationHandler = withNotification (LSP.didSaveTextDocumentNotificationHandler x) $
47− \ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri}) -> do
47+ \_ ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri}) -> do
48 setSomethingModified ide
48 setSomethingModified ide
49 logInfo (ideLogger ide) $ "Saved text document: " <> getUri _uri
49 logInfo (ideLogger ide) $ "Saved text document: " <> getUri _uri
50
50
51 ,LSP.didCloseTextDocumentNotificationHandler = withNotification (LSP.didCloseTextDocumentNotificationHandler x) $
51 ,LSP.didCloseTextDocumentNotificationHandler = withNotification (LSP.didCloseTextDocumentNotificationHandler x) $
52− \ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> do
52+ \_ ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> do
53 setSomethingModified ide
53 setSomethingModified ide
54 whenUriFile ide _uri $ \file ->
54 whenUriFile ide _uri $ \file ->
55 modifyFilesOfInterest ide (S.delete file)
55 modifyFilesOfInterest ide (S.delete file)
src/Development/IDE/LSP/Server.hs+2−2
@@ -20,11 +20,11 @@ import Development.IDE.Core.Service
20data WithMessage = WithMessage
20data WithMessage = WithMessage
21 {withResponse :: forall m req resp . (Show m, Show req) =>
21 {withResponse :: forall m req resp . (Show m, Show req) =>
22 (ResponseMessage resp -> LSP.FromServerMessage) -> -- how to wrap a response
22 (ResponseMessage resp -> LSP.FromServerMessage) -> -- how to wrap a response
23− (IdeState -> req -> IO resp) -> -- actual work
23+ (LSP.LspFuncs () -> IdeState -> req -> IO resp) -> -- actual work
24 Maybe (LSP.Handler (RequestMessage m req resp))
24 Maybe (LSP.Handler (RequestMessage m req resp))
25 ,withNotification :: forall m req . (Show m, Show req) =>
25 ,withNotification :: forall m req . (Show m, Show req) =>
26 Maybe (LSP.Handler (NotificationMessage m req)) -> -- old notification handler
26 Maybe (LSP.Handler (NotificationMessage m req)) -> -- old notification handler
27− (IdeState -> req -> IO ()) -> -- actual work
27+ (LSP.LspFuncs () -> IdeState -> req -> IO ()) -> -- actual work
28 Maybe (LSP.Handler (NotificationMessage m req))
28 Maybe (LSP.Handler (NotificationMessage m req))
29 }
29 }
30
30