populate TFS Build Summary using FAKE ITraceListener

[ctaggart]

from work in progress in Fake.fsx. It looks like It is a heirachy of IBuildInformationNodes. The AddBuildMessage didn't do anything. The AddBuildStep aded a category with nothing under it. The dates may need to be DateTime.Now instead. Not sure.

// code in progress
type TfsBuildTraceListener(tb:TfsBuild) =
    let bi = tb.Build.Information
    let addActivity displayText start finish =
        let at = bi.AddActivityTracking(null, null, displayText)
        at.StartTime <- start
        at.FinishTime <- finish
        at.Save()
    // not showing up
    let highMessage text = bi.AddBuildMessage("high: "+text, BuildMessageImportance.High, DateTime.UtcNow) |> ignore
    let normalMessage text = bi.AddBuildMessage("normal: "+text, BuildMessageImportance.Normal, DateTime.UtcNow) |> ignore
    let lowMessage text = bi.AddBuildMessage("low: "+text, BuildMessageImportance.Low, DateTime.UtcNow) |> ignore
    let errorMessage text = bi.AddBuildError(text, DateTime.UtcNow) |> ignore
    let mutable step = null
    interface ITraceListener with
        member this.Write msg =
            match msg with 
            | StartMessage -> ()
            | ImportantMessage text -> highMessage text
            | LogMessage(text,_) -> normalMessage text
            | TraceMessage(text,_) -> lowMessage text
            | FinishedMessage -> ()
            | OpenTag(tag,name) ->
                step <- bi.AddBuildStep(tag,name)
                step.StartTime <- DateTime.UtcNow
            | CloseTag tag ->
                step.FinishTime <- DateTime.UtcNow
                step.Save()
            | ErrorMessage text -> errorMessage text

if isTfsBuild then
    listeners.Clear()
    listeners.Add (new TfsBuildTraceListener(getTfsBuild()))

[ctaggart]

I was hoping to be able to split up logging by each target, but several of the log statements, but it looks like the CloseTag "target" may be getting called before logging the messages.

I just created an in memory listener for troubleshooting.

type TargetLog(name) =
    member x.Name with get() = name
    member val Messages = List<string>() with get, set
    member val Children = List<TargetLog>() with get, set

type TargetLogListener() =
    let root = TargetLog "root"
    let mutable target = root
    interface ITraceListener with
        member x.Write msg =
            match msg with
            | OpenTag(tag,name) ->
                if tag.Equals "target" then
                    let t = TargetLog name
                    root.Children.Add t
                    target <- t
            | StartMessage -> ()
            | ImportantMessage text -> target.Messages.Add text
            | LogMessage(text,newLine) -> target.Messages.Add text
            | TraceMessage(text,newLine) -> target.Messages.Add text
            | ErrorMessage text -> target.Messages.Add text
            | FinishedMessage -> ()
            | CloseTag tag ->
                if tag.Equals "target" then
                    target <- root
    member x.Root with get() = root

Target "Summary" (fun _ ->
    logfn "this is Summary"
    let rec printLogNode (t:TargetLog) indent =
        for m in t.Messages do
            printfn "%s%s> %s" indent t.Name m
        for c in t.Children do
            printLogNode c (indent + "  ")
    printLogNode memListener.Root "  "
    ()
)

/cc @forki

[forki]

oh that doesn't look good.

[ctaggart]

For my own notes, the in progress TfsLogListener that was trying to group log statements by target looks like this:

type TfsLogListener(bi:IBuildInformation) =
    let defaultTarget = bi.AddBuildStep("no target", "no target", DateTime.UtcNow, BuildStepStatus.Unknown)
    let mutable target = defaultTarget
    interface ITraceListener with
        member x.Write msg =
            match msg with
            | OpenTag(tag,name) ->
                if tag.Equals "target" then
                    target <- bi.AddBuildStep(name, name, DateTime.UtcNow, BuildStepStatus.Unknown)
            | StartMessage -> ()
            | ImportantMessage text ->
                target.Node.Children.AddBuildMessage(text, BuildMessageImportance.High, DateTime.UtcNow) |> ignore
            | LogMessage(text,newLine) ->
                target.Node.Children.AddBuildMessage(text, BuildMessageImportance.Normal, DateTime.UtcNow) |> ignore
            | TraceMessage(text,newLine) ->
                target.Node.Children.AddBuildMessage(text, BuildMessageImportance.Low, DateTime.UtcNow) |> ignore
            | ErrorMessage text -> 
                target.Node.Children.AddBuildError(text, DateTime.UtcNow) |> ignore
            | FinishedMessage -> ()
            | CloseTag tag ->
                if tag.Equals "target" then
                    target.FinishTime <- DateTime.UtcNow
                    target <- defaultTarget
                    bi.Save()

if isTfsBuild then
    listeners.Clear()
    listeners.Add(TfsLogListener(getTfsBuild().Build.Information))

[ctaggart]

This has been working since that issue was fixed in FAKE.