db: split off db/util/datetime module
This commit is contained in:
parent
a91e6f6452
commit
92e2d1eb6e
|
@ -1,3 +1,4 @@
|
|||
internal docs
|
||||
----
|
||||
|
||||
Testing
|
||||
|
|
|
@ -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?)])
|
||||
|
|
|
@ -1,28 +1,10 @@
|
|||
#lang racket/base
|
||||
(require racket/match
|
||||
(prefix-in srfi: srfi/19)
|
||||
"sql-data.rkt")
|
||||
(require "sql-data.rkt")
|
||||
|
||||
#|
|
||||
parse-<type> : string -> racket-datum
|
||||
;; ========================================
|
||||
|
||||
Takes the textual wire representation of <type> 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-<type> : fsym index datum -> string
|
||||
|
||||
Takes a racket datum and converts it into <type>'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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]{
|
||||
|
|
|
@ -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}
|
||||
|
|
84
collects/db/util/datetime.rkt
Normal file
84
collects/db/util/datetime.rkt
Normal file
|
@ -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?)])
|
|
@ -5,6 +5,7 @@
|
|||
racket/string
|
||||
(prefix-in srfi: srfi/19)
|
||||
db/base
|
||||
db/util/datetime
|
||||
db/util/geometry
|
||||
db/util/postgresql
|
||||
"../config.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
|
||||
|
|
Loading…
Reference in New Issue
Block a user