diff --git a/collects/db/TODO b/collects/db/TODO index 90f19081af..b9af8c7f36 100644 --- a/collects/db/TODO +++ b/collects/db/TODO @@ -1,3 +1,4 @@ +internal docs ---- Testing diff --git a/collects/db/private/generic/main.rkt b/collects/db/private/generic/main.rkt index 2c93420e15..505209c3c1 100644 --- a/collects/db/private/generic/main.rkt +++ b/collects/db/private/generic/main.rkt @@ -1,14 +1,68 @@ #lang racket/base -(require "interfaces.rkt" +(require racket/contract + "interfaces.rkt" "sql-data.rkt" "functions.rkt") (provide (struct-out simple-result) (struct-out rows-result) statement-binding? - (except-out (all-from-out "sql-data.rkt") - make-sql-bits/bytes - sql-bits-bv - align-sql-bits - int8? int16? int24? int32? int64? - uint8?) (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?)]) diff --git a/collects/db/private/generic/sql-convert.rkt b/collects/db/private/generic/sql-convert.rkt index 00a08a8d7d..ac6eac4dc8 100644 --- a/collects/db/private/generic/sql-convert.rkt +++ b/collects/db/private/generic/sql-convert.rkt @@ -1,28 +1,10 @@ #lang racket/base -(require racket/match - (prefix-in srfi: srfi/19) - "sql-data.rkt") +(require "sql-data.rkt") -#| -parse- : string -> racket-datum +;; ======================================== -Takes the textual wire representation of as a string, and -produces the corresponding racket datum. - -No conversion may be passed sql-null. -|# - -(provide parse-char1 - parse-decimal - parse-date - parse-time - parse-time-tz - parse-timestamp - parse-timestamp-tz - parse-interval) - -(define (parse-char1 s) - (string-ref s 0)) +(provide parse-decimal ;; used by pg, mysql + parse-exact-fraction) ;; used by pg (define (parse-decimal s) (cond [(equal? s "NaN") +nan.0] @@ -34,102 +16,19 @@ No conversion may be passed sql-null. => (lambda (m) (+ (string->number (cadr m)) (parse-exact-fraction (caddr m))))] - [else (parse-error "numeric" s)])) + [else + (error 'parse-decimal "internal error: cannot parse ~s as decimal" s)])) (define (parse-exact-fraction s) ;; eg: (parse-exact-fraction "12") = 12/100 (/ (string->number s) (expt 10 (string-length s)))) -(define (parse-date d) - (srfi-date->sql-date - (srfi:string->date d "~Y-~m-~d"))) - -(define time/ns-rx #rx"^[0-9]*:[0-9]*:[0-9]*\\.([0-9]*)") -(define timestamp/ns-rx #rx"^.* [0-9]*:[0-9]*:[0-9]*\\.([0-9]*)") - -(define (ns-of t rx) - (let ([m (regexp-match rx t)]) - (if m - (* #e1e9 (parse-exact-fraction (cadr m))) - 0))) - -(define (parse-time t) - (srfi-date->sql-time - (srfi:string->date t "~k:~M:~S") - (ns-of t time/ns-rx))) - -(define (parse-time-tz t) - (srfi-date->sql-time-tz - (srfi:string->date t "~k:~M:~S~z") - (ns-of t time/ns-rx))) - -(define (parse-timestamp t) - (srfi-date->sql-timestamp - (srfi:string->date t "~Y-~m-~d ~k:~M:~S") - (ns-of t timestamp/ns-rx))) - -(define (parse-timestamp-tz t) - (srfi-date->sql-timestamp-tz - (srfi:string->date t "~Y-~m-~d ~k:~M:~S~z") - (ns-of t timestamp/ns-rx))) - -(define interval-rx - (regexp - (string-append "^" - "(?:(-?[0-9]*) years? *)?" - "(?:(-?[0-9]*) mons? *)?" - "(?:(-?[0-9]*) days? *)?" - "(?:(-?)([0-9]*):([0-9]*):([0-9]*)(?:\\.([0-9]*))?)?" - "$"))) - -(define (parse-interval s) - (define (to-num m) - (if m (string->number m) 0)) - (define match-result (regexp-match interval-rx s)) - (match match-result - [(list _whole years months days tsign hours mins secs fsec) - (let* ([years (to-num years)] - [months (to-num months)] - [days (to-num days)] - [sg (if (equal? tsign "-") - +)] - [hours (sg (to-num hours))] - [mins (sg (to-num mins))] - [secs (sg (to-num secs))] - [nsecs (if fsec - (let ([flen (string-length fsec)]) - (* (string->number (substring fsec 0 (min flen 9))) - (expt 10 (- 9 (min flen 9))))) - 0)]) - (sql-interval years months days hours mins secs nsecs))])) - - -;; ---------------------------------------- - -;; parse-error : string string -> (raises error) -(define (parse-error type rep) - (error 'query* "internal error: cannot parse as SQL type ~s: ~e" - type rep)) - ;; ======================================== -#| -marshal- : fsym index datum -> string - -Takes a racket datum and converts it into 's text wire format. -No conversion may be passed sql-null. -|# - -(provide marshal-decimal - marshal-date - marshal-time - marshal-time-tz - marshal-timestamp - marshal-timestamp-tz - marshal-interval - - exact->decimal-string - exact->scaled-integer) +(provide marshal-decimal ;; pg, odbc (?!) + exact->decimal-string ;; tests (?) + exact->scaled-integer) ;; odbc (define (marshal-decimal f i n) (cond [(not (real? n)) @@ -193,49 +92,9 @@ No conversion may be passed sql-null. (values n 0))) (loop n factor)) -(define (marshal-date f i d) - (unless (sql-date? d) - (marshal-error f i "date" d)) - (srfi:date->string (sql-datetime->srfi-date d) "~Y-~m-~d")) +;; ======================================== -(define (marshal-time f i t) - (unless (sql-time? t) - (marshal-error f i "time" t)) - (srfi:date->string (sql-datetime->srfi-date t) "~k:~M:~S.~N")) - -(define (marshal-time-tz f i t) - (unless (sql-time? t) - (marshal-error f i "time" t)) - (srfi:date->string (sql-datetime->srfi-date t) "~k:~M:~S.~N~z")) - -(define (marshal-timestamp f i t) - (unless (sql-timestamp? t) - (marshal-error f i "timestamp" t)) - (srfi:date->string (sql-datetime->srfi-date t) "~Y-~m-~d ~k:~M:~S.~N")) - -(define (marshal-timestamp-tz f i t) - (unless (sql-timestamp? t) - (marshal-error f i "timestamp" t)) - (srfi:date->string (sql-datetime->srfi-date t) "~Y-~m-~d ~k:~M:~S.~N~z")) - -(define (marshal-interval f i t) - (define (tag num unit) - (if (zero? num) "" (format "~a ~a " num unit))) - (match t - [(sql-interval years months days hours minutes seconds nanoseconds) - ;; Note: we take advantage of PostgreSQL's liberal interval parser - ;; and we acknowledge its micro-second precision. - (string-append (tag years "years") - (tag months "months") - (tag days "days") - (tag hours "hours") - (tag minutes "minutes") - (tag seconds "seconds") - (tag (quotient nanoseconds 1000) "microseconds"))] - [else - (marshal-error f i "interval" t)])) - -;; ---------------------------------------- +(provide marshal-error) ;; marshal-error : string datum -> (raises error) (define (marshal-error f i type datum) diff --git a/collects/db/private/generic/sql-data.rkt b/collects/db/private/generic/sql-data.rkt index 28f2d9caab..6336173377 100644 --- a/collects/db/private/generic/sql-data.rkt +++ b/collects/db/private/generic/sql-data.rkt @@ -1,11 +1,13 @@ #lang racket/base -(require racket/contract - racket/match - (prefix-in srfi: srfi/19)) +(provide (all-defined-out)) ;; SQL Data ;; Datatypes for things that have no appropriate corresponding Scheme datatype +;; ---------------------------------------- + +;; NULL + (define sql-null (let () (define-struct sql-null ()) @@ -24,10 +26,11 @@ sql-null x)) -;; ---- +;; ---------------------------------------- + +;; Dates and times #| - ** problems with Racket date: - fields in wrong order @@ -39,7 +42,6 @@ - fields in wrong order - timezone offset too limited - |# (define-struct sql-date (year month day) #:transparent) @@ -74,55 +76,6 @@ ;; ---- -(define (sql-datetime->srfi-date datetime) - (match datetime - [(struct sql-date (year month day)) - (srfi:make-date 0 0 0 0 day month year 0)] - [(struct sql-time (hour minute second nanosecond tz)) - (srfi:make-date nanosecond second minute hour 0 0 0 (or tz 0))] - [(struct sql-timestamp (year month day hour minute second nanosecond tz)) - (srfi:make-date nanosecond second minute hour day month year (or tz 0))] - [else - (raise-type-error 'sql-datetime->srfi-date - "sql-date, sql-time, or sql-timestamp" - datetime)])) - -(define (srfi-date->sql-date date) - (make-sql-date (srfi:date-year date) - (srfi:date-month date) - (srfi:date-day date))) - -(define (srfi-date->sql-time* date tz? ns) - (make-sql-time (srfi:date-hour date) - (srfi:date-minute date) - (srfi:date-second date) - (or ns (srfi:date-nanosecond date)) - (and tz? (srfi:date-zone-offset date)))) - -(define (srfi-date->sql-time date [ns #f]) - (srfi-date->sql-time* date #f ns)) - -(define (srfi-date->sql-time-tz date [ns #f]) - (srfi-date->sql-time* date #t ns)) - -(define (srfi-date->sql-timestamp* date tz? ns) - (make-sql-timestamp (srfi:date-year date) - (srfi:date-month date) - (srfi:date-day date) - (srfi:date-hour date) - (srfi:date-minute date) - (srfi:date-second date) - (or ns (srfi:date-nanosecond date)) - (and tz? (srfi:date-zone-offset date)))) - -(define (srfi-date->sql-timestamp date [ns #f]) - (srfi-date->sql-timestamp* date #f ns)) - -(define (srfi-date->sql-timestamp-tz date [ns #f]) - (srfi-date->sql-timestamp* date #t ns)) - -;; ---- - (define (sql-day-time-interval? x) (and (sql-interval? x) (zero? (sql-interval-years x)) @@ -136,17 +89,6 @@ (zero? (sql-interval-seconds x)) (zero? (sql-interval-nanoseconds x)))) -(define (sql-day-time-interval->seconds x) - (+ (* (sql-interval-hours x) 60 60) - (* (sql-interval-minutes x) 60) - (sql-interval-seconds x) - (/ (sql-interval-nanoseconds x) #i1e9))) - -(define (same-signs? w x y z) - (define some-pos? (or (positive? w) (positive? x) (positive? y) (positive? z))) - (define some-neg? (or (negative? w) (negative? x) (negative? y) (negative? z))) - (not (and some-pos? some-neg?))) - (define no-arg (gensym)) (define (sql-interval->sql-time x [default no-arg]) @@ -176,70 +118,9 @@ (sql-time-second x) (sql-time-nanosecond x))) -;; ---- +;; ---------------------------------------- -;; Note: MySQL allows 0 month, 0 day, etc. - -(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-datetime->srfi-date - (-> (or/c sql-date? sql-time? sql-timestamp?) - srfi:date?)] - [srfi-date->sql-date - (-> srfi:date? sql-date?)] - [srfi-date->sql-time - (->* (srfi:date?) ((or/c exact-nonnegative-integer? #f)) - sql-time?)] - [srfi-date->sql-time-tz - (->* (srfi:date?) ((or/c exact-nonnegative-integer? #f)) - sql-time?)] - [srfi-date->sql-timestamp - (->* (srfi:date?) ((or/c exact-nonnegative-integer? #f)) - sql-timestamp?)] - [srfi-date->sql-timestamp-tz - (->* (srfi:date?) ((or/c exact-nonnegative-integer? #f)) - sql-timestamp?)] - - [sql-day-time-interval? - (-> any/c boolean?)] - [sql-year-month-interval? - (-> any/c boolean?)] - [sql-day-time-interval->seconds - (-> sql-day-time-interval? rational?)] - [sql-interval->sql-time - (->* (sql-interval?) (any/c) - any)] - [sql-time->sql-interval - (-> sql-time? sql-day-time-interval?)]) - -;; ---- +;; Bits #| A sql-bits is (sql-bits len bv offset) @@ -344,30 +225,6 @@ byte. (Because that's PostgreSQL's binary format.) For example: (bv-set! bv* (+ i offset*) (bv-ref bv0 (+ offset0 i)))) (sql-bits len bv* offset*))) -(provide make-sql-bits/bytes - sql-bits-bv - align-sql-bits) - -(provide/contract - [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?)]) - ;; ---------------------------------------- ;; Predicates diff --git a/collects/db/private/postgresql/dbsystem.rkt b/collects/db/private/postgresql/dbsystem.rkt index b356b00fa7..40d3123595 100644 --- a/collects/db/private/postgresql/dbsystem.rkt +++ b/collects/db/private/postgresql/dbsystem.rkt @@ -1,9 +1,12 @@ #lang racket/base (require racket/class racket/list + racket/match + (prefix-in srfi: srfi/19) "../generic/interfaces.rkt" "../generic/sql-data.rkt" "../generic/sql-convert.rkt" + "../../util/datetime.rkt" "../../util/geometry.rkt" "../../util/postgresql.rkt" (only-in "message.rkt" field-dvec->typeid)) @@ -130,6 +133,114 @@ record = cols:int4 (typeoid:int4 len/-1:int4 data:byte^len)^cols |# +;; Text readers + +(define (parse-date d) + (srfi-date->sql-date + (srfi:string->date d "~Y-~m-~d"))) + +(define time/ns-rx #rx"^[0-9]*:[0-9]*:[0-9]*\\.([0-9]*)") +(define timestamp/ns-rx #rx"^.* [0-9]*:[0-9]*:[0-9]*\\.([0-9]*)") + +(define (ns-of t rx) + (let ([m (regexp-match rx t)]) + (if m + (* #e1e9 (parse-exact-fraction (cadr m))) + 0))) + +(define (parse-time t) + (srfi-date->sql-time + (srfi:string->date t "~k:~M:~S") + (ns-of t time/ns-rx))) + +(define (parse-time-tz t) + (srfi-date->sql-time-tz + (srfi:string->date t "~k:~M:~S~z") + (ns-of t time/ns-rx))) + +(define (parse-timestamp t) + (srfi-date->sql-timestamp + (srfi:string->date t "~Y-~m-~d ~k:~M:~S") + (ns-of t timestamp/ns-rx))) + +(define (parse-timestamp-tz t) + (srfi-date->sql-timestamp-tz + (srfi:string->date t "~Y-~m-~d ~k:~M:~S~z") + (ns-of t timestamp/ns-rx))) + +(define interval-rx + (regexp + (string-append "^" + "(?:(-?[0-9]*) years? *)?" + "(?:(-?[0-9]*) mons? *)?" + "(?:(-?[0-9]*) days? *)?" + "(?:(-?)([0-9]*):([0-9]*):([0-9]*)(?:\\.([0-9]*))?)?" + "$"))) + +(define (parse-interval s) + (define (to-num m) + (if m (string->number m) 0)) + (define match-result (regexp-match interval-rx s)) + (match match-result + [(list _whole years months days tsign hours mins secs fsec) + (let* ([years (to-num years)] + [months (to-num months)] + [days (to-num days)] + [sg (if (equal? tsign "-") - +)] + [hours (sg (to-num hours))] + [mins (sg (to-num mins))] + [secs (sg (to-num secs))] + [nsecs (if fsec + (let ([flen (string-length fsec)]) + (* (string->number (substring fsec 0 (min flen 9))) + (expt 10 (- 9 (min flen 9))))) + 0)]) + (sql-interval years months days hours mins secs nsecs))])) + +;; Text writers + +(define (marshal-date f i d) + (unless (sql-date? d) + (marshal-error f i "date" d)) + (srfi:date->string (sql-datetime->srfi-date d) "~Y-~m-~d")) + +(define (marshal-time f i t) + (unless (sql-time? t) + (marshal-error f i "time" t)) + (srfi:date->string (sql-datetime->srfi-date t) "~k:~M:~S.~N")) + +(define (marshal-time-tz f i t) + (unless (sql-time? t) + (marshal-error f i "time" t)) + (srfi:date->string (sql-datetime->srfi-date t) "~k:~M:~S.~N~z")) + +(define (marshal-timestamp f i t) + (unless (sql-timestamp? t) + (marshal-error f i "timestamp" t)) + (srfi:date->string (sql-datetime->srfi-date t) "~Y-~m-~d ~k:~M:~S.~N")) + +(define (marshal-timestamp-tz f i t) + (unless (sql-timestamp? t) + (marshal-error f i "timestamp" t)) + (srfi:date->string (sql-datetime->srfi-date t) "~Y-~m-~d ~k:~M:~S.~N~z")) + +(define (marshal-interval f i t) + (define (tag num unit) + (if (zero? num) "" (format "~a ~a " num unit))) + (match t + [(sql-interval years months days hours minutes seconds nanoseconds) + ;; Note: we take advantage of PostgreSQL's liberal interval parser + ;; and we acknowledge its micro-second precision. + (string-append (tag years "years") + (tag months "months") + (tag days "days") + (tag hours "hours") + (tag minutes "minutes") + (tag seconds "seconds") + (tag (quotient nanoseconds 1000) "microseconds"))] + [else + (marshal-error f i "interval" t)])) + ;; Binary readers (define (recv-bits x) @@ -227,8 +338,7 @@ record = cols:int4 (typeoid:int4 len/-1:int4 data:byte^len)^cols +nan.0]))) |# -(define-values (c-parse-char1 - c-parse-date +(define-values (c-parse-date c-parse-time c-parse-time-tz c-parse-timestamp @@ -236,8 +346,7 @@ record = cols:int4 (typeoid:int4 len/-1:int4 data:byte^len)^cols c-parse-interval c-parse-decimal) (let ([c (lambda (f) (lambda (x) (f (bytes->string/utf-8 x))))]) - (values (c parse-char1) - (c parse-date) + (values (c parse-date) (c parse-time) (c parse-time-tz) (c parse-timestamp) diff --git a/collects/db/scribblings/config.rkt b/collects/db/scribblings/config.rkt index 1d4fdac6e0..290492679a 100644 --- a/collects/db/scribblings/config.rkt +++ b/collects/db/scribblings/config.rkt @@ -14,7 +14,8 @@ (void (interaction-eval #:eval the-eval (require racket/class - "main.rkt")) + "main.rkt" + "util/datetime.rkt")) (interaction-eval #:eval the-eval (define connection% (class object% (super-new)))) (interaction-eval #:eval the-eval diff --git a/collects/db/scribblings/sql-types.scrbl b/collects/db/scribblings/sql-types.scrbl index 1b27b1b7d4..bc2e666250 100644 --- a/collects/db/scribblings/sql-types.scrbl +++ b/collects/db/scribblings/sql-types.scrbl @@ -330,6 +330,9 @@ The @tt{DATE}, @tt{TIME} (@tt{WITH TIME ZONE} and without), @tt{TIMESTAMP} (@tt{WITH TIME ZONE} and without), and @tt{INTERVAL} SQL types are represented by the following structures. +See also @secref["datetime-util"] for more functions on datetime +values. + @defstruct*[sql-date ([year exact-integer?] [month (integer-in 0 12)] @@ -390,39 +393,6 @@ SQL types are represented by the following structures. (make-sql-timestamp 1969 12 31 19 0 0 0 #f)] ] -@deftogether[[ -@defproc[(sql-datetime->srfi-date [t (or/c sql-date? sql-time? sql-timestamp?)]) - srfi:date?] -@defproc[(srfi-date->sql-date [d srfi:date?]) - sql-date?] -@defproc[(srfi-date->sql-time [d srfi:date?]) - sql-time?] -@defproc[(srfi-date->sql-time-tz [d srfi:date?]) - sql-time?] -@defproc[(srfi-date->sql-timestamp [d srfi:date?]) - sql-timestamp?] -@defproc[(srfi-date->sql-timestamp-tz [d srfi:date?]) - sql-timestamp?]]]{ - - Converts between this library's date and time values and SRFI 19's - date values (see @racketmodname[srfi/19]). SRFI dates store more - information than SQL dates and times, so converting a SQL time to a - SRFI date, for example, puts zeroes in the year, month, and day - fields. - -@(examples/results - [(sql-datetime->srfi-date - (query-value pgc "select time '7:30'")) - (sql-datetime->srfi-date (make-sql-time 7 30 0 0 #f))] - [(sql-datetime->srfi-date - (query-value pgc "select date '25-dec-1980'")) - (sql-datetime->srfi-date - (make-sql-date 1980 12 25))] - [(sql-datetime->srfi-date - (query-value pgc "select timestamp 'epoch'")) - (sql-datetime->srfi-date (make-sql-timestamp 1970 1 1 0 0 0 0 #f))]) -} - @defstruct*[sql-interval ([years exact-integer?] [months exact-integer?] @@ -469,12 +439,6 @@ SQL types are represented by the following structures. where the @racket[years] and @racket[months] fields are zero. } -@defproc[(sql-day-time-interval->seconds [interval sql-day-time-interval?]) - rational?]{ - - Returns the length of @racket[interval] in seconds. -} - @defproc[(sql-interval->sql-time [interval sql-interval?] [failure any/c (lambda () (error ....))]) any]{ diff --git a/collects/db/scribblings/util.scrbl b/collects/db/scribblings/util.scrbl index 9b398c8b55..75650bf970 100644 --- a/collects/db/scribblings/util.scrbl +++ b/collects/db/scribblings/util.scrbl @@ -4,13 +4,59 @@ scribble/struct scheme/sandbox "config.rkt" - (for-label db db/util/geometry db/util/postgresql)) + (for-label db db/util/datetime db/util/geometry db/util/postgresql)) @title[#:tag "util"]{Utilities} The bindings described in this section are provided by the specific modules below, not by @racketmodname[db] or @racketmodname[db/base]. +@;{========================================} + +@section[#:tag "datetime-util"]{Datetime Type Utilities} + +@defmodule[db/util/datetime] + +@deftogether[[ +@defproc[(sql-datetime->srfi-date [t (or/c sql-date? sql-time? sql-timestamp?)]) + srfi:date?] +@defproc[(srfi-date->sql-date [d srfi:date?]) + sql-date?] +@defproc[(srfi-date->sql-time [d srfi:date?]) + sql-time?] +@defproc[(srfi-date->sql-time-tz [d srfi:date?]) + sql-time?] +@defproc[(srfi-date->sql-timestamp [d srfi:date?]) + sql-timestamp?] +@defproc[(srfi-date->sql-timestamp-tz [d srfi:date?]) + sql-timestamp?]]]{ + + Converts between this library's date and time values and SRFI 19's + date values (see @racketmodname[srfi/19]). SRFI dates store more + information than SQL dates and times, so converting a SQL time to a + SRFI date, for example, puts zeroes in the year, month, and day + fields. + +@(examples/results + [(sql-datetime->srfi-date + (query-value pgc "select time '7:30'")) + (sql-datetime->srfi-date (make-sql-time 7 30 0 0 #f))] + [(sql-datetime->srfi-date + (query-value pgc "select date '25-dec-1980'")) + (sql-datetime->srfi-date + (make-sql-date 1980 12 25))] + [(sql-datetime->srfi-date + (query-value pgc "select timestamp 'epoch'")) + (sql-datetime->srfi-date (make-sql-timestamp 1970 1 1 0 0 0 0 #f))]) +} + +@defproc[(sql-day-time-interval->seconds [interval sql-day-time-interval?]) + rational?]{ + + Returns the length of @racket[interval] in seconds. +} + + @;{========================================} @section[#:tag "geometry"]{Geometric Types} diff --git a/collects/db/util/datetime.rkt b/collects/db/util/datetime.rkt new file mode 100644 index 0000000000..53e3ba3774 --- /dev/null +++ b/collects/db/util/datetime.rkt @@ -0,0 +1,84 @@ +#lang racket/base +(require racket/contract + racket/match + (prefix-in srfi: srfi/19) + "../private/generic/sql-data.rkt") + +(define (sql-datetime->srfi-date datetime) + (match datetime + [(struct sql-date (year month day)) + (srfi:make-date 0 0 0 0 day month year 0)] + [(struct sql-time (hour minute second nanosecond tz)) + (srfi:make-date nanosecond second minute hour 0 0 0 (or tz 0))] + [(struct sql-timestamp (year month day hour minute second nanosecond tz)) + (srfi:make-date nanosecond second minute hour day month year (or tz 0))] + [else + (raise-type-error 'sql-datetime->srfi-date + "sql-date, sql-time, or sql-timestamp" + datetime)])) + +(define (srfi-date->sql-date date) + (make-sql-date (srfi:date-year date) + (srfi:date-month date) + (srfi:date-day date))) + +(define (srfi-date->sql-time* date tz? ns) + (make-sql-time (srfi:date-hour date) + (srfi:date-minute date) + (srfi:date-second date) + (or ns (srfi:date-nanosecond date)) + (and tz? (srfi:date-zone-offset date)))) + +(define (srfi-date->sql-time date [ns #f]) + (srfi-date->sql-time* date #f ns)) + +(define (srfi-date->sql-time-tz date [ns #f]) + (srfi-date->sql-time* date #t ns)) + +(define (srfi-date->sql-timestamp* date tz? ns) + (make-sql-timestamp (srfi:date-year date) + (srfi:date-month date) + (srfi:date-day date) + (srfi:date-hour date) + (srfi:date-minute date) + (srfi:date-second date) + (or ns (srfi:date-nanosecond date)) + (and tz? (srfi:date-zone-offset date)))) + +(define (srfi-date->sql-timestamp date [ns #f]) + (srfi-date->sql-timestamp* date #f ns)) + +(define (srfi-date->sql-timestamp-tz date [ns #f]) + (srfi-date->sql-timestamp* date #t ns)) + +(define (sql-day-time-interval->seconds x) + (+ (* (sql-interval-hours x) 60 60) + (* (sql-interval-minutes x) 60) + (sql-interval-seconds x) + (/ (sql-interval-nanoseconds x) #i1e9))) + +;; ============================================================ + +;; Note: MySQL allows 0 month, 0 day, etc. + +(provide/contract + [sql-datetime->srfi-date + (-> (or/c sql-date? sql-time? sql-timestamp?) + srfi:date?)] + [srfi-date->sql-date + (-> srfi:date? sql-date?)] + [srfi-date->sql-time + (->* (srfi:date?) ((or/c exact-nonnegative-integer? #f)) + sql-time?)] + [srfi-date->sql-time-tz + (->* (srfi:date?) ((or/c exact-nonnegative-integer? #f)) + sql-time?)] + [srfi-date->sql-timestamp + (->* (srfi:date?) ((or/c exact-nonnegative-integer? #f)) + sql-timestamp?)] + [srfi-date->sql-timestamp-tz + (->* (srfi:date?) ((or/c exact-nonnegative-integer? #f)) + sql-timestamp?)] + + [sql-day-time-interval->seconds + (-> sql-day-time-interval? rational?)]) diff --git a/collects/tests/db/db/sql-types.rkt b/collects/tests/db/db/sql-types.rkt index 224ae9039c..ed5aa436bc 100644 --- a/collects/tests/db/db/sql-types.rkt +++ b/collects/tests/db/db/sql-types.rkt @@ -5,6 +5,7 @@ racket/string (prefix-in srfi: srfi/19) db/base + db/util/datetime db/util/geometry db/util/postgresql "../config.rkt") diff --git a/collects/tests/db/gen/sql-types.rkt b/collects/tests/db/gen/sql-types.rkt index 51a7ccbe3b..c2b8109e7c 100644 --- a/collects/tests/db/gen/sql-types.rkt +++ b/collects/tests/db/gen/sql-types.rkt @@ -5,6 +5,14 @@ db/base db/private/generic/sql-convert "../config.rkt") +(require/expose + db/private/postgresql/dbsystem + (parse-date + parse-time + parse-time-tz + parse-timestamp + parse-timestamp-tz)) + (provide sql-types:test) (define sql-types:test