File Coverage

blib/lib/Data/Focus.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	11	14	78.5
condition			n/a
subroutine	15	15	100.0
pod	8	8	100.0
total	96	99	96.9

package Data::Focus;
use strict;
use warnings;
use Data::Focus::Lens::Composite;
use Carp;
use Exporter qw(import);

our $VERSION = "0.01";

our @EXPORT_OK = qw(focus);

sub focus {
    my ($target, @lenses) = @_;
    return __PACKAGE__->new(target => $target, lens => \@lenses);
}

sub new {
    my ($class, %args) = @_;
    croak "target param is mandatory" if !exists($args{target});
    my $target = $args{target};
    my $lenses = [];
    if(exists($args{lens})) {
        if(ref($args{lens}) eq "ARRAY") {
            $lenses = $args{lens};
        }else {
            $lenses = [$args{lens}];
        }
    }
    @$lenses = map { $class->coerce_to_lens($_) } @$lenses;
    my $self = bless {
        target => $target,
        lenses => $lenses
    }, $class;
    return $self;
}

sub coerce_to_lens {
    my ($class_self, $maybe_lens) = @_;
    if(eval { $maybe_lens->isa("Data::Focus::Lens") }) {
        return $maybe_lens;
    }else {
        require Data::Focus::Lens::HashArray::Index;
        return Data::Focus::Lens::HashArray::Index->new(index => $maybe_lens); ## default lens (for now)
    }
}

sub into {
    my ($self, @lenses) = @_;
    my $deeper = ref($self)->new(
        target => $self->{target},
        lens => [@{$self->{lenses}}, map { $self->coerce_to_lens($_) } @lenses]
    );
    return $deeper;
}

sub _apply_lenses_to_target {
    my ($self, $app_class, $updater, @additional_lenses) = @_;
    my @lenses = (@{$self->{lenses}}, map { $self->coerce_to_lens($_) } @additional_lenses);
    return Data::Focus::Lens::Composite->new(@lenses)->apply_lens(
        $app_class,
        $app_class->create_part_mapper($updater),
        $self->{target}
    );
}

sub get {
    my ($self, @lenses) = @_;
    require Data::Focus::Applicative::Const::First;
    my $ret = $self->_apply_lenses_to_target(
        "Data::Focus::Applicative::Const::First", undef, @lenses
    )->get_const;
    return defined($ret) ? $$ret : undef;
}

sub list {
    my ($self, @lenses) = @_;
    require Data::Focus::Applicative::Const::List;
    my $traversed_list = $self->_apply_lenses_to_target(
        "Data::Focus::Applicative::Const::List", undef, @lenses
    )->get_const;
    return wantarray ? @$traversed_list : $traversed_list->[0];
}

sub over {
    my $updater = pop;
    my ($self, @lenses) = @_;
    croak "updater param must be a code-ref" if ref($updater) ne "CODE";
    require Data::Focus::Applicative::Identity;
    return $self->_apply_lenses_to_target(
        "Data::Focus::Applicative::Identity", $updater, @lenses
    )->run_identity;
}

sub set {
    my $datum = pop;
    my $self = shift;
    return $self->over(@_, sub { $datum });
}

1;
__END__