Add Trace support for ProblemReport & Extend BuildState to include st…

…ring option
fsprojects · Oct 10, 2018 · b63fc9a · b63fc9a
1 parent 26e13b5
commit b63fc9a
Show file tree

Hide file tree

Showing 8 changed files with 39 additions and 16 deletions.
diff --git a/src/app/Fake.BuildServer.AppVeyor/AppVeyor.fs b/src/app/Fake.BuildServer.AppVeyor/AppVeyor.fs
@@ -275,7 +275,7 @@ module AppVeyor =
                     currentTestSuite <- Some name
                 | TraceData.CloseTag (KnownTags.TestSuite name, _, _) ->
                     currentTestSuite <- None
-                | TraceData.BuildState state ->
+                | TraceData.BuildState (state, _) ->
                     ConsoleWriter.writeAnsiColor false color true (sprintf "Changing BuildState to: %A" state)
                 | TraceData.OpenTag (tag, descr) ->
                     match descr with
@@ -286,6 +286,7 @@ module AppVeyor =
                 | TraceData.ImportantMessage text ->
                     ConsoleWriter.writeAnsiColor false color true text
                     AppVeyorInternal.AddMessage AppVeyorInternal.MessageCategory.Warning "" text
+                | TraceData.ProblemReport text
                 | TraceData.ErrorMessage text ->
                     ConsoleWriter.writeAnsiColor false color true text
                     AppVeyorInternal.AddMessage AppVeyorInternal.MessageCategory.Error "" text

diff --git a/src/app/Fake.BuildServer.GitLab/GitLab.fs b/src/app/Fake.BuildServer.GitLab/GitLab.fs
@@ -181,7 +181,7 @@ module GitLab =
                 let importantMessagesToStdErr = true
                 let write = ConsoleWriter.writeAnsiColor //else ConsoleWriter.write
                 match msg with
-                | TraceData.ImportantMessage text | TraceData.ErrorMessage text ->
+                | TraceData.ImportantMessage text | TraceData.ErrorMessage text | TraceData.ProblemReport text ->
                     write importantMessagesToStdErr color true text
                 | TraceData.LogMessage(text, newLine) | TraceData.TraceMessage(text, newLine) ->
                     write false color newLine text
@@ -191,7 +191,7 @@ module GitLab =
                     | _ -> write false color true (sprintf "Starting %s '%s'" tag.Type tag.Name)  
                 | TraceData.CloseTag (tag, time, state) ->
                     write false color true (sprintf "Finished (%A) '%s' in %O" state tag.Name time)
-                | TraceData.BuildState state ->
+                | TraceData.BuildState (state, _) ->
                     write false color true (sprintf "Changing BuildState to: %A" state)
                 | TraceData.ImportData (typ, path) ->
                     let name = Path.GetFileName path

diff --git a/src/app/Fake.BuildServer.TeamCity/TeamCity.fs b/src/app/Fake.BuildServer.TeamCity/TeamCity.fs
@@ -361,12 +361,16 @@ module TeamCity =
                     testFailed testName message detail
                 | TraceData.TestStatus (testName,TestStatus.Failed(message, detail, Some (expected, actual))) ->
                     comparisonFailure testName message detail expected actual
-                | TraceData.BuildState TagStatus.Success ->
+                | TraceData.BuildState (TagStatus.Success, _) ->
                     reportBuildStatus "SUCCESS" "{build.status.text}"
-                | TraceData.BuildState TagStatus.Warning ->
+                | TraceData.BuildState (TagStatus.Warning, None) ->
                     warning "Setting build state to warning."
-                | TraceData.BuildState TagStatus.Failed ->
+                | TraceData.BuildState (TagStatus.Warning, Some message) ->
+                    warning message
+                | TraceData.BuildState (TagStatus.Failed, None) ->
                     reportBuildStatus "FAILURE" "Failure - {build.status.text}"
+                | TraceData.BuildState (TagStatus.Failed, Some message) ->
+                    reportBuildStatus "FAILURE" (sprintf "%s - {build.status.text}" message)
                 | TraceData.CloseTag (KnownTags.Test name, time, _) ->
                     finishTestCase name time
                 | TraceData.OpenTag (KnownTags.TestSuite name, _) ->
@@ -383,6 +387,8 @@ module TeamCity =
                     warning text
                 | TraceData.ErrorMessage text ->
                     error text
+                | TraceData.ProblemReport text ->
+                    reportBuildProblem text
                 | TraceData.LogMessage(text, newLine) | TraceData.TraceMessage(text, newLine) ->
                     ConsoleWriter.write false color newLine text
                 | TraceData.ImportData (ImportData.BuildArtifactWithName name, path) ->

diff --git a/src/app/Fake.BuildServer.TeamFoundation/TeamFoundation.fs b/src/app/Fake.BuildServer.TeamFoundation/TeamFoundation.fs
@@ -215,6 +215,7 @@ module TeamFoundation =
                 let color = ConsoleWriter.colorMap msg
                 let writeConsole = ConsoleWriter.write
                 match msg with
+                | TraceData.ProblemReport text
                 | TraceData.ErrorMessage text ->
                     logIssue false None None None None text
                 | TraceData.ImportantMessage text ->
@@ -248,7 +249,7 @@ module TeamFoundation =
                         | TagStatus.Failed -> LogDetailResult.Failed
                         | TagStatus.Success -> LogDetailResult.Succeeded               
                     setLogDetailFinished id result
-                | TraceData.BuildState state ->
+                | TraceData.BuildState (state, _) ->
                     let vsoState, msg =
                         match state with
                         | TagStatus.Success -> "Succeeded", "OK" 

diff --git a/src/app/Fake.BuildServer.Travis/Travis.fs b/src/app/Fake.BuildServer.Travis/Travis.fs
@@ -24,7 +24,7 @@ module Travis =
                 let color = ConsoleWriter.colorMap msg
                 let write = ConsoleWriter.writeAnsiColor
                 match msg with
-                | TraceData.ImportantMessage text | TraceData.ErrorMessage text ->
+                | TraceData.ImportantMessage text | TraceData.ErrorMessage text | TraceData.ProblemReport text ->
                     write true color true text
                 | TraceData.LogMessage(text, newLine) | TraceData.TraceMessage(text, newLine) ->
                     write false color newLine text
@@ -42,7 +42,7 @@ module Travis =
                     write false color true (sprintf "Build Number: %s" number)
                 | TraceData.TestStatus (test, status) ->
                     write false color true (sprintf "Test '%s' status: %A" test status)
-                | TraceData.BuildState state ->
+                | TraceData.BuildState (state, _) ->
                     write false color true (sprintf "Build State: %A" state)
 
     let defaultTraceListener =

diff --git a/src/app/Fake.Core.Trace/Trace.fs b/src/app/Fake.Core.Trace/Trace.fs
@@ -170,8 +170,14 @@ let traceTag tag description =
     openTagUnsafe tag description
     asSafeDisposable (fun state -> closeTagUnsafeEx state tag)
 
+let setBuildStateWithMessage tag message =
+    TraceData.BuildState(tag, Some(message)) |> CoreTracing.postMessage
+
 let setBuildState tag =
-    TraceData.BuildState tag |> CoreTracing.postMessage
+    TraceData.BuildState(tag, None) |> CoreTracing.postMessage
+
+let reportProblem message =
+    TraceData.ProblemReport(message) |> CoreTracing.postMessage
 
 let testStatus testName testStatus =
     // TODO: Check if the given test is opened in openTags-stack?

diff --git a/src/app/Fake.Core.Trace/TraceListener.fs b/src/app/Fake.Core.Trace/TraceListener.fs
@@ -141,18 +141,20 @@ type TraceData =
     | ErrorMessage of text:string
     | LogMessage of text:string * newLine:bool
     | TraceMessage of text:string * newLine:bool
+    | ProblemReport of text:string
     /// Happens when a tag (Task, Target, Test, ...) has started.
     | OpenTag of KnownTags * description:string option
     | TestStatus of testName:string * status:TestStatus
     | TestOutput of testName:string * out:string * err:string
     | CloseTag of KnownTags * time:TimeSpan * TagStatus
-    | BuildState of TagStatus
+    | BuildState of TagStatus * string option
     member x.NewLine =
         match x with
         | ImportantMessage _
         | ErrorMessage _ -> Some true
         | LogMessage (_, newLine)
         | TraceMessage (_, newLine) -> Some newLine
+        | ProblemReport _
         | BuildNumber _
         | TestStatus _
         | TestOutput _
@@ -165,13 +167,15 @@ type TraceData =
         | ImportantMessage text
         | ErrorMessage text
         | LogMessage (text, _)
-        | TraceMessage (text, _) -> Some text
+        | TraceMessage (text, _)
+        | ProblemReport text
+        | BuildState (_, Some text) -> Some text
+        | BuildState _
         | BuildNumber _
         | TestStatus _
         | TestOutput _
         | ImportData _
         | OpenTag _
-        | BuildState _
         | CloseTag _ -> None
 
 module TraceData =
@@ -189,11 +193,13 @@ module TraceData =
         | TraceData.ErrorMessage text -> TraceData.ErrorMessage (f text)
         | TraceData.LogMessage (text, d) -> TraceData.LogMessage (f text, d)
         | TraceData.TraceMessage (text, d) -> TraceData.TraceMessage (f text, d)
+        | TraceData.ProblemReport text -> TraceData.ProblemReport (f text)
         | TraceData.TestStatus (testName,status) -> TraceData.TestStatus(testName, TestStatus.mapMessage f status)
         | TraceData.TestOutput (testName,out,err) -> TraceData.TestOutput (testName,f out,f err)
         | TraceData.OpenTag(tag, Some d) -> TraceData.OpenTag((mapKnownTags f tag), Some(f d))
         | TraceData.OpenTag(tag, None) -> TraceData.OpenTag((mapKnownTags f tag), None)
         | TraceData.CloseTag(tag, time, status) -> TraceData.CloseTag((mapKnownTags f tag), time, status)        
+        | TraceData.BuildState(tag, Some message) -> TraceData.BuildState(tag, Some(f message))    
         | _ -> t
 
     let internal repl (oldStr:string) (repl:string) (s:string) =
@@ -262,6 +268,7 @@ module ConsoleWriter =
         | TraceData.ErrorMessage _ -> ConsoleColor.Red
         | TraceData.LogMessage _ -> ConsoleColor.Gray
         | TraceData.TraceMessage _ -> ConsoleColor.Green
+        | TraceData.ProblemReport _ -> ConsoleColor.Red
         | _ -> ConsoleColor.Gray
 
 /// Implements a TraceListener for System.Console.
@@ -275,7 +282,7 @@ type ConsoleTraceListener(importantMessagesToStdErr, colorMap, ansiColor) =
             let color = colorMap msg
             let write = if ansiColor then ConsoleWriter.writeAnsiColor else ConsoleWriter.write
             match msg with
-            | TraceData.ImportantMessage text | TraceData.ErrorMessage text ->
+            | TraceData.ImportantMessage text | TraceData.ErrorMessage text | TraceData.ProblemReport text ->
                 write importantMessagesToStdErr color true text
             | TraceData.LogMessage(text, newLine) | TraceData.TraceMessage(text, newLine) ->
                 write false color newLine text
@@ -294,8 +301,10 @@ type ConsoleTraceListener(importantMessagesToStdErr, colorMap, ansiColor) =
                 write false color true (sprintf "Finished (%A) '%s' in %O" status tag.Name time)
             | TraceData.ImportData (typ, path) ->
                 write false color true (sprintf "Import data '%O': %s" typ path)
-            | TraceData.BuildState state ->
+            | TraceData.BuildState (state, None) ->
                 write false color true (sprintf "Changing BuildState to: %A" state)
+            | TraceData.BuildState (state, Some message) ->
+                write false color true (sprintf "Changing BuildState to: %A - %s" state message)            
             | TraceData.TestOutput (test, out, err) ->
                 write false color true (sprintf "Test '%s' output:\n\tOutput: %s\n\tError: %s" test out err)
             | TraceData.BuildNumber number ->

diff --git a/src/app/Fake.Tracing.NAntXml/NAntXmlTraceListener.fs b/src/app/Fake.Tracing.NAntXml/NAntXmlTraceListener.fs
@@ -49,7 +49,7 @@ type NAntXmlTraceListener(encoding : Encoding, xmlOutputFile) =
         | TraceData.LogMessage(text, _) | TraceData.TraceMessage(text, _) -> sprintf "<message level=\"Info\"><![CDATA[%s]]></message>" text
         | TraceData.OpenTag(tag, _) -> sprintf "<%s name=\"%s\">" tag.Type tag.Name
         | TraceData.CloseTag (tag, _, _) -> sprintf "</%s>" tag.Type
-        | TraceData.ErrorMessage text -> 
+        | TraceData.ErrorMessage text | TraceData.ProblemReport text -> 
             sprintf "<failure><builderror><message level=\"Error\"><![CDATA[%s]]></message></builderror></failure>" text
         | TraceData.TestOutput _
         | TraceData.TestStatus _