More code actions for hie-core (#1948)

* Push the suggestion work further up

* Make LspFuncs an argument to the handlers

* Actually pass around the contents of the buffer to suggestAction

* Make suggestAction do sensible figuring out if you remove the next line too

* Better indentation

* Code action to add GHC extensions as required

* Deal with extra arguments to LSP handler

src/Development/IDE/LSP/CodeAction.hs

@@ -10,40 +10,88 @@ module Development.IDE.LSP.CodeAction
     ) where
 
 import           Language.Haskell.LSP.Types
-
+import GHC.LanguageExtensions.Type
 import Development.IDE.Core.Rules
 import Development.IDE.LSP.Server
 import qualified Data.HashMap.Strict as Map
+import qualified Data.HashSet as Set
 import qualified Language.Haskell.LSP.Core as LSP
-import qualified Language.Haskell.LSP.Types as LSP
+import Language.Haskell.LSP.VFS
 import Language.Haskell.LSP.Messages
-
+import qualified Data.Rope.UTF16 as Rope
+import Data.Char
 import qualified Data.Text as T
 
 -- | Generate code actions.
 codeAction
-    :: IdeState
+    :: LSP.LspFuncs ()
+    -> IdeState
     -> CodeActionParams
     -> IO (List CAResult)
-codeAction _ CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
+codeAction lsp _ CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
     -- disable logging as its quite verbose
     -- logInfo (ideLogger ide) $ T.pack $ "Code action req: " ++ show arg
+    contents <- LSP.getVirtualFileFunc lsp $ toNormalizedUri uri
+    let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
     pure $ List
         [ CACodeAction $ CodeAction title (Just CodeActionQuickFix) (Just $ List [x]) (Just edit) Nothing
-        | x <- xs, (title, edit) <- suggestAction uri x]
+        | x <- xs, (title, tedit) <- suggestAction text x
+        , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
+        ]
 
 
-suggestAction :: Uri -> Diagnostic -> [(T.Text, LSP.WorkspaceEdit)]
-suggestAction uri Diagnostic{..}
+suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
+suggestAction contents Diagnostic{_range=_range@Range{..},..}
+
 -- File.hs:16:1: warning:
 --     The import of `Data.List' is redundant
 --       except perhaps to import instances from `Data.List'
 --     To import instances alone, use: import Data.List()
     | "The import of " `T.isInfixOf` _message
     , " is redundant" `T.isInfixOf` _message
-    = [("Remove import", WorkspaceEdit (Just $ Map.singleton uri $ List [TextEdit _range ""]) Nothing)]
+    , let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . textAtPosition _end) contents
+    , let extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line
+        = [("Remove import", [TextEdit (if extend then Range _start (Position (_line _end + 1) 0) else _range) ""])]
+
+-- File.hs:22:8: error:
+--     Illegal lambda-case (use -XLambdaCase)
+-- File.hs:22:6: error:
+--     Illegal view pattern:  x -> foo
+--     Use ViewPatterns to enable view patterns
+-- File.hs:26:8: error:
+--     Illegal `..' in record pattern
+--     Use RecordWildCards to permit this
+-- File.hs:53:28: error:
+--     Illegal tuple section: use TupleSections
+-- File.hs:238:29: error:
+--     * Can't make a derived instance of `Data FSATrace':
+--         You need DeriveDataTypeable to derive an instance for this class
+--     * In the data declaration for `FSATrace'
+-- C:\Neil\shake\src\Development\Shake\Command.hs:515:31: error:
+--     * Illegal equational constraint a ~ ()
+--       (Use GADTs or TypeFamilies to permit this)
+--     * In the context: a ~ ()
+--       While checking an instance declaration
+--       In the instance declaration for `Unit (m a)'
+    | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message
+        = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]
+
 suggestAction _ _ = []
 
+
+-- | All the GHC extensions
+ghcExtensions :: Set.HashSet T.Text
+ghcExtensions = Set.fromList $ map (T.pack . show) [Cpp .. StarIsType] -- use enumerate from GHC 8.8 and beyond
+
+
+textAtPosition :: Position -> T.Text -> (T.Text, T.Text)
+textAtPosition (Position row col) x
+    | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x
+    , (preCol, postCol) <- T.splitAt col mid
+        = (T.intercalate "\n" $ preRow ++ [preCol], T.intercalate "\n" $ postCol : postRow)
+    | otherwise = (x, T.empty)
+
+
 setHandlersCodeAction :: PartialHandlers
 setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{
     LSP.codeActionHandler = withResponse RspCodeAction codeAction

src/Development/IDE/LSP/Definition.hs

@@ -40,5 +40,5 @@ gotoDefinition ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos)
 
 setHandlersDefinition :: PartialHandlers
 setHandlersDefinition = PartialHandlers $ \WithMessage{..} x -> return x{
-    LSP.definitionHandler = withResponse RspDefinition gotoDefinition
+    LSP.definitionHandler = withResponse RspDefinition $ const gotoDefinition
     }

src/Development/IDE/LSP/Hover.hs

@@ -44,5 +44,5 @@ onHover ide (TextDocumentPositionParams (TextDocumentIdentifier uri) pos) = do
 
 setHandlersHover :: PartialHandlers
 setHandlersHover = PartialHandlers $ \WithMessage{..} x -> return x{
-    LSP.hoverHandler = withResponse RspHover onHover
+    LSP.hoverHandler = withResponse RspHover $ const onHover
     }

src/Development/IDE/LSP/LanguageServer.hs

@@ -66,7 +66,7 @@ runLanguageServer options userHandlers getIdeState = do
     clientMsgBarrier <- newBarrier
 
     let withResponse wrap f = Just $ \r -> writeChan clientMsgChan $ Response r wrap f
-    let withNotification old f = Just $ \r -> writeChan clientMsgChan $ Notification r (\ide x -> f ide x >> whenJust old ($ r))
+    let withNotification old f = Just $ \r -> writeChan clientMsgChan $ Notification r (\lsp ide x -> f lsp ide x >> whenJust old ($ r))
     let PartialHandlers parts =
             setHandlersIgnore <> -- least important
             setHandlersDefinition <> setHandlersHover <> setHandlersCodeAction <> -- useful features someone may override
@@ -94,14 +94,14 @@ runLanguageServer options userHandlers getIdeState = do
                 msg <- readChan clientMsgChan
                 case msg of
                     Notification x@NotificationMessage{_params} act -> do
-                        catch (act ide _params) $ \(e :: SomeException) ->
+                        catch (act lspFuncs ide _params) $ \(e :: SomeException) ->
                             logError (ideLogger ide) $ T.pack $
                                 "Unexpected exception on notification, please report!\n" ++
                                 "Message: " ++ show x ++ "\n" ++
                                 "Exception: " ++ show e
                     Response x@RequestMessage{_id, _params} wrap act ->
                         catch (do
-                            res <- act ide _params
+                            res <- act lspFuncs ide _params
                             sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Just res) Nothing
                         ) $ \(e :: SomeException) -> do
                             logError (ideLogger ide) $ T.pack $
@@ -126,8 +126,8 @@ setHandlersIgnore = PartialHandlers $ \_ x -> return x
 -- | A message that we need to deal with - the pieces are split up with existentials to gain additional type safety
 --   and defer precise processing until later (allows us to keep at a higher level of abstraction slightly longer)
 data Message
-    = forall m req resp . (Show m, Show req) => Response (RequestMessage m req resp) (ResponseMessage resp -> FromServerMessage) (IdeState -> req -> IO resp)
-    | forall m req . (Show m, Show req) => Notification (NotificationMessage m req) (IdeState -> req -> IO ())
+    = forall m req resp . (Show m, Show req) => Response (RequestMessage m req resp) (ResponseMessage resp -> FromServerMessage) (LSP.LspFuncs () -> IdeState -> req -> IO resp)
+    | forall m req . (Show m, Show req) => Notification (NotificationMessage m req) (LSP.LspFuncs () -> IdeState -> req -> IO ())
 
 
 modifyOptions :: LSP.Options -> LSP.Options

src/Development/IDE/LSP/Notifications.hs

@@ -32,24 +32,24 @@ whenUriFile ide uri act = case LSP.uriToFilePath uri of
 setHandlersNotifications :: PartialHandlers
 setHandlersNotifications = PartialHandlers $ \WithMessage{..} x -> return x
     {LSP.didOpenTextDocumentNotificationHandler = withNotification (LSP.didOpenTextDocumentNotificationHandler x) $
-        \ide (DidOpenTextDocumentParams TextDocumentItem{_uri}) -> do
+        \_ ide (DidOpenTextDocumentParams TextDocumentItem{_uri}) -> do
             setSomethingModified ide
             whenUriFile ide _uri $ \file ->
                 modifyFilesOfInterest ide (S.insert file)
             logInfo (ideLogger ide) $ "Opened text document: " <> getUri _uri
 
     ,LSP.didChangeTextDocumentNotificationHandler = withNotification (LSP.didChangeTextDocumentNotificationHandler x) $
-        \ide (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> do
+        \_ ide (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> do
             setSomethingModified ide
             logInfo (ideLogger ide) $ "Modified text document: " <> getUri _uri
 
     ,LSP.didSaveTextDocumentNotificationHandler = withNotification (LSP.didSaveTextDocumentNotificationHandler x) $
-        \ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri}) -> do
+        \_ ide (DidSaveTextDocumentParams TextDocumentIdentifier{_uri}) -> do
             setSomethingModified ide
             logInfo (ideLogger ide) $ "Saved text document: " <> getUri _uri
 
     ,LSP.didCloseTextDocumentNotificationHandler = withNotification (LSP.didCloseTextDocumentNotificationHandler x) $
-        \ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> do
+        \_ ide (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> do
             setSomethingModified ide
             whenUriFile ide _uri $ \file ->
                 modifyFilesOfInterest ide (S.delete file)

src/Development/IDE/LSP/Server.hs

@@ -20,11 +20,11 @@ import Development.IDE.Core.Service
 data WithMessage = WithMessage
     {withResponse :: forall m req resp . (Show m, Show req) =>
         (ResponseMessage resp -> LSP.FromServerMessage) -> -- how to wrap a response
-        (IdeState -> req -> IO resp) -> -- actual work
+        (LSP.LspFuncs () -> IdeState -> req -> IO resp) -> -- actual work
         Maybe (LSP.Handler (RequestMessage m req resp))
     ,withNotification :: forall m req . (Show m, Show req) =>
         Maybe (LSP.Handler (NotificationMessage m req)) -> -- old notification handler
-        (IdeState -> req -> IO ()) -> -- actual work
+        (LSP.LspFuncs () -> IdeState -> req -> IO ()) -> -- actual work
         Maybe (LSP.Handler (NotificationMessage m req))
     }