initial partial sketch

[scpubgit/DX.git] / lib / DX / Hypothesis.pm

diff --git a/lib/DX/Hypothesis.pm b/lib/DX/Hypothesis.pm
new file mode 100644 (file)
index 0000000..4c8c382
--- /dev/null
+++ b/lib/DX/Hypothesis.pm
@@ -0,0 +1,48 @@
+package DX::Hypothesis;
+
+use DX::Class;
+
+has scope => (is => 'ro', required => 1);
+
+has resolved_propositions => (is => 'ro', required => 1);
+
+has outstanding_propositions => (is => 'ro', required => 1);
+
+has actions => (is => 'ro', required => 1);
+
+sub with_actions {
+  my ($self, @actions) = @_;
+  my $hyp = $self;
+  foreach my $act (@actions) {
+    ($hyp, my @events) = $act->dry_run_against($hyp);
+    return undef unless $hyp;
+    $hyp = $hyp->but_recheck_for(@events);
+    return undef unless $hyp;
+  }
+  return $hyp;
+}
+
+sub but_recheck_for {
+  my ($self, @events) = @_;
+  my ($still_resolved, @recheck) = $self->resolved_propositions
+                                        ->but_expire_for(@events);
+  my $hyp = $self->but(resolved_propositions => $still_resolved);
+  $hyp = $_->but_recheck_against($hyp) or return undef for @recheck;
+  return $hyp;
+}
+
+sub resolve_head_dependent_on {
+  my ($self, $depends) = @_;
+  my ($first, @rest) = @{$self->outstanding_propositions};
+  $self->but(
+    resolved_propositions => $self->resolved_propositions
+                                  ->but_with_resolution(
+                                      proposition => $first,
+                                      depends_on => $depends,
+                                      at_depth => $self->scope->depth,
+                                    ),
+    outstanding_propositons => \@rest,
+  );
+}
+
+1;