lib/DX/ResolutionSpace.pm

   1 package DX::ResolutionSpace;
   2
   3 use DX::Step::Backtrack;
   4 use DX::Step::ResolveProposition;
   5 use DX::Utils qw(compact_deps);
   6 use DX::Class;
   7
   8 has proposition => (is => 'ro', isa => Proposition);
   9
  10 has geometry_depends_on => (is => 'ro', required => 1, isa => DependencyList);
  11
  12 has aperture => (is => 'ro', required => 1, isa => ApertureList);
  13
  14 has members => (
  15   is => 'ro', required => 1, isa => ArrayRef[ResolutionStrategy|Resolution]
  16 );
  17
  18 sub for_deparse {
  19   my ($self) = @_;
  20   [ statement => [
  21     [ symbol => 'resolution_space' ],
  22     [ pairs => [
  23       [ proposition => $self->proposition ],
  24       [ geometry_depends_on => [ block => [
  25         map [ statement => [
  26           [ symbol => (split '::', ${$_->[0]})[-1] ],
  27           [ value_path => [ @{$_}[1..$#$_] ] ],
  28         ] ], @{$self->geometry_depends_on}
  29       ] ] ],
  30       (@{$self->aperture}
  31         ? [ aperture => [ block => [
  32             map [ statement => [
  33               [ symbol => (split '::', ${$_->[0]})[-1] ],
  34               [ value_path => [ @{$_}[1..$#$_] ] ],
  35             ] ], @{$self->aperture}
  36           ] ] ]
  37         : ()),
  38       [ members => [ block => [ @{$self->members} ] ] ]
  39     ] ],
  40   ] ];
  41 }
  42
  43 sub next_resolution {
  44   my ($self) = @_;
  45   return undef unless my ($first) = @{$self->members};
  46   return $first->next_resolution;
  47 }
  48
  49 sub remaining_resolution_space {
  50   my ($self) = @_;
  51   die "Sense makes not" unless my ($first, @rest) = @{$self->members};
  52   return $self->but(members => [ $first->remainder, @rest ]);
  53 }
  54
  55 sub next_step {
  56   my ($self) = @_;
  57   my $step_type = (@{$self->members} ? 'ResolveProposition' : 'Backtrack');
  58   return "DX::Step::${step_type}"->new(resolution_space => $self);
  59 }
  60
  61 sub with_geometry_dependencies {
  62   my ($self, $deps) = @_;
  63   my $new_deps = compact_deps([ @{$self->geometry_depends_on}, @$deps ]);
  64   return $self->but(geometry_depends_on => $new_deps);
  65 }
  66
  67 1;