Add colours to FSI output (#2156)

* Add colours to FSI output

* Update test baselines (made whitespace consistent)

Author: saul

src/fsharp/CompileOptions.fs

@@ -1347,27 +1347,34 @@ let GetGeneratedILModuleName (t:CompilerTarget) (s:string) =
     let ext = match t with | Dll -> "dll" | Module -> "netmodule" | _ -> "exe"
     s + "." + ext
 
-
 let ignoreFailureOnMono1_1_16 f = try f() with _ -> ()
 
-let DoWithErrorColor isError f =
-    if not enableConsoleColoring then
+let foreBackColor () =
+    try
+        let c = Console.ForegroundColor // may fail, perhaps on Mac, and maybe ForegroundColor is Black
+        let b = Console.BackgroundColor // may fail, perhaps on Mac, and maybe BackgroundColor is White
+        Some (c,b)
+    with
+        e -> None
+
+let DoWithColor newColor f =
+    match enableConsoleColoring, foreBackColor() with
+    | false, _
+    | true, None ->
+        // could not get console colours, so no attempt to change colours, can not set them back
         f()
-    else
-        let foreBackColor =
-            try
-                let c = Console.ForegroundColor // may fail, perhaps on Mac, and maybe ForegroundColor is Black
-                let b = Console.BackgroundColor // may fail, perhaps on Mac, and maybe BackgroundColor is White
-                Some (c,b)
-            with
-                e -> None
-        match foreBackColor with
-          | None -> f() (* could not get console colours, so no attempt to change colours, can not set them back *)
-          | Some (c,_) ->
-              try
-                let warnColor  = if Console.BackgroundColor = ConsoleColor.White then ConsoleColor.DarkBlue else ConsoleColor.Cyan
-                let errorColor = ConsoleColor.Red
-                ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- (if isError then errorColor else warnColor))
-                f()
-              finally
-                ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- c)
+    | true, Some (c,_) ->
+        try
+            ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- newColor)
+            f()
+        finally
+            ignoreFailureOnMono1_1_16 (fun () -> Console.ForegroundColor <- c)
+
+let DoWithErrorColor isError f =
+    match foreBackColor() with
+    | None -> f()
+    | Some (_, backColor) ->
+        let warnColor = if backColor = ConsoleColor.White then ConsoleColor.DarkBlue else ConsoleColor.Cyan
+        let errorColor = ConsoleColor.Red
+        let color = if isError then errorColor else warnColor 
+        DoWithColor color f

src/fsharp/CompileOptions.fsi

@@ -92,7 +92,8 @@ val NormalizeAssemblyRefs : TcImports -> (AbstractIL.IL.ILScopeRef -> AbstractIL
 // Miscellany
 val ignoreFailureOnMono1_1_16 : (unit -> unit) -> unit
 val mutable enableConsoleColoring : bool
-val DoWithErrorColor : isError:bool -> (unit -> 'a) -> 'a
+val DoWithColor : System.ConsoleColor -> (unit -> 'a) -> 'a
+val DoWithErrorColor : bool -> (unit -> 'a) -> 'a
 val ReportTime : TcConfig -> string -> unit
 val GetAbbrevFlagSet : TcConfigBuilder -> bool -> Set<string>
 val PostProcessCompilerArgs : string Set -> string [] -> string list

src/fsharp/fsi/fsi.fs

@@ -55,6 +55,7 @@ open Microsoft.FSharp.Compiler.Tastops
 open Microsoft.FSharp.Compiler.TcGlobals
 
 open Internal.Utilities.Collections
+open Internal.Utilities.StructuredFormat
 
 type FormatOptions = Internal.Utilities.StructuredFormat.FormatOptions
 
@@ -148,6 +149,45 @@ module internal Utilities =
         let m = match typeArgs with [||] -> m | _ -> m.MakeGenericMethod(typeArgs)
         m.Invoke(obj, [|v1;v2;v3|]) |> unbox
 
+    let colorPrintL (outWriter : TextWriter) opts layout =
+        let renderer =
+            { new LayoutRenderer<NoResult,NoState> with
+                member r.Start () = NoState
+
+                member r.AddText z s =
+                    let color =
+                        match s with
+                        | Keyword _ -> ConsoleColor.Blue
+                        | TypeParameter _
+                        | Alias _
+                        | Class _ -> ConsoleColor.Cyan
+                        | StringLiteral _ -> ConsoleColor.Red
+                        | NumericLiteral _ -> ConsoleColor.Magenta
+                        | _ -> Console.ForegroundColor
+
+                    DoWithColor color (fun () -> outWriter.Write s.Value)
+
+                    z
+
+                member r.AddBreak z n =
+                    outWriter.WriteLine()
+                    outWriter.Write (String.replicate n " ")
+                    z
+
+                member r.AddTag z (tag,attrs,start) = z
+
+                member r.Finish z =
+                    outWriter.WriteLine()
+                    NoResult
+            }
+
+        layout
+        |> Internal.Utilities.StructuredFormat.Display.squash_layout opts
+        |> Layout.renderL renderer
+        |> ignore
+
+        outWriter.WriteLine()
+
 let referencedAssemblies = Dictionary<string, DateTime>()
 
 #if FX_RESHAPED_REFLECTION
@@ -237,7 +277,7 @@ type public FsiEvaluationSessionHostConfig () =
 
 /// Used to print value signatures along with their values, according to the current
 /// set of pretty printers installed in the system, and default printing rules.
-type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, g: TcGlobals, generateDebugInfo, resolvePath, outWriter) = 
+type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, g: TcGlobals, generateDebugInfo, resolvePath, outWriter: TextWriter) = 
 
     /// This printer is used by F# Interactive if no other printers apply.
     let DefaultPrintingIntercept (ienv: Internal.Utilities.StructuredFormat.IEnvironment) (obj:obj) = 
@@ -405,10 +445,8 @@ type internal FsiValuePrinter(fsi: FsiEvaluationSessionHostConfig, g: TcGlobals,
                       NicePrint.layoutValOrMember denv vref (* the rhs was suppressed by the printer, so no value to print *)
                     else
                       (NicePrint.layoutValOrMember denv vref ++ wordL (TaggedTextOps.tagText "=")) --- rhsL.Value
-        Internal.Utilities.StructuredFormat.Display.output_layout opts outWriter fullL;  
-        outWriter.WriteLine()
-    
 
+        Utilities.colorPrintL outWriter opts fullL
 
 /// Used to make a copy of input in order to include the input when displaying the error text.
 type internal FsiStdinSyphon(errorWriter: TextWriter) = 
@@ -450,10 +488,9 @@ type internal FsiStdinSyphon(errorWriter: TextWriter) =
         Utilities.ignoreAllErrors (fun () -> 
             let isError = true
             DoWithErrorColor isError (fun () ->
-                errorWriter.WriteLine();
                 writeViaBufferWithEnvironmentNewLines errorWriter (OutputDiagnosticContext "  " syphon.GetLine) err; 
                 writeViaBufferWithEnvironmentNewLines errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.errorStyle,isError))  err;
-                errorWriter.WriteLine()
+                errorWriter.WriteLine("\n")
                 errorWriter.Flush()))
 
 
@@ -498,7 +535,7 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd
                 fsiConsoleOutput.Error.WriteLine()
                 writeViaBufferWithEnvironmentNewLines fsiConsoleOutput.Error (OutputDiagnosticContext "  " fsiStdinSyphon.GetLine) err
                 writeViaBufferWithEnvironmentNewLines fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,isError)) err
-                fsiConsoleOutput.Error.WriteLine())
+                fsiConsoleOutput.Error.WriteLine("\n"))
 
     override x.ErrorCount = errorCount
 
@@ -1049,12 +1086,9 @@ type internal FsiDynamicCompiler
 
             for (TImplFile(_qname,_,mexpr,_,_)) in declaredImpls do
                 let responseL = NicePrint.layoutInferredSigOfModuleExpr false denv infoReader AccessibleFromSomewhere rangeStdin mexpr 
-                if not (Layout.isEmptyL responseL) then      
-                    fsiConsoleOutput.uprintfn "";
+                if not (Layout.isEmptyL responseL) then
                     let opts = valuePrinter.GetFsiPrintOptions()
-                    let responseL = Internal.Utilities.StructuredFormat.Display.squash_layout opts responseL
-                    Layout.renderL (Layout.channelR outWriter) responseL |> ignore
-                    fsiConsoleOutput.uprintfnn ""
+                    Utilities.colorPrintL outWriter opts responseL |> ignore
 
         // Build the new incremental state.
         let istate = {istate with  optEnv    = optEnv;
@@ -1741,7 +1775,7 @@ type internal FsiInteractionProcessor
                              initialInteractiveState) = 
 
     let mutable currState = initialInteractiveState
-    let event = Event<unit>()
+    let event = Control.Event<unit>()
     let setCurrState s = currState <- s; event.Trigger()
     let runCodeOnEventLoop errorLogger f istate = 
         try 

tests/fsharp/core/load-script/out.stdout.bsl

@@ -22,13 +22,10 @@ Test 3=================================================
 Hello
 World
 -the end
-
 namespace FSI_0002
 
-
 namespace FSI_0002
 
-
 namespace FSI_0002
 
 >