#lang scheme
(require (prefix-in dbd: (planet jaymccarthy/sqlite:4:5))
(planet bzlib/base)
(planet bzlib/dbi)
(prefix-in s: srfi/19)
)
(define (sqlite-connect driver path . attrs)
(let-values (((loader attrs)
(filter-file-loader/attrs attrs)))
(let ((handle (make-handle driver (dbd:open path)
(make-immutable-hash-registry)
0)))
(load-files! handle (if (list? loader) loader
(list loader)))
handle)))
(define (sqlite-disconnect handle)
(hash-for-each (registry-table (handle-query handle))
(lambda (key prepared)
(dbd:finalize (prepared-inner prepared))))
(dbd:close (handle-conn handle)))
(define (sqlite-query handle stmt (args '()))
(if-it (registry-ref (handle-query handle) stmt) (convert-result
(let ((query (prepared-query it))
(stmt (prepared-inner it)))
(apply dbd:load-params stmt (map cell->sql-cell (phq-map-values query args)))
(begin0
(dbd:step* stmt)
(dbd:reset stmt))))
(begin
(sqlite-prepare handle stmt stmt)
(sqlite-query handle stmt args))))
(define (sqlite-prepare handle key stmt)
(let ((query (make-place-holder-query question-converter stmt)))
(registry-set! (handle-query handle)
key
(make-prepared query
(dbd:prepare (handle-conn handle) (phq-converted query))))))
(define (convert-result result)
(if (null? result) (void)
(map (lambda (rec)
(map sql-cell->cell (vector->list rec)))
result)))
(define (sql-cell->cell cell)
(cond ((eq? #f cell) '())
(else cell)))
(define (cell->sql-cell cell)
(cond ((null? cell) #f)
((s:date? cell)
(s:date->string cell "~Y-~m-~d ~H:~M:~S~z"))
(else cell)))
(registry-set! drivers 'jsqlite
(make-driver sqlite-connect
sqlite-disconnect
sqlite-query
sqlite-prepare
default-begin
default-commit
default-rollback))