Improve quick-fix support for "term-level use of type constructors"

Author: sol

src/GHC/Diagnostic.hs

@@ -18,6 +18,7 @@ module GHC.Diagnostic (
 , extractIdentifiers
 , qualifiedName
 , analyzeAnnotation
+, takeGhcSourceSpan
 , applyReplace
 #endif
 ) where
@@ -65,6 +66,7 @@ formatSolutions start = zipWith formatNumbered [start..] >>> reverse >>> \ case
       ImportName module_ qualification name -> importStatement module_ qualification [name] <> faint package
         where
           package = " (" <> Builder.fromText module_.package <> ")"
+      AddToImportList module_ text _span -> "Add " <> Builder.fromText text <> " to import list of " <> Builder.fromText module_
 
     faint :: Builder -> Builder
     faint = Builder.withSGR [SetConsoleIntensity FaintIntensity]
@@ -98,10 +100,10 @@ annotate getAvailableImports diagnostic = getAvailableImports >>= \ case
         ++ maybe [] (analyzeAnnotation availableImports) annotation
 
 analyzeHints :: [Text] -> [Solution]
-analyzeHints = concat . mapMaybe analyzeHint
+analyzeHints = concatMap analyzeHint
 
-analyzeHint :: Text -> Maybe [Solution]
-analyzeHint hint = asum [
+analyzeHint :: Text -> [Solution]
+analyzeHint hint = (fromMaybe [] $ asum [
     prefix "Perhaps you intended to use " <&> takeExtensions
 
   , requiredFor GHC_910 $ prefix "Enable any of the following extensions: " <&>
@@ -110,7 +112,7 @@ analyzeHint hint = asum [
   , prefix "Perhaps use `" <&> return . takeIdentifier
   , prefix "Perhaps use variable `" <&> return . takeIdentifier
   , prefix "Perhaps use one of these:" <&> extractIdentifiers
-  ]
+  ]) <> maybeToList addToImportList
   where
     prefix :: Text -> Maybe Text
     prefix p = stripPrefix p hint
@@ -133,6 +135,37 @@ analyzeHint hint = asum [
     takeIdentifier :: Text -> Solution
     takeIdentifier = UseName . T.takeWhile (/= '\'')
 
+    addToImportList :: Maybe Solution
+    addToImportList = case T.splitOn "' to the import list in the import of `" $ T.unwords $ T.lines $ hint of
+      [T.takeWhileEnd (/= '`') -> name, T.splitOn "'" -> [module_, r]] -> AddToImportList module_ name <$> do
+          takeGhcSourceSpan r
+      _ -> Nothing
+
+takeGhcSourceSpan :: Text -> Maybe Span
+takeGhcSourceSpan input = stripPrefix " (at " input <&> T.splitOn ":" >>= \ case
+    file
+      : (int -> Just line)
+      : (T.splitOn "-" . (T.takeWhile (/= ')')) -> [int -> Just start, int -> Just end])
+      : _ ->
+      Just $ span file (line, start) (line, end)
+
+    file
+      : (T.splitOn "-" -> [foo -> Just start, (takeFoo >>> foo) -> Just end])
+      : _ ->
+      Just $ span file start end
+    _ -> Nothing
+  where
+    span :: Text -> (Int, Int) -> (Int, Int) -> Span
+    span file start end = Span (T.unpack file) (uncurry Location start) (uncurry Location end)
+
+    int :: Text -> Maybe Int
+    int = T.unpack >>> readMaybe
+
+    foo :: Text -> Maybe (Int, Int)
+    foo = T.unpack >>> readMaybe
+
+    takeFoo t = T.take ((T.length $ T.takeWhile (/= ')') t) + 1) t
+
 extractIdentifiers :: Text -> [Solution]
 extractIdentifiers input = case T.breakOn "`" >>> snd >>> T.breakOn "\'" $ input of
   (T.drop 1 -> identifier, rest)
@@ -307,6 +340,7 @@ edits annotated = case annotated.diagnostic.span of
         RemoveImport -> removeLines
         UseName name -> Replace span name
         ImportName module_ qualification name -> AddImport file module_ qualification [name]
+        AddToImportList _ text loc -> Replace (Span loc.file loc.end loc.end) $ text <> "(..))" -- FIXME this is not correct and would need HIE lookup
 
       file :: FilePath
       file = span.file

src/GHC/Diagnostic/Annotated.hs

@@ -15,6 +15,7 @@ data Solution =
   | RemoveImport
   | UseName Text
   | ImportName Module Qualification Text
+  | AddToImportList Text Text Span
   deriving (Eq, Show)
 
 data Annotation =

test/GHC/DiagnosticSpec.hs

@@ -284,13 +284,14 @@ spec = do
 
     test "term-level-use-of-type-constructor" [] [r|
       module Foo where
-      data Foo = Fooa | Fooi
-      foo = Foo
-      |] (Just $ TermLevelUseOfTypeConstructor Unqualified "Foo") [
-          UseName "foo"
-        , UseName "Fooa"
-        , UseName "Fooi"
-        ]
+      import Text.Markdown.Unlit (CodeBlock)
+      data Foo = CodeBloc
+      foo = CodeBlock
+      |] (Just $ TermLevelUseOfTypeConstructor Unqualified "CodeBlock") [
+        UseName "CodeBloc"
+      , AddToImportList "Text.Markdown.Unlit" "CodeBlock" (Span "test/fixtures/term-level-use-of-type-constructor/Foo.hs" (Location 2 1) (Location 2 38))
+      , importName (Module "markdown-unlit" "Text.Markdown.Unlit") "CodeBlock(..)"
+      ]
 
     test "found-hole" [] [r|
       module Foo where
@@ -435,7 +436,7 @@ spec = do
             requiredFor GHC_910 "Perhaps you intended to use BlockArguments"
           , requiredFor GHC_912 "Perhaps you intended to use the `BlockArguments' extension"
           ]
-      for_ inputs \ input -> analyzeHint input `shouldBe` Just [
+      for_ inputs \ input -> analyzeHint input `shouldBe` [
           EnableExtension "BlockArguments"
         ]
 
@@ -446,7 +447,7 @@ spec = do
             requiredFor GHC_910 "Enable any of the following extensions: TemplateHaskell, TemplateHaskellQuotes"
           , requiredFor GHC_912 "Perhaps you intended to use the `TemplateHaskellQuotes' extension (implied by `TemplateHaskell')"
           ]
-      for_ inputs \ input -> analyzeHint input `shouldBe` Just [
+      for_ inputs \ input -> analyzeHint input `shouldBe` [
           EnableExtension "TemplateHaskellQuotes"
         , EnableExtension "TemplateHaskell"
         ]
@@ -549,6 +550,15 @@ spec = do
           analyzeAnnotation availableImports annotation `shouldBe` [
             ]
 
+  fdescribe "takeGhcSourceSpan" do
+    it "extracts single-line source spans" do
+      takeGhcSourceSpan " (at Foo.hs:2:1-38).:.:." `shouldBe`
+        Just (Span "Foo.hs" (Location 2 1) (Location 2 38))
+
+    it "extracts multi-line source spans" do
+      takeGhcSourceSpan " (at Foo.hs:(2,1)-(5,12)).:.:." `shouldBe`
+        Just (Span "Foo.hs" (Location 2 1) (Location 5 12))
+
   describe "applyReplace" do
     it "replaces a given source span with a substitute" do
       applyReplace (Location 2 7) (Location 2 14) "filter" [

test/fixtures/term-level-use-of-type-constructor/Foo.hs

@@ -0,0 +1 @@
+{"version":"1.0","ghcVersion":"ghc-9.10.0","span":{"file":"test/fixtures/term-level-use-of-type-constructor/Foo.hs","start":{"line":4,"column":7},"end":{"line":4,"column":16}},"severity":"Error","code":1928,"message":["Illegal term-level use of the type constructor `CodeBlock'","  imported from `Text.Markdown.Unlit' at test/fixtures/term-level-use-of-type-constructor/Foo.hs:2:29-37","Perhaps use `CodeBloc' (line 3)\nAdd `CodeBlock' to the import list in the import of\n`Text.Markdown.Unlit'\n(at test/fixtures/term-level-use-of-type-constructor/Foo.hs:2:1-38).","In the expression: CodeBlock\nIn an equation for `foo': foo = CodeBlock"],"hints":[]}

test/fixtures/term-level-use-of-type-constructor/err.json

@@ -1,8 +1,10 @@
-test/fixtures/term-level-use-of-type-constructor/Foo.hs:3:7: error: [GHC-01928]
-    • Illegal term-level use of the type constructor `Foo'
-    • defined at test/fixtures/term-level-use-of-type-constructor/Foo.hs:2:1
-    • Perhaps use one of these:
-        variable `foo' (line 3), `Fooa' (line 2), `Fooi' (line 2)
-    • In the expression: Foo
-      In an equation for `foo': foo = Foo
+test/fixtures/term-level-use-of-type-constructor/Foo.hs:4:7: error: [GHC-01928]
+    • Illegal term-level use of the type constructor `CodeBlock'
+    • imported from `Text.Markdown.Unlit' at test/fixtures/term-level-use-of-type-constructor/Foo.hs:2:29-37
+    • Perhaps use `CodeBloc' (line 3)
+      Add `CodeBlock' to the import list in the import of
+      `Text.Markdown.Unlit'
+      (at test/fixtures/term-level-use-of-type-constructor/Foo.hs:2:1-38).
+    • In the expression: CodeBlock
+      In an equation for `foo': foo = CodeBlock