In check, apply ghcUserOptions after setting -Wall

This commit is contained in:
Daniel Gröber 2014-08-13 19:25:27 +02:00
parent 4b05c20205
commit ec1b115cc1
3 changed files with 33 additions and 6 deletions

View File

@ -4,7 +4,6 @@ module Language.Haskell.GhcMod.CaseSplit (
splits
) where
import CoreMonad (liftIO)
import Data.List (find, intercalate)
import Data.Maybe (isJust)
import qualified Data.Text as T

View File

@ -8,8 +8,10 @@ module Language.Haskell.GhcMod.Check (
import Control.Applicative ((<$>))
import Language.Haskell.GhcMod.DynFlags
import qualified Language.Haskell.GhcMod.Gap as Gap
import qualified GHC as G
import Language.Haskell.GhcMod.Logger
import Language.Haskell.GhcMod.Monad (IOish, GhcModT, withErrorHandler)
import Language.Haskell.GhcMod.Monad (IOish, GhcModT, withErrorHandler
, overrideGhcUserOptions)
import Language.Haskell.GhcMod.Target (setTargetFiles)
----------------------------------------------------------------
@ -34,8 +36,9 @@ checkSyntax files = withErrorHandler sessionName $
check :: IOish m
=> [FilePath] -- ^ The target files.
-> GhcModT m (Either String String)
check fileNames =
withLogger (setAllWaringFlags . setNoMaxRelevantBindings) $
check fileNames = overrideGhcUserOptions $ \ghcOpts -> do
withLogger (setAllWaringFlags . setNoMaxRelevantBindings) $ do
_ <- G.setSessionDynFlags =<< addCmdOpts ghcOpts =<< G.getSessionDynFlags
setTargetFiles fileNames
----------------------------------------------------------------

View File

@ -30,7 +30,10 @@ module Language.Haskell.GhcMod.Monad (
, getCompilerMode
, setCompilerMode
, withOptions
-- ** Exporting convenient modules
, withTempSession
, overrideGhcUserOptions
-- ** Re-exporting convenient stuff
, liftIO
, module Control.Monad.Reader.Class
, module Control.Monad.Journal.Class
) where
@ -57,7 +60,7 @@ import Exception
import GHC
import qualified GHC as G
import GHC.Paths (libdir)
import GhcMonad
import GhcMonad hiding (withTempSession)
#if __GLASGOW_HASKELL__ <= 702
import HscTypes
#endif
@ -282,6 +285,28 @@ withErrorHandler label = ghandle ignore
hPrint stderr e
exitSuccess
-- | Make a copy of the 'gmGhcSession' IORef, run the action and restore the
-- original 'HscEnv'.
withTempSession :: IOish m => GhcModT m a -> GhcModT m a
withTempSession action = do
session <- gmGhcSession <$> ask
savedHscEnv <- liftIO $ readIORef session
a <- action
liftIO $ writeIORef session savedHscEnv
return a
-- | This is a very ugly workaround don't use it.
overrideGhcUserOptions :: IOish m => ([GHCOption] -> GhcModT m b) -> GhcModT m b
overrideGhcUserOptions action = withTempSession $ do
env <- ask
opt <- options
let ghcOpts = ghcUserOptions opt
opt' = opt { ghcUserOptions = [] }
initializeFlagsWithCradle opt' (gmCradle env)
action ghcOpts
-- | This is only a transitional mechanism don't use it for new code.
toGhcModT :: IOish m => Ghc a -> GhcModT m a
toGhcModT a = do