The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
# Copyright 2015 Jeffrey Kegler
# This file is part of Marpa::R2.  Marpa::R2 is free software: you can
# redistribute it and/or modify it under the terms of the GNU Lesser
# General Public License as published by the Free Software Foundation,
# either version 3 of the License, or (at your option) any later version.
#
# Marpa::R2 is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser
# General Public License along with Marpa::R2.  If not, see
# http://www.gnu.org/licenses/.

use 5.010;
use strict;
use warnings;
use English qw( -no_match_vars );
use Data::Dumper;

# This is a 'meta' tool, so I relax some of the
# restrictions I use to guarantee portability.
use autodie;

# I expect to be run from a subdirectory in the
# development heirarchy
use lib '../../../';
use lib '../../../../blib/arch';
use Marpa::R2;

use Getopt::Long;
my $verbose         = 1;
my $help_flag       = 0;
my $result          = Getopt::Long::GetOptions(
    'help'       => \$help_flag,
);
die "usage $PROGRAM_NAME [--help] file ...\n" if $help_flag;

my $bnf = do { local $RS = undef; \(<>) };
my $ast = Marpa::R2::Internal::MetaAST->new($bnf);
my $parse_result = $ast->ast_to_hash();

sub sort_bnf {
    my $cmp = $a->{lhs} cmp $b->{lhs};
    return $cmp if $cmp;
    my $a_rhs_length = scalar @{ $a->{rhs} };
    my $b_rhs_length = scalar @{ $b->{rhs} };
    $cmp = $a_rhs_length <=> $b_rhs_length;
    return $cmp if $cmp;
    for my $ix ( 0 .. ( $a_rhs_length - 1 ) ) {
        $cmp = $a->{rhs}->[$ix] cmp $b->{rhs}->[$ix];
        return $cmp if $cmp;
    }
    return 0;
} ## end sub sort_bnf

my %cooked_parse_result = (
    character_classes      => $parse_result->{character_classes},
    symbols                => $parse_result->{symbols},
    discard_default_adverbs => $parse_result->{discard_default_adverbs},
    lexeme_default_adverbs => $parse_result->{lexeme_default_adverbs},
    first_lhs              => $parse_result->{first_lhs},
    start_lhs              => $parse_result->{start_lhs},
);

my @rule_sets = keys %{ $parse_result->{rules} };
for my $rule_set (@rule_sets) {
    my $aoh        = $parse_result->{rules}->{$rule_set};
    my $sorted_aoh = [ sort sort_bnf @{$aoh} ];
    $cooked_parse_result{rules}->{$rule_set} = $sorted_aoh;
}

say "## The code after this line was automatically generated by ",
    $PROGRAM_NAME;
say "## Date: ", scalar localtime();
$Data::Dumper::Sortkeys = 1;
print Data::Dumper->Dump( [ \%cooked_parse_result ], [qw(hashed_metag)] );
say "## The code before this line was automatically generated by ",
    $PROGRAM_NAME;