From e23f250d9ea7bf1d8f5e182798984f52dc397080 Mon Sep 17 00:00:00 2001
From: Simon Hengel <sol@typeful.net>
Date: Sat, 25 Jan 2025 17:48:48 +0700
Subject: [PATCH] Remove GHCi specific hints from GHC error messages

---
 src/GHC/Diagnostic.hs                   | 10 +++++++++-
 test/GHC/DiagnosticSpec.hs              |  2 +-
 test/assets/use-BlockArguments/err.json |  2 +-
 3 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/src/GHC/Diagnostic.hs b/src/GHC/Diagnostic.hs
index 823cb71c..5caebf6c 100644
--- a/src/GHC/Diagnostic.hs
+++ b/src/GHC/Diagnostic.hs
@@ -40,7 +40,7 @@ data Severity = Warning | Error
   deriving (Eq, Show, Generic, ToJSON, FromJSON)
 
 parse :: ByteString -> Maybe Diagnostic
-parse = decode . fromStrict
+parse = fmap removeGhciSpecificHints . decode . fromStrict
 
 format :: Diagnostic -> ByteString
 format diagnostic = encodeUtf8 . render $ unlines [
@@ -90,3 +90,11 @@ format diagnostic = encodeUtf8 . render $ unlines [
 
     unlines :: [Doc] -> Doc
     unlines = foldr ($+$) empty
+
+removeGhciSpecificHints :: Diagnostic -> Diagnostic
+removeGhciSpecificHints diagnostic = diagnostic { hints = map f diagnostic.hints }
+  where
+    f :: String -> String
+    f input = case lines input of
+      [hint, "You may enable this language extension in GHCi with:", ghciHint] | "  :set -X" `isPrefixOf` ghciHint -> hint
+      _ -> input
diff --git a/test/GHC/DiagnosticSpec.hs b/test/GHC/DiagnosticSpec.hs
index eecf4361..68813449 100644
--- a/test/GHC/DiagnosticSpec.hs
+++ b/test/GHC/DiagnosticSpec.hs
@@ -13,7 +13,7 @@ import           GHC.Diagnostic
 test :: HasCallStack => FilePath -> Spec
 test name = it name $ do
   err <- translate <$> ghc ["-fno-diagnostics-show-caret"]
-  json <- encodeUtf8 <$> ghc ["-fdiagnostics-as-json"]
+  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
diff --git a/test/assets/use-BlockArguments/err.json b/test/assets/use-BlockArguments/err.json
index 611d0cb4..74c6e268 100644
--- a/test/assets/use-BlockArguments/err.json
+++ b/test/assets/use-BlockArguments/err.json
@@ -1 +1 @@
-{"version":"1.0","ghcVersion":"ghc-9.10.1","span":{"file":"test/assets/use-BlockArguments/Foo.hs","start":{"line":5,"column":10},"end":{"line":5,"column":22}},"severity":"Error","code":52095,"message":["Unexpected do block in function application:\n    do return ()"],"hints":["Use parentheses.","Perhaps you intended to use BlockArguments"]}
+{"version":"1.0","ghcVersion":"ghc-9.10.1","span":{"file":"test/assets/use-BlockArguments/Foo.hs","start":{"line":5,"column":10},"end":{"line":5,"column":22}},"severity":"Error","code":52095,"message":["Unexpected do block in function application:\n    do return ()"],"hints":["Use parentheses.","Perhaps you intended to use BlockArguments\nYou may enable this language extension in GHCi with:\n  :set -XBlockArguments"]}