[libcatmandu-perl] 05/85: Extended the Fix language with do (monad)

[Jonas Smedegaard]

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 25ce81bac2fb46023b0ad8b6fabfa828f444c004
Author: Patrick Hochstenbach <patrick.hochstenbach at ugent.be>
Date:   Thu May 8 07:29:15 2014 +0200

    Extended the Fix language with do (monad)
---
 lib/Catmandu/Fix.pm               |  2 +-
 lib/Catmandu/Fix/Bind.pm          | 15 +++++++++++++++
 lib/Catmandu/Fix/Bind/identity.pm |  8 ++++++++
 lib/Catmandu/Fix/Parser.pm        | 19 +++++++++++++++++++
 4 files changed, 43 insertions(+), 1 deletion(-)

diff --git a/lib/Catmandu/Fix.pm b/lib/Catmandu/Fix.pm
index adc9205..5d8c66c 100644
--- a/lib/Catmandu/Fix.pm
+++ b/lib/Catmandu/Fix.pm
@@ -26,7 +26,7 @@ has _captures   => (is => 'ro', lazy => 1, init_arg => undef, default => sub { +
 has var         => (is => 'ro', lazy => 1, init_arg => undef, builder => 'generate_var');
 has fixes       => (is => 'ro', required => 1, trigger => 1);
 has binds       => (is => 'ro');
-has binder      => (is => 'lazy');
+has binder      => (is => 'rw');
 has _reject     => (is => 'ro', init_arg => undef, default => sub { +{} });
 has _reject_var => (is => 'ro', lazy => 1, init_arg => undef, builder => '_build_reject_var');
 
diff --git a/lib/Catmandu/Fix/Bind.pm b/lib/Catmandu/Fix/Bind.pm
index 22fed80..6ea77ea 100644
--- a/lib/Catmandu/Fix/Bind.pm
+++ b/lib/Catmandu/Fix/Bind.pm
@@ -6,6 +6,8 @@ use namespace::clean;
 requires 'unit';
 requires 'bind';
 
+has fixes => (is => 'rw', default => sub { [] });
+
 sub unit {
 	my ($self,$data) = @_;
 	return $data;
@@ -16,6 +18,19 @@ sub bind {
 	return $code->($data);
 }
 
+sub emit {
+    my ($self, $fixer, $label) = @_;
+    my $perl = "";
+    
+    $fixer->binder([$self]);
+
+    $perl .= $fixer->emit_fixes($self->fixes);
+
+    $fixer->binder(undef);
+
+    $perl;
+}
+
 =head1 NAME
 
 Catmandu::Fix::Bind - a Binder for fixes
diff --git a/lib/Catmandu/Fix/Bind/identity.pm b/lib/Catmandu/Fix/Bind/identity.pm
new file mode 100644
index 0000000..7972ef3
--- /dev/null
+++ b/lib/Catmandu/Fix/Bind/identity.pm
@@ -0,0 +1,8 @@
+package Catmandu::Fix::Bind::identity;
+
+use Moo;
+use Data::Dumper;
+
+with 'Catmandu::Fix::Bind';
+
+1;
\ No newline at end of file
diff --git a/lib/Catmandu/Fix/Parser.pm b/lib/Catmandu/Fix/Parser.pm
index 48a87bf..9480d68 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
+             | do         action => ::first
              | fix        action => ::first
 
 old_if ::= old_if_condition fixes ('end()') bless => IfElse
@@ -45,6 +46,10 @@ old_unless_condition ::= old_unless_name ('(') args (')') bless => OldCondition
 
 condition ::= name ('(') args (')') bless => Condition
 
+do ::= ('do') bind fixes ('end') bless => Do
+
+bind ::= name ('(') args (')') bless => Bind
+
 fix ::= name ('(') args (')') bless => Fix
 
 args ::= arg* separator => sep
@@ -159,6 +164,20 @@ sub Catmandu::Fix::Parser::OldCondition::reify {
         ->new(map { $_->reify } @$args);
 }
 
+sub Catmandu::Fix::Parser::Do::reify {
+    my $bind       = $_[0]->[0]->reify;
+    my $do_fixes   = $_[0]->[1];
+    $bind->fixes([map { $_->reify } @$do_fixes]);
+    $bind;
+}
+
+sub Catmandu::Fix::Parser::Bind::reify {
+    my $name = $_[0]->[0];
+    my $args = $_[0]->[1];
+    Catmandu::Util::require_package($name, 'Catmandu::Fix::Bind')
+        ->new(map { $_->reify } @$args);
+}
+
 sub Catmandu::Fix::Parser::DoubleQuotedString::reify {
     my $str = $_[0]->[0];
 

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