use DX::Solver;
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 });
my $split = $tcl->curry::weak::SplitList;
-my (@res, @last_q);
+my ($r, $res, @last_q);
+
+my $last_mode;
+
+sub show {
+ $r = ($res->isa('DX::Result') ? $res : $res->next);
+ unless ($r) { warn "false\n"; return; }
+ 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 {
- @res = $solver->query(@last_q)->results;
- Dwarn([ map {
- my @act = $_->actions;
- ((@act ? \@act : ()), $_->all_values);
- } @res ]);
+ $res = $solver->$last_mode(@last_q);
+ show();
}
-$tcl->CreateCommand(query => sub {
- my (undef, undef, undef, $vars, $body) = @_;
+sub expand_def {
+ my ($vars, $body) = @_;
my @varnames = $split->($vars);
+ return (\@varnames, expand_body($body));
+}
+
+sub expand_body {
+ my ($body) = @_;
+ die "No body!" unless $body;
local our @Body_Parts;
$tcl->Eval($body);
- @last_q = (\@varnames, @Body_Parts);
+ return @Body_Parts;
+}
+
+sub q_command {
+ my ($this_mode, undef, undef, undef, $body) = @_;
+ $last_mode = $this_mode;
+ if ($body) {
+ @last_q = expand_body($body);
+ }
do_query();
return;
-});
+}
+
+$tcl->CreateCommand('?' => sub { q_command(query => @_) });
+$tcl->CreateCommand('?!' => sub { q_command(solve => @_) });
+$tcl->CreateCommand('!?' => sub { q_command(solve => @_) });
+$tcl->CreateCommand('!' => sub { q_command(ensure => @_) });
$tcl->CreateCommand(run => sub {
- foreach my $ind ($res[0]->independent_actions) {
- my $cl = ref($ind);
- warn +(split('::', $cl))[-1]."\n";
+ foreach my $ind ($r->independent_actions) {
$solver->run_action($ind);
}
do_query();
return;
});
+$tcl->CreateCommand(dump => sub {
+ my (undef, undef, undef, $to_dump) = @_;
+ my $filter = quote_sub($to_dump);
+ Dwarn($filter->($r));
+});
+
sub mangle_args {
my @args = @_;
map { $_ =~ /^'(.*)'$/ ? \do { my $x = $1 } : $_ } @args;
return;
};
+$tcl->CreateCommand(rule => sub {
+ my (undef, undef, undef, $rule, $vars, $body) = @_;
+ $solver->add_rule($rule => expand_def($vars, $body));
+ $tcl->CreateCommand($rule => $rule_sub);
+ return;
+});
+
foreach my $rule (keys %{$solver->rule_set->rules}) {
$rule =~ s/\/\d+$//;
$tcl->CreateCommand($rule => $rule_sub);
}
+
+$tcl->CreateCommand(foreach => sub {
+ my (undef, undef, undef, $var, $body, $each_body) = @_;
+ push our @Body_Parts, [
+ foreach => $var => map [ expand_body($_) ], $body, $each_body
+ ];
+ return;
+});
+
+$tcl->CreateCommand(findall => sub {
+ my (undef, undef, undef, $coll_var, $name_var, $body) = @_;
+ push our @Body_Parts, [
+ findall => $coll_var => $name_var => expand_body($body)
+ ];
+ 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'; }});
+if ($ARGV[0]) {
+ $tcl->EvalFile($ARGV[0]);
+}
+
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);
+ unless (eval { $tcl->Eval($cmd); 1 }) {
+ warn $@;
+ }
$cmd = '';
}
}