File Coverage

blib/lib/Data/Focus.pm

Criterion	Covered	Total	%
statement	61	61	100.0
branch	13	16	81.2
condition	2	3	66.6
subroutine	16	16	100.0
pod	8	8	100.0
total	100	104	96.1

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

our $VERSION = "0.03";

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 = exists($args{lens}) ?
        (ref($args{lens}) eq "ARRAY" ? $args{lens} : [$args{lens}])
        : [];
    $_ = $class->coerce_to_lens($_) foreach @$lenses;
    my $self = bless {
        target => $target,
        lenses => $lenses
    }, $class;
    return $self;
}

sub coerce_to_lens {
    my (undef, $maybe_lens) = @_;
    if(Scalar::Util::blessed($maybe_lens) && $maybe_lens->isa("Data::Focus::Lens")) {
        return $maybe_lens;
    }else {
        require Data::Focus::Lens::Dynamic;
        return Data::Focus::Lens::Dynamic->new($maybe_lens);
    }
}

sub into {
    my ($self, @lenses) = @_;
    unshift @lenses, @{$self->{lenses}};
    my $deeper = ref($self)->new(
        target => $self->{target},
        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);
    if(@lenses == 1) {
        return $lenses[0]->apply_lens(
            $app_class, $app_class->create_part_mapper($updater), $self->{target}
        );
    }else {
        return Data::Focus::Lens::Composite->apply_composite_lens(
            \@lenses,
            $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__