Skip to content

Commit 79fd77e

Browse files
dylan-thinnesJaro Reinders
authored and
Jaro Reinders
committed
Drop attachReason logic from withWarnings, technically incorrect
1 parent e948f2a commit 79fd77e

File tree

1 file changed

+1
-15
lines changed

1 file changed

+1
-15
lines changed

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

Lines changed: 1 addition & 15 deletions
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
@@ -30,20 +27,9 @@ withWarnings diagSource action = do
3027
warnings <- newVar []
3128
let newAction :: DynFlags -> LogActionCompat
3229
newAction dynFlags logFlags wr _ loc prUnqual msg = do
33-
let wr_d = map ((wr,) . over fdLspDiagnosticL (attachReason wr)) $ diagFromSDocErrMsg diagSource dynFlags (mkWarnMsg dynFlags wr logFlags loc prUnqual msg)
30+
let wr_d = map (wr,) $ diagFromSDocErrMsg diagSource dynFlags (mkWarnMsg dynFlags wr logFlags loc prUnqual msg)
3431
modifyVar_ warnings $ return . (wr_d:)
3532
newLogger env = pushLogHook (const (logActionCompat (newAction (hsc_dflags env)))) (hsc_logger env)
3633
res <- action $ \env -> putLogHook (newLogger env) env
3734
warns <- readVar warnings
3835
return (reverse $ concat warns, res)
39-
40-
attachReason :: Maybe DiagnosticReason -> Diagnostic -> Diagnostic
41-
attachReason Nothing d = d
42-
attachReason (Just wr) d = d{_code = InR <$> showReason wr}
43-
where
44-
showReason = \case
45-
WarningWithFlag flag -> showFlag flag
46-
_ -> Nothing
47-
48-
showFlag :: WarningFlag -> Maybe T.Text
49-
showFlag flag = ("-W" <>) . T.pack . flagSpecName <$> find ((== flag) . flagSpecFlag) wWarningFlags

0 commit comments

Comments
 (0)