hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

enabling -fno-warn- (#246).

Browse Source
This commit is contained in:
Kazu Yamamoto 2014-05-09 23:45:34 +09:00
parent c05b27b65b
commit 2e3b172b0e
2 changed files with 17 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Language/Haskell/GhcMod/GHCApi.hs
View File

@ -8,6 +8,7 @@ module Language.Haskell.GhcMod.GHCApi (
, getDynamicFlags , getDynamicFlags
, getSystemLibDir , getSystemLibDir
, withDynFlags , withDynFlags
, withCmdFlags
, setNoWaringFlags , setNoWaringFlags
, setAllWaringFlags , setAllWaringFlags
) where ) where
@ -176,6 +177,15 @@ withDynFlags setFlag body = G.gbracket setup teardown (\_ -> body)
return dflag return dflag
teardown = void . G.setSessionDynFlags teardown = void . G.setSessionDynFlags
withCmdFlags :: [GHCOption] -> Ghc a -> Ghc a
withCmdFlags flags body = G.gbracket setup teardown (\_ -> body)
where
setup = do
dflag <- G.getSessionDynFlags >>= addCmdOpts flags
void $ G.setSessionDynFlags dflag
return dflag
teardown = void . G.setSessionDynFlags
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Set 'DynFlags' equivalent to "-w:". -- | Set 'DynFlags' equivalent to "-w:".

11
Language/Haskell/GhcMod/Logger.hs
View File

@ -9,6 +9,7 @@ import Bag (Bag, bagToList)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import CoreMonad (liftIO) import CoreMonad (liftIO)
import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef) import Data.IORef (IORef, newIORef, readIORef, writeIORef, modifyIORef)
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import ErrUtils (ErrMsg, errMsgShortDoc, errMsgExtraInfo) import ErrUtils (ErrMsg, errMsgShortDoc, errMsgExtraInfo)
import Exception (ghandle) import Exception (ghandle)
@ -16,9 +17,9 @@ import GHC (Ghc, DynFlags, SrcSpan, Severity(SevError))
import qualified GHC as G import qualified GHC as G
import HscTypes (SourceError, srcErrorMessages) import HscTypes (SourceError, srcErrorMessages)
import Language.Haskell.GhcMod.Doc (showPage, getStyle) import Language.Haskell.GhcMod.Doc (showPage, getStyle)
import Language.Haskell.GhcMod.GHCApi (withDynFlags) import Language.Haskell.GhcMod.GHCApi (withDynFlags, withCmdFlags)
import qualified Language.Haskell.GhcMod.Gap as Gap import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Types (Options, convert) import Language.Haskell.GhcMod.Types (Options(..), convert)
import Outputable (PprStyle, SDoc) import Outputable (PprStyle, SDoc)
import System.FilePath (normalise) import System.FilePath (normalise)
@ -51,10 +52,12 @@ withLogger :: Options -> (DynFlags -> DynFlags) -> Ghc () -> Ghc (Either String
withLogger opt setDF body = ghandle (sourceError opt) $ do withLogger opt setDF body = ghandle (sourceError opt) $ do
logref <- liftIO $ newLogRef logref <- liftIO $ newLogRef
withDynFlags (setLogger logref . setDF) $ do withDynFlags (setLogger logref . setDF) $ do
body withCmdFlags wflags $ do
liftIO $ Right <$> readAndClearLogRef opt logref body
liftIO $ Right <$> readAndClearLogRef opt logref
where where
setLogger logref df = Gap.setLogAction df $ appendLogRef df logref setLogger logref df = Gap.setLogAction df $ appendLogRef df logref
wflags = filter ("-fno-warn" `isPrefixOf`) $ ghcOpts opt
---------------------------------------------------------------- ----------------------------------------------------------------