Only use debugLogger when loglevel >= GmDebug

This commit is contained in:
Daniel Gröber 2015-09-16 05:09:55 +02:00
parent 413bac085d
commit 380acdaee0
2 changed files with 12 additions and 1 deletions

View File

@ -13,6 +13,10 @@ import Language.Haskell.GhcMod.DebugLogger
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import Prelude import Prelude
setEmptyLogger :: DynFlags -> DynFlags
setEmptyLogger df =
Gap.setLogAction df $ \_ _ _ _ _ -> return ()
setDebugLogger :: (String -> IO ()) -> DynFlags -> DynFlags setDebugLogger :: (String -> IO ()) -> DynFlags -> DynFlags
setDebugLogger put df = do setDebugLogger put df = do
Gap.setLogAction df (debugLogAction put) Gap.setLogAction df (debugLogAction put)

View File

@ -137,9 +137,13 @@ runGmlTWith efnmns' mdf wrapper action = do
(text "Initializing GHC session with following options") (text "Initializing GHC session with following options")
(intercalate " " $ map (("\""++) . (++"\"")) opts') (intercalate " " $ map (("\""++) . (++"\"")) opts')
GhcModLog { gmLogLevel = Just level } <- gmlHistory
putErr <- gmErrStrIO putErr <- gmErrStrIO
let setLogger | level >= GmDebug = setDebugLogger putErr
| otherwise = setEmptyLogger
initSession opts' $ initSession opts' $
setModeSimple >>> setDebugLogger putErr >>> mdf setModeSimple >>> setLogger >>> mdf
mappedStrs <- getMMappedFilePaths mappedStrs <- getMMappedFilePaths
let targetStrs = mappedStrs ++ map moduleNameString mns ++ cfns let targetStrs = mappedStrs ++ map moduleNameString mns ++ cfns
@ -441,6 +445,9 @@ loadTargets opts targetStrs = do
loadTargets' Intelligent loadTargets' Intelligent
else else
loadTargets' Simple loadTargets' Simple
gmLog GmDebug "loadTargets" $ text "Loading done"
where where
relativize (Target (TargetFile filePath phase) taoc src) = do relativize (Target (TargetFile filePath phase) taoc src) = do
crdl <- cradle crdl <- cradle