Last active
May 24, 2022 12:11
-
-
Save tfausak/0ce845d1d81b27ef4510c38200ac6cf6 to your computer and use it in GitHub Desktop.
A GHC plugin for disabling some warnings.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
cabal-version: >= 1.10 | |
name: disable-warnings | |
version: 0.2022.5.24 | |
build-type: Simple | |
library | |
build-depends: base, ghc | |
default-language: Haskell2010 | |
exposed-modules: DisableWarnings |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module DisableWarnings where | |
import qualified Data.List as List | |
import qualified GHC.Data.Bag as Bag | |
import qualified GHC.Data.IOEnv as IOEnv | |
import qualified GHC.Plugins as Plugins | |
import qualified GHC.Tc.Types as Tc | |
import qualified GHC.Types.Error as Error | |
plugin :: Plugins.Plugin | |
plugin = Plugins.defaultPlugin | |
{ Plugins.pluginRecompile = Plugins.purePlugin | |
, Plugins.typeCheckResultAction = \_ _ _ -> do | |
env <- IOEnv.getEnv | |
IOEnv.updMutVarM (Tc.tcl_errs $ Tc.env_lcl env) $ \messages -> do | |
let | |
(warnings, errors) = Error.partitionMessages messages | |
newWarnings = Bag.filterBag shouldKeep warnings | |
pure . Error.mkMessages $ Bag.unionBags newWarnings errors | |
pure $ Tc.env_gbl env | |
} | |
shouldKeep :: Error.MsgEnvelope Error.DecoratedSDoc -> Bool | |
shouldKeep msgEnvelope = | |
let shown = show msgEnvelope | |
in | |
case Error.errMsgReason msgEnvelope of | |
Plugins.Reason Plugins.Opt_WarnDuplicateConstraints -> | |
notInfixOf "HasCallStack" shown | |
Plugins.Reason Plugins.Opt_WarnRedundantConstraints -> | |
notInfixOf "HasCallStack" shown | |
Plugins.Reason Plugins.Opt_WarnUnusedImports -> | |
notInfixOf "GHC.Stack" shown | |
_ -> True | |
notInfixOf :: Eq a => [a] -> [a] -> Bool | |
notInfixOf x = not . List.isInfixOf x |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment