Make --ignore=Parse error work again

src/Apply.hs

@@ -87,7 +87,15 @@ parseModuleApply flags s file src = do
     case res of
       Right r -> pure $ Right r
       Left (ParseError sl msg ctxt) ->
-            pure $ Left $ classify [x | SettingClassify x <- s] $ rawIdeaN Error msg sl ctxt Nothing []
+            pure $ Left $ classify [x | SettingClassify x <- s] $ rawIdeaN Error (adjustMessage msg) sl ctxt Nothing []
+    where
+        -- important the message has "Parse error:" as the prefix so "--ignore=Parse error" works
+        -- try and tidy up things like "parse error (mismatched brackets)" to not look silly
+        adjustMessage :: String -> String
+        adjustMessage x = "Parse error: " ++ dropBrackets (dropPrefix "parse error " x)
+
+        dropBrackets ('(':xs) | Just (xs,')') <- unsnoc xs = xs
+        dropBrackets xs = xs
 
 
 -- | Find which hints a list of settings implies.
@@ -99,10 +107,11 @@ allHints xs = mconcat $ hintRules [x | SettingMatchExp x <- xs] : map f builtin
 
 -- | Given some settings, make sure the severity field of the Idea is correct.
 classify :: [Classify] -> Idea -> Idea
-classify xs i =  let s = foldl' (f i) (ideaSeverity i) xs in s `seq` i{ideaSeverity=s}
+classify xs i = let s = foldl' (f i) (ideaSeverity i) xs in s `seq` i{ideaSeverity=s}
     where
         -- figure out if we need to change the severity
         f :: Idea -> Severity -> Classify -> Severity
-        f i r c | classifyHint c ~= [ideaHint i] && classifyModule c ~= ideaModule i && classifyDecl c ~= ideaDecl i = classifySeverity c
+        f i r c | classifyHint c ~~= ideaHint i && classifyModule c ~= ideaModule i && classifyDecl c ~= ideaDecl i = classifySeverity c
                 | otherwise = r
-        x ~= y = null x || x `elem` y
+        x ~= y = x == "" || x `elem` y
+        x  ~~= y = x == "" || x == y || ((x ++ ":") `isPrefixOf` y)

src/HSE/All.hs

@@ -121,8 +121,7 @@ ghcFailOpParseModuleEx ppstr file str (loc, err) = do
    let pe = case loc of
             GHC.RealSrcSpan r -> context (GHC.srcSpanStartLine r) ppstr
             _ -> ""
-       msg = Outputable.showSDoc baseDynFlags $
-               ErrUtils.pprLocErrMsg (ErrUtils.mkPlainErrMsg baseDynFlags loc err)
+       msg = Outputable.showSDoc baseDynFlags err
    pure $ Left $ ParseError loc msg pe
 
 -- A hacky function to get fixities from HSE parse flags suitable for

tests/parse-error.test

@@ -3,12 +3,6 @@ RUN "--ignore=Parse error" tests/ignore-parse-error.hs
 FILE tests/ignore-parse-error.hs
 where
 OUTPUT
-tests/ignore-parse-error.hs:1:1-5: Error: tests/ignore-parse-error.hs:1:1: error:
-    parse error on input `where'
-Found:
-  > where
-
-1 hint
 
 ---------------------------------------------------------------------
 RUN tests/ignore-parse-error2.hs
@@ -17,8 +11,7 @@ module Foo where
 
 where
 OUTPUT
-tests/ignore-parse-error2.hs:3:1-5: Error: tests/ignore-parse-error2.hs:3:1: error:
-    parse error on input `where'
+tests/ignore-parse-error2.hs:3:1-5: Error: Parse error: on input `where'
 Found:
     module Foo where