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