1	#Region "Microsoft.VisualBasic::ecc48fd610cb63e9c7f3889cc31b8ab7, Microsoft.VisualBasic.Core\ApplicationServices\Utils.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 Utils
35	'
36	'         Function: FormatTicks, TaskRun, (+2 Overloads) Time
37	'
38	'         Sub: TryRun
39	'         Delegate Function
40	'
41	'             Function: CLIPath, CLIToken, FileMimeType, GetMIMEDescrib
42	'
43	'             Sub: (+2 Overloads) Wait
44	'
45	'
46	'
47	' /********************************************************************************/
48
49	#End Region
50
51	Imports System.Runtime.CompilerServices
52	Imports System.Threading
53	Imports Microsoft.VisualBasic.CommandLine.Reflection
54	Imports Microsoft.VisualBasic.Net.Protocols.ContentTypes
55	Imports Microsoft.VisualBasic.Parallel.Tasks
56
57	Namespace ApplicationServices
58
59	''' <summary>
60	''' App utils
61	''' </summary>
62	Public Module Utils
63
64	''' <summary>
65	''' Call target <see cref="Action"/> delegate, if exception occurs in the action,
66	''' then this function will logs the exception and exit without thorw an exception.
67	''' </summary>
68	''' <param name="task"></param>
69	''' <param name="stack$"></param>
70	<Extension>
71	Public Sub TryRun(task As Action, <CallerMemberName> Optional stack$ = Nothing)
72	Try
73	Call task()
74	Catch ex As Exception
75	Call $"[{stack}] {task.Method.ToString} failure!".Warning
76	Call App.LogException(ex)
77	End Try
78	End Sub
79
80	''' <summary>
81	''' Run background task, if the <see cref="AsyncHandle(Of Exception).GetValue()"/> returns nothing,
82	''' then means the task run no errors.
83	''' </summary>
84	''' <param name="task"></param>
85	''' <param name="stack">进行调用堆栈的上一层的栈名称</param>
86	''' <returns></returns>
87	<Extension> Public Function TaskRun(task As Action, <CallerMemberName> Optional stack$ = Nothing) As AsyncHandle(Of Exception)
88	Dim handle = Function() As Exception
89	Try
90	Call task()
91	Catch ex As Exception
92	Return New Exception(stack, ex)
93	End Try
94
95	Return Nothing
96	End Function
97	Return New AsyncHandle(Of Exception)(handle).Run
98	End Function
99
100	''' <summary>
101	''' Returns the total executation time of the target <paramref name="work"/>.
102	''' (性能测试工具，函数之中会自动输出整个任务所经历的处理时长)
103	''' </summary>
104	''' <param name="work">
105	''' Function pointer of the task work that needs to be tested.(需要测试性能的工作对象)
106	''' </param>
107	''' <returns>Returns the total executation time of the target <paramref name="work"/>. ms</returns>
108	Public Function Time(work As Action) As Long
109	Dim startTick As Long = App.NanoTime
110
111	' -------- start worker ---------
112	Call work()
113	' --------- end worker ---------
114
115	Dim endTick As Long = App.NanoTime
116	Dim t& = (endTick - startTick) / TimeSpan.TicksPerMillisecond
117	Return t
118	End Function
119
120	Public Function Time(Of T)(work As Func(Of T), Optional ByRef ms& = 0, Optional tick As Boolean = True, Optional trace$ = Nothing) As T
121	Dim tickTask As AsyncHandle(Of Exception)
122
123	If tick Then
124	tickTask = Utils.TaskRun(
125	Sub()
126	Do While tick
127	Call Console.Write(".")
128	Call Thread.Sleep(1000)
129	Loop
130	End Sub)
131	End If
132
133	Dim value As T
134	Dim task As Action = Sub() value = work()
135
136	task.BENCHMARK(trace)
137	tick = False  ' 需要使用这个变量的变化来控制 tickTask 里面的过程
138
139	Return value
140	End Function
141
142	''' <summary>
143	''' Format ``ms`` for content print.
144	''' </summary>
145	''' <param name="ms"></param>
146	''' <returns></returns>
147	<Extension> Public Function FormatTicks(ms&) As String
148	If ms > 1000 Then
149	Dim s = ms / 1000
150
151	If s < 1000 Then
152	Return s & "s"
153	Else
154	Dim min = s \ 60
155	Return $"{min}min{s Mod 60}s"
156	End If
157	Else
158	Return ms & "ms"
159	End If
160	End Function
161
162	Public Delegate Function WaitHandle() As Boolean
163
164	''' <summary>
165	''' 假若条件判断<paramref name="handle"/>不为真的话，函数会一直阻塞线程，直到条件判断<paramref name="handle"/>为真
166	''' </summary>
167	''' <param name="handle"></param>
168	<Extension> Public Sub Wait(handle As Func(Of Boolean))
169	If handle Is Nothing Then
170	Return
171	End If
172
173	Do While handle() = False
174	Call Thread.Sleep(10)
175	Call Application.DoEvents()
176	Loop
177	End Sub
178
179	''' <summary>
180	''' 假若条件判断<paramref name="handle"/>不为真的话，函数会一直阻塞线程，直到条件判断<paramref name="handle"/>为真
181	''' </summary>
182	''' <param name="handle"></param>
183	<Extension> Public Sub Wait(handle As WaitHandle)
184	If handle Is Nothing Then
185	Return
186	End If
187
188	Do While handle() = False
189	Call Thread.Sleep(10)
190	Call Application.DoEvents()
191	Loop
192	End Sub
193
194	''' <summary>
195	''' If the path string value is already wrappered by quot, then this function will returns the original string (DO_NOTHING).
196	''' (假若命令行之中的文件名参数之中含有空格的话，则可能会造成错误，需要添加一个双引号来消除歧义)
197	''' </summary>
198	''' <param name="path"></param>
199	''' <returns></returns>
200	'''
201	<ExportAPI("CLI_PATH")>
202	<Extension> Public Function CLIPath(path As String) As String
203	If String.IsNullOrEmpty(path) Then
204	Return ""
205	Else
206	path = path.Replace("\", "/")  '这个是R、Java、Perl等程序对路径的要求所导致的
207	Return path.CLIToken
208	End If
209	End Function
210
211	''' <summary>
212	''' <see cref="CLIPath(String)"/>函数为了保持对Linux系统的兼容性会自动替换\为/符号，这个函数则不会执行这个替换
213	''' </summary>
214	''' <param name="token"></param>
215	''' <returns></returns>
216	<Extension> Public Function CLIToken(token As String) As String
217	If String.IsNullOrEmpty(token) OrElse Not Len(token) > 2 Then
218	Return token
219	End If
220
221	If token.First = """"c AndAlso token.Last = """"c Then
222	Return token
223	End If
224	If token.Contains(" "c) Then
225	token = $"""{token}"""
226	End If
227
228	Return token
229	End Function
230
231	''' <summary>
232	''' ``*.txt -> text``，这个函数是作用于文件的拓展名之上的
233	''' </summary>
234	''' <param name="ext$"></param>
235	''' <returns></returns>
236	<Extension> Public Function GetMIMEDescrib(ext$) As ContentType
237	Dim key$ = LCase(ext).Trim("*"c)
238
239	If MIME.SuffixTable.ContainsKey(key) Then
240	Return MIME.SuffixTable(key)
241	Else
242	Return MIME.UnknownType
243	End If
244	End Function
245
246	''' <summary>
247	''' 与<see cref="GetMIMEDescrib(String)"/>所不同的是，这个函数是直接作用于文件路径之上的。
248	''' </summary>
249	''' <param name="path"></param>
250	''' <returns></returns>
251	<MethodImpl(MethodImplOptions.AggressiveInlining)>
252	<Extension>
253	Public Function FileMimeType(path As String) As ContentType
254	Return ("*." & path.ExtensionSuffix).GetMIMEDescrib
255	End Function
256	End Module
257	End Namespace