X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=sql%2Fexpressions.lisp;h=304cb3bfa5f9f70f56cad3b90ec70ecfecdb4c6c;hb=9c0cfd2ef1ee5b236fa870061127052689dd581a;hp=d7a95ef74f83a11cd85ab96e69ed87af14cfe9ad;hpb=6c813a0543182a94859d01a6af85d5e08d23ec35;p=clsql.git diff --git a/sql/expressions.lisp b/sql/expressions.lisp index d7a95ef..304cb3b 100644 --- a/sql/expressions.lisp +++ b/sql/expressions.lisp @@ -245,18 +245,32 @@ (with-slots (operator sub-expressions) expr (when sub-expressions - (let ((subs (if (consp (car sub-expressions)) - (car sub-expressions) - sub-expressions))) - (write-char #\( *sql-stream*) - (do ((sub subs (cdr sub))) - ((null (cdr sub)) - (output-sql (car sub) database)) - (output-sql (car sub) database) - (write-char #\Space *sql-stream*) - (output-sql operator database) - (write-char #\Space *sql-stream*)) - (write-char #\) *sql-stream*)))) + (let (has-written) + ;; we do this as two runs so as not to emit confusing superflous parentheses + ;; The first loop renders all the child outputs so that we can skip anding with + ;; empty output (which causes sql errors) + ;; the next loop simply emits each sub-expression with the appropriate number of + ;; parens and operators + (let ((str-subs (loop for sub in sub-expressions + for str-sub = (string-trim '(#\space #\newline #\return #\tab #\no-break_space) + (with-output-to-string (*sql-stream*) + (output-sql sub database))) + when (and str-sub (> (length str-sub) 0)) + collect str-sub + ))) + (loop for str-sub in str-subs + do + (progn + (when (and (not has-written) + (> (length str-subs) 1)) + (write-char #\( *sql-stream*)) + (when has-written + (write-char #\Space *sql-stream*) + (output-sql operator database)) + (write-string str-sub *sql-stream*) + (setf has-written T))) + (when (and has-written (> (length str-subs) 1)) + (write-char #\) *sql-stream*)))))) t) (defclass sql-array-exp (sql-relational-exp) @@ -625,9 +639,13 @@ uninclusive, and the args from that keyword to the end." (write-string " ON " *sql-stream*) (output-sql on database)) (when where - (write-string " WHERE " *sql-stream*) - (let ((*in-subselect* t)) - (output-sql where database))) + (let ((where-out (string-trim '(#\newline #\space #\tab #\return) + (with-output-to-string (*sql-stream*) + (let ((*in-subselect* t)) + (output-sql where database)))))) + (when (> (length where-out) 0) + (write-string " WHERE " *sql-stream*) + (write-string where-out *sql-stream*)))) (when group-by (write-string " GROUP BY " *sql-stream*) (if (listp group-by)