removing -Wall and -w:.

This commit is contained in:
Kazu Yamamoto 2014-04-28 12:52:09 +09:00
parent f413cda0fe
commit 117d01a52a
6 changed files with 34 additions and 18 deletions

View File

@ -22,13 +22,12 @@ checkSyntax :: Options
-> IO String -> IO String
checkSyntax _ _ [] = return "" checkSyntax _ _ [] = return ""
checkSyntax opt cradle files = withGHC sessionName $ do checkSyntax opt cradle files = withGHC sessionName $ do
initializeFlagsWithCradle opt cradle options initializeFlagsWithCradle opt cradle (ghcOpts opt)
check opt files check opt files
where where
sessionName = case files of sessionName = case files of
[file] -> file [file] -> file
_ -> "MultipleFiles" _ -> "MultipleFiles"
options = "-Wall" : ghcOpts opt
---------------------------------------------------------------- ----------------------------------------------------------------
@ -38,7 +37,7 @@ check :: Options
-> [FilePath] -- ^ The target files. -> [FilePath] -- ^ The target files.
-> Ghc String -> Ghc String
check opt fileNames = ghandle (handleErrMsg opt) $ check opt fileNames = ghandle (handleErrMsg opt) $
withLogger opt $ setTargetFiles fileNames withLogger opt setAllWaringFlags $ setTargetFiles fileNames
---------------------------------------------------------------- ----------------------------------------------------------------
@ -49,13 +48,12 @@ expandTemplate :: Options
-> IO String -> IO String
expandTemplate _ _ [] = return "" expandTemplate _ _ [] = return ""
expandTemplate opt cradle files = withGHC sessionName $ do expandTemplate opt cradle files = withGHC sessionName $ do
initializeFlagsWithCradle opt cradle options initializeFlagsWithCradle opt cradle (ghcOpts opt)
expand opt files expand opt files
where where
sessionName = case files of sessionName = case files of
[file] -> file [file] -> file
_ -> "MultipleFiles" _ -> "MultipleFiles"
options = noWaringOption : ghcOpts opt
---------------------------------------------------------------- ----------------------------------------------------------------
@ -65,4 +63,4 @@ expand :: Options
-> Ghc String -> Ghc String
expand opt fileNames = ghandle (handleErrMsg opt) $ expand opt fileNames = ghandle (handleErrMsg opt) $
withDynFlags Gap.setDumpSplices $ withDynFlags Gap.setDumpSplices $
withLogger opt $ setTargetFiles fileNames withLogger opt setNoWaringFlags $ setTargetFiles fileNames

View File

@ -50,12 +50,14 @@ appendLogRef df (LogRef ref) _ sev src style msg = do
---------------------------------------------------------------- ----------------------------------------------------------------
withLogger :: Options -> Ghc () -> Ghc String withLogger :: Options -> (DynFlags -> DynFlags) -> Ghc () -> Ghc String
withLogger opt body = do withLogger opt setDF body = do
logref <- liftIO $ newLogRef logref <- liftIO $ newLogRef
withDynFlags (\df -> Gap.setLogAction df $ appendLogRef df logref) $ do withDynFlags (setLogger logref . setDF) $ do
body body
liftIO $ readAndClearLogRef opt logref liftIO $ readAndClearLogRef opt logref
where
setLogger logref df = Gap.setLogAction df $ appendLogRef df logref
---------------------------------------------------------------- ----------------------------------------------------------------

View File

@ -9,7 +9,8 @@ module Language.Haskell.GhcMod.GHCApi (
, getDynamicFlags , getDynamicFlags
, getSystemLibDir , getSystemLibDir
, withDynFlags , withDynFlags
, noWaringOption , setNoWaringFlags
, setAllWaringFlags
) where ) where
import Language.Haskell.GhcMod.CabalApi import Language.Haskell.GhcMod.CabalApi
@ -19,6 +20,7 @@ import Language.Haskell.GhcMod.GhcPkg
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Control.Monad (forM, void) import Control.Monad (forM, void)
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.IntSet (IntSet, empty)
import Data.Maybe (isJust, fromJust) import Data.Maybe (isJust, fromJust)
import Exception (ghandle, SomeException(..)) import Exception (ghandle, SomeException(..))
import GHC (Ghc, GhcMonad, DynFlags(..), GhcLink(..), HscTarget(..), LoadHowMuch(..)) 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 Language.Haskell.GhcMod.Types
import System.Exit (exitSuccess) import System.Exit (exitSuccess)
import System.IO (hPutStr, hPrint, stderr) import System.IO (hPutStr, hPrint, stderr)
import System.IO.Unsafe (unsafePerformIO)
import System.Process (readProcess) import System.Process (readProcess)
---------------------------------------------------------------- ----------------------------------------------------------------
@ -184,6 +187,16 @@ withDynFlags setFlag body = G.gbracket setup teardown (\_ -> body)
---------------------------------------------------------------- ----------------------------------------------------------------
-- probably this is not necessary anymore. setNoWaringFlags :: DynFlags -> DynFlags
noWaringOption :: String setNoWaringFlags df = df { warningFlags = empty}
noWaringOption = "-w:"
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'

View File

@ -37,7 +37,7 @@ infoExpr :: Options
-> Expression -- ^ A Haskell expression. -> Expression -- ^ A Haskell expression.
-> IO String -> IO String
infoExpr opt cradle file expr = withGHC' $ do infoExpr opt cradle file expr = withGHC' $ do
initializeFlagsWithCradle opt cradle [noWaringOption] initializeFlagsWithCradle opt cradle []
info opt file expr info opt file expr
-- | Obtaining information of a target expression. (GHCi's info:) -- | Obtaining information of a target expression. (GHCi's info:)
@ -73,7 +73,7 @@ typeExpr :: Options
-> Int -- ^ Column number. -> Int -- ^ Column number.
-> IO String -> IO String
typeExpr opt cradle file lineNo colNo = withGHC' $ do typeExpr opt cradle file lineNo colNo = withGHC' $ do
initializeFlagsWithCradle opt cradle [noWaringOption] initializeFlagsWithCradle opt cradle []
types opt file lineNo colNo types opt file lineNo colNo
-- | Obtaining type of a target expression. (GHCi's type:) -- | 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 :: FilePath -> (DynFlags -> PprStyle -> Ghc a) -> Ghc a
inModuleContext file action = withDynFlags setDeferTypeErrors $ do inModuleContext file action =
withDynFlags (setDeferTypeErrors . setNoWaringFlags) $ do
setTargetFiles [file] setTargetFiles [file]
Gap.withContext $ do Gap.withContext $ do
dflag <- G.getSessionDynFlags dflag <- G.getSessionDynFlags

View File

@ -26,6 +26,8 @@ module Language.Haskell.GhcMod.Internal (
, addTargetFiles , addTargetFiles
, handleErrMsg , handleErrMsg
, withLogger , withLogger
, setNoWaringFlags
, setAllWaringFlags
-- * 'Ghc' Choice -- * 'Ghc' Choice
, (||>) , (||>)
, goNext , goNext

View File

@ -122,7 +122,7 @@ replace (x:xs) = x : replace xs
run :: Cradle -> Maybe FilePath -> Options -> Ghc a -> IO a run :: Cradle -> Maybe FilePath -> Options -> Ghc a -> IO a
run cradle mlibdir opt body = G.runGhc mlibdir $ do run cradle mlibdir opt body = G.runGhc mlibdir $ do
initializeFlagsWithCradle opt cradle ["-Wall"] initializeFlagsWithCradle opt cradle []
dflags <- G.getSessionDynFlags dflags <- G.getSessionDynFlags
G.defaultCleanupHandler dflags body G.defaultCleanupHandler dflags body
@ -171,7 +171,7 @@ checkStx opt set file = do
GE.ghandle handler $ do GE.ghandle handler $ do
(set',add) <- removeMainTarget file set (set',add) <- removeMainTarget file set
let files = if add then [file] else [] let files = if add then [file] else []
ret <- withLogger opt $ addTargetFiles files ret <- withLogger opt setAllWaringFlags $ addTargetFiles files
return (ret, True, set') return (ret, True, set')
where where
handler :: SourceError -> Ghc (String, Bool, Set FilePath) handler :: SourceError -> Ghc (String, Bool, Set FilePath)