;;; http-static-server-adaptive.lsp — static server that learns which
;;; paths matter. A hit counter per URL is updated on every request and
;;; periodically flushed to disk (*hits-path*, newline-delimited
;;; "url count" records). At startup, if hit data exists from a prior
;;; run, the top *cache-max* URLs are preloaded; otherwise we fall
;;; back to *seed-paths* (a minimal cold-start set).
;;;
;;; This is the "~95% of the win" version of predictive preloading
;;; for small deployments (<=1000 resources). The DAG-of-hot-paths
;;; variant for larger fleets is future work — see whitepaper §Future.
;;;
;;; Assets above *inline-threshold* bytes are cached as
;;; headers-only + fs-path and streamed via tcp-sendfile, same as
;;; http-static-server-sendfile.lsp.

(define *port*              8080)
(define *docroot*           "www")
(define *hits-path*         "www.hits")
(define *cache-max*         100)
(define *max-requests*      1000000)
(define *inline-threshold*  16384)
(define *hits-save-every*   500)

(define *crlf*              "\r\n")
(define *crlf-crlf*         "\r\n\r\n")

;;; Seed paths used on first boot (no hit history yet). Anything
;;; requested afterwards gets learned and promoted across restarts.
(define *seed-paths*
  (list "/"
        "/404.html"))

;;; ── helpers ─────────────────────────────────────────────────

(define SPACE   32)
(define NEWLINE 10)
(define ZERO    48)
(define NINE    57)

(define (char-at s i) (char->integer (string-ref s i)))

(define (ends-with? s suffix)
  (let ((ns (string-length s)) (nf (string-length suffix)))
    (if (< ns nf) #f
        (string=? suffix (substring s (- ns nf) ns)))))

(define (mime-of path)
  (cond
    ((ends-with? path ".html") "text/html; charset=utf-8")
    ((ends-with? path ".css")  "text/css; charset=utf-8")
    ((ends-with? path ".pdf")  "application/pdf")
    ((ends-with? path ".txt")  "text/plain; charset=utf-8")
    ((ends-with? path ".js")   "application/javascript")
    ((ends-with? path ".svg")  "image/svg+xml")
    ((ends-with? path ".png")  "image/png")
    ((ends-with? path ".jpg")  "image/jpeg")
    ((ends-with? path ".ico")  "image/x-icon")
    (else "application/octet-stream")))

(define (url-to-fs url-path)
  (cond
    ((string=? url-path "/") (string-append *docroot* "/index.html"))
    (else (string-append *docroot* url-path))))

(define (inline-response status ctype body)
  (string-append
    "HTTP/1.0 " status *crlf*
    "Content-Type: " ctype *crlf*
    "Content-Length: " (number->string (string-length body)) *crlf*
    "Connection: close" *crlf-crlf*
    body))

(define (headers-only status ctype nbytes)
  (string-append
    "HTTP/1.0 " status *crlf*
    "Content-Type: " ctype *crlf*
    "Content-Length: " (number->string nbytes) *crlf*
    "Connection: close" *crlf-crlf*))

;;; ── hit-counter persistence ─────────────────────────────────

(define *hits* (make-hash-table))

(define (bump-hit! path)
  (let ((n (hash-table-ref/default *hits* path 0)))
    (hash-table-set! *hits* path (+ n 1))))

;;; Serialize *hits* to "url count\n" lines and write atomically.
(define (hits-save)
  (let loop ((keys (hash-table-keys *hits*)) (acc ""))
    (cond
      ((null? keys) (write-file *hits-path* acc))
      (else
        (let ((k (car keys)))
          (loop (cdr keys)
                (string-append acc k " "
                               (number->string
                                 (hash-table-ref/default *hits* k 0))
                               "\n")))))))

;;; Parse "url count\n" records into a list of (url . count) pairs.
;;; Defensive — skips malformed lines so a corrupt hits file never
;;; takes the server down.
(define (parse-int-token s i len)
  (let loop ((j i) (n 0))
    (cond
      ((= j len) (cons n j))
      ((and (>= (char-at s j) ZERO) (<= (char-at s j) NINE))
       (loop (+ j 1) (+ (* n 10) (- (char-at s j) ZERO))))
      (else (cons n j)))))

(define (parse-line s start end)
  ;; end is the index of '\n' (or the length). Split on first space.
  (let loop ((i start))
    (cond
      ((>= i end) #f)
      ((= (char-at s i) SPACE)
       (let ((pr (parse-int-token s (+ i 1) end)))
         (cons (substring s start i) (car pr))))
      (else (loop (+ i 1))))))

(define (hits-parse s)
  (let ((n (string-length s)))
    (let loop ((i 0) (acc '()))
      (cond
        ((>= i n) (reverse acc))
        (else
          (let find-nl ((j i))
            (cond
              ((or (= j n) (= (char-at s j) NEWLINE))
               (let ((rec (parse-line s i j)))
                 (loop (+ j 1) (if rec (cons rec acc) acc))))
              (else (find-nl (+ j 1))))))))))

(define (hits-load)
  (let ((s (file->string *hits-path*)))
    (if s (hits-parse s) '())))

;;; Insertion sort by cdr descending. N is cache-max, so O(N²) is fine.
(define (insert-desc x xs)
  (cond
    ((null? xs) (list x))
    ((>= (cdr x) (cdr (car xs))) (cons x xs))
    (else (cons (car xs) (insert-desc x (cdr xs))))))

(define (sort-desc pairs)
  (let loop ((in pairs) (out '()))
    (cond
      ((null? in) out)
      (else (loop (cdr in) (insert-desc (car in) out))))))

(define (take n xs)
  (cond
    ((or (= n 0) (null? xs)) '())
    (else (cons (car xs) (take (- n 1) (cdr xs))))))

;;; ── cache (headers + either body or fs-path) ────────────────

(define *cache-inline*   (make-hash-table))
(define *cache-sendfile* (make-hash-table))

(define (cache-count)
  (+ (hash-table-size *cache-inline*)
     (hash-table-size *cache-sendfile*)))

(define (cache-add! url-path)
  (if (>= (cache-count) *cache-max*)
      'capped
      (let ((fs-path (url-to-fs url-path)))
        (let ((body (file->string fs-path)))
          (cond
            ((not body) 'missing)
            ((<= (string-length body) *inline-threshold*)
              (hash-table-set! *cache-inline* url-path
                (inline-response "200 OK" (mime-of fs-path) body))
              'inline)
            (else
              (hash-table-set! *cache-sendfile* url-path
                (cons (headers-only "200 OK" (mime-of fs-path)
                                    (string-length body))
                      fs-path))
              'sendfile))))))

(define (preload-all paths)
  (cond
    ((null? paths) 'done)
    (else (cache-add! (car paths)) (preload-all (cdr paths)))))

(define (preload-top-n ranked n)
  ;; ranked is ((url . count) ...), preload URLs only.
  (let loop ((xs ranked) (left n))
    (cond
      ((or (null? xs) (= left 0)) 'done)
      (else
        (cache-add! (car (car xs)))
        (loop (cdr xs) (- left 1))))))

;;; ── startup: load hits, rank, preload ───────────────────────

(define *resp-404*
  (let ((body (file->string (string-append *docroot* "/404.html"))))
    (if body
        (inline-response "404 Not Found" "text/html; charset=utf-8" body)
        (inline-response "404 Not Found" "text/plain" "not found\n"))))

(define *boot-hits* (hits-load))
(cond
  ((null? *boot-hits*)
    (display "adaptive: cold start — preloading seed paths") (newline)
    (preload-all *seed-paths*))
  (else
    (display "adaptive: loaded ") (display (length *boot-hits*))
    (display " hit records, preloading top ") (display *cache-max*)
    (newline)
    (preload-top-n (sort-desc *boot-hits*) *cache-max*)
    ;; Re-seed the in-memory counter from disk so learned ranks
    ;; don't reset each boot.
    (let loop ((xs *boot-hits*))
      (cond
        ((null? xs) 'done)
        (else
          (hash-table-set! *hits* (car (car xs)) (cdr (car xs)))
          (loop (cdr xs)))))))

;;; ── per-request ─────────────────────────────────────────────

(define (second-token s)
  (let ((len (string-length s)))
    (let loop1 ((i 0))
      (cond
        ((= i len) "/")
        ((= (char-at s i) SPACE)
         (let loop2 ((j (+ i 1)))
           (cond
             ((= j len) (substring s (+ i 1) len))
             ((= (char-at s j) SPACE) (substring s (+ i 1) j))
             (else (loop2 (+ j 1))))))
        (else (loop1 (+ i 1)))))))

(define (serve client req)
  (let ((path (second-token req)))
    (bump-hit! path)
    (let ((inline (hash-table-ref/default *cache-inline* path #f)))
      (if inline
          (tcp-send client inline)
          (let ((sf (hash-table-ref/default *cache-sendfile* path #f)))
            (if sf
                (begin
                  (tcp-send     client (car sf))
                  (tcp-sendfile client (cdr sf)))
                ;; Cold path: try to warm the cache for next hit,
                ;; then serve via the new entry. Caps at *cache-max*.
                (let ((tag (cache-add! path)))
                  (cond
                    ((equal? tag 'inline)
                      (tcp-send client
                        (hash-table-ref/default *cache-inline* path *resp-404*)))
                    ((equal? tag 'sendfile)
                      (let ((sf2 (hash-table-ref/default *cache-sendfile* path #f)))
                        (tcp-send     client (car sf2))
                        (tcp-sendfile client (cdr sf2))))
                    (else
                      (tcp-send client *resp-404*))))))))))

;;; ── main loop ───────────────────────────────────────────────
;;;
;;; This server mutates persistent state on every request
;;; (hit-counter bump, cold-path cache promotion), so the
;;; arena-pattern heap-restore used by the other servers would
;;; corrupt the hits table and cache. We run under lumbda-gc
;;; and rely on mark-sweep to reclaim per-request transients.

(define server (tcp-listen *port*))

(define (server-loop n)
  (if (>= n *max-requests*)
      (begin
        (display "request cap reached, exiting\n")
        (hits-save)
        (tcp-close server))
      (begin
        (let ((client (tcp-accept server)))
          (let ((req (tcp-recv client 4096)))
            (if (and req (> (string-length req) 0))
                (serve client req)
                #f))
          (tcp-close client))
        (if (and (> n 0) (= (remainder n *hits-save-every*) 0))
            (hits-save)
            #f)
        (server-loop (+ n 1)))))

(display "lumbda-www adaptive on :") (display *port*)
(display " serving ") (display *docroot*)
(display " (") (display (cache-count)) (display "/") (display *cache-max*)
(display " cached, hits=") (display *hits-path*) (display ")")
(newline)
(server-loop 0)