#lang scheme/base
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DBI.plt
;;
;; database interface abstraction.  Inspired by Perl DBI.
;;
;; Bonzai Lab, LLC.  All rights reserved.
;;
;; released under LGPL.
;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; query.ss - handles the query conversions into statements.
;; yc 9/8/2009 - first version
;; yc 9/30/2009 - added date & srfi/19 date SQL escape support, plus error for unsupported datatype


;; (convert query) => phq (place holder query).
;;
;; example: select * from test where (?uuid is null or uuid = ?uuid)
;; => select * from test where ?1 is null or uuid = ?2

;; the way to replace them are:
;; extract the list of the keys (question mark followed by alphanumeric word)
;; *unique* the list of the keys.
;; map the keys into their replacements (this is where the algorithm comes in)
;; transform the list of the keys into the replacements.

;; NOTE - this can be done with the help of the IQS (which uses $ as the notifier).
(require (planet bzlib/base)
         (planet bzlib/template/iqs)
         "base.ss"
         (prefix-in s: srfi/19) 
         )

;; so what's customizable below?
;; just the converter...

(define (make-place-holder-query converter s)
  (define (helper lst)
    (make-phq s (iqs-convert lst converter '())
              (filter symbol? lst)))
  (parameterize ((iqs-symbol-start #\?))
    (helper (read-iqs (open-input-string s)))))

(define (default-converter args)
  (let ((i 0))
    (lambda (s)
      (set! i (add1 i))
      (format "$~a" i))))

(define (question-converter args)
  (lambda (s) "?"))

(define (phq-map-values phq value
                        (mapper
                         (lambda (lst value) 
                           (map (lambda (key)
                                  (if-it (assoc key value)
                                         (cdr it)
                                         (error 'phq-map-values "missing key ~a" key)))
                                lst))))
  (mapper (phq-args phq) value))
;; (trace phq-map-values)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; at this point we can actually generate a query by itself if we know how to
;; format the values to string!!...
;; we'll skip this for now... ??
;; at this moment, we can handle regular prepare statement
;; but we still need to handle one more thing... and that is to
;; handle the data values into string.
;; basically - we have the following base types that we need to handle
;; number -> leave along
;; string -> add single quotes (and escape single quotes within)
;; date -> also add single quote (we'll handle date later)
;; '() => NULL
(define (sql-escape-string x)
  (string-append "'"
                 (regexp-replace* #px"\\'" x "''")
                 "'"))

(define (data->string x)
  (cond ((null? x) "NULL")
        ((number? x) (number->string x))
        ((s:date? x) (sql-escape-string (s:date->string x "~Y-~m-~d ~H:~M:~S~z")))
        ((date? x) 
         (data->string (s:make-date (date-second x)
                                    (date-minute x)
                                    (date-hour x)
                                    (date-day x)
                                    (date-month x)
                                    (date-year x)
                                    (date-time-zone-offset x))))
        ((bytes? x) ;; bytes might not be working correctly...
         (error 'data->string "bytes are not directly supported - please encode it into string according to your database's format, or use prepare statement"))
        ((string? x) (sql-escape-string x))
        (else (error 'data->string "unsupported data type: ~a - please first convert to string" x))))
  
(define (map-value-converter args)
  (let ((args args))
    (lambda (s)
      (begin0 (data->string (car args))
        (set! args (cdr args))))))
     
;; now to generate a statement - the values are assumed to be mapped... ??
(define (phq-merge-query phq value)
  (let ((lst (read-iqs (open-input-string (phq-converted phq)))))
    (if (not (= (length (filter symbol? lst)) (length value)))
        (error 'php-merge-query "missing args in ~a" value)
        (iqs-convert lst map-value-converter value))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CONTRACT
(provide/contract
 (make-place-holder-query (-> (-> (listof any/c) (-> any/c any)) string? phq?))
 (default-converter (-> (listof any/c) (-> any/c any)))
 (question-converter (-> (listof any/c) (-> any/c any)))
 (phq-map-values (->* (phq? (listof any/c))
                      ((-> (listof any/c) (listof any/c) any))
                      any))
 (phq-merge-query (-> phq? (listof any/c) string?))
 (data->string (-> any/c any))
 )