In check
, apply ghcUserOptions after setting -Wall
This commit is contained in:
parent
4b05c20205
commit
ec1b115cc1
@ -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
|
||||
|
@ -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
|
||||
|
||||
----------------------------------------------------------------
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user