From f77d82ec1d968d3dca3af1a8a12a843d25a3adad Mon Sep 17 00:00:00 2001 From: Simon Hengel Date: Tue, 28 Jan 2025 03:28:43 +0700 Subject: [PATCH] Add quick-fix support for "Variable not in scope" --- src/GHC/Diagnostic.hs | 37 ++++++++++++++++- src/HTTP.hs | 2 +- src/Imports.hs | 2 +- test/GHC/DiagnosticSpec.hs | 41 +++++++++++++++---- .../not-in-scope-perhaps-use-multiline/Foo.hs | 3 ++ .../err.json | 1 + .../err.out | 7 ++++ .../Foo.hs | 2 + .../err.json | 1 + .../err.out | 6 +++ .../Foo.hs | 0 test/assets/not-in-scope-perhaps-use/err.json | 1 + .../err.out | 2 +- .../Foo.hs | 0 test/assets/not-in-scope/err.json | 1 + test/assets/not-in-scope/err.out | 3 ++ .../err.json | 1 - test/assets/variable-not-in-scope/err.json | 1 - test/assets/variable-not-in-scope/err.out | 3 -- 19 files changed, 96 insertions(+), 18 deletions(-) create mode 100644 test/assets/not-in-scope-perhaps-use-multiline/Foo.hs create mode 100644 test/assets/not-in-scope-perhaps-use-multiline/err.json create mode 100644 test/assets/not-in-scope-perhaps-use-multiline/err.out create mode 100644 test/assets/not-in-scope-perhaps-use-one-of-these/Foo.hs create mode 100644 test/assets/not-in-scope-perhaps-use-one-of-these/err.json create mode 100644 test/assets/not-in-scope-perhaps-use-one-of-these/err.out rename test/assets/{variable-not-in-scope-perhaps-use => not-in-scope-perhaps-use}/Foo.hs (100%) create mode 100644 test/assets/not-in-scope-perhaps-use/err.json rename test/assets/{variable-not-in-scope-perhaps-use => not-in-scope-perhaps-use}/err.out (56%) rename test/assets/{variable-not-in-scope => not-in-scope}/Foo.hs (100%) create mode 100644 test/assets/not-in-scope/err.json create mode 100644 test/assets/not-in-scope/err.out delete mode 100644 test/assets/variable-not-in-scope-perhaps-use/err.json delete mode 100644 test/assets/variable-not-in-scope/err.json delete mode 100644 test/assets/variable-not-in-scope/err.out diff --git a/src/GHC/Diagnostic.hs b/src/GHC/Diagnostic.hs index 3b4af968..54c43d7e 100644 --- a/src/GHC/Diagnostic.hs +++ b/src/GHC/Diagnostic.hs @@ -1,22 +1,28 @@ +{-# LANGUAGE CPP #-} module GHC.Diagnostic ( module Diagnostic , Action(..) , analyze , apply +#ifdef TEST +, applyReplace +#endif ) where +import Prelude hiding (span) + import Imports import System.IO import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T -import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B import Data.ByteString.Builder (hPutBuilder) import GHC.Diagnostic.Type as Diagnostic -data Action = AddExtension FilePath Text +data Action = AddExtension FilePath Text | Replace Span Text deriving (Eq, Show) analyze :: Diagnostic -> Maybe Action @@ -26,6 +32,8 @@ analyze diagnostic = listToMaybe $ mapMaybe analyzeHint diagnostic.hints analyzeHint (T.pack -> hint) = perhapsYouIntendedToUse <|> enableAnyOfTheFollowingExtensions + <|> perhapsUse + <|> perhapsUseOneOfThese where perhapsYouIntendedToUse :: Maybe Action perhapsYouIntendedToUse = do @@ -37,6 +45,18 @@ analyze diagnostic = listToMaybe $ mapMaybe analyzeHint diagnostic.hints T.stripPrefix "Enable any of the following extensions: " hint >>= listToMaybe . reverse . map (AddExtension file) . T.splitOn ", " + perhapsUse :: Maybe Action + perhapsUse = mkPerhapsUse "Perhaps use `" + + perhapsUseOneOfThese :: Maybe Action + perhapsUseOneOfThese = mkPerhapsUse "Perhaps use one of these:\n `" + + mkPerhapsUse :: Text -> Maybe Action + mkPerhapsUse prefix = Replace <$> diagnostic.span <*> (takeIdentifier <$> T.stripPrefix prefix hint) + where + takeIdentifier :: Text -> Text + takeIdentifier = T.takeWhile (/= '\'') + apply :: Action -> IO () apply = \ case AddExtension file name -> do @@ -44,3 +64,16 @@ apply = \ case withFile file WriteMode $ \ h -> do hPutBuilder h $ "{-# LANGUAGE " <> T.encodeUtf8Builder name <> " #-}\n" B.hPutStr h old + Replace span substitute -> do + input <- B.readFile span.file <&> B.lines + B.writeFile span.file . B.unlines $ + applyReplace span.start span.end substitute input + +applyReplace :: Location -> Location -> Text -> [ByteString] -> [ByteString] +applyReplace start end substitute input = case splitAt (start.line - 1) input of + (xs, y : ys) | start.line == end.line -> xs ++ replaceInLine y : ys + _ -> input + where + replaceInLine :: ByteString -> ByteString + replaceInLine = T.decodeUtf8Lenient >>> T.splitAt (start.column - 1) >>> \ case + (xs, ys) -> T.encodeUtf8 $ xs <> substitute <> T.drop (end.column - start.column) ys diff --git a/src/HTTP.hs b/src/HTTP.hs index 476121c8..8b83ecd9 100644 --- a/src/HTTP.hs +++ b/src/HTTP.hs @@ -76,7 +76,7 @@ app getLastResult request respond = case pathInfo request of getLastResult >>= \ case (_, _, (analyze -> Just action) : _) -> apply action _ -> pass - respond $ jsonResponse Status.ok200 "{}" + respond $ jsonResponse Status.noContent204 "" _ -> do respond $ genericStatus Status.notFound404 request diff --git a/src/Imports.hs b/src/Imports.hs index 2305da21..e277841d 100644 --- a/src/Imports.hs +++ b/src/Imports.hs @@ -16,7 +16,7 @@ import Data.Maybe as Imports import Data.String as Imports import Data.ByteString.Char8 as Imports (ByteString, pack, unpack) import Data.Tuple as Imports -import System.FilePath as Imports hiding (combine) +import System.FilePath as Imports hiding (addExtension, combine) import System.IO.Error as Imports (isDoesNotExistError) import Text.Read as Imports (readMaybe) import System.Exit as Imports (ExitCode(..)) diff --git a/test/GHC/DiagnosticSpec.hs b/test/GHC/DiagnosticSpec.hs index 03dcb482..ebcd2022 100644 --- a/test/GHC/DiagnosticSpec.hs +++ b/test/GHC/DiagnosticSpec.hs @@ -1,24 +1,26 @@ {-# LANGUAGE BlockArguments #-} module GHC.DiagnosticSpec (spec) where +import Prelude hiding (span) + import Helper hiding (diagnostic) import System.Process - import System.Environment -import Language.Haskell.GhciWrapper (lookupGhc) +import Data.Text (Text) +import Language.Haskell.GhciWrapper (lookupGhc) import GHC.Diagnostic test :: HasCallStack => FilePath -> Maybe Action -> Spec -test name edit = it name $ do +test name action = it name $ do err <- translate <$> ghc ["-fno-diagnostics-show-caret"] json <- encodeUtf8 <$> ghc ["-fdiagnostics-as-json", "--interactive", "-ignore-dot-ghci"] ensureFile (dir "err.out") (encodeUtf8 err) ensureFile (dir "err.json") json Just diagnostic <- return $ parse json decodeUtf8 (format diagnostic) `shouldBe` err - analyze diagnostic `shouldBe` edit + normalizeFileName <$> analyze diagnostic `shouldBe` action where dir :: FilePath dir = "test" "assets" name @@ -39,20 +41,43 @@ test name edit = it name $ do '’' -> '\'' c -> c +normalizeFileName :: Action -> Action +normalizeFileName = \ case + AddExtension _ name -> AddExtension "Foo.hs" name + Replace span substitute -> Replace span {file = "Foo.hs"} substitute + ftest :: HasCallStack => FilePath -> Maybe Action -> Spec ftest name = focus . test name _ignore :: HasCallStack => FilePath -> Maybe Action -> Spec _ignore = ftest +replace :: Location -> Location -> Text -> Maybe Action +replace start end = Just . Replace (Span "Foo.hs" start end) + +addExtension :: Text -> Maybe Action +addExtension = Just . AddExtension "Foo.hs" + spec :: Spec spec = do describe "format" $ do - test "variable-not-in-scope" Nothing - test "variable-not-in-scope-perhaps-use" Nothing - test "use-BlockArguments" (Just $ AddExtension "test/assets/use-BlockArguments/Foo.hs" "BlockArguments") - test "use-TemplateHaskellQuotes" (Just $ AddExtension "test/assets/use-TemplateHaskellQuotes/Foo.hs" "TemplateHaskellQuotes") + test "not-in-scope" Nothing + test "not-in-scope-perhaps-use" $ replace (Location 2 7) (Location 2 14) "filter" + test "not-in-scope-perhaps-use-one-of-these" $ replace (Location 2 7) (Location 2 11) "foldl" + test "not-in-scope-perhaps-use-multiline" $ replace (Location 3 7) (Location 3 11) "foldl" + test "use-BlockArguments" $ addExtension "BlockArguments" + test "use-TemplateHaskellQuotes" $ addExtension "TemplateHaskellQuotes" test "non-existing" Nothing test "parse-error" Nothing test "lex-error" Nothing test "multiple-error-messages" Nothing + + describe "applyReplace" $ do + it "replaces a given source span with a substitute" $ do + applyReplace (Location 2 7) (Location 2 14) "filter" [ + "module Foo where" + , "foo = filter_ p xs" + ] `shouldBe` [ + "module Foo where" + , "foo = filter p xs" + ] diff --git a/test/assets/not-in-scope-perhaps-use-multiline/Foo.hs b/test/assets/not-in-scope-perhaps-use-multiline/Foo.hs new file mode 100644 index 00000000..29041cbd --- /dev/null +++ b/test/assets/not-in-scope-perhaps-use-multiline/Foo.hs @@ -0,0 +1,3 @@ +module Foo where +import Data.List +foo = fold diff --git a/test/assets/not-in-scope-perhaps-use-multiline/err.json b/test/assets/not-in-scope-perhaps-use-multiline/err.json new file mode 100644 index 00000000..6faf404e --- /dev/null +++ b/test/assets/not-in-scope-perhaps-use-multiline/err.json @@ -0,0 +1 @@ +{"version":"1.0","ghcVersion":"ghc-9.10.1","span":{"file":"test/assets/not-in-scope-perhaps-use-multiline/Foo.hs","start":{"line":3,"column":7},"end":{"line":3,"column":11}},"severity":"Error","code":88464,"message":["Variable not in scope: fold"],"hints":["Perhaps use one of these:\n `foldl' (imported from Data.List),\n `foldr' (imported from Data.List)"]} diff --git a/test/assets/not-in-scope-perhaps-use-multiline/err.out b/test/assets/not-in-scope-perhaps-use-multiline/err.out new file mode 100644 index 00000000..23576bcf --- /dev/null +++ b/test/assets/not-in-scope-perhaps-use-multiline/err.out @@ -0,0 +1,7 @@ +test/assets/not-in-scope-perhaps-use-multiline/Foo.hs:3:7: error: [GHC-88464] + Variable not in scope: fold + Suggested fix: + Perhaps use one of these: + `foldl' (imported from Data.List), + `foldr' (imported from Data.List) + diff --git a/test/assets/not-in-scope-perhaps-use-one-of-these/Foo.hs b/test/assets/not-in-scope-perhaps-use-one-of-these/Foo.hs new file mode 100644 index 00000000..b2577107 --- /dev/null +++ b/test/assets/not-in-scope-perhaps-use-one-of-these/Foo.hs @@ -0,0 +1,2 @@ +module Foo where +foo = fold diff --git a/test/assets/not-in-scope-perhaps-use-one-of-these/err.json b/test/assets/not-in-scope-perhaps-use-one-of-these/err.json new file mode 100644 index 00000000..aa61cda5 --- /dev/null +++ b/test/assets/not-in-scope-perhaps-use-one-of-these/err.json @@ -0,0 +1 @@ +{"version":"1.0","ghcVersion":"ghc-9.10.1","span":{"file":"test/assets/not-in-scope-perhaps-use-one-of-these/Foo.hs","start":{"line":2,"column":7},"end":{"line":2,"column":11}},"severity":"Error","code":88464,"message":["Variable not in scope: fold"],"hints":["Perhaps use one of these:\n `foldl' (imported from Prelude), `foldr' (imported from Prelude)"]} diff --git a/test/assets/not-in-scope-perhaps-use-one-of-these/err.out b/test/assets/not-in-scope-perhaps-use-one-of-these/err.out new file mode 100644 index 00000000..16f9d966 --- /dev/null +++ b/test/assets/not-in-scope-perhaps-use-one-of-these/err.out @@ -0,0 +1,6 @@ +test/assets/not-in-scope-perhaps-use-one-of-these/Foo.hs:2:7: error: [GHC-88464] + Variable not in scope: fold + Suggested fix: + Perhaps use one of these: + `foldl' (imported from Prelude), `foldr' (imported from Prelude) + diff --git a/test/assets/variable-not-in-scope-perhaps-use/Foo.hs b/test/assets/not-in-scope-perhaps-use/Foo.hs similarity index 100% rename from test/assets/variable-not-in-scope-perhaps-use/Foo.hs rename to test/assets/not-in-scope-perhaps-use/Foo.hs diff --git a/test/assets/not-in-scope-perhaps-use/err.json b/test/assets/not-in-scope-perhaps-use/err.json new file mode 100644 index 00000000..bd06dc3c --- /dev/null +++ b/test/assets/not-in-scope-perhaps-use/err.json @@ -0,0 +1 @@ +{"version":"1.0","ghcVersion":"ghc-9.10.1","span":{"file":"test/assets/not-in-scope-perhaps-use/Foo.hs","start":{"line":2,"column":7},"end":{"line":2,"column":14}},"severity":"Error","code":88464,"message":["Variable not in scope: filter_"],"hints":["Perhaps use `filter' (imported from Prelude)"]} diff --git a/test/assets/variable-not-in-scope-perhaps-use/err.out b/test/assets/not-in-scope-perhaps-use/err.out similarity index 56% rename from test/assets/variable-not-in-scope-perhaps-use/err.out rename to test/assets/not-in-scope-perhaps-use/err.out index dba1a4f5..48714450 100644 --- a/test/assets/variable-not-in-scope-perhaps-use/err.out +++ b/test/assets/not-in-scope-perhaps-use/err.out @@ -1,4 +1,4 @@ -test/assets/variable-not-in-scope-perhaps-use/Foo.hs:2:7: error: [GHC-88464] +test/assets/not-in-scope-perhaps-use/Foo.hs:2:7: error: [GHC-88464] Variable not in scope: filter_ Suggested fix: Perhaps use `filter' (imported from Prelude) diff --git a/test/assets/variable-not-in-scope/Foo.hs b/test/assets/not-in-scope/Foo.hs similarity index 100% rename from test/assets/variable-not-in-scope/Foo.hs rename to test/assets/not-in-scope/Foo.hs diff --git a/test/assets/not-in-scope/err.json b/test/assets/not-in-scope/err.json new file mode 100644 index 00000000..e68eb5f4 --- /dev/null +++ b/test/assets/not-in-scope/err.json @@ -0,0 +1 @@ +{"version":"1.0","ghcVersion":"ghc-9.10.1","span":{"file":"test/assets/not-in-scope/Foo.hs","start":{"line":2,"column":7},"end":{"line":2,"column":10}},"severity":"Error","code":88464,"message":["Variable not in scope: bar"],"hints":[]} diff --git a/test/assets/not-in-scope/err.out b/test/assets/not-in-scope/err.out new file mode 100644 index 00000000..28cbfe22 --- /dev/null +++ b/test/assets/not-in-scope/err.out @@ -0,0 +1,3 @@ +test/assets/not-in-scope/Foo.hs:2:7: error: [GHC-88464] + Variable not in scope: bar + diff --git a/test/assets/variable-not-in-scope-perhaps-use/err.json b/test/assets/variable-not-in-scope-perhaps-use/err.json deleted file mode 100644 index e3c301fd..00000000 --- a/test/assets/variable-not-in-scope-perhaps-use/err.json +++ /dev/null @@ -1 +0,0 @@ -{"version":"1.0","ghcVersion":"ghc-9.10.1","span":{"file":"test/assets/variable-not-in-scope-perhaps-use/Foo.hs","start":{"line":2,"column":7},"end":{"line":2,"column":14}},"severity":"Error","code":88464,"message":["Variable not in scope: filter_"],"hints":["Perhaps use `filter' (imported from Prelude)"]} diff --git a/test/assets/variable-not-in-scope/err.json b/test/assets/variable-not-in-scope/err.json deleted file mode 100644 index 73776704..00000000 --- a/test/assets/variable-not-in-scope/err.json +++ /dev/null @@ -1 +0,0 @@ -{"version":"1.0","ghcVersion":"ghc-9.10.1","span":{"file":"test/assets/variable-not-in-scope/Foo.hs","start":{"line":2,"column":7},"end":{"line":2,"column":10}},"severity":"Error","code":88464,"message":["Variable not in scope: bar"],"hints":[]} diff --git a/test/assets/variable-not-in-scope/err.out b/test/assets/variable-not-in-scope/err.out deleted file mode 100644 index 1f30f365..00000000 --- a/test/assets/variable-not-in-scope/err.out +++ /dev/null @@ -1,3 +0,0 @@ -test/assets/variable-not-in-scope/Foo.hs:2:7: error: [GHC-88464] - Variable not in scope: bar -