1	#Region "Microsoft.VisualBasic::45d21ea902dbe434ef06bebc197d1579, Microsoft.VisualBasic.Core\ApplicationServices\VBDev\Signature\VBCodeSignature.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 VBCodeSignature
35	'
36	'         Function: memberList, RemoveAttributes, SummaryInternal, SummaryModules, typeSummary
37	'
38	'
39	' /********************************************************************************/
40
41	#End Region
42
43	Imports System.Runtime.CompilerServices
44	Imports System.Text
45	Imports Microsoft.VisualBasic.ComponentModel.DataSourceModel
46	Imports Microsoft.VisualBasic.Emit.Marshal
47	Imports Microsoft.VisualBasic.Language
48	Imports Microsoft.VisualBasic.Language.Values
49	Imports Microsoft.VisualBasic.Scripting.SymbolBuilder
50	Imports Microsoft.VisualBasic.Text
51	Imports r = System.Text.RegularExpressions.Regex
52	Imports VBCodePatterns = Microsoft.VisualBasic.Scripting.SymbolBuilder.VBLanguage.Patterns
53
54	Namespace ApplicationServices.Development
55
56	''' <summary>
57	''' 在这个模块之中对VB的代码文件进行大纲摘要的提取操作
58	''' </summary>
59	Public Module VBCodeSignature
60
61	<MethodImpl(MethodImplOptions.AggressiveInlining)>
62	<Extension>
63	Public Function RemoveAttributes(line As String) As String
64	Return r.Replace(line, VBCodePatterns.Attribute, "", RegexICSng)
65	End Function
66
67	<MethodImpl(MethodImplOptions.AggressiveInlining)>
68	<Extension> Public Function SummaryModules(vb As String) As String
69	Dim vblines As Pointer(Of String) = vb _
70	.LineTokens _
71	.Select(AddressOf RemoveAttributes) _
72	.ToArray
73
74	With New StringBuilder
75	Do While Not vblines.EndRead
76	Call .AppendLine(vblines.SummaryInternal(vb))
77	Loop
78
79	Return .ToString
80	End With
81	End Function
82
83	<Extension>
84	Private Function SummaryInternal(vblines As Pointer(Of String), vb$) As String
85	Dim line$
86	Dim tokens As Value(Of String) = ""
87	Dim list As List(Of String)
88	Dim type$
89	Dim name$
90	Dim indents$
91	Dim properties As New List(Of NamedValue(Of String))
92	Dim methods As New List(Of NamedValue(Of String))
93	Dim operators As New List(Of NamedValue(Of String))
94	Dim container As New NamedValue(Of String)
95	Dim innerModules As New StringBuilder
96
97	Do While Not vblines.EndRead
98	line = ++vblines
99
100	If Not (tokens = line.Match(VBCodePatterns.Type, RegexICMul)).StringEmpty Then
101	list = tokens.Split(" "c).AsList
102	type = list(-2)
103	name = list(-1)
104	indents = line.Match(VBCodePatterns.Indents, RegexICMul)
105
106	If type = "Enum" Then
107	Dim members = vb _
108	.Match("Enum\s+" & name & ".+?End Enum", RegexICSng) _
109	.LineTokens _
110	.Where(Function(s) s.IsPattern("\s+" & VBCodePatterns.Identifer & "\s*([=].+?)?\s*")) _
111	.Select(AddressOf Trim) _
112	.Where(Function(s) Not s.StringEmpty) _
113	.ToArray
114
115	Dim enumType As New StringBuilder
116	Dim memberList = members.memberList
117
118	enumType.AppendLine(indents & type & " " & name)
119	enumType.AppendLine()
120
121	For Each line In memberList
122	enumType.AppendLine(indents & "    " & line)
123	Next
124
125	If container.IsEmpty Then
126	Return enumType.ToString
127	Else
128	innerModules.AppendLine(enumType.ToString)
129	End If
130	Else
131	If container.IsEmpty Then
132	container = New NamedValue(Of String)(name, type, indents.Trim(ASCII.CR, ASCII.LF))
133	Else
134	' 下一层堆栈
135	innerModules.AppendLine((vblines - 1).SummaryInternal(vb))
136	End If
137	End If
138	End If
139	If Not (tokens = line.Match(VBCodePatterns.Property, RegexICMul)).StringEmpty Then
140	list = tokens.Split(" "c).AsList
141	type = list(-2)
142	name = list(-1)
143	indents = line.Match(VBCodePatterns.Indents, RegexICMul)
144
145	properties += New NamedValue(Of String)(name, type, indents)
146	End If
147	If Not (tokens = line.Match(VBCodePatterns.Method, RegexICMul)).StringEmpty Then
148	list = tokens.Split(" "c).AsList
149	type = list(-2)
150	name = list(-1)
151	indents = line.Match(VBCodePatterns.Indents, RegexICMul)
152
153	If type = "Operator" Then
154	operators += New NamedValue(Of String)(name, type, indents)
155	Else
156	methods += New NamedValue(Of String)(name, type, indents)
157	End If
158	End If
159	If Not (tokens = line.Match(VBCodePatterns.Operator, RegexICMul)).StringEmpty Then
160	list = tokens.Split(" "c).AsList
161	type = list(-2)
162	name = list(-1)
163	indents = line.Match(VBCodePatterns.Indents, RegexICMul)
164
165	If type = "Operator" Then
166	operators += New NamedValue(Of String)(name, type, indents)
167	Else
168	methods += New NamedValue(Of String)(name, type, indents)
169	End If
170	End If
171	If Not (tokens = line.Match(VBLanguage.Patterns.CloseType, RegexICMul)).StringEmpty Then
172	Return container.typeSummary(properties, methods, operators, innerModules)
173	End If
174	Loop
175
176	If Not container.IsEmpty Then
177	Return container.typeSummary(properties, methods, operators, innerModules)
178	ElseIf Not innerModules.Length = 0 Then
179	Return innerModules.ToString
180	Else
181	Return ""
182	End If
183	End Function
184
185	<Extension>
186	Private Function typeSummary(container As NamedValue(Of String),
187	properties As List(Of NamedValue(Of String)),
188	methods As List(Of NamedValue(Of String)),
189	operators As List(Of NamedValue(Of String)),
190	innerModules As StringBuilder) As String
191
192	Dim vbType As New StringBuilder
193	Dim members As New List(Of String)
194	Dim prefix$
195	Dim lines$()
196
197	vbType.AppendLine(container.Description & container.Value & " " & container.Name)
198	vbType.AppendLine()
199
200	If Not properties.IsNullOrEmpty Then
201	prefix = container.Description & "    Properties: "
202	lines = properties.Keys.memberList
203	members += prefix & lines(Scan0)
204
205	If lines.Length > 1 Then
206	members += lines _
207	.Skip(1) _
208	.Select(Function(l) New String(" "c, prefix.Length) & l) _
209	.JoinBy(ASCII.LF)
210	End If
211
212	If Not methods.IsNullOrEmpty Then
213	members += ""
214	End If
215	End If
216	If Not methods.IsNullOrEmpty Then
217	Dim constructors = methods _
218	.Where(Function(s) s.Name = "New") _
219	.ToArray
220	Dim types = methods _
221	.Where(Function(s) s.Name <> "New") _
222	.GroupBy(Function(m) m.Value) _
223	.ToDictionary(Function(t) t.Key,
224	Function(l) l.Keys.memberList)
225
226	If constructors.Length > 0 Then
227	members += container.Description & $"    Constructor: (+{constructors.Count} Overloads) Sub New"
228
229	If types.Count > 1 Then
230	members += ""
231	End If
232	End If
233
234	If types.ContainsKey("Function") Then
235	prefix = container.Description & $"    Function: "
236	members += prefix & types!Function.First
237
238	If types!Function.Length > 1 Then
239	members += types!Function _
240	.Skip(1) _
241	.Select(Function(l) New String(" "c, prefix.Length) & l) _
242	.JoinBy(ASCII.LF)
243	End If
244
245	If types.Count > 1 Then
246	members += ""
247	End If
248	End If
249	If types.ContainsKey("Sub") Then
250	prefix = container.Description & $"    Sub: "
251	members += prefix & types!Sub.First
252
253	If types!Sub.Length > 1 Then
254	members += types!Sub _
255	.Skip(1) _
256	.Select(Function(l) New String(" "c, prefix.Length) & l) _
257	.JoinBy(ASCII.LF)
258	End If
259
260	If Not operators.IsNullOrEmpty Then
261	members += ""
262	End If
263	End If
264	End If
265	If Not operators.IsNullOrEmpty Then
266	prefix = container.Description & "    Operators: "
267	lines = operators.Keys.memberList
268	members += prefix & lines(Scan0)
269
270	If lines.Length > 1 Then
271	members += lines _
272	.Skip(1) _
273	.Select(Function(l) New String(" "c, prefix.Length) & l) _
274	.JoinBy(ASCII.LF)
275	End If
276	End If
277
278	vbType.AppendLine(members.JoinBy(ASCII.LF))
279
280	If innerModules.Length > 0 Then
281	vbType.AppendLine(innerModules.ToString)
282	End If
283
284	Return vbType.ToString
285	End Function
286
287	<MethodImpl(MethodImplOptions.AggressiveInlining)>
288	<Extension> Private Function memberList(names As IEnumerable(Of String)) As String()
289	Return names _
290	.GroupBy(Function(pName) pName) _
291	.OrderBy(Function(pName) pName.Key) _
292	.Select(Function(overload)
293	If overload.Count = 1 Then
294	Return overload.Key
295	Else
296	Return $"(+{overload.Count} Overloads) " & overload.Key
297	End If
298	End Function) _
299	.Split(5) _
300	.Select(Function(part) part.JoinBy(", ")) _
301	.ToArray
302	End Function
303	End Module
304	End Namespace