#!/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 = ''; } }