(module sqlite-oo mzscheme (require (lib "class.ss") (lib "contract.ss") (prefix sqlite: "sqlite.ss")) (provide (all-defined) (all-from (lib "class.ss"))) (define db<%> (interface () exec exec/ignore select statement% changes-count total-changes-count)) (define statement<%> (interface () load-params step run)) (define db% (class* object% (db<%>) (public exec exec/ignore select statement% changes-count total-changes-count) (define db #f) (init-field path) (define (exec sql callback) (sqlite:exec db sql callback)) (define (exec/ignore sql) (sqlite:exec/ignore db sql)) (define (select sql) (sqlite:select db sql)) (define (statement%) (class* object% (statement<%>) (public load-params step run) (define stmt #f) (init-field sql) (define (load-params . params) (apply sqlite:load-params stmt params)) (define (step) (sqlite:step stmt)) (define (run . params) (apply sqlite:run stmt params)) (set! stmt (sqlite:prepare db sql)) (super-new))) (define (changes-count) (sqlite:changes-count db)) (define (total-changes-count) (sqlite:total-changes-count db)) (set! db (sqlite:open path)) (super-new))) (define-syntax transaction/lock (syntax-rules () [(_ db lock-type fail body ...) (let ([end (lambda () (send db exec/ignore "ROLLBACK TRANSACTION"))]) (send db exec/ignore (format "BEGIN ~a TRANSACTION" (sqlite:lock-type->string 'lock-type))) (let/ec fail body ... (set! end (lambda () (send db exec/ignore "COMMIT TRANSACTION")))) (end) (send db exec/ignore "END TRANSACTION"))])) (define-syntax transaction (syntax-rules () [(_ db fail body ...) (transaction/lock db none fail body ...)])))