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__

=head1 NAME

Data::Monad::Base::Monad - The base class of any monads.

=head1 SYNOPSIS

  package YourMonadClass;
  use base qw/Data::Monad::Base::Monad/;

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

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

=head1 DESCRIPTION

Data::Monad::Base::Monad provides some useful functions for any monads.

You must implement unit() and flat_map() according to monad laws.
Or you may implement flatten() and map() instead of flat_map().

This module is marked B<EXPERIMENTAL>. API could be changed without any notice.
I'll drop many useless stuffs in the future.

=head1 METHODS

=over 4

=item $m = SomeMonad->unit(@vs);

A natural transformation, which is known as "return" in Haskell.

You must implement this method in sub classes.

=item $f = SomeMonad->flat_map_multi(sub { ... }, $m1, $m2, ...);

Changes the type of function from (v1, v2, ...) -> m(v0)
to (m(v1), m(v2), ...) -> m(v0), and apply it to $m1, $m2, ...

=item $f = SomeMonad->map_multi(sub { ... }, $m1, $m2, ...);

Changes the type of function from (v1, v2, ...) -> v0
to (m(v1), m(v2), ...) -> m(v0), and apply it to $m1, $m2, ...

=item $m = SomeMonad->sequence($m1, $m2, $m3, ...);

Packs monads into the new monad.

=item $m2 = $m1->flat_map(sub { ... });

The composition of Kleisli category, which known as ">>=" in Haskell.

You must implement this method in sub classes.

=item $m2 = $m1->map(sub { ... });

The morphism map of the monad, which is known as "fmap" in Haskell.

=item $m = $mm->flatten;

A natural transformation, which is known as "join" in Haskell.

=item $m = $mf->ap($m1, $m2,...);

Executes the function which wrapped by the monad.

=item $m = $m->while(\&predicate, \&f);

C<flat_map(\&f)> while C<\&predicate> is true.

=back

=head1 AUTHOR

hiratara E<lt>hiratara {at} cpan.orgE<gt>

=head1 SEE ALSO

L<Data::Monad::Base::MonadZero>, L<Data::Monad::Base::Sugar>

=head1 LICENSE

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut