File Coverage

blib/lib/Lazy/Util.pm

Criterion	Covered	Total	%
statement	127	128	99.2
branch	31	32	96.8
condition	5	9	55.5
subroutine	31	31	100.0
pod	15	15	100.0
total	209	215	97.2

use strict;
use warnings;

package Lazy::Util;
$Lazy::Util::VERSION = '0.002';
#ABSTRACT: Perl utilities for lazy evaluation


use Carp qw/ croak /;
use Exporter qw/ import /;
use Lazy::Util::OO;
use Scalar::Util qw/ blessed /;

use constant SCALAR_DEFER => eval { require Scalar::Defer; 1 };

our @EXPORT_OK = qw/
  l_concat l_first l_grep l_map l_nuniq l_uniq l_until g_count g_first g_join
  g_last g_max g_min g_prod g_sum
  /;

our %EXPORT_TAGS = (all => [@EXPORT_OK],);

sub _isa { defined blessed $_[0] and $_[0]->isa($_[1]); }


sub l_concat {
  my (@vals) = grep defined, @_;

  return Lazy::Util::OO->new(sub {undef}) if @vals == 0;

  return $vals[0] if @vals == 1 and _isa($vals[0], 'Lazy::Util::OO');

  return Lazy::Util::OO->new(
    sub {
      while (@vals) {

        # if it's a Scalar::Defer or a CODE reference, coerce into a
        # Lazy::Util::OO object
        $vals[0] = Lazy::Util::OO->new($vals[0])
          if SCALAR_DEFER && _isa($vals[0], 0)
          or ref $vals[0] eq 'CODE';

        # if by this point it's not a Lazy::Util::OO object, simply return it
        # and remove from @vals
        return shift @vals if not _isa($vals[0], 'Lazy::Util::OO');

        # ->get the next value from the Lazy::Util::OO object and return it if
        # it's defined
        if   (defined(my $get = $vals[0]->get())) { return $get; }
        else                                      { shift @vals; }
      }
      return undef;
    }
  );
}


sub l_first {
  my ($n, @vals) = @_;

  my $vals = l_concat @vals;

  return Lazy::Util::OO->new(
    sub {
      return $vals->get() if $n-- > 0;
      return undef;
    }
  );
}


sub l_grep (&@) {
  my ($grep, @vals) = @_;

  my $vals = l_concat @vals;

  return Lazy::Util::OO->new(
    sub {
      while (defined(my $get = $vals->get())) {
        for ($get) {
          if ($grep->($get)) { return $get }
        }
      }

      return undef;
    }
  );
}


sub l_map (&@) {
  my ($map, @vals) = @_;

  my $vals = l_concat @vals;

  my @subvals = ();
  return Lazy::Util::OO->new(
    sub {
      return shift @subvals if @subvals;

      while (not @subvals) {
        my $get = $vals->get();
        return undef if not defined $get;

        @subvals = $map->($get) for $get;
      }

      return shift @subvals;
    }
  );
}


sub l_nuniq {
  my (@vals) = @_;

  my $vals = l_concat @vals;

  my %uniq;
  return Lazy::Util::OO->new(
    sub {
      while (defined(my $get = $vals->get())) {
        my $key = 0 + $get;
        $uniq{$key}++ or return $get;
      }
      return undef;
    }
  );
}


sub l_uniq {
  my (@vals) = @_;

  my $vals = l_concat @vals;

  my %uniq;
  return Lazy::Util::OO->new(
    sub {
      while (defined(my $get = $vals->get())) {
        $uniq{$get}++ or return $get;
      }
      return undef;
    }
  );
}


sub l_until (&@) {
  my ($until, @vals) = @_;

  my $vals = l_concat @vals;

  my $found = 0;
  return Lazy::Util::OO->new(
    sub {
      return undef if $found;

      my $get = $vals->get();
      $found = $until->($get) for $get;

      return $get;
    }
  );
}


sub g_count {
  my (@vals) = @_;

  my $vals = l_concat @vals;

  my $n = 0;
  while (defined $vals->get()) { $n++; }

  return $n;
}


sub g_first {
  my (@vals) = @_;

  my $vals = l_concat @vals;

  return $vals->get();
}


sub g_join {
  my ($sep, @vals) = @_;

  my $vals = l_concat @vals;

  my $ret = $vals->get();
  while (defined(my $get = $vals->get())) { $ret .= $sep . $get; }

  return $ret;
}


sub g_last {
  my @vals = @_;

  my $vals = l_concat @vals;

  my $ret = undef;
  while (defined(my $get = $vals->get())) { $ret = $get; }

  return $ret;
}


sub g_max {
  my @vals = @_;

  my $vals = l_concat @vals;

  my $ret = $vals->get();
  while (defined(my $get = $vals->get())) { $ret = $get if $get > $ret; }

  return $ret;
}


sub g_min {
  my @vals = @_;

  my $vals = l_concat @vals;

  my $ret = $vals->get();
  while (defined(my $get = $vals->get())) { $ret = $get if $get < $ret; }

  return $ret;
}


sub g_prod {
  my @vals = @_;

  my $vals = l_concat @vals;

  my $ret = 1;
  while (defined(my $get = $vals->get())) {
    $ret *= $get;
    return 0 if $ret == 0;
  }

  return $ret;
}


sub g_sum {
  my @vals = @_;

  my $vals = l_concat @vals;

  my $ret = 0;
  while (defined(my $get = $vals->get())) { $ret += $get; }

  return $ret;
}

1;

__END__