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 OverloadsSub 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 StringAs {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 <= "9AndAlso 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 StringIn 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 = """"AndAlso value.Last = """"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