simplify and generalise

diff --git a/lib/Attribute/Builder.pm b/lib/Attribute/Builder.pm
new file mode 100644 (file)
index 0000000..1f8a403
--- /dev/null
+++ b/lib/Attribute/Builder.pm
@@ -0,0 +1,15 @@
+package Attribute::Builder;
+
+use strictures 1;
+use base qw(Exporter);
+use Attribute::Builder::AttributeSet;
+use Moo::Role ();
+
+our @EXPORT = qw(builder);
+
+sub builder {
+  my $target = caller;
+  Moo::Role->apply_roles_to_package($target, AttributeSet(@_));
+}
+
+1;

diff --git a/lib/Object/Builder.pm b/lib/Object/Builder.pm
index 2cbe0e0..96ac635 100644 (file)
--- a/lib/Object/Builder.pm
+++ b/lib/Object/Builder.pm
@@ -1,6 +1,8 @@
 package Object::Builder;
 
 use Module::Runtime qw(use_module);
+use List::Util qw(reduce);
+use Scalar::Util qw(weaken);
 use Moo;
 
 our $VERSION = '0.000001'; # 0.0.1
@@ -15,21 +17,33 @@ has class => (
 sub _build_class { die "No default class set" }
 
 has roles => (
-  is => 'rw', lazy => 1, builder => 1,
+  is => 'rw', lazy => 1, builder => 1, clearer => 1,
   trigger => sub { shift->_clear_final_class },
-  clearer => 'reset_roles',
+  coerce => sub { ref($_[0]) eq 'ARRAY' ? { '' => $_[0] } : $_[0] },
 );
 
-after reset_roles => sub { shift->_clear_final_class };
+sub set_roles_for {
+  my ($self, $for, @roles) = @_;
+  $self->roles({ %{$self->roles}, $for => \@roles });
+  return;
+}
+
+after clear_roles => sub { shift->_clear_final_class };
 
-sub _build_roles { [] }
+sub _build_roles { {} }
+
+sub _role_list {
+  my ($self) = @_;
+  my $roles = $self->roles;
+  map @{$roles->{$_}}, sort keys %$roles;
+}
 
 has _final_class => (is => 'lazy', clearer => 1);
 
 sub _build__final_class {
   my ($self) = @_;
   my $class = use_module($self->class);
-  if (my @roles = @{$self->roles}) {
+  if (my @roles = $self->_role_list) {
     require Moo::Role;
     return Moo::Role->create_class_with_roles($class, @roles);
   } else {
@@ -42,30 +56,46 @@ after _clear_final_class => sub { shift->clear_object };
 has constructor => (is => 'ro', default => sub { 'new' });
 
 has arguments => (
-  is => 'rw', builder => 1,
+  is => 'rw', builder => 1, clearer => 1,
   trigger => sub { shift->_clear_final_arguments },
-  clearer => 'reset_arguments',
 );
 
-after reset_arguments => sub { shift->_clear_final_arguments };
+sub set_argument {
+  my ($self, $name, @arg) = @_;
+  $self->arguments({ %{$self->arguments}, $name => \@arg });
+}
 
-sub _build_arguments { {} }
+sub set_argument_weaken {
+  my ($self, $name, @arg) = @_;
+  weaken($arg[0]);
+  $self->arguments({ %{$self->arguments}, $name => \@arg });
+}
 
-has argument_filter => (
-  is => 'rw', builder => 1,
-  trigger => sub { shift->_clear_final_arguments },
-  clearer => 'reset_argument_filter',
-);
+sub _build_arguments { {} }
 
-sub _build_argument_filter { sub { shift } }
+after clear_arguments => sub { shift->_clear_final_arguments };
 
 has _final_arguments => (is => 'lazy', clearer => 1);
 
-after _clear_final_arguments => sub { shift->_clear_object };
+after _clear_final_arguments => sub { shift->clear_object };
 
 sub _build__final_arguments {
   my ($self) = @_;
-  $self->argument_filter->($self->arguments);
+  my %arguments = %{$self->arguments};
+  map +($_ => $self->_resolve($arguments{$_})), keys %arguments;
+}
+
+sub _resolve {
+  my ($self, $to_resolve) = @_;
+
+  # [ $x ] -> $x
+  # [ $inv, 'x', 'y' ] -> $inv->x->y
+  # [ $inv, [ 'x', 'y' ], 'z' ] -> $inv->x('y')->z
+
+  return reduce {
+    my ($meth, @arg) = (ref($b) eq 'ARRAY' ? @$b : $b);
+    $a->$meth(@arg);
+  } @$to_resolve;
 }
 
 has object => (is => 'lazy', clearer => 1);
@@ -75,6 +105,11 @@ sub _build_object {
   $self->_final_class->${\$self->constructor}($self->_final_arguments);
 }
 
+sub fresh_object {
+  my ($self) = @_;
+  $self->_build_object;
+}
+
 sub BUILD {
   my ($self, $args) = @_;
   unless (