1 #Region "Microsoft.VisualBasic::04369fce4edad7572df6e2634f9e59eb, 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, (+2 Overloads) PrintException, this
42     '                   Warning
43     
44     '         Sub: (+2 Overloads) __DEBUG_ECHO, __INFO_ECHO, (+3 OverloadsAssertion, AttachLoggingDriver, cat
45     '              (+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     ''' 
80     <MethodImpl(MethodImplOptions.AggressiveInlining)>
81     Public Function die(message$, Optional failure As Assert(Of Object) = Nothing, <CallerMemberName> Optional caller$ = NothingAs ExceptionHandle
82         Return New ExceptionHandle With {
83             .Message = message,
84             .failure = failure Or defaultAssert
85         }
86     End Function
87
88     ''' <summary>
89     ''' 当在执行大型的数据集合的时候怀疑linq里面的某一个任务进入了死循环状态,可以使用这个方法来检查是否如此
90     ''' </summary>
91     ''' <typeparam name="T"></typeparam>
92     ''' <param name="source"></param>
93     ''' <param name="tag"></param>
94     ''' <returns></returns>
95     ''' 
96     <MethodImpl(MethodImplOptions.AggressiveInlining)>
97     <Extension> Public Function LinqProc(Of T)(source As IEnumerable(Of T), <CallerMemberName> Optional tag$ = NothingAs EventProc
98         Return New EventProc(source.Count, tag)
99     End Function
100
101     ''' <summary>
102     ''' 当前的调试器的信息输出登记,默认是输出所有的信息
103     ''' </summary>
104     Friend m_level As DebuggerLevels = DebuggerLevels.On
105     ''' <summary>
106     ''' 是否静默掉所有的调试器输出信息?默认不是
107     ''' </summary>
108     Friend m_mute As Boolean = False
109
110     ''' <summary>
111     ''' 对外部开放的调试日志的获取接口类型的申明
112     ''' </summary>
113     ''' <param name="header">消息的类型的头部标签</param>
114     ''' <param name="message">消息文本内容,一般为一行文本</param>
115     ''' <param name="level">日志消息的错误等级</param>
116     Public Delegate Sub LoggingDriver(header$, message$, level As MSG_TYPES)
117
118     ''' <summary>
119     ''' Disable the debugger information outputs on the console if this <see cref="Mute"/> property is set to 
120     ''' <see cref="Boolean.True"/>, and enable the output if this property is set to <see cref="Boolean.False"/>. 
121     ''' NOTE: this debugger option property can be overrides by the debugger parameter from the CLI parameter 
122     ''' named ``--echo``
123     ''' </summary>
124     ''' <returns></returns>
125     Public Property Mute As Boolean
126         Get
127             Return m_mute
128         End Get
129         Set(value As Boolean)
130             ' off的时候,不会输出任何信息
131             If m_level = DebuggerLevels.Off Then
132                 m_mute = True
133             Else
134                 m_mute = value
135             End If
136         End Set
137     End Property
138
139     ''' <summary>
140     ''' Force the app debugging output redirect into the std_error device.
141     ''' </summary>
142     ''' <returns></returns>
143     Public Property ForceSTDError As Boolean = False
144
145     ''' <summary>
146     ''' Test how long this <paramref name="test"/> will takes.
147     ''' </summary>
148     ''' <param name="test"></param>
149     ''' <param name="trace$"></param>
150     ''' <returns></returns>
151     <Extension>
152     Public Function BENCHMARK(test As Action, <CallerMemberName> Optional trace$ = NothingAs Long
153         Dim start = Now.ToLongTimeString
154         Dim ms& = Utils.Time(test)
155         Dim end$ = Now.ToLongTimeString
156
157         If Not Mute AndAlso m_level < DebuggerLevels.Warning Then
158             Dim head$ = $"Benchmark `{ms.FormatTicks}` {start} - {[end]}"
159             Dim str$ = " " & $"{trace} -> {CStrSafe(test.Target, "null")}::{test.Method.Name}"
160
161             Call My.Log4VB.Print(head, str, ConsoleColor.Magenta, ConsoleColor.Magenta)
162         End If
163
164         Return ms
165     End Function
166
167     ''' <summary>
168     ''' Output the full debug information while the project is debugging in debug mode.
169     ''' (向标准终端和调试终端输出一些带有时间戳的调试信息)
170     ''' </summary>
171     ''' <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>
172     ''' <param name="indent"></param>
173     ''' <returns>其实这个函数是不会返回任何东西的,只是因为为了Linq调试输出的需要,所以在这里是返回Nothing的</returns>
174     <Extension> Public Function __DEBUG_ECHO(msg$, Optional indent% = 0, Optional mute As Boolean = FalseAs String
175         Static indents$() = {"",
176             New String(" ", 1), New String(" ", 2), New String(" ", 3), New String(" ", 4),
177             New String(" ", 5), New String(" ", 6), New String(" ", 7), New String(" ", 8),
178             New String(" ", 9), New String(" ", 10)
179         }
180
181         If Not mute AndAlso Not VBDebugger.Mute AndAlso m_level < DebuggerLevels.Warning Then
182             Dim head As String = $"DEBUG {Now.ToString}"
183             Dim str As String = $"{indents(indent)} {msg}"
184
185             Call My.Log4VB.Print(head, str, ConsoleColor.White, MSG_TYPES.DEBUG)
186
187 #If DEBUG Then
188             Call Debug.WriteLine($"[{head}]{str}")
189 #End If
190         End If
191
192         Return Nothing
193     End Function
194
195     <Extension> Public Sub __INFO_ECHO(msg$)
196         If Not Mute AndAlso m_level < DebuggerLevels.Warning Then
197             Dim head As String = $"INFOM {Now.ToString}"
198             Dim str As String = " " & msg
199
200             Call My.Log4VB.Print(head, str, ConsoleColor.White, MSG_TYPES.INF)
201
202 #If DEBUG Then
203             Call Debug.WriteLine($"[{head}]{str}")
204 #End If
205         End If
206     End Sub
207
208     <MethodImpl(MethodImplOptions.AggressiveInlining)>
209     Public Sub AttachLoggingDriver(driver As LoggingDriver)
210         My.Log4VB.logs.Add(driver)
211     End Sub
212
213     ''' <summary>
214     ''' The function will print the exception details information on the standard <see cref="console"/>, <see cref="debug"/> console, and system <see cref="trace"/> console.
215     ''' (分别在标准终端,调试终端,系统调试终端之中打印出错误信息,请注意,函数会直接返回False可以用于指定调用者函数的执行状态,这个函数仅仅是在终端上面打印出错误,不会保存为日志文件)
216     ''' </summary>
217     ''' <typeparam name="ex"></typeparam>
218     ''' <param name="exception"></param>
219     ''' 
220     <MethodImpl(MethodImplOptions.AggressiveInlining)>
221     <Extension> Public Function PrintException(Of ex As Exception)(exception As ex, <CallerMemberName> Optional memberName$ = ""As Boolean
222         Return New Exception(memberName, exception).ToString.PrintException(memberName)
223     End Function
224
225     ''' <summary>
226     ''' 可以使用这个方法<see cref="MethodBase.GetCurrentMethod"/>.<see cref="GetFullName"/>获取得到<paramref name="memberName"/>所需要的参数信息
227     ''' </summary>
228     ''' <param name="msg"></param>
229     ''' <param name="memberName"></param>
230     ''' <returns></returns>
231     ''' 
232     <MethodImpl(MethodImplOptions.AggressiveInlining)>
233     <Extension>
234     Public Function PrintException(msg$, <CallerMemberName> Optional memberName$ = ""As Boolean
235         Return My.Log4VB.Print($"ERROR {Now.ToString}", $"<{memberName}>::{msg}", ConsoleColor.Red, MSG_TYPES.ERR)
236     End Function
237
238     ''' <summary>
239     ''' 等待调试器输出工作线程将内部的消息队列输出完毕
240     ''' </summary>
241     Public Sub WaitOutput()
242         Call My.InnerQueue.WaitQueue()
243     End Sub
244
245     ''' <summary>
246     ''' 使用<see cref="xConsole"/>输出消息
247     ''' </summary>
248     ''' <returns></returns>
249     Public Property UsingxConsole As Boolean = False
250
251     ''' <summary>
252     ''' 输出的终端消息带有指定的终端颜色色彩,当<see cref="UsingxConsole"/>为True的时候,
253     ''' <paramref name="msg"/>参数之中的文本字符串兼容<see cref="xConsole"/>语法,
254     ''' 而<paramref name="color"/>将会被<see cref="xConsole"/>覆盖而不会起作用
255     ''' </summary>
256     ''' <param name="msg">兼容<see cref="xConsole"/>语法</param>
257     ''' <param name="color">当<see cref="UsingxConsole"/>参数为True的时候,这个函数参数将不会起作用</param>
258     ''' 
259     <MethodImpl(MethodImplOptions.AggressiveInlining)>
260     <Extension>
261     Public Sub WriteLine(msg$, color As ConsoleColor)
262         My.Log4VB.WriteLine(msg, color)
263     End Sub
264
265     ''' <summary>
266     ''' Display the wraning level(YELLOW color) message on the console.
267     ''' </summary>
268     ''' <param name="msg"></param>
269     ''' <param name="calls"></param>
270     ''' <returns></returns>
271     <Extension>
272     Public Function Warning(msg As String, <CallerMemberName> Optional calls As String = ""As String
273         If Not Mute Then
274             Dim head As String = $"WARNG <{calls}> {Now.ToString}"
275
276             Call My.Log4VB.Print(head, " " & msg, ConsoleColor.Yellow, MSG_TYPES.DEBUG)
277 #If DEBUG Then
278             Call Debug.WriteLine($"[{head}]{msg}")
279 #End If
280         End If
281
282         Return Nothing
283     End Function
284
285     ''' <summary>
286     ''' 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.
287     ''' </summary>
288     ''' <param name="test"></param>
289     ''' <param name="fails"></param>
290     ''' <param name="level"></param>
291     ''' <param name="calls"></param>
292     <Extension>
293     Public Sub Assertion(test As Boolean, fails As String, level As MSG_TYPES, <CallerMemberName> Optional calls As String = "")
294         If Not test = True Then
295             If level = MSG_TYPES.DEBUG Then
296                 If m_level < DebuggerLevels.Warning Then
297                     Call fails.__DEBUG_ECHO(memberName:=calls)
298                 End If
299             ElseIf level = MSG_TYPES.ERR Then
300                 If m_level <> DebuggerLevels.Off Then
301                     Call WriteLine(fails, ConsoleColor.Red)
302                 End If
303             ElseIf level = MSG_TYPES.WRN Then
304                 If m_level <> DebuggerLevels.Error Then
305                     Call Warning(fails, calls)
306                 End If
307             Else
308                 If m_level < DebuggerLevels.Warning Then
309                     Call Console.WriteLine($"@{calls}::" & fails)
310                 End If
311             End If
312         End If
313     End Sub
314
315     ''' <summary>
316     ''' If the <paramref name="test"/> message is not null or empty string, then the console will output the message.
317     ''' </summary>
318     ''' <param name="test"></param>
319     ''' <param name="level"></param>
320     ''' <param name="calls"></param>
321     <Extension>
322     Public Sub Assertion(test As String, level As MSG_TYPES, <CallerMemberName> Optional calls As String = "")
323         Call VBDebugger.Assertion((String.IsNullOrEmpty(test) OrElse String.IsNullOrWhiteSpace(test)), test, level, calls)
324     End Sub
325
326     ''' <summary>
327     ''' Use an assert statement to disrupt normal execution if a boolean condition is false.
328     ''' If <paramref name="test"/> is false(means this assertion test failure), then throw exception.
329     ''' </summary>
330     ''' <param name="test"></param>
331     ''' <param name="msg"></param>
332     Public Sub Assertion(test As Boolean, msg As String, <CallerMemberName> Optional calls As String = "")
333         Dim null = test Or die(message:=msg, caller:=calls)
334     End Sub
335
336     Public Function Assert(test As Boolean,
337                            failed$,
338                            Optional success$ = Nothing,
339                            Optional failedLevel As MSG_TYPES = MSG_TYPES.ERR,
340                            <CallerMemberName> Optional calls As String = ""As Boolean
341         If test Then
342             If Not String.IsNullOrEmpty(success) Then
343                 Call success.__DEBUG_ECHO
344             End If
345
346             Return True
347         Else
348             Select Case failedLevel
349                 Case MSG_TYPES.DEBUG
350                     Call failed.__DEBUG_ECHO
351                 Case MSG_TYPES.ERR
352                     Call failed.PrintException(calls)
353                 Case MSG_TYPES.WRN
354                     Call failed.Warning(calls)
355                 Case Else
356                     Call failed.Echo(calls)
357             End Select
358
359             Return False
360         End If
361     End Function
362
363     ''' <summary>
364     ''' Output the full debug information while the project is debugging in debug mode.
365     ''' (向标准终端和调试终端输出一些带有时间戳的调试信息)
366     ''' </summary>
367     ''' <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>
368     ''' <param name="Indent"></param>
369     <MethodImpl(MethodImplOptions.AggressiveInlining)>
370     <Extension> Public Sub __DEBUG_ECHO(MSG As StringBuilder, Optional Indent As Integer = 0)
371         Call MSG.ToString.__DEBUG_ECHO(Indent)
372     End Sub
373
374     <Extension> Public Sub __DEBUG_ECHO(Of T)(value As T, <CallerMemberName> Optional memberName As String = "")
375         Call (Scripting.InputHandler.ToString(value) & "              @" & memberName).__DEBUG_ECHO
376     End Sub
377
378     ''' <summary>
379     ''' Returns the current function name.
380     ''' </summary>
381     ''' <param name="caller">
382     ''' The caller function name, do not assign any value to this parameter! Just leave it blank.
383     ''' </param>
384     ''' <returns></returns>
385     Public Function this(<CallerMemberName> Optional caller As String = ""As String
386         Return caller
387     End Function
388
389     <Extension> Public Sub Echo(Of T)(array As IEnumerable(Of T), <CallerMemberName> Optional memberName As String = "")
390         Call String.Join(", ", array.Select(Function(obj) Scripting.ToString(obj)).ToArray).__DEBUG_ECHO
391     End Sub
392
393     <Extension> Public Sub Echo(lines As IEnumerable(Of String))
394         For Each line$ In lines
395             Call Console.WriteLine(line)
396         Next
397     End Sub
398
399     ''' <summary>
400     ''' Alias for <see cref="Console.WriteLine"/>
401     ''' </summary>
402     ''' <param name="s$"></param>
403     <Extension> Public Sub EchoLine(s$)
404         If Not Mute Then
405             Call My.InnerQueue.AddToQueue(
406                 Sub()
407                     Call Console.WriteLine(s)
408                 End Sub)
409         End If
410     End Sub
411
412     ''' <summary>
413     ''' Alias for <see cref="Console.Write"/>
414     ''' </summary>
415     ''' <param name="c"></param>
416     <Extension> Public Sub Echo(c As Char)
417         If Not Mute Then
418             Call Console.Write(c)
419         End If
420     End Sub
421
422     ''' <summary>
423     ''' print message, alias for <see cref="Console.Write(String)"/>.(支持``sprintf``之中的转义字符)
424     ''' </summary>
425     ''' <param name="s$"></param>
426     Public Sub cat(s$)
427         If Not Mute Then
428             Call My.InnerQueue.AddToQueue(
429                 Sub()
430                     Call Console.Write(s.ReplaceMetaChars)
431                 End Sub)
432         End If
433     End Sub
434 End Module