#!/usr/bin/env perl
use strict;
use warnings;
use 5.010;

use FindBin;
use lib $FindBin::Bin;
use Parser ();

my $ast = Parser->parse(\Parser::EXAMPLE_INPUT);

say $ast->prettyprint;

package Ast;  # a parent class to define common methods

use Scalar::Util 'blessed';

# a constructor for convenience.
# Marpa won't use this but rather `bless` directly
sub new {
    my ($class, @args) = @_;
    bless \@args => $class;
}

sub prettyprint {
    my ($self, $indent) = @_;
    $indent //= 0;  # initialize $indent if no value passed
    $indent++;      # increment indent level
    my $items = join "\n",         # concatenate items with newline
        map { "  "x$indent . $_ }  # pad with intendation
        map { _prettyprint_if_possible($_, $indent) }
        @$self;
    my $type = ref $self;
    return "$type(\n$items )";
}

sub _prettyprint_if_possible {
    my ($maybe_ast, $indent) = @_;
    if (blessed($maybe_ast) and $maybe_ast->can('prettyprint')) {
        return $maybe_ast->prettyprint($indent);
    }
    return $maybe_ast;
}

package Ast::Binop;  # convenience base for all binary operators
use parent -norequire, 'Ast';

sub l   { shift()->[0] }
sub r   { shift()->[1] }

package Ast::Equals;
use parent -norequire, 'Ast::Binop';

package Ast::Assign;
use parent -norequire, 'Ast::Binop';

package Ast::Or;
use parent -norequire, 'Ast::Binop';

package Ast::Var;
use parent -norequire, 'Ast';

sub name { shift()->[0] }

sub prettyprint {
    my ($self) = @_;
    return '${' . $self->name . '}';
}

package Ast::Cond;
use parent -norequire, 'Ast';

sub cond { shift()->[0] }
sub then { shift()->[1] }
sub else { shift()->[2] }

sub prettyprint {
    my ($self, $indent) = @_;
    $indent //= 0;
    my ($cond, $then, $else) =
        map { $_->prettyprint($indent) } @$self;
    return "if $cond\n"
      . "  "x$indent . "then $then\n"
      . "  "x$indent . "else $else";
}

BEGIN { undef *prettyprint unless $ENV{PRETTYPRINT_COND} }

package Ast::Block;
use parent -norequire, 'Ast';

package Ast::Literal;
use parent -norequire, 'Ast';

sub val { shift()->[0] }

sub prettyprint {
    my ($self) = @_;
    return q(") . $self->val . q(");
}
