order by somewhat working

diff --git a/lib/Data/Query/ExprDeclare.pm b/lib/Data/Query/ExprDeclare.pm
index 971e3cc..b2f38a6 100644 (file)
--- a/lib/Data/Query/ExprDeclare.pm
+++ b/lib/Data/Query/ExprDeclare.pm
@@ -8,7 +8,9 @@ use Safe::Isa;
 
 use base qw(Exporter);
 
-our @EXPORT = qw(expr SELECT AS FROM BY JOIN ON LEFT WHERE ORDER GROUP);
+our @EXPORT = qw(
+  expr SELECT AS FROM BY JOIN ON LEFT WHERE ORDER GROUP DESC
+);
 
 sub expr (&) {
   _run_expr($_[0])->{expr};
@@ -66,7 +68,16 @@ sub FROM (&;@) {
     $from_dq = { %{+shift}, left => $from_dq };
   }
   if (is_Where($_[0])) {
-    $from_dq = Where(shift->{where}, $from_dq);
+    my $where = shift->{where};
+    if (is_Select($from_dq)) {
+      $from_dq = Select($from_dq->{select}, Where($where, $from_dq->{from}));
+    } else {
+      $from_dq = Where($where, $from_dq);
+    }
+  }
+  while (is_Order($_[0])) {
+    my $order = shift;
+    $from_dq = Order($order->{by}, $order->{reverse}, $from_dq);
   }
   return $from_dq;
 }
@@ -100,4 +111,18 @@ sub WHERE (&;@) {
   return Where(_value(_run_expr($w))), @_;
 }
 
+sub DESC { bless({}, 'LIES::DESC'), @_ }
+
+sub ORDER {
+  my @order = map _value($_), _run_expr(shift);
+  my $reverse = do {
+    if ($_[0]->$_isa('LIES::DESC')) {
+      shift; 1;
+    } else {
+      0;
+    }
+  };
+  return compose { Order($b, $reverse, $a) } @order, undef;
+}
+
 1;

diff --git a/t/example.t b/t/example.t
index 25d6466..35a1a92 100644 (file)
--- a/t/example.t
+++ b/t/example.t
@@ -38,3 +38,18 @@ DwarnL render_expr(
     ON { $_->cd->artistid eq $_->artist->id }
   WHERE { $_->artist->age > 25 }
 );
+DwarnL render_expr(ORDER BY { $_->foo, $_->bar, $_->baz } DESC);
+
+my $basic = SELECT { $_->cd->name } FROM { $_->cds, AS 'cd' };
+
+DwarnL render_expr(
+  FROM { $basic } WHERE { $_->year > 2000 }
+);
+
+DwarnL render_expr(
+  FROM { $basic } ORDER BY { $_->year }
+);
+
+DwarnL render_expr(
+  SELECT { $_->cd->name } FROM { $_->cds, AS 'cd' } ORDER BY { $_->year }
+);