1	#Region "Microsoft.VisualBasic::125a6d44d8c1671566edd5ee1a66651c, Microsoft.VisualBasic.Core\CommandLine\InteropService\SharedORM\VisualBasic.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	'     Class VisualBasic
35	'
36	'         Constructor: (+2 Overloads) Sub New
37	'
38	'         Function: __CLI, __defaultValue, __normalizedAsIdentifier, __vbParameters, __xmlComments
39	'                   GetSourceCode
40	'
41	'         Sub: __calls
42	'
43	'
44	' /********************************************************************************/
45
46	#End Region
47
48	Imports System.Runtime.CompilerServices
49	Imports System.Text
50	Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel
51	Imports Microsoft.VisualBasic.Language
52	Imports Microsoft.VisualBasic.Scripting.SymbolBuilder.VBLanguage
53	Imports Microsoft.VisualBasic.Text
54	Imports Microsoft.VisualBasic.Text.Xml
55
56	Namespace CommandLine.InteropService.SharedORM
57
58	Public Class VisualBasic : Inherits CodeGenerator
59
60	Dim namespace$
61
62	<MethodImpl(MethodImplOptions.AggressiveInlining)>
63	Public Sub New(CLI As Type, namespace$)
64	Me.New(New Interpreter(type:=CLI), [namespace])
65	End Sub
66
67	Sub New(App As Interpreter, Optional namespace$ = Nothing)
68	Call MyBase.New(App)
69	Me.namespace = [namespace] Or App.Type.Name.AsDefault
70	End Sub
71
72	Public Overrides Function GetSourceCode() As String
73	Dim vb As New StringBuilder
74	Dim className$ = MyBase.exe _
75	.NormalizePathString(OnlyASCII:=True) _
76	.Replace(" ", "_")
77	Dim rel$ = PathExtensions.RelativePath(App.Type.Assembly.Location.GetFullPath)
78	Dim info$ = App.Type.NamespaceEntry.Description
79	Dim appName$ = KeywordProcessor.AutoEscapeVBKeyword(className)
80
81	Call vb.AppendLine("Imports System.Runtime.CompilerServices")
82	Call vb.AppendLine("Imports " & GetType(StringBuilder).Namespace)
83	Call vb.AppendLine("Imports " & GetType(IIORedirectAbstract).Namespace)
84	Call vb.AppendLine("Imports " & GetType(InteropService).Namespace)
85	Call vb.AppendLine("Imports Microsoft.VisualBasic.ApplicationServices")
86	Call vb.AppendLine()
87	Call vb.AppendLine("' Microsoft VisualBasic CommandLine Code AutoGenerator")
88	Call vb.AppendLine("' assembly: " & rel)
89	Call vb.AppendLine()
90	Call vb.AppendLine(GetManualPage.LineTokens.Select(Function(l) "' " & l).JoinBy(vbCrLf))
91	Call vb.AppendLine()
92	Call vb.AppendLine("Namespace " & [namespace])
93	Call vb.AppendLine()
94	Call vb.AppendLine(__xmlComments(XmlEntity.EscapingXmlEntity(info)))
95	Call vb.AppendLine($"Public Class {appName} : Inherits {GetType(InteropService).Name}")
96	Call vb.AppendLine()
97	Call vb.AppendLine($"    Public Const App$ = ""{exe}.exe""")
98	Call vb.AppendLine()
99	Call vb.AppendLine("    Sub New(App$)")
100	Call vb.AppendLine($"        MyBase.{NameOf(InteropService._executableAssembly)} = App$")
101	Call vb.AppendLine("    End Sub")
102	Call vb.AppendLine()
103	Call vb.AppendLine("     <MethodImpl(MethodImplOptions.AggressiveInlining)>")
104	Call vb.AppendLine($"    Public Shared Function FromEnvironment(directory As String) As {appName}")
105	Call vb.AppendLine($"          Return New {appName}(App:=directory & ""/"" & {appName}.App)")
106	Call vb.AppendLine("     End Function")
107
108	For Each API In Me.EnumeratesAPI
109	Call __calls(vb, API.CLI, incompatible:=Not InCompatibleAttribute.CLRProcessCompatible(API.API))
110	Next
111
112	Call vb.AppendLine("End Class")
113	Call vb.AppendLine("End Namespace")
114
115	Return vb.ToString
116	End Function
117
118	Private Shared Function __xmlComments(description$) As String
119	If description.StringEmpty Then
120	description = "<span class="xml_comment">'''"</span>
121	Else
122	description = description _
123	.LineTokens _
124	.Select(Function(s) "''' " & s.Trim(" "c, ASCII.TAB)) _
125	.JoinBy(vbCrLf)
126	End If
127
128	Return $"
129	<span class="xml_comment">''' <summary></span>
130	{description}
131	<span class="xml_comment">''' </summary></span>
132	<span class="xml_comment">'''"</span>
133	End Function
134
135	<span class="xml_comment">''' <summary></span>
136	<span class="xml_comment">''' </span>
137	<span class="xml_comment">''' </summary></span>
138	<span class="xml_comment">''' <param name="vb"></param></span>
139	<span class="xml_comment">''' <param name="API"></param></span>
140	<span class="xml_comment">''' <remarks></span>
141	<span class="xml_comment">''' </remarks></span>
142	Private Sub __calls(vb As StringBuilder, API As NamedValue(Of CommandLine), incompatible As Boolean)
143
144	#Region "Code template"
145
146	' Public Function CommandName(args$,....Optional args$....) As Integer
147	'     Dim CLI$ = "commandname arguments"
148	'     Dim proc As IIORedirectAbstract = RunDotNetApp(CLI$)
149	'
150	'     Return proc.Run()
151	' End Function
152	#End Region
153
154	' 直接使用函数原型的名字了，会比较容易辨别一些
155	Dim func$ = API.Name
156	' Xml comment 已经是经过转义了的，所以不需要再做xml entity的转义了
157	Dim xmlComments$ = __xmlComments(API.Description)
158	Dim params$()
159
160	Try
161	If func.First <= "9" AndAlso func.First >= "0"c Then
162	func = "_" & func  ' 有些命令行开关是以数字开头的？
163	Else
164	' 不是以数字开头的，则尝试解决关键词的问题
165	func = KeywordProcessor.AutoEscapeVBKeyword(func)
166	End If
167	params = __vbParameters(API.Value)
168	Catch ex As Exception
169	ex = New Exception("Check for your CLI Usage definition: " & API.Value.ToString, ex)
170	Throw ex
171	End Try
172
173	Call vb.AppendLine(xmlComments)
174
175	Call vb.AppendLine($"Public Function {func}({params.JoinBy(", ")}) As Integer")
176	Call vb.AppendLine($"    Dim CLI As New StringBuilder(""{API.Value.Name}"")")
177	Call vb.AppendLine("    Call CLI.Append("" "")") ' 插入命令名称和参数值之间的一个必须的空格
178	Call vb.AppendLine(__CLI(+API))
179	Call vb.AppendLine()
180
181	If incompatible Then
182	' 这个CLI是不兼容的方法
183	Call vb.AppendLine($"    Dim proc As {NameOf(IIORedirectAbstract)} = {NameOf(InteropService.RunProgram)}(CLI.ToString(), Nothing)")
184	Else
185	' 兼容的
186	Call vb.AppendLine($"    Dim proc As {NameOf(IIORedirectAbstract)} = {NameOf(InteropService.RunDotNetApp)}(CLI.ToString())")
187	End If
188
189	Call vb.AppendLine($"    Return proc.{NameOf(IIORedirectAbstract.Run)}()")
190	Call vb.AppendLine("End Function")
191	End Sub
192
193
194	<span class="xml_comment">''' <summary></span>
195	<span class="xml_comment">''' 在这个函数之中会生成函数的参数列表</span>
196	<span class="xml_comment">''' </summary></span>
197	<span class="xml_comment">''' <param name="API"></param></span>
198	<span class="xml_comment">''' <returns></returns></span>
199	Private Shared Function __vbParameters(API As CommandLine) As String()
200	Dim out As New List(Of String)
201	Dim param$
202
203	For Each arg As NamedValue(Of String) In API.ParameterList
204	param = $"{VisualBasic.__normalizedAsIdentifier(arg.Name)} As String"
205
206	If Not arg.Description.StringEmpty Then
207	' 可选参数
208	param = $"Optional {param} = ""{__defaultValue(arg.Value)}"""
209	End If
210
211	out += param
212	Next
213	For Each bool In API.BoolFlags
214	out += $"Optional {VisualBasic.__normalizedAsIdentifier(bool)} As Boolean = False"
215	Next
216
217	Return out
218	End Function
219
220	''' <summary>
221	''' 必须是以``default=``来作为前缀的，否则默认使用空字符串
222	''' </summary>
223	''' <param name="value$"></param>
224	''' <returns></returns>
225	Private Shared Function __defaultValue(value$) As String
226	If value.First = """"c AndAlso value.Last = """"c Then
227	' 如果是直接使用双引号包裹而不是使用<>尖括号进行包裹，则认为双引号所包裹的值都是默认值
228	value = value.GetStackValue(ASCII.Quot, ASCII.Quot)
229	ElseIf value.First = "<"c AndAlso value.Last = ">"c Then
230	' 而如果是使用尖括号的时候，则判断是否存在default=表达式，不存在则是空值
231	value = value.GetStackValue("<", ">")
232
233	If InStr(value, "default=") > 0 Then
234	value = Strings.Split(value, "default=").Last.Trim(""""c)
235	Else
236	value = "" ' 没有表达式前缀，则使用默认的空字符串
237	End If
238	Else
239	' 其他情况都认为是使用空值为默认值
240	value = ""
241	End If
242
243	value = value.Replace(""""c, New String(ASCII.Quot, 2))
244
245	Return value
246	End Function
247
248	Private Shared Function __CLI(API As CommandLine) As String
249	Dim CLI As New StringBuilder
250	Dim vbcode$
251
252	For Each param In API.ParameterList
253	Dim var$ = __normalizedAsIdentifier(param.Name)
254
255	' 注意：在这句代码的最后有一个空格，是间隔参数所必需的，不可以删除
256	vbcode = $"    Call CLI.Append(""{param.Name} "" & """""""" & {var} & """""" "")"
257
258	If param.Description.StringEmpty Then
259	' 必须参数不需要进一步判断，直接添加
260	Call CLI.AppendLine(vbcode)
261	Else
262	' 可选参数还需要IF判断是否存在
263	Call CLI.AppendLine($"    If Not {var}.{NameOf(StringEmpty)} Then")
264	Call CLI.AppendLine("        " & vbcode)
265	Call CLI.AppendLine("    End If")
266	End If
267	Next
268
269	For Each b In API.BoolFlags
270	Dim var$ = __normalizedAsIdentifier(b)
271
272	Call CLI.AppendLine($"    If {var} Then")
273	Call CLI.AppendLine($"        Call CLI.Append(""{b} "")") ' 逻辑参数后面有一个空格，是正确的生成CLI所必需的
274	Call CLI.AppendLine("    End If")
275	Next
276
277	Return CLI.ToString
278	End Function
279
280	Const SyntaxError$ = "'<' or '>' is using for the IO redirect in your terminal, unavailable for your commandline argument name!"
281
282	''' <summary>
283	''' 将命令行参数的名称转义为VB之中有效的对象标识符
284	''' </summary>
285	''' <param name="arg$"></param>
286	''' <returns></returns>
287	Private Shared Function __normalizedAsIdentifier(arg$) As String
288	' 在命令行的参数名称前面一般都会有/-之类的控制符前缀，在这里去掉
289	Dim name$ = arg.Trim("/"c, "\"c, "-"c)
290	Dim s As Char() = name.ToArray
291	Dim upper As Char() = name.ToUpper.ToArray
292	Dim c As Char
293
294	If s.First = "<"c OrElse s.Last = ">"c Then
295	Throw New SyntaxErrorException(SyntaxError)
296	End If
297
298	For i As Integer = 0 To s.Length - 1
299	c = upper(i)
300
301	If (c >= "A"c AndAlso c <= "Z"c) OrElse (c >= "0"c AndAlso c <= "9"c) OrElse (c = "_") Then
302	' 合法的字符，不做处理
303	Else
304	' 非法字符串都被替换为下划线
305	s(i) = "_"c
306	End If
307	Next
308
309	If s.First >= "0"c AndAlso s.First <= "9"c Then
310	Return "_" & New String(s)
311	Else
312	' 可能会存在in, byref, class这类的名字，需要在这里转义一下
313	Return KeywordProcessor.AutoEscapeVBKeyword(New String(s))
314	End If
315	End Function
316	End Class
317	End Namespace