From 8e670dd6512860312aa9ee3dd59c71fba7f182a5 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Thu, 27 Dec 2012 05:28:07 -0600 Subject: block services --- lib/Bread/Board.pm | 78 ++++++++++++++++++++++++++-------- t/003_block_injection.t | 83 +++++++++++++++++++++++++++++++++++++ t/004_block_injection_w_out_class.t | 25 +++++++++++ 3 files changed, 168 insertions(+), 18 deletions(-) create mode 100644 t/003_block_injection.t create mode 100644 t/004_block_injection_w_out_class.t diff --git a/lib/Bread/Board.pm b/lib/Bread/Board.pm index c3d1a26..aba64df 100644 --- a/lib/Bread/Board.pm +++ b/lib/Bread/Board.pm @@ -9,9 +9,7 @@ role Bread::Board::Service { # makes it fail when the parameters aren't passed # shouldn't the " = {}" part be taking care of that? # has Hash of Bread::Board::Dependency $.dependencies = {}; - # has Hash of Hash $.parameters = {}; has $.dependencies = {}; - has $.parameters = {}; # XXX overriding new here is an extremely suboptimal solution # does perl 6 have anything like moose's coercions? @@ -35,23 +33,14 @@ role Bread::Board::Service { } } -class Bread::Board::Dependency { - has Bread::Board::Service $.service handles 'get'; -} - -class Bread::Board::ConstructorInjection does Bread::Board::Service { - has $.class; - has Str $.constructor_name is rw = 'new'; - - method get (*%params is copy) { - self.check_parameters(%params); - for $.dependencies.keys -> $name { - %params{$name} = $.dependencies{$name}.get; - } - return $.class."$.constructor_name"(|%params); - } +role Bread::Board::HasParameters { + # XXX not sure how to make these optional - specifying the types here + # makes it fail when the parameters aren't passed + # shouldn't the " = {}" part be taking care of that? + # has Hash of Hash $.parameters = {}; + has $.parameters = {}; - my method check_parameters (%params) { + method check_parameters (%params) { for $.parameters.keys -> $name { if not %params.{$name}:exists { die "Required parameter $name not given"; @@ -72,6 +61,59 @@ class Bread::Board::ConstructorInjection does Bread::Board::Service { } } +class Bread::Board::Dependency { + has Bread::Board::Service $.service handles 'get'; +} + +class Bread::Board::ConstructorInjection + does Bread::Board::Service + does Bread::Board::HasParameters { + + has $.class; + has Str $.constructor_name is rw = 'new'; + + method get (*%params is copy) { + # XXX remove more duplication? + self.check_parameters(%params); + for $.dependencies.keys -> $name { + %params{$name} = $.dependencies{$name}.get; + } + return $.class."$.constructor_name"(|%params); + } +} + +class Bread::Board::Parameters { + has Hash $.params; + # XXX do we really want to keep this API? + has $.class; + + method param (Str $name) { + return $.params.{$name}; + } +} + +class Bread::Board::BlockInjection + does Bread::Board::Service + does Bread::Board::HasParameters { + + has Callable $.block; + has $.class = Any; + + method get (*%params is copy) { + # XXX remove more duplication? + self.check_parameters(%params); + for $.dependencies.keys -> $name { + %params{$name} = $.dependencies{$name}.get; + } + return $.block.( + Bread::Board::Parameters.new( + params => %params, + class => $.class, + ) + ); + } +} + class Bread::Board::Literal does Bread::Board::Service { has $.value; diff --git a/t/003_block_injection.t b/t/003_block_injection.t new file mode 100644 index 0000000..ec12ec0 --- /dev/null +++ b/t/003_block_injection.t @@ -0,0 +1,83 @@ +use v6; +use Test; + +use Bread::Board; + +sub does_ok(Mu $var, Mu $type, $msg = ("The object does '" ~ $type.perl ~ "'")) { + ok($var.does($type), $msg); +} + +class Needle { } +class Mexican::Black::Tar { } +class Addict { + has $.needle; + has $.spoon; + has $.stash; + + method shoot_up_good (Addict $class: *%args) { + $class.new(|%args, overdose => 1); + } +} + +{ + my $s = Bread::Board::BlockInjection.new( + name => 'William', + class => Addict, + block => -> $s { $s.class.new(|$s.params) }, + dependencies => { + needle => Bread::Board::ConstructorInjection.new( + name => 'spike', + class => Needle, + ), + spoon => Bread::Board::Literal.new( + name => 'works', + value => 'Spoon!', + ), + }, + parameters => { + stash => { isa => Mexican::Black::Tar }, + }, + ); + + isa_ok($s, Bread::Board::BlockInjection); + does_ok($s, Bread::Board::Service); + + { + my $i = $s.get(stash => Mexican::Black::Tar.new); + isa_ok($i, Addict); + isa_ok($i.needle, Needle); + is($i.spoon, 'Spoon!'); + isa_ok($i.stash, Mexican::Black::Tar); + + my $i2 = $s.get(stash => Mexican::Black::Tar.new); + isnt($i, $i2); + } + + is($s.name, 'William'); + is($s.class.perl, Addict.perl); + + my $deps = $s.dependencies; + is_deeply([$deps.keys.sort], [qw/needle spoon/]); + + my $needle = $s.get_dependency('needle'); + isa_ok($needle, Bread::Board::Dependency); + isa_ok($needle.service, Bread::Board::ConstructorInjection); + is($needle.service.name, 'spike'); + is($needle.service.class.perl, Needle.perl); + + my $spoon = $s.get_dependency('spoon'); + isa_ok($spoon, Bread::Board::Dependency); + isa_ok($spoon.service, Bread::Board::Literal); + is($spoon.service.name, 'works'); + is($spoon.service.value, 'Spoon!'); + + my $params = $s.parameters; + is_deeply([$params.keys.sort], [qw/stash/]); + is_deeply($params., { isa => Mexican::Black::Tar }); + + dies_ok { $s.get }; + dies_ok { $s.get(stash => []) }; + dies_ok { $s.get(stash => Mexican::Black::Tar.new, foo => 10) }; +} + +done; diff --git a/t/004_block_injection_w_out_class.t b/t/004_block_injection_w_out_class.t new file mode 100644 index 0000000..3ff775e --- /dev/null +++ b/t/004_block_injection_w_out_class.t @@ -0,0 +1,25 @@ +use v6; +use Test; + +use Bread::Board; + +sub does_ok(Mu $var, Mu $type, $msg = ("The object does '" ~ $type.perl ~ "'")) { + ok($var.does($type), $msg); +} + +my $s = Bread::Board::BlockInjection.new( + name => 'NoClass', + block => -> $s { return { foo => $s.param('foo') } }, + dependencies => { + foo => Bread::Board::Literal.new(name => 'foo', value => 'FOO'); + }, +); + +isa_ok($s, Bread::Board::BlockInjection); +does_ok($s, Bread::Board::Service); + +my $x = $s.get; +isa_ok($x, Hash); +is_deeply($x, { foo => 'FOO' }); + +done; -- cgit v1.2.3