(module sqld-i-sqlite mzscheme
        (require (lib "foreign.ss")) (unsafe!)
        (provide c-sqlite-open
                 c-sqlite-close
                 c-sqlite-query
                 c-sqlite-cell
                 c-sqlite-nrows
                 c-sqlite-ncols
                 c-sqlite-lasterr
                 c-sqlite-version
                 c-sqlite-debug)
        
        (define libsqlite 
          (letrec ((trylibs (lambda (lib libs)
                              (if (null? lib)
                                  (error (format "Cannot load C library: none of:\n~aworked"
                                                 (apply string-append 
                                                        (map (lambda (l)
                                                               (format "   ~a\n" l))
                                                             libs))))
                                  (let ((L (with-handlers ((exn:fail? (lambda (exn) #f)))
                                             (ffi-lib (car lib)))))
                                    (if (eq? L #f)
                                        (trylibs (cdr lib) libs)
                                        L))))))
            (let ((L '("sqlite3" "libsqlite3" 
                                 "/usr/lib/sqlite3" "/usr/lib/libsqlite3"
                                                    "/usr/local/lib/sqlite3" "/usr/local/lib/libsqlite3")))
              (if (not (eq? (getenv "LIBSQLITE") #f))
                  (set! L (cons (format "~a/sqlite3" (getenv "LIBSQLITE")) 
                                (cons (format "~a/libsqlite3" (getenv "LIBSQLITE"))
                                      L))))
              (trylibs L L))))
        
        (define DEBUG #f)

        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; SQLite3 types
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define _sqlite_callback (_fun _scheme _int _pointer _pointer -> _int))
        (define _busy_callback   (_fun _scheme _int -> _int))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; SQLite3 interfacing
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define sqlite3-open (get-ffi-obj "sqlite3_open" 
                                          libsqlite 
                                          (_fun (file : _string)
                                                (handle : (_ptr o _pointer))
                                                -> (result : _int)
                                                -> (values handle result))))
        
        (define sqlite3-close (get-ffi-obj "sqlite3_close"
                                           libsqlite
                                           (_fun (handle : _pointer)
                                                 -> (result : _int)
                                                 -> result)))
        
        
        (define sqlite3-exec (get-ffi-obj "sqlite3_exec"
                                          libsqlite
                                          (_fun (handle   : _pointer)
                                                (sql      : _string)
                                                (callback : _sqlite_callback)
                                                (context  : _scheme)   
                                                (errmsg   : (_ptr o _string))
                                                -> (result : _int)
                                                -> (values result errmsg))))
        
        (define sqlite3-errmsg (get-ffi-obj "sqlite3_errmsg"
                                            libsqlite
                                            (_fun (handle  : _pointer)
                                                  -> _string)))
        
        (define sqlite3-libversion  (get-ffi-obj "sqlite3_libversion"
                                                 libsqlite
                                                 (_fun -> _string)))
        
        (define sqlite3-busy-handler (get-ffi-obj "sqlite3_busy_handler"
                                                  libsqlite
                                                  (_fun (handle   : _pointer)
                                                        (callback : _busy_callback)
                                                        (context  : _scheme)
                                                        -> _int)))
        
        (define sqlite3-busy-timeout (get-ffi-obj "sqlite3_busy_timeout"
                                                  libsqlite
                                                  (_fun (handle   : _pointer)
                                                        (millisec : _int)
                                                        -> _int)))
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; Scheme interfacing
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define-struct sqlite-handle (handle err-message err))
        (define-struct sqlite-result (strings ncols nrows handle))
        
        (define (sqlite-i-callback adder columns pvalues names)
          (let ((values (cvector->list (make-cvector* pvalues _string columns))))
            (adder columns values))
          0)
        
        (define (sqlite-i-busy-callback obj times)  ;;; only there to allow scheme threads to run
          (if DEBUG (display (format "busy timeout handler ~a~%" times)))
          (sleep 0.1)
          1)
;          #t)
        
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        ;;; Scheme interfacing - exported functions
        ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
        
        (define (c-sqlite-open file . busytimeout)
          (if (null? busytimeout) (set! busytimeout 30000)) ;;; 30 seconds
          (call-with-values (lambda () (sqlite3-open file))
                            (lambda (handle r)
                              (register-finalizer handle sqlite3-finalize-handle)
                              (sqlite3-busy-handler handle sqlite-i-busy-callback #f)
;                              (sqlite3-busy-timeout handle busytimeout)
                              ;(display (format "~s ~s ~%" handle r))
                              (if (= r 0)
                                  (make-sqlite-handle handle "" #f)
                                  (make-sqlite-handle #f (sqlite3-errmsg handle) #t)))))
        
        (define (sqlite3-finalize-handle handle)
          ;(display "Finalizing c handle\n")
          (sqlite3-close handle))
        
        (define (c-sqlite-close handle)
          (set-sqlite-handle-handle! handle #f)
          #t)
        
        (define (c-sqlite-query handle query)
          (let ((R      (list))
                (ncols  #f))
            (let ((adder (lambda (colcount values)
                           (set! R (cons values R))
                           (set! ncols colcount))))
              (call-with-values 
               (lambda ()
                 (sqlite3-exec (sqlite-handle-handle handle) query sqlite-i-callback adder))
               (lambda (result errmsg)
                 (if (= result 0)
                     (begin
                       (set-sqlite-handle-err-message! handle "")
                       (set-sqlite-handle-err! handle #f)
                       (make-sqlite-result (list->vector (reverse R))
                                           ncols
                                           (length R)
                                           handle))
                     (begin
                       (set-sqlite-handle-err-message! handle errmsg)
                       (set-sqlite-handle-err! handle #t)
                       (make-sqlite-result (vector) ncols 0 handle))))))))
        
        (define (c-sqlite-nrows result)
          (sqlite-result-nrows result))
        
        (define (c-sqlite-ncols result)
          (sqlite-result-ncols result))
        
        (define (c-sqlite-lasterr handle-or-result)
          (if (sqlite-result? handle-or-result)
              (c-sqlite-lasterr (sqlite-result-handle handle-or-result))
              (sqlite-handle-err-message handle-or-result)))
          
        (define (c-sqlite-cell result row col)
          (list-ref (vector-ref (sqlite-result-strings result) row) col))

        (define (c-sqlite-version)
          (let ((S (sqlite3-libversion)))
            S))
        
        (define (c-sqlite-debug x)
          (set! DEBUG x))
        
        )