Perlのユーティリティ関数

util.pl

use strict;
use warnings;
use open OUT => qw/:utf8 :std/;
use Test::More qw/no_plan/;

sub compose {
  my @subs = @_; 
  return sub {
    my @args = @_; 
    my @reversed_subs = reverse @subs;
    for my $sub (@reversed_subs) {
      @args = &$sub(@args);
    }   
    return $args[0];
  }
}

sub partial {
  my $fn = shift;
  my @bind = @_; 
  return sub {
    my @args = @_; 
    $fn->(@bind, @args);
  }
}

sub feach {
  my $fn = shift;
  my $array = shift;
  for my $elm (@$array) {
    $fn->($elm);
  }
}

sub fmap {
  my $fn = shift;
  my $array = shift;
  my $accum = []; 
  for my $elm (@$array) {
    push @$accum, $fn->($elm);
  }
  $accum;
}

sub freduce {
  my $fn = shift;
  my $init = shift;
  my $array = shift;
  my $first_elm = shift @$array; 
  my $accum = $fn->($init, $first_elm);
  for my $elm (@$array) {
    $accum = $fn->($accum, $elm);
  }
  $accum;
}


# Tests
is(compose(sub { shift() * 10 }, sub { shift() + 5 })->(10), 150, 'compose two args');
is(compose(sub { shift() + 5 }, sub { shift() * 10 }, sub { shift() + 5 })->(10), 155, 'compose three args');

is_deeply(compose(sub {
  my $arr = shift;
  [apply { $_ *= 2 } @$arr];
}, sub {
  my $arr = shift;
  [apply { $_ *= 10 } @$arr];
})->([1,2,3,4,5]), [20, 40, 60, 80, 100], 'compose more');

is(partial(sub {
  my $x = shift;
  my $y = shift;
  return $x + $y;
}, 10)->(5), 15, 'partial one/two args');

is(partial(sub {
  my $x = shift;
  my $y = shift;
  my $z = shift;
  return $x + $y + $z;
}, 10)->(10, 10), 30, 'partial one/three args');

is(partial(sub {
  my $x = shift;
  my $y = shift;
  my $z = shift;
  return $x + $y + $z;
}, 10, 10)->(10), 30, 'partial two/three args');

is(partial(partial(sub {
  my $x = shift;
  my $y = shift;
  my $z = shift;
  return $x + $y + $z;
}, 10), 10)->(10), 30, 'partial nested');

is_deeply([partial(\&apply, sub { $_ *= 10 })->(1,2,3,4,5)], [10,20,30,40,50], 'partial othre sub ref');

is_deeply(freduce(sub {
  my $accum = shift;
  my $elm = shift;
  $accum + $elm;
}, 0, [1,2,3,4,5]), 15);

is('g' . freduce(sub {
  my $accum = shift;
  $accum . 'o';
}, '', [1,2,3,4,5]) . 'gle', 'gooooogle');
  
is_deeply(fmap(sub {
  my $elm = shift;
  $elm * 10;
}, [1,2,3]), [10,20,30]);

is_deeply(fmap(sub {
  my $elm = shift;
  "%" . $elm . "%";
}, ['hoge','fuga','piyo']), ['%hoge%', '%fuga%', '%piyo%']);

done_testing;