forked from microsoft/fsharplu
-
Notifications
You must be signed in to change notification settings - Fork 0
/
TraceLogging.fs
278 lines (250 loc) · 16.2 KB
/
TraceLogging.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
/// Copyright (c) Microsoft Corporation.
/// Functors and types used to create strongly-typed Printf-like wrappers
/// for Trace logging and System.Diagnostics
namespace Microsoft.FSharpLu.Logging
/// We define a _strongly-typed tracer_ as any static type implementing the following "static interface":
/// ^T when ^T : (static member writeLine : string -> unit)
/// and ^T : (static member info : string -> unit)
/// and ^T : (static member warning : string -> unit)
/// and ^T : (static member error : string -> unit)
/// and ^T : (static member critical : string -> unit)
/// and ^T : (static member verbose : string -> unit)
/// and ^T : (static member writeLine : string -> unit)
/// and ^T : (static member flush : unit -> unit)
/// and ^T : (static member indent : unit -> unit)
/// and ^T : (static member unindent : unit -> unit)
/// Unfortunately, F# does not support definition of aliases for sets of static constraints so
/// we have to repeat this definition everytime we refer to this interface. Two related uservoices
/// suggestions were declined by the F# team:
/// https://fslang.uservoice.com/forums/245727-f-language/suggestions/8509687-add-constraints-as-a-language-construct
/// https://fslang.uservoice.com/forums/245727-f-language/suggestions/8393964-interfaces-as-simple-reusable-and-named-sets-of-m
/// But maybe one day we will be able to use type-classes instead:
/// https://fslang.uservoice.com/forums/245727-f-language/suggestions/5762135-support-for-type-classes-or-implicits
/// Functor used to create a strongly-typed event tracer
/// from a set of string tracing functions
type StronglyTypedTracer< ^T when ^T : (static member writeLine : string -> unit)
and ^T : (static member info : string -> unit)
and ^T : (static member warning : string -> unit)
and ^T : (static member error : string -> unit)
and ^T : (static member critical : string -> unit)
and ^T : (static member verbose : string -> unit)
and ^T : (static member writeLine : string -> unit)
and ^T : (static member flush : unit -> unit)
and ^T : (static member indent : unit -> unit)
and ^T : (static member unindent : unit -> unit) > =
static member inline info format = Printf.kprintf (fun m -> (^T:(static member info : string -> unit) m)) format
static member inline warning format = Printf.kprintf (fun m -> (^T:(static member warning : string -> unit) m)) format
static member inline error format = Printf.kprintf (fun m -> (^T:(static member error : string -> unit) m)) format
static member inline critical format = Printf.kprintf (fun m -> (^T:(static member critical : string -> unit) m)) format
static member inline failwith format = Printf.kprintf (fun m -> (^T:(static member critical : string -> unit) m); Operators.failwith m) format
static member inline verbose format = Printf.kprintf (fun m -> (^T:(static member verbose : string -> unit) m)) format
static member inline writeLine format = Printf.kprintf (fun m -> (^T:(static member writeLine : string -> unit) m)) format
static member inline flush () = (^T:(static member flush : unit -> unit) ())
static member inline indent () = (^T:(static member indent : unit -> unit) ())
static member inline unindent () = (^T:(static member unindent : unit -> unit) ())
/// Combine two strongly-typed tracers into one
type Combine< ^T1, ^T2 when
^T1 : (static member writeLine : string -> unit)
and ^T1 : (static member info : string -> unit)
and ^T1 : (static member warning : string -> unit)
and ^T1 : (static member error : string -> unit)
and ^T1 : (static member critical : string -> unit)
and ^T1 : (static member verbose : string -> unit)
and ^T1 : (static member writeLine : string -> unit)
and ^T1 : (static member flush : unit -> unit)
and ^T1 : (static member indent : unit -> unit)
and ^T1 : (static member unindent : unit -> unit)
and ^T2 : (static member writeLine : string -> unit)
and ^T2 : (static member info : string -> unit)
and ^T2 : (static member warning : string -> unit)
and ^T2 : (static member error : string -> unit)
and ^T2 : (static member critical : string -> unit)
and ^T2 : (static member verbose : string -> unit)
and ^T2 : (static member writeLine : string -> unit)
and ^T2 : (static member flush : unit -> unit)
and ^T2 : (static member indent : unit -> unit)
and ^T2 : (static member unindent : unit -> unit)> =
static member inline info m =
(^T1:(static member info : string -> unit) m)
(^T2:(static member info : string -> unit) m)
static member inline warning m =
(^T1:(static member warning : string -> unit) m)
(^T2:(static member warning : string -> unit) m)
static member inline error m =
(^T1:(static member error : string -> unit) m)
(^T2:(static member error : string -> unit) m)
static member inline critical m =
(^T1:(static member critical : string -> unit) m)
(^T2:(static member critical : string -> unit) m)
static member inline verbose m =
(^T1:(static member verbose : string -> unit) m)
(^T2:(static member verbose : string -> unit) m)
static member inline writeLine m =
(^T1:(static member writeLine : string -> unit) m)
(^T2:(static member writeLine : string -> unit) m)
static member inline flush () =
(^T1:(static member flush : unit -> unit) ())
(^T2:(static member flush : unit -> unit) ())
static member inline indent () =
(^T1:(static member indent : unit -> unit) ())
(^T2:(static member indent : unit -> unit) ())
static member inline unindent () =
(^T1:(static member unindent : unit -> unit) ())
(^T2:(static member unindent : unit -> unit) ())
module EnvironmentInfo =
/// Trace environment information to a strongly-typed tracer
let inline trace< ^T when ^T : (static member writeLine : string -> unit)
and ^T : (static member info : string -> unit)
and ^T : (static member warning : string -> unit)
and ^T : (static member error : string -> unit)
and ^T : (static member critical : string -> unit)
and ^T : (static member verbose : string -> unit)
and ^T : (static member writeLine : string -> unit)
and ^T : (static member flush : unit -> unit)
and ^T : (static member indent : unit -> unit)
and ^T : (static member unindent : unit -> unit)> () =
StronglyTypedTracer< ^T>.indent()
StronglyTypedTracer< ^T>.writeLine "Operating system: %O" System.Environment.OSVersion
StronglyTypedTracer< ^T>.writeLine "Computer name: %s" System.Environment.MachineName
StronglyTypedTracer< ^T>.writeLine "User name: %s" System.Environment.UserName
StronglyTypedTracer< ^T>.writeLine "CLR runtime version: %O" System.Environment.Version
StronglyTypedTracer< ^T>.writeLine "Command line: %s" System.Environment.CommandLine
StronglyTypedTracer< ^T>.unindent()
/// Helper functions for System.Diagnostics
namespace System.Diagnostics
open System
/// A strongly-typed tracer implemented with System.Diagnostics event tracing
type DiagnosticsTracer =
static member inline info m = Trace.TraceInformation m
static member inline warning m = Trace.TraceWarning m
static member inline error m = Trace.TraceError m
static member inline verbose m = Debug.Write m
static member inline writeLine m = Trace.WriteLine m
static member inline critical m = Trace.TraceError m
static member inline flush () = Trace.Flush()
static member inline indent () = Trace.Indent()
static member inline unindent () = Trace.Unindent()
/// A System.Diagnostics trace listener redirecting messages to
/// the Console with nice colors for errors and warnings.
type ColorConsoleTraceListener() =
inherit ConsoleTraceListener()
let colorByEvent =
Map.ofSeq
[ TraceEventType.Verbose, ConsoleColor.DarkGray
TraceEventType.Information, ConsoleColor.White
TraceEventType.Warning, ConsoleColor.Yellow
TraceEventType.Error, ConsoleColor.DarkRed
TraceEventType.Critical, ConsoleColor.Red
TraceEventType.Start, ConsoleColor.DarkCyan
TraceEventType.Stop, ConsoleColor.DarkCyan ]
override x.TraceEvent(eventCache:TraceEventCache, source:string, eventType:TraceEventType, id:int, message:string) =
x.TraceEvent(eventCache, source, eventType, id, "{0}", message)
override __.TraceEvent(eventCache:TraceEventCache, source:string, eventType:TraceEventType, id:int, format:string, [<ParamArray>] args:obj[]) =
let originalColor = Console.ForegroundColor
Console.ForegroundColor <- defaultArg (colorByEvent.TryFind eventType) originalColor
base.TraceEvent(eventCache, source, eventType, id, format, args)
Console.ForegroundColor <- originalColor
/// Interface for anything that can be flushed (e.g., stream)
type IFlushable =
abstract Flush : unit -> unit
/// Self-cleanup interface for objects returned by logger registration functions
type IFileLogger =
inherit IDisposable
inherit IFlushable
abstract LogFilePath : string
/// FSharpLu helpers to register listers with System.Diagnostics
module Listener =
[<Literal>]
let TraceLogFilePathKey = "LogFilePath"
/// Register a trace listener that redirects all tracing functions from System.Diagnostics
/// to an external log file on disk.
/// Returns an IDisposable that, when disposed, unregisters the listener.
let registerFileTracer componentName directory =
let directory = defaultArg directory <| System.IO.Directory.GetCurrentDirectory()
let logFileName = sprintf "%s-%s.log" componentName (System.DateTime.Now.ToString("yyyyMMdd-hhmmss"))
let logFilePath = System.IO.Path.Combine (directory, logFileName)
let fileTracer = new TextWriterTraceListener(logFilePath, Name = componentName, TraceOutputOptions = TraceOptions.DateTime)
fileTracer.Attributes.Add(TraceLogFilePathKey, logFilePath)
System.Diagnostics.Trace.Listeners.Add(fileTracer) |> ignore
{
new IFileLogger with
member __.LogFilePath
with get () = logFilePath
interface IFlushable with
member __.Flush() =
fileTracer.Flush()
interface IDisposable with
member __.Dispose() =
System.Diagnostics.Trace.Listeners.Remove(fileTracer)
fileTracer.Flush()
fileTracer.Dispose()
}
/// Register a System.Diagnostics trace listener that redirects all tracing functions
/// to the console and to a log file on disk.
/// Returns an IDisposable that, when disposed, unregisters the listners.
let registerFileAndConsoleTracer componentName directory =
let fileLogger =
// Reuse existing console listener if one is already registered
let existingFileListener =
System.Diagnostics.Trace.Listeners
|> Seq.cast<TraceListener>
|> Seq.tryFind (fun l -> l.GetType() = typeof<TextWriterTraceListener> && l.Name = componentName)
match existingFileListener with
| None ->
registerFileTracer componentName directory
| Some existingFileLogger ->
{
new IFileLogger with
member __.LogFilePath
with get () = existingFileLogger.Attributes.[TraceLogFilePathKey]
interface IFlushable with
member __.Flush() = ()
interface IDisposable with
member __.Dispose() = ()
}
// Determine if a console listener is already registered
let existingConsoleListener =
System.Diagnostics.Trace.Listeners
|> Seq.cast<TraceListener>
|> Seq.tryFind (fun l -> l.GetType() = typeof<ColorConsoleTraceListener>)
match existingConsoleListener with
| Some _ -> fileLogger
| None ->
// Create and register a new console listener
let consoleTracer = new ColorConsoleTraceListener(Name = componentName, TraceOutputOptions = TraceOptions.DateTime)
consoleTracer.WriteLine(sprintf "%O + [%s] - Starting output to trace listener." System.DateTime.Now consoleTracer.Name)
System.Diagnostics.Trace.Listeners.Add(consoleTracer) |> ignore
Trace.WriteLine (sprintf "%s - Copyright Microsoft 2015-2016" componentName)
Microsoft.FSharpLu.Logging.EnvironmentInfo.trace<DiagnosticsTracer> ()
// Return a disposable that will dispose both the console and file tracers
{
new IFileLogger with
member __.LogFilePath
with get () = fileLogger.LogFilePath
interface IFlushable with
member __.Flush() =
consoleTracer.Flush()
fileLogger.Flush()
interface IDisposable with
member __.Dispose() =
fileLogger.Dispose()
System.Diagnostics.Trace.Listeners.Remove(consoleTracer)
consoleTracer.Dispose()
}
namespace Microsoft.FSharpLu.Logging
/// Strongly-typed wrappers for System.Diagnostics event tracing
type Trace = Microsoft.FSharpLu.Logging.StronglyTypedTracer<System.Diagnostics.DiagnosticsTracer>
/// Strongly-typed event tracings with additional custom tags
module TraceTags =
let propertiesToString (properties:seq<string*string>) =
properties
|> Seq.map (fun (n,v) -> sprintf "%s: %s" n v)
|> Microsoft.FSharpLu.Text.join ", "
let inline info name properties = Trace.info "%s: %s" name (propertiesToString properties)
let inline warning name properties = Trace.warning "%s: %s" name (propertiesToString properties)
let inline error name properties = Trace.error "%s: %s" name (propertiesToString properties)
let inline verbose name properties = Trace.verbose "%s: %s" name (propertiesToString properties)
let inline critical name properties = Trace.critical "%s: %s" name (propertiesToString properties)
let inline failwith name properties = Trace.failwith "%s: %s" name (propertiesToString properties)
let inline event name properties = Trace.writeLine "Event: %s: %s" name (propertiesToString properties)
let inline trackException (exn:System.Exception) properties = Trace.critical "Exception: %O: %s" exn (propertiesToString properties)