1 #Region "Microsoft.VisualBasic::aca9b021816bc788e9dc0f75d39f5a1b, 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
53 Namespace ApplicationServices.Development
54
55     Public Module VBCodeSignature
56
57         Const AccessPattern$ = "((Partial )|(Public )|(Private )|(Friend )|(Protected )|(Shadows )|(Shared )|(Overrides )|(Overloads )|(Overridable )|(MustOverrides )|(NotInheritable )|(MustInherit ))*"
58         Const TypePatterns$ = "^\s*" & AccessPattern & "((Class)|(Module)|(Structure)|(Enum)|(Delegate)|(Interface))\s+" & VBLanguage.IdentiferPattern
59         Const PropertyPatterns$ = "^\s+" & AccessPattern & "\s*((ReadOnly )|(WriteOnly )|(Default ))*\s*Property\s+" & VBLanguage.IdentiferPattern
60         Const MethodPatterns$ = "^\s+" & AccessPattern & "\s*((Sub )|(Function )|(Iterator )|(Operator ))+\s*" & VBLanguage.IdentiferPattern
61         Const OperatorPatterns$ = "^\s+" & AccessPattern & "\s*Operator\s+(([<]|[>]|\=|\+|\-|\*|/|\^|\\)+|(" & VBLanguage.IdentiferPattern & "))"
62         Const ClosePatterns$ = "^\s+End\s((Sub)|(Function)|(Class)|(Structure)|(Enum)|(Interface)|(Operator)|(Module))"
63         Const CloseTypePatterns$ = "^\s*End\s((Class)|(Structure)|(Enum)|(Interface)|(Module))"
64         Const IndentsPattern$ = "^\s+"
65         Const AttributePattern$ = "<.+?>\s*"
66
67         <MethodImpl(MethodImplOptions.AggressiveInlining)>
68         <Extension>
69         Public Function RemoveAttributes(line As StringAs String
70             Return r.Replace(line, AttributePattern, "", RegexICSng)
71         End Function
72
73         <MethodImpl(MethodImplOptions.AggressiveInlining)>
74         <Extension> Public Function SummaryModules(vb As StringAs String
75             Dim vblines As Pointer(Of String) = vb _
76                 .LineTokens _
77                 .Select(AddressOf RemoveAttributes) _
78                 .ToArray
79
80             With New StringBuilder
81                 Do While Not vblines.EndRead
82                     Call .AppendLine(vblines.SummaryInternal(vb))
83                 Loop
84
85                 Return .ToString
86             End With
87         End Function
88
89         <Extension>
90         Private Function SummaryInternal(vblines As Pointer(Of String), vb$) As String
91             Dim line$
92             Dim tokens As Value(Of String) = ""
93             Dim list As List(Of String)
94             Dim type$
95             Dim name$
96             Dim indents$
97             Dim properties As New List(Of NamedValue(Of String))
98             Dim methods As New List(Of NamedValue(Of String))
99             Dim operators As New List(Of NamedValue(Of String))
100             Dim container As New NamedValue(Of String)
101             Dim innerModules As New StringBuilder
102
103             Do While Not vblines.EndRead
104                 line = ++vblines
105
106                 If Not (tokens = line.Match(TypePatterns, RegexICMul)).StringEmpty Then
107                     list = tokens.Split(" "c).AsList
108                     type = list(-2)
109                     name = list(-1)
110                     indents = line.Match(IndentsPattern, RegexICMul)
111
112                     If type = "Enum" Then
113                         Dim members = vb _
114                             .Match("Enum\s+" & name & ".+?End Enum", RegexICSng) _
115                             .LineTokens _
116                             .Where(Function(s) s.IsPattern("\s+" & VBLanguage.IdentiferPattern & "\s*([=].+?)?\s*")) _
117                             .Select(AddressOf Trim) _
118                             .Where(Function(s) Not s.StringEmpty) _
119                             .ToArray
120
121                         Dim enumType As New StringBuilder
122                         Dim memberList = members.memberList
123
124                         enumType.AppendLine(indents & type & " " & name)
125                         enumType.AppendLine()
126
127                         For Each line In memberList
128                             enumType.AppendLine(indents & "    " & line)
129                         Next
130
131                         If container.IsEmpty Then
132                             Return enumType.ToString
133                         Else
134                             innerModules.AppendLine(enumType.ToString)
135                         End If
136                     Else
137                         If container.IsEmpty Then
138                             container = New NamedValue(Of String)(name, type, indents.Trim(ASCII.CR, ASCII.LF))
139                         Else
140                             ' 下一层堆栈
141                             innerModules.AppendLine((vblines - 1).SummaryInternal(vb))
142                         End If
143                     End If
144                 End If
145                 If Not (tokens = line.Match(PropertyPatterns, RegexICMul)).StringEmpty Then
146                     list = tokens.Split(" "c).AsList
147                     type = list(-2)
148                     name = list(-1)
149                     indents = line.Match(IndentsPattern, RegexICMul)
150
151                     properties += New NamedValue(Of String)(name, type, indents)
152                 End If
153                 If Not (tokens = line.Match(MethodPatterns, RegexICMul)).StringEmpty Then
154                     list = tokens.Split(" "c).AsList
155                     type = list(-2)
156                     name = list(-1)
157                     indents = line.Match(IndentsPattern, RegexICMul)
158
159                     If type = "Operator" Then
160                         operators += New NamedValue(Of String)(name, type, indents)
161                     Else
162                         methods += New NamedValue(Of String)(name, type, indents)
163                     End If
164                 End If
165                 If Not (tokens = line.Match(OperatorPatterns, RegexICMul)).StringEmpty Then
166                     list = tokens.Split(" "c).AsList
167                     type = list(-2)
168                     name = list(-1)
169                     indents = line.Match(IndentsPattern, RegexICMul)
170
171                     If type = "Operator" Then
172                         operators += New NamedValue(Of String)(name, type, indents)
173                     Else
174                         methods += New NamedValue(Of String)(name, type, indents)
175                     End If
176                 End If
177                 If Not (tokens = line.Match(CloseTypePatterns, RegexICMul)).StringEmpty Then
178                     Return container.typeSummary(properties, methods, operators, innerModules)
179                 End If
180             Loop
181
182             If Not container.IsEmpty Then
183                 Return container.typeSummary(properties, methods, operators, innerModules)
184             ElseIf Not innerModules.Length = 0 Then
185                 Return innerModules.ToString
186             Else
187                 Return ""
188             End If
189         End Function
190
191         <Extension>
192         Private Function typeSummary(container As NamedValue(Of String),
193                                      properties As List(Of NamedValue(Of String)),
194                                      methods As List(Of NamedValue(Of String)),
195                                      operators As List(Of NamedValue(Of String)),
196                                      innerModules As StringBuilder) As String
197
198             Dim vbType As New StringBuilder
199             Dim members As New List(Of String)
200             Dim prefix$
201             Dim lines$()
202
203             vbType.AppendLine(container.Description & container.Value & " " & container.Name)
204             vbType.AppendLine()
205
206             If Not properties.IsNullOrEmpty Then
207                 prefix = container.Description & "    Properties: "
208                 lines = properties.Keys.memberList
209                 members += prefix & lines(Scan0)
210
211                 If lines.Length > 1 Then
212                     members += lines _
213                         .Skip(1) _
214                         .Select(Function(l) New String(" "c, prefix.Length) & l) _
215                         .JoinBy(ASCII.LF)
216                 End If
217
218                 If Not methods.IsNullOrEmpty Then
219                     members += ""
220                 End If
221             End If
222             If Not methods.IsNullOrEmpty Then
223                 Dim constructors = methods _
224                     .Where(Function(s) s.Name = "New") _
225                     .ToArray
226                 Dim types = methods _
227                     .Where(Function(s) s.Name <> "New") _
228                     .GroupBy(Function(m) m.Value) _
229                     .ToDictionary(Function(t) t.Key,
230                                   Function(l) l.Keys.memberList)
231
232                 If constructors.Length > 0 Then
233                     members += container.Description & $"    Constructor: (+{constructors.Count} OverloadsSub New"
234
235                     If types.Count > 1 Then
236                         members += ""
237                     End If
238                 End If
239
240                 If types.ContainsKey("Function"Then
241                     prefix = container.Description & $"    Function: "
242                     members += prefix & types!Function.First
243
244                     If types!Function.Length > 1 Then
245                         members += types!Function _
246                             .Skip(1) _
247                             .Select(Function(l) New String(" "c, prefix.Length) & l) _
248                             .JoinBy(ASCII.LF)
249                     End If
250
251                     If types.Count > 1 Then
252                         members += ""
253                     End If
254                 End If
255                 If types.ContainsKey("Sub"Then
256                     prefix = container.Description & $"    Sub: "
257                     members += prefix & types!Sub.First
258
259                     If types!Sub.Length > 1 Then
260                         members += types!Sub _
261                             .Skip(1) _
262                             .Select(Function(l) New String(" "c, prefix.Length) & l) _
263                             .JoinBy(ASCII.LF)
264                     End If
265
266                     If Not operators.IsNullOrEmpty Then
267                         members += ""
268                     End If
269                 End If
270             End If
271             If Not operators.IsNullOrEmpty Then
272                 prefix = container.Description & "    Operators: "
273                 lines = operators.Keys.memberList
274                 members += prefix & lines(Scan0)
275
276                 If lines.Length > 1 Then
277                     members += lines _
278                         .Skip(1) _
279                         .Select(Function(l) New String(" "c, prefix.Length) & l) _
280                         .JoinBy(ASCII.LF)
281                 End If
282             End If
283
284             vbType.AppendLine(members.JoinBy(ASCII.LF))
285
286             If innerModules.Length > 0 Then
287                 vbType.AppendLine(innerModules.ToString)
288             End If
289
290             Return vbType.ToString
291         End Function
292
293         <MethodImpl(MethodImplOptions.AggressiveInlining)>
294         <Extension> Private Function memberList(names As IEnumerable(Of String)) As String()
295             Return names _
296                 .GroupBy(Function(pName) pName) _
297                 .OrderBy(Function(pName) pName.Key) _
298                 .Select(Function(overload)
299                             If overload.Count = 1 Then
300                                 Return overload.Key
301                             Else
302                                 Return $"(+{overload.Count} Overloads) " & overload.Key
303                             End If
304                         End Function) _
305                 .Split(5) _
306                 .Select(Function(part) part.JoinBy(", ")) _
307                 .ToArray
308         End Function
309     End Module
310 End Namespace