From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sun, 1 Nov 2015 07:22:02 +0000 (+0000)
Subject: deparse actually sorta working
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1e812b195dcba3c8afdffabc8d1e6d119c454ab1;p=scpubgit%2FDX.git

deparse actually sorta working
---

diff --git a/lib/DX/Deparse.pm b/lib/DX/Deparse.pm
index ecee7ba..89a805d 100644
--- a/lib/DX/Deparse.pm
+++ b/lib/DX/Deparse.pm
@@ -25,21 +25,30 @@ sub fmt {
 sub _fmt {
   my ($self, $thing, $meta) = @_;
   return $thing unless ref($thing);
-  my $type = join'_', split '::', lc +(ref($thing) =~ /^DX::(.*)/)[0];
+  my $type = join'_', split '::', lc +(ref($thing) =~ /^(?:DX::)?(.*)/)[0];
   $self->${\"_fmt_${type}"}($thing, $meta);
 }
 
 sub _fmt_value_dict {
-  my ($self, $dict, $ometa) = @_;
-  my $imeta = $self->_inner_meta($ometa);
-  my $chunks = $self->_indent_one(join "\n", map {
-    "$_ ".$self->_fmt($dict->get_member_at($_), $imeta)
-  } $dict->index_list);
+  my ($self, $dict, $meta) = @_;
+  my $chunks = $self->_fmt_pairs([
+    map [ $_, $dict->get_member_at($_) ], $dict->index_list
+  ], $meta);
+  return '{{ }}' unless $chunks =~ /\S/;
   "{{\n${chunks}\n}}";
 }
 
+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 _fmt_value_string {
   my ($self, $string) = @_;
+  # TODO: multiline handling
   my $val = $string->string_value;
   if ($val =~ /^\w+$/) {
     qq{'${val}'}
@@ -54,6 +63,65 @@ sub _fmt_value_true { 'true' }
 
 sub _fmt_value_false { 'false' }
 
-sub _fmat_value_unset { 'unset' }
+sub _fmt_value_unset { 'unset' }
+
+sub _fmt_object {
+  my ($self, $pairs, $meta) = @_;
+  my $chunks = $self->_fmt_pairs($pairs, $meta);
+  return '{ }' unless $chunks =~ /\S/;
+  "{\n${chunks}\n}"
+}
+
+sub _fmt_hypothesis {
+  my ($self, $hyp, $meta) = @_;
+  $self->_fmt_object([
+    map [ $_ => $hyp->$_ ],
+      qw(actions outstanding_propositions 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 _fmt_action_setvalue {
+  my ($self, $action, $meta) = @_;
+  $self->_fmt_action_generic(SetValue => $action, $meta);
+}
+
+sub _fmt_action_addvalue {
+  my ($self, $action, $meta) = @_;
+  $self->_fmt_action_generic(AddValue => $action, $meta);
+}
+
+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 _fmt_resolvedpropositionset { '{...}' }
+
+sub _fmt_scope {
+  my ($self, $scope, $meta) = @_;
+  $self->_fmt_object([
+    [ W => $scope->globals ],
+    map [ $_ => $scope->locals->[$_] ], 0..$#{$scope->locals}
+  ], $meta);
+}
+
+sub _fmt_searchstate {
+  my ($self, $ss, $meta) = @_;
+  $self->_fmt_object([
+    [ alternatives => '{...}' ],
+    [ current_hypothesis => $ss->current_hypothesis ],
+  ], $meta);
+}
 
 1;
diff --git a/lib/DX/Utils.pm b/lib/DX/Utils.pm
index 39b1794..89f2fdd 100644
--- a/lib/DX/Utils.pm
+++ b/lib/DX/Utils.pm
@@ -10,7 +10,8 @@ my @const = (
 
 our @EXPORT_OK = (
   @const,
-  my @builders = qw(step string number dict proposition)
+  (my @builders = qw(step string number dict proposition)),
+  'deparse',
 );
 
 our %EXPORT_TAGS = (
@@ -67,6 +68,16 @@ sub proposition {
   );
 }
 
+{
+  require DX::Deparse;
+  my $dp = DX::Deparse->new;
+
+  sub deparse {
+    my ($thing) = @_;
+    $dp->fmt($thing);
+  }
+}
+
 # Here so that circular require doesn't stab us in the face
 
 require DX::Step::Normal;
diff --git a/lib/DX/Value/Dict.pm b/lib/DX/Value/Dict.pm
index bc568a4..af579ea 100644
--- a/lib/DX/Value/Dict.pm
+++ b/lib/DX/Value/Dict.pm
@@ -14,6 +14,8 @@ has '+action_builder' => (
 
 has members => (is => 'ro', required => 1);
 
+sub index_list { sort keys %{$_[0]->members} }
+
 sub get_member_at {
   my ($self, $at) = @_;
   $self->members->{ref($at) ? $at->string_value : $at};
diff --git a/t/01basics.t b/t/01basics.t
index 545a0de..09af40e 100644
--- a/t/01basics.t
+++ b/t/01basics.t
@@ -1,7 +1,7 @@
 use strictures 1;
 use Test::More;
 use Module::Runtime qw(use_module);
-use DX::Utils qw(:builders);
+use DX::Utils qw(:builders deparse);
 
 my $ab = use_module('DX::ActionBuilder::UnsetValue')->new(
   target_path => [ 0, 'X' ]
@@ -39,4 +39,6 @@ my $ss = use_module('DX::SearchState')->new(
   alternatives => [],
 );
 
-::Dwarn($ss->with_one_step->with_one_step);
+#::Dwarn($ss->with_one_step->with_one_step);
+require YAML;
+warn deparse($ss->with_one_step->with_one_step);