;; Copyright 2011 Ryan Culpepper
;; Released under the terms of the LGPL version 3 or later.
;; See the file COPYRIGHT for details.

#lang racket/base
(require (for-syntax racket/base)
         racket/runtime-path
         racket/promise
         racket/contract
         "base.rkt")
(provide (all-from-out "base.rkt"))

;; Lazy instantiation

(define-syntax-rule (define-lazy-functions modpath fun ...)
  (begin (define-runtime-module-path-index mpi modpath)
         (deflazyfun mpi fun) ...))
(define-syntax-rule (deflazyfun mpi fun)
  ;; Use delay/sync because delay promise is not reentrant.
  ;; FIXME: delay/sync promise is probably not kill-safe, though
  (begin (define fun-p (delay/sync (dynamic-require mpi 'fun)))
         (define fun
           (wrap-kw-fun
            (make-keyword-procedure
             (lambda (kws kwargs . args)
               (keyword-apply (force fun-p) kws kwargs args)))))))

;; Note: bug in contracts applied to result of make-keyword-procedure
;; Workaround: reduce kw-arity to known kws

(define known-keywords
  (sort '(#:user #:database #:password #:server #:port #:socket
          #:allow-cleartext-password? #:ssl #:ssl-context
          #:notice-handler #:notification-handler
          #:mode #:busy-retry-limit #:busy-retry-delay
          #:dsn #:strict-parameter-types? #:character-mode)
        keyword<?))

(define (wrap-kw-fun proc)
  (procedure-reduce-keyword-arity
   proc (procedure-arity proc) '() known-keywords))

;; ----

(define-lazy-functions "private/postgresql/main.rkt"
  postgresql-connect
  postgresql-guess-socket-path
  postgresql-password-hash)

(define-lazy-functions "private/mysql/main.rkt"
  mysql-connect
  mysql-guess-socket-path
  mysql-password-hash)

(define-lazy-functions "private/sqlite3/main.rkt"
  sqlite3-connect)

(define-lazy-functions "private/odbc/main.rkt"
  odbc-connect
  odbc-driver-connect
  odbc-data-sources
  odbc-drivers)

(define-lazy-functions 'openssl
  ssl-client-context?)

(provide/contract
 ;; Duplicates contracts at postgresql.rkt
 [postgresql-connect
  (->* (#:user string?
        #:database string?)
       (#:password (or/c string? (list/c 'hash string?) #f)
        #:server (or/c string? #f)
        #:port (or/c exact-positive-integer? #f)
        #:socket (or/c path-string? 'guess #f)
        #:allow-cleartext-password? boolean?
        #:ssl (or/c 'yes 'no 'optional)
        #:ssl-context ssl-client-context?
        #:notice-handler (or/c 'output 'error output-port? procedure?)
        #:notification-handler (or/c 'output 'error output-port? procedure?))
       any/c)]
 [postgresql-guess-socket-path
  (-> path-string?)]
 [postgresql-password-hash
  (-> string? string? string?)]

 ;; Duplicates contracts at mysql.rkt
 [mysql-connect
  (->* (#:user string?
        #:database string?)
       (#:password (or/c string? (list/c 'hash string?) #f)
        #:server (or/c string? #f)
        #:port (or/c exact-positive-integer? #f)
        #:socket (or/c path-string? 'guess #f)
        #:notice-handler (or/c 'output 'error output-port? procedure?))
       any/c)]
 [mysql-guess-socket-path
  (-> path-string?)]
 [mysql-password-hash
  (-> string? string?)]

 ;; Duplicates contracts at sqlite3.rkt
 [sqlite3-connect
  (->* (#:database (or/c path-string? 'memory 'temporary))
       (#:mode (or/c 'read-only 'read/write 'create)
        #:busy-retry-limit (or/c exact-nonnegative-integer? +inf.0)
        #:busy-retry-delay (and/c rational? (not/c negative?)))
       any/c)]

 ;; Duplicates contracts at odbc.rkt
 [odbc-connect
  (->* ()
       (#:dsn (or/c string? #f)
        #:database (or/c string? #f)
        #:user (or/c string? #f)
        #:password (or/c string? #f)
        #:notice-handler (or/c 'output 'error output-port? procedure?)
        #:strict-parameter-types? boolean?
        #:character-mode (or/c 'wchar 'utf-8 'latin-1))
       connection?)]
 [odbc-driver-connect
  (->* (string?)
       (#:notice-handler (or/c 'output 'error output-port? procedure?)
        #:strict-parameter-types? boolean?
        #:character-mode (or/c 'wchar 'utf-8 'latin-1))
       connection?)]
 [odbc-data-sources
  (-> (listof (list/c string? string?)))]
 [odbc-drivers
  (-> (listof (cons/c string? any/c)))])