1 #Region "Microsoft.VisualBasic::051219c7858b016ac1936b62bc6eb520, Microsoft.VisualBasic.Core\ApplicationServices\Debugger.vb"
2
3     ' Author:
4     
5     '       asuka (amethyst.asuka@gcmodeller.org)
6     '       xie (genetics@smrucc.org)
7     '       xieguigang (xie.guigang@live.com)
8     
9     ' Copyright (c) 2018 GPL3 Licensed
10     
11     
12     ' GNU GENERAL PUBLIC LICENSE (GPL3)
13     
14     
15     ' This program is free software: you can redistribute it and/or modify
16     ' it under the terms of the GNU General Public License as published by
17     ' the Free Software Foundation, either version 3 of the License, or
18     ' (at your option) any later version.
19     
20     ' This program is distributed in the hope that it will be useful,
21     ' but WITHOUT ANY WARRANTY; without even the implied warranty of
22     ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
23     ' GNU General Public License for more details.
24     
25     ' You should have received a copy of the GNU General Public License
26     ' along with this program. If not, see <http://www.gnu.org/licenses/>.
27
28
29
30     ' /********************************************************************************/
31
32     ' Summaries:
33
34     Module VBDebugger
35     
36     '     Function: die, LinqProc
37     '     Delegate Sub
38     
39     '         Properties: ForceSTDError, Mute, UsingxConsole
40     
41     '         Function: __DEBUG_ECHO, Assert, BENCHMARK, getColor, (+2 Overloads) PrintException
42     '                   this, Warning
43     
44     '         Sub: (+2 Overloads) __DEBUG_ECHO, __INFO_ECHO, __print, (+3 OverloadsAssertion, AttachLoggingDriver
45     '              cat, (+3 Overloads) Echo, EchoLine, WaitOutput, WriteLine
46     
47     
48     
49     ' /********************************************************************************/
50
51 #End Region
52
53 Imports System.Reflection
54 Imports System.Runtime.CompilerServices
55 Imports System.Text
56 Imports Microsoft.VisualBasic.ApplicationServices
57 Imports Microsoft.VisualBasic.ApplicationServices.Debugging
58 Imports Microsoft.VisualBasic.ApplicationServices.Debugging.Logging
59 Imports Microsoft.VisualBasic.Language
60 Imports Microsoft.VisualBasic.Language.C
61 Imports Microsoft.VisualBasic.Language.Default
62 Imports Microsoft.VisualBasic.Language.Perl
63 Imports Microsoft.VisualBasic.Linq.Extensions
64 Imports Microsoft.VisualBasic.Scripting.Runtime
65 Imports Microsoft.VisualBasic.Terminal
66 Imports Microsoft.VisualBasic.Terminal.Utility
67
68 ''' <summary>
69 ''' Debugger helper module for VisualBasic Enterprises System.
70 ''' </summary>
71 Public Module VBDebugger
72
73     ''' <summary>
74     ''' Assert that the expression value is correctly or not?
75     ''' </summary>
76     ''' <param name="message$">The exception message</param>
77     ''' <param name="failure">If this expression test is True, then die expression will raise an exception</param>
78     ''' <returns></returns>
79     Public Function die(message$, Optional failure As Assert(Of Object) = Nothing, <CallerMemberName> Optional caller$ = NothingAs ExceptionHandler
80         Return New ExceptionHandler With {
81             .Message = message,
82             .failure = failure Or defaultAssert
83         }
84     End Function
85
86     ''' <summary>
87     ''' 当在执行大型的数据集合的时候怀疑linq里面的某一个任务进入了死循环状态,可以使用这个方法来检查是否如此
88     ''' </summary>
89     ''' <typeparam name="T"></typeparam>
90     ''' <param name="source"></param>
91     ''' <param name="TAG"></param>
92     ''' <returns></returns>
93     <Extension> Public Function LinqProc(Of T)(source As IEnumerable(Of T), <CallerMemberName> Optional TAG As String = ""As EventProc
94         Return New EventProc(source.Count, TAG)
95     End Function
96
97     Dim __mute As Boolean = False
98     Dim logs As New List(Of LoggingDriver)
99
100     Friend __level As DebuggerLevels = DebuggerLevels.On  ' 默认是输出所有的信息
101
102     Public Delegate Sub LoggingDriver(header$, message$, level As MSG_TYPES)
103
104     ''' <summary>
105     ''' Disable the debugger information outputs on the console if this <see cref="Mute"/> property is set to True
106     ''' and enable the output if this property is set to False
107     ''' NOTE: this debugger option property can be overrides by the debugger parameter from the CLI parameter named '--echo'
108     ''' </summary>
109     ''' <returns></returns>
110     Public Property Mute As Boolean
111         Get
112             Return __mute
113         End Get
114         Set(value As Boolean)
115             If __level = DebuggerLevels.Off Then  ' off的时候,不会输出任何信息
116                 __mute = True
117             Else
118                 __mute = value
119             End If
120         End Set
121     End Property
122
123     ''' <summary>
124     ''' Force the app debugging output redirect into the std_error device.
125     ''' </summary>
126     ''' <returns></returns>
127     Public Property ForceSTDError As Boolean = False
128
129     ReadOnly _Indent As String() = {
130         "",
131         New String(" ", 1), New String(" ", 2), New String(" ", 3), New String(" ", 4),
132         New String(" ", 5), New String(" ", 6), New String(" ", 7), New String(" ", 8),
133         New String(" ", 9), New String(" ", 10)
134     }
135
136     ''' <summary>
137     ''' Test how long this <paramref name="test"/> will takes.
138     ''' </summary>
139     ''' <param name="test"></param>
140     ''' <param name="trace$"></param>
141     ''' <returns></returns>
142     <Extension>
143     Public Function BENCHMARK(test As Action, <CallerMemberName> Optional trace$ = NothingAs Long
144         Dim start = Now.ToLongTimeString
145         Dim ms& = Utils.Time(test)
146         Dim end$ = Now.ToLongTimeString
147
148         If Not Mute AndAlso __level < DebuggerLevels.Warning Then
149             Dim head$ = $"Benchmark `{ms.FormatTicks}` {start} - {[end]}"
150             Dim str$ = " " & $"{trace} -> {CStrSafe(test.Target, "null")}::{test.Method.Name}"
151
152             Call Terminal.AddToQueue(
153                 Sub()
154                     Call __print(head, str, ConsoleColor.Magenta, ConsoleColor.Magenta)
155                 End Sub)
156         End If
157
158         Return ms
159     End Function
160
161     ''' <summary>
162     ''' Output the full debug information while the project is debugging in debug mode.
163     ''' (向标准终端和调试终端输出一些带有时间戳的调试信息)
164     ''' </summary>
165     ''' <param name="msg">The message fro output to the debugger console, this function will add a time stamp automaticly To the leading position Of the message.</param>
166     ''' <param name="indent"></param>
167     ''' <returns>其实这个函数是不会返回任何东西的,只是因为为了Linq调试输出的需要,所以在这里是返回Nothing的</returns>
168     <Extension> Public Function __DEBUG_ECHO(msg$, Optional indent% = 0) As String
169         If Not Mute AndAlso __level < DebuggerLevels.Warning Then
170             Dim head As String = $"DEBUG {Now.ToString}"
171             Dim str As String = $"{_Indent(indent)} {msg}"
172
173             Call Terminal.AddToQueue(
174                 Sub()
175                     Call __print(head, str, ConsoleColor.White, MSG_TYPES.DEBUG)
176                 End Sub)
177 #If DEBUG Then
178             Call Debug.WriteLine($"[{head}]{str}")
179 #End If
180         End If
181
182         Return Nothing
183     End Function
184
185     <Extension> Public Sub __INFO_ECHO(msg$)
186         If Not Mute AndAlso __level < DebuggerLevels.Warning Then
187             Dim head As String = $"INFOM {Now.ToString}"
188             Dim str As String = " " & msg
189
190             Call Terminal.AddToQueue(
191                 Sub()
192                     Call __print(head, str, ConsoleColor.White, MSG_TYPES.INF)
193                 End Sub)
194 #If DEBUG Then
195             Call Debug.WriteLine($"[{head}]{str}")
196 #End If
197         End If
198     End Sub
199
200     ''' <summary>
201     ''' 头部和消息字符串都是放在一个task之中进行输出的,<see cref="xConsole"/>的输出也是和内部的debugger输出使用的同一个消息线程
202     ''' </summary>
203     ''' <param name="head"></param>
204     ''' <param name="str"></param>
205     ''' <param name="msgColor"></param>
206     ''' <param name="level"><see cref="ConsoleColor"/> or <see cref="MSG_TYPES"/></param>
207     Private Sub __print(head As String, str As String, msgColor As ConsoleColor, level As Integer)
208         If ForceSTDError Then
209             Call Console.Error.WriteLine($"[{head}]{str}")
210         Else
211             Dim cl As ConsoleColor = Console.ForegroundColor
212             Dim headColor As ConsoleColor = getColor(level)
213
214             If msgColor = headColor Then
215                 Console.ForegroundColor = headColor
216                 Console.WriteLine($"[{head}]{str}")
217                 Console.ForegroundColor = cl
218             Else
219                 Call Console.Write("[")
220                 Console.ForegroundColor = headColor
221                 Call Console.Write(head)
222                 Console.ForegroundColor = cl
223                 Call Console.Write("]")
224
225                 Call WriteLine(str, msgColor)
226             End If
227         End If
228
229         For Each driver As LoggingDriver In VBDebugger.logs
230             Call driver(head, str, level)
231         Next
232     End Sub
233
234     <MethodImpl(MethodImplOptions.AggressiveInlining)>
235     Public Sub AttachLoggingDriver(driver As LoggingDriver)
236         logs += driver
237     End Sub
238
239     <MethodImpl(MethodImplOptions.AggressiveInlining)>
240     <Extension>
241     Private Function getColor(level As IntegerAs ConsoleColor
242         Return If(DebuggerTagColors.ContainsKey(level), DebuggerTagColors(level), CType(level, ConsoleColor))
243     End Function
244
245     ''' <summary>
246     ''' The function will print the exception details information on the standard <see cref="console"/>, <see cref="debug"/> console, and system <see cref="trace"/> console.
247     ''' (分别在标准终端,调试终端,系统调试终端之中打印出错误信息,请注意,函数会直接返回False可以用于指定调用者函数的执行状态,这个函数仅仅是在终端上面打印出错误,不会保存为日志文件)
248     ''' </summary>
249     ''' <typeparam name="ex"></typeparam>
250     ''' <param name="exception"></param>
251     <Extension> Public Function PrintException(Of ex As Exception)(exception As ex, <CallerMemberName> Optional memberName As String = ""As Boolean
252         Dim exMsg As String = New Exception(memberName, exception).ToString
253         Return PrintException(exMsg, memberName)
254     End Function
255
256     ''' <summary>
257     ''' 可以使用这个方法<see cref="MethodBase.GetCurrentMethod"/>.<see cref="GetFullName"/>获取得到<paramref name="memberName"/>所需要的参数信息
258     ''' </summary>
259     ''' <param name="msg"></param>
260     ''' <param name="memberName"></param>
261     ''' <returns></returns>
262     <Extension>
263     Public Function PrintException(msg As String, <CallerMemberName> Optional memberName As String = ""As Boolean
264         Dim exMsg As String = $"[ERROR {Now.ToString}] <{memberName}>::{msg}"
265         Call Terminal.AddToQueue(Sub() Call VBDebugger.WriteLine(exMsg, ConsoleColor.Red))
266         Return False
267     End Function
268
269     ''' <summary>
270     ''' 等待调试器输出工作线程将内部的消息队列输出完毕
271     ''' </summary>
272     Public Sub WaitOutput()
273         Call Terminal.WaitQueue()
274     End Sub
275
276     ''' <summary>
277     ''' 使用<see cref="xConsole"/>输出消息
278     ''' </summary>
279     ''' <returns></returns>
280     Public Property UsingxConsole As Boolean = False
281
282     ''' <summary>
283     ''' 输出的终端消息带有指定的终端颜色色彩,当<see cref="UsingxConsole"/>为True的时候,
284     ''' <paramref name="msg"/>参数之中的文本字符串兼容<see cref="xConsole"/>语法,
285     ''' 而<paramref name="color"/>将会被<see cref="xConsole"/>覆盖而不会起作用
286     ''' </summary>
287     ''' <param name="msg">兼容<see cref="xConsole"/>语法</param>
288     ''' <param name="color">当<see cref="UsingxConsole"/>参数为True的时候,这个函数参数将不会起作用</param>
289     <Extension>
290     Public Sub WriteLine(msg As String, color As ConsoleColor)
291         If Mute Then
292             Return
293         End If
294
295         If ForceSTDError Then
296             Console.Error.WriteLine(msg)
297         Else
298             If UsingxConsole AndAlso App.IsMicrosoftPlatform Then
299                 Call xConsole.CoolWrite(msg)
300             Else
301                 ' 使用传统的输出输出方法
302                 Dim cl As ConsoleColor = Console.ForegroundColor
303
304                 Console.ForegroundColor = color
305                 Console.WriteLine(msg)
306                 Console.ForegroundColor = cl
307             End If
308         End If
309
310 #If DEBUG Then
311         Call Debug.WriteLine(msg)
312 #End If
313     End Sub
314
315     ''' <summary>
316     ''' ``<see cref="MSG_TYPES"/> -> <see cref="ConsoleColor"/>``
317     ''' </summary>
318     ReadOnly DebuggerTagColors As New Dictionary(Of Integer, ConsoleColor) From {
319         {MSG_TYPES.DEBUG, ConsoleColor.DarkGreen},
320         {MSG_TYPES.ERR, ConsoleColor.Red},
321         {MSG_TYPES.INF, ConsoleColor.Blue},
322         {MSG_TYPES.WRN, ConsoleColor.Yellow}
323     }
324
325     ''' <summary>
326     ''' Display the wraning level(YELLOW color) message on the console.
327     ''' </summary>
328     ''' <param name="msg"></param>
329     ''' <param name="calls"></param>
330     ''' <returns></returns>
331     <Extension>
332     Public Function Warning(msg As String, <CallerMemberName> Optional calls As String = ""As String
333         If Not Mute Then
334             Dim head As String = $"WARNG <{calls}> {Now.ToString}"
335
336             Call Terminal.AddToQueue(
337                 Sub()
338                     Call __print(head, " " & msg, ConsoleColor.Yellow, MSG_TYPES.DEBUG)
339                 End Sub)
340 #If DEBUG Then
341             Call Debug.WriteLine($"[{head}]{msg}")
342 #End If
343         End If
344
345         Return Nothing
346     End Function
347
348     ''' <summary>
349     ''' If <paramref name="test"/> boolean value is False, then the assertion test failure. If the test is failure the specific message will be output on the console.
350     ''' </summary>
351     ''' <param name="test"></param>
352     ''' <param name="fails"></param>
353     ''' <param name="level"></param>
354     ''' <param name="calls"></param>
355     <Extension>
356     Public Sub Assertion(test As Boolean, fails As String, level As MSG_TYPES, <CallerMemberName> Optional calls As String = "")
357         If Not test = True Then
358             If level = MSG_TYPES.DEBUG Then
359                 If __level < DebuggerLevels.Warning Then
360                     Call fails.__DEBUG_ECHO(memberName:=calls)
361                 End If
362             ElseIf level = MSG_TYPES.ERR Then
363                 If __level <> DebuggerLevels.Off Then
364                     Call WriteLine(fails, ConsoleColor.Red)
365                 End If
366             ElseIf level = MSG_TYPES.WRN Then
367                 If __level <> DebuggerLevels.Error Then
368                     Call Warning(fails, calls)
369                 End If
370             Else
371                 If __level < DebuggerLevels.Warning Then
372                     Call Console.WriteLine($"@{calls}::" & fails)
373                 End If
374             End If
375         End If
376     End Sub
377
378     ''' <summary>
379     ''' If the <paramref name="test"/> message is not null or empty string, then the console will output the message.
380     ''' </summary>
381     ''' <param name="test"></param>
382     ''' <param name="level"></param>
383     ''' <param name="calls"></param>
384     <Extension>
385     Public Sub Assertion(test As String, level As MSG_TYPES, <CallerMemberName> Optional calls As String = "")
386         Call VBDebugger.Assertion((String.IsNullOrEmpty(test) OrElse String.IsNullOrWhiteSpace(test)), test, level, calls)
387     End Sub
388
389     ''' <summary>
390     ''' Use an assert statement to disrupt normal execution if a boolean condition is false.
391     ''' If <paramref name="test"/> is false(means this assertion test failure), then throw exception.
392     ''' </summary>
393     ''' <param name="test"></param>
394     ''' <param name="msg"></param>
395     Public Sub Assertion(test As Boolean, msg As String, <CallerMemberName> Optional calls As String = "")
396         Dim null = test Or die(message:=msg, caller:=calls)
397     End Sub
398
399     Public Function Assert(test As Boolean,
400                            failed$,
401                            Optional success$ = Nothing,
402                            Optional failedLevel As MSG_TYPES = MSG_TYPES.ERR,
403                            <CallerMemberName> Optional calls As String = ""As Boolean
404         If test Then
405             If Not String.IsNullOrEmpty(success) Then
406                 Call success.__DEBUG_ECHO
407             End If
408
409             Return True
410         Else
411             Select Case failedLevel
412                 Case MSG_TYPES.DEBUG
413                     Call failed.__DEBUG_ECHO
414                 Case MSG_TYPES.ERR
415                     Call failed.PrintException(calls)
416                 Case MSG_TYPES.WRN
417                     Call failed.Warning(calls)
418                 Case Else
419                     Call failed.Echo(calls)
420             End Select
421
422             Return False
423         End If
424     End Function
425
426     ''' <summary>
427     ''' Output the full debug information while the project is debugging in debug mode.
428     ''' (向标准终端和调试终端输出一些带有时间戳的调试信息)
429     ''' </summary>
430     ''' <param name="MSG">The message fro output to the debugger console, this function will add a time stamp automaticly To the leading position Of the message.</param>
431     ''' <param name="Indent"></param>
432     <MethodImpl(MethodImplOptions.AggressiveInlining)>
433     <Extension> Public Sub __DEBUG_ECHO(MSG As StringBuilder, Optional Indent As Integer = 0)
434         Call MSG.ToString.__DEBUG_ECHO(Indent)
435     End Sub
436
437     <Extension> Public Sub __DEBUG_ECHO(Of T)(value As T, <CallerMemberName> Optional memberName As String = "")
438         Call (Scripting.InputHandler.ToString(value) & "              @" & memberName).__DEBUG_ECHO
439     End Sub
440
441     ''' <summary>
442     ''' Returns the current function name.
443     ''' </summary>
444     ''' <param name="caller">
445     ''' The caller function name, do not assign any value to this parameter! Just leave it blank.
446     ''' </param>
447     ''' <returns></returns>
448     Public Function this(<CallerMemberName> Optional caller As String = ""As String
449         Return caller
450     End Function
451
452     <Extension> Public Sub Echo(Of T)(array As IEnumerable(Of T), <CallerMemberName> Optional memberName As String = "")
453         Call String.Join(", ", array.Select(Function(obj) Scripting.ToString(obj)).ToArray).__DEBUG_ECHO
454     End Sub
455
456     <Extension> Public Sub Echo(lines As IEnumerable(Of String))
457         For Each line$ In lines
458             Call Console.WriteLine(line)
459         Next
460     End Sub
461
462     ''' <summary>
463     ''' Alias for <see cref="Console.WriteLine"/>
464     ''' </summary>
465     ''' <param name="s$"></param>
466     <Extension> Public Sub EchoLine(s$)
467         If Not Mute Then
468             Call Terminal.AddToQueue(
469                 Sub()
470                     Call Console.WriteLine(s)
471                 End Sub)
472         End If
473     End Sub
474
475     ''' <summary>
476     ''' Alias for <see cref="Console.Write"/>
477     ''' </summary>
478     ''' <param name="c"></param>
479     <Extension> Public Sub Echo(c As Char)
480         If Not Mute Then
481             Call Console.Write(c)
482         End If
483     End Sub
484
485     ''' <summary>
486     ''' print message, alias for <see cref="Console.Write(String)"/>.(支持``sprintf``之中的转义字符)
487     ''' </summary>
488     ''' <param name="s$"></param>
489     Public Sub cat(s$)
490         If Not Mute Then
491             Call Terminal.AddToQueue(
492                 Sub()
493                     Call Console.Write(s.ReplaceMetaChars)
494                 End Sub)
495         End If
496     End Sub
497 End Module