[libcatmandu-perl] 12/85: Simplyfying monads
Jonas Smedegaard
dr at jones.dk
Tue May 20 09:56:15 UTC 2014
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 8ab600587abe1649df600f86422285b6e6525028
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date: Fri May 9 12:06:19 2014 +0200
Simplyfying monads
---
lib/Catmandu/Fix/Bind.pm | 3 +--
lib/Catmandu/Fix/Bind/each.pm | 36 +++++++++++++++++++++++++++++-------
2 files changed, 30 insertions(+), 9 deletions(-)
diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm
index d089818..b8215e9 100644
--- a/lib/Catmandu/Fix/Bind.pm
+++ b/lib/Catmandu/Fix/Bind.pm
@@ -2,7 +2,6 @@ package Catmandu::Fix::Bind;
use Moo::Role;
use namespace::clean;
-use Data::Dumper;
requires 'unit';
requires 'bind';
@@ -46,7 +45,7 @@ sub emit_bind {
my $bind_var = $fixer->capture($self);
my $unit = $fixer->generate_var;
-
+
$perl .= "my ${unit} = ${bind_var}->unit(${var});";
for my $pair (@$code) {
diff --git a/lib/Catmandu/Fix/Bind/each.pm b/lib/Catmandu/Fix/Bind/each.pm
index da37293..2d30e27 100644
--- a/lib/Catmandu/Fix/Bind/each.pm
+++ b/lib/Catmandu/Fix/Bind/each.pm
@@ -2,12 +2,13 @@ package Catmandu::Fix::Bind::each;
use Moo;
use Catmandu::Util qw(:data :is);
-use Data::Dumper;
with 'Catmandu::Fix::Bind';
-has path => (is => 'ro' , required => 1);
-has index => (is => 'ro');
+has path => (is => 'ro' , required => 1);
+has index => (is => 'ro');
+has values => (is => 'rw', default => sub { [] });
+has promises => (is => 'rw', default => sub { [] });
sub bind {
my ($self,$data,$code,$name) = @_;
@@ -15,13 +16,34 @@ sub bind {
my $value = data_at($self->path,$data);
if (defined $value && is_array_ref($value)) {
- for my $i (@$value) {
- $data->{$self->index} = $i if defined $self->index;
- $data = $code->($data);
- }
+ $self->values($value);
+ push @{$self->promises} , [$code,$name];
}
$data;
}
+sub finally {
+ my ($self,$data) = @_;
+
+ for my $i (@{$self->values}) {
+ for my $promise (@{$self->promises}) {
+ my ($code,$name) = @$promise;
+ if (defined $self->index) {
+ $data->{$self->index} = $i;
+ }
+ $data = $code->($data);
+ }
+ }
+
+ if (defined $self->index) {
+ delete $data->{$self->index};
+ }
+
+ $self->promises([]);
+ $self->values([]);
+
+ $data;
+}
+
1;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libcatmandu-perl.git
More information about the Pkg-perl-cvs-commits
mailing list