bin/dx-shell

   1 #!/usr/bin/env perl
   2
   3 use strictures 1;
   4 use curry;
   5 use DX::Solver;
   6 use DX::Lib::FS;
   7 use Term::ReadLine;
   8
   9 my $solver = DX::Solver->new(observation_policy => sub { 1 });
  10
  11 DX::Lib::FS->new->load_into($solver);
  12
  13 #::Dwarn(
  14 #  [ $solver->query([ 'D' ], [ directory_at => 'D' => \'t' ])->results ]
  15 #    ->[0]->value_for('D')
  16 #);
  17
  18 use Tcl;
  19
  20 my $tcl = Tcl->new;
  21
  22 my $split = $tcl->curry::weak::SplitList;
  23
  24 my (@res, @last_q);
  25
  26 sub do_query {
  27   @res = $solver->query(@last_q)->results;
  28   Dwarn([ map {
  29     my @act = $_->actions;
  30     ((@act ? \@act : ()), $_->all_values);
  31   } @res ]);
  32 }
  33
  34 $tcl->CreateCommand(query => sub {
  35   my (undef, undef, undef, $vars, $body) = @_;
  36   my @varnames = $split->($vars);
  37   local our @Body_Parts;
  38   $tcl->Eval($body);
  39   @last_q = (\@varnames, @Body_Parts);
  40   do_query();
  41   return;
  42 });
  43
  44 $tcl->CreateCommand(run => sub {
  45   foreach my $ind ($res[0]->independent_actions) {
  46     my $cl = ref($ind);
  47     warn +(split('::', $cl))[-1]."\n";
  48     $solver->run_action($ind);
  49   }
  50   do_query();
  51   return;
  52 });
  53
  54 sub mangle_args {
  55   my @args = @_;
  56   map { $_ =~ /^'(.*)'$/ ? \do { my $x = $1 } : $_ } @args;
  57 }
  58
  59 my $rule_sub = sub {
  60   my (undef, undef, $name, @args) = @_;
  61   push our @Body_Parts, [ $name => mangle_args(@args) ];
  62   return;
  63 };
  64
  65 foreach my $rule (keys %{$solver->rule_set->rules}) {
  66   $rule =~ s/\/\d+$//;
  67   $tcl->CreateCommand($rule => $rule_sub);
  68 }
  69
  70 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});
  71
  72 my $rl = Term::ReadLine->new;
  73
  74 my $cmd;
  75
  76 while (defined(my $line = $rl->readline(length($cmd)?'+ ':'$ '))) {
  77   $cmd .= $line;
  78   if ($tcl->call(info => complete => $cmd)) {
  79     $tcl->Eval($cmd);
  80     $cmd = '';
  81   }
  82 }