fixes issues with rendering progress, added --progress option (off by default)

Author: OlegZee

core/ExecCore.fs

@@ -238,7 +238,7 @@ module internal ExecCore =
                     true
                 <| target
 
-            let progressSink = Progress.openProgress (getDurationDeps ctx getDeps) options.Threads targets
+            let progressSink = Progress.openProgress (getDurationDeps ctx getDeps) options.Threads targets options.Progress
             let stepCtx = {ctx with NeedRebuild = check_rebuild; Progress = progressSink}
 
             try
@@ -251,7 +251,7 @@ module internal ExecCore =
                 List.map (makeTarget ctx) >> (runTargets ctx options)
             )
             // some long text (looks awkward) to remove progress message. I do not think it worth spending another half an hour to design proper solution
-            ctx.Logger.Log Message "                                     \n\n\tBuild completed in %A\n" (System.DateTime.Now - start)
+            ctx.Logger.Log Message "                                     \n\n    Build completed in %A\n" (System.DateTime.Now - start)
         with
             | exn ->
                 let th = if options.FailOnError then raiseError else reportError

core/ExecTypes.fs

@@ -41,6 +41,9 @@ type ExecOptions = {
 
     /// Dump dependencies only
     DumpDeps: bool
+
+    /// Dump dependencies only
+    Progress: bool
 } with
 static member Default =
     {
@@ -59,6 +62,7 @@ static member Default =
     DbFileName = ".xake"
     DryRun = false
     DumpDeps = false
+    Progress = false
     }
 end
 

core/Logging.fs

@@ -113,25 +113,26 @@ module private ConsoleSink =
         | Verbose -> Some (ConsoleColor.Magenta, ConsoleColor.DarkMagenta)
         | _ -> None
 
+    let fmtTs (ts:System.TimeSpan) =
+        (if ts.TotalHours >= 1.0 then "h'h'\ mm'm'\ ss's'"
+        else if ts.TotalMinutes >= 1.0 then "mm'm'\ ss's'"
+        else "'0m 'ss's'")
+        |> ts.ToString
+
+    let po = MailboxProcessor.Start(fun mbox ->
 
-    let po = MailboxProcessor.Start(fun mbox -> 
-        let fmtTs (ts:System.TimeSpan) =
-            (if ts.TotalHours >= 1.0 then "h'h'\ mm'm'\ ss's'"
-            else if ts.TotalMinutes >= 1.0 then "mm'm'\ ss's'"
-            else "'0m 'ss's'")
-            |> ts.ToString
         let rec loop (progressMessage) =
-            let wipe pos =
-                match progressMessage with
-                | None -> ()
-                | Some x ->
-                    let extraChars = (String.length x) - pos
-                    System.Console.Write (if extraChars > 0 then (String.replicate extraChars " ") else "")
+            let wipeProgressMessage () =
+                let len = progressMessage |> Option.fold (fun _ -> String.length) 0
+                // printfn "cleft: %A len: %d" Console.CursorLeft len
+                match len - Console.CursorLeft with
+                | e when e > 0 -> System.Console.Write (String.replicate e " ")
+                | _ -> ()
             let renderProgress = function
                 | Some (outputString: string) ->
                     Console.ForegroundColor <- ConsoleColor.White
                     Console.Write outputString
-                    wipe outputString.Length
+                    wipeProgressMessage()
 
                     Console.ResetColor()
                 | None -> ()
@@ -141,17 +142,17 @@ module private ConsoleSink =
                 match msg with
                 | Message(level, text) ->
                     match level |> levelToColor with
-                    | Some (color, text_color) ->
-                        let levelStr = sprintf "[%s] " (LevelToString level)
+                    | Some (color, textColor) ->
+                        // in case of CRLF in the string make sure we washed out the progress message
 
                         Console.ForegroundColor <- color
-                        Console.Write levelStr
+                        Console.Write (sprintf "\r[%s] " (LevelToString level))
 
-                        Console.ForegroundColor <- text_color
+                        Console.ForegroundColor <- textColor
                         text |> System.Console.Write
 
-                        wipe (levelStr.Length + text.Length)
-                        System.Console.WriteLine ""
+                        wipeProgressMessage()
+                        System.Console.WriteLine()
                         renderProgress progressMessage
 
                     | _ -> ()
@@ -163,13 +164,14 @@ module private ConsoleSink =
                         | a when a >= 100 || a < 0 || timeLeft.TotalMilliseconds < 100.0 -> ""
                         | pct ->
                             let barlen = pct * ProgressBarLen / 100
-                            sprintf "%3d%% [%s%s] %s\r" pct (String.replicate barlen "=") (String.replicate (ProgressBarLen - barlen) "-") (fmtTs timeLeft)
+                            sprintf "\r%3d%% Complete [%s%s] %s Left" pct (String.replicate barlen "=") (String.replicate (ProgressBarLen - barlen) " ") (fmtTs timeLeft)
+                        |> Some
 
-                    renderProgress (Some outputString)
-                    return! loop (Some outputString)
+                    renderProgress outputString
+                    return! loop outputString
 
                 | Flush ch ->
-                    wipe 0
+                    wipeProgressMessage()
                     Console.Write "\r"
                     ch.Reply ()
                     return! loop None
@@ -205,7 +207,9 @@ let ConsoleLogger =
 
 /// Ensures all logs finished pending output.
 let FlushLogs () =
-    ConsoleSink.po.PostAndReply (ConsoleSink.Flush, 100) |> ignore
+    try
+        ConsoleSink.po.PostAndReply (ConsoleSink.Flush, 200) |> ignore
+    with _ -> ()
 
 /// Draws a progress bar to console log.
 let WriteConsoleProgress =

core/Program.fs

@@ -34,6 +34,7 @@ Options:
   target1;target2;..targetN -- execute the targets simultaneously
   -d <name>=<value>   - defines a script variable value
   --dryrun            - defines a script variable value
+  --progress, -p      - display progress indicator
 
             """
             exit(0)
@@ -55,6 +56,8 @@ Options:
             ({optionsSoFar with DryRun = true}, TopLevel)
         | "--dump" -> 
             ({optionsSoFar with DumpDeps = true}, TopLevel)
+        | "--progress" | "-p" -> 
+            ({optionsSoFar with Progress = true}, TopLevel)
 
         | x when x.StartsWith("-") || x.StartsWith("/") ->
             printfn "Option '%s' is unrecognized" x

core/Progress.fs

@@ -189,7 +189,7 @@ let estimateEndTime getDurationDeps threadCount groups =
 /// <param name="getDurationDeps">gets the dependency duration in ms</param>
 /// <param name="threadCount"></param>
 /// <param name="goals"></param>
-let openProgress getDurationDeps threadCount goals = 
+let openProgress getDurationDeps threadCount goals toConsole = 
 
     let progressBar = WindowsProgress.createTaskbarIndicator() |> Impl.ignoreFailures
     let machine_state = {Cpu = BusyUntil 0<ms> |> List.replicate threadCount; Tasks = Map.empty}
@@ -217,7 +217,8 @@ let openProgress getDurationDeps threadCount goals =
         let percentDone = timePassed * 100 / (timePassed + leftTime) |> int
         let progressData = System.TimeSpan.FromMilliseconds (leftTime/1<ms> |> float), percentDone
         do ProgressMessage.Progress progressData |> progressBar
-        do WriteConsoleProgress progressData
+        if toConsole then
+            do WriteConsoleProgress progressData
 
     let updTime = ref System.DateTime.Now
     let advanceRunningTime rt =