1package GraphQL::Language::Receiver; 2 3use 5.014; 4use strict; 5use warnings; 6use base 'Pegex::Receiver'; 7use Types::Standard -all; 8use GraphQL::MaybeTypeCheck; 9use JSON::MaybeXS; 10use Carp; 11 12my $JSON = JSON::MaybeXS->new->allow_nonref->canonical; 13 14my @KINDHASH = qw( 15 scalar 16 union 17 field 18 inline_fragment 19 fragment_spread 20 fragment 21 directive 22); 23my %KINDHASH21 = map { ($_ => 1) } @KINDHASH; 24 25my @KINDFIELDS = qw( 26 type 27 input 28 interface 29); 30my %KINDFIELDS21 = map { ($_ => 1) } @KINDFIELDS; 31 32=head1 NAME 33 34GraphQL::Language::Receiver - GraphQL Pegex AST constructor 35 36=head1 VERSION 37 38Version 0.02 39 40=cut 41 42our $VERSION = '0.02'; 43 44=head1 SYNOPSIS 45 46 # this class used internally by: 47 use GraphQL::Language::Parser qw(parse); 48 my $parsed = parse($source); 49 50=head1 DESCRIPTION 51 52Subclass of L<Pegex::Receiver> to turn Pegex parsing events into data 53usable by GraphQL. 54 55=cut 56 57method gotrule (Any $param = undef) { 58 return unless defined $param; 59 if ($KINDHASH21{$self->{parser}{rule}}) { 60 return {kind => $self->{parser}{rule}, %{$self->_locate_hash(_merge_hash($param))}}; 61 } elsif ($KINDFIELDS21{$self->{parser}{rule}}) { 62 return {kind => $self->{parser}{rule}, %{$self->_locate_hash(_merge_hash($param, 'fields'))}}; 63 } 64 return {$self->{parser}{rule} => $param}; 65} 66 67method _locate_hash(HashRef $hash) { 68 my ($line, $column) = @{$self->{parser}->line_column($self->{parser}{farthest})}; 69 +{ %$hash, location => { line => $line, column => $column } }; 70} 71 72fun _merge_hash (Any $param = undef, Any $arraykey = undef) { 73 my %def = map %$_, grep ref eq 'HASH', @$param; 74 if ($arraykey) { 75 my @arrays = grep ref eq 'ARRAY', @$param; 76 Carp::confess "More than one array found\n" if @arrays > 1; 77 Carp::confess "No arrays found but \$arraykey given\n" if !@arrays; 78 my %fields = map %$_, @{$arrays[0]}; 79 $def{$arraykey} = \%fields; 80 } 81 \%def; 82} 83 84fun _unescape (Str $str) { 85 # https://facebook.github.io/graphql/June2018/#EscapedCharacter 86 $str =~ s|\\(["\\/bfnrt])|"qq!\\$1!"|gee; 87 return $str; 88} 89 90fun _blockstring_value (Str $str) { 91 # https://facebook.github.io/graphql/June2018/#BlockStringValue() 92 my @lines = split(/(?:\n|\r(?!\r)|\r\n)/s, $str); 93 if (1 < @lines) { 94 my $common_indent; 95 for my $line (@lines[1..$#lines]) { 96 my $length = length($line); 97 my $indent = length(($line =~ /^([\t ]*)/)[0] || ''); 98 if ($indent < $length && (!defined($common_indent) || $indent < $common_indent)) { 99 $common_indent = $indent; 100 } 101 } 102 if (defined $common_indent) { 103 for my $line (@lines[1..$#lines]) { 104 $line =~ s/^[\t ]{$common_indent}//; 105 } 106 } 107 } 108 my ($start, $end); 109 for ($start = 0; $start < @lines && $lines[$start] =~ /^[\t ]*$/; ++$start) {} 110 for ($end = $#lines; $end >= 0 && $lines[$end] =~ /^[\t ]*$/; --$end) {} 111 @lines = @lines[$start..$end]; 112 my $formatted = join("\n", @lines); 113 $formatted =~ s/\\"""/"""/g; 114 return $formatted; 115} 116 117method got_arguments (Any $param = undef) { 118 return unless defined $param; 119 my %args = map { ($_->[0]{name} => $_->[1]) } @$param; 120 return {$self->{parser}{rule} => \%args}; 121} 122 123method got_argument (Any $param = undef) { 124 return unless defined $param; 125 $param; 126} 127 128method got_objectField (Any $param = undef) { 129 return unless defined $param; 130 return {$param->[0]{name} => $param->[1]}; 131} 132 133method got_objectValue (Any $param = undef) { 134 return unless defined $param; 135 _merge_hash($param); 136} 137 138method got_objectField_const (Any $param = undef) { 139 unshift @_, $self; goto &got_objectField; 140} 141 142method got_objectValue_const (Any $param = undef) { 143 unshift @_, $self; goto &got_objectValue; 144} 145 146method got_listValue (Any $param = undef) { 147 return unless defined $param; 148 return $param; 149} 150 151method got_listValue_const (Any $param = undef) { 152 unshift @_, $self; goto &got_listValue; 153} 154 155method got_directiveactual (Any $param = undef) { 156 return unless defined $param; 157 _merge_hash($param); 158} 159 160method got_inputValueDefinition (Any $param = undef) { 161 return unless defined $param; 162 my $def = _merge_hash($param); 163 my $name = delete $def->{name}; 164 return { $name => $def }; 165} 166 167method got_directiveLocations (Any $param = undef) { 168 return unless defined $param; 169 return {locations => [ map $_->{name}, @$param ]}; 170} 171 172method got_namedType (Any $param = undef) { 173 return unless defined $param; 174 return $param->{name}; 175} 176 177method got_enumValueDefinition (Any $param = undef) { 178 return unless defined $param; 179 my @copy = @$param; 180 my $rest = pop @copy; 181 my $value = pop @copy; 182 my $description = $copy[0] // {}; 183 $rest = ref $rest eq 'HASH' ? [ $rest ] : $rest; 184 my %def = (%$description, value => $value, map %$_, @$rest); 185 return \%def; 186} 187 188method got_defaultValue (Any $param = undef) { 189 # the value can be undef 190 return { default_value => $param }; 191} 192 193method got_implementsInterfaces (Any $param = undef) { 194 return unless defined $param; 195 return { interfaces => $param }; 196} 197 198method got_argumentsDefinition (Any $param = undef) { 199 return unless defined $param; 200 return { args => _merge_hash($param) }; 201} 202 203method got_fieldDefinition (Any $param = undef) { 204 return unless defined $param; 205 my $def = _merge_hash($param); 206 my $name = delete $def->{name}; 207 return { $name => $def }; 208} 209 210method got_typeExtensionDefinition (Any $param = undef) { 211 return unless defined $param; 212 return {kind => 'extend', %{$self->_locate_hash($param)}}; 213} 214 215method got_enumTypeDefinition (Any $param = undef) { 216 return unless defined $param; 217 my $def = _merge_hash($param); 218 my %values; 219 map { 220 my $name = ${${delete $_->{value}}}; 221 $values{$name} = $_; 222 } @{(grep ref eq 'ARRAY', @$param)[0]}; 223 $def->{values} = \%values; 224 return {kind => 'enum', %{$self->_locate_hash($def)}}; 225} 226 227method got_unionMembers (Any $param = undef) { 228 return unless defined $param; 229 return { types => $param }; 230} 231 232method got_boolean (Any $param = undef) { 233 return unless defined $param; 234 return $param eq 'true' ? JSON->true : JSON->false; 235} 236 237method got_null (Any $param = undef) { 238 return unless defined $param; 239 return undef; 240} 241 242method got_string (Any $param = undef) { 243 return unless defined $param; 244 return $param; 245} 246 247method got_stringValue (Any $param = undef) { 248 return unless defined $param; 249 return _unescape($param); 250} 251 252method got_blockStringValue (Any $param = undef) { 253 return unless defined $param; 254 return _blockstring_value($param); 255} 256 257method got_int (Any $param = undef) { 258 $param+0; 259} 260 261method got_float (Any $param = undef) { 262 $param+0; 263} 264 265method got_enumValue (Any $param = undef) { 266 return unless defined $param; 267 my $varname = $param->{name}; 268 return \\$varname; 269} 270 271# not returning empty list if undef 272method got_value_const (Any $param = undef) { 273 return $param; 274} 275 276method got_value (Any $param = undef) { 277 unshift @_, $self; goto &got_value_const; 278} 279 280method got_variableDefinitions (Any $param = undef) { 281 return unless defined $param; 282 my %def; 283 map { 284 my $name = ${ shift @$_ }; 285 $def{$name} = { map %$_, @$_ }; # merge 286 } @$param; 287 return {variables => \%def}; 288} 289 290method got_variableDefinition (Any $param = undef) { 291 return unless defined $param; 292 return $param; 293} 294 295method got_selection (Any $param = undef) { 296 unshift @_, $self; goto &got_value_const; 297} 298 299method got_typedef (Any $param = undef) { 300 return unless defined $param; 301 $param = $param->{name} if ref($param) eq 'HASH'; 302 return {type => $param}; 303} 304 305method got_alias (Any $param = undef) { 306 return unless defined $param; 307 return {$self->{parser}{rule} => $param->{name}}; 308} 309 310method got_typeCondition (Any $param = undef) { 311 return unless defined $param; 312 return {on => $param}; 313} 314 315method got_fragmentName (Any $param = undef) { 316 return unless defined $param; 317 return $param; 318} 319 320method got_selectionSet (Any $param = undef) { 321 return unless defined $param; 322 return {selections => $param}; 323} 324 325method got_operationDefinition (Any $param = undef) { 326 return unless defined $param; 327 $param = [ $param ] unless ref $param eq 'ARRAY'; # bare selectionSet 328 return {kind => 'operation', %{$self->_locate_hash(_merge_hash($param))}}; 329} 330 331method got_directives (Any $param = undef) { 332 return unless defined $param; 333 return {$self->{parser}{rule} => $param}; 334} 335 336method got_graphql (Any $param = undef) { 337 return unless defined $param; 338 return $param; 339} 340 341method got_definition (Any $param = undef) { 342 return unless defined $param; 343 return $param; 344} 345 346method got_operationTypeDefinition (Any $param = undef) { 347 return unless defined $param; 348 return { map { ref($_) ? values %$_ : $_ } @$param }; 349} 350 351method got_comment (Any $param = undef) { 352 return unless defined $param; 353 return $param; 354} 355 356method got_description (Any $param = undef) { 357 return unless defined $param; 358 my $string = ref($param) eq 'ARRAY' ? join("\n", @$param) : $param; 359 return $string ? {$self->{parser}{rule} => $string} : {}; 360} 361 362method got_schema (Any $param = undef) { 363 return unless defined $param; 364 my $directives = {}; 365 if (ref $param->[1] eq 'ARRAY') { 366 # got directives 367 $directives = shift @$param; 368 } 369 my %type2count; 370 $type2count{(keys %$_)[0]}++ for @{$param->[0]}; 371 $type2count{$_} > 1 and die "Must provide only one $_ type in schema.\n" 372 for keys %type2count; 373 return {kind => $self->{parser}{rule}, %{$self->_locate_hash(_merge_hash($param->[0]))}, %$directives}; 374} 375 376method got_typeSystemDefinition (Any $param = undef) { 377 return unless defined $param; 378 my @copy = @$param; 379 my $node = pop @copy; 380 my $description = $copy[0] // {}; 381 +{ %$node, %$description }; 382} 383 384method got_typeDefinition (Any $param = undef) { 385 return unless defined $param; 386 return $param; 387} 388 389method got_variable (Any $param = undef) { 390 return unless defined $param; 391 my $varname = $param->{name}; 392 return \$varname; 393} 394 395method got_nonNullType (Any $param = undef) { 396 return unless defined $param; 397 $param = $param->[0]; # zap first useless layer 398 $param = { type => $param } if ref $param ne 'HASH'; 399 return [ 'non_null', $param ]; 400} 401 402method got_listType (Any $param = undef) { 403 return unless defined $param; 404 $param = $param->[0]; # zap first useless layer 405 $param = { type => $param } if ref $param ne 'HASH'; 406 return [ 'list', $param ]; 407} 408 4091; 410