diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 3c9437719d..937f95147a 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -839,8 +839,13 @@ suggestAddTypeAnnotationToSatisfyContraints sourceOpt Diagnostic{_range=_range,. in [( title, edits )] -suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] -suggestReplaceIdentifier contents Diagnostic{_range=_range,..} +-- | GHC strips out backticks in case of infix functions as well as single quote +-- in case of quoted name when using TemplateHaskellQuotes. Which is not desired. +-- +-- For example: +-- 1. +-- +-- @ -- File.hs:52:41: error: -- * Variable not in scope: -- suggestAcion :: Maybe T.Text -> Range -> Range @@ -852,6 +857,27 @@ suggestReplaceIdentifier contents Diagnostic{_range=_range,..} -- ‘T.isInfixOf’ (imported from Data.Text), -- ‘T.isSuffixOf’ (imported from Data.Text) -- Module ‘Data.Text’ does not export ‘isPrfixOf’. +-- @ +-- +-- * action: \`suggestAcion\` will be renamed to \`suggestAction\` keeping back ticks around the function +-- +-- 2. +-- +-- @ +-- import Language.Haskell.TH (Name) +-- foo :: Name +-- foo = 'bread +-- +-- File.hs:8:7: error: +-- Not in scope: ‘bread’ +-- * Perhaps you meant one of these: +-- ‘break’ (imported from Prelude), ‘read’ (imported from Prelude) +-- * In the Template Haskell quotation 'bread +-- @ +-- +-- * action: 'bread will be renamed to 'break keeping single quote on beginning of name +suggestReplaceIdentifier :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] +suggestReplaceIdentifier contents Diagnostic{_range=_range,..} | renameSuggestions@(_:_) <- extractRenamableTerms _message = [ ("Replace with ‘" <> name <> "’", [mkRenameEdit contents _range name]) | name <- renameSuggestions ] | otherwise = [] @@ -1771,15 +1797,17 @@ extractDoesNotExportModuleName x mkRenameEdit :: Maybe T.Text -> Range -> T.Text -> TextEdit -mkRenameEdit contents range name = - if maybeIsInfixFunction == Just True - then TextEdit range ("`" <> name <> "`") - else TextEdit range name +mkRenameEdit contents range name + | maybeIsInfixFunction == Just True = TextEdit range ("`" <> name <> "`") + | maybeIsTemplateFunction == Just True = TextEdit range ("'" <> name) + | otherwise = TextEdit range name where maybeIsInfixFunction = do curr <- textInRange range <$> contents pure $ "`" `T.isPrefixOf` curr && "`" `T.isSuffixOf` curr - + maybeIsTemplateFunction = do + curr <- textInRange range <$> contents + pure $ "'" `T.isPrefixOf` curr -- | Extract the type and surround it in parentheses except in obviously safe cases. -- diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 2a81b9085e..599d4bde29 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -609,6 +609,28 @@ renameActionTests = testGroup "rename actions" , "foo x y = x `monus` y" ] liftIO $ expectedContentAfterAction @=? contentAfterAction + , testSession "change template function" $ do + let content = T.unlines + [ "{-# LANGUAGE TemplateHaskellQuotes #-}" + , "module Testing where" + , "import Language.Haskell.TH (Name)" + , "foo :: Name" + , "foo = 'bread" + ] + doc <- createDoc "Testing.hs" "haskell" content + diags <- waitForDiagnostics + actionsOrCommands <- getCodeActions doc (Range (Position 4 6) (Position 4 12)) + [fixTypo] <- pure [action | InR action@CodeAction{ _title = actionTitle } <- actionsOrCommands, "break" `T.isInfixOf` actionTitle ] + executeCodeAction fixTypo + contentAfterAction <- documentContents doc + let expectedContentAfterAction = T.unlines + [ "{-# LANGUAGE TemplateHaskellQuotes #-}" + , "module Testing where" + , "import Language.Haskell.TH (Name)" + , "foo :: Name" + , "foo = 'break" + ] + liftIO $ expectedContentAfterAction @=? contentAfterAction ] typeWildCardActionTests :: TestTree