view release on metacpan or  search on metacpan

lib/Devel/Optic/Lens/Perlish/Interpreter.pm  view on Meta::CPAN

package Devel::Optic::Lens::Perlish::Interpreter;
$Devel::Optic::Lens::Perlish::Interpreter::VERSION = '0.015';
# ABSTRACT: Basic recursive interpreter for Perlish lens

use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(run);

use Carp qw(croak);
our @CARP_NOT = qw(Devel::Optic::Lens::Perlish Devel::Optic);

use Devel::Optic::Lens::Perlish::Constants qw(:all);

use Scalar::Util qw(looks_like_number);
use Ref::Util qw(is_arrayref is_hashref is_refref is_scalarref is_ref);

sub run {
    my ($scope, $ast) = @_;
    my ($type, $payload) = @$ast;
    if ($type eq OP_ACCESS) {
        return _access($scope, undef, $ast, $payload);
    }

    if ($type eq SYMBOL) {
        return _symbol($scope, $payload);
    }

    croak sprintf("invalid query: %s does not start with access or symbol",
        _ast_to_code($ast),
    );
}

sub _access {
    my ($scope, $parent, $self, $children) = @_;

    my ($left, $right) = @$children;

    my ($l_arg, $r_arg);
    my ($l_type, $l_val) = @$left;
    my ($r_type, $r_val) = @$right;

    if ($l_type eq SYMBOL) {
        $l_arg = _symbol($scope, $l_val);
    }

    if ($l_type eq OP_ACCESS) {
        $l_arg = _access($scope, $self, $left, $l_val);
    }

    if ($r_type eq OP_ACCESS) {
        die "an access can't be followed directly by another access. the parser admitted an invalid program. please report this!";
    }

    if ($r_type eq OP_HASHKEY) {
        return _hashkey($scope, $self, $left, $right, $l_arg, $r_val);
    }

    if ($r_type eq OP_ARRAYINDEX) {
        return _arrayindex($scope, $self, $left, $right, $l_arg, $r_val, $left);
    }
}

sub _arrayindex {
    my ($scope, $access_node, $array_node, $index_node, $arrayref, $child) = @_;
    my ($type, $value) = @$child;

    if (!is_arrayref($arrayref)) {
        croak sprintf("invalid array access: '%s' is %s, not array",
            _ast_to_code($array_node),
            _sample_or_ref($arrayref),
        );
    }

    if ($type eq STRING) {
        croak sprintf("invalid array access: can't index '%s' with string '%s'",