Add quick-fix support for "Variable not in scope"

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,10 +45,35 @@ 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
     old <- B.readFile file
     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

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

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(..))

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"
+        ]

test/assets/not-in-scope-perhaps-use-multiline/Foo.hs

@@ -0,0 +1,3 @@
+module Foo where
+import Data.List
+foo = fold

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)"]}

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)
+

test/assets/not-in-scope-perhaps-use-one-of-these/Foo.hs

@@ -0,0 +1,2 @@
+module Foo where
+foo = fold

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)"]}

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)
+

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)"]}

test/assets/variable-not-in-scope-perhaps-use/err.out → 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)
 

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":[]}

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
+