Skip to content

Commit 4fed987

Browse files
committed
Drop attachReason logic from withWarnings, technically incorrect
1 parent 3500ac3 commit 4fed987

File tree

1 file changed

+1
-25
lines changed

1 file changed

+1
-25
lines changed

ghcide/src/Development/IDE/GHC/Warnings.hs

+1-25
Original file line numberDiff line numberDiff line change
@@ -6,14 +6,11 @@
66
module Development.IDE.GHC.Warnings(withWarnings) where
77

88
import Control.Concurrent.Strict
9-
import Control.Lens (over)
10-
import Data.List
119
import qualified Data.Text as T
1210

1311
import Development.IDE.GHC.Compat
1412
import Development.IDE.GHC.Error
1513
import Development.IDE.Types.Diagnostics
16-
import Language.LSP.Protocol.Types (type (|?) (..))
1714

1815

1916
-- | Take a GHC monadic action (e.g. @typecheckModule pm@ for some
@@ -34,30 +31,9 @@ withWarnings diagSource action = do
3431
warnings <- newVar []
3532
let newAction :: DynFlags -> LogActionCompat
3633
newAction dynFlags logFlags wr _ loc prUnqual msg = do
37-
let wr_d = map ((wr,) . over fdLspDiagnosticL (attachReason wr)) $ diagFromSDocErrMsg diagSource dynFlags (mkWarnMsg dynFlags wr logFlags loc prUnqual msg)
34+
let wr_d = map (wr,) $ diagFromSDocErrMsg diagSource dynFlags (mkWarnMsg dynFlags wr logFlags loc prUnqual msg)
3835
modifyVar_ warnings $ return . (wr_d:)
3936
newLogger env = pushLogHook (const (logActionCompat (newAction (hsc_dflags env)))) (hsc_logger env)
4037
res <- action $ \env -> putLogHook (newLogger env) env
4138
warns <- readVar warnings
4239
return (reverse $ concat warns, res)
43-
44-
#if MIN_VERSION_ghc(9,3,0)
45-
attachReason :: Maybe DiagnosticReason -> Diagnostic -> Diagnostic
46-
attachReason Nothing d = d
47-
attachReason (Just wr) d = d{_code = InR <$> showReason wr}
48-
where
49-
showReason = \case
50-
WarningWithFlag flag -> showFlag flag
51-
_ -> Nothing
52-
#else
53-
attachReason :: WarnReason -> Diagnostic -> Diagnostic
54-
attachReason wr d = d{_code = InR <$> showReason wr}
55-
where
56-
showReason = \case
57-
NoReason -> Nothing
58-
Reason flag -> showFlag flag
59-
ErrReason flag -> showFlag =<< flag
60-
#endif
61-
62-
showFlag :: WarningFlag -> Maybe T.Text
63-
showFlag flag = ("-W" <>) . T.pack . flagSpecName <$> find ((== flag) . flagSpecFlag) wWarningFlags

0 commit comments

Comments
 (0)