db: moved private contracts to db/base, removed useless requires

This commit is contained in:
Ryan Culpepper 2011-08-31 02:12:40 -06:00
parent 8611435269
commit a5bda8e0cd
19 changed files with 289 additions and 313 deletions

View File

@ -1,4 +1,3 @@
internal docs
----
Testing
@ -31,11 +30,11 @@ Types
Misc
- internal docs
- use ffi/unsafe/alloc to simplify odbc handle allocation
- add ODBC-like functions for inspecting schemas (list-tables, etc)
- util/schema (?), util/info (for information_schema) (?)
- at least, table-exists? : string [...] -> boolean?
- for wrapped/managed connections, detect if underlying connection gets
disconnected by server (eg, times out after 10 minutes of inactivity)

View File

@ -1,9 +1,248 @@
#lang racket/base
(require racket/contract
"private/generic/main.rkt"
"private/generic/connect-util.rkt"
"private/generic/dsn.rkt")
unstable/prop-contract)
(provide (all-from-out "private/generic/main.rkt")
(all-from-out "private/generic/dsn.rkt")
(all-from-out "private/generic/connect-util.rkt"))
;; ============================================================
(require "private/generic/interfaces.rkt"
"private/generic/sql-data.rkt")
(provide (struct-out simple-result)
(struct-out rows-result)
statement-binding?)
(provide sql-null
sql-null?
sql-null->false
false->sql-null)
(provide/contract
[struct sql-date ([year exact-integer?]
[month (integer-in 0 12)]
[day (integer-in 0 31)])]
[struct sql-time ([hour (integer-in 0 23)]
[minute (integer-in 0 59)]
[second (integer-in 0 61)] ;; leap seconds
[nanosecond (integer-in 0 (sub1 #e1e9))]
[tz (or/c #f exact-integer?)])]
[struct sql-timestamp ([year exact-integer?]
[month (integer-in 0 12)]
[day (integer-in 0 31)]
[hour (integer-in 0 23)]
[minute (integer-in 0 59)]
[second (integer-in 0 61)]
[nanosecond (integer-in 0 (sub1 #e1e9))]
[tz (or/c #f exact-integer?)])]
[struct sql-interval ([years exact-integer?]
[months exact-integer?]
[days exact-integer?]
[hours exact-integer?]
[minutes exact-integer?]
[seconds exact-integer?]
[nanoseconds exact-integer?])]
[sql-day-time-interval?
(-> any/c boolean?)]
[sql-year-month-interval?
(-> any/c boolean?)]
[sql-interval->sql-time
(->* (sql-interval?) (any/c)
any)]
[sql-time->sql-interval
(-> sql-time? sql-day-time-interval?)]
[make-sql-bits
(-> exact-nonnegative-integer? sql-bits?)]
[sql-bits?
(-> any/c boolean?)]
[sql-bits-length
(-> sql-bits? exact-nonnegative-integer?)]
[sql-bits-ref
(-> sql-bits? exact-nonnegative-integer? boolean?)]
[sql-bits-set!
(-> sql-bits? exact-nonnegative-integer? boolean? void?)]
[sql-bits->list
(-> sql-bits? (listof boolean?))]
[list->sql-bits
(-> (listof boolean?) sql-bits?)]
[sql-bits->string
(-> sql-bits? string?)]
[string->sql-bits
(-> string? sql-bits?)])
;; ============================================================
(require "private/generic/functions.rkt")
(provide (rename-out [in-query* in-query]))
(provide/contract
[connection?
(-> any/c any)]
[disconnect
(-> connection? any)]
[connected?
(-> connection? any)]
[connection-dbsystem
(-> connection? dbsystem?)]
[dbsystem?
(-> any/c any)]
[dbsystem-name
(-> dbsystem? symbol?)]
[dbsystem-supported-types
(-> dbsystem? (listof symbol?))]
[statement?
(-> any/c any)]
[prepared-statement?
(-> any/c any)]
[prepared-statement-parameter-types
(-> prepared-statement? (or/c list? #f))]
[prepared-statement-result-types
(-> prepared-statement? (or/c list? #f))]
[query-exec
(->* (connection? statement?) () #:rest list? any)]
[query-rows
(->* (connection? statement?) () #:rest list? (listof vector?))]
[query-list
(->* (connection? statement?) () #:rest list? list?)]
[query-row
(->* (connection? statement?) () #:rest list? vector?)]
[query-maybe-row
(->* (connection? statement?) () #:rest list? (or/c #f vector?))]
[query-value
(->* (connection? statement?) () #:rest list? any)]
[query-maybe-value
(->* (connection? statement?) () #:rest list? any)]
[query
(->* (connection? statement?) () #:rest list? any)]
[prepare
(-> connection? (or/c string? virtual-statement?) any)]
[bind-prepared-statement
(-> prepared-statement? list? any)]
[rename virtual-statement* virtual-statement
(-> (or/c string? (-> dbsystem? string?))
virtual-statement?)]
[virtual-statement?
(-> any/c boolean?)]
[start-transaction
(->* (connection?)
(#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
void?)]
[commit-transaction
(-> connection? void?)]
[rollback-transaction
(-> connection? void?)]
[in-transaction?
(-> connection? boolean?)]
[needs-rollback?
(-> connection? boolean?)]
[call-with-transaction
(->* (connection? (-> any))
(#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
void?)]
[prop:statement
(struct-type-property/c
(-> any/c connection?
statement?))]
[list-tables
(->* (connection?)
(#:schema (or/c 'search-or-current 'search 'current))
(listof string?))]
[table-exists?
(->* (connection? string?)
(#:schema (or/c 'search-or-current 'search 'current)
#:case-sensitive? any/c)
boolean?)]
[group-rows
(->* (rows-result?
#:group (or/c (vectorof string?) (listof (vectorof string?))))
(#:group-mode (listof (or/c 'preserve-null-rows 'list)))
rows-result?)])
;; ============================================================
(require "private/generic/connect-util.rkt")
(provide/contract
[kill-safe-connection
(-> connection? connection?)]
[virtual-connection
(->* ((or/c (-> connection?) connection-pool?))
()
connection?)]
[connection-pool
(->* ((-> connection?))
(#:max-connections (or/c (integer-in 1 10000) +inf.0)
#:max-idle-connections (or/c (integer-in 1 10000) +inf.0))
connection-pool?)]
[connection-pool?
(-> any/c boolean?)]
[connection-pool-lease
(->* (connection-pool?)
((or/c custodian? evt?))
connection?)])
;; ============================================================
(require "private/generic/dsn.rkt")
(provide dsn-connect) ;; can't express "or any kw at all" w/ ->* contract
(provide/contract
[struct data-source
([connector connector?]
[args arglist?]
[extensions (listof (list/c symbol? writable-datum?))])]
[current-dsn-file (parameter/c path-string?)]
[get-dsn
(->* (symbol?) (any/c #:dsn-file path-string?) any)]
[put-dsn
(->* (symbol? (or/c data-source? #f)) (#:dsn-file path-string?) void?)]
[postgresql-data-source
(->* ()
(#:user string?
#:database string?
#:server string?
#:port exact-positive-integer?
#:socket (or/c string? 'guess)
#:password (or/c string? #f)
#:allow-cleartext-password? boolean?
#:ssl (or/c 'yes 'optional 'no)
#:notice-handler (or/c 'output 'error)
#:notification-handler (or/c 'output 'error))
data-source?)]
[mysql-data-source
(->* ()
(#:user string?
#:database string?
#:server string?
#:port exact-positive-integer?
#:socket (or/c string? 'guess)
#:password (or/c string? #f)
#:notice-handler (or/c 'output 'error))
data-source?)]
[sqlite3-data-source
(->* ()
(#:database (or/c 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?))
#:use-place boolean?)
data-source?)]
[odbc-data-source
(->* ()
(#:dsn string?
#:user string?
#:password string?
#:notice-handler (or/c 'output 'error)
#:strict-parameter-types? boolean?
#:character-mode (or/c 'wchar 'utf-8 'latin-1)
#:use-place boolean?)
data-source?)])

View File

@ -2,7 +2,6 @@
(require (for-syntax racket/base)
"private/generic/lazy-require.rkt"
racket/runtime-path
racket/promise
racket/contract
"base.rkt")
(provide (all-from-out "base.rkt"))
@ -49,7 +48,7 @@
#: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)]
connection?)]
[postgresql-guess-socket-path
(-> path-string?)]
[postgresql-password-hash
@ -64,7 +63,7 @@
#: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)]
connection?)]
[mysql-guess-socket-path
(-> path-string?)]
[mysql-password-hash
@ -77,7 +76,7 @@
#:busy-retry-limit (or/c exact-nonnegative-integer? +inf.0)
#:busy-retry-delay (and/c rational? (not/c negative?))
#:use-place boolean?)
any/c)]
connection?)]
;; Duplicates contracts at odbc.rkt
[odbc-connect

View File

@ -13,7 +13,7 @@
#: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)]
connection?)]
[mysql-guess-socket-path
(-> path-string?)]
[mysql-password-hash

View File

@ -18,7 +18,7 @@
#: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)]
connection?)]
[postgresql-guess-socket-path
(-> path-string?)]
[postgresql-password-hash

View File

@ -1,8 +1,11 @@
#lang racket/base
(require racket/contract
racket/class
"interfaces.rkt"
(only-in "functions.rkt" connection?))
(require racket/class
"interfaces.rkt")
(provide kill-safe-connection
virtual-connection
connection-pool
connection-pool?
connection-pool-lease)
;; manager% implements kill-safe manager thread w/ request channel
(define manager%
@ -376,24 +379,3 @@
(uerror 'connection-pool-lease
"cannot obtain connection; connection pool limit reached"))
result))
;; ========================================
(provide/contract
[kill-safe-connection
(-> connection? connection?)]
[virtual-connection
(->* ((or/c (-> connection?) connection-pool?))
()
connection?)]
[connection-pool
(->* ((-> connection?))
(#:max-connections (or/c (integer-in 1 10000) +inf.0)
#:max-idle-connections (or/c (integer-in 1 10000) +inf.0))
connection-pool?)]
[connection-pool?
(-> any/c boolean?)]
[connection-pool-lease
(->* (connection-pool?)
((or/c custodian? evt?))
connection?)])

View File

@ -1,12 +1,21 @@
#lang racket/base
(require "lazy-require.rkt"
racket/contract
racket/match
racket/file
racket/list
racket/runtime-path
racket/promise
"main.rkt")
racket/runtime-path)
(provide dsn-connect
(struct-out data-source)
connector?
arglist?
writable-datum?
current-dsn-file
get-dsn
put-dsn
postgresql-data-source
mysql-data-source
sqlite3-data-source
odbc-data-source)
(define-lazy-require-definer define-main "../../main.rkt")
@ -47,15 +56,15 @@ considered important.
(define none (gensym 'none))
(define (datum? x)
(define (writable-datum? x)
(or (symbol? x)
(string? x)
(number? x)
(boolean? x)
(null? x)
(and (pair? x)
(datum? (car x))
(datum? (cdr x)))))
(writable-datum? (car x))
(writable-datum? (cdr x)))))
(define (connector? x)
(memq x '(postgresql mysql sqlite3 odbc)))
@ -72,11 +81,11 @@ considered important.
(reverse kwargs))]
[(keyword? (car x))
(cond [(null? (cdr x)) (fail "keyword without argument: ~a" (car x))]
[(datum? (cadr x))
[(writable-datum? (cadr x))
(loop (cddr x) pargs (cons (list (car x) (cadr x)) kwargs))]
[else
(fail "expected readable datum: ~e" (cadr x))])]
[(datum? (car x))
[(writable-datum? (car x))
(loop (cdr x) (cons (car x) pargs) kwargs)]
[else (fail "expected readable datum: ~e" (car x))]))
(fail "expected list")))
@ -93,7 +102,7 @@ considered important.
(if (list? x)
(map (lambda (x)
(match x
[(list (? symbol? key) (? datum? value))
[(list (? symbol? key) (? writable-datum? value))
x]
[else (fail "expected extension entry: ~e" x)]))
x)
@ -195,56 +204,3 @@ considered important.
(mk-specialized 'odbc-data-source 'odbc 0
'(#:dsn #:user #:password #:notice-handler
#:strict-parameter-types? #:character-mode #:use-place)))
(provide/contract
[struct data-source
([connector connector?]
[args arglist?]
[extensions (listof (list/c symbol? datum?))])]
[dsn-connect procedure?] ;; Can't express "or any kw at all" w/ ->* contract.
[current-dsn-file (parameter/c path-string?)]
[get-dsn
(->* (symbol?) (any/c #:dsn-file path-string?) any)]
[put-dsn
(->* (symbol? (or/c data-source? #f)) (#:dsn-file path-string?) void?)]
[postgresql-data-source
(->* ()
(#:user string?
#:database string?
#:server string?
#:port exact-positive-integer?
#:socket (or/c string? 'guess)
#:password (or/c string? #f)
#:allow-cleartext-password? boolean?
#:ssl (or/c 'yes 'optional 'no)
#:notice-handler (or/c 'output 'error)
#:notification-handler (or/c 'output 'error))
data-source?)]
[mysql-data-source
(->* ()
(#:user string?
#:database string?
#:server string?
#:port exact-positive-integer?
#:socket (or/c string? 'guess)
#:password (or/c string? #f)
#:notice-handler (or/c 'output 'error))
data-source?)]
[sqlite3-data-source
(->* ()
(#:database (or/c 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?))
#:use-place boolean?)
data-source?)]
[odbc-data-source
(->* ()
(#:dsn string?
#:user string?
#:password string?
#:notice-handler (or/c 'output 'error)
#:strict-parameter-types? boolean?
#:character-mode (or/c 'wchar 'utf-8 'latin-1)
#:use-place boolean?)
data-source?)])

View File

@ -1,11 +1,10 @@
#lang racket/base
(require (for-syntax racket/base)
racket/contract
racket/vector
unstable/prop-contract
racket/class
"interfaces.rkt"
(only-in "sql-data.rkt" sql-null sql-null?))
(provide (all-defined-out))
;; == Administrative procedures
@ -42,9 +41,6 @@
(statement-binding? x)
(prop:statement? x)))
(define complete-statement?
(or/c string? statement-binding?))
(define (bind-prepared-statement pst params)
(send pst bind 'bind-prepared-statement params))
@ -304,110 +300,6 @@
;; list-tables* : ... -> (listof vector)
;; Return full catalog/schema/table/type list.
;; ========================================
(define preparable/c (or/c string? virtual-statement?))
(provide (rename-out [in-query* in-query]))
(provide/contract
[connection?
(-> any/c any)]
[disconnect
(-> connection? any)]
[connected?
(-> connection? any)]
[connection-dbsystem
(-> connection? dbsystem?)]
[dbsystem?
(-> any/c any)]
[dbsystem-name
(-> dbsystem? symbol?)]
[dbsystem-supported-types
(-> dbsystem? (listof symbol?))]
[statement?
(-> any/c any)]
[prepared-statement?
(-> any/c any)]
[prepared-statement-parameter-types
(-> prepared-statement? (or/c list? #f))]
[prepared-statement-result-types
(-> prepared-statement? (or/c list? #f))]
[query-exec
(->* (connection? statement?) () #:rest list? any)]
[query-rows
(->* (connection? statement?) () #:rest list? (listof vector?))]
[query-list
(->* (connection? statement?) () #:rest list? list?)]
[query-row
(->* (connection? statement?) () #:rest list? vector?)]
[query-maybe-row
(->* (connection? statement?) () #:rest list? (or/c #f vector?))]
[query-value
(->* (connection? statement?) () #:rest list? any)]
[query-maybe-value
(->* (connection? statement?) () #:rest list? any)]
[query
(->* (connection? statement?) () #:rest list? any)]
#|
[in-query
(->* (connection? statement?) () #:rest list? sequence?)]
|#
[prepare
(-> connection? preparable/c any)]
[bind-prepared-statement
(-> prepared-statement? list? any)]
[rename virtual-statement* virtual-statement
(-> (or/c string? (-> dbsystem? string?))
virtual-statement?)]
[virtual-statement?
(-> any/c boolean?)]
[start-transaction
(->* (connection?)
(#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
void?)]
[commit-transaction
(-> connection? void?)]
[rollback-transaction
(-> connection? void?)]
[in-transaction?
(-> connection? boolean?)]
[needs-rollback?
(-> connection? boolean?)]
[call-with-transaction
(->* (connection? (-> any))
(#:isolation (or/c 'serializable 'repeatable-read 'read-committed 'read-uncommitted #f))
void?)]
[prop:statement
(struct-type-property/c
(-> any/c connection?
statement?))]
[list-tables
(->* (connection?)
(#:schema (or/c 'search-or-current 'search 'current))
(listof string?))]
[table-exists?
(->* (connection? string?)
(#:schema (or/c 'search-or-current 'search 'current)
#:case-sensitive? any/c)
boolean?)]
#|
[get-schemas
(-> connection? (listof vector?))]
[get-tables
(-> connection? (listof vector?))]
|#)
;; ========================================
(define (group-rows result
@ -553,10 +445,3 @@
invert-outer?
as-list?)])
(vector-append key (vector residuals))))))]))
(provide/contract
[group-rows
(->* (rows-result?
#:group (or/c (vectorof string?) (listof (vectorof string?))))
(#:group-mode (listof (or/c 'preserve-null-rows 'list)))
rows-result?)])

View File

@ -1,68 +0,0 @@
#lang racket/base
(require racket/contract
"interfaces.rkt"
"sql-data.rkt"
"functions.rkt")
(provide (struct-out simple-result)
(struct-out rows-result)
statement-binding?
(all-from-out "functions.rkt"))
(provide sql-null
sql-null?
sql-null->false
false->sql-null)
(provide/contract
[struct sql-date ([year exact-integer?]
[month (integer-in 0 12)]
[day (integer-in 0 31)])]
[struct sql-time ([hour (integer-in 0 23)]
[minute (integer-in 0 59)]
[second (integer-in 0 61)] ;; leap seconds
[nanosecond (integer-in 0 (sub1 #e1e9))]
[tz (or/c #f exact-integer?)])]
[struct sql-timestamp ([year exact-integer?]
[month (integer-in 0 12)]
[day (integer-in 0 31)]
[hour (integer-in 0 23)]
[minute (integer-in 0 59)]
[second (integer-in 0 61)]
[nanosecond (integer-in 0 (sub1 #e1e9))]
[tz (or/c #f exact-integer?)])]
[struct sql-interval ([years exact-integer?]
[months exact-integer?]
[days exact-integer?]
[hours exact-integer?]
[minutes exact-integer?]
[seconds exact-integer?]
[nanoseconds exact-integer?])]
[sql-day-time-interval?
(-> any/c boolean?)]
[sql-year-month-interval?
(-> any/c boolean?)]
[sql-interval->sql-time
(->* (sql-interval?) (any/c)
any)]
[sql-time->sql-interval
(-> sql-time? sql-day-time-interval?)]
[make-sql-bits
(-> exact-nonnegative-integer? sql-bits?)]
[sql-bits?
(-> any/c boolean?)]
[sql-bits-length
(-> sql-bits? exact-nonnegative-integer?)]
[sql-bits-ref
(-> sql-bits? exact-nonnegative-integer? boolean?)]
[sql-bits-set!
(-> sql-bits? exact-nonnegative-integer? boolean? void?)]
[sql-bits->list
(-> sql-bits? (listof boolean?))]
[list->sql-bits
(-> (listof boolean?) sql-bits?)]
[sql-bits->string
(-> sql-bits? string?)]
[string->sql-bits
(-> string? sql-bits?)])

View File

@ -1,5 +1,4 @@
#lang racket/base
(require "sql-data.rkt")
;; ========================================

View File

@ -1,16 +1,13 @@
#lang racket/base
(require racket/contract
racket/class
(require racket/class
racket/tcp
file/sha1
"../generic/interfaces.rkt"
"../generic/socket.rkt"
"connection.rkt"
"dbsystem.rkt")
"connection.rkt")
(provide mysql-connect
mysql-guess-socket-path
mysql-password-hash
(rename-out [dbsystem mysql-dbsystem]))
mysql-password-hash)
(define (mysql-connect #:user user
#:database database

View File

@ -1,11 +1,8 @@
#lang racket/base
(require racket/class
ffi/unsafe
ffi/unsafe/atomic
"../generic/interfaces.rkt"
"../generic/sql-data.rkt"
"../generic/sql-convert.rkt"
"ffi.rkt")
"../generic/sql-convert.rkt")
(provide dbsystem
supported-typeid?)

View File

@ -1,6 +1,5 @@
#lang racket/base
(require (rename-in racket/contract [-> c->])
ffi/unsafe
(require ffi/unsafe
ffi/unsafe/define
"ffi-constants.rkt")
(provide (all-from-out "ffi-constants.rkt"))

View File

@ -1,6 +1,5 @@
#lang racket/base
(require racket/class
racket/contract
"../generic/interfaces.rkt"
"../generic/place-client.rkt"
"connection.rkt"

View File

@ -1,16 +1,13 @@
#lang racket/base
(require racket/class
racket/contract
racket/tcp
openssl
"../generic/interfaces.rkt"
"../generic/socket.rkt"
"connection.rkt"
"dbsystem.rkt")
"connection.rkt")
(provide postgresql-connect
postgresql-guess-socket-path
postgresql-password-hash
(rename-out [dbsystem postgresql-dbsystem]))
postgresql-password-hash)
(define (postgresql-connect #:user user
#:database database

View File

@ -1,8 +1,6 @@
#lang racket/base
(require racket/class
"../generic/interfaces.rkt"
"../generic/sql-data.rkt"
"ffi-constants.rkt")
"../generic/interfaces.rkt")
(provide dbsystem)
(define sqlite3-dbsystem%

View File

@ -1,7 +1,6 @@
#lang racket/base
(require scribble/manual
scribble/eval
racket/sandbox
(for-label racket/base
racket/contract))
(provide (all-defined-out)

View File

@ -11,4 +11,4 @@
#:busy-retry-limit (or/c exact-nonnegative-integer? +inf.0)
#:busy-retry-delay (and/c rational? (not/c negative?))
#:use-place any/c)
any/c)])
connection?)])

View File

@ -1,6 +1,5 @@
#lang racket/base
(require racket/contract
racket/list)
(require racket/list)
(provide (all-defined-out))
#|