From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 22 Feb 2014 20:38:39 +0000 (+0000)
Subject: better debugging output
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=scpubgit%2FDKit.git;a=commitdiff_plain;h=db732a141fc08c5641d641a5c7f5b9c283e0ac51

better debugging output
---

diff --git a/bin/dx-shell b/bin/dx-shell
index 725fc10..b540453 100644
--- a/bin/dx-shell
+++ b/bin/dx-shell
@@ -7,6 +7,8 @@ use DX::Lib::FS;
 use Term::ReadLine;
 use Devel::Dwarn;
 use Sub::Quote;
+use YAML ();
+use Safe::Isa;
 
 my $solver = DX::Solver->new(observation_policy => sub { 1 });
 
@@ -30,10 +32,19 @@ my $last_mode;
 sub show {
   $r = ($res->isa('DX::Result') ? $res : $res->next);
   unless ($r) { warn "false\n"; return; }
-  Dwarn(map {
-    my @act = $_->actions;
-    ((@act ? \@act : ()), $_->all_values);
-  } $r);
+  if (my @act = $r->actions) {
+    warn YAML::Dump([ map $_->as_structure, @act ]);
+  }
+  my $values = $r->all_values;
+  unless (keys %$values) {
+    warn "---\ntrue\n"; return;
+  }
+  warn YAML::Dump({
+    map +($_ => ($values->{$_}->$_does('DX::Role::Set')
+                  ? [ $values->{$_}->all ]
+                  : $values->{$_} )),
+      keys %$values
+  });
 }
 
 sub do_query {
@@ -121,6 +132,8 @@ $tcl->CreateCommand(findall => sub {
   ];
   return;
 });
+
+$tcl->CreateCommand(n => \&show);
   
 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});
 
diff --git a/lib/DX/OrderedSet.pm b/lib/DX/OrderedSet.pm
index 06af0e8..e2e97af 100644
--- a/lib/DX/OrderedSet.pm
+++ b/lib/DX/OrderedSet.pm
@@ -3,6 +3,8 @@ package DX::OrderedSet;
 use DX::ArrayStream;
 use Moo;
 
+with 'DX::Role::Set';
+
 has values => (is => 'ro', default => sub { [] });
 
 sub all { @{$_[0]->values} }
diff --git a/lib/DX/Role/Action.pm b/lib/DX/Role/Action.pm
index 3b7367a..d345b4f 100644
--- a/lib/DX/Role/Action.pm
+++ b/lib/DX/Role/Action.pm
@@ -21,4 +21,12 @@ sub run {
   return @res;
 }
 
+sub as_structure {
+  my ($self) = @_;
+  my %data = %$self;
+  delete $data{dependencies} unless @{$data{dependencies}};
+  my $id = delete $data{id};
+  +{ $id => \%data };
+}
+
 1;
diff --git a/lib/DX/Role/Set.pm b/lib/DX/Role/Set.pm
new file mode 100644
index 0000000..f52737e
--- /dev/null
+++ b/lib/DX/Role/Set.pm
@@ -0,0 +1,13 @@
+package DX::Role::Set;
+
+use Moo::Role;
+
+requires 'to_stream';
+
+requires 'all';
+
+requires 'get';
+
+requires 'key_list';
+
+1;
diff --git a/lib/DX/SetOver.pm b/lib/DX/SetOver.pm
index b267761..2707dab 100644
--- a/lib/DX/SetOver.pm
+++ b/lib/DX/SetOver.pm
@@ -3,6 +3,8 @@ package DX::SetOver;
 use DX::ArrayStream;
 use Moo;
 
+with 'DX::Role::Set';
+
 has over => (is => 'ro', required => 1);
 
 has values => (is => 'ro', default => sub { {} });