#lang scheme/base
;;; ES: TODO: Handle ALL error conditions!
(require scheme/foreign) (unsafe!)
(require (rename-in scheme/contract (-> -->)))
(require (lib "misc.ss" "swindle")) ; For list-of

(define (valid-pointer? p)
  (or
   (and p (cpointer? p))
   (and
    (fixnum? p)
    (not (zero? p)))))


(define libmysql (ffi-lib "C:\\Program Files\\MySQL\\MySQL Server 5.0\\bin\\libmySQL"))

(provide/contract [server-end (--> any)])
(define server-end (get-ffi-obj "mysql_server_end" libmysql (_fun -> _void)))
(define _my_bool _byte)

(provide/contract [mysql-thread-init (--> integer?)])
(define mysql-thread-init (get-ffi-obj "mysql_thread_init" libmysql (_fun -> _my_bool)))
(define mysql-thread-end (get-ffi-obj "mysql_thread_end" libmysql (_fun -> _void)))

;; WARNING: This is not thread-safe. See 
; http://dev.mysql.com/doc/refman/5.0/en/mysql-library-init.html
(define library-init (get-ffi-obj "mysql_server_init" libmysql (_fun _int _pointer 
                                                                     _pointer -> _int)))

;;;;;;;;;;;
;; Call this when done with the library.
(provide mysql-library-end)
(define mysql-library-end (get-ffi-obj "mysql_server_end" libmysql (_fun -> _void)))

;;;;;;;;;;;
;; Initialize the library on module load.
(let ([error-code (library-init -1 #f #f)])
  (unless (zero? error-code)
    ; Library init failed. Signal an error.
    (error (format "mysql_library_init failed with error code ~A" error-code))))

(define CLIENT_NET_READ_TIMEOUT (* 365 24 3600)) ; Timeout on read
(define CLIENT_NET_WRITE_TIMEOUT (* 365 24 3600)) ; Timeout on write

(define _enum_field_types (_enum
                           '(MYSQL_TYPE_DECIMAL
                             MYSQL_TYPE_TINY 
                             MYSQL_TYPE_SHORT   MYSQL_TYPE_LONG 
                             MYSQL_TYPE_FLOAT   MYSQL_TYPE_DOUBLE 
                             MYSQL_TYPE_NULL    MYSQL_TYPE_TIMESTAMP 
                             MYSQL_TYPE_LONGLONG MYSQL_TYPE_INT24 
                             MYSQL_TYPE_DATE    MYSQL_TYPE_TIME 
                             MYSQL_TYPE_DATETIME  MYSQL_TYPE_YEAR 
                             MYSQL_TYPE_NEWDATE  MYSQL_TYPE_VARCHAR 
                             MYSQL_TYPE_BIT 
                             MYSQL_TYPE_NEWDECIMAL = 246 
                             MYSQL_TYPE_ENUM = 247 
                             MYSQL_TYPE_SET = 248 
                             MYSQL_TYPE_TINY_BLOB = 249 
                             MYSQL_TYPE_MEDIUM_BLOB = 250 
                             MYSQL_TYPE_LONG_BLOB = 251 
                             MYSQL_TYPE_BLOB = 252 
                             MYSQL_TYPE_VAR_STRING = 253 
                             MYSQL_TYPE_STRING = 254 
                             MYSQL_TYPE_GEOMETRY = 255)))

(define-cstruct _mysql-field
  ((name _string)
   (org_name _string)
   (table _string)
   (org_table _string)
   (db _string)
   (catalog _string)
   (def _string)
   (length _ulong)
   (max_length _ulong)
   (name-length _uint)
   (org-name-length _uint)
   (table-length _uint)
   (org-table-length _uint)
   (db-length _uint)
   (catalog-length _uint)
   (def-length _uint)
   (flags _uint)
   (decimals _uint)
   (charsetnr _uint)
   (type _enum_field_types)))

(define _MYSQL-FIELD-OFFSET _uint)

(define MYSQL-COUNT-ERROR #xffffffffffffffff)


;;;;;;
; Creates a MYSQL object for connecting. Called automatically by mysql-connect.
(define init (get-ffi-obj "mysql_init" libmysql (_fun _ulong -> _pointer)))

(define real-connect (get-ffi-obj "mysql_real_connect" libmysql
                                  (_fun (mysql host user passwd db port unix-socket 
                                               clientflag) ::
                                        (mysql : _pointer)
                                        (host : _string)
                                        (user : _string)
                                        (passwd : _string)
                                        (db : _string)
                                        (port : _uint)
                                        (unix-socket : _string)
                                        (clientflag : _ulong)
                                        -> _pointer)))

(define query (get-ffi-obj "mysql_query" libmysql (_fun _pointer _string -> _int)))

(define mysql-error (get-ffi-obj "mysql_error" libmysql (_fun _pointer -> _string)))
(define mysql-errno (get-ffi-obj "mysql_errno" libmysql (_fun _pointer -> _uint)))

(provide/contract [mysql-insert-id (--> valid-pointer? integer?)])
(define mysql-insert-id
  (get-ffi-obj "mysql_insert_id" libmysql (_fun _pointer -> _ulong)))

(provide/contract [use-result (--> valid-pointer? cpointer?)])
(define use-result (get-ffi-obj "mysql_use_result" libmysql (_fun _pointer -> _pointer)))
;MYSQL_ROW	STDCALL mysql_fetch_row(MYSQL_RES *result);
(define fetch-row-raw (get-ffi-obj "mysql_fetch_row" libmysql (_fun (res num-fields) ::
                                                                    (res : _pointer)
                                                                    -> (_list o _string num-fields))))
(provide/contract [fetch-row (--> valid-pointer? cpointer?)])
(define (fetch-row res)
  ; If an error occurs, return false to indicate no more values.
  (with-handlers ((exn:fail:contract? (lambda (ignore) #f)))
    (fetch-row-raw res (num-fields res))))

(define num-fields (get-ffi-obj "mysql_num_fields" libmysql (_fun _pointer -> _uint)))

;;;;;;;;;
;; Takes a connection object (returned from mysql-connect) and a query string.
;; Returns a list of rows. Each row is represented by a list of strings holding
;; the values.
(provide/contract [mysql-query (--> valid-pointer? string? list?)])
(define (mysql-query conn query-string)
  (let ([ret (query conn query-string)])
    (unless (zero? ret) (error (format "Query failed with code ~a. ~a" ret (mysql-error conn)))))
  (let ([res (use-result conn)])
    ; Gotta love the list-of macro, from Swindle.
    ;; ES: Switch to using for/list.
    (if res
        (list-of x (x <- (lambda () (fetch-row res))) while x)
        ;; No result
        '())))

;;;;;;;;;
;; Connect to the given database with the given user and password.
;; Optionally specify host, port, unix_socket, and client flags.

(provide mysql-connect)
(define (mysql-connect db user passwd #:host (host #f) #:port (port 0)
                       #:unix-socket (unix-socket #f) #:clientflag (clientflag 0))
  (let ([conn (init 0)])
    (real-connect conn host user passwd db port unix-socket clientflag)))

;;;;;;;;;;
;; Close a connection that was opened with mysql-connect
(provide/contract [mysql-close (--> valid-pointer? any)])
(define mysql-close (get-ffi-obj "mysql_close" libmysql (_fun _pointer -> _void)))

(define ER_NO_SUCH_TABLE 1146)

(provide mysql-description)
(define-struct mysql-description (field-name type null key default extra))
(provide/contract [mysql-describe (--> valid-pointer? string? (or/c list? not))])
(define (mysql-describe conn table-name)
  (let ([res (describe-or-false conn table-name)])
    (and res
        (map (lambda (args) (apply make-mysql-description args)) res))))

(define (describe-or-false conn table-name)
  (with-handlers
      ((exn:fail?
        (lambda (ex)
          (if (= (mysql-errno conn)  ER_NO_SUCH_TABLE)
              #f
              (raise ex)))))
    (mysql-query conn (format "describe ~a" table-name))))
; End of mysql module


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;(define conn (mysql-connect "test" "eddy" "Password" #:host "localhost"))

;(display "Calling mysql-query\n")
;(mysql-query conn "select * from cards_card")
;(mysql-close conn)
;(mysql-library-end)