;; lib/host/otel.sx — OpenTelemetry in SX, P1: the span model + API.
;;
;; A TRACE is a COMPOSITION: a span is {:trace :span :parent :name :t0 :t1 :attrs
;; :events}, so a trace is a tree of spans (the same shape as an object's :body
;; composition). Later phases fold that tree into a waterfall (render-fold), OTLP
;; JSON (export-fold) and metrics (aggregate-fold). This phase gives us the model,
;; the dynamic parent stack that builds the tree, and a bounded in-memory ring
;; buffer — spans are cheap timed effects, NOT durable KV rows.

;; ── monotonic id + clock ─────────────────────────────────────────────
;; A simple process-monotonic counter gives collision-free ids without needing a
;; random source (Math.random/Date.now aren't available on this host).
(define otel/-id-counter 0)
(define otel/-next-id
  (fn (prefix)
    (begin
      (set! otel/-id-counter (+ otel/-id-counter 1))
      (str prefix otel/-id-counter))))
(define otel/gen-trace-id (fn () (otel/-next-id "trace-")))
(define otel/gen-span-id  (fn () (otel/-next-id "span-")))

;; now-ns — real epoch time in NANOSECONDS (the unit OTLP wants for
;; start/endTimeUnixNano). The OCaml host exposes `clock-milliseconds`
;; (Unix.gettimeofday, epoch ms); we scale by 1e6. Wall clocks can step
;; backwards (NTP), so we clamp against a high-water mark: now-ns never
;; decreases, keeping span durations non-negative even across a clock step.
(define otel/-last-ns 0)
(define otel/now-ns
  (fn ()
    (let ((raw (* (clock-milliseconds) 1000000)))
      (let ((t (if (> raw otel/-last-ns) raw otel/-last-ns)))
        (begin
          (set! otel/-last-ns t)
          t)))))

;; ── the dynamic parent stack ─────────────────────────────────────────
;; head = the innermost (current) span context {:span id :trace id}. Pushing on
;; with-span entry / popping on exit is what turns lexical nesting into parent
;; links, so a trace tree falls out of ordinary call nesting.
(define otel/-stack (list))
(define otel/-push! (fn (ctx) (set! otel/-stack (cons ctx otel/-stack))))
(define otel/-pop!  (fn () (set! otel/-stack (rest otel/-stack))))
(define otel/-top   (fn () (if (= (len otel/-stack) 0) nil (first otel/-stack))))

(define otel/current-span
  (fn () (let ((t (otel/-top))) (if t (get t :span) nil))))
(define otel/current-trace
  (fn () (let ((t (otel/-top))) (if t (get t :trace) nil))))

;; ── the bounded ring buffer ──────────────────────────────────────────
;; Oldest → newest. record! appends and drops from the front once over cap, so the
;; buffer stays O(cap) no matter how many spans flow through. NOT persisted.
(define otel/-cap 1000)
(define otel/-ring (list))
(define otel/set-cap! (fn (n) (begin (set! otel/-cap n) nil)))

(define otel/record!
  (fn (span)
    (begin
      (set! otel/-ring (append otel/-ring (list span)))
      (if (> (len otel/-ring) otel/-cap)
        (set! otel/-ring (slice otel/-ring (- (len otel/-ring) otel/-cap)))
        nil)
      span)))

(define otel/recent (fn () otel/-ring))

;; Clear the ring AND the parent stack — used between tests / requests.
(define otel/reset!
  (fn ()
    (begin
      (set! otel/-ring (list))
      (set! otel/-stack (list))
      nil)))

;; ── -timed: the shared timed-effect core ─────────────────────────────
;; Records a span around (thunk): a fresh span id, the trace inherited from the
;; enclosing span (or a new trace at the root), the enclosing span as :parent, and
;; t0/t1 straddling the call. Pushes its context so nested spans see it as parent,
;; pops after, then records the finished span. `finalize` maps the thunk's result
;; to EXTRA attrs merged onto `attrs` (e.g. an http.status only known post-call).
;; Returns the thunk's value unchanged.
(define otel/-timed
  (fn (name attrs finalize thunk)
    (let ((parent-ctx (otel/-top)))
      (let ((trace  (if parent-ctx (get parent-ctx :trace) (otel/gen-trace-id)))
            (span   (otel/gen-span-id))
            (parent (if parent-ctx (get parent-ctx :span) nil)))
        (let ((t0 (begin (otel/-push! {:span span :trace trace}) (otel/now-ns))))
          (let ((result (thunk)))
            (let ((t1 (otel/now-ns)))
              (begin
                (otel/-pop!)
                (otel/record!
                  {:trace trace :span span :parent parent :name name
                   :t0 t0 :t1 t1
                   :attrs (merge attrs (finalize result))
                   :events (list)})
                result))))))))

;; with-span — a plain timed span; no result-derived attrs.
(define otel/with-span
  (fn (name attrs thunk)
    (otel/-timed name attrs (fn (r) {}) thunk)))

;; ── auto-instrument HTTP handlers ─────────────────────────────────────
;; A trace is a composition; a request handler is a timed effect. Wrap one Dream
;; route's handler so dispatching it records a root span "METHOD /route" with
;; {:http.method :http.route :http.status}. The status is only known after the
;; handler runs, so it's a finalize attr; the result is coerced the same way the
;; router coerces it, so a bare-string handler still reports 200. The raw handler
;; result is returned untouched so dr/run-route's own coercion is unchanged.
(define otel/instrument-route
  (fn (r)
    (let ((method  (dream-route-method r))
          (path    (dream-route-path r))
          (handler (dream-route-handler r)))
      (dream-route method path
        (fn (req)
          (otel/-timed
            (str method " " path)
            {:http.method method :http.route path}
            (fn (resp) {:http.status (dream-status (dream-coerce-response resp))})
            (fn () (handler req))))))))

;; Flatten nested route groups and instrument each route — the host/make-app seam.
(define otel/instrument-routes
  (fn (routes) (map otel/instrument-route (dr/flatten-routes routes))))

;; ── P4: render-fold → SVG waterfall ───────────────────────────────────
;; A trace is a tree of spans; a waterfall is a fold over that tree into SVG (the
;; same discipline as the compose render-fold: walk the structure, emit per node).
;; Layout: x ∝ (t0 − trace.t0), width ∝ duration, y ∝ depth (ancestor count via
;; parent links). Geometry is computed as plain rect data first (otel/waterfall-
;; rects, testable), then folded into <svg> markup (otel/waterfall).
(define otel/-row-h 18)
(define otel/-svg-w 640)
(define otel/-pad 4)

;; all spans belonging to one trace, from the ring.
(define otel/trace-spans
  (fn (trace-id) (filter (fn (s) (= (get s :trace) trace-id)) (otel/recent))))

(define otel/-span-by-id
  (fn (spans id) (first (filter (fn (s) (= (get s :span) id)) spans))))

;; depth = number of ancestors reachable via :parent within this trace's spans.
(define otel/-depth
  (fn (s spans)
    (if (nil? (get s :parent))
      0
      (let ((p (otel/-span-by-id spans (get s :parent))))
        (if (nil? p) 0 (+ 1 (otel/-depth p spans)))))))

;; trace start = earliest t0; end = latest t1 (folds over the spans).
(define otel/-min-t0
  (fn (spans) (reduce (fn (m s) (min m (get s :t0))) (get (first spans) :t0) spans)))
(define otel/-max-t1
  (fn (spans) (reduce (fn (m s) (max m (get s :t1))) (get (first spans) :t1) spans)))

;; a rect per span: {:span :name :depth :x :y :w}. x/width are scaled to the
;; drawable width; a zero-duration span still gets a 1px sliver so it's visible.
(define otel/waterfall-rects
  (fn (trace-id)
    (let ((spans (otel/trace-spans trace-id)))
      (if (empty? spans)
        (list)
        (let ((t0 (otel/-min-t0 spans))
              (t1 (otel/-max-t1 spans))
              (iw (- otel/-svg-w (* 2 otel/-pad))))
          (let ((total (if (> (- t1 t0) 0) (- t1 t0) 1)))
            (map
              (fn (s)
                (let ((d (otel/-depth s spans))
                      (dur (- (get s :t1) (get s :t0))))
                  (let ((raw-w (* (/ dur total) iw)))
                    {:span (get s :span)
                     :name (get s :name)
                     :depth d
                     :x (+ otel/-pad (* (/ (- (get s :t0) t0) total) iw))
                     :y (+ otel/-pad (* d otel/-row-h))
                     :w (if (> raw-w 1) raw-w 1)})))
              spans)))))))

;; one <g> (bar + label) per rect.
(define otel/-rect->g
  (fn (r)
    (quasiquote
      (g
        (rect :x (unquote (get r :x)) :y (unquote (get r :y))
              :width (unquote (get r :w)) :height (unquote (- otel/-row-h 2))
              :fill "#4c78a8" :rx 2)
        (text :x (unquote (+ (get r :x) 3)) :y (unquote (+ (get r :y) 12))
              :font-size 10 :fill "#ffffff" (unquote (get r :name)))))))

;; max depth across rects (0 when empty) → svg height.
(define otel/-max-depth
  (fn (rects) (reduce (fn (m r) (max m (get r :depth))) 0 rects)))

;; the trace as an inline <svg> waterfall.
(define otel/waterfall
  (fn (trace-id)
    (let ((rects (otel/waterfall-rects trace-id)))
      (let ((h (+ (* 2 otel/-pad) (* (+ (otel/-max-depth rects) 1) otel/-row-h))))
        (quasiquote
          (svg :width (unquote otel/-svg-w) :height (unquote h)
               :xmlns "http://www.w3.org/2000/svg"
               (splice-unquote (map otel/-rect->g rects))))))))

;; count nodes whose head symbol prints as `head` — a small SVG-tree assertion aid.
(define otel/-tree-count
  (fn (tree head)
    (if (list? tree)
      (let ((self (if (and (not (empty? tree)) (= (str (first tree)) head)) 1 0)))
        (reduce (fn (acc n) (+ acc (otel/-tree-count n head))) self tree))
      0)))

;; ── P5: metrics (aggregate-fold) ──────────────────────────────────────
;; Fold the recent spans into per-route request counts + a latency histogram
;; (p50/p95/p99 from durations). No `sort` primitive here, so percentiles ride a
;; tiny insertion sort; nearest-rank keeps the maths exact for the tests.
(define otel/-insert
  (fn (x sorted)
    (if (empty? sorted)
      (list x)
      (if (<= x (first sorted))
        (cons x sorted)
        (cons (first sorted) (otel/-insert x (rest sorted)))))))
(define otel/-sort-nums
  (fn (lst) (reduce (fn (acc x) (otel/-insert x acc)) (list) lst)))

;; nearest-rank percentile of an ASCENDING list: rank = ceil(p/100 · N), 1-based.
(define otel/-percentile
  (fn (sorted p)
    (if (empty? sorted)
      0
      (let ((n (len sorted)))
        (let ((idx (- (ceil (* (/ p 100) n)) 1)))
          (let ((i (if (< idx 0) 0 (if (>= idx n) (- n 1) idx))))
            (nth sorted i)))))))

;; a span's route label: the http.route attr, else the span name.
(define otel/-span-route
  (fn (s) (or (get (get s :attrs) :http.route) (get s :name))))

(define otel/-span-dur (fn (s) (- (get s :t1) (get s :t0))))

;; distinct values, order-preserving.
(define otel/-distinct
  (fn (lst)
    (reduce
      (fn (acc x) (if (some (fn (y) (= y x)) acc) acc (append acc (list x))))
      (list)
      lst)))

;; the aggregate for one route: count + latency percentiles over its durations.
(define otel/route-metrics
  (fn (spans route)
    (let ((rs (filter (fn (s) (= (otel/-span-route s) route)) spans)))
      (let ((durs (otel/-sort-nums (map otel/-span-dur rs))))
        {:route route
         :count (len rs)
         :p50 (otel/-percentile durs 50)
         :p95 (otel/-percentile durs 95)
         :p99 (otel/-percentile durs 99)}))))

;; fold spans → {:total-requests N :routes (per-route metrics …)}.
(define otel/metrics
  (fn (spans)
    (let ((routes (otel/-distinct (map otel/-span-route spans))))
      {:total-requests (len spans)
       :routes (map (fn (r) (otel/route-metrics spans r)) routes)})))

;; convenience: metrics over the current ring.
(define otel/metrics-recent (fn () (otel/metrics (otel/recent))))

;; ── P6: live dashboard (SSR + SSE) ────────────────────────────────────
;; GET /otel renders a dashboard — metrics strip + the latest trace's waterfall +
;; a recent-traces list — as server-rendered HTML carrying Datastar-style reactive
;; attributes that subscribe to GET /otel/stream, the SSE feed of new span events
;; (SXTP events, the host's Datastar-borrowed wire format). SSR + declarative
;; reactive attrs + SSE patches IS the reactive-island model here. (Live client
;; hydration is a deploy concern; SSR, the event feed, and the data are tested.)

;; recent traces, newest-first: {:trace :name :spans}. root name = the parentless
;; span (fallback: first recorded).
(define otel/-trace-ids
  (fn () (otel/-distinct (map (fn (s) (get s :trace)) (otel/recent)))))
(define otel/-trace-root-name
  (fn (trace-id)
    (let ((spans (otel/trace-spans trace-id)))
      (let ((roots (filter (fn (s) (nil? (get s :parent))) spans)))
        (cond
          ((not (empty? roots)) (get (first roots) :name))
          ((not (empty? spans)) (get (first spans) :name))
          (else ""))))))
(define otel/trace-summary
  (fn (trace-id)
    {:trace trace-id
     :name (otel/-trace-root-name trace-id)
     :spans (len (otel/trace-spans trace-id))}))
(define otel/recent-traces
  (fn () (reverse (map otel/trace-summary (otel/-trace-ids)))))
(define otel/latest-trace
  (fn ()
    (let ((r (otel/recent)))
      (if (empty? r) nil (get (last r) :trace)))))

;; ── SSE span events (SXTP) ────────────────────────────────────────────
(define otel/span-event
  (fn (s)
    (sxtp/event "otel.span"
      {:id (get s :span)
       :body {:trace (get s :trace) :span (get s :span) :parent (get s :parent)
              :name (get s :name) :t0 (get s :t0) :t1 (get s :t1)
              :attrs (get s :attrs)}
       :time (get s :t1)})))
(define otel/latest-span-event
  (fn ()
    (let ((r (otel/recent)))
      (if (empty? r) nil (otel/span-event (last r))))))
;; one SSE frame: `event: otel.span\n data: <sxtp event>\n\n`; "" when no spans.
(define otel/-stream-body
  (fn ()
    (let ((e (otel/latest-span-event)))
      (if (nil? e)
        ""
        (str "event: otel.span\ndata: " (sxtp/serialize e) "\n\n")))))

;; ── dashboard markup (plain HTML tags → render-to-html SSRs cleanly) ──
(define otel/-metrics-strip
  (fn (m)
    (quasiquote
      (table :class "otel-metrics"
        (tr (th "route") (th "count") (th "p50") (th "p95") (th "p99"))
        (splice-unquote
          (map
            (fn (r)
              (quasiquote
                (tr (td (unquote (str (get r :route))))
                    (td (unquote (str (get r :count))))
                    (td (unquote (str (get r :p50))))
                    (td (unquote (str (get r :p95))))
                    (td (unquote (str (get r :p99)))))))
            (get m :routes)))))))

(define otel/-traces-list
  (fn (traces)
    (quasiquote
      (ul :class "otel-traces"
        (splice-unquote
          (map
            (fn (t)
              (quasiquote
                (li :data-trace (unquote (str (get t :trace)))
                  (unquote (str (get t :name) " — " (get t :spans) " spans")))))
            traces))))))

(define otel/dashboard
  (fn ()
    (let ((m (otel/metrics (otel/recent)))
          (lt (otel/latest-trace))
          (traces (otel/recent-traces)))
      (quasiquote
        (div :id "otel-dashboard" :data-on-load "@get('/otel/stream')"
          (h1 "OpenTelemetry")
          (h2 "metrics")
          (unquote (otel/-metrics-strip m))
          (h2 "latest trace")
          (unquote
            (if (nil? lt)
              (quasiquote (p :class "otel-empty" "no traces yet"))
              (otel/waterfall lt)))
          (h2 "recent traces")
          (unquote (otel/-traces-list traces)))))))

;; ── routes ────────────────────────────────────────────────────────────
(define otel/dashboard-route
  (dream-get "/otel"
    (fn (req) (dream-html (render-to-html (otel/dashboard) {})))))
(define otel/stream-route
  (dream-get "/otel/stream"
    (fn (req)
      (dream-response 200 {:content-type "text/event-stream"} (otel/-stream-body)))))
(define otel/routes (list otel/dashboard-route otel/stream-route))