kritphong
/
ssql
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

improve sub-query parenthesization and add more tests

Browse Source
master
Moritz Heidkamp 13 years ago
parent 69915c5082
commit cc9ea436a5
2 changed files with 57 additions and 42 deletions
Show Stats Download Patch File Download Diff File

86
ssql.scm
Unescape Escape View File

@ -16,6 +16,8 @@
(and (not (eq? y (car lst))) (and (not (eq? y (car lst)))
(loop (cdr lst)))))) (loop (cdr lst))))))
(define sub-query? (make-parameter #f))
(define-syntax define-operators (define-syntax define-operators
(ir-macro-transformer (ir-macro-transformer
(lambda (x i c) (lambda (x i c)
@ -26,7 +28,7 @@
(let ((ssql-op (first op)) (let ((ssql-op (first op))
(type (second op))) (type (second op)))
(unless (memq (i type) '(infix infix* suffix prefix function)) (unless (memq (i type) '(infix infix* suffix prefix suffix* prefix* function))
(error "unknown operator syntax type" type)) (error "unknown operator syntax type" type))
(let-optionals (cddr op) (let-optionals (cddr op)
@ -60,7 +62,7 @@
(sprintf "(~A)" (sprintf "(~A)"
(string-intersperse (string-intersperse
(map (lambda (s) (map (lambda (s)
(self 'ssql->sql s #t)) (self 'ssql->sql s))
list) list)
", "))) ", ")))
@ -120,12 +122,13 @@
(symbol->string table)) (symbol->string table))
((insert into rest) ((insert into rest)
(sprintf "INSERT INTO ~A ~A" (parameterize ((sub-query? #t))
into (sprintf "INSERT INTO ~A ~A"
(string-intersperse into
(map (lambda (s) (string-intersperse
(self 'ssql->sql s)) (map (lambda (s)
rest)))) (self 'ssql->sql s))
rest)))))
((insert (('into table) ('columns columns ...) rest ...)) ((insert (('into table) ('columns columns ...) rest ...))
(self 'insert (self 'insert
@ -159,39 +162,48 @@
(string-append " " operator " "))) (string-append " " operator " ")))
((function) ((function)
(sprintf "~A(~A)" (parameterize ((sub-query? #t))
operator (sprintf "~A(~A)"
(string-intersperse operator
(map (lambda (operand) (string-intersperse
(self 'ssql->sql operand)) (map (lambda (operand)
operands) (self 'ssql->sql operand))
(or separator ", ")))) operands)
(or separator ", ")))))
((suffix prefix) ((suffix prefix)
(let ((operator (if (eq? type 'prefix) (let* ((operator (if (eq? type 'prefix)
(string-append operator " ") (string-append operator " ")
(string-append " " operator)))) (string-append " " operator))))
(string-join (parameterize ((sub-query? #t))
(list (string-join
(string-intersperse (list
(map (lambda (operand) (string-intersperse
(self 'ssql->sql operand)) (map (lambda (operand)
operands) (self 'ssql->sql operand))
(or separator " "))) operands)
operator (or separator " ")))
type))) operator
type))))
((suffix* prefix*)
(let ((sql (self 'operator->sql
(if (eq? 'suffix* type) 'suffix 'prefix)
operator
separator
operands)))
(if (sub-query?)
(sprintf "(~A)" sql)
sql)))
(else (error "unknown operator syntax type" type)))) (else (error "unknown operator syntax type" type))))
((ssql->sql ssql parenthesize?) ((ssql->sql ssql)
(let ((handler (alist-ref (list ssql) (self 'type->sql-converters) apply))) (let ((handler (alist-ref (list ssql) (self 'type->sql-converters) apply)))
(if handler (if handler
(if (and parenthesize? (pair? ssql)) (self handler ssql)
(sprintf "(~A)" (self handler ssql))
(self handler ssql))
(error "unknown datatype" ssql)))) (error "unknown datatype" ssql))))
((ssql->sql ssql)
(self 'ssql->sql ssql #f))
((insert-clause clause ssql) ((insert-clause clause ssql)
(let ((order (self 'clauses-order))) (let ((order (self 'clauses-order)))
(let loop ((ssql ssql)) (let loop ((ssql ssql))
@ -204,9 +216,9 @@
(append target-clause (cdr clause))))) (append target-clause (cdr clause)))))
(define-operators *ansi-translator* (define-operators *ansi-translator*
(select prefix) (select prefix*)
(update prefix) (update prefix*)
(delete prefix) (delete prefix*)
(from prefix "FROM" ", ") (from prefix "FROM" ", ")
(where prefix) (where prefix)
(order prefix "ORDER BY" ", ") (order prefix "ORDER BY" ", ")

13
tests/ansi-test.scm
Unescape Escape View File

@ -33,8 +33,11 @@
(ssql->sql #f '(update (table actors) (set (firstname "Rube") (lastname "Goldberg"))))) (ssql->sql #f '(update (table actors) (set (firstname "Rube") (lastname "Goldberg")))))
(test "with condition" (test "with condition"
"UPDATE actors SET firstname = 'Felix' WHERE (lastname = 'Winkelmann')" "UPDATE actors SET firstname = 'Felix', experience = (SELECT COUNT(*) FROM roles WHERE (actor_id = actors.id)) WHERE (lastname = 'Winkelmann')"
(ssql->sql #f '(update (table actors) (set (firstname "Felix")) (where (= lastname "Winkelmann")))))) (ssql->sql #f '(update (table actors)
(set (firstname "Felix")
(experience (select (count *) (from roles) (where (= actor_id actors.id)))))
(where (= lastname "Winkelmann"))))))
(test-group "inserts" (test-group "inserts"
(test "with sub-queries" (test "with sub-queries"
@ -63,9 +66,9 @@
(test-group "syntax" (test-group "syntax"
(test "set literals" (test "set literals"
"SELECT one, two FROM (1, 2)" "SELECT one, two FROM (1, 2, (SELECT MAX(amount) FROM widgets))"
(ssql->sql #f '(select (columns one two) (from #(1 2))))) (ssql->sql #f '(select (columns one two) (from #(1 2 (select (max amount) (from widgets)))))))
(test "function calls" (test "function calls"
"SELECT foo(99, (bar('baz')))" "SELECT foo(99, bar('baz'))"
(ssql->sql #f '(select (call foo 99 (call bar "baz")))))) (ssql->sql #f '(select (call foo 99 (call bar "baz"))))))
Write Preview
Loading…
Cancel
Save