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 186a12faad7c76a77124f79e1d18d5c29011a1ba Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be> Date: Sat May 10 14:20:40 2014 +0200 Adding zero and plus operators for the Monad --- lib/Catmandu/Fix/Bind.pm | 70 +++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 57 insertions(+), 13 deletions(-) diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm index 29c08f3..156aeaa 100644 --- a/lib/Catmandu/Fix/Bind.pm +++ b/lib/Catmandu/Fix/Bind.pm @@ -8,6 +8,11 @@ requires 'bind'; has fixes => (is => 'rw', default => sub { [] }); +sub zero { + my ($self) = @_; + +{}; +} + sub unit { my ($self,$data) = @_; return $data; @@ -15,7 +20,17 @@ sub unit { sub bind { my ($self,$data,$code,$name,$perl) = @_; - return $code->($data); + return $code->($data); +} + +sub plus { + my ($self,$prev,$curr) = @_; + if ($prev == $self->zero || $curr == $self->zero) { + $self->zero; + } + else { + $curr; + } } sub finally { @@ -39,26 +54,26 @@ sub emit_bind { my $perl = ""; - my $bind_var = $fixer->capture($self); - my $unit = $fixer->generate_var; + my $monad = $fixer->capture($self); + my $m_res = $fixer->generate_var; - $perl .= "my ${unit} = ${bind_var}->unit(${var});"; + $perl .= "my ${m_res} = ${monad}->unit(${var});"; for my $pair (@$code) { my $name = $pair->[0]; my $code = $pair->[1]; my $code_var = $fixer->capture($code); - $perl .= "${unit} = ${bind_var}->bind(${unit}, sub {"; + $perl .= "${m_res} = ${monad}->plus(${m_res},${monad}->bind(${m_res}, sub {"; $perl .= "${var} = shift;"; $perl .= $code; $perl .= "${var}"; - $perl .= "},'$name',${code_var});" + $perl .= "},'$name',${code_var}));" } - $perl .= "${unit} = ${bind_var}->finally(${unit});" if $self->can('finally'); + $perl .= "${var} = ${monad}->finally(${m_res});" if $self->can('finally'); my $reject = $fixer->capture($fixer->_reject); - $perl .= "return ${unit} if ${unit} == ${reject};"; + $perl .= "return ${var} if ${var} == ${reject};"; $perl; } @@ -118,25 +133,54 @@ A Catmandu::Fix::Bind needs to implement two methods: 'unit' and 'bind'. The unit method receives a Perl $data HASH and should return it. The 'unit' method is called on a Catmandu::Fix::Bind instance before all Fix methods are executed. A trivial implementation of 'unit' is: + # Wrap the data into an array sub unit { my ($self,$data) = @_; - return $data; + my $m_data = ['foobar',$data]; + return $m_data; } -=head2 bind($data,$code,$name,$perl) +=head2 bind($m_data,$code,$name,$perl) The bind method is executed for every Catmandu::Fix method in the fixer. It receives the $data , which as wrapped by unit, the fix method as anonymous subroutine, the name of the fix and the actual perl code to run it. It should return the fixed code. A trivial implementaion of 'bind' is: + # Unwrap the data and execute the given code sub bind { - my ($self,$data,$code,$name) = @_; - return $code->($data); + my ($self,$m_data,$code,$name) = @_; + my ($foo, $data) = @$m_data + my $res = $code->($data); + ['foobar',$res]; } +=head2 zero + +Optionally provide an zero unit in combining computations. E.g. + + sub zero { + return undef; + } + +=head2 plus($prev,$curr) + +Optionally provide a function to combine the results of two computations. E.g. + + sub plus { + my ($self,$prev,$curr) = @_; + return $curr; + } + =head2 finally($data) -Optionally finally is executed on the data when all the fixes in a do block have run. +Optionally finally is executed on the data when all the fixes in a do block have run. A trivial example of finally is: + + # Unwrap the data and return the original + sub finally { + my ($self,$m_data) = @_; + my ($foo, $data) = @$m_data ; + $data; + } =head1 SEE ALSO -- 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