beginnings of declarative code

[dbsrgits/Data-Query.git] / lib / Data / Query / ExprDeclare.pm

package Data::Query::ExprDeclare;

use strictures;
use Data::Query::ExprBuilder::Identifier;
use Data::Query::ExprHelpers;
use Data::Query::Constants;
use Safe::Isa;

use base qw(Exporter);

our @EXPORT = qw(expr SELECT AS FROM BY JOIN ON LEFT);

sub expr (&) {
  _run_expr($_[0])->{expr};
}

sub _run_expr {
  local $_ = Data::Query::ExprBuilder::Identifier->new({
    expr => Identifier(),
  });
  $_[0]->();
}

sub _value {
  ref($_[0]) ? $_[0]->{expr} : perl_scalar_value($_[0])
}

sub AS {
  my $as = shift;
  (bless(\$as, 'LIES::AS'), @_);
}

sub SELECT (&;@) {
  my @select = map _value($_), _run_expr(shift);
  my @final;
  while (@select) {
    my $e = shift @select;
    push @final,
      (ref($select[0]) eq 'LIES::AS'
        ? Alias(${shift(@select)}, $e)
        : $e
     );
  }
      
  return Select(\@final, $_[0]);
}

sub BY (&;@) { @_ }

sub FROM (&;@) {
  my @from = _run_expr(shift);
  my $from_dq = do {
    if (@from == 2 and ref($from[1]) eq 'LIES::AS') {
      Alias(${$from[1]}, _value($from[0]))
    } elsif (@from == 1) {
      _value($from[0]);
    }
  };
  while ($_[0] and is_Join($_[0])) {
    $from_dq = { %{+shift}, left => $from_dq };
  }
  return $from_dq;
  die "Huh?"
}

sub LEFT {
  my ($join, @rest) = @_;
  die "LEFT used as modifier on non-join ${join}"
    unless is_Join($join);
  return +{ %$join, outer => 'LEFT' }, @rest;
}

sub JOIN (&;@) {
  my $join = FROM(\&{+shift});
  my $on = do {
    if ($_[0]->$_isa('LIES::ON')) {
      ${+shift}
    } else {
      undef
    }
  };
  Join(undef, $join, $on), @_;
}

sub ON (&;@) {
  my $on = _value(_run_expr(shift));
  return bless(\$on, 'LIES::ON'), @_;
}

sub WHERE (&;@) {
  my $w = shift;
  return Where(_value(_run_expr($w))), @_;
}

1;