diff --git a/src/Development/IDE/GHC/Util.hs b/src/Development/IDE/GHC/Util.hs index a38ea1aa..295e8ec2 100644 --- a/src/Development/IDE/GHC/Util.hs +++ b/src/Development/IDE/GHC/Util.hs @@ -72,7 +72,7 @@ runGhcEnv :: HscEnv -> Ghc a -> IO a runGhcEnv env act = do filesToClean <- newIORef emptyFilesToClean dirsToClean <- newIORef mempty - let dflags = (hsc_dflags env){filesToClean=filesToClean, dirsToClean=dirsToClean} + let dflags = (hsc_dflags env){filesToClean=filesToClean, dirsToClean=dirsToClean, useUnicode=True} ref <- newIORef env{hsc_dflags=dflags} unGhc act (Session ref) `finally` do cleanTempFiles dflags diff --git a/src/Development/IDE/LSP/CodeAction.hs b/src/Development/IDE/LSP/CodeAction.hs index 0bdb0661..d7543f3e 100644 --- a/src/Development/IDE/LSP/CodeAction.hs +++ b/src/Development/IDE/LSP/CodeAction.hs @@ -19,6 +19,7 @@ import Language.Haskell.LSP.VFS import Language.Haskell.LSP.Messages import qualified Data.Rope.UTF16 as Rope import Data.Char +import Data.Maybe import qualified Data.Text as T -- | Generate code actions. @@ -48,9 +49,21 @@ suggestAction contents Diagnostic{_range=_range@Range{..},..} -- To import instances alone, use: import Data.List() | "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 -- 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) ""])] + = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])] + +-- File.hs:52:41: error: +-- * Variable not in scope: +-- suggestAcion :: Maybe T.Text -> Range -> Range +-- * Perhaps you meant ‘suggestAction’ (line 83) +-- File.hs:94:37: error: +-- Not in scope: ‘T.isPrfixOf’ +-- Perhaps you meant one of these: +-- ‘T.isPrefixOf’ (imported from Data.Text), +-- ‘T.isInfixOf’ (imported from Data.Text), +-- ‘T.isSuffixOf’ (imported from Data.Text) +-- Module ‘Data.Text’ does not export ‘isPrfixOf’. + | renameSuggestions@(_:_) <- extractRenamableTerms _message + = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ] -- File.hs:22:8: error: -- Illegal lambda-case (use -XLambdaCase) @@ -77,19 +90,68 @@ suggestAction contents Diagnostic{_range=_range@Range{..},..} suggestAction _ _ = [] +mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit +mkRenameEdit contents range name = + if fromMaybe False maybeIsInfixFunction + then TextEdit range ("`" <> name <> "`") + else TextEdit range name + where + maybeIsInfixFunction = do + curr <- textInRange range <$> contents + pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr + + +extractRenamableTerms :: T.Text -> [T.Text] +extractRenamableTerms msg + -- Account for both "Variable not in scope" and "Not in scope" + | "ot in scope:" `T.isInfixOf` msg = extractSuggestions msg + | otherwise = [] + where + extractSuggestions = map getEnclosed + . concatMap singleSuggestions + . filter isKnownSymbol + . T.lines + singleSuggestions = T.splitOn "), " -- Each suggestion is comma delimited + isKnownSymbol t = " (imported from" `T.isInfixOf` t || " (line " `T.isInfixOf` t + getEnclosed = T.dropWhile (== '‘') + . T.dropWhileEnd (== '’') + . T.dropAround (\c -> c /= '‘' && c /= '’') + +-- | If a range takes up a whole line (it begins at the start of the line and there's only whitespace +-- between the end of the range and the next newline), extend the range to take up the whole line. +extendToWholeLineIfPossible :: Maybe T.Text -> Range -> Range +extendToWholeLineIfPossible contents range@Range{..} = + let newlineAfter = maybe False (T.isPrefixOf "\n" . T.dropWhile (\x -> isSpace x && x /= '\n') . snd . splitTextAtPosition _end) contents + extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line + in if extend then Range _start (Position (_line _end + 1) 0) else range -- | All the GHC extensions 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 +splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text) +splitTextAtPosition (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) +textInRange :: Range -> T.Text -> T.Text +textInRange (Range (Position startRow startCol) (Position endRow endCol)) text = + case compare startRow endRow of + LT -> + let (linesInRangeBeforeEndLine, endLineAndFurtherLines) = splitAt (endRow - startRow) linesBeginningWithStartLine + (textInRangeInFirstLine, linesBetween) = case linesInRangeBeforeEndLine of + [] -> ("", []) + firstLine:linesInBetween -> (T.drop startCol firstLine, linesInBetween) + maybeTextInRangeInEndLine = T.take endCol <$> listToMaybe endLineAndFurtherLines + in T.intercalate "\n" (textInRangeInFirstLine : linesBetween ++ maybeToList maybeTextInRangeInEndLine) + EQ -> + let line = fromMaybe "" (listToMaybe linesBeginningWithStartLine) + in T.take (endCol - startCol) (T.drop startCol line) + GT -> "" + where + linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text) setHandlersCodeAction :: PartialHandlers setHandlersCodeAction = PartialHandlers $ \WithMessage{..} x -> return x{ diff --git a/test/exe/Main.hs b/test/exe/Main.hs index fd0edb39..28356fc4 100644 --- a/test/exe/Main.hs +++ b/test/exe/Main.hs @@ -6,6 +6,7 @@ module Main (main) where import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) import qualified Data.Text as T import Development.IDE.Test import Development.IDE.Test.Runfiles @@ -26,6 +27,7 @@ main = defaultMain $ testGroup "HIE" closeDoc doc void (message :: Session ProgressDoneNotification) , diagnosticTests + , codeActionTests ] @@ -182,6 +184,86 @@ diagnosticTests = testGroup "diagnostics" ] ] +codeActionTests :: TestTree +codeActionTests = testGroup "code actions" + [ renameActionTests + ] + +renameActionTests :: TestTree +renameActionTests = testGroup "rename actions" + [ testSession "change to local variable name" $ do + let content = T.unlines + [ "module Testing where" + , "foo :: Int -> Int" + , "foo argName = argNme" + ] + doc <- openDoc' "Testing.hs" "haskell" content + _ <- waitForDiagnostics + [CACodeAction action@CodeAction { _title = actionTitle }] + <- getCodeActions doc (Range (Position 2 14) (Position 2 20)) + liftIO $ "Replace with ‘argName’" @=? actionTitle + executeCodeAction action + contentAfterAction <- documentContents doc + let expectedContentAfterAction = T.unlines + [ "module Testing where" + , "foo :: Int -> Int" + , "foo argName = argName" + ] + liftIO $ expectedContentAfterAction @=? contentAfterAction + , testSession "change to name of imported function" $ do + let content = T.unlines + [ "module Testing where" + , "import Data.Maybe (maybeToList)" + , "foo :: Maybe a -> [a]" + , "foo = maybToList" + ] + doc <- openDoc' "Testing.hs" "haskell" content + _ <- waitForDiagnostics + [CACodeAction action@CodeAction { _title = actionTitle }] + <- getCodeActions doc (Range (Position 3 6) (Position 3 16)) + liftIO $ "Replace with ‘maybeToList’" @=? actionTitle + executeCodeAction action + contentAfterAction <- documentContents doc + let expectedContentAfterAction = T.unlines + [ "module Testing where" + , "import Data.Maybe (maybeToList)" + , "foo :: Maybe a -> [a]" + , "foo = maybeToList" + ] + liftIO $ expectedContentAfterAction @=? contentAfterAction + , testSession "suggest multiple local variable names" $ do + let content = T.unlines + [ "module Testing where" + , "foo :: Char -> Char -> Char -> Char" + , "foo argument1 argument2 argument3 = argumentX" + ] + doc <- openDoc' "Testing.hs" "haskell" content + _ <- waitForDiagnostics + actionsOrCommands <- getCodeActions doc (Range (Position 2 36) (Position 2 45)) + let actionTitles = [ actionTitle | CACodeAction CodeAction{ _title = actionTitle } <- actionsOrCommands ] + expectedActionTitles = ["Replace with ‘argument1’", "Replace with ‘argument2’", "Replace with ‘argument3’"] + liftIO $ expectedActionTitles @=? actionTitles + , testSession "change infix function" $ do + let content = T.unlines + [ "module Testing where" + , "monus :: Int -> Int" + , "monus x y = max 0 (x - y)" + , "foo x y = x `monnus` y" + ] + doc <- openDoc' "Testing.hs" "haskell" content + _ <- waitForDiagnostics + actionsOrCommands <- getCodeActions doc (Range (Position 3 12) (Position 3 20)) + [fixTypo] <- pure [action | CACodeAction action@CodeAction{ _title = actionTitle } <- actionsOrCommands, "monus" `T.isInfixOf` actionTitle ] + executeCodeAction fixTypo + contentAfterAction <- documentContents doc + let expectedContentAfterAction = T.unlines + [ "module Testing where" + , "monus :: Int -> Int" + , "monus x y = max 0 (x - y)" + , "foo x y = x `monus` y" + ] + liftIO $ expectedContentAfterAction @=? contentAfterAction + ] ---------------------------------------------------------------------- -- Utils