diff options
author | Arun Isaac | 2021-12-11 12:44:17 +0530 |
---|---|---|
committer | Arun Isaac | 2021-12-11 12:44:17 +0530 |
commit | f577e126b1996295d228c9d96521fe41380be535 (patch) | |
tree | 28f1e6413786144cd211a945ee477c7a698c1683 /dump | |
parent | c538cd28f8105dee70f3c89d3ed91d6b943402a6 (diff) | |
download | gn-transform-databases-f577e126b1996295d228c9d96521fe41380be535.tar.gz |
Implement S-expression like SQL select query.
* dump/sql.scm: Import (srfi srfi-1). Export select-query.
(select-query): New macro.
Diffstat (limited to 'dump')
-rw-r--r-- | dump/sql.scm | 51 |
1 files changed, 48 insertions, 3 deletions
diff --git a/dump/sql.scm b/dump/sql.scm index 576d6cd..74f3139 100644 --- a/dump/sql.scm +++ b/dump/sql.scm @@ -1,19 +1,64 @@ ;;; Database helpers ;;; -;;; These functions should have been a part of guile-dbi. Never too -;;; late to contribute upstream! +;;; Most of these functions should have been a part of +;;; guile-dbi. Never too late to contribute upstream! (define-module (dump sql) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) #:use-module (dbi dbi) - #:export (call-with-database + #:export (select-query + call-with-database sql-exec sql-fold sql-map sql-for-each sql-find)) +;; A half-baked macro to make SQL SELECT queries a bit more +;; S-expression friendly +(define-syntax select-query + (lambda (x) + (syntax-case x () + ((_ fields tables raw-forms ...) + #`(string-append "SELECT " + #,(syntax-case #'fields (distinct) + ((distinct _ ...) + "DISTINCT ") + (_ "")) + #,(string-join (filter-map (match-lambda + ('distinct #f) + ((table column) + (format #f "~a.~a" table column)) + ((table column alias) + (format #f "~a.~a AS ~a" table column alias)) + (field-spec + (error "Invalid field specification" field-spec))) + (syntax->datum #'fields)) + ", ") + " FROM " + #,(string-join (map (match-lambda + ((join table condition) + (format #f "~a ~a ~a" + (case join + ((join) "JOIN") + ((left-join) "LEFT JOIN") + ((inner-join) "INNER JOIN") + (else (error "Invalid join operator" join))) + table condition)) + ((? symbol? table) + (symbol->string table)) + (table-spec + (error "Invalid table specification" table-spec))) + (syntax->datum #'tables)) + " ") + #,(syntax-case #'(raw-forms ...) () + (() "") + (_ " ")) + raw-forms ...)) + (_ (error "Invalid SQL select query" (syntax->datum x)))))) + (define (call-with-database backend connection-string proc) (let ((db #f)) (dynamic-wind (lambda () |