Commit a7b1d219 authored by Ian Lynagh's avatar Ian Lynagh

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 (
defaultDynFlags, -- Settings -> DynFlags
initDynFlags, -- DynFlags -> IO DynFlags
defaultLogAction,
defaultLogActionHPrintDoc,
defaultFlushOut,
defaultFlushErr,
......@@ -114,6 +115,7 @@ import Constants ( mAX_CONTEXT_REDUCTION_DEPTH )
import Panic
import Util
import Maybes ( orElse )
import qualified Pretty
import SrcLoc
import FastString
import Outputable
......@@ -965,15 +967,22 @@ type LogAction = Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
defaultLogAction :: LogAction
defaultLogAction severity srcSpan style msg
= case severity of
SevOutput -> printSDoc msg style
SevInfo -> printErrs msg style
SevFatal -> printErrs msg style
_ -> do hPutChar stderr '\n'
printErrs (mkLocMessage severity srcSpan msg) style
-- careful (#2302): printErrs prints in UTF-8, whereas
-- converting to string first and using hPutStr would
-- just emit the low 8 bits of each unicode char.
= case severity of
SevOutput -> printSDoc msg style
SevInfo -> printErrs msg style
SevFatal -> printErrs msg style
_ -> do hPutChar stderr '\n'
printErrs (mkLocMessage severity srcSpan msg) style
-- careful (#2302): printErrs prints in UTF-8, whereas
-- converting to string first and using hPutStr would
-- 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 ())
......
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