1package GraphQL::Language::Parser; 2 3use 5.014; 4use strict; 5use warnings; 6use base qw(Pegex::Parser); 7use Exporter 'import'; 8use Types::Standard -all; 9use GraphQL::MaybeTypeCheck; 10use GraphQL::Language::Grammar; 11use GraphQL::Language::Receiver; 12use GraphQL::Error; 13 14our $VERSION = '0.02'; 15our @EXPORT_OK = qw( 16 parse 17); 18 19=head1 NAME 20 21GraphQL::Language::Parser - GraphQL Pegex parser 22 23=head1 SYNOPSIS 24 25 use GraphQL::Language::Parser qw(parse); 26 my $parsed = parse( 27 $source 28 ); 29 30=head1 DESCRIPTION 31 32Provides both an outside-accessible point of entry into the GraphQL 33parser (see above), and a subclass of L<Pegex::Parser> to parse a document 34into an AST usable by GraphQL. 35 36=head1 METHODS 37 38=head2 parse 39 40 parse($source, $noLocation); 41 42B<NB> that unlike in C<Pegex::Parser> this is a function, not an instance 43method. This achieves hiding of Pegex implementation details. 44 45=cut 46 47my $GRAMMAR = GraphQL::Language::Grammar->new; # singleton 48fun parse( 49 Str $source, 50 Bool $noLocation = undef, 51) :ReturnType(ArrayRef[HashRef]) { 52 my $parser = __PACKAGE__->SUPER::new( 53 grammar => $GRAMMAR, 54 receiver => GraphQL::Language::Receiver->new, 55 ); 56 my $input = Pegex::Input->new(string => $source); 57 scalar $parser->SUPER::parse($input); 58} 59 60=head2 format_error 61 62Override of parent method. Returns a L<GraphQL::Error>. 63 64=cut 65 66sub format_error :ReturnType(InstanceOf['GraphQL::Error']) { 67 my ($self, $msg) = @_; 68 my $buffer = $self->{buffer}; 69 my $position = $self->{farthest}; 70 my $real_pos = $self->{position}; 71 my ($line, $column) = @{$self->line_column($position)}; 72 my $pretext = substr( 73 $$buffer, 74 $position < 50 ? 0 : $position - 50, 75 $position < 50 ? $position : 50 76 ); 77 my $context = substr($$buffer, $position, 50); 78 $pretext =~ s/.*\n//gs; 79 $context =~ s/\n/\\n/g; 80 return GraphQL::Error->new( 81 locations => [ { line => $line, column => $column } ], 82 message => <<EOF); 83Error parsing Pegex document: 84 msg: $msg 85 context: $pretext$context 86 ${\ (' ' x (length($pretext)) . '^')} 87 position: $position ($real_pos pre-lookahead) 88EOF 89} 90 911; 92