File Coverage

blib/lib/Data/Monad/Base/Monad.pm

Criterion	Covered	Total	%
statement	77	79	97.4
branch	6	6	100.0
condition	3	3	100.0
subroutine	26	27	96.3
pod	9	9	100.0
total	121	124	97.5

package Data::Monad::Base::Monad;
use strict;
use warnings;
use Scalar::Util ();
use Data::Monad::Base::Sugar;
use Data::Monad::Base::Util qw(list);

sub unit {
    my ($class, @v) = @_;
    die "You should override this method.";
}

sub flat_map_multi {
    my ($class, $f, @ms) = @_;

    Data::Monad::Base::Sugar::for {
        my @args;
        for my $i (0 .. $#ms) {
            # capture each value in each slot of @args
            pick +(my $slot = []) => sub { $ms[$i] };
            push @args, $slot;
        }
        pick sub { $f->(map { @$_ } @args) };
    };
}

sub map_multi {
    my ($class, $f, @ms) = @_;

    $class->flat_map_multi(sub { $class->unit($f->(@_)) }, @ms)
}

sub sequence {
    my $class = shift;
    $class->map_multi(sub { list @_ } => @_);
}

sub _welldefined_check {
    my $self = shift;
    \&flat_map != $self->can('flat_map') and return;
    \&map != $self->can('map') and \&flatten != $self->can('flatten')
                                                                    and return;

    die "You must implement flat_map(), or map() and flatten().";
}

sub flat_map {
    my ($self, $f) = @_;

    $self->_welldefined_check;

    no strict qw/refs/;
    *{(ref $self) . "::flat_map"} = sub {
        my ($self, $f) = @_;
        $self->map($f)->flatten;
    };

    $self->flat_map($f);
}

sub map {
    my ($self, $f) = @_;

    $self->_welldefined_check;

    no strict qw/refs/;
    *{(ref $self) . "::map"} = sub {
        my ($self, $f) = @_;
        $self->flat_map(sub { (ref $self)->unit($f->(@_)) });
    };

    $self->map($f);
}

sub flatten {
    my $self_duplexed = shift;

    $self_duplexed->_welldefined_check;

    no strict qw/refs/;
    *{(ref $self_duplexed) . "::flatten"} = sub {
        my $self_duplexed = shift;
        $self_duplexed->flat_map(sub { list @_ });
    };

    $self_duplexed->flatten;
}

sub ap { (ref $_[0])->map_multi(sub { my $c = shift; $c->(@_) } => @_) }

sub while {
    my ($self, $predicate, $f) = @_;

    my $weaken_loop;
    my $loop = sub {
        my @v = @_;
        $predicate->(@v) ? $f->(@v)->flat_map($weaken_loop)
                         : (ref $self)->unit(@v);
    };
    Scalar::Util::weaken($weaken_loop = $loop);

    $self->flat_map($loop);
}

1;

__END__