From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 5 Mar 2016 05:36:11 +0000 (+0000)
Subject: updated shell code to register query commands with Tcl object
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fa8f5696d6233768df6c1e54df63b11f37926f2a;p=scpubgit%2FDX.git

updated shell code to register query commands with Tcl object
---

diff --git a/bin/dx b/bin/dx
index fac99ee..d5a2107 100644
--- a/bin/dx
+++ b/bin/dx
@@ -1,13 +1,22 @@
 use strictures 2;
 use Module::Runtime qw(use_module);
-BEGIN { *u = \&use_module }
+use DX::Utils qw(:builders);
 
 use_module('DX::ShellFrontend')->new(
   session_mode => 'shell',
   session => use_module('DX::ShellSession')->new(
     shell_state => use_module('DX::ShellState')->new(
       mode => 'shell',
-      template_query_state => use_module('DX::QueryState')->new
+      template_query_state => use_module('DX::QueryState')->new(
+          predicates => {
+          'eq' => use_module('DX::Predicate::Eq')->new,
+          member_at => use_module('DX::Predicate::MemberAt')->new,
+          is_dict => use_module('DX::Predicate::IsDict')->new,
+        },
+        globals => dict(),
+        proposition_sequence
+          => use_module('DX::PropositionSequence')->new_empty,
+      ),
     )
   ),
 )->repl
diff --git a/lib/DX/Class.pm b/lib/DX/Class.pm
index cc51cd4..a25c72f 100644
--- a/lib/DX/Class.pm
+++ b/lib/DX/Class.pm
@@ -5,6 +5,7 @@ use Import::Into;
 sub import {
   strictures->import::into(1); # should pass version
   DX::Types->import::into(1, ':types', ':assert');
+  Try::Tiny->import::into(1);
   Moo->import::into(1);
   # This would not be safe with method modifiers, but since the role
   # provides only a single method it works out fine.
diff --git a/lib/DX/PropositionSequence.pm b/lib/DX/PropositionSequence.pm
index 2becac1..d884d96 100644
--- a/lib/DX/PropositionSequence.pm
+++ b/lib/DX/PropositionSequence.pm
@@ -11,7 +11,7 @@ sub new_empty {
 
 sub but_append_proposition {
   my ($self, $prop) = @_;
-  $self->but(members => [ @{$self->members}, $prop ];
+  $self->but(members => [ @{$self->members}, $prop ]);
 }
 
 1;
diff --git a/lib/DX/QueryState.pm b/lib/DX/QueryState.pm
index 90d72bc..857745d 100644
--- a/lib/DX/QueryState.pm
+++ b/lib/DX/QueryState.pm
@@ -1,9 +1,14 @@
 package DX::QueryState;
 
+use Types::Standard qw(HashRef);
 use DX::Class;
 
-#has proposition_sequence => (
-#  is => 'ro', isa => PropositionSequence, required => 1
-#);
+has predicates => (is => 'ro', isa => HashRef[Predicate], required => 1);
+
+has globals => (is => 'ro', isa => DictValue, required => 1);
+
+has proposition_sequence => (
+  is => 'ro', isa => PropositionSequence, required => 1
+);
 
 1;
diff --git a/lib/DX/ShellFrontend.pm b/lib/DX/ShellFrontend.pm
index 1b91bf6..1b8c66e 100644
--- a/lib/DX/ShellFrontend.pm
+++ b/lib/DX/ShellFrontend.pm
@@ -57,6 +57,7 @@ sub process_mode_result {
 
 sub process_output_result {
   my ($self, $output) = @_;
+  $output .= "\n" unless $output =~ /\n$/;
   print $output;
 }
 
diff --git a/lib/DX/ShellSession.pm b/lib/DX/ShellSession.pm
index dd4c2a9..1e6cdc7 100644
--- a/lib/DX/ShellSession.pm
+++ b/lib/DX/ShellSession.pm
@@ -2,10 +2,16 @@ package DX::ShellSession;
 
 use Tcl;
 use Scalar::Util qw(weaken);
+use DX::Expander;
 use DX::Class;
 
 has shell_state => (is => 'rwp', required => 1, isa => ShellState);
 
+has expander => (
+  is => 'lazy', builder => sub { DX::Expander->new(tcl => $_[0]->tcl) },
+  handles => [ qw(expand_args) ],
+);
+
 has tcl => (is => 'lazy', builder => sub {
   my ($self) = @_;
   weaken $self;
@@ -19,6 +25,14 @@ has tcl => (is => 'lazy', builder => sub {
   $tcl->CreateCommand('.' => sub {
     $self->apply_to_state([ mode => 'shell' ])
   });
+  foreach my $pred (
+    keys %{$self->shell_state->template_query_state->predicates}
+  ) {
+    $tcl->CreateCommand($pred => sub {
+      my (undef, undef, undef, @args) = @_; # ($data, $interp, $pred)
+      $self->apply_predicate($pred => @args);
+    });
+  }
   return $tcl;
 });
 
@@ -43,8 +57,19 @@ sub is_complete_command_string {
 sub eval_command_string {
   my ($self, $string) = @_;
   local our @Result;
-  $self->tcl->Eval($string);
+  try {
+    $self->tcl->Eval($string);
+  } catch {
+    push @Result, [ output => $_ ];
+  };
   return @Result;
 }
 
+sub apply_predicate {
+  my ($self, $pred, @args) = @_;
+  die "Can't call predicate ${pred} outside a query\n"
+    unless $self->shell_state->mode eq 'query';
+use Data::Dumper::Concise; die Dumper [ $pred, $self->expand_args(@args) ];
+}
+
 1;