nested where nodes
[dbsrgits/Data-Query.git] / lib / Data / Query / Renderer / SQL / Naive.pm
index c4ac4b3..19c2288 100644 (file)
@@ -5,10 +5,7 @@ use strictures 1;
 sub intersperse { my $i = shift; my @i = map +($_, $i), @_; pop @i; @i }
 
 use SQL::ReservedWords;
-use Data::Query::Constants qw(
-  DQ_IDENTIFIER DQ_OPERATOR DQ_VALUE DQ_JOIN DQ_ALIAS DQ_ORDER DQ_LITERAL
-  DQ_GROUP DQ_SELECT DQ_SLICE
-);
+use Data::Query::ExprHelpers;
 
 use Moo;
 
@@ -82,6 +79,9 @@ sub _flatten_structure {
 sub _format_keyword { $_[0]->lc_keywords ? lc($_[1]) : $_[1] }
 
 sub _render {
+  unless (ref($_[1]) eq 'HASH') {
+    die "Expected hashref, got ".(defined($_[1])?$_[1]:'undef');
+  }
   $_[0]->${\"_render_${\(lc($_[1]->{type})||'broken')}"}($_[1]);
 }
 
@@ -141,15 +141,24 @@ sub _render_operator {
   die "Unsure how to handle ${op_name}";
 }
 
+sub _maybe_parenthesise {
+  my ($self, $dq) = @_;
+  for ($dq) {
+    return is_Select() || is_Group() || is_Slice() || is_Having()
+      ? [ '(', $self->_render($dq), ')' ]
+      : $self->_render($dq);
+  }
+}
+
 sub _handle_op_type_binop {
   my ($self, $op_name, $dq) = @_;
   die "${op_name} registered as binary op but args contain "
       .scalar(@{$dq->{args}})." entries"
     unless @{$dq->{args}} == 2;
   [
-    $self->_render($dq->{args}[0]),
+    $self->_maybe_parenthesise($dq->{args}[0]),
     $op_name,
-    $self->_render($dq->{args}[1]),
+    $self->_maybe_parenthesise($dq->{args}[1]),
   ]
 }
 
@@ -183,7 +192,7 @@ sub _handle_op_type_flatten {
   my @arg_final;
   while (my $arg = shift @argq) {
 
-    unless ($arg->{type} eq DQ_OPERATOR) {
+    unless (is_Operator($arg)) {
       push @arg_final, $arg;
       next;
     }
@@ -202,7 +211,7 @@ sub _handle_op_type_flatten {
   [ '(',
       intersperse(
         $self->_format_keyword($op_name),
-        map $self->_render($_), @arg_final
+        map $self->_maybe_parenthesise($_), @arg_final
       ),
     ')'
   ];
@@ -223,9 +232,9 @@ sub _handle_op_type_between {
   my ($self, $op_name, $dq) = @_;
   my @args = @{$dq->{args}};
   if (@args == 3) {
-    my ($lhs, $rhs1, $rhs2) = (map $self->_render($_), @args);
+    my ($lhs, $rhs1, $rhs2) = (map $self->_maybe_parenthesise($_), @args);
     [ '(', $lhs, $op_name, $rhs1, 'AND', $rhs2, ')' ];
-  } elsif (@args == 2 and $args[1]->{type} eq DQ_LITERAL) {
+  } elsif (@args == 2 and is_Literal $args[1]) {
     my ($lhs, $rhs) = (map $self->_render($_), @args);
     [ '(', $lhs, $op_name, $rhs, ')' ];
   } else {
@@ -237,7 +246,7 @@ sub _handle_op_type_apply {
   my ($self, $op_name, $dq) = @_;
   my ($func, @args) = @{$dq->{args}};
   die "Function name must be identifier"
-    unless $func->{type} eq DQ_IDENTIFIER;
+    unless is_Identifier $func;
   my $ident = do {
     # The problem we have here is that built-ins can't be quoted, generally.
     # I rather wonder if things like MAX(...) need to -not- be handled as
@@ -248,7 +257,7 @@ sub _handle_op_type_apply {
   };
   [
     "$ident(",
-      intersperse(',', map $self->_render($_), @args),
+      intersperse(',', map $self->_maybe_parenthesise($_), @args),
     ')'
   ]
 }
@@ -274,7 +283,7 @@ sub _render_select {
   # to project from since many databases handle 'SELECT 1;' fine
 
   my @select = intersperse(',',
-    map +($_->{type} eq DQ_ALIAS
+    map +(is_Alias()
            ? $self->_render_alias($_, $self->_format_keyword('AS'))
            : $self->_render($_)), @{$dq->{select}}
   );
@@ -296,18 +305,15 @@ sub _render_alias {
   # FROM foo foo -> FROM foo
   # FROM foo.bar bar -> FROM foo.bar
   if ($self->collapse_aliases) {
-    if ($dq->{from}{type} eq DQ_IDENTIFIER) {
-      if ($dq->{from}{elements}[-1] eq $dq->{to}) {
-        return $self->_render($dq->{from});
+    if (is_Identifier(my $from = $dq->{from})) {
+      if ($from->{elements}[-1] eq $dq->{to}) {
+        return $self->_render($from);
       }
     }
   }
-  my %parenthesise = map +($_ => 1), DQ_SELECT, DQ_SLICE;
-  return [ # XXX not sure this is the right place to detect this
-    ($parenthesise{$dq->{from}{type}}
-      ? [ '(', $self->_render($dq->{from}), ')' ]
-      : $self->_render($dq->{from})),
-    $as || ' ',
+  return [
+    $self->_maybe_parenthesise($dq->{from}),
+    $as || '',
     $self->_render_identifier({ elements => [ $dq->{to} ] })
   ];
 }
@@ -343,7 +349,7 @@ sub _render_join {
   my $rhs = $self->_render($right);
   [
     $self->_render($left), $join,
-    ($right->{type} eq DQ_JOIN ? ('(', $rhs, ')') : $rhs),
+    (is_Join($right) ? ('(', $rhs, ')') : $rhs),
     ($dq->{on}
       ? ($self->_format_keyword('ON'), $self->_render($dq->{on}))
       : ())
@@ -353,7 +359,11 @@ sub _render_join {
 sub _render_where {
   my ($self, $dq) = @_;
   my ($from, $where) = @{$dq}{qw(from where)};
-  my $keyword = ($from && $from->{type} eq DQ_GROUP) ? 'HAVING' : 'WHERE';
+  while (is_Where $from) {
+    $where = Operator({ 'SQL.Naive' => 'and' }, [ $where, $from->{where} ]);
+    $from = $from->{from};
+  }
+  my $keyword = (is_Group($from) ? 'HAVING' : 'WHERE');
   [
     ($from ? $self->_render($from) : ()),
     $self->_format_keyword($keyword),
@@ -366,19 +376,19 @@ sub _render_order {
   my @ret = (
     $self->_format_keyword('ORDER BY'),
     $self->_render($dq->{by}),
-    (defined $dq->{reverse}
-      ? $self->_format_keyword($dq->{reverse} ? 'DESC' : 'ASC')
+    ($dq->{reverse}
+      ? $self->_format_keyword('DESC')
       : ())
   );
   my $from;
   while ($from = $dq->{from}) {
-    last unless $from->{type} eq DQ_ORDER;
+    last unless is_Order $from;
     $dq = $from;
     push @ret, (
       ',',
       $self->_render($dq->{by}),
-      (exists $dq->{reverse}
-        ? $self->_format_keyword($dq->{reverse} ? 'DESC' : 'ASC')
+      ($dq->{reverse}
+        ? $self->_format_keyword('DESC')
         : ())
     );
   }