Don't swallow ghc's verbose output

This commit is contained in:
Daniel Gröber 2015-09-08 06:44:02 +02:00
parent dbf215a35b
commit 6ad71af001
4 changed files with 27 additions and 11 deletions

View File

@ -3,18 +3,19 @@
module Language.Haskell.GhcMod.DynFlags where
import Control.Applicative
import Control.Monad (void)
import GHC (DynFlags(..), GhcMode(..), GhcLink(..), HscTarget(..))
import Control.Monad
import GHC
import qualified GHC as G
import GHC.Paths (libdir)
import GhcMonad
import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Types
import Language.Haskell.GhcMod.DebugLogger
import System.IO.Unsafe (unsafePerformIO)
import Prelude
setEmptyLogger :: DynFlags -> DynFlags
setEmptyLogger df = Gap.setLogAction df $ \_ _ _ _ _ -> return ()
setDebugLogger :: (String -> IO ()) -> DynFlags -> DynFlags
setDebugLogger put df = do
Gap.setLogAction df (debugLogAction put)
-- * Fast
-- * Friendly to foreign export

View File

@ -22,9 +22,15 @@ module Language.Haskell.GhcMod.Output (
, gmErrStr
, gmPutStrLn
, gmErrStrLn
, gmPutStrIO
, gmErrStrIO
, gmReadProcess
, gmUnsafePutStr
, gmUnsafeErrStr
, stdoutGateway
) where
@ -105,15 +111,21 @@ gmPutStr, gmPutStrLn, gmErrStr, gmErrStrLn
:: (MonadIO m, GmOut m) => String -> m ()
gmPutStr str = do
putOut <- fst `liftM` outputFns
putOut $ toGmLines str
putOut <- gmPutStrIO
putOut str
gmErrStr str = do
putErr <- gmErrStrIO
putErr str
gmPutStrLn = gmPutStr . (++"\n")
gmErrStrLn = gmErrStr . (++"\n")
gmErrStr str = do
putErr <- snd `liftM` outputFns
putErr $ toGmLines str
gmPutStrIO, gmErrStrIO :: (GmOut m, MonadIO mi) => m (String -> mi ())
gmPutStrIO = ((. toGmLines) . fst) `liftM` outputFns
gmErrStrIO = ((. toGmLines) . snd) `liftM` outputFns
-- | Only use these when you're sure there are no other writers on stdout
gmUnsafePutStr, gmUnsafeErrStr

View File

@ -38,6 +38,7 @@ import Language.Haskell.GhcMod.Utils as U
import Language.Haskell.GhcMod.FileMapping
import Language.Haskell.GhcMod.LightGhc
import Language.Haskell.GhcMod.CustomPackageDb
import Language.Haskell.GhcMod.Output
import Data.Maybe
import Data.Monoid as Monoid
@ -131,8 +132,9 @@ runGmlTWith efnmns' mdf wrapper action = do
(text "Initializing GHC session with following options")
(intercalate " " $ map (("\""++) . (++"\"")) opts')
putErr <- gmErrStrIO
initSession opts' $
setModeSimple >>> setEmptyLogger >>> mdf
setModeSimple >>> setDebugLogger putErr >>> mdf
mappedStrs <- getMMappedFilePaths
let targetStrs = mappedStrs ++ map moduleNameString mns ++ cfns

View File

@ -112,6 +112,7 @@ Library
Language.Haskell.GhcMod.Cradle
Language.Haskell.GhcMod.CustomPackageDb
Language.Haskell.GhcMod.Debug
Language.Haskell.GhcMod.DebugLogger
Language.Haskell.GhcMod.Doc
Language.Haskell.GhcMod.DynFlags
Language.Haskell.GhcMod.Error