Conformance: SimpleDateFormat parse + read over host readers
- java.text.SimpleDateFormat.parse parses the RFC1123/1036/asctime patterns (day/month names, 2-digit-year sliding window, tz token), and .format renders z/Z/X timezone tokens (GMT/+0000/Z) instead of emitting them literally. Date gains toLocalDate/toLocalDateTime/before/after/equals. Fixes ring.util.time. - read / read+string work over a host java.io reader (StringReader wrapped in a PushbackReader): drain, parse one form, push the tail back. Fixes cuerdas istr / << string interpolation (and selmer's <<), which read embedded forms from the template via (read pushback-reader).
This commit is contained in:
Yogthos
parent
d83175b8c2
commit
c7bbdea11d
4 changed files with 146 additions and 0 deletions
|
|
@ -150,9 +150,83 @@
|
|||
((char=? c #\m) (display (if (= k 1) (number->string mi) (pad2 mi)) out) (loop (+ i k)))
|
||||
((char=? c #\s) (display (if (= k 1) (number->string se) (pad2 se)) out) (loop (+ i k)))
|
||||
((char=? c #\a) (display (if (< hh 12) "AM" "PM") out) (loop (+ i k)))
|
||||
;; timezone — format-ms renders UTC, the HTTP zone is GMT: z/zzz -> GMT,
|
||||
;; Z (RFC822) -> +0000, X (ISO) -> Z.
|
||||
((char=? c #\z) (display "GMT" out) (loop (+ i k)))
|
||||
((char=? c #\Z) (display "+0000" out) (loop (+ i k)))
|
||||
((char=? c #\X) (display "Z" out) (loop (+ i k)))
|
||||
(else (write-char c out) (loop (+ i 1)))))))
|
||||
(get-output-string out))))
|
||||
|
||||
;; --- SimpleDateFormat .parse: pattern-driven parse to epoch-ms (UTC/GMT) ------
|
||||
(define (month-from-name s)
|
||||
(let ((m3 (ascii-string-down (substring s 0 (min 3 (string-length s))))))
|
||||
(let loop ((i 0))
|
||||
(cond ((= i 12) #f)
|
||||
((string=? (ascii-string-down (substring (vector-ref month-names i) 0 3)) m3) (+ i 1))
|
||||
(else (loop (+ i 1)))))))
|
||||
(define (parse-ms pattern input)
|
||||
(let ((pn (string-length pattern)) (inn (string-length input))
|
||||
(y 1970) (mo 1) (d 1) (hh 0) (mi 0) (ss 0) (pm 'none))
|
||||
(define (pfail) (error #f (string-append "ParseException: unparseable date \"" input "\"")))
|
||||
(define (run-len i c) (let loop ((j i)) (if (and (< j pn) (char=? (string-ref pattern j) c)) (loop (+ j 1)) (- j i))))
|
||||
(define (read-digits ii) ; -> (val . next), pfail if none
|
||||
(let loop ((j ii) (acc 0) (any #f))
|
||||
(if (and (< j inn) (digit? (string-ref input j)))
|
||||
(loop (+ j 1) (+ (* acc 10) (- (char->integer (string-ref input j)) 48)) #t)
|
||||
(if any (cons acc j) (pfail)))))
|
||||
(define (read-alpha ii) ; -> (str . next)
|
||||
(let loop ((j ii)) (if (and (< j inn) (char-alphabetic? (string-ref input j))) (loop (+ j 1))
|
||||
(cons (substring input ii j) j))))
|
||||
(define (read-tz ii) ; consume GMT/UTC/Z or ±hhmm; -> next
|
||||
(cond ((>= ii inn) ii)
|
||||
((char-alphabetic? (string-ref input ii)) (cdr (read-alpha ii)))
|
||||
((or (char=? (string-ref input ii) #\+) (char=? (string-ref input ii) #\-))
|
||||
(let loop ((j (+ ii 1))) (if (and (< j inn) (or (digit? (string-ref input j)) (char=? (string-ref input j) #\:))) (loop (+ j 1)) j)))
|
||||
(else ii)))
|
||||
(let loop ((pi 0) (ii 0))
|
||||
(if (>= pi pn)
|
||||
(begin
|
||||
(when (eq? pm 'pm) (when (< hh 12) (set! hh (+ hh 12))))
|
||||
(when (eq? pm 'am) (when (= hh 12) (set! hh 0)))
|
||||
(make-jinst (* 1000 (+ (* (days-from-civil y mo d) 86400) (* hh 3600) (* mi 60) ss))))
|
||||
(let ((c (string-ref pattern pi)))
|
||||
(cond
|
||||
((char-alphabetic? c)
|
||||
(let ((k (run-len pi c)))
|
||||
(cond
|
||||
((char=? c #\y) (let ((r (read-digits ii)))
|
||||
;; 2-digit year (value < 100): JVM sliding window — 00-68 -> 20xx,
|
||||
;; 69-99 -> 19xx (rfc1036 HTTP dates). A full year stays as-is.
|
||||
(set! y (let ((v (car r))) (if (< v 100) (if (< v 69) (+ 2000 v) (+ 1900 v)) v)))
|
||||
(loop (+ pi k) (cdr r))))
|
||||
((char=? c #\M) (if (>= k 3)
|
||||
(let ((r (read-alpha ii))) (set! mo (or (month-from-name (car r)) (pfail))) (loop (+ pi k) (cdr r)))
|
||||
(let ((r (read-digits ii))) (set! mo (car r)) (loop (+ pi k) (cdr r)))))
|
||||
((char=? c #\d) (let ((r (read-digits ii))) (set! d (car r)) (loop (+ pi k) (cdr r))))
|
||||
((or (char=? c #\H) (char=? c #\h)) (let ((r (read-digits ii))) (set! hh (car r)) (loop (+ pi k) (cdr r))))
|
||||
((char=? c #\m) (let ((r (read-digits ii))) (set! mi (car r)) (loop (+ pi k) (cdr r))))
|
||||
((char=? c #\s) (let ((r (read-digits ii))) (set! ss (car r)) (loop (+ pi k) (cdr r))))
|
||||
((char=? c #\E) (loop (+ pi k) (cdr (read-alpha ii))))
|
||||
((char=? c #\a) (let ((r (read-alpha ii)))
|
||||
(set! pm (if (string=? (ascii-string-down (car r)) "pm") 'pm 'am))
|
||||
(loop (+ pi k) (cdr r))))
|
||||
((or (char=? c #\z) (char=? c #\Z) (char=? c #\X)) (loop (+ pi k) (read-tz ii)))
|
||||
(else (loop (+ pi k) ii)))))
|
||||
((char=? c #\')
|
||||
(if (and (< (+ pi 1) pn) (char=? (string-ref pattern (+ pi 1)) #\'))
|
||||
(loop (+ pi 2) (if (and (< ii inn) (char=? (string-ref input ii) #\')) (+ ii 1) ii))
|
||||
(let lit ((pj (+ pi 1)) (ij ii))
|
||||
(cond ((>= pj pn) (loop pj ij))
|
||||
((char=? (string-ref pattern pj) #\') (loop (+ pj 1) ij))
|
||||
((and (< ij inn) (char=? (string-ref input ij) (string-ref pattern pj))) (lit (+ pj 1) (+ ij 1)))
|
||||
(else (pfail))))))
|
||||
;; literal: match it; a pattern space tolerates missing/extra spaces.
|
||||
((char=? c #\space)
|
||||
(let skip ((ij ii)) (if (and (< ij inn) (char=? (string-ref input ij) #\space)) (skip (+ ij 1)) (loop (+ pi 1) ij))))
|
||||
((and (< ii inn) (char=? (string-ref input ii) c)) (loop (+ pi 1) (+ ii 1)))
|
||||
(else (pfail))))))))
|
||||
|
||||
;; --- value integration: get / = / hash / pr / type / instance? --------------
|
||||
(define kw-jolt-type (keyword "jolt" "type"))
|
||||
(define kw-ms (keyword #f "ms"))
|
||||
|
|
@ -303,6 +377,10 @@
|
|||
(register-class-ctor! "java.text.SimpleDateFormat" sdf-ctor)
|
||||
(register-host-methods! "sdf"
|
||||
(list (cons "setTimeZone" (lambda (self tz) jolt-nil))
|
||||
(cons "setLenient" (lambda (self b) jolt-nil))
|
||||
(cons "applyPattern" (lambda (self p) (vector-set! (jhost-state self) 0 (jolt-str-render-one p)) jolt-nil))
|
||||
(cons "toPattern" (lambda (self) (vector-ref (jhost-state self) 0)))
|
||||
(cons "parse" (lambda (self s) (parse-ms (vector-ref (jhost-state self) 0) (jolt-str-render-one s))))
|
||||
(cons "format" (lambda (self d) (format-ms (vector-ref (jhost-state self) 0) (ms-of d))))))
|
||||
|
||||
;; a jinst's java.util.Date method surface (record-method-dispatch arm).
|
||||
|
|
@ -313,6 +391,13 @@
|
|||
((jinst? obj)
|
||||
(cond ((string=? method-name "getTime") (jinst-ms obj))
|
||||
((string=? method-name "toInstant") (mk-instant (jinst-ms obj)))
|
||||
((string=? method-name "toLocalDate") (mk-local (jinst-ms obj)))
|
||||
((string=? method-name "toLocalDateTime") (mk-local (jinst-ms obj)))
|
||||
((string=? method-name "toString") (inst-rfc3339 obj))
|
||||
((string=? method-name "equals") (and (pair? (if (jolt-nil? rest-args) '() (seq->list rest-args)))
|
||||
(jinst? (car (seq->list rest-args)))
|
||||
(= (jinst-ms obj) (jinst-ms (car (seq->list rest-args))))))
|
||||
((string=? method-name "before") (< (jinst-ms obj) (ms-of (car (seq->list rest-args)))))
|
||||
((string=? method-name "after") (> (jinst-ms obj) (ms-of (car (seq->list rest-args)))))
|
||||
(else (error #f (string-append "No method " method-name " on Date")))))
|
||||
(else (%it-rmd obj method-name rest-args)))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue