Make LaTeX::TikZ::Scope objects immutable

[perl/modules/LaTeX-TikZ.git] / lib / LaTeX / TikZ / Scope.pm
diff --git a/lib/LaTeX/TikZ/Scope.pm b/lib/LaTeX/TikZ/Scope.pm

index d8ce86183abfde264ab100125983fc7873a3b34e..1a57c613f36fbf1513be0a3f72d5ea3d331939d7 100644 (file)
--- a/lib/LaTeX/TikZ/Scope.pm
+++ b/lib/LaTeX/TikZ/Scope.pm
@@ -28,9 +28,9 @@ use Any::Moose;
  =cut
  
  has '_mods' => (
- is       => 'ro',
+ is       => 'rw',
   isa      => 'Maybe[ArrayRef[LaTeX::TikZ::Mod::Formatted]]',
- init_arg => undef,
+ init_arg => 'mods',
   default  => sub { [ ] },
  );
  
@@ -47,58 +47,47 @@ has '_mods_cache' => (
  
  =cut
  
-has '_body' => (
- is       => 'rw',
+has 'body' => (
+ is       => 'ro',
   isa      => 'LaTeX::TikZ::Scope|ArrayRef[Str]',
+ required => 1,
   init_arg => 'body',
  );
  
-my $my_tc    = LaTeX::TikZ::Tools::type_constraint(__PACKAGE__);
-my $ltmf_tc  = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Formatted');
-my $_body_tc = __PACKAGE__->meta->find_attribute_by_name('_body')
-                                ->type_constraint;
+my $my_tc   = LaTeX::TikZ::Tools::type_constraint(__PACKAGE__);
+my $ltmf_tc = LaTeX::TikZ::Tools::type_constraint('LaTeX::TikZ::Mod::Formatted');
+my $body_tc = __PACKAGE__->meta->find_attribute_by_name('body')
+                               ->type_constraint;
  
-=head1 METHODS
+around 'BUILDARGS' => sub {
+ my ($orig, $class, %args) = @_;
  
-=head2 C<mod>
+ my $mods = $args{mods};
+ if (defined $mods and ref $mods eq 'ARRAY') {
+  for my $mod (@$mods) {
+   $mod = $ltmf_tc->coerce($mod);
+  }
+ }
  
-=cut
+ $class->$orig(%args);
+};
  
-sub mod {
+sub BUILD {
   my $scope = shift;
  
   my $cache = $scope->_mods_cache;
  
- for (@_) {
-  my $mod = $ltmf_tc->coerce($_);
-  $ltmf_tc->assert_valid($mod);
+ my @unique_mods;
+ for my $mod ($scope->mods) {
    my $tag = $mod->tag;
    next if exists $cache->{$tag};
    $cache->{$tag} = $mod;
-  push @{$scope->_mods}, $mod;
- }
-
- $scope;
-}
-
-=head2 C<body>
-
-=cut
-
-sub body {
- my $scope = shift;
-
- if (@_) {
-  $scope->_body($_[0]);
-  $scope;
- } else {
-  @{$scope->_body};
+  push @unique_mods, $mod;
   }
+ $scope->_mods(\@unique_mods);
  }
  
-use overload (
- '@{}' => 'dereference',
-);
+=head1 METHODS
  
  =head2 C<flatten>
  
@@ -108,11 +97,12 @@ sub flatten {
   my ($scope) = @_;
  
   do {
-  my $body = $scope->_body;
+  my $body = $scope->body;
    return $scope unless $my_tc->check($body);
-  $scope = $scope->new
-                 ->mod ($scope->mods, $body->mods)
-                 ->body($body->_body)
+  $scope = $scope->new(
+   mods => [ $scope->mods, $body->mods ],
+   body => $body->body,
+  );
   } while (1);
  }
  
@@ -160,7 +150,7 @@ sub instantiate {
    }
   }
  
- my @body = $scope->body;
+ my @body = @{$scope->body};
  
   my $mods_string = @raw_mods ? ' [' . join(',', @raw_mods) . ']' : undef;
  
@@ -192,12 +182,6 @@ sub instantiate {
   return @body;
  }
  
-=head2 C<dereference>
-
-=cut
-
-sub dereference { [ $_[0]->instantiate ] }
-
  =head2 C<fold>
  
  =cut
@@ -227,20 +211,23 @@ sub fold {
     }
  
     if (!$has_different_layers and @$common) {
-    my $x = $left->new
-                 ->mod(@$only_left)
-                 ->body($left->_body);
-    my $y = $left->new
-                 ->mod(@$only_right)
-                 ->body($right->_body);
-    return $left->new
-                ->mod(@$common)
-                ->body(fold($x, $y, $rev));
+    my $x = $left->new(
+     mods => $only_left,
+     body => $left->body,
+    );
+    my $y = $left->new(
+     mods => $only_right,
+     body => $right->body,
+    );
+    return $left->new(
+     mods => $common,
+     body => fold($x, $y, $rev),
+    );
     } else {
      @right = $right->instantiate;
     }
    } else {
-   $_body_tc->assert_valid($right);
+   $body_tc->assert_valid($right);
     @right = @$right;
    }
  
@@ -249,7 +236,7 @@ sub fold {
    if ($my_tc->check($right)) {
     return fold($right, $left, 1);
    } else {
-   $_body_tc->assert_valid($_) for $left, $right;
+   $body_tc->assert_valid($_) for $left, $right;
     @left  = @$left;
     @right = @$right;
    }
@@ -258,6 +245,10 @@ sub fold {
   $rev ? [ @right, @left ] : [ @left, @right ];
  }
  
+use overload (
+ '@{}' => sub { [ $_[0]->instantiate ] },
+);
+
  __PACKAGE__->meta->make_immutable;
  
  =head1 SEE ALSO