diff --git a/typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl b/typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl index 2bbebbc4..1f175e16 100644 --- a/typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl +++ b/typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl @@ -202,6 +202,9 @@ and the @racket[URL] and @racket[Path/Param] types from @defmodule/incl[typed/syntax/stx] @defmodule/incl[typed/web-server/configuration/responders] @defmodule/incl[typed/web-server/http] +@defmodule/incl[typed/db] +@defmodule/incl[typed/db/base] +@defmodule/incl[typed/db/splite3] In some cases, these typed adapters may not contain all of exports of the original module, or their types may be more limited. diff --git a/typed-racket-more/info.rkt b/typed-racket-more/info.rkt index f2b2ccef..073904e5 100644 --- a/typed-racket-more/info.rkt +++ b/typed-racket-more/info.rkt @@ -6,6 +6,7 @@ "base" "net-lib" "web-server-lib" + "db-lib" "draw-lib" "rackunit-lib" "rackunit-gui" diff --git a/typed-racket-more/typed/db.rkt b/typed-racket-more/typed/db.rkt new file mode 100644 index 00000000..b77500e4 --- /dev/null +++ b/typed-racket-more/typed/db.rkt @@ -0,0 +1,10 @@ +#lang typed/racket + +(define-syntax (require/provide stx) + (syntax-case stx [] + [(_ db.rkt ...) + #'(begin (provide (all-from-out db.rkt)) ... + (require db.rkt) ...)])) + +(require/provide "db/base.rkt" + "db/sqlite3.rkt") diff --git a/typed-racket-more/typed/db/base.rkt b/typed-racket-more/typed/db/base.rkt new file mode 100644 index 00000000..f8be5e47 --- /dev/null +++ b/typed-racket-more/typed/db/base.rkt @@ -0,0 +1,141 @@ +#lang typed/racket + +(provide (all-defined-out)) + +(require (for-syntax racket/syntax)) + +(define-type Data-Source data-source) +(define-type Simple-Result simple-result) +(define-type Rows-Result rows-result) + +(define-type Null-Mode (U 'preserve-null 'list)) +(define-type Isolation-Level (U 'serializable 'repeatable-read 'read-committed 'read-uncommitted False)) +(define-type Schema-Option (U 'search-or-current 'search 'current)) + +(define-type SQL-Datum Any) +(define-type SQL-Type (List Boolean (Option Symbol) SQL-Datum)) +(define-type Statement (U String Prepared-Statement Virtual-Statement Statement-Binding)) + +(define-type SQL-Field (U String Natural)) +(define-type SQL-Grouping (U SQL-Field (Vectorof SQL-Field))) +(define-type SQL-Group (U SQL-Grouping (Vectorof SQL-Grouping))) + +(require/typed/provide + db/base + [#:opaque SQL-Null sql-null?] + [sql-null SQL-Null] + [sql-null->false (-> (U SQL-Null Any) Any)] + [false->sql-null (-> Any (U SQL-Null Any))]) + +(require/typed/provide + db/base + [#:opaque Connection connection?] + [#:opaque DBSystem dbsystem?] + [#:opaque Connection-Pool connection-pool?] + [#:struct data-source ([connector : Symbol] + [args : (Listof Any)] + [extensions : (Listof (List Symbol Any))])] + [#:struct (exn:fail:sql exn:fail) ([sqlstate : (U String Symbol)] + [info : (Listof (Pairof Symbol Any))]) + #:extra-constructor-name make-exn:fail:sql] + [disconnect (-> Connection Void)] + [connected? (-> Connection Boolean)] + [connection-dbsystem (-> Connection DBSystem)] + [dbsystem-name (-> DBSystem Symbol)] + [dbsystem-supported-types (-> DBSystem (Listof Symbol))] + [list-tables (-> Connection [#:schema Schema-Option] (Listof String))] + [table-exists? (-> Connection String [#:schema Schema-Option] [#:case-sensitive? Any] Boolean)] + [current-dsn-file (Parameterof Path-String)] + [get-dsn (All (a) (->* (Symbol) ((U a (-> a)) #:dsn-file Path-String) (U Data-Source a)))] + [put-dsn (-> Symbol (Option Data-Source) [#:dsn-file Path-String] Void)] + [kill-safe-connection (-> Connection Connection)] + [virtual-connection (-> (U (-> Connection) Connection-Pool) Connection)] + [connection-pool-lease (->* (Connection-Pool) ((U (Evtof Any) Custodian)) Connection)] + [connection-pool (-> (-> Connection) + [#:max-connections (U Positive-Index +inf.0)] + [#:max-idle-connections (U Positive-Index +inf.0)] + Connection-Pool)]) + +(require/typed/provide + db/base + [query-exec (-> Connection Statement SQL-Datum * Void)] + [query-list (All (a) (-> Connection Statement SQL-Datum * (Listof a)))] + [query-row (-> Connection Statement SQL-Datum * (Vectorof SQL-Datum))] + [query-maybe-row (-> Connection Statement SQL-Datum * (Option (Vectorof SQL-Datum)))] + [query-value (-> Connection Statement SQL-Datum * SQL-Datum)] + [query-maybe-value (-> Connection Statement SQL-Datum * (Option SQL-Datum))] + [query-rows (-> Connection Statement + [#:group SQL-Group] + [#:group-mode (Listof Null-Mode)] + SQL-Datum * + (Listof (Vectorof SQL-Datum)))] + [in-query (-> Connection Statement + [#:fetch (U Positive-Integer +inf.0)] + [#:group SQL-Group] + [#:group-mode (Listof Null-Mode)] + SQL-Datum * + (Sequenceof (Vectorof SQL-Datum)))]) + +(require/typed/provide + db/base + [#:struct simple-result ([info : (Listof (Pairof Symbol SQL-Datum))])] + [#:struct rows-result ([headers : (Listof Any)] [rows : (Listof (Vectorof SQL-Datum))])] + [query (-> Connection Statement SQL-Datum * (U Simple-Result Rows-Result))] + [group-rows (->* (Rows-Result #:group SQL-Group) + (#:group-mode (Listof Null-Mode)) + Rows-Result)] + [rows->dict (->* (Rows-Result + #:key SQL-Field ; if Grouping/c: required a flat contract but got a chaperone one + #:value SQL-Grouping) + (#:value-mode (Listof Null-Mode)) + (HashTable (U SQL-Field SQL-Null) SQL-Grouping))]) + +(require/typed/provide + db/base + [#:opaque Prepared-Statement prepared-statement?] + [#:opaque Virtual-Statement virtual-statement?] + [#:opaque Statement-Binding statement-binding?] + [prepare (-> Connection (U String Virtual-Statement) Prepared-Statement)] + [prepared-statement-parameter-types (-> Prepared-Statement (Listof SQL-Type))] + [prepared-statement-result-types (-> Prepared-Statement (Listof SQL-Type))] + [bind-prepared-statement (-> Prepared-Statement (Listof SQL-Datum) Statement-Binding)] + [virtual-statement (-> (U String (-> DBSystem String)) Virtual-Statement)]) + +(define statement? : (-> Any Boolean : Statement) + (lambda [s] + (or (string? s) + (prepared-statement? s) + (statement-binding? s) + (virtual-statement? s)))) + +(require/typed/provide + db/base + [start-transaction (-> Connection [#:isolation Isolation-Level] [#:option (Option Symbol)] Void)] + [commit-transaction (-> Connection Void)] + [rollback-transaction (-> Connection Void)] + [in-transaction? (-> Connection Boolean)] + [needs-rollback? (-> Connection Boolean)] + [call-with-transaction (All (a) (-> Connection (-> a) + [#:isolation Isolation-Level] + [#:option (Option Symbol)] + a))]) + +(define-syntax (require/db/provide stx) + (syntax-case stx [->*] + [(_ (->* (mandatory-dom ...) (optional-dom ...) connector)) + (with-syntax ([db/module (format-id #'connector "db/~a" (syntax-e #'connector))] + [db-connect (format-id #'connector "~a-connect" (syntax-e #'connector))] + [db-data-source (format-id #'connector "~a-data-source" (syntax-e #'connector))]) + #'(begin (require/typed/provide db/module + [db-connect (->* (mandatory-dom ...) + (optional-dom ...) + Connection)]) + + (require/typed/provide db/base + [db-data-source (->* () + (mandatory-dom ... optional-dom ...) + Data-Source)])))])) + +(require/typed/provide + db/util/testing + [high-latency-connection (-> Connection Nonnegative-Real [#:sleep-atomic? Any] Connection)]) diff --git a/typed-racket-more/typed/db/sqlite3.rkt b/typed-racket-more/typed/db/sqlite3.rkt new file mode 100644 index 00000000..38fec8a0 --- /dev/null +++ b/typed-racket-more/typed/db/sqlite3.rkt @@ -0,0 +1,17 @@ +#lang typed/racket + +(provide (all-defined-out)) + +(require "base.rkt") + +(define-type SQLite3-Database-Storage (U Path-String 'memory 'temporary)) +(define-type SQLite3-Connection-Mode (U 'read-only 'read/write 'create)) + +(require/typed/provide db/sqlite3 [sqlite3-available? (-> Boolean)]) + +(require/db/provide (->* (#:database SQLite3-Database-Storage) + (#:mode SQLite3-Connection-Mode + #:busy-retry-limit (U Natural +inf.0) + #:busy-retry-delay Nonnegative-Real + #:use-place Boolean) + sqlite3))