1
- using Rubberduck . Common ;
2
- using Rubberduck . Parsing ;
1
+ using Rubberduck . Parsing ;
3
2
using Rubberduck . Parsing . Grammar ;
4
3
using Rubberduck . Parsing . Symbols ;
5
4
using System ;
@@ -35,7 +34,7 @@ string BuildMemberBlockFromPrototype(ModuleBodyElementDeclaration declaration,
35
34
/// <summary>
36
35
/// Generates a Property Get codeblock based on the prototype declaration
37
36
/// </summary>
38
- /// <param name="prototype">VariableDeclaration or UserDefinedTypeMember</param>
37
+ /// <param name="prototype">DeclarationType with flags: Variable, Constant, UserDefinedTypeMember, or Function </param>
39
38
/// <param name="content">Member body content. Formatting is the responsibility of the caller</param>
40
39
/// <param name="parameterIdentifier">Defaults to '<paramref name="propertyIdentifier"/>Value' unless otherwise specified</param>
41
40
bool TryBuildPropertyGetCodeBlock ( Declaration prototype ,
@@ -47,7 +46,7 @@ bool TryBuildPropertyGetCodeBlock(Declaration prototype,
47
46
/// <summary>
48
47
/// Generates a Property Let codeblock based on the prototype declaration
49
48
/// </summary>
50
- /// <param name="prototype">VariableDeclaration or UserDefinedTypeMember</param>
49
+ /// <param name="prototype">DeclarationType with flags: Variable, Constant, UserDefinedTypeMember, or Function </param>
51
50
/// <param name="content">Member body content. Formatting is the responsibility of the caller</param>
52
51
/// <param name="parameterIdentifier">Defaults to '<paramref name="propertyIdentifier"/>Value' unless otherwise specified</param>
53
52
bool TryBuildPropertyLetCodeBlock ( Declaration prototype ,
@@ -60,7 +59,7 @@ bool TryBuildPropertyLetCodeBlock(Declaration prototype,
60
59
/// <summary>
61
60
/// Generates a Property Set codeblock based on the prototype declaration
62
61
/// </summary>
63
- /// <param name="prototype">VariableDeclaration or UserDefinedTypeMember</param>
62
+ /// <param name="prototype">DeclarationType with flags: Variable, Constant, UserDefinedTypeMember, or Function </param>
64
63
/// <param name="content">Member body content. Formatting is the responsibility of the caller</param>
65
64
/// <param name="parameterIdentifier">Defaults to '<paramref name="propertyIdentifier"/>Value' unless otherwise specified</param>
66
65
bool TryBuildPropertySetCodeBlock ( Declaration prototype ,
@@ -71,16 +70,20 @@ bool TryBuildPropertySetCodeBlock(Declaration prototype,
71
70
string parameterIdentifier = null ) ;
72
71
73
72
/// <summary>
74
- /// Generates a UserDefinedType (UDT) declaration using a <c>VariableDeclaration</c> as the prototype for
75
- /// creating the UserDefinedTypeMember.
73
+ /// Generates a UserDefinedType (UDT) declaration using the prototype declarations for
74
+ /// creating the UserDefinedTypeMember declarations .
76
75
/// </summary>
77
- /// <remarks> At least one <c>VariableDeclaration</c> must be provided and
78
- /// all <c>UDTMemberIdentifiers</c> must be unique
76
+ /// <remarks>No validation or conflict analysis is applied to the identifiers.
79
77
/// </remarks>
80
- /// <param name="memberPrototypes">Collection of prototypes and their required identifier. Must have 1 or more elements </param>
81
- string BuildUserDefinedTypeDeclaration ( string udtIdentifier , IEnumerable < ( VariableDeclaration Field , string UDTMemberIdentifier ) > memberPrototypes , Accessibility accessibility = Accessibility . Private ) ;
78
+ /// <param name="memberPrototypes">DeclarationTypes with flags: Variable, Constant, UserDefinedTypeMember, or Function </param>
79
+ bool TryBuildUserDefinedTypeDeclaration ( string udtIdentifier , IEnumerable < ( Declaration Prototype , string UDTMemberIdentifier ) > memberPrototypes , out string declaration , Accessibility accessibility = Accessibility . Private ) ;
82
80
83
- string UDTMemberDeclaration ( string identifier , string typeName , string indention = null ) ;
81
+ /// <summary>
82
+ /// Generates a <c>UserDefinedTypeMember</c> declaration expression based on the prototype declaration
83
+ /// </summary>
84
+ /// <param name="prototype">DeclarationType with flags: Variable, Constant, UserDefinedTypeMember, or Function</param>
85
+ /// <param name="indentation">Defaults is 4 spaces</param>
86
+ bool TryBuildUDTMemberDeclaration ( string identifier , Declaration prototype , out string declaration , string indentation = null ) ;
84
87
}
85
88
86
89
public class CodeBuilder : ICodeBuilder
@@ -119,7 +122,7 @@ private bool TryBuildPropertyBlockFromTarget<T>(T prototype, DeclarationType let
119
122
throw new ArgumentException ( ) ;
120
123
}
121
124
122
- if ( ! ( prototype is VariableDeclaration || prototype . DeclarationType . HasFlag ( DeclarationType . UserDefinedTypeMember ) ) )
125
+ if ( ! IsValidPrototypeDeclarationType ( prototype . DeclarationType ) )
123
126
{
124
127
return false ;
125
128
}
@@ -243,47 +246,64 @@ private static string EndStatement(DeclarationType declarationType)
243
246
private static string TypeToken ( DeclarationType declarationType )
244
247
=> _declarationTypeTokens [ declarationType ] . TypeToken ;
245
248
246
- public string BuildUserDefinedTypeDeclaration ( string udtIdentifier , IEnumerable < ( VariableDeclaration Field , string UDTMemberIdentifier ) > memberPrototypes , Accessibility accessibility = Accessibility . Private )
249
+ public bool TryBuildUserDefinedTypeDeclaration ( string udtIdentifier , IEnumerable < ( Declaration Prototype , string UDTMemberIdentifier ) > memberPrototypes , out string declaration , Accessibility accessibility = Accessibility . Private )
247
250
{
248
- if ( ! memberPrototypes . Any ( ) )
251
+ if ( udtIdentifier is null
252
+ || ! memberPrototypes . Any ( )
253
+ || memberPrototypes . Any ( p => p . Prototype is null || p . UDTMemberIdentifier is null )
254
+ || memberPrototypes . Any ( mp => ! IsValidPrototypeDeclarationType ( mp . Prototype . DeclarationType ) ) )
249
255
{
250
- throw new ArgumentOutOfRangeException ( ) ;
256
+ declaration = string . Empty ;
257
+ return false ;
251
258
}
252
259
253
- var hasDuplicateMemberNames = memberPrototypes . Select ( pr => pr . UDTMemberIdentifier . ToUpperInvariant ( ) )
254
- . GroupBy ( uc => uc ) . Any ( g => g . Count ( ) > 1 ) ;
255
- if ( hasDuplicateMemberNames )
256
- {
257
- throw new ArgumentException ( ) ;
258
- }
260
+ var blockLines = memberPrototypes
261
+ . Select ( m => BuildUDTMemberDeclaration ( m . UDTMemberIdentifier , m . Prototype ) )
262
+ . ToList ( ) ;
259
263
260
- var newMemberTokenPairs = memberPrototypes . Select ( m => ( GetDeclarationIdentifier ( m . Field , m . UDTMemberIdentifier ) , m . Field . AsTypeName ) )
261
- . Cast < ( string Identifier , string AsTypeName ) > ( ) ;
264
+ blockLines . Insert ( 0 , $ "{ accessibility . TokenString ( ) } { Tokens . Type } { udtIdentifier } ") ;
262
265
263
- var blockLines = new List < string > ( ) ;
266
+ blockLines . Add ( $ " { Tokens . End } { Tokens . Type } " ) ;
264
267
265
- blockLines . Add ( $ "{ accessibility . TokenString ( ) } { Tokens . Type } { udtIdentifier } ") ;
268
+ declaration = string . Join ( Environment . NewLine , blockLines ) ;
269
+ return true ;
270
+ }
266
271
267
- blockLines . AddRange ( newMemberTokenPairs . Select ( m => UDTMemberDeclaration ( m . Identifier , m . AsTypeName ) ) ) ;
272
+ public bool TryBuildUDTMemberDeclaration ( string udtMemberIdentifier , Declaration prototype , out string declaration , string indentation = null )
273
+ {
274
+ declaration = string . Empty ;
268
275
269
- blockLines . Add ( $ "{ Tokens . End } { Tokens . Type } ") ;
276
+ if ( udtMemberIdentifier is null
277
+ || prototype is null
278
+ || ! IsValidPrototypeDeclarationType ( prototype . DeclarationType ) )
279
+ {
280
+ return false ;
281
+ }
270
282
271
- return string . Join ( Environment . NewLine , blockLines ) ;
283
+ declaration = BuildUDTMemberDeclaration ( udtMemberIdentifier , prototype , indentation ) ;
284
+ return true ;
272
285
}
273
286
274
- private static string GetDeclarationIdentifier ( Declaration field , string udtMemberIdentifier )
287
+ private static string BuildUDTMemberDeclaration ( string udtMemberIdentifier , Declaration prototype , string indentation = null )
275
288
{
276
- if ( field . IsArray )
289
+ var identifierExpression = udtMemberIdentifier ;
290
+ if ( prototype . IsArray )
277
291
{
278
- return field . Context . TryGetChildContext < VBAParser . SubscriptsContext > ( out var ctxt )
292
+ identifierExpression = prototype . Context . TryGetChildContext < VBAParser . SubscriptsContext > ( out var ctxt )
279
293
? $ "{ udtMemberIdentifier } ({ ctxt . GetText ( ) } )"
280
294
: $ "{ udtMemberIdentifier } ()";
281
295
}
282
- return udtMemberIdentifier ;
296
+
297
+ return $ "{ indentation ?? " " } { identifierExpression } { Tokens . As } { prototype . AsTypeName } ";
283
298
}
284
299
285
- public string UDTMemberDeclaration ( string identifier , string typeName , string indention = null )
286
- => $ "{ indention ?? " " } { identifier } { Tokens . As } { typeName } ";
300
+ private static bool IsValidPrototypeDeclarationType ( DeclarationType declarationType )
301
+ {
302
+ return declarationType . HasFlag ( DeclarationType . Variable )
303
+ || declarationType . HasFlag ( DeclarationType . UserDefinedTypeMember )
304
+ || declarationType . HasFlag ( DeclarationType . Constant )
305
+ || declarationType . HasFlag ( DeclarationType . Function ) ;
306
+ }
287
307
288
308
private static bool IsEnumField ( VariableDeclaration declaration )
289
309
=> IsMemberVariable ( declaration )
0 commit comments