;; java.io.File + host file I/O, implemented over Chez's filesystem
;; primitives. A File is a
;; path-backed jfile record: (instance? java.io.File f) is true, str/slurp coerce
;; it to its path, and the File method surface (getName/getPath/exists/
;; isDirectory/isFile/listFiles) dispatches through record-method-dispatch.
;;
;; Provides make-file/file?/slurp/spit/flush/dir?/
;; list-dir for the overlay file-seq (20-coll.clj), which calls __file?/__dir?/
;; __list-dir + the .isDirectory/.listFiles/.isFile method surface.
;;
;; Loaded LAST in rt.ss, after
;; dot-forms.ss (so the jfile method arm wraps the fully-built dispatch) and
;; natives-meta.ss / records.ss / printing.ss (jolt-type / instance-check /
;; jolt-str-render-one, which it extends).

(define-record-type jfile (fields path) (nongenerative jolt-jfile-v1))
(define (jolt-file? x) (jfile? x))

;; path string of any value: a jfile -> its path, else its str rendering.
(define (file-path-of x) (if (jfile? x) (jfile-path x) (jolt-str-render-one x)))

;; Resources baked into a standalone binary by `jolt build` (deps.edn
;; :jolt/build :embed). The build emits a register-embedded-resource! per file at
;; heap-build time, so the contents live in the boot image — io/resource serves
;; them with no file on disk. An embedded hit reads through slurp/reader exactly
;; like a jfile would.
(define embedded-resources (make-hashtable equal-hash equal?))
(define (register-embedded-resource! name content)
  (hashtable-set! embedded-resources name content))
(define-record-type embedded-res (fields name content) (nongenerative jolt-embres-v1))

;; --- self-contained build artifacts (jolt-eaj) ------------------------------
;; A toolchain-free `jolt build` (the distributed joltc) carries the Chez
;; petite/scheme boots and a prebuilt launcher stub baked into its own boot image.
;; They live in the same table as embedded-resources, but keyed under bytevector
;; values (register-embedded-bytes!) rather than strings; resolve-on-roots /
;; io/resource only ever ask for the string-keyed source entries, so the two
;; coexist. The build driver reads them at heap-build time from files that exist
;; only on the dev machine.
(define (register-embedded-bytes! name bv) (hashtable-set! embedded-resources name bv))
(define (jolt-embedded-bytes name)
  (let ((v (hashtable-ref embedded-resources name #f)))
    (and (bytevector? v) v)))

;; Read a whole file as a bytevector ("" -> empty). Used to slurp boot/stub files.
(define (read-file-bytes path)
  (let ((p (open-file-input-port path)))
    (let ((bv (get-bytevector-all p)))
      (close-port p)
      (if (eof-object? bv) (bytevector) bv))))

;; Write an embedded bytevector resource out to a path. make-boot-file needs the
;; petite/scheme boots as files, so they are spilled to scratch before the call.
(define (jolt-spill-embedded! name path)
  (let ((bv (jolt-embedded-bytes name)))
    (unless bv (error 'jolt-spill-embedded! "no embedded bytes for" name))
    (let ((p (open-file-output-port path (file-options no-fail) (buffer-mode block))))
      (put-bytevector p bv)
      (close-port p))))

;; Frame an app boot onto a file that already holds the stub bytes. Layout:
;; [stub][boot][boot-length:le64]["JOLTBOOT"]. The stub (host/chez/stub/launcher.c)
;; reads the trailing 16 bytes — the 8-byte magic, then the preceding 8-byte LE
;; length — to locate and register the boot, so a boot that itself contains the
;; magic bytes can't be mistaken for the frame.
(define jolt-payload-magic (string->utf8 "JOLTBOOT"))
(define (jolt-append-payload! path boot-bv)
  (let ((head (read-file-bytes path)))           ; the stub bytes already written
    (let ((p (open-file-output-port path (file-options no-fail) (buffer-mode block)))
          (lb (make-bytevector 8 0)))
      (bytevector-u64-set! lb 0 (bytevector-length boot-bv) (endianness little))
      (put-bytevector p head)
      (put-bytevector p boot-bv)
      (put-bytevector p lb)
      (put-bytevector p jolt-payload-magic)
      (close-port p))))

;; chmod 0755 via libc, so the produced binary is executable. load-shared-object
;; with #f pulls the running process's own symbols (chmod is in libc, linked into
;; every Chez binary) — no external toolchain. Falls back to /bin/sh chmod if the
;; symbol can't be resolved.
(define jolt-chmod-755
  (let ((c (guard (e (#t #f))
             (load-shared-object #f)
             (foreign-procedure "chmod" (string int) int))))
    (lambda (path)
      (if c
          (c path #o755)
          (system (string-append "chmod 755 '" path "'"))))))

;; A user-facing relative path resolves against JOLT_PWD — the user's cwd before
;; the launcher cd'd to the jolt repo root — matching the JVM, where io/file is
;; cwd-relative. (io/resource builds jfiles from the source roots directly, so it
;; isn't routed through here.)
(define (project-relative p)
  (if (or (= (string-length p) 0) (char=? (string-ref p 0) #\/))
      p
      (let ((pwd (getenv "JOLT_PWD")))
        (if (and pwd (> (string-length pwd) 0)) (string-append pwd "/" p) p))))

;; (io/file path) / (io/file parent child) — join children with "/". The File
;; keeps the path AS GIVEN (like the JVM: new File("rel").getPath() is "rel");
;; a relative path resolves against JOLT_PWD only when the filesystem is touched
;; (jfile-fs / slurp / spit / the stream constructors).
(define (jolt-make-file path . rest)
  (let loop ((p (file-path-of path)) (cs rest))
    (if (null? cs) (make-jfile p)
        (loop (string-append p "/" (file-path-of (car cs))) (cdr cs)))))
;; the on-disk path of a value: a relative path resolves against JOLT_PWD.
(define (jfile-fs f) (project-relative (file-path-of f)))

(define (path-last-segment p)
  (let loop ((i (- (string-length p) 1)))
    (cond ((< i 0) p)
          ((char=? (string-ref p i) #\/) (substring p (+ i 1) (string-length p)))
          (else (loop (- i 1))))))

;; directory children as full paths, sorted (the __list-dir seed primitive).
(define (jolt-list-dir path)
  (let ((p (project-relative (file-path-of path))))
    (map (lambda (e) (string-append p "/" e))
         (sort string<? (directory-list p)))))
(define (jolt-dir? path) (if (file-directory? (project-relative (file-path-of path))) #t #f))

;; absolute path string (cwd-relative paths resolved against current-directory).
(define (jfile-abs p)
  (if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/)) p
      (string-append (current-directory) "/" p)))

;; --- file metadata over Chez filesystem ops ---------------------------------
;; byte size of a regular file (0 for a directory or a missing file).
(define (file-byte-size p)
  (if (or (not (file-exists? p)) (file-directory? p)) 0
      (let ((port (open-file-input-port p))) (let ((n (file-length port))) (close-port port) n))))
;; last-modified as epoch milliseconds (0 if the file is absent).
(define (file-mtime-millis p)
  (if (file-exists? p)
      (let ((t (file-modification-time p)))
        (+ (* (time-second t) 1000) (div (time-nanosecond t) 1000000)))
      0))
;; mkdir -p: create p and any missing parents. Returns #t if p ends up a dir.
(define (mkdirs! p)
  (unless (or (= 0 (string-length p)) (file-exists? p))
    (let loop ((i (- (string-length p) 1)))
      (cond ((<= i 0) #f)
            ((char=? (string-ref p i) #\/)
             (let ((parent (substring p 0 i))) (unless (file-exists? parent) (mkdirs! parent))))
            (else (loop (- i 1)))))
    (guard (e (#t #f)) (mkdir p)))
  (and (file-exists? p) (file-directory? p)))
;; delete a file or an (empty) directory; #t on success.
(define (delete-path! p)
  (guard (e (#t #f))
    (cond ((not (file-exists? p)) #f)
          ((file-directory? p) (delete-directory p) #t)
          (else (delete-file p) #t))))

;; --- java.net.URL (a jhost "url", state #(spec)) ----------------------------
;; A File.toURL value: .toString / .toExternalForm give the spec, .getPath /
;; .getFile strip the "file:" scheme.
(define (make-url spec) (make-jhost "url" (vector spec)))
(define (url-spec u) (vector-ref (jhost-state u) 0))
(define (url-strip-scheme spec)
  (if (and (>= (string-length spec) 5) (string=? (substring spec 0 5) "file:"))
      (substring spec 5 (string-length spec)) spec))
(define (url-protocol spec)
  (let ((i (let loop ((j 0)) (cond ((>= j (string-length spec)) #f)
                                   ((char=? (string-ref spec j) #\:) j) (else (loop (+ j 1)))))))
    (if i (substring spec 0 i) "")))
;; (java.net.URL. spec) — a basic file/http URL value (a library may register a
;; richer URL shim, which overrides this).
(register-class-ctor! "URL" (lambda (spec . _) (make-url (jolt-str-render-one spec))))
(register-class-ctor! "java.net.URL" (lambda (spec . _) (make-url (jolt-str-render-one spec))))
(register-host-methods! "url"
  (list (cons "toString"       (lambda (self) (url-spec self)))
        (cons "toExternalForm" (lambda (self) (url-spec self)))
        (cons "getProtocol"    (lambda (self) (url-protocol (url-spec self))))
        (cons "getPath"        (lambda (self) (url-strip-scheme (url-spec self))))
        (cons "getFile"        (lambda (self) (url-strip-scheme (url-spec self))))))

;; --- File method surface (record-method-dispatch arm) -----------------------
(define (jfile-method f name args)        ; -> boxed result, or #f to fall through
  (let ((p (jfile-path f))               ; the path as given (display methods)
        (fp (jfile-fs f)))               ; JOLT_PWD-resolved on-disk path (FS methods)
    (cond
      ((string=? name "getPath")        (list p))
      ((string=? name "getName")        (list (path-last-segment p)))
      ((string=? name "toString")       (list p))
      ((string=? name "getAbsolutePath")(list (jfile-abs fp)))
      ((string=? name "getCanonicalPath")(list (jfile-abs fp)))
      ((string=? name "toURI")          (list (string-append "file:" (jfile-abs fp))))
      ((string=? name "toURL")          (list (make-url (string-append "file:" (jfile-abs fp)))))
      ;; io/resource returns a File where the JVM returns a file: URL; answer the
      ;; two URL methods resource-serving middleware (ring) calls on the result, so
      ;; it sees a "file" protocol and a path without changing the return type.
      ((string=? name "getProtocol")    (list "file"))
      ((string=? name "getFile")        (list (jfile-abs fp)))
      ((string=? name "exists")         (list (if (file-exists? fp) #t #f)))
      ((string=? name "isDirectory")    (list (if (file-directory? fp) #t #f)))
      ((string=? name "isFile")         (list (if (and (file-exists? fp) (not (file-directory? fp))) #t #f)))
      ((string=? name "isAbsolute")     (list (if (and (> (string-length p) 0) (char=? (string-ref p 0) #\/)) #t #f)))
      ((string=? name "listFiles")      (list (list->cseq (map make-jfile (jolt-list-dir fp)))))
      ;; .list -> the child NAMES (a String[]), nil if not a directory.
      ((string=? name "list")
       (list (if (file-directory? fp)
                 (apply jolt-vector (sort string<? (directory-list fp)))
                 jolt-nil)))
      ((string=? name "length")         (list (->num (file-byte-size fp))))
      ((string=? name "lastModified")   (list (->num (file-mtime-millis fp))))
      ((string=? name "canRead")        (list (if (file-exists? fp) #t #f)))
      ((string=? name "canWrite")       (list (if (file-exists? fp) #t #f)))
      ((string=? name "canExecute")     (list (if (file-exists? fp) #t #f)))
      ((string=? name "isHidden")       (list (let ((nm (path-last-segment p)))
                                                (if (and (> (string-length nm) 0) (char=? (string-ref nm 0) #\.)) #t #f))))
      ((string=? name "mkdir")          (list (guard (e (#t #f)) (and (not (file-exists? fp)) (begin (mkdir fp) #t)))))
      ((string=? name "mkdirs")         (list (if (mkdirs! fp) #t #f)))
      ((string=? name "delete")         (list (if (delete-path! fp) #t #f)))
      ((string=? name "deleteOnExit")   (list jolt-nil))
      ((string=? name "setLastModified")(list #t))
      ((string=? name "createNewFile")
       (list (if (file-exists? fp) #f
                 (guard (e (#t #f)) (close-port (open-output-file fp 'truncate)) #t))))
      ((string=? name "renameTo")
       (list (let ((dst (jfile-fs (car args)))) (guard (e (#t #f)) (rename-file fp dst) #t))))
      ((string=? name "getParentFile")
       (let loop ((i (- (string-length p) 1)))
         (cond ((< i 0) (list jolt-nil))
               ((char=? (string-ref p i) #\/) (list (make-jfile (if (= i 0) "/" (substring p 0 i)))))
               (else (loop (- i 1))))))
      ((string=? name "getAbsoluteFile")  (list (make-jfile (jfile-abs p))))
      ((string=? name "getCanonicalFile") (list (make-jfile (jfile-abs p))))
      ((string=? name "compareTo")      (list (->num (let ((o (file-path-of (car args))))
                                                       (cond ((string<? p o) -1) ((string>? p o) 1) (else 0))))))
      ((string=? name "equals")         (list (and (jfile? (car args)) (string=? p (jfile-path (car args))))))
      ((string=? name "hashCode")       (list (->num (string-hash p))))
      ((string=? name "getParent")
       (let loop ((i (- (string-length p) 1)))
         (cond ((< i 0) (list jolt-nil))
               ((char=? (string-ref p i) #\/) (list (if (= i 0) "/" (substring p 0 i))))
               (else (loop (- i 1))))))
      (else #f))))

(register-method-arm! 41
  (lambda (obj method-name rest-args)
    (if (jfile? obj)
        (let* ((rest (if (jolt-nil? rest-args) '() (seq->list rest-args)))
               (r (jfile-method obj method-name rest)))
          (if r (car r) (error #f "no File method" method-name)))
        'pass)))

;; .isDirectory / .listFiles emit to jolt-host-call (rt.ss), not record-method-
;; dispatch — the shims there assume a path STRING target. Make them jfile-aware
;; so file-seq's File branch works.
(define %io-host-call jolt-host-call)
(set! jolt-host-call
  (lambda (method target . args)
    (cond
      ((and (jfile? target) (string=? method "isDirectory"))
       (if (file-directory? (jfile-fs target)) #t #f))
      ((and (jfile? target) (string=? method "listFiles"))
       (list->cseq (map make-jfile (jolt-list-dir target))))
      (else (apply %io-host-call method target args)))))

;; --- slurp / spit / flush ---------------------------------------------------
(define (read-file-string path)
  (let ((p (open-input-file path)))
    (let ((s (get-string-all p))) (close-port p) (if (eof-object? s) "" s))))

;; Drain a jhost reader (StringReader / PushbackReader): read code units from the
;; current position to EOF (-1) and assemble the string. Used by slurp; advances
;; the reader, as on the JVM.
(define (drain-reader r)
  (let loop ((acc '()))
    (let ((u (record-method-dispatch r "read" jolt-nil)))
      (if (or (jolt-nil? u) (and (number? u) (< u 0)))
          (list->string (reverse acc))
          (loop (cons (integer->char (exact (truncate u))) acc))))))

(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: drain the jhost reader to a string and read the
;; first EDN form (read-string). Re-asserted over the prelude in post-prelude.ss.
(define (chez-edn-read reader)
  (jolt-invoke (var-deref "clojure.core" "read-string")
               (if (reader-jhost? reader) (drain-reader reader) (jolt-str-render-one reader))))

;; line-seq: an io/reader is a jhost StringReader. Drain it (or take a string)
;; and split on newline; a trailing newline does NOT yield a final empty line
;; (like readLine -> nil at EOF). Re-asserted in post-prelude.ss.
(define (chez-lines s)
  (let loop ((cs (string->list s)) (cur '()) (acc '()))
    (cond ((null? cs) (reverse (if (null? cur) acc (cons (list->string (reverse cur)) acc))))
          ((char=? (car cs) #\newline) (loop (cdr cs) '() (cons (list->string (reverse cur)) acc)))
          (else (loop (cdr cs) (cons (car cs) cur) acc)))))
(define (chez-line-seq rdr)
  (list->cseq (chez-lines (cond ((string? rdr) rdr)
                                ((reader-jhost? rdr) (drain-reader rdr))
                                (else (jolt-str-render-one rdr))))))

;; (slurp src :encoding "...") — pull the charset from the trailing kwargs.
(define (slurp-encoding opts)
  (let loop ((o opts))
    (cond ((or (null? o) (null? (cdr o))) '())
          ((and (keyword-t? (car o)) (string=? (keyword-t-name (car o)) "encoding"))
           (list (jolt-str-render-one (cadr o))))
          (else (loop (cddr o))))))
;; drain a byte input-stream shim (tagged-table) one byte at a time to a bytevector.
(define (drain-byte-stream src)
  (let loop ((acc '()))
    (let ((b (record-method-dispatch src "read" jolt-nil)))
      (if (or (jolt-nil? b) (and (number? b) (< b 0)))
          (u8-list->bytevector (reverse acc))
          (loop (cons (bitwise-and (jnum->exact b) #xff) acc))))))
(define (jolt-slurp src . opts)
  (cond
    ((jfile? src) (read-file-string (jfile-fs src)))
    ((embedded-res? src) (embedded-res-content src))
    ((reader-jhost? src) (drain-reader src))
    ;; bytes (a bytevector or a jolt byte-array): decode with :encoding (UTF-8
    ;; default). clj-http-lite slurps response-body byte arrays.
    ((bytevector? src) (decode-bytevector src (slurp-encoding opts)))
    ((and (jolt-array? src) (eq? (jolt-array-kind src) 'byte))
     (decode-bytevector (na-bytearray->bv src) (slurp-encoding opts)))
    ;; a byte input-stream shim (e.g. clj-http-lite's :as :stream body): drain it.
    ((and (htable? src) (jolt-truthy? (jolt-ref-get src (keyword "jolt" "input-stream"))))
     (decode-bytevector (drain-byte-stream src) (slurp-encoding opts)))
    ((string? src) (read-file-string (project-relative src)))
    (else (error #f "slurp: unsupported source" src))))

(define (spit-append? opts)
  (let loop ((o opts))
    (cond ((or (null? o) (null? (cdr o))) #f)
          ((and (keyword-t? (car o)) (string=? (keyword-t-name (car o)) "append")
                (jolt-truthy? (cadr o))) #t)
          (else (loop (cddr o))))))

(define (jolt-spit path content . opts)
  (let* ((p (project-relative (file-path-of path)))
         (port (open-output-file p (if (spit-append? opts) 'append 'truncate))))
    (put-string port (jolt-str-render-one content))
    (close-port port)
    jolt-nil))

(define (jolt-flush) (flush-output-port (current-output-port)) jolt-nil)

;; --- str / type / instance? integration ------------------------------------
;; str of a jfile is its path (Clojure's File.toString).
(register-str-render! jfile? jfile-path)

;; stdin line seam: the clojure.core *in* reader (50-io.clj) drives read-line /
;; read / read+string through __stdin-read-line. Return the next line (newline
;; stripped) or nil at EOF. Without this, (read-line) and the REPL call nil.
(def-var! "clojure.core" "__stdin-read-line"
  (lambda () (let ((l (get-line (current-input-port)))) (if (eof-object? l) jolt-nil l))))

;; (type f) -> :jolt/file (the tagged-file :jolt/type). Re-def-var!
;; "type": natives-meta.ss already bound the var to the old jolt-type value, so the
;; set! alone (which updates the symbol for internal callers) wouldn't reach it.
(define io-kw-file (keyword "jolt" "file"))
(define %io-type jolt-type)
(set! jolt-type (lambda (x) (if (jfile? x) io-kw-file (%io-type x))))

;; (instance? java.io.File f): the instance? macro passes the class-name symbol;
;; match "File" / "java.io.File" (and any *.File) against a jfile.
(register-instance-check-arm!
  (lambda (type-sym val)
    (let ((tname (symbol-t-name type-sym)))
      (if (and (jfile? val)
               (or (string=? tname "File") (string=? tname "java.io.File")
                   (string=? (path-last-segment tname) "File")))
          #t
          'pass))))

;; --- def-var! the native names the overlay file-seq + str/slurp use ----
(def-var! "clojure.core" "__make-file" jolt-make-file)
(def-var! "clojure.core" "__file?" jolt-file?)
(def-var! "clojure.core" "__dir?" jolt-dir?)
(def-var! "clojure.core" "__list-dir" (lambda (p) (list->cseq (jolt-list-dir p))))
(def-var! "clojure.core" "slurp" jolt-slurp)
(def-var! "clojure.core" "spit" jolt-spit)
(def-var! "clojure.core" "flush" jolt-flush)

;; --- with-open's close seam (__close): a map-like value closes via its :close
;; fn; a jhost reader/writer/file via its .close method (a no-op here); anything
;; else is an error.
(define (jolt-close x)
  (cond
    ((jolt-nil? x) jolt-nil)
    ((and (jhost? x) (member (jhost-tag x) '("string-reader" "pushback-reader" "writer"
                                             "file-writer" "port-writer" "print-writer")))
     (record-method-dispatch x "close" jolt-nil) jolt-nil)
    ;; a library's stream shim (tagged-table) closes via its registered .close
    ;; method (a no-op for in-memory streams); absent method -> no-op.
    ((htable? x) (guard (e (#t jolt-nil)) (record-method-dispatch x "close" jolt-nil)) jolt-nil)
    ((jfile? x) jolt-nil)
    ;; a deftype/defrecord that implements a `close` method (java.io.Closeable /
    ;; AutoCloseable, e.g. tools.reader's reader types) closes through it — the
    ;; same method (.close x) would dispatch to.
    ((and (jrec? x) (jrec-cl x "close"))
     (record-method-dispatch x "close" jolt-nil) jolt-nil)
    (else
     (let ((closef (jolt-get x (keyword #f "close") jolt-nil)))
       (if (and (not (jolt-nil? closef)) (procedure? closef))
           (begin (jolt-invoke closef) jolt-nil)
           (error #f "with-open: don't know how to close" x))))))
(def-var! "clojure.core" "__close" jolt-close)

;; --- clojure.java.io/reader: an in-memory java.io.Reader over the source. An
;; existing reader passes through; a File / path / URL is slurped; a char[] (or
;; any seq) becomes a reader over (apply str …). Mirrors io.clj's reader. Returns
;; a StringReader (host-static.ss jhost) so .read/.mark/.reset and slurp work.
(define (seq-source->string x)
  (apply string-append (map jolt-str-render-one (seq->list x))))
;; io/reader returns an in-memory StringReader (the full Reader contract incl.
;; (read), mark/reset and pushback). The streaming java.io.FileReader /
;; BufferedReader classes (io-streams.ss) read a Chez port directly when a caller
;; wants to avoid loading the whole source.
(define (jolt-io-reader x)
  (cond
    ((reader-jhost? x) x)
    ((jfile? x) (host-new "StringReader" (read-file-string (jfile-fs x))))
    ((embedded-res? x) (host-new "StringReader" (embedded-res-content x)))
    ((and (jhost? x) (string=? (jhost-tag x) "url"))
     (host-new "StringReader" (read-file-string (url-strip-scheme (url-spec x)))))
    ((string? x) (host-new "StringReader" (read-file-string (project-relative x))))
    ((or (cseq? x) (empty-list-t? x) (pvec? x))
     (host-new "StringReader" (seq-source->string x)))
    (else (host-new "StringReader" (jolt-str-render-one x)))))

;; --- clojure.java.io/writer: an existing writer passes through; a File / path
;; gets a file-backed writer (host-static.ss "file-writer") that persists on
;; flush/close. Mirrors io.clj's writer over the host's StringWriter/file ports.
(define (jolt-io-writer x)
  (cond
    ((and (jhost? x) (string=? (jhost-tag x) "writer")) x)
    ((and (jhost? x) (string=? (jhost-tag x) "file-writer")) x)
    ((jfile? x) (make-jhost "file-writer" (vector (jfile-path x) "")))
    ((string? x) (make-jhost "file-writer" (vector x "")))
    (else (error #f "io/writer: don't know how to create a writer from" x))))

;; --- clojure.java.io ns -----------------------------------------------------
(def-var! "clojure.java.io" "file" jolt-make-file)
(def-var! "clojure.java.io" "as-file" (lambda (x) (if (jfile? x) x (make-jfile (file-path-of x)))))
;; "reader" is bound by natives-array.ss (loaded later) so a char[] argument is
;; handled; that binding delegates here via jolt-io-reader for everything else.
(def-var! "clojure.java.io" "writer" jolt-io-writer)
(def-var! "clojure.java.io" "input-stream" jolt-io-reader)
(def-var! "clojure.java.io" "output-stream" jolt-io-writer)
;; resource: jolt has no classpath, so a named resource is resolved against the
;; loader's source roots (a project's :paths, e.g. "resources"). Returns a File
;; (slurp/reader-able) for the first match, else nil. get-source-roots is the
;; loader's accessor (loader.ss), resolved at call time — the runtime CLI loads it.
(define (jolt-io-resource name)
  (let* ((nm (jolt-str-render-one name))
         (emb (hashtable-ref embedded-resources nm #f)))
    (if emb (make-embedded-res nm emb)
        (let loop ((roots (get-source-roots)))
          (cond ((null? roots) jolt-nil)
                ((file-exists? (string-append (car roots) "/" nm)) (make-jfile (string-append (car roots) "/" nm)))
                (else (loop (cdr roots))))))))
(def-var! "clojure.java.io" "resource" jolt-io-resource)
;; as-url honors a library-registered URL class (e.g. jolt-lang/http-client's full
;; java.net.URL shim) so io/as-url and (URL. spec) agree; else the file-only jhost.
(def-var! "clojure.java.io" "as-url"
  (lambda (x)
    (cond ((and (jhost? x) (string=? (jhost-tag x) "url")) x)
          ((htable? x) x)
          (else (let ((ctor (lookup-class class-ctors-tbl "URL")))
                  (if ctor (ctor (jolt-str-render-one x)) (make-url (jolt-str-render-one x))))))))

;; --- java.lang.ClassLoader --------------------------------------------------
;; jolt has no classpath; a "classloader" resolves a named resource against the
;; loader's source roots (the same model as clojure.java.io/resource), returning a
;; file: URL or nil. getSystemClassLoader / a thread's contextClassLoader both hand
;; back this loader. Libraries that probe the classpath (e.g. migratus's migration-
;; dir discovery) then fall back to the filesystem when a resource isn't a root.
(define the-classloader (make-jhost "classloader" (vector)))
(define (cl-get-resource self name)
  (let ((nm (jolt-str-render-one name)))
    (let loop ((roots (get-source-roots)))
      (cond ((null? roots) jolt-nil)
            ((file-exists? (string-append (car roots) "/" nm))
             (make-url (string-append "file:" (car roots) "/" nm)))
            (else (loop (cdr roots)))))))
;; getResources: every source root that holds the named resource, as file: URLs
;; (enumeration-seq just calls seq, so a list serves). ring's static-resource
;; symlink check enumerates these to confirm a served file sits under a root.
(define (cl-get-resources self name)
  (let ((nm (jolt-str-render-one name)))
    (let loop ((roots (get-source-roots)) (acc '()))
      (cond ((null? roots) (list->cseq (reverse acc)))
            ((file-exists? (string-append (car roots) "/" nm))
             (loop (cdr roots) (cons (make-url (string-append "file:" (car roots) "/" nm)) acc)))
            (else (loop (cdr roots) acc))))))
(register-host-methods! "classloader"
  (list (cons "getResource" cl-get-resource)
        (cons "getResources" cl-get-resources)
        (cons "getResourceAsStream"
              (lambda (self name)
                (let ((u (cl-get-resource self name)))
                  (if (jolt-nil? u) jolt-nil (host-new "StringReader" (jolt-slurp (url-strip-scheme (url-spec u))))))))))
(register-class-statics! "ClassLoader" (list (cons "getSystemClassLoader" (lambda () the-classloader))))
(register-class-statics! "java.lang.ClassLoader" (list (cons "getSystemClassLoader" (lambda () the-classloader))))
;; clojure.lang.RT/baseLoader — the resource-resolving class loader (RT/baseLoader
;; is how libraries reach Clojure's base loader, e.g. aws-api's resources ns).
(register-class-statics! "RT" (list (cons "baseLoader" (lambda () the-classloader))))
(register-class-statics! "clojure.lang.RT" (list (cons "baseLoader" (lambda () the-classloader))))
;; clojure.lang.RT/nextID — process-unique increasing id (AtomicInteger(1)
;; getAndIncrement), used by id generators such as core.logic's lvar.
(define rt-next-id-counter 1)
(define (rt-next-id)
  (let ((v rt-next-id-counter))
    (set! rt-next-id-counter (+ rt-next-id-counter 1))
    v))
(register-class-statics! "RT" (list (cons "nextID" rt-next-id)))
(register-class-statics! "clojure.lang.RT" (list (cons "nextID" rt-next-id)))
;; clojure.lang.Util — hash/equality helpers libraries call directly (core.logic's
;; LCons.hashCode uses Util/hash). hash = Java hashCode (0 for nil); hasheq = the
;; value hash jolt's = uses; equiv = value equality; identical = reference identity.
(let ((util-statics
       (list (cons "hash" (lambda (x) (if (jolt-nil? x) 0 (record-method-dispatch x "hashCode" jolt-nil))))
             (cons "hasheq" (lambda (x) (jolt-hash x)))
             (cons "equiv" (lambda (a b) (if (jolt= a b) #t #f)))
             (cons "identical" (lambda (a b) (if (eq? a b) #t #f))))))
  (register-class-statics! "Util" util-statics)
  (register-class-statics! "clojure.lang.Util" util-statics))
;; Thread/currentThread -> a fresh thread jhost wrapping THIS thread's interrupt
;; flag (the box from current-interrupt-box, host-static.ss), so .interrupt from
;; any thread sets the target thread's flag and .isInterrupted reads it without
;; clearing (instance semantics; the static Thread/interrupted reads-and-clears).
;; getContextClassLoader hands back the loader.
(register-host-methods! "thread"
  (list (cons "getContextClassLoader" (lambda (self) the-classloader))
        (cons "getName" (lambda (self) "main"))
        ;; no reified call stack (jolt does TCO, so caller frames are erased) — an
        ;; empty StackTraceElement[]. clojure.spec.test.alpha's instrument reads it
        ;; to name the caller var; it degrades to no ::caller, the conform error
        ;; (the ExceptionInfo) is still thrown.
        (cons "getStackTrace" (lambda (self) (jolt-vector)))
        (cons "interrupt" (lambda (self)
                            (when (box? (jhost-state self)) (set-box! (jhost-state self) #t))
                            jolt-nil))
        (cons "isInterrupted" (lambda (self)
                                (and (box? (jhost-state self)) (unbox (jhost-state self)) #t)))))
(define (current-thread-handle) (make-jhost "thread" (current-interrupt-box)))
(register-class-statics! "Thread" (list (cons "currentThread" current-thread-handle)))
(register-class-statics! "java.lang.Thread" (list (cons "currentThread" current-thread-handle)))

;; --- java.io.File / java.util.UUID constructors -----------------------------
;; (java.io.File. parent child) joins with "/"; (File. path) wraps the path.
(register-class-ctor! "File"
  (lambda (a . rest)
    (if (pair? rest)
        (jolt-make-file (string-append (file-path-of a) "/" (file-path-of (car rest))))
        (jolt-make-file a))))
;; File statics: the platform separators plus createTempFile / listRoots.
(define temp-file-counter 0)
(define (file-create-temp prefix suffix . dir)
  (let* ((d (cond ((pair? dir) (file-path-of (car dir)))
                  ((getenv "TMPDIR") => (lambda (t) t))
                  (else "/tmp")))
         (sfx (if (or (null? (list suffix)) (jolt-nil? suffix)) ".tmp" (jolt-str-render-one suffix))))
    (set! temp-file-counter (+ temp-file-counter 1))
    (let loop ((n temp-file-counter))
      (let ((p (string-append d "/" (jolt-str-render-one prefix)
                              (number->string (now-millis)) "-" (number->string n) sfx)))
        (if (file-exists? p) (loop (+ n 1))
            (begin (close-port (open-output-file p 'truncate)) (make-jfile p)))))))
(let ((statics (list (cons "separator" "/")
                     (cons "separatorChar" #\/)
                     (cons "pathSeparator" ":")
                     (cons "pathSeparatorChar" #\:)
                     (cons "createTempFile" file-create-temp)
                     (cons "listRoots" (lambda () (jolt-vector (make-jfile "/")))))))
  (register-class-statics! "File" statics)
  (register-class-statics! "java.io.File" statics))
(register-class-ctor! "java.io.File"
  (lambda (a . rest)
    (if (pair? rest)
        (jolt-make-file (string-append (file-path-of a) "/" (file-path-of (car rest))))
        (jolt-make-file a))))
;; UUID: randomUUID / fromString statics + a (UUID. s) string ctor.
(register-class-statics! "UUID"
  (list (cons "randomUUID" (lambda () (jolt-random-uuid)))
        (cons "fromString" (lambda (s) (jolt-parse-uuid (jolt-str-render-one s))))))
(register-class-statics! "java.util.UUID"
  (list (cons "randomUUID" (lambda () (jolt-random-uuid)))
        (cons "fromString" (lambda (s) (jolt-parse-uuid (jolt-str-render-one s))))))
;; (UUID. msb lsb): build from the most/least-significant 64-bit halves (the JVM's
;; 2-long ctor), the form test.check's uuid generator uses. (UUID. s) parses a
;; string. The 128 bits format as the canonical 8-4-4-4-12 lowercase hex string.
(define (uuid-long->hex16 n)
  (let* ((u (bitwise-and (jnum->exact n) #xFFFFFFFFFFFFFFFF))
         (s (string-downcase (number->string u 16))))   ; JVM UUIDs are lowercase
    (string-append (make-string (- 16 (string-length s)) #\0) s)))
(define (uuid-from-halves msb lsb)
  (let ((h (uuid-long->hex16 msb)) (l (uuid-long->hex16 lsb)))
    (make-juuid (string-append (substring h 0 8) "-" (substring h 8 12) "-" (substring h 12 16)
                               "-" (substring l 0 4) "-" (substring l 4 16)))))
(define (uuid-ctor . args)
  (if (= (length args) 2)
      (uuid-from-halves (car args) (cadr args))
      (jolt-parse-uuid (jolt-str-render-one (car args)))))
(register-class-ctor! "UUID" uuid-ctor)
(register-class-ctor! "java.util.UUID" uuid-ctor)
;; (Long. n) / (Long. "n"): a Long is just jolt's integer; return it (parse a string).
(register-class-ctor! "Long" (lambda (x) (if (string? x) (parse-int-or-throw x 10 "Long") (->num (jnum->exact x)))))
(register-class-ctor! "java.lang.Long" (lambda (x) (if (string? x) (parse-int-or-throw x 10 "Long") (->num (jnum->exact x)))))
;; (Integer. n) / (Integer. "n"): jolt's integer, range-checked like intCast.
(define (integer-ctor x)
  (jolt-int-cast (if (string? x) (parse-int-or-throw x 10 "Integer") x)))
(register-class-ctor! "Integer" integer-ctor)
(register-class-ctor! "java.lang.Integer" integer-ctor)
;; (Double. x) / (Double. "x"): jolt's double.
(define (double-ctor x)
  (if (string? x)
      (let ((n (string->number x)))
        (if n (exact->inexact n)
            (jolt-throw (jolt-host-throwable "java.lang.NumberFormatException"
                                             (string-append "For input string: \"" x "\"")))))
      (jolt-double x)))
(register-class-ctor! "Double" double-ctor)
(register-class-ctor! "java.lang.Double" double-ctor)

;; (Boolean. "true") / (Boolean. b): true for the string "true" (case-insensitive,
;; anything else false) or the boolean itself — Boolean.valueOf semantics; the
;; box is jolt's plain boolean.
(define (boolean-ctor x)
  (cond ((string? x) (string-ci=? x "true"))
        ((boolean? x) x)
        (else #f)))
(register-class-ctor! "Boolean" boolean-ctor)
(register-class-ctor! "java.lang.Boolean" boolean-ctor)

;; --- java.net.URI -----------------------------------------------------------
;; A minimal RFC-3986 split into scheme/authority/host/port/path/query/fragment,
;; kept in a jhost "uri" carrying the original string. (str u)/(.toString u) give
;; the original; getHost is nil for a relative URI (hiccup.util/to-str branches on
;; it). instance? java.net.URI + extend-protocol dispatch work via value-host-tags.
(define (uri-index-of s ch from)
  (let ((n (string-length s)))
    (let loop ((i from)) (cond ((>= i n) #f) ((char=? (string-ref s i) ch) i) (else (loop (+ i 1)))))))
(define (uri-scheme-end s)
  ;; index of ':' that ends a scheme (letter then alnum/+-. before any /?#), or #f.
  (let ((n (string-length s)))
    (and (> n 0) (char-alphabetic? (string-ref s 0))
         (let loop ((i 1))
           (cond ((>= i n) #f)
                 ((char=? (string-ref s i) #\:) i)
                 ((let ((c (string-ref s i)))
                    (or (char-alphabetic? c) (char-numeric? c) (char=? c #\+) (char=? c #\-) (char=? c #\.)))
                  (loop (+ i 1)))
                 (else #f))))))
(define (uri-parse s)
  (let* ((n (string-length s))
         (se (uri-scheme-end s))
         (scheme (and se (substring s 0 se)))
         (rest-start (if se (+ se 1) 0))
         ;; fragment
         (hash (uri-index-of s #\# rest-start))
         (frag (and hash (substring s (+ hash 1) n)))
         (pre-frag-end (or hash n))
         ;; query
         (qm (uri-index-of s #\? rest-start))
         (query (and qm (< qm pre-frag-end) (substring s (+ qm 1) pre-frag-end)))
         (hp-end (cond ((and qm (< qm pre-frag-end)) qm) (else pre-frag-end)))
         ;; authority (after "//")
         (has-auth (and (<= (+ rest-start 2) n)
                        (char=? (string-ref s rest-start) #\/)
                        (char=? (string-ref s (+ rest-start 1)) #\/)))
         (auth-start (and has-auth (+ rest-start 2)))
         (auth-end (and has-auth
                        (let loop ((i auth-start))
                          (cond ((>= i hp-end) hp-end)
                                ((char=? (string-ref s i) #\/) i)
                                (else (loop (+ i 1)))))))
         (authority (and has-auth (substring s auth-start auth-end)))
         (path-start (if has-auth auth-end rest-start))
         (path (substring s path-start hp-end)))
    ;; host:port from authority (strip userinfo@)
    (let* ((at (and authority (uri-index-of authority #\@ 0)))
           (hostport (if at (substring authority (+ at 1) (string-length authority)) authority))
           (colon (and hostport (uri-index-of hostport #\: 0)))
           (host (cond ((not hostport) jolt-nil)
                       (colon (substring hostport 0 colon))
                       (else hostport)))
           (port (if (and colon (< (+ colon 1) (string-length hostport)))
                     (or (string->number (substring hostport (+ colon 1) (string-length hostport))) -1)
                     -1)))
      (make-jhost "uri"
        (list (cons 'string s)
              (cons 'scheme (or scheme jolt-nil))
              (cons 'authority (or authority jolt-nil))
              (cons 'host (if (and host (string? host) (= 0 (string-length host))) jolt-nil host))
              (cons 'port (->num port))
              (cons 'path (if (= 0 (string-length path)) (if has-auth "" jolt-nil) path))
              (cons 'query (or query jolt-nil))
              (cons 'fragment (or frag jolt-nil)))))))
(define (uri-field u k) (let ((p (assq k (jhost-state u)))) (if p (cdr p) jolt-nil)))
(register-class-ctor! "URI" (lambda (s) (uri-parse (jolt-str-render-one s))))
(register-class-ctor! "java.net.URI" (lambda (s) (uri-parse (jolt-str-render-one s))))
;; URI/create — the static factory, same as the (URI. s) constructor.
(register-class-statics! "URI" (list (cons "create" (lambda (s) (uri-parse (jolt-str-render-one s))))))
(register-class-statics! "java.net.URI" (list (cons "create" (lambda (s) (uri-parse (jolt-str-render-one s))))))
(register-host-methods! "uri"
  (list (cons "toString" (lambda (u) (uri-field u 'string)))
        (cons "toASCIIString" (lambda (u) (uri-field u 'string)))
        (cons "getScheme" (lambda (u) (uri-field u 'scheme)))
        (cons "getAuthority" (lambda (u) (uri-field u 'authority)))
        (cons "getHost" (lambda (u) (uri-field u 'host)))
        (cons "getPort" (lambda (u) (uri-field u 'port)))
        (cons "getPath" (lambda (u) (uri-field u 'path)))
        (cons "getRawPath" (lambda (u) (uri-field u 'path)))
        (cons "getQuery" (lambda (u) (uri-field u 'query)))
        (cons "getRawQuery" (lambda (u) (uri-field u 'query)))
        (cons "getFragment" (lambda (u) (uri-field u 'fragment)))
        (cons "isAbsolute" (lambda (u) (not (jolt-nil? (uri-field u 'scheme)))))
        (cons "hashCode" (lambda (u) (string-hash (uri-field u 'string))))
        (cons "equals" (lambda (u o) (and (jhost? o) (string=? (jhost-tag o) "uri")
                                          (string=? (uri-field u 'string) (uri-field o 'string)))))))
;; (= u1 u2) is value equality by string form (the .equals method above only
;; serves explicit (.equals …)); hash matches so a URI works as a map key / set
;; member (ring/hiccup compare (URI. "/") values).
(define (uri-jhost? x) (and (jhost? x) (string=? (jhost-tag x) "uri")))
(register-eq-arm! (lambda (a b) (or (uri-jhost? a) (uri-jhost? b)))
                  (lambda (a b) (and (uri-jhost? a) (uri-jhost? b)
                                     (string=? (uri-field a 'string) (uri-field b 'string)))))
(register-hash-arm! uri-jhost? (lambda (x) (string-hash (uri-field x 'string))))
;; str / pr-str of a uri -> its string form.
(register-str-render! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "uri")))
                      (lambda (x) (uri-field x 'string)))
(register-pr-readable-arm! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "uri")))
                           (lambda (x) (string-append "#object[java.net.URI \"" (uri-field x 'string) "\"]")))
;; class of the host value types defined by now (uri/uuid/file).
(register-class-arm! (lambda (x) (and (jhost? x) (string=? (jhost-tag x) "uri"))) (lambda (x) "java.net.URI"))
(register-class-arm! juuid? (lambda (x) "java.util.UUID"))
(register-class-arm! jfile? (lambda (x) "java.io.File"))