Allow trace module (=Buildservers) to detect and report failures in c…

…losing tags. Default to warning if MarkSuccess is not called.

help/markdown/core-trace.md

@@ -30,6 +30,7 @@ Trace.traceLine()
 Target.create "mytarget" (fun _ ->
     use __ = Trace.traceTask "MyOperation" "Description"
     // do my operation
+    __.MarkSuccess()
 )
 
 ```

src/app/Fake.Core.Trace/Trace.fs

@@ -123,35 +123,46 @@ let openTagUnsafe tag description =
     openTags.Value <- (sw, tag) :: openTags.Value
     TraceData.OpenTag(tag, description) |> CoreTracing.postMessage
 
+type ISafeDisposable =
+    inherit System.IDisposable
+    abstract MarkSuccess : unit -> unit
+    abstract MarkFailed : unit -> unit
+
 let private asSafeDisposable f =
+    let mutable state = TagStatus.Failed
     let mutable isDisposed = false
-    { new System.IDisposable with
+    { new ISafeDisposable with
+        member __.MarkSuccess () = state <- TagStatus.Success
+        member __.MarkFailed () = state <- TagStatus.Failed
         member __.Dispose () =
             if not isDisposed then
               isDisposed <- true
-              f() }
+              f state }
 
 /// Puts an opening tag on the internal tag stack
 [<System.Obsolete("Consider using traceTag instead and 'use' to properly call closeTag in case of exceptions. To remove this warning use 'openTagUnsafe'.")>]
 let openTag tag description = openTagUnsafe tag description
 
 /// Removes an opening tag from the internal tag stack
-let closeTagUnsafe tag =
+let closeTagUnsafeEx status tag =
     let time =
         match openTags.Value with
         | (sw, x) :: rest when x = tag -> 
             openTags.Value <- rest
             sw.Elapsed
         | _ -> failwithf "Invalid tag structure. Trying to close %A tag but stack is %A" tag openTags
-    TraceData.CloseTag (tag, time) |> CoreTracing.postMessage
+    TraceData.CloseTag (tag, time, status) |> CoreTracing.postMessage
+
+let closeTagUnsafe tag =
+    closeTagUnsafeEx TagStatus.Success tag
 
 /// Removes an opening tag from the internal tag stack
 [<System.Obsolete("Consider using traceTag instead and 'use' to properly call closeTag in case of exceptions. To remove this warning use 'closeTagUnsafe'.")>]
 let closeTag tag = closeTagUnsafe tag
 
 let traceTag tag description =
     openTagUnsafe tag description
-    asSafeDisposable (fun () -> closeTagUnsafe tag)
+    asSafeDisposable (fun state -> closeTagUnsafeEx state tag)
 
 
 let testStatus testName testStatus =
@@ -167,7 +178,7 @@ let publish typ path =
 let setBuildNumber number =
     TraceData.BuildNumber number |> CoreTracing.postMessage
 
-let closeAllOpenTags() = Seq.iter (fun (_, tag) -> closeTagUnsafe tag) openTags.Value
+let closeAllOpenTags() = Seq.iter (fun (_, tag) -> closeTagUnsafeEx TagStatus.Failed tag) openTags.Value
 
 /// Traces the begin of a target
 let traceStartTargetUnsafe name description dependencyString =
@@ -179,17 +190,22 @@ let traceStartTargetUnsafe name description dependencyString =
 let traceStartTarget name description dependencyString =
     traceStartTargetUnsafe name description dependencyString
 
+/// Traces the end of a target
+let traceEndTargetUnsafeEx state name = 
+    closeTagUnsafeEx state (KnownTags.Target name)
+
 /// Traces the end of a target
 let traceEndTargetUnsafe name = 
-    closeTagUnsafe (KnownTags.Target name)
+    traceEndTargetUnsafeEx TagStatus.Success name
+
 
 /// Traces the end of a target
 [<System.Obsolete("Consider using traceTarget instead and 'use' to properly call traceEndTask in case of exceptions. To remove this warning use 'traceEndTargetUnsafe'.")>]
 let traceEndTarget name = traceEndTargetUnsafe name
 
 let traceTarget name description dependencyString =
     traceStartTargetUnsafe name description dependencyString
-    asSafeDisposable (fun () -> traceEndTargetUnsafe name)
+    asSafeDisposable (fun state -> traceEndTargetUnsafeEx state name)
 
 /// Traces the begin of a task
 let traceStartTaskUnsafe task description = 
@@ -200,16 +216,19 @@ let traceStartTaskUnsafe task description =
 let traceStartTask task description = traceStartTaskUnsafe task description
 
 /// Traces the end of a task
-let traceEndTaskUnsafe task = 
-    closeTagUnsafe (KnownTags.Task task)
+let traceEndTaskUnsafeEx state task = 
+    closeTagUnsafeEx state (KnownTags.Task task)
+
+/// Traces the end of a task
+let traceEndTaskUnsafe task = traceEndTaskUnsafeEx TagStatus.Success task
 
 /// Traces the end of a task
 [<System.Obsolete("Consider using traceTask instead and 'use' to properly call traceEndTask in case of exceptions. To remove this warning use 'traceEndTask'.")>]
 let traceEndTask task = traceEndTaskUnsafe task
 
 let traceTask name description =
     traceStartTaskUnsafe name description
-    asSafeDisposable (fun _ -> traceEndTaskUnsafe name)
+    asSafeDisposable (fun state -> traceEndTaskUnsafeEx state name)
 
 open System.Diagnostics
 #if DOTNETCORE

src/app/Fake.Core.Trace/TraceListener.fs

@@ -102,6 +102,11 @@ module TestStatus =
             TestStatus.Failed (f message, f details, None)
         | _ -> t        
 
+[<RequireQualifiedAccess>]
+type TagStatus =
+    | Success
+    | Warning
+    | Failed
 
 /// Defines Tracing information for TraceListeners
 [<RequireQualifiedAccess>]
@@ -115,7 +120,7 @@ type TraceData =
     | OpenTag of KnownTags * description:string
     | TestStatus of testName:string * status:TestStatus
     | TestOutput of testName:string * out:string * err:string
-    | CloseTag of KnownTags * time:TimeSpan
+    | CloseTag of KnownTags * time:TimeSpan * TagStatus
     member x.NewLine =
         match x with
         | ImportantMessage _
@@ -236,8 +241,8 @@ type ConsoleTraceListener(importantMessagesToStdErr, colorMap, ansiColor) =
                 write false color newLine text
             | TraceData.OpenTag (tag, descr) ->
                 write false color true (sprintf "Starting %s '%s': %s" tag.Type tag.Name descr)
-            | TraceData.CloseTag (tag, time) ->
-                write false color true (sprintf "Finished '%s' in %O" tag.Name time)
+            | TraceData.CloseTag (tag, time, status) ->
+                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.TestOutput (test, out, err) ->

src/app/Fake.Documentation.DocFx/DocFx.fs

@@ -61,6 +61,7 @@ let exec setParams command args=
                 WorkingDirectory = p.WorkingDirectory
                 Arguments = commandArgs })) p.Timeout
     then failwithf "DocFx command %s failed." commandArgs
+    __.MarkSuccess()
 
 /// Init-Command parameters
 type InitParams = 

src/app/Fake.DotNet.AssemblyInfoFile/AssemblyInfoFile.fs

@@ -238,6 +238,7 @@ module AssemblyInfoFile =
 
         attributeLines @ sourceLines
         |> writeToFile outputFileName
+        __.MarkSuccess()
 
     /// Creates a F# AssemblyInfo file with the given attributes and configuration.
     /// The generated AssemblyInfo file contains an AssemblyVersionInformation class which can be used to retrieve the current version no. from inside of an assembly.
@@ -268,6 +269,7 @@ module AssemblyInfoFile =
             ]
 
         sourceLines |> writeToFile outputFileName
+        __.MarkSuccess()
 
     /// Creates a VB AssemblyInfo file with the given attributes and configuration.
     /// The generated AssemblyInfo file contains an AssemblyVersionInformation class which can be used to retrieve the current version no. from inside of an assembly.
@@ -294,6 +296,7 @@ module AssemblyInfoFile =
 
         attributeLines @ sourceLines
         |> writeToFile outputFileName
+        __.MarkSuccess()
 
     /// Creates a C++/CLI AssemblyInfo file with the given attributes and configuration.
     /// Does not generate an AssemblyVersionInformation class.
@@ -312,6 +315,7 @@ module AssemblyInfoFile =
 
         attributeLines
         |> writeToFile outputFileName
+        __.MarkSuccess()
 
     /// Creates a C# AssemblyInfo file with the given attributes.
     /// The generated AssemblyInfo file contains an AssemblyVersionInformation class which can be used to retrieve the current version no. from inside of an assembly.

src/app/Fake.DotNet.Cli/DotNet.fs

@@ -517,6 +517,7 @@ module DotNet =
 
         if rid.IsNone then failwithf "could not read rid from output: \n%s" (System.String.Join("\n", result.Messages))
 
+        __.MarkSuccess()
         { RID = rid.Value }
 
 
@@ -565,6 +566,7 @@ module DotNet =
 
         if String.isNullOrWhiteSpace version then failwithf "could not read version from output: \n%s" (System.String.Join("\n", result.Messages))
 
+        __.MarkSuccess()
         version
 
     /// Install .NET Core SDK if required
@@ -709,6 +711,7 @@ module DotNet =
         let args = sprintf "%s %s" project (buildRestoreArgs param)
         let result = exec (fun _ -> param.Common) "restore" args
         if not result.OK then failwithf "dotnet restore failed with code %i" result.ExitCode
+        __.MarkSuccess()
 
     /// build configuration
     type BuildConfiguration =
@@ -787,6 +790,7 @@ module DotNet =
         let args = sprintf "%s %s" project (buildPackArgs param)
         let result = exec (fun _ -> param.Common) "pack" args
         if not result.OK then failwithf "dotnet pack failed with code %i" result.ExitCode
+        __.MarkSuccess()
 
     /// dotnet publish command options
     type PublishOptions =
@@ -859,6 +863,7 @@ module DotNet =
         let args = sprintf "%s %s" project (buildPublishArgs param)
         let result = exec (fun _ -> param.Common) "publish" args
         if not result.OK then failwithf "dotnet publish failed with code %i" result.ExitCode
+        __.MarkSuccess()
 
     /// dotnet build command options
     type BuildOptions =
@@ -928,6 +933,7 @@ module DotNet =
         let args = sprintf "%s %s" project (buildBuildArgs param)
         let result = exec (fun _ -> param.Common) "build" args
         if not result.OK then failwithf "dotnet build failed with code %i" result.ExitCode
+        __.MarkSuccess()
 
     /// dotnet build command options
     type TestOptions =
@@ -1033,6 +1039,7 @@ module DotNet =
         let args = sprintf "%s %s" project (buildTestArgs param)
         let result = exec (fun _ -> param.Common) "test" args
         if not result.OK then failwithf "dotnet test failed with code %i" result.ExitCode
+        __.MarkSuccess()
 
     /// Gets the DotNet SDK from the global.json
     let getSDKVersionFromGlobalJson() : string =

src/app/Fake.DotNet.Fsc/Fsc.fs

@@ -348,11 +348,12 @@ let private compileFiles (compiler: CompilerFunc) (srcFiles : string list) (opts
 let private doCompile (compiler: CompilerFunc) (fscParams : FscParam list) (inputFiles : string list) : int = 
     let inputFiles = inputFiles |> Seq.toList
     let taskDesc = inputFiles |> String.separated ", "
-    let fscParams = if fscParams = [] then FscParam.Defaults else fscParams
+    let fscParams = if List.isEmpty fscParams then FscParam.Defaults else fscParams
     let argList = fscParams |> List.map string
 
     use __ = Trace.traceTask "Fsc " taskDesc
     let res = compileFiles compiler inputFiles argList
+    __.MarkSuccess()
     res
 
 

src/app/Fake.DotNet.MSBuild/MSBuild.fs

@@ -494,6 +494,7 @@ module MSBuild =
 
         let errorMessage = sprintf "Building %s failed with exitcode %d." project exitCode
         raise (MSBuildException(errorMessage, errors))
+    __.MarkSuccess()
 
   /// Builds the given project files and collects the output files.
   /// ## Parameters
@@ -612,6 +613,7 @@ module MSBuild =
           "WebProjectOutputDir", prefix + outputPath + "/" + projectName ] [ projectFile ]
         |> ignore
     !! (projectDir + "/bin/*.*") |> Shell.copy(outputPath + "/" + projectName + "/bin/")
+    __.MarkSuccess()
 
   /// Builds the given web project file with debug configuration and copies it to the given outputPath.
   /// ## Parameters

src/app/Fake.DotNet.NuGet/Install.fs

@@ -93,3 +93,4 @@ let NugetInstall setParams packageName =
     let param = NugetInstallDefaults |> setParams
     let args = sprintf "install %s %s" packageName (buildArgs param)
     runNuGetTrial param.Retries param.ToolPath param.TimeOut args (fun () -> failwithf "Package install for %s failed." packageName)
+    __.MarkSuccess()

src/app/Fake.DotNet.NuGet/NuGet.fs

@@ -390,10 +390,11 @@ let NuGetPackDirectly setParams nuspecOrProjectFile =
     try
          pack parameters nuspecOrProjectFile
     with exn ->
-        (if exn.InnerException <> null then exn.Message + "\r\n" + exn.InnerException.Message
+        (if not (isNull exn.InnerException) then exn.Message + "\r\n" + exn.InnerException.Message
          else exn.Message)
         |> TraceSecrets.guardMessage
         |> failwith
+    __.MarkSuccess()
 
 /// Creates a new NuGet package based on the given .nuspec or project file.
 /// Template parameter substitution is performed when passing a .nuspec
@@ -411,10 +412,11 @@ let NuGetPack setParams nuspecOrProjectFile =
             File.delete nuspecTemplateFile
         | None -> pack parameters nuspecOrProjectFile
     with exn ->
-        (if exn.InnerException <> null then exn.Message + "\r\n" + exn.InnerException.Message
+        (if not (isNull exn.InnerException) then exn.Message + "\r\n" + exn.InnerException.Message
          else exn.Message)
         |> TraceSecrets.guardMessage
         |> failwith
+    __.MarkSuccess()
 
 /// Publishes a NuGet package to the nuget server.
 /// ## Parameters
@@ -426,9 +428,10 @@ let NuGetPublish setParams =
     try
         publish parameters
     with exn ->
-        if exn.InnerException <> null then exn.Message + "\r\n" + exn.InnerException.Message else exn.Message
+        if not (isNull exn.InnerException) then exn.Message + "\r\n" + exn.InnerException.Message else exn.Message
         |> TraceSecrets.guardMessage
         |> failwith
+    __.MarkSuccess()
 
 /// Creates a new NuGet package, and optionally publishes it.
 /// Template parameter substitution is performed when passing a .nuspec
@@ -448,12 +451,13 @@ let NuGet setParams nuspecOrProjectFile =
 
         if parameters.Publish then
             publish parameters
-            if parameters.ProjectFile <> null then publishSymbols parameters
+            if not (isNull parameters.ProjectFile) then publishSymbols parameters
     with exn ->
-        (if exn.InnerException <> null then exn.Message + "\r\n" + exn.InnerException.Message
+        (if not (isNull exn.InnerException) then exn.Message + "\r\n" + exn.InnerException.Message
          else exn.Message)
         |> TraceSecrets.guardMessage
         |> failwith
+    __.MarkSuccess()
 
 /// NuSpec metadata type
 type NuSpecPackage =

src/app/Fake.DotNet.NuGet/Restore.fs

@@ -161,6 +161,7 @@ let RestorePackageId setParams packageId =
 
     let args = buildNuGetArgs setParams packageId
     runNuGetTrial parameters.Retries parameters.ToolPath parameters.TimeOut args (fun () -> failwithf "Package installation of package %s failed." packageId)
+    __.MarkSuccess()
 
 /// Restores the packages in the given packages.config file from NuGet.
 /// ## Parameters
@@ -192,6 +193,7 @@ let RestorePackage setParams packageFile =
         ] |> joinArgs
 
     runNuGetTrial parameters.Retries parameters.ToolPath parameters.TimeOut args (fun () -> failwithf "Package installation of %s generation failed." packageFile)
+    __.MarkSuccess()
 
 /// Restores all packages from NuGet to the default directories by scanning for packages.config files in any subdirectory.
 let RestorePackages() =
@@ -228,3 +230,4 @@ let RestoreMSSolutionPackages setParams solutionFile =
         ] |> joinArgs
 
     runNuGetTrial parameters.Retries parameters.ToolPath parameters.TimeOut args (fun () -> failwithf "Package restore of %s failed" solutionFile)
+    __.MarkSuccess()

src/app/Fake.DotNet.NuGet/Update.fs

@@ -85,3 +85,4 @@ let NugetUpdate setParams packagesFile =
     let param = NugetUpdateDefaults |> setParams
     let args = sprintf "update %s %s" packagesFile (buildArgs param)
     runNuGetTrial param.Retries param.ToolPath param.TimeOut args (fun () -> failwithf "Package update for %s failed." packagesFile)
+    __.MarkSuccess()

src/app/Fake.DotNet.Paket/Paket.fs

@@ -138,6 +138,7 @@ let pack setParams =
             parameters.TimeOut
 
     if packResult <> 0 then failwithf "Error during packing %s." parameters.WorkingDir
+    __.MarkSuccess()
 
 /// Pushes the given NuGet packages to the server by using Paket push.
 /// ## Parameters
@@ -201,6 +202,7 @@ let pushFiles setParams files =
                         >> Process.withFramework)
                     parameters.TimeOut
             if pushResult <> 0 then failwithf "Error during pushing %s." package
+    __.MarkSuccess()
 
 /// Pushes all NuGet packages in the working dir to the server by using Paket push.
 /// ## Parameters
@@ -272,3 +274,4 @@ let restore setParams =
             parameters.TimeOut
 
     if restoreResult <> 0 then failwithf "Error during restore %s." parameters.WorkingDir
+    __.MarkSuccess()

src/app/Fake.DotNet.Paket/PaketTemplate.fs

@@ -281,3 +281,4 @@ let create setParams =
                    | _ -> "paket.template"
 
     File.writeString false filePath (Rendering.createLines parameters)
+    __.MarkSuccess()

src/app/Fake.DotNet.Testing.Expecto/Expecto.fs

@@ -129,3 +129,4 @@ let run (setParams : Params -> Params) (assemblies : string seq) =
             sprintf "Expecto test of assembly '%s' failed. Process finished with exit code %d." testAssembly exitCode )
         |> String.concat System.Environment.NewLine
         |> FailedTestsException |> raise
+    __.MarkSuccess()

src/app/Fake.DotNet.Testing.MSTest/MSTest.fs

@@ -118,3 +118,4 @@ let exec (setParams : MSTestParams -> MSTestParams) (assemblies : string seq) =
             WorkingDirectory = parameters.WorkingDir
             Arguments = args }) >> Process.withFramework) parameters.TimeOut
         |> failIfError assembly
+    __.MarkSuccess()