commit 405455a226eabd2a7348128743d569f508d7fe38
parent f00c303fee225894a4bbf8520c0ca9f9a5e45617
Author: septeql <septeql@telent.net>
Date: Sat, 1 Sep 2007 23:24:30 +0000
add support for left joins
Diffstat:
2 files changed, 17 insertions(+), 2 deletions(-)
diff --git a/septeql.lisp b/septeql.lisp
@@ -156,6 +156,12 @@ interpolated into a SQL statement as a string literal"
(setf r (make-instance 'sql :from r)))
(make-instance 'sql :from `(join ,(sv l 'from) ,(sv r 'from) ,expr))))
+(define-translator left-join (rel1 rel2 expr)
+ (let* ((j (parse-relation `(join ,rel1 ,rel2 ,expr)))
+ (from (sv j 'from)))
+ (setf (sv j 'from) `(left-join ,@(cdr from)))
+ j))
+
(define-translator group (aggregates dividers relation)
(let ((l (parse-relation relation)))
(when (any-slot-bound-p l '(start end group-by attributes order-by))
@@ -223,6 +229,11 @@ interpolated into a SQL statement as a string literal"
(from-clause-as-string (second from))
(from-clause-as-string (third from))
(translate-scalar (fourth from))))
+ ((eql (car from) 'left-join)
+ (format nil "(~A LEFT JOIN ~A ON ~A)"
+ (from-clause-as-string (second from))
+ (from-clause-as-string (third from))
+ (translate-scalar (fourth from))))
(t (error "buggered if I know"))))
(defun as-string (sql)
diff --git a/tests.lisp b/tests.lisp
@@ -135,4 +135,8 @@ SIMPLE-ERROR
;; sent
(to-sql '(select relation (and (= value 1) (< another 10) (or true false))))
;; received
-"SELECT * FROM RELATION WHERE (((VALUE = 1) AND (ANOTHER < 10)) AND (TRUE OR FALSE)) "
-\ No newline at end of file
+"SELECT * FROM RELATION WHERE (((VALUE = 1) AND (ANOTHER < 10)) AND (TRUE OR FALSE)) "
+;; sent
+(7ql:to-sql '(left-join a b (= a.id b.id)))
+;; received
+"SELECT * FROM (A LEFT JOIN B ON (A.ID = B.ID)) "
+\ No newline at end of file
