Commit a7b1d219 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Add defaultLogActionHPrintDoc to DynFlags

We now use this function rather than Outputable.{printSDoc,printErrs}.

Outputable is arguably a better home for the function, but putting it
in DynFlags should dissuade people from using it inappropriately (in
particular, nothing other than the default hooks should have stdout
or stderr hardcoded).

Not exporting it at all would also be an option, but exporting it with
an ungainly name will make it slightly easier for people who want to
send output to other Handles for some reason.
parent 4fa3f16d
...@@ -66,6 +66,7 @@ module DynFlags ( ...@@ -66,6 +66,7 @@ module DynFlags (
defaultDynFlags, -- Settings -> DynFlags defaultDynFlags, -- Settings -> DynFlags
initDynFlags, -- DynFlags -> IO DynFlags initDynFlags, -- DynFlags -> IO DynFlags
defaultLogAction, defaultLogAction,
defaultLogActionHPrintDoc,
defaultFlushOut, defaultFlushOut,
defaultFlushErr, defaultFlushErr,
...@@ -114,6 +115,7 @@ import Constants ( mAX_CONTEXT_REDUCTION_DEPTH ) ...@@ -114,6 +115,7 @@ import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic import Panic
import Util import Util
import Maybes ( orElse ) import Maybes ( orElse )
import qualified Pretty
import SrcLoc import SrcLoc
import FastString import FastString
import Outputable import Outputable
...@@ -965,15 +967,22 @@ type LogAction = Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO () ...@@ -965,15 +967,22 @@ type LogAction = Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
defaultLogAction :: LogAction defaultLogAction :: LogAction
defaultLogAction severity srcSpan style msg defaultLogAction severity srcSpan style msg
= case severity of = case severity of
SevOutput -> printSDoc msg style SevOutput -> printSDoc msg style
SevInfo -> printErrs msg style SevInfo -> printErrs msg style
SevFatal -> printErrs msg style SevFatal -> printErrs msg style
_ -> do hPutChar stderr '\n' _ -> do hPutChar stderr '\n'
printErrs (mkLocMessage severity srcSpan msg) style printErrs (mkLocMessage severity srcSpan msg) style
-- careful (#2302): printErrs prints in UTF-8, whereas -- careful (#2302): printErrs prints in UTF-8, whereas
-- converting to string first and using hPutStr would -- converting to string first and using hPutStr would
-- just emit the low 8 bits of each unicode char. -- just emit the low 8 bits of each unicode char.
where printSDoc = defaultLogActionHPrintDoc stdout
printErrs = defaultLogActionHPrintDoc stderr
defaultLogActionHPrintDoc :: Handle -> SDoc -> PprStyle -> IO ()
defaultLogActionHPrintDoc h d sty
= do Pretty.printDoc Pretty.PageMode h (runSDoc d (initSDocContext sty))
hFlush h
newtype FlushOut = FlushOut (IO ()) newtype FlushOut = FlushOut (IO ())
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment