view release on metacpan or  search on metacpan

lib/Data/Monad/Base/Sugar.pm  view on Meta::CPAN

use strict;
use warnings;
use Scalar::Util qw/blessed weaken/;
use Exporter qw/import/;

our @EXPORT = qw/pick satisfy yield let/;

our $_PICK = our $_SATISFY = 
    our $_YIELD = our $_LET = sub { die "called outside for()." };
sub pick($;$)  { $_PICK->(@_)    }
sub satisfy(&) { $_SATISFY->(@_) }
sub yield(&)   { $_YIELD->(@_)   }
sub let($$)    { $_LET->(@_)     }

sub _capture {
    my $ref = pop;

    return $ref->capture(@_) if blessed $ref && $ref->can('capture');

    ref $ref eq 'ARRAY' ? (@$ref = @_) : ($$ref = $_[0]);
}

sub _tuple { bless [@_], 'Data::Monad::Base::Sugar::Tuple' }
sub Data::Monad::Base::Sugar::Tuple::capture {
    my ($self, $result) = @_;
    blessed $result && $result->isa(ref $self)
                                            or die "[BUG]result is not tuple";

    _capture @{$result->[$_]} => $self->[$_] for 0 .. $#$self;
}

sub for(&) {
    my $code = shift;

    my @blocks;
    {
        local $_PICK = sub {
            my ($ref, $block) = @_;
            $block = $ref, $ref = undef unless defined $block;

            push @blocks, {ref => $ref, block => $block};
        };

lib/Data/Monad/List.pm  view on Meta::CPAN

use Exporter qw/import/;
use base qw/Data::Monad::Base::MonadZero/;

our @EXPORT = qw/scalar_list list_unit list_zero list_flat_map_multi 
                 list_map_multi list_sequence/;

sub scalar_list(@) { __PACKAGE__->new(map { [$_] } @_) }

sub list_unit { __PACKAGE__->unit(@_) }
sub list_zero { __PACKAGE__->zero(@_) }
sub list_flat_map_multi(&@) { __PACKAGE__->flat_map_multi(@_) }
sub list_map_multi(&@) { __PACKAGE__->map_multi(@_) }
sub list_sequence { __PACKAGE__->sequence(@_) }

sub new {
    my $class = shift;
    bless [@_], $class;
}

sub unit {
    my $class = shift;
    $class->new([@_]);