shell tweaks

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

#!/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}\n";
  if ($tcl->call(info => complete => $cmd)) {
    $tcl->Eval($cmd);
    $cmd = '';
  }
}