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

simplified code.

Browse Source
This commit is contained in:
Kazu Yamamoto 2010-04-30 15:09:24 +09:00
parent 2345765077
commit 24fd6f28df
1 changed files with 7 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
Check.hs
View File

@ -35,7 +35,7 @@ check fileName = ghandle ignore $ runGhc (Just libdir) $ do
initSession = do initSession = do
dflags <- getSessionDynFlags dflags <- getSessionDynFlags
(dflags',_,_) <- parseDynamicFlags dflags cmdOptions (dflags',_,_) <- parseDynamicFlags dflags cmdOptions
setSessionDynFlags $ setTarget $ setGhcPackage $ setImportPath dflags' setSessionDynFlags $ setFlags dflags'
setTargetFile file = do setTargetFile file = do
target <- guessTarget file Nothing target <- guessTarget file Nothing
setTargets [target] setTargets [target]
@ -46,30 +46,22 @@ check fileName = ghandle ignore $ runGhc (Just libdir) $ do
refLogger :: IORef [String] -> WarnErrLogger refLogger :: IORef [String] -> WarnErrLogger
refLogger ref Nothing = do refLogger ref Nothing = do
warns <- map showErrMsg . bagToList <$> getWarnings warns <- map showErrMsg . reverse . bagToList <$> getWarnings
liftIO $ writeIORef ref warns liftIO $ writeIORef ref warns
clearWarnings clearWarnings
refLogger ref (Just e) = do refLogger ref (Just e) = do
let errs = map showErrMsg . bagToList . srcErrorMessages $ e let errs = map showErrMsg . reverse . bagToList . srcErrorMessages $ e
liftIO $ writeIORef ref errs liftIO $ writeIORef ref errs
clearWarnings clearWarnings
---------------------------------------------------------------- ----------------------------------------------------------------
setImportPath :: DynFlags -> DynFlags setFlags :: DynFlags -> DynFlags
setImportPath d = d { setFlags d = d {
importPaths = importPaths d ++ ["..","../..","../../..","../../../../.."] importPaths = importPaths d ++ ["..","../..","../../..","../../../../.."]
} , packageFlags = ExposePackage "ghc" : packageFlags d
setGhcPackage :: DynFlags -> DynFlags
setGhcPackage d = d {
packageFlags = ExposePackage "ghc" : packageFlags d
, ghcLink = NoLink , ghcLink = NoLink
} , hscTarget = HscNothing
setTarget :: DynFlags -> DynFlags
setTarget d = d {
hscTarget = HscNothing
} }
---------------------------------------------------------------- ----------------------------------------------------------------