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)))))
|
||||
|
|
|
|||
|
|
@ -130,6 +130,23 @@
|
|||
(define (reader-jhost? x)
|
||||
(and (jhost? x) (member (jhost-tag x) '("string-reader" "pushback-reader"))))
|
||||
|
||||
;; Refill a host reader so subsequent read/slurp see `s` (the unconsumed tail).
|
||||
(define (reader-refill! r s)
|
||||
(cond
|
||||
((string=? (jhost-tag r) "string-reader")
|
||||
(vector-set! (jhost-state r) 0 s) (vector-set! (jhost-state r) 1 0))
|
||||
((string=? (jhost-tag r) "pushback-reader")
|
||||
(vector-set! (jhost-state r) 0 (host-new "StringReader" s))
|
||||
(vector-set! (jhost-state r) 1 '()))))
|
||||
;; Read ONE form from a host reader (StringReader/PushbackReader): drain the
|
||||
;; remaining chars, parse one form, push the tail back. -> (values form found?).
|
||||
;; (read r) over a java.io reader — cuerdas' interpolation reads this way.
|
||||
(define (host-reader-read-form r)
|
||||
(let* ((s (drain-reader r)) (pr (jolt-parse-next s)))
|
||||
(if (jolt-nil? pr)
|
||||
(begin (reader-refill! r "") (values jolt-nil #f))
|
||||
(begin (reader-refill! r (jolt-nth pr 1)) (values (jolt-nth pr 0) #t)))))
|
||||
|
||||
;; clojure.edn/read over a reader (jolt-uicd): the overlay edn.clj's drain-reader is
|
||||
;; janet/type-coupled, so on Chez we drain the jhost reader to a string and read the
|
||||
;; first EDN form (read-string). Re-asserted over the prelude in post-prelude.ss.
|
||||
|
|
|
|||
|
|
@ -101,3 +101,40 @@
|
|||
;; :jolt/deftype)) — the get-trick invokes a sorted-map's comparator on
|
||||
;; :jolt/deftype and throws (jolt-3bbj). Matches the JVM (instance? IRecord).
|
||||
(def-var! "clojure.core" "record?" (lambda (x) (jrec? x)))
|
||||
|
||||
;; read / read+string over a HOST reader jhost (java.io StringReader/PushbackReader):
|
||||
;; the overlay's IReader protocol only covers the reify map-reader, so a (read
|
||||
;; pushback-reader) — cuerdas' string interpolation — would miss. Intercept a host
|
||||
;; reader; everything else (the *in* reify) delegates to the overlay.
|
||||
(let ((ov-read (var-deref "clojure.core" "read")))
|
||||
(def-var! "clojure.core" "read"
|
||||
(case-lambda
|
||||
(() (jolt-invoke ov-read))
|
||||
((stream)
|
||||
(if (reader-jhost? stream)
|
||||
(let-values (((form found?) (host-reader-read-form stream)))
|
||||
(if found? form (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap)))))
|
||||
(jolt-invoke ov-read stream)))
|
||||
((stream e? ev)
|
||||
(if (reader-jhost? stream)
|
||||
(let-values (((form found?) (host-reader-read-form stream)))
|
||||
(cond (found? form)
|
||||
((jolt-truthy? e?) (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap))))
|
||||
(else ev)))
|
||||
(jolt-invoke ov-read stream e? ev))))))
|
||||
(let ((ov-rps (var-deref "clojure.core" "read+string")))
|
||||
(def-var! "clojure.core" "read+string"
|
||||
(case-lambda
|
||||
(() (jolt-invoke ov-rps))
|
||||
((stream) (jolt-invoke (var-deref "clojure.core" "read+string") stream #t jolt-nil))
|
||||
((stream e? ev)
|
||||
(if (reader-jhost? stream)
|
||||
(let* ((s (drain-reader stream)) (pr (jolt-parse-next s)))
|
||||
(if (jolt-nil? pr)
|
||||
(begin (reader-refill! stream "")
|
||||
(if (jolt-truthy? e?) (jolt-throw (jolt-ex-info "EOF while reading" (empty-pmap)))
|
||||
(jolt-vector ev "")))
|
||||
(let ((rest (jolt-nth pr 1)))
|
||||
(reader-refill! stream rest)
|
||||
(jolt-vector (jolt-nth pr 0) (substring s 0 (- (string-length s) (string-length rest)))))))
|
||||
(jolt-invoke ov-rps stream e? ev))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue