Remove more uses of stdout and stderr

6 files changed, 33 insertions, 18 deletions

diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs
index c8946d6367..ab028f603d 100644
--- a/compiler/ghci/Debugger.hs
+++ b/compiler/ghci/Debugger.hs
@@ -27,6 +27,7 @@ import GHC
 import Outputable
 import PprTyThing
 import MonadUtils
+import DynFlags
 import Exception
 
 import Control.Monad
@@ -34,7 +35,6 @@ import Data.List
 import Data.Maybe
 import Data.IORef
 
-import System.IO
 import GHC.Exts
 
 -------------------------------------
@@ -58,7 +58,8 @@ pprintClosureCommand bindThings force str = do
   -- Finally, print the Terms
   unqual  <- GHC.getPrintUnqual
   docterms <- mapM showTerm terms
-  liftIO $ (printForUser stdout unqual . vcat)
+  dflags <- getDynFlags
+  liftIO $ (printOutputForUser dflags unqual . vcat)
            (zipWith (\id docterm -> ppr id <+> char '=' <+> docterm)
                     ids
                     docterms)
@@ -226,4 +227,4 @@ pprTypeAndContents id = do
 traceOptIf :: GhcMonad m => DynFlag -> SDoc -> m ()
 traceOptIf flag doc = do
   dflags <- GHC.getSessionDynFlags
-  when (dopt flag dflags) $ liftIO $ printForUser stderr alwaysQualify doc
+  when (dopt flag dflags) $ liftIO $ printInfoForUser dflags alwaysQualify doc
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index aa646ec847..5fae709d62 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -44,6 +44,8 @@ module DynFlags (
         fFlags, fWarningFlags, fLangFlags, xFlags,
         wayNames, dynFlagDependencies,
 
+        printOutputForUser, printInfoForUser,
+
         -- ** Safe Haskell
         SafeHaskellMode(..),
         safeHaskellOn, safeImportsOn, safeLanguageOn, safeInferOn,
@@ -995,6 +997,16 @@ newtype FlushErr = FlushErr (IO ())
 defaultFlushErr :: FlushErr
 defaultFlushErr = FlushErr $ hFlush stderr
 
+printOutputForUser :: DynFlags -> PrintUnqualified -> SDoc -> IO ()
+printOutputForUser = printSevForUser SevOutput
+
+printInfoForUser :: DynFlags -> PrintUnqualified -> SDoc -> IO ()
+printInfoForUser = printSevForUser SevInfo
+
+printSevForUser :: Severity -> DynFlags -> PrintUnqualified -> SDoc -> IO ()
+printSevForUser sev dflags unqual doc
+    = log_action dflags sev noSrcSpan (mkUserStyle unqual AllTheWay) doc
+
 {-
 Note [Verbosity levels]
 ~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 42147dce94..43b60afae0 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -84,7 +84,6 @@ import GHC.Exts
 import Data.Array
 import Exception
 import Control.Concurrent
-import System.IO
 import System.IO.Unsafe
 
 -- -----------------------------------------------------------------------------
@@ -707,8 +706,9 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
                         WARN(True, text (":print failed to calculate the "
                                            ++ "improvement for a type")) hsc_env
                Just subst -> do
-                 when (dopt Opt_D_dump_rtti (hsc_dflags hsc_env)) $
-                      printForUser stderr alwaysQualify $
+                 let dflags = hsc_dflags hsc_env
+                 when (dopt Opt_D_dump_rtti dflags) $
+                      printInfoForUser dflags alwaysQualify $
                       fsep [text "RTTI Improvement for", ppr id, equals, ppr subst]
 
                  let ic' = extendInteractiveContext
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 08cfb85979..08c5cdb0ec 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -49,7 +49,6 @@ import FastString
 import Panic
 import Util
 
-import System.IO
 import Data.IORef
 import qualified Data.Set as Set
 import Control.Monad
@@ -444,7 +443,8 @@ traceHiDiffs = traceOptIf Opt_D_dump_hi_diffs
 
 traceOptIf :: DynFlag -> SDoc -> TcRnIf m n ()  -- No RdrEnv available, so qualify everything
 traceOptIf flag doc = ifDOptM flag $
-                      liftIO (printForUser stderr alwaysQualify doc)
+                          do dflags <- getDynFlags
+                             liftIO (printInfoForUser dflags alwaysQualify doc)
 
 traceOptTcRn :: DynFlag -> SDoc -> TcRn ()
 -- Output the message, with current location if opt_PprStyle_Debug
@@ -459,7 +459,7 @@ traceOptTcRn flag doc = ifDOptM flag $ do
 dumpTcRn :: SDoc -> TcRn ()
 dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv
                   ; dflags <- getDynFlags
-                  ; liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
+                  ; liftIO (printInfoForUser dflags (mkPrintUnqualified dflags rdr_env) doc) }
 
 debugDumpTcRn :: SDoc -> TcRn ()
 debugDumpTcRn doc | opt_NoDebugOutput = return ()
diff --git a/compiler/vectorise/Vectorise/Monad.hs b/compiler/vectorise/Vectorise/Monad.hs
index 426682cea8..2784868d8e 100644
--- a/compiler/vectorise/Vectorise/Monad.hs
+++ b/compiler/vectorise/Vectorise/Monad.hs
@@ -43,8 +43,6 @@ import Name
 import ErrUtils
 import Outputable
 
-import System.IO
-
 
 -- |Run a vectorisation computation.
 --
@@ -69,7 +67,9 @@ initV hsc_env guts info thing_inside
        ; return res
        }
   where
-    dumpIfVtTrace = dumpIfSet_dyn (hsc_dflags hsc_env) Opt_D_dump_vt_trace
+    dflags = hsc_dflags hsc_env
+
+    dumpIfVtTrace = dumpIfSet_dyn dflags Opt_D_dump_vt_trace
     
     bindsToIds (NonRec v _)   = [v]
     bindsToIds (Rec    binds) = map fst binds
@@ -100,7 +100,7 @@ initV hsc_env guts info thing_inside
                Yes genv _ x -> return $ Just (new_info genv, x)
                No reason    -> do { unqual <- mkPrintUnqualifiedDs
                                   ; liftIO $ 
-                                      printForUser stderr unqual $ 
+                                      printInfoForUser dflags unqual $ 
                                         mkDumpDoc "Warning: vectorisation failure:" reason
                                   ; return Nothing
                                   }
diff --git a/compiler/vectorise/Vectorise/Monad/Base.hs b/compiler/vectorise/Vectorise/Monad/Base.hs
index 91a9552a7e..8483aa8002 100644
--- a/compiler/vectorise/Vectorise/Monad/Base.hs
+++ b/compiler/vectorise/Vectorise/Monad/Base.hs
@@ -37,7 +37,6 @@ import DynFlags
 import StaticFlags
 
 import Control.Monad
-import System.IO (stderr)
 
 
 -- The Vectorisation Monad ----------------------------------------------------
@@ -112,8 +111,9 @@ maybeCantVectoriseM s d p
 --
 emitVt :: String -> SDoc -> VM () 
 emitVt herald doc
-  = liftDs $
-      liftIO . printForUser stderr alwaysQualify $
+  = liftDs $ do
+      dflags <- getDynFlags
+      liftIO . printInfoForUser dflags alwaysQualify $
         hang (text herald) 2 doc
 
 -- |Output a trace message if -ddump-vt-trace is active.
@@ -140,7 +140,8 @@ dumpOptVt flag header doc
 dumpVt :: String -> SDoc -> VM ()
 dumpVt header doc 
   = do { unqual <- liftDs mkPrintUnqualifiedDs
-       ; liftIO $ printForUser stderr unqual (mkDumpDoc header doc)
+       ; dflags <- liftDs getDynFlags
+       ; liftIO $ printInfoForUser dflags unqual (mkDumpDoc header doc)
        }
 
 
@@ -185,8 +186,9 @@ tryErrV (VM p) = VM $ \bi genv lenv ->
     case r of
       Yes genv' lenv' x -> return (Yes genv' lenv' (Just x))
       No reason         -> do { unqual <- mkPrintUnqualifiedDs
+                              ; dflags <- getDynFlags
                               ; liftIO $ 
-                                  printForUser stderr unqual $ 
+                                  printInfoForUser dflags unqual $
                                     text "Warning: vectorisation failure:" <+> reason
                               ; return (Yes genv  lenv  Nothing)
                               }