view release on metacpan or  search on metacpan

lib/FP/Currying.pm  view on Meta::CPAN

package FP::Currying;
use strict;
use warnings;
use warnings FATAL => 'uninitialized';
use Exporter "import";

our @EXPORT = qw(
    curry
    curry_
    partial
    uncurry
    uncurry_1_1
    uncurry_2_1
    uncurry_1_2
    uncurry_2_2
    uncurry_1_1_1
);
our @EXPORT_OK   = qw();
our %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]);

use FP::Carp;

sub curry {
    @_ == 1 or fp_croak_arity 1;
    my ($f) = @_;
    sub {
        @_ == 1 or fp_croak_arity 1;
        my ($a) = @_;
        sub {
            @_ == 1 or fp_croak_arity 1;
            @_ = ($a, @_);
            goto \&$f
        }
    }
}

# relaxed version
sub curry_ {
    my ($f, @p) = @_;
    sub {
        my @a = @_;
        sub {
            @_ = (@p, @a, @_);
            goto \&$f
        }
    }
}

# https://github.com/clojure/clojure/blob/master/src/clj/clojure/core.clj
# "Takes a function f and fewer than the normal arguments to f, and
# returns a fn that takes a variable number of additional args. When
# called, the returned function calls f with args + additional args."
sub partial {
    my ($f, @p) = @_;
    sub {
        @_ = (@p, @_);
        goto \&$f
    }
}

# Macros would be useful here.

sub uncurry_1_1 {
    @_ == 1 or fp_croak_arity 1;
    my ($f) = @_;
    sub {
        @_ == 2 or fp_croak_arity 2;
        my ($a, $b) = @_;
        $f->($a)->($b)
    }
}

sub uncurry;
*uncurry = \&uncurry_1_1;

sub uncurry_2_1 {
    @_ == 1 or fp_croak_arity 1;
    my ($f) = @_;
    sub {
        @_ == 3 or fp_croak_arity 3;
        my ($a, $b, $c) = @_;
        $f->($a, $b)->($c)
    }
}

sub uncurry_1_2 {
    @_ == 1 or fp_croak_arity 1;
    my ($f) = @_;
    sub {
        @_ == 3 or fp_croak_arity 3;
        my ($a, $b, $c) = @_;
        $f->($a)->($b, $c)
    }
}

sub uncurry_2_2 {
    @_ == 1 or fp_croak_arity 1;
    my ($f) = @_;
    sub {
        @_ == 4 or fp_croak_arity 4;
        my ($a, $b, $c, $d) = @_;
        $f->($a, $b)->($c, $d)
    }
}

sub uncurry_1_1_1 {
    @_ == 1 or fp_croak_arity 1;
    my ($f) = @_;
    sub {
        @_ == 3 or fp_croak_arity 3;
        my ($a, $b, $c) = @_;
        $f->($a)->($b)->($c)
    }
}

# ...

1