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 828f0ad4bd45dab59098350c2c33b28c1d12c5d1 Author: Patrick Hochstenbach <patrick.hochstenb...@ugent.be> Date: Sun May 11 08:08:46 2014 +0200 Adding a doset syntax --- lib/Catmandu/Fix/Bind.pm | 67 ++++++++++++++++++++++---------------- lib/Catmandu/Fix/Bind/benchmark.pm | 2 +- lib/Catmandu/Fix/Bind/identity.pm | 2 +- lib/Catmandu/Fix/Bind/maybe.pm | 2 +- lib/Catmandu/Fix/Parser.pm | 12 +++++++ t/Catmandu-Fix-Bind-benchmark.t | 3 +- t/Catmandu-Fix-Bind-identity.t | 3 +- t/Catmandu-Fix-Bind-maybe.t | 3 +- 8 files changed, 57 insertions(+), 37 deletions(-) diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm index bb9ecf1..54dbd66 100644 --- a/lib/Catmandu/Fix/Bind.pm +++ b/lib/Catmandu/Fix/Bind.pm @@ -6,7 +6,8 @@ use namespace::clean; requires 'unit'; requires 'bind'; -has fixes => (is => 'rw', default => sub { [] }); +has return => (is => 'rw', default => sub { [0]}); +has fixes => (is => 'rw', default => sub { [] }); sub unit { my ($self,$data) = @_; @@ -18,11 +19,6 @@ sub bind { return $code->($data); } -sub finally { - my ($self,$data) = @_; - $data; -} - sub emit { my ($self, $fixer, $label) = @_; @@ -42,10 +38,6 @@ sub emit_bind { my $bind_var = $fixer->capture($self); my $unit = $fixer->generate_var; - # Poor man's monads using global state. Should be a bit - # faster than nested binds. The finally method is required - # to unwrap monadic values again to perl Hashes that - # Catmandu::Fix can understand $perl .= "my ${unit} = ${bind_var}->unit(${var});"; for my $pair (@$code) { @@ -53,17 +45,22 @@ sub emit_bind { my $code = $pair->[1]; my $code_var = $fixer->capture($code); $perl .= "${unit} = ${bind_var}->bind(${unit}, sub {"; - $perl .= "${var} = shift;"; + $perl .= "my ${var} = shift;"; $perl .= $code; $perl .= "${var}"; $perl .= "},'$name',${code_var});" } - $perl .= "${unit} = ${bind_var}->finally(${unit});" if $self->can('finally'); - my $reject = $fixer->capture($fixer->_reject); $perl .= "return ${unit} if defined ${unit} && ${unit} == ${reject};"; + if ($self->return) { + $perl .= "return ${unit};"; + } + else { + $perl .= "return ${var};"; + } + $perl; } @@ -104,7 +101,7 @@ Bind is a package that wraps Catmandu::Fix-es and other Catmandu::Bind-s togethe the programmer further control on the excution of fixes. With Catmandu::Fix::Bind you can simulate the 'before', 'after' and 'around' modifiers as found in Moo or Dancer. -To wrap Fix functions, the Fix language has a 'do' statment: +To wrap Fix functions, the Fix language has a 'do' statement: do BIND FIX1 @@ -112,9 +109,34 @@ To wrap Fix functions, the Fix language has a 'do' statment: FIX3 end -where BIND is a implementation of BIND and FIX1,...,FIXn are fix functions. +where BIND is a implementation of Catmandu::Fix::Bind and FIX1,...,FIXn are Catmandu::Fix functions. + +In the example above the BIND will wrap FIX1, FIX2 and FIX3. BIND will first wrap the record data +using its 'unit' method and send the data sequentially to each FIX which can make inline changes +to the record data. In pseudo-code this will look like: -In the example above the BIND will wrap FIX1, FIX2 and FIX3. + $bind_data = $bind->unit($data); + $bind_data = $bind->bind($bind_data, $fix1); + $bind_data = $bind->bind($bind_data, $fix2); + $bind_data = $bind->bind($bind_data, $fix3); + return $data; + + An alternative form exists, 'doset' which will overwrite the record data with results of the last + fix. + + doset BIND + FIX1 + FIX2 + FIX3 + end + +Will result in a pseudo code like: + + $bind_data = $bind->unit($data); + $bind_data = $bind->bind($bind_data, $fix1); + $bind_data = $bind->bind($bind_data, $fix2); + $bind_data = $bind->bind($bind_data, $fix3); + return $bind_data; A Catmandu::Fix::Bind needs to implement two methods: 'unit' and 'bind'. @@ -147,20 +169,9 @@ A trivial, but verbose, implementaion of 'bind' is: $data; } -=head2 finally($data) - -Optionally finally is executed at the end the 'do' block. This method should be an inverse of unit (unwrap the data). -A trivial, but verbose, implementation of 'finally' is: - - sub finally { - my ($self,$wrapped_data) = @_; - my $data = $wrapped_data; - $data; - } - =head1 REQUIREMENTS -Bind mmodules are simplified implementations of Monads. They should answer the formal definition of Monads, codified +Bind modules are simplified implementations of Monads. They should answer the formal definition of Monads, codified in 3 monadic laws: =head2 left unit: unit acts as a neutral element of bind diff --git a/lib/Catmandu/Fix/Bind/benchmark.pm b/lib/Catmandu/Fix/Bind/benchmark.pm index 017ecdb..c82539b 100644 --- a/lib/Catmandu/Fix/Bind/benchmark.pm +++ b/lib/Catmandu/Fix/Bind/benchmark.pm @@ -80,7 +80,7 @@ Required. The path of a file to which the benchmark statistics will be written. =head1 AUTHOR -hochsten L<hochs...@cpan.org> +Patrick Hochstenbach <Patrick . Hochstenbach @ UGent . be > =head1 SEE ALSO diff --git a/lib/Catmandu/Fix/Bind/identity.pm b/lib/Catmandu/Fix/Bind/identity.pm index 6d20101..e50e480 100644 --- a/lib/Catmandu/Fix/Bind/identity.pm +++ b/lib/Catmandu/Fix/Bind/identity.pm @@ -37,7 +37,7 @@ applies the bound fix functions to its input without any modification. =head1 AUTHOR -hochsten L<hochs...@cpan.org> +Patrick Hochstenbach <Patrick . Hochstenbach @ UGent . be > =head1 SEE ALSO diff --git a/lib/Catmandu/Fix/Bind/maybe.pm b/lib/Catmandu/Fix/Bind/maybe.pm index b8975ca..c324c9b 100644 --- a/lib/Catmandu/Fix/Bind/maybe.pm +++ b/lib/Catmandu/Fix/Bind/maybe.pm @@ -38,7 +38,7 @@ The maybe binder computes all the Fix function and ignores fixes that throw exce =head1 AUTHOR -hochsten L<hochs...@cpan.org> +Patrick Hochstenbach <Patrick . Hochstenbach @ UGent . be > =head1 SEE ALSO diff --git a/lib/Catmandu/Fix/Parser.pm b/lib/Catmandu/Fix/Parser.pm index 9480d68..0c768de 100644 --- a/lib/Catmandu/Fix/Parser.pm +++ b/lib/Catmandu/Fix/Parser.pm @@ -23,6 +23,7 @@ expression ::= old_if action => ::first | unless action => ::first | select action => ::first | reject action => ::first + | doset action => ::first | do action => ::first | fix action => ::first @@ -46,6 +47,8 @@ old_unless_condition ::= old_unless_name ('(') args (')') bless => OldCondition condition ::= name ('(') args (')') bless => Condition +doset ::= ('doset') bind fixes ('end') bless => DoSet + do ::= ('do') bind fixes ('end') bless => Do bind ::= name ('(') args (')') bless => Bind @@ -164,9 +167,18 @@ sub Catmandu::Fix::Parser::OldCondition::reify { ->new(map { $_->reify } @$args); } +sub Catmandu::Fix::Parser::DoSet::reify { + my $bind = $_[0]->[0]->reify; + my $do_fixes = $_[0]->[1]; + $bind->return(1); + $bind->fixes([map { $_->reify } @$do_fixes]); + $bind; +} + sub Catmandu::Fix::Parser::Do::reify { my $bind = $_[0]->[0]->reify; my $do_fixes = $_[0]->[1]; + $bind->return(0); $bind->fixes([map { $_->reify } @$do_fixes]); $bind; } diff --git a/t/Catmandu-Fix-Bind-benchmark.t b/t/Catmandu-Fix-Bind-benchmark.t index a670e51..ae0f3b3 100644 --- a/t/Catmandu-Fix-Bind-benchmark.t +++ b/t/Catmandu-Fix-Bind-benchmark.t @@ -22,7 +22,6 @@ is_deeply $monad->bind( $monad->unit({}), $f) , $f->({}) , "left unit monadic la is_deeply $monad->bind( $monad->unit({}), sub { $monad->unit(shift) }) , $monad->unit({}) , "right unit monadic law"; is_deeply $monad->bind( $monad->bind( $monad->unit({}), $f ) , $g ) , $monad->bind( $monad->unit({}) , sub { $monad->bind($f->($_[0]),$g) } ) , "associative monadic law"; -is_deeply $monad->finally( $monad->unit({hello => 'world'} ) ) , {hello => 'world'} , "can we unwrap the monad?"; my $fixes =<<EOF; do benchmark(output => /dev/null) @@ -103,4 +102,4 @@ $fixer = Catmandu::Fix->new(fixes => [$fixes]); is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; -done_testing 14; \ No newline at end of file +done_testing 13; \ No newline at end of file diff --git a/t/Catmandu-Fix-Bind-identity.t b/t/Catmandu-Fix-Bind-identity.t index e60868b..7bb2d72 100644 --- a/t/Catmandu-Fix-Bind-identity.t +++ b/t/Catmandu-Fix-Bind-identity.t @@ -22,7 +22,6 @@ is_deeply $monad->bind( $monad->unit({}), $f) , $f->({}) , "left unit monadic la is_deeply $monad->bind( $monad->unit({}), sub { $monad->unit(shift) }) , $monad->unit({}) , "right unit monadic law"; is_deeply $monad->bind( $monad->bind( $monad->unit({}), $f ) , $g ) , $monad->bind( $monad->unit({}) , sub { $monad->bind($f->($_[0]),$g) } ) , "associative monadic law"; -is_deeply $monad->finally( $monad->unit({hello => 'world'} ) ) , {hello => 'world'} , "can we unwrap the monad?"; my $fixes =<<EOF; do identity() @@ -103,4 +102,4 @@ $fixer = Catmandu::Fix->new(fixes => [$fixes]); is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'testing nesting'; -done_testing 14; \ No newline at end of file +done_testing 13; \ No newline at end of file diff --git a/t/Catmandu-Fix-Bind-maybe.t b/t/Catmandu-Fix-Bind-maybe.t index c89a3d5..2d46d80 100644 --- a/t/Catmandu-Fix-Bind-maybe.t +++ b/t/Catmandu-Fix-Bind-maybe.t @@ -31,7 +31,6 @@ is_deeply $monad->bind( $monad->unit({}), $f) , $f->({}) , "left unit monadic la is_deeply $monad->bind( $monad->unit({}), sub { $monad->unit(shift) }) , $monad->unit({}) , "right unit monadic law"; is_deeply $monad->bind( $monad->bind( $monad->unit({}), $f ) , $g ) , $monad->bind( $monad->unit({}) , sub { $monad->bind($f->($_[0]),$g) } ) , "associative monadic law"; -is_deeply $monad->finally( $monad->unit({hello => 'world'} ) ) , {hello => 'world'} , "can we unwrap the monad?"; my $fixes =<<EOF; do maybe() @@ -123,4 +122,4 @@ $fixer = Catmandu::Fix->new(fixes => [$fixes]); is_deeply $fixer->fix({foo => 'bar'}), {foo => 'bar'} , 'specific testing'; -done_testing 15; \ No newline at end of file +done_testing 14; \ No newline at end of file -- 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