File Coverage

blib/lib/Data/Monad/Either.pm

Criterion	Covered	Total	%
statement	49	51	96.0
branch	10	10	100.0
condition			n/a
subroutine	26	27	96.3
pod	13	13	100.0
total	98	101	97.0

package Data::Monad::Either;
use strict;
use warnings;
use parent qw/Data::Monad::Base::Monad/;
use Exporter qw/import/;

our @EXPORT = qw/left right/;

sub left {
    return bless [@_], __PACKAGE__ . '::Left';
}

sub right {
    return bless [@_], __PACKAGE__ . '::Right';
}

# from Data::Monad::Base::Monad

sub unit {
    my ($class, @v) = @_;
    return right(@v);
}

sub flat_map {
    my ($self, $f) = @_;
    return $self->is_left ? $self : $f->($self->value);
}

# instance methods

sub is_left {
    my ($self) = @_;
    return ref($self) eq __PACKAGE__ . '::Left';
}

sub is_right {
    my ($self) = @_;
    return ref($self) eq __PACKAGE__ . '::Right';
}

sub value {
    my ($self) = @_;
    return wantarray ? @$self : $self->[0];
}

sub fold {
    my ($self, $left_accum, $right_accum) = @_;
    my $accum = $self->is_right ? $right_accum : $left_accum;
    return $accum->($self->value);
}

sub or_else {
    my ($self, $else) = @_;
    return $self->fold(
      sub { return $else },
      sub { return right(@_) },
    );
}

sub get_or_else {
    my ($self, @else) = @_;
    return $self->value_or(sub { wantarray ? @else : $else[0] });
}

sub value_or {
    my ($self, $or) = @_;
    return $self->fold(
      $or,
      sub { return wantarray ? @_ : $_[0] },
    );
}

sub swap {
    my ($self) = @_;
    return $self->fold(
      sub { return right(@_) },
      sub { return left(@_) },
    )
}

sub left_map {
    my ($self, $f) = @_;
    return $self->fold(
      sub { return left($f->(@_)) },
      sub { return right(@_) },
    );
}

package Data::Monad::Either::Left;
use parent -norequire, 'Data::Monad::Either';

package Data::Monad::Either::Right;
use parent -norequire, 'Data::Monad::Either';

1;

__END__