From 117d01a52a53426b51468136d36a355c0f98cd5f Mon Sep 17 00:00:00 2001 From: Kazu Yamamoto Date: Mon, 28 Apr 2014 12:52:09 +0900 Subject: [PATCH] removing -Wall and -w:. --- Language/Haskell/GhcMod/Check.hs | 10 ++++------ Language/Haskell/GhcMod/ErrMsg.hs | 8 +++++--- Language/Haskell/GhcMod/GHCApi.hs | 21 +++++++++++++++++---- Language/Haskell/GhcMod/Info.hs | 7 ++++--- Language/Haskell/GhcMod/Internal.hs | 2 ++ src/GHCModi.hs | 4 ++-- 6 files changed, 34 insertions(+), 18 deletions(-) diff --git a/Language/Haskell/GhcMod/Check.hs b/Language/Haskell/GhcMod/Check.hs index 88a547b..0f32997 100644 --- a/Language/Haskell/GhcMod/Check.hs +++ b/Language/Haskell/GhcMod/Check.hs @@ -22,13 +22,12 @@ checkSyntax :: Options -> IO String checkSyntax _ _ [] = return "" checkSyntax opt cradle files = withGHC sessionName $ do - initializeFlagsWithCradle opt cradle options + initializeFlagsWithCradle opt cradle (ghcOpts opt) check opt files where sessionName = case files of [file] -> file _ -> "MultipleFiles" - options = "-Wall" : ghcOpts opt ---------------------------------------------------------------- @@ -38,7 +37,7 @@ check :: Options -> [FilePath] -- ^ The target files. -> Ghc String check opt fileNames = ghandle (handleErrMsg opt) $ - withLogger opt $ setTargetFiles fileNames + withLogger opt setAllWaringFlags $ setTargetFiles fileNames ---------------------------------------------------------------- @@ -49,13 +48,12 @@ expandTemplate :: Options -> IO String expandTemplate _ _ [] = return "" expandTemplate opt cradle files = withGHC sessionName $ do - initializeFlagsWithCradle opt cradle options + initializeFlagsWithCradle opt cradle (ghcOpts opt) expand opt files where sessionName = case files of [file] -> file _ -> "MultipleFiles" - options = noWaringOption : ghcOpts opt ---------------------------------------------------------------- @@ -65,4 +63,4 @@ expand :: Options -> Ghc String expand opt fileNames = ghandle (handleErrMsg opt) $ withDynFlags Gap.setDumpSplices $ - withLogger opt $ setTargetFiles fileNames + withLogger opt setNoWaringFlags $ setTargetFiles fileNames diff --git a/Language/Haskell/GhcMod/ErrMsg.hs b/Language/Haskell/GhcMod/ErrMsg.hs index acced15..1009b1d 100644 --- a/Language/Haskell/GhcMod/ErrMsg.hs +++ b/Language/Haskell/GhcMod/ErrMsg.hs @@ -50,12 +50,14 @@ appendLogRef df (LogRef ref) _ sev src style msg = do ---------------------------------------------------------------- -withLogger :: Options -> Ghc () -> Ghc String -withLogger opt body = do +withLogger :: Options -> (DynFlags -> DynFlags) -> Ghc () -> Ghc String +withLogger opt setDF body = do logref <- liftIO $ newLogRef - withDynFlags (\df -> Gap.setLogAction df $ appendLogRef df logref) $ do + withDynFlags (setLogger logref . setDF) $ do body liftIO $ readAndClearLogRef opt logref + where + setLogger logref df = Gap.setLogAction df $ appendLogRef df logref ---------------------------------------------------------------- diff --git a/Language/Haskell/GhcMod/GHCApi.hs b/Language/Haskell/GhcMod/GHCApi.hs index 888b78c..b1011d4 100644 --- a/Language/Haskell/GhcMod/GHCApi.hs +++ b/Language/Haskell/GhcMod/GHCApi.hs @@ -9,7 +9,8 @@ module Language.Haskell.GhcMod.GHCApi ( , getDynamicFlags , getSystemLibDir , withDynFlags - , noWaringOption + , setNoWaringFlags + , setAllWaringFlags ) where import Language.Haskell.GhcMod.CabalApi @@ -19,6 +20,7 @@ import Language.Haskell.GhcMod.GhcPkg import Control.Applicative ((<$>)) import Control.Monad (forM, void) import CoreMonad (liftIO) +import Data.IntSet (IntSet, empty) import Data.Maybe (isJust, fromJust) import Exception (ghandle, SomeException(..)) import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..)) @@ -27,6 +29,7 @@ import qualified Language.Haskell.GhcMod.Gap as Gap import Language.Haskell.GhcMod.Types import System.Exit (exitSuccess) import System.IO (hPutStr, hPrint, stderr) +import System.IO.Unsafe (unsafePerformIO) import System.Process (readProcess) ---------------------------------------------------------------- @@ -184,6 +187,16 @@ withDynFlags setFlag body = G.gbracket setup teardown (\_ -> body) ---------------------------------------------------------------- --- probably this is not necessary anymore. -noWaringOption :: String -noWaringOption = "-w:" +setNoWaringFlags :: DynFlags -> DynFlags +setNoWaringFlags df = df { warningFlags = empty} + +setAllWaringFlags :: DynFlags -> DynFlags +setAllWaringFlags df = df { warningFlags = allWarningFlags } + +allWarningFlags :: IntSet +allWarningFlags = unsafePerformIO $ do + mlibdir <- getSystemLibDir + G.runGhc mlibdir $ do + df <- G.getSessionDynFlags + df' <- addCmdOpts ["-Wall"] df + return $ G.warningFlags df' diff --git a/Language/Haskell/GhcMod/Info.hs b/Language/Haskell/GhcMod/Info.hs index 416ec23..c73716a 100644 --- a/Language/Haskell/GhcMod/Info.hs +++ b/Language/Haskell/GhcMod/Info.hs @@ -37,7 +37,7 @@ infoExpr :: Options -> Expression -- ^ A Haskell expression. -> IO String infoExpr opt cradle file expr = withGHC' $ do - initializeFlagsWithCradle opt cradle [noWaringOption] + initializeFlagsWithCradle opt cradle [] info opt file expr -- | Obtaining information of a target expression. (GHCi's info:) @@ -73,7 +73,7 @@ typeExpr :: Options -> Int -- ^ Column number. -> IO String typeExpr opt cradle file lineNo colNo = withGHC' $ do - initializeFlagsWithCradle opt cradle [noWaringOption] + initializeFlagsWithCradle opt cradle [] types opt file lineNo colNo -- | Obtaining type of a target expression. (GHCi's type:) @@ -128,7 +128,8 @@ pretty dflag style = showOneLine dflag style . Gap.typeForUser ---------------------------------------------------------------- inModuleContext :: FilePath -> (DynFlags -> PprStyle -> Ghc a) -> Ghc a -inModuleContext file action = withDynFlags setDeferTypeErrors $ do +inModuleContext file action = + withDynFlags (setDeferTypeErrors . setNoWaringFlags) $ do setTargetFiles [file] Gap.withContext $ do dflag <- G.getSessionDynFlags diff --git a/Language/Haskell/GhcMod/Internal.hs b/Language/Haskell/GhcMod/Internal.hs index 17c6ce3..f51cf28 100644 --- a/Language/Haskell/GhcMod/Internal.hs +++ b/Language/Haskell/GhcMod/Internal.hs @@ -26,6 +26,8 @@ module Language.Haskell.GhcMod.Internal ( , addTargetFiles , handleErrMsg , withLogger + , setNoWaringFlags + , setAllWaringFlags -- * 'Ghc' Choice , (||>) , goNext diff --git a/src/GHCModi.hs b/src/GHCModi.hs index 7a5fed5..618703a 100644 --- a/src/GHCModi.hs +++ b/src/GHCModi.hs @@ -122,7 +122,7 @@ replace (x:xs) = x : replace xs run :: Cradle -> Maybe FilePath -> Options -> Ghc a -> IO a run cradle mlibdir opt body = G.runGhc mlibdir $ do - initializeFlagsWithCradle opt cradle ["-Wall"] + initializeFlagsWithCradle opt cradle [] dflags <- G.getSessionDynFlags G.defaultCleanupHandler dflags body @@ -171,7 +171,7 @@ checkStx opt set file = do GE.ghandle handler $ do (set',add) <- removeMainTarget file set let files = if add then [file] else [] - ret <- withLogger opt $ addTargetFiles files + ret <- withLogger opt setAllWaringFlags $ addTargetFiles files return (ret, True, set') where handler :: SourceError -> Ghc (String, Bool, Set FilePath)