suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add support for db/base and db/sqlite3 (#419)

Browse Source
This commit is contained in:
WarGrey Gyoudmon Ju 2016-09-02 00:04:36 +08:00 committed by Sam Tobin-Hochstadt
parent dfd61642b6
commit abdc0e8ebc
5 changed files with 172 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl
View File

@ -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.

1
typed-racket-more/info.rkt
View File

@ -6,6 +6,7 @@
"base"
"net-lib"
"web-server-lib"
"db-lib"
"draw-lib"
"rackunit-lib"
"rackunit-gui"

10
typed-racket-more/typed/db.rkt Normal file
View File

@ -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")

141
typed-racket-more/typed/db/base.rkt Normal file
View File

@ -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)])

17
typed-racket-more/typed/db/sqlite3.rkt Normal file
View File

@ -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))