diff options
Diffstat (limited to 'compiler/main')
| -rw-r--r-- | compiler/main/DynFlags.hs | 13 | ||||
| -rw-r--r-- | compiler/main/ErrUtils.lhs | 1 | ||||
| -rw-r--r-- | compiler/main/ErrUtils.lhs-boot | 1 |
3 files changed, 13 insertions, 2 deletions
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 64ae9b5699..7292ce5cd2 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -79,6 +79,7 @@ module DynFlags ( defaultFatalMessager, defaultLogAction, defaultLogActionHPrintDoc, + defaultLogActionHPutStrDoc, defaultFlushOut, defaultFlushErr, @@ -1384,6 +1385,7 @@ defaultLogAction dflags severity srcSpan style msg = case severity of SevOutput -> printSDoc msg style SevDump -> printSDoc (msg $$ blankLine) style + SevInteractive -> putStrSDoc msg style SevInfo -> printErrs msg style SevFatal -> printErrs msg style _ -> do hPutChar stderr '\n' @@ -1391,8 +1393,9 @@ defaultLogAction dflags severity srcSpan style msg -- 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 dflags stdout - printErrs = defaultLogActionHPrintDoc dflags stderr + where printSDoc = defaultLogActionHPrintDoc dflags stdout + printErrs = defaultLogActionHPrintDoc dflags stderr + putStrSDoc = defaultLogActionHPutStrDoc dflags stdout defaultLogActionHPrintDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO () defaultLogActionHPrintDoc dflags h d sty @@ -1400,6 +1403,12 @@ defaultLogActionHPrintDoc dflags h d sty Pretty.printDoc Pretty.PageMode (pprCols dflags) h doc hFlush h +defaultLogActionHPutStrDoc :: DynFlags -> Handle -> SDoc -> PprStyle -> IO () +defaultLogActionHPutStrDoc dflags h d sty + = do let doc = runSDoc d (initSDocContext dflags sty) + hPutStr h (Pretty.render doc) + hFlush h + newtype FlushOut = FlushOut (IO ()) defaultFlushOut :: FlushOut diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 3fd92ed473..f9f4387120 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -78,6 +78,7 @@ type MsgDoc = SDoc data Severity = SevOutput | SevDump + | SevInteractive | SevInfo | SevWarning | SevError diff --git a/compiler/main/ErrUtils.lhs-boot b/compiler/main/ErrUtils.lhs-boot index 6f4a373313..fc99c5afde 100644 --- a/compiler/main/ErrUtils.lhs-boot +++ b/compiler/main/ErrUtils.lhs-boot @@ -7,6 +7,7 @@ import SrcLoc (SrcSpan) data Severity = SevOutput | SevDump + | SevInteractive | SevInfo | SevWarning | SevError |