Don't swallow ghc's verbose output
This commit is contained in:
parent
dbf215a35b
commit
6ad71af001
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user