add support for not rules

[scpubgit/DKit.git] / bin / dx-shell

diff --git a/bin/dx-shell b/bin/dx-shell
index 725fc10..2df61b5 100644 (file)
--- 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 {
@@ -48,9 +59,10 @@ sub expand_def {
 }
 
 sub expand_body {
-  my (@body) = @_;
+  my ($body) = @_;
+  die "No body!" unless $body;
   local our @Body_Parts;
-  $tcl->Eval(@body);
+  $tcl->Eval($body);
   return @Body_Parts;
 }
 
@@ -121,6 +133,14 @@ $tcl->CreateCommand(findall => sub {
   ];
   return;
 });
+
+$tcl->CreateCommand(not => sub {
+  my (undef, undef, undef, $body) = @_;
+  push our @Body_Parts, [ not => expand_body($body) ];
+  return;
+});
+
+$tcl->CreateCommand(n => \&show);
   
 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});