(module sql-quote-unit mzscheme
  
  (require (lib "etc.ss")
           (lib "pregexp.ss")
           (lib "unitsig.ss")
           (lib "list.ss"       "srfi" "1")
           (lib "string.ss"     "srfi" "13")
           (lib "time.ss"       "srfi" "19")
           (lib "vector-lib.ss" "srfi" "43"))
  
  (require (file "spgsql-ssl/spgsql.ss")
           (file "../base.ss")
           (file "../era.ss")
           (file "../type.ss")
           (file "../generic/sql-sig.ss")
           (prefix generic: (file "../generic/sql-quote-unit.ss")))
  
  (provide sql-quote@)
  
  ;; Provides a DBMS specific unit for quoting/unquoting data primitives. See:
  ;;
  ;;     ../sql-sig.ss
  ;;     ../generic/sql-quote.ss
  ;;
  ;; for more information.
  
  (define sql-quote@
    (let ([mixin@
           (unit/sig sql-quote^
             (import (generic : sql-quote^))
             
             ;; quote-id : (U symbol string) -> string
             ;;
             ;; Quotes a field or table name. In SQLite's case this is
             ;; done by wrapping the name in square brackets
             (define (quote-id identifier)
               (if (symbol? identifier)
                   (string-append "\"" (symbol->string identifier) "\"")
                   (string-append "\"" identifier "\"")))
             
             ;; quote-data type any -> string
             (define (quote-data type data)
               ; base : base-type
               (let ([base (type-base type)])
                 (cond [(eq? base type:id)
                        (cond [(integer? data) (number->string data)]
                              [(equal? data (type-null type)) "NULL"]
                              [else (raise-exn exn:fail:snooze
                                      (format "Expected data of type (U integer #f), given ~a" data))])]
                       [(eq? base type:revision)
                        (cond [(integer? data) (number->string data)]
                              [(equal? data (type-null type)) "NULL"]
                              [else (raise-exn exn:fail:snooze
                                      (format "Expected data of type (U integer #f), given ~a" data))])]
                       [(eq? base type:text)
                        (cond [(string? data) (string-append "'" (regexp-replace* #rx"'" data "''") "'")]
                              [(equal? data (type-null type)) "NULL"]
                              [else (raise-exn exn:fail:snooze
                                      (format "Expected data of type (U string #f), given ~a" data))])]
                       [(eq? base type:integer)
                        (cond [(integer? data) (number->string data)]
                              [(equal? data (type-null type)) "NULL"]
                              [else (raise-exn exn:fail:snooze
                                      (format "Expected data of type (U integer #f), given ~a" data))])]
                       [(eq? base type:real)
                        (cond [(real? data) (number->string (exact->inexact data))]
                              [(equal? data (type-null type)) "NULL"]
                              [else (raise-exn exn:fail:snooze
                                      (format "Expected data of type (U real #f), given ~a" data))])]
                       [(eq? base type:symbol)
                        (cond [(symbol? data) (string-append "'" (regexp-replace* #rx"'" (symbol->string data) "''") "'")]
                              [(equal? data (type-null type)) "NULL"]
                              [else (raise-exn exn:fail:snooze
                                      (format "Expected data of type (U symbol #f), given ~a\n" data))])]
                       [(eq? base type:boolean)
                        (cond [(eq? data #t) "true"]
                              [(eq? data #f) "false"]
                              [else (raise-exn exn:fail:snooze
                                      (format "Expected data of type (U #t #f), given ~a\n" data))])]
                       [(eq? base type:time-tai)
                        (cond [(time? data)
                               ; NOTE: PostgreSQL expects dates in ISO 8601 format. There are formats for date->string
                               ; that write versions of this, but I'm being explicit below and now using them.
                               ;
                               ; NOTE: TODO: HACK: There are hacks here to get around a bug in SRFI-19. This bug has been
                               ; spotted elsewhere and reported appropriately. For example:
                               ;
                               ;     http://permalink.gmane.org/gmane.comp.java.sisc.devel/634
                               ;
                               ; once this bug has been fixed, the calls to string-append / date->string / string-pad
                               ; can be replaced with single calls to date->string:
                               ;
                               ;     (date->string (time-tai->date data 0) "'~5.~N'")
                               ;
                               ; the "requires" statement for SRFI-13 will probably be superfluous once we're not using
                               ; string-pad anymore.
                               (cond [(eq? (time-type data) time-tai) 
                                      ; TODO: Change this expression (see comment above):
                                      (string-append (date->string (time-tai->date data 0) "'~Y-~m-~d ~H:~M:~S.")
                                                     (string-pad (date->string (time-tai->date data) "~N'") 10 #\0))]
                                     [(eq? (time-type data) time-utc) 
                                      (let ([data (time-utc->time-tai data)])
                                        ; TODO: Change this expression (see comment above):
                                        (string-append (date->string (time-tai->date data 0) "'~Y-~m-~d ~H:~M:~S.")
                                                       (string-pad (date->string (time-tai->date data) "~N'") 10 #\0)))]
                                     [else (raise-exn exn:fail:snooze
                                             (format "Expected data of type (U time-tai time-utc #f), given ~a\n" data))])]
                              [(equal? data (type-null type)) "NULL"]
                              [else (raise-exn exn:fail:snooze
                                      (format "Expected data of type (U time-tai time-utc #f), given ~a\n" data))])])))
             
             ;; unquote-data : type (U bytes string sql-null) -> any
             (define (unquote-data type data)
               ; base : base-type
               (let ([base (type-base type)])
                 (cond [(eq? base type:text) 
                        (cond [(sql-null? data)   #f]
                              [(bytes? data)      (bytes->string/utf-8 data)]
                              [(string? data)     data]
                              [else               (raise-exn exn:fail:snooze (format "Cannot parse ~a: ~s" type data))])]
                       [(or (eq? base type:id) 
                            (eq? base type:revision)
                            (eq? base type:integer)
                            (eq? base type:real))
                        (cond [(sql-null? data)   #f]
                              [(bytes? data)      (string->number (bytes->string/utf-8 data))]
                              [(string? data)     (string->number data)]
                              [else               (raise-exn exn:fail:snooze (format "Cannot parse ~a: ~s" type data))])]
                       [(eq? base type:symbol)
                        (cond [(sql-null? data)   #f]
                              [(bytes? data)      (string->symbol (bytes->string/utf-8 data))]
                              [(string? data)     (string->symbol data)]
                              [else               (raise-exn exn:fail:snooze (format "Cannot parse ~a: ~s" type data))])]
                       [(eq? base type:boolean)
                        (cond [(sql-null? data)   #f]
                              [(equal? data #"t") #t]
                              [(equal? data "t")  #t]
                              [else               #f])]
                       [(eq? base type:time-tai)
                        (cond [(sql-null? data)   #f]
                              [(bytes? data)     (unquote-time-tai (bytes->string/utf-8 data))]
                              [(string? data)    (unquote-time-tai data)]
                              [else              (raise-exn exn:fail:snooze (format "Cannot parse ~a: ~s" type data))])])))
             
             ;; iso-8601-regexp-1 : pregexp
             ;;
             ;; Matches the yy-mm-dd hh:mm:ss part of a timestamp string.
             (define iso-8601-regexp-1 (pregexp "^([0-9]{4})-([0-9]{2})-([0-9]{2})[ T]([0-9]{2}):([0-9]{2}):([0-9]{2})"))
             
             ;; iso-8601-regexp-2 : pregexp
             ;;
             ;; Matches the nanoseconds part of a timestamp string.
             (define iso-8601-regexp-2 (pregexp "\\.([0-9]{1,9})$"))
             
             ;; unquote-time-tai : string -> time
             (define (unquote-time-tai data)
               (let ([matches1 (pregexp-match iso-8601-regexp-1 data)]
                     [matches2 (pregexp-match iso-8601-regexp-2 data)])
                 (if matches1
                     (date->time-tai (apply make-srfi:date
                                            (append 
                                             ; Nanosecond
                                             (if matches2
                                                 (list (string->number (string-pad-right (cadr matches2) 9 #\0)))
                                                 (list 0))
                                             ; Second minute hour day month year
                                             (map string->number (reverse (cdr matches1)))
                                             ; Timezone-offset
                                             (list 0))))
                     (raise-exn exn:fail:snooze
                       (format "Expected ISO 8601 formatted string, received ~a" data)))))
             
             ;; make-data-unquoter
             ;;     : (list-of type)
             ;;    -> ((U (vector-of (U string #f)) #f) -> (U (vector-of scheme-primitive) #f))
             ;;
             ;; Creates a procedure that "unquotes" (parses) a vector of data retrieved from a database.
             (define (make-data-unquoter types)
               (let ([types (list->vector types)])
                 (lambda (source)
                   (if source
                       (vector-map (lambda (index type val)
                                     (unquote-data type val))
                                   types
                                   source)
                       #f))))
             
             )])
      
      (compound-unit/sig
        (import)
        (link (original  : sql-quote^ (generic:sql-quote@))
              (variation : sql-quote^ (mixin@ original)))
        (export (open variation)))))
  
  )