From: Matt S Trout <mst@shadowcat.co.uk>
Date: Wed, 28 Feb 2018 21:24:10 +0000 (+0000)
Subject: rewrite deparse system
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FDX.git;a=commitdiff_plain;h=c25fbf056abf91b25ef365e9be2a84eb2b132dba

rewrite deparse system
---

diff --git a/lib/DX/Action/BindValue.pm b/lib/DX/Action/BindValue.pm
index a355935..c8f43d1 100644
--- a/lib/DX/Action/BindValue.pm
+++ b/lib/DX/Action/BindValue.pm
@@ -8,6 +8,18 @@ with 'DX::Role::SimpleAction';
 
 has new_value => (is => 'ro', required => 1);
 
+sub for_deparse {
+  my ($self) = @_;
+  [ statement => [
+    [ symbol => 'BindValue' ],
+    [ value_path => $self->target_path ],
+    [ value_path => $self->new_value
+                         ->action_builder
+                         ->inner_action_builder
+                         ->target_path ],
+  ] ];
+}
+
 sub _build__updates {
   my ($self) = @_;
   DX::Update::SetValue->new(
diff --git a/lib/DX/Deparse.pm b/lib/DX/Deparse.pm
index 0b01d2b..74d8eb3 100644
--- a/lib/DX/Deparse.pm
+++ b/lib/DX/Deparse.pm
@@ -1,62 +1,34 @@
 package DX::Deparse;
 
+use Scalar::Util qw(blessed);
 use DX::Class;
 
 sub indent_by { '    ' }
 
-sub max_width { 78 }
-
-sub _inner_meta {
-  my ($self, $ometa) = @_;
-  +{ %$ometa, width_left => $ometa->{width_left} - length $self->indent_by };
-}
-
-sub _indent_one {
-  my ($self, $to_indent) = @_;
-  $to_indent =~ s/^/${\$self->indent_by}/mg;
-  $to_indent;
-}
-
-sub fmt {
+sub format {
   my ($self, $thing) = @_;
-  $self->_fmt($thing, { width_left => $self->max_width })."\n";
-}
-
-sub _fmt {
-  my ($self, $thing, $meta) = @_;
-  return '{}' unless defined($thing);
-  return $thing unless ref($thing);
-  my $type = join'_', split '::', lc +(ref($thing) =~ /^(?:DX::)?(.*)/)[0];
-  $self->${\"_fmt_${type}"}($thing, $meta);
-}
-
-sub _fmt_error_typetiny_assertion {
-  $_[1]->to_string;
+  local our $Indent_Level = 0;
+  $self->_format($thing);
 }
 
-sub _fmt_value_dict {
-  my ($self, $dict, $meta) = @_;
-  my $chunks = $self->_fmt_pairs([
-    map [ $_, $dict->get_member_at($_) ], $dict->index_list
-  ], $meta);
-  return '{{ }}' unless $chunks =~ /\S/;
-  s/^\s+//, s/\n\s+/ /g for (my $maybe = $chunks);
-  return "{{ ${maybe} }}" if length($maybe) < $meta->{width_left};
-  "{{\n${chunks}\n}}";
+sub _format {
+  my ($self, $thing) = @_;
+  my ($as, $data) = @{blessed($thing) ? $thing->for_deparse : $thing};
+  $self->${\"_format_as_${as}"}($data);
 }
 
-sub _fmt_pairs {
-  my ($self, $pairs, $ometa) = @_;
-  my $imeta = $self->_inner_meta($ometa);
-  $self->_indent_one(join "\n", map {
-    join ' ', map $self->_fmt($_, $imeta), @$_
-  } @$pairs);
+sub _format_indented {
+  my ($self, $cb) = @_;
+  our $Indent_Level;
+  local $Indent_Level = $Indent_Level + 1;
+  my $unindented = $cb->();
+  (my $indented = $unindented) =~ s/^/${\$self->indent_by}/mg;
+  return $indented;
 }
 
-sub _fmt_value_string {
-  my ($self, $string) = @_;
+sub _format_as_string {
+  my ($self, $val) = @_;
   # TODO: multiline handling
-  my $val = $string->string_value;
   if ($val =~ /^\w+$/) {
     qq{'${val}'}
   } else {
@@ -64,158 +36,67 @@ sub _fmt_value_string {
   }
 }
 
-sub _fmt_value_number { $_[1]->number_value }
-
-sub _fmt_value_true { 'true' }
-
-sub _fmt_value_false { 'false' }
-
-sub _fmt_value_unset { 'unset' }
-
-sub _fmt_object {
-  my ($self, $pairs, $meta) = @_;
-  my $chunks = $self->_fmt_pairs($pairs, $meta);
-  return '{ }' unless $chunks =~ /\S/;
-  s/^\s+//, s/\n\s+/ /g for (my $maybe = $chunks);
-  return "{ ${maybe} }" if length($maybe) < $meta->{width_left};
-  "{\n${chunks}\n}"
-}
-
-sub _fmt_hypothesis {
-  my ($self, $hyp, $meta) = @_;
-  $self->_fmt_object([
-    map [ $_ => $hyp->$_ ],
-      qw(actions resolved_propositions scope)
-  ], $meta);
-}
-
-sub _fmt_array {
-  my ($self, $ary, $ometa) = @_;
-  my $imeta = $self->_inner_meta($ometa);
-  my $chunks = $self->_indent_one(
-    join "\n", map $self->_fmt($_, $imeta), @$ary
-  );
-  return '{ }' unless $chunks =~ /\S/;
-  "{\n${chunks}\n}";
-}
+sub _format_as_symbol { $_[1] }
 
-sub _fmt_glob {
-  my ($self, $glob, $meta) = @_;
-  return ((''.*$glob) =~ /::([A-Z_]+)$/)[0];
+sub _format_as_maybe_bareword {
+  my ($self, $maybe_bareword) = @_;
+  # should stringify if required
+  return $maybe_bareword;
 }
 
-sub _fmt_action_setvalue {
-  my ($self, $action, $meta) = @_;
-  $self->_fmt_action_generic(SetValue => $action, $meta);
-}
+sub _format_as_number { $_[1] }
 
-sub _fmt_action_addvalue {
-  my ($self, $action, $meta) = @_;
-  $self->_fmt_action_generic(AddValue => $action, $meta);
-}
+sub _format_as_boolean { $_[1] ? 'true' : 'false' }
 
-sub _fmt_action_bindvalue {
-  my ($self, $action, $meta) = @_;
-  my $path = join '.', map $self->_fmt($_, $meta), @{$action->target_path};
-  my $bound_path = join '.',
-                     map $self->_fmt($_, $meta),
-                       @{$action->new_value
-                                ->action_builder
-                                ->inner_action_builder
-                                ->target_path};
-  join ' ', BindValue => $path, $bound_path;
-}
-
-sub _fmt_action_addboundvalue {
-  my ($self, $action, $meta) = @_;
-  $self->_fmt_action_generic(AddBoundValue => $action, $meta);
-}
-
-sub _fmt_action_setboundvalue {
-  my ($self, $action, $meta) = @_;
-  $self->_fmt_action_generic(SetBoundValue => $action, $meta);
-}
+sub _format_as_unset { 'unset' }
 
-sub _fmt_action_generic {
-  my ($self, $name, $action, $meta) = @_;
-  my $path = join '.', map $self->_fmt($_, $meta), @{$action->target_path};
-  join ' ', $name, $path, $self->_fmt($action->new_value, $meta);
+sub _format_as_array {
+  my ($self, $members) = @_;
+  join ' ', '{[', (map $self->_format($_), @$members), ']}';
 }
 
-sub _fmt_resolvedpropositionset {
-  my ($self, $rps, $meta) = @_;
-  $self->_fmt_object([
-    map {
-      [ $_, [
-        map bless([ @$_ ], 'DX::Dependency'),
-          map @{$_}[1..$#$_],
-            @{$rps->dependencies_for($_)}
-      ] ]
-    } @{$rps->propositions},
-  ], $meta);
+sub _format_as_dict {
+  my ($self, $members) = @_;
+  join ' ', '{{', (
+    map +(
+      $self->_format_as_maybe_bareword($_),
+      $self->_format($members->{$_}),
+    ), sort keys %$members
+  ), '}}';
 }
 
-sub _fmt_dependency {
-  my ($self, $dep, $meta) = @_;
-  '{ '.join(' ', map $self->_fmt($_, $meta), @$dep).' }'
+sub _format_as_statement {
+  my ($self, $parts) = @_;
+  join ' ', map $self->_format($_), @$parts;
 }
 
-sub _fmt_proposition {
-  my ($self, $prop, $meta) = @_;
-  join ' ',
-    $prop->predicate,
-    map $self->_fmt($_, $meta),
-      map +((!ref($_) and $prop->introduced_names->{$_}) ? "?$_" : $_),
-        @{$prop->args};
+sub _format_as_value_path {
+  my ($self, $parts) = @_;
+  join '.', map $self->_format_as_maybe_bareword($_), @$parts;
 }
 
-sub _fmt_scope {
-  my ($self, $scope, $meta) = @_;
-  $self->_fmt_object([
-    [ W => $scope->globals ],
-    map [ $_ => $scope->locals->[$_] ], 0..$#{$scope->locals}
-  ], $meta);
+sub _format_as_list {
+  my ($self, $members) = @_;
+  join "\n", '{', (
+    map $self->_format_indented($self->curry::_format($_)), @$members
+  ), '}';
 }
 
-sub _fmt_searchstate {
-  my ($self, $ss, $meta) = @_;
-  $self->_fmt_object([
-    [ adjustments_made => '{...}' ],
-    [ current_hypothesis => $ss->current_hypothesis ],
-  ], $meta);
+sub _format_as_pairs {
+  my ($self, $members) = @_;
+  join "\n", '{', (
+    map $self->_format_indented(sub {
+          $self->_format_as_maybe_bareword($_->[0])
+            .' '.$self->_format($_->[1])
+        }), @$members
+  ), '}';
 }
 
-sub _fmt_step_considerproposition {
-  my ($self, $step, $meta) = @_;
-  'consider '.$self->_fmt($step->proposition, $meta);
+sub _format_as_block {
+  my ($self, $members) = @_;
+  join "\n", '{', (
+    map $self->_format_indented($self->curry::_format($_)), @$members
+  ), '}';
 }
 
-sub _fmt_step_resolveproposition {
-  my ($self, $step, $meta) = @_;
-  'resolve '.$self->_fmt_object([
-    [ actions => $step->actions ],
-    ($step->alternative_step
-      ? [ alternative_step => '...' ]
-      : ()),
-    [ depends_on => [
-      map bless([ @$_ ], 'DX::Dependency'),
-        map @{$_}[1..$#$_],
-          @{$step->depends_on}
-    ] ],
-  ], $meta);
-}
-
-sub _fmt_step_backtrack { 'backtrack' }
-
-sub _fmt_step_markassolution { 'mark as solution' }
-
-sub _fmt_step_enterrecheck {
-  my ($self, $step, $meta) = @_;
-  'recheck '.$self->_fmt($step->proposition_list->[0], $meta);
-}
-
-sub _fmt_step_completerecheck { 'complete recheck' }
-
-sub _fmt_step_failrecheck { 'fail recheck' }
-
 1;
diff --git a/lib/DX/Proposition.pm b/lib/DX/Proposition.pm
index 1415276..b173ca8 100644
--- a/lib/DX/Proposition.pm
+++ b/lib/DX/Proposition.pm
@@ -11,6 +11,18 @@ has introduced_names => (is => 'ro', isa => HashRef[One], required => 1);
 
 has required_names => (is => 'ro', isa => HashRef[One], required => 1);
 
+sub for_deparse {
+  my ($self) = @_;
+  [ statement => [
+    [ symbol => $self->predicate ],
+    map {
+      ref($_)
+        ? $_
+        : [ symbol => $self->introduced_names->{$_} ? "?$_" : $_ ]
+    } @{$self->args}
+  ] ];
+}
+
 sub resolve_for {
   my ($self, $scope) = @_;
   my $predicate = $scope->lookup_predicate($self->predicate);
diff --git a/lib/DX/Role/BooleanValue.pm b/lib/DX/Role/BooleanValue.pm
index 336e545..37f3097 100644
--- a/lib/DX/Role/BooleanValue.pm
+++ b/lib/DX/Role/BooleanValue.pm
@@ -4,6 +4,8 @@ use DX::Role;
 
 with 'DX::Role::Value';
 
+sub for_deparse { [ boolean => $_[0]->is_true ] }
+
 requires 'is_true';
 
 1;
diff --git a/lib/DX/Role/BoundValueAction.pm b/lib/DX/Role/BoundValueAction.pm
index 37b317b..3bd125e 100644
--- a/lib/DX/Role/BoundValueAction.pm
+++ b/lib/DX/Role/BoundValueAction.pm
@@ -16,6 +16,15 @@ has inner_action => (is => 'ro', required => 1);
 
 requires 'update_class';
 
+sub for_deparse {
+  my ($self) = @_;
+  [ statement => [
+    [ symbol => (split('::',ref($self)))[-1] ],
+    [ value_path => $self->target_path ],
+    $self->new_value,
+  ] ];
+}
+
 sub dry_run {
   my ($self, $hyp) = @_;
   my ($outer_hyp, @inner_events) = $self->inner_action->dry_run(
diff --git a/lib/DX/Role/SimpleAction.pm b/lib/DX/Role/SimpleAction.pm
index 9b6086f..62bf837 100644
--- a/lib/DX/Role/SimpleAction.pm
+++ b/lib/DX/Role/SimpleAction.pm
@@ -10,6 +10,15 @@ has _updates => (is => 'lazy');
 
 requires '_build__updates';
 
+sub for_deparse {
+  my ($self) = @_;
+  [ statement => [
+    [ symbol => (split('::',ref($self)))[-1] ],
+    [ value_path => $self->target_path ],
+    $self->new_value,
+  ] ];
+}
+
 sub dry_run {
   my ($self, $hyp) = @_;
   my ($scope, @events) = $hyp->scope->apply_updates($self->_updates);
diff --git a/lib/DX/Utils.pm b/lib/DX/Utils.pm
index 37a0829..4c9f0b8 100644
--- a/lib/DX/Utils.pm
+++ b/lib/DX/Utils.pm
@@ -115,7 +115,7 @@ sub proposition {
       DX::Deparse->new;
     };
     my ($thing) = @_;
-    $dp->fmt($thing);
+    $dp->format($thing);
   }
 }
 
diff --git a/lib/DX/Value/Dict.pm b/lib/DX/Value/Dict.pm
index 13cec8d..8c61afe 100644
--- a/lib/DX/Value/Dict.pm
+++ b/lib/DX/Value/Dict.pm
@@ -14,6 +14,10 @@ has '+action_builder' => (
 
 has members => (is => 'ro', required => 1);
 
+sub for_deparse {
+  [ dict => $_[0]->members ]
+}
+
 sub index_list { sort keys %{$_[0]->members} }
 
 sub get_member_at {
diff --git a/lib/DX/Value/Number.pm b/lib/DX/Value/Number.pm
index 74e30ac..10500df 100644
--- a/lib/DX/Value/Number.pm
+++ b/lib/DX/Value/Number.pm
@@ -6,6 +6,8 @@ with 'DX::Role::Value';
 
 has number_value => (is => 'ro', required => 1);
 
+sub for_deparse { [ number => $_[0]->number_value ] }
+
 sub to_data { 0+$_[0]->number_value }
 
 1;
diff --git a/lib/DX/Value/String.pm b/lib/DX/Value/String.pm
index e1a55b6..33b110a 100644
--- a/lib/DX/Value/String.pm
+++ b/lib/DX/Value/String.pm
@@ -6,6 +6,8 @@ with 'DX::Role::Value';
 
 has string_value => (is => 'ro', required => 1);
 
+sub for_deparse { [ string => $_[0]->string_value ] }
+
 sub to_data { ''.$_[0]->string_value }
 
 1;
diff --git a/lib/DX/Value/Unset.pm b/lib/DX/Value/Unset.pm
index 507bd4f..84d3b58 100644
--- a/lib/DX/Value/Unset.pm
+++ b/lib/DX/Value/Unset.pm
@@ -4,6 +4,8 @@ use DX::Class;
 
 with 'DX::Role::Value';
 
+sub for_deparse { [ 'unset' ] }
+
 sub is_set { 0 }
 
 sub to_data { undef }