{-# LANGUAGE DuplicateRecordFields #-}
module Development.IDE.LSP.CodeAction
( setHandlersCodeAction
) where
import Language.Haskell.LSP.Types
import Development.IDE.GHC.Compat
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 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
codeAction
:: LSP.LspFuncs ()
-> IdeState
-> CodeActionParams
-> IO (List CAResult)
codeAction lsp _ CodeActionParams{_textDocument=TextDocumentIdentifier uri,_context=CodeActionContext{_diagnostics=List xs}} = do
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, tedit) <- suggestAction text x
, let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
]
suggestAction :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
suggestAction contents Diagnostic{_range=_range@Range{..},..}
| "The import of " `T.isInfixOf` _message
, " is redundant" `T.isInfixOf` _message
, let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . textAtPosition _end) contents
, let extend = newlineAfter && _character _start == 0
= [("Remove import", [TextEdit (if extend then Range _start (Position (_line _end + 1) 0) else _range) ""])]
| 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 _ _ = []
ghcExtensions :: Set.HashSet T.Text
ghcExtensions = Set.fromList $ map (T.pack . show) ghcEnumerateExtensions
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
}