This is an automated email from the git hooks/post-receive script.

js pushed a commit to tag 0.91
in repository libcatmandu-perl.

commit b28cbc284e0836eda0d5ee0a578b4485adf8dc51
Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be>
Date:   Sun May 11 20:21:38 2014 +0200

    Fixing maybe and list monad
---
 lib/Catmandu/Fix/Bind.pm       |  2 +-
 lib/Catmandu/Fix/Bind/list.pm  | 22 ++++++----------------
 lib/Catmandu/Fix/Bind/maybe.pm | 20 ++++++--------------
 t/Catmandu-Fix-Bind-list.t     |  2 +-
 t/Catmandu-Fix-Bind-maybe.t    |  6 +++---
 5 files changed, 17 insertions(+), 35 deletions(-)

diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm
index 89973d4..3b652b4 100644
--- a/lib/Catmandu/Fix/Bind.pm
+++ b/lib/Catmandu/Fix/Bind.pm
@@ -13,7 +13,7 @@ around bind => sub {
     my ($orig, $self, $prev, @args) = @_;
     my $next = $orig->($self,$prev,@args);
 
-    if ($self->can('plus') && $self->can('zero')) {
+    if ($self->can('plus')) {
         return $self->plus($prev,$next);
     }
     else {
diff --git a/lib/Catmandu/Fix/Bind/list.pm b/lib/Catmandu/Fix/Bind/list.pm
index 15a82ab..4793270 100644
--- a/lib/Catmandu/Fix/Bind/list.pm
+++ b/lib/Catmandu/Fix/Bind/list.pm
@@ -13,21 +13,6 @@ sub zero {
        [];
 }
 
-sub plus {
-       my ($self,$a,$b) = @_;
-
-       if ($a == $self->zero || $b == $self->zero) {
-               return $self->zero;
-       }
-       elsif (Catmandu::Util::is_array_ref($b)) {
-               # Flatten the results
-               return [ grep {defined $_} (map { 
Catmandu::Util::is_array_ref($_) ? @$_ : $_ } @$b) ];
-       }
-       else {
-               $b;
-       }
-}
-
 sub unit {
        my ($self,$data) = @_;
 
@@ -46,13 +31,18 @@ sub bind {
        my ($self,$mvar,$func,$name) = @_;
 
        if (Catmandu::Util::is_array_ref($mvar)) {
-               [ map { $func->($_) } @$mvar ];
+               concat ( [ map { $func->($_) } @$mvar ] );
        }
        else {
                return $self->zero;
        }
 }
 
+# Flatten an array: [ [A] , [A] , [A] ] -> [ A, A, A]
+sub concat {
+       [ map { Catmandu::Util::is_array_ref($_) ? @$_ : $_ } @{$_[0]} ];
+}
+
 =head1 NAME
 
 Catmandu::Fix::Bind::maybe - a binder that computes Fix-es for every element 
in a list
diff --git a/lib/Catmandu/Fix/Bind/maybe.pm b/lib/Catmandu/Fix/Bind/maybe.pm
index c2867cc..234261b 100644
--- a/lib/Catmandu/Fix/Bind/maybe.pm
+++ b/lib/Catmandu/Fix/Bind/maybe.pm
@@ -8,32 +8,24 @@ with 'Catmandu::Fix::Bind';
 sub bind {
        my ($self,$mvar,$func) = @_;
 
-       my $res;
-
-       eval {
-               $res = $func->($mvar);
-       };
-       if ($@) {
-               if (ref $@ eq 'Catmandu::Fix::Reject') {
-                       die $@;
-               }
-               else {
-                       return $mvar;
-               }
+       if (! defined $mvar) {
+               return undef;
        }
+
+       my $res = $func->($mvar);
        
        $res;
 }
 
 =head1 NAME
 
-Catmandu::Fix::Bind::maybe - a binder that ignores all Fix functions that 
throw errors
+Catmandu::Fix::Bind::maybe - a binder that skips fixes is one returns undef
 
 =head1 SYNOPSIS
 
  do maybe()
        foo()
-       throw_error() # will be ignored
+       return_undef() # rest will be ignored
        bar()
  end
 
diff --git a/t/Catmandu-Fix-Bind-list.t b/t/Catmandu-Fix-Bind-list.t
index 5b69af9..d5d45df 100644
--- a/t/Catmandu-Fix-Bind-list.t
+++ b/t/Catmandu-Fix-Bind-list.t
@@ -15,7 +15,7 @@ BEGIN {
 require_ok $pkg;
 
 my $monad = Catmandu::Fix::Bind::list->new();
-my $f     = sub { $_[0]->{demo} = 1  ;  [ $_[0] ]; };
+my $f     = sub { $_[0]->{demo} = 1  ; [ $_[0] ]; };
 my $g     = sub { $_[0]->{demo} += 1 ; [ $_[0] ]; };
 
 is_deeply $monad->bind( $monad->unit({}), $f) , $f->({}) , "left unit monadic 
law";
diff --git a/t/Catmandu-Fix-Bind-maybe.t b/t/Catmandu-Fix-Bind-maybe.t
index 2d46d80..776a391 100644
--- a/t/Catmandu-Fix-Bind-maybe.t
+++ b/t/Catmandu-Fix-Bind-maybe.t
@@ -1,10 +1,10 @@
 #!/usr/bin/env perl
-package Catmandu::Fix::throw_error;
+package Catmandu::Fix::undef_error;
 
 use Moo;
 
 sub fix {
-  die "eek!";
+   undef;
 }
 
 package main;
@@ -113,7 +113,7 @@ is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 
'testing nesting';
 
 $fixes =<<EOF;
 do maybe()
-  throw_error()
+  undef_error()
   add_field(foo,bar)
 end
 EOF

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to