From 8e1e4cceab516afab46ccced63ca9edab663ca11 Mon Sep 17 00:00:00 2001 From: Munyoki Kilyungi Date: Mon, 21 Aug 2023 15:03:20 +0300 Subject: Rename dump -> transform Signed-off-by: Munyoki Kilyungi --- dump/sql.scm | 114 ----------------------------------------------------------- 1 file changed, 114 deletions(-) delete mode 100644 dump/sql.scm (limited to 'dump/sql.scm') diff --git a/dump/sql.scm b/dump/sql.scm deleted file mode 100644 index 9e6b21a..0000000 --- a/dump/sql.scm +++ /dev/null @@ -1,114 +0,0 @@ -;;; Database helpers -;;; -;;; 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 (select-query - call-with-database - call-with-target-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) - (((query alias)) - (format #f "~a AS ~a" query alias)) - ((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 () - (set! db (dbi-open backend connection-string))) - (cut proc db) - (cut dbi-close db)))) - -(define (database-check-status db) - (match (dbi-get_status db) - ((code . str) - (unless (zero? code) - (error str))))) - -(define (sql-exec db statement) - (dbi-query db statement) - (database-check-status db)) - -(define (sql-fold proc init db statement) - (sql-exec db statement) - (let loop ((result init)) - (let ((row (dbi-get_row db))) - (if row - (loop (proc row result)) - result)))) - -(define (sql-map proc db statement) - (sql-fold (lambda (row result) - (cons (proc row) result)) - (list) db statement)) - -(define (sql-for-each proc db statement) - (sql-fold (lambda (row _) - (proc row)) - #f db statement)) - -(define (sql-find db statement) - (sql-exec db statement) - (dbi-get_row db)) - -(define (call-with-target-database connection-settings proc) - (call-with-database "mysql" (string-join - (list (assq-ref connection-settings 'sql-username) - (assq-ref connection-settings 'sql-password) - (assq-ref connection-settings 'sql-database) - "tcp" - (assq-ref connection-settings 'sql-host) - (number->string - (assq-ref connection-settings 'sql-port))) - ":") - proc)) -- cgit v1.2.3