Merge pull request #317 from DanielG/dev

Workaround for #273 + more release-prep
This commit is contained in:
Kazu Yamamoto 2014-08-14 09:27:40 +09:00
commit b3b1175d6e
10 changed files with 47 additions and 17 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,10 +30,10 @@ debugInfo = cradle >>= \c -> convert' =<< do
]
where
simpleCompilerOption = options >>= \op ->
return $ CompilerOptions (ghcOpts op) [] []
return $ CompilerOptions (ghcUserOptions op) [] []
fromCabalFile c = options >>= \opts -> do
pkgDesc <- parseCabalFile $ fromJust $ cradleCabalFile c
liftIO $ getCompilerOptions (ghcOpts opts) c pkgDesc
liftIO $ getCompilerOptions (ghcUserOptions opts) c pkgDesc
----------------------------------------------------------------

View File

@ -88,8 +88,8 @@ withCmdFlags :: GhcMonad m => [GHCOption] -> m a -> m a
withCmdFlags flags body = G.gbracket setup teardown (\_ -> body)
where
setup = do
dflags <- G.getSessionDynFlags >>= addCmdOpts flags
void $ G.setSessionDynFlags dflags
dflags <- G.getSessionDynFlags
void $ G.setSessionDynFlags =<< addCmdOpts flags dflags
return dflags
teardown = void . G.setSessionDynFlags

View File

@ -61,6 +61,7 @@ newtype SymbolDb = SymbolDb (Map Symbol [ModuleString])
-- | When introducing incompatible changes to the 'symbolCache' file format
-- increment this version number.
symbolCacheVersion :: Integer
symbolCacheVersion = 0
-- | Filename of the symbol table cache file.

View File

@ -64,7 +64,7 @@ withLogger :: IOish m
-> GhcModT m (Either String String)
withLogger setDF body = ghandle sourceError $ do
logref <- liftIO newLogRef
wflags <- filter ("-fno-warn" `isPrefixOf`) . ghcOpts <$> options
wflags <- filter ("-fno-warn" `isPrefixOf`) . ghcUserOptions <$> options
withDynFlags (setLogger logref . setDF) $
withCmdFlags wflags $ do
body

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
@ -201,7 +204,7 @@ initializeFlagsWithCradle opt c
where
mCradleFile = cradleCabalFile c
cabal = isJust mCradleFile
ghcopts = ghcOpts opt
ghcopts = ghcUserOptions opt
withCabal = do
pkgDesc <- parseCabalFile $ fromJust mCradleFile
compOpts <- liftIO $ getCompilerOptions ghcopts c pkgDesc
@ -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

View File

@ -28,7 +28,8 @@ newtype LineSeparator = LineSeparator String
data Options = Options {
outputStyle :: OutputStyle
, hlintOpts :: [String]
, ghcOpts :: [GHCOption]
-- | GHC command line options set on the @ghc-mod@ command line
, ghcUserOptions:: [GHCOption]
-- | If 'True', 'browse' also returns operators.
, operators :: Bool
-- | If 'True', 'browse' also returns types.
@ -44,7 +45,7 @@ defaultOptions :: Options
defaultOptions = Options {
outputStyle = PlainStyle
, hlintOpts = []
, ghcOpts = []
, ghcUserOptions= []
, operators = False
, detailed = False
, qualified = False

View File

@ -63,7 +63,7 @@ argspec = [ Option "l" ["tolisp"]
(ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt")
"hlint options"
, Option "g" ["ghcOpt"]
(ReqArg (\g opts -> opts { ghcOpts = g : ghcOpts opts }) "ghcOpt")
(ReqArg (\g opts -> opts { ghcUserOptions = g : ghcUserOptions opts }) "ghcOpt")
"GHC options"
, Option "o" ["operators"]
(NoArg (\opts -> opts { operators = True }))
@ -138,7 +138,8 @@ main = flip E.catches handlers $ do
cmd -> E.throw (NoSuchCommand cmd)
case res of
Right s -> putStr s
Left e -> error $ show e
Left (GMENoMsg) -> hPutStrLn stderr "Unknown error"
Left (GMEString msg) -> hPutStrLn stderr msg
where
handlers = [Handler (handleThenExit handler1), Handler (handleThenExit handler2)]
handleThenExit handler e = handler e >> exitFailure

View File

@ -58,7 +58,7 @@ argspec = [ Option "b" ["boundary"]
(NoArg (\opts -> opts { outputStyle = LispStyle }))
"print as a list of Lisp"
, Option "g" []
(ReqArg (\s opts -> opts { ghcOpts = s : ghcOpts opts }) "flag") "specify a ghc flag"
(ReqArg (\s opts -> opts { ghcUserOptions = s : ghcUserOptions opts }) "flag") "specify a ghc flag"
]
usage :: String