Merge branch 'dev'

Author: OlegZee

core/CommonTasks.fs

@@ -42,8 +42,8 @@ module internal impl =
                 return proc.ExitCode
         }
 
-    type SystemOptionsType = {LogPrefix:string; StdOutLevel: Level; ErrOutLevel: Level; EnvVars: (string * string) list}
-    let SystemOptions = {LogPrefix = ""; StdOutLevel = Level.Info; ErrOutLevel = Level.Error; EnvVars = []}
+    type SystemOptions = {LogPrefix:string; StdOutLevel: string -> Level; ErrOutLevel: string -> Level; EnvVars: (string * string) list}
+    with static member Default = {LogPrefix = ""; StdOutLevel = (fun _ -> Level.Info); ErrOutLevel = (fun _ -> Level.Error); EnvVars = []}
 
     /// <summary>
     /// Executes system command. E.g. '_system SystemOptions "dir" []'
@@ -59,8 +59,8 @@ module internal impl =
         do! trace Level.Debug "[system] envvars: '%A'" settings.EnvVars
         do! trace Level.Debug "[system] args: '%A'" args
 
-        let handleErr = log settings.ErrOutLevel "%s %s" settings.LogPrefix
-        let handleStd = log settings.StdOutLevel  "%s %s" settings.LogPrefix
+        let handleErr s = log (settings.ErrOutLevel s) "%s %s" settings.LogPrefix s
+        let handleStd s = log (settings.StdOutLevel s) "%s %s" settings.LogPrefix s
 
         return
             if isWindows && not <| isExt cmd ".exe" then
@@ -79,7 +79,7 @@ open impl
 let system cmd args =
   action {
     do! trace Info "[system] starting '%s'" cmd
-    let! exitCode = _system SystemOptions cmd (args |> String.concat " ")
+    let! exitCode = _system SystemOptions.Default cmd (args |> String.concat " ")
     do! trace Info "[system] сompleted '%s' exitcode: %d" cmd exitCode
 
     return exitCode

core/DotnetTasks.fs

@@ -228,6 +228,12 @@ module DotnetTasks =
         let platformStr = function
             |AnyCpu -> "anycpu" |AnyCpu32Preferred -> "anycpu32preferred" |ARM -> "arm" | X64 -> "x64" | X86 -> "x86" |Itanium -> "itanium"
 
+        /// Parses the compiler output and returns messageLevel
+        let levelFromString defaultLevel (text:string) :Level =
+            if text.IndexOf "): warning " > 0 then Level.Warning
+            else if text.IndexOf "): error " > 0 then Level.Error
+            else defaultLevel
+
         end // end of Impl module
 
     /// C# compiler task
@@ -321,9 +327,10 @@ module DotnetTasks =
             do! trace Debug "Command line: '%s %s'" fwkInfo.CscTool (args |> Seq.map Impl.escapeArgument |> String.concat "\r\n\t")
 
             let options = {
-                SystemOptions with
+                SystemOptions.Default with
                     LogPrefix = "[CSC] "
-                    StdOutLevel = Level.Verbose     // consider standard compiler output too noisy
+                    StdOutLevel = fun _ -> Level.Verbose
+                    ErrOutLevel = Impl.levelFromString Level.Verbose
                     EnvVars = fwkInfo.EnvVars
                 }
             let! exitCode = _system options fwkInfo.CscTool commandLine
@@ -470,9 +477,10 @@ module DotnetTasks =
             do! trace Debug "Command line: '%s'" args
 
             let options = {
-                SystemOptions with
+                SystemOptions.Default with
                     LogPrefix = pfx
-                    StdOutLevel = Level.Info     // consider standard compiler output too noisy
+                    StdOutLevel = fun _ -> Level.Info
+                    ErrOutLevel = Impl.levelFromString Level.Verbose
                 }
             let! exitCode = args |> _system options fwkInfo.MsbuildTool
 
@@ -587,9 +595,10 @@ module DotnetTasks =
             do! trace Debug "Command line: '%s %s'" fsc (args |> Seq.map Impl.escapeArgument |> String.concat "\r\n\t")
 
             let options = {
-                SystemOptions with
+                SystemOptions.Default with
                     LogPrefix = "[FSC] "
-                    StdOutLevel = Level.Verbose     // consider standard compiler output too noisy
+                    StdOutLevel = fun _ -> Level.Verbose
+                    ErrOutLevel = Impl.levelFromString Level.Verbose
                     EnvVars = fwkInfo.EnvVars
                 }
             let! exitCode = _system options fsc (args |> String.concat " ")

core/Logging.fs

@@ -94,22 +94,70 @@ let FileLogger name maxLevel =
                   | false -> ignore
               Printf.kprintf write format }
 
+module private ConsoleSink =
+
+    open System
+
+    type Message = Message of Level * string
+
+    let defaultColor = Console.ForegroundColor
+
+    let levelToColor = function
+        | Level.Message -> ConsoleColor.White, ConsoleColor.White
+        | Error   -> ConsoleColor.Red, ConsoleColor.DarkRed
+        | Command -> ConsoleColor.Green, ConsoleColor.DarkGreen
+        | Warning -> ConsoleColor.Yellow, ConsoleColor.DarkYellow
+        | Info -> ConsoleColor.DarkGreen, defaultColor
+        | Debug -> ConsoleColor.DarkGray, ConsoleColor.DarkGray
+        | Verbose -> ConsoleColor.Gray, ConsoleColor.Gray
+        | _ -> defaultColor, defaultColor
+
+
+    let po = MailboxProcessor.Start(fun mbox -> 
+        let rec loop () = 
+            async { 
+                let! (Message(level, text)) = mbox.Receive()
+
+                let color, text_color = level |> levelToColor
+
+                Console.ForegroundColor <- defaultColor
+                Console.Write "["
+                Console.ForegroundColor <- color
+                Console.Write (LevelToString level)
+                Console.ForegroundColor <- defaultColor
+                Console.Write "] "
+
+                Console.ForegroundColor <- text_color
+                text |> System.Console.WriteLine
+                Console.ForegroundColor <- defaultColor
+
+                return! loop ()
+            }
+        loop ())
+
+
 /// <summary>
 /// Console logger.
 /// </summary>
 /// <param name="maxLevel"></param>
-let ConsoleLogger maxLevel = 
+let private ConsoleLoggerBase (write: Level -> string -> unit) maxLevel = 
     let filterLevels = logFilter maxLevel
     { new ILogger with
           member __.Log level format = 
               let write = 
-                  match Set.contains level filterLevels with
-                  | true -> 
-                      sprintf "[%s] %s" (LevelToString level) 
-                      >> System.Console.WriteLine
+                  match filterLevels |> Set.contains level with
+                  | true -> write level
                   | false -> ignore
               Printf.kprintf write format }
 
+let DumbConsoleLogger =
+    ConsoleLoggerBase (
+        fun level -> (LevelToString level) |> sprintf "[%s] %s" >> System.Console.WriteLine
+        )
+
+let ConsoleLogger =
+    ConsoleLoggerBase (fun level s -> ConsoleSink.Message(level,s) |>  ConsoleSink.po.Post)
+
 /// <summary>
 /// Creates a logger that is combination of two loggers.
 /// </summary>

samples/csc/hw-net2-net4.fsx

@@ -12,8 +12,8 @@ do xake {ExecOptions.Default with Vars = ["NETFX", "4.0"]; FileLogLevel = Verbos
 
     "check_deps" => action {
         let! ctx = getCtx()
-        let tgt = FileTarget (Artifact (ctx.Options.ProjectRoot </> "hw2.exe"))
-        let reasons = getDirtyState ctx tgt
+        let tgt = FileTarget (File.make (ctx.Options.ProjectRoot </> "hw2.exe"))
+        let reasons = getPlainDeps ctx tgt
 
         printfn "need: %A" reasons
     }