#lang scheme/base

(require (prefix-in sqlite: (planet jaymccarthy/sqlite:4))
         (planet synx/util:1/unwind-protect)
         
         scheme/class)

(define statement%
  (class object%
    (init-field statement)
    
    (super-new)
    (define/public (load . params)
      (apply sqlite:load-params statement params))
    
    (define/public (reset)
      (sqlite:reset statement))
    
    (define/public (step)
      (sqlite:step statement))
    
    (define/public (with-resetting thunk)
      (reset)
      (rewind-protect thunk (λ () (reset))))
    
    (define/public (for-each proc)
      (with-resetting 
       (λ ()
         (let loop ()
           (let ([row (step)])
             (when row
               (apply proc (vector->list row))
               (loop)))))))

    (define/public (fold proc init)
      (with-resetting
       (λ ()
         (let loop ([result init])
           (let ([row (step)])
             (if row
                 (loop (proc row result))
                 result))))))
    
    (define/public (once . params)
      (when (not (null? params))
        (apply sqlite:load-params statement params))
      (rewind-protect
       (λ () (sqlite:step statement))
       (λ () (sqlite:reset statement))))
    
    (define/public (map proc)
      (begin0
        (reverse
         (fold (λ (row result) (cons (apply proc (vector->list row)) result)) null))))))

(define connection%
  (class object%
    (init-field path)
    (super-new)
    (define context (sqlite:open path))
    (define statements (make-immutable-hash null))
    
    (define/public (clear)
      (for-each sqlite:finalize statements)
      (sqlite:close context))
    
    ; because no hash for weak values...
    (define/public (prepare sql)
      (define (new-statement)
        (let ((stmt (make-object statement% (sqlite:prepare context sql))))
          (set! statements (hash-set statements sql (make-weak-box stmt)))
          stmt))
      (let ((box
             (hash-ref statements sql (λ () #f))))
        (if box
            (let ((stmt (weak-box-value box)))
              (if stmt stmt
                  (new-statement)))
            (new-statement))))
    
    (define t-begin (prepare "BEGIN"))
    (define t-end (prepare "END"))
    (define transaction-level 0)
    
    (define/public (with-transaction body)
      (when (= transaction-level 0)
        (send t-begin once))
      (set! transaction-level (+ transaction-level 1))
      (rewind-protect
       body
       (λ () 
         (when (= transaction-level 1)
           (send t-end once))
         (set! transaction-level (- transaction-level 1)))))
    
    (define/public (changes-count)
      (sqlite:changes-count context))
    
    (define/public (last-insert)
      (sqlite:last-insert-rowid context))
    
    (define/public (map proc sql . params)
      (let ([stmt (prepare sql)])
        (send/apply stmt load params)
        (send stmt map proc)))
    
    (define/public (for-each proc sql . params)
      (let ([stmt (prepare sql)])
        (send/apply stmt load params)
        (send stmt for-each proc)))
    
    (define/public (fold proc init sql . params)
      (let ([stmt (prepare sql)])
        (send/apply stmt load params)
        (send stmt fold proc init)))
    
    (define/public (once sql . params)
      (let ([stmt (prepare sql)])
        (send/apply stmt once params)))
    ; etc...
    ))

(define-syntax-rule (with-transaction c body ...)
  (send c with-transaction (λ () body ...)))

(define-syntax-rule (with-resetting stmt body ...)
  (send stmt with-resetting (λ () body ...)))

;(provide connection% (rename-out (sqlite:with-transaction with-transaction)))
(provide connection% with-transaction with-resetting)