From: Matt S Trout <mst@shadowcat.co.uk>
Date: Fri, 14 Feb 2014 06:23:58 +0000 (+0000)
Subject: first sketch towards shell
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=eed368c97647537f763448ff19dd867b95d77de2;p=scpubgit%2FDKit.git

first sketch towards shell
---

diff --git a/bin/dx-shell b/bin/dx-shell
new file mode 100644
index 0000000..e7b1b58
--- /dev/null
+++ b/bin/dx-shell
@@ -0,0 +1,82 @@
+#!/usr/bin/env perl
+
+use strictures 1;
+use curry;
+use DX::Solver;
+use DX::Lib::FS;
+use Term::ReadLine;
+
+my $solver = DX::Solver->new(observation_policy => sub { 1 });
+
+DX::Lib::FS->new->load_into($solver);
+
+#::Dwarn(
+#  [ $solver->query([ 'D' ], [ directory_at => 'D' => \'t' ])->results ]
+#    ->[0]->value_for('D')
+#);
+
+use Tcl;
+
+my $tcl = Tcl->new;
+
+my $split = $tcl->curry::weak::SplitList;
+
+my (@res, @last_q);
+
+sub do_query {
+  @res = $solver->query(@last_q)->results;
+  Dwarn([ map {
+    my @act = $_->actions;
+    ((@act ? \@act : ()), $_->all_values);
+  } @res ]);
+}
+
+$tcl->CreateCommand(query => sub {
+  my (undef, undef, undef, $vars, $body) = @_;
+  my @varnames = $split->($vars);
+  local our @Body_Parts;
+  $tcl->Eval($body);
+  @last_q = (\@varnames, @Body_Parts);
+  do_query();
+  return;
+});
+
+$tcl->CreateCommand(run => sub {
+  foreach my $ind ($res[0]->independent_actions) {
+    my $cl = ref($ind);
+    warn +(split('::', $cl))[-1]."\n";
+    $solver->run_action($ind);
+  }
+  do_query();
+  return;
+});
+
+sub mangle_args {
+  my @args = @_;
+  map { $_ =~ /^'(.*)'$/ ? \do { my $x = $1 } : $_ } @args;
+}
+
+my $rule_sub = sub {
+  my (undef, undef, $name, @args) = @_;
+  push our @Body_Parts, [ $name => mangle_args(@args) ];
+  return;
+};
+
+foreach my $rule (keys %{$solver->rule_set->rules}) {
+  $rule =~ s/\/\d+$//;
+  $tcl->CreateCommand($rule => $rule_sub);
+}
+  
+#$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});
+
+my $rl = Term::ReadLine->new;
+
+my $cmd;
+
+while (defined(my $line = $rl->readline(length($cmd)?'+ ':'$ '))) {
+  $cmd .= $line;
+  if ($tcl->call(info => complete => $cmd)) {
+    $tcl->Eval($cmd);
+    $cmd = '';
+  }
+}