;; lib/host/ledger.sx — the strangler migration ledger. A catalogue of every
;; rose-ash HTTP endpoint with its Quart original and its current host status, so
;; the cut-over from Quart to the SX host is tracked endpoint-by-endpoint rather
;; than big-bang. Status is one of:
;;   :native   — born on the host, has no Quart original (e.g. /health probe)
;;   :migrated — moved off Quart, now served by an SX handler
;;   :proxied  — still on Quart; the host forwards until cut over
;; Coverage (how far the strangler has progressed = how much is OFF Quart) is
;; computed from the catalogue. Pure data + queries — no IO, fully conformable.

;; ── entry constructor ───────────────────────────────────────────────
;; quart is a "service:handler" ref string (nil for :native endpoints); handler
;; is the SX handler name serving it (nil while still :proxied).
(define host/ledger-entry
  (fn (domain method path quart status handler)
    {:domain domain :method method :path path
     :quart quart :status status :handler handler}))

;; ── the catalogue ───────────────────────────────────────────────────
;; Reflects the live host: feed reads+writes migrated, /health native, the
;; relations container endpoints migrated onto lib/relations (reads get-children/
;; get-parents + writes attach-child/detach-child — see lib/host/relations.sx).
;; The TYPED relations actions (relate/unrelate/can-relate) stay proxied: they
;; carry registry + cardinality validation lib/relations does not implement. The
;; internal-only likes data+action endpoints stay proxied too — likes has no SX
;; subsystem to dispatch to.
(define host/ledger
  (list
    (host/ledger-entry "host"      "GET"  "/health"                     nil                         "native"   "host/health-route")
    (host/ledger-entry "blog"      "GET"  "/:slug"                      "blog:post_detail"          "migrated" "host/blog-post")
    (host/ledger-entry "feed"      "GET"  "/feed"                       "feed:timeline"             "migrated" "host/feed-timeline")
    (host/ledger-entry "feed"      "POST" "/feed"                       "feed:create"               "migrated" "host/feed-create")
    (host/ledger-entry "relations" "GET"  "/internal/data/get-children"  "relations:get_children"  "migrated" "host/relations-children")
    (host/ledger-entry "relations" "GET"  "/internal/data/get-parents"   "relations:get_parents"   "migrated" "host/relations-parents")
    (host/ledger-entry "relations" "POST" "/internal/actions/attach-child" "relations:attach_child" "migrated" "host/relations-attach")
    (host/ledger-entry "relations" "POST" "/internal/actions/detach-child" "relations:detach_child" "migrated" "host/relations-detach")
    (host/ledger-entry "relations" "POST" "/internal/actions/relate"     "relations:relate"        "proxied"  nil)
    (host/ledger-entry "relations" "POST" "/internal/actions/unrelate"   "relations:unrelate"      "proxied"  nil)
    (host/ledger-entry "relations" "POST" "/internal/actions/can-relate" "relations:can_relate"    "proxied"  nil)
    (host/ledger-entry "likes"     "GET"  "/internal/data/is-liked"     "likes:is_liked"            "proxied"  nil)
    (host/ledger-entry "likes"     "GET"  "/internal/data/liked-slugs"  "likes:liked_slugs"         "proxied"  nil)
    (host/ledger-entry "likes"     "GET"  "/internal/data/liked-ids"    "likes:liked_ids"           "proxied"  nil)
    (host/ledger-entry "likes"     "POST" "/internal/actions/toggle"    "likes:toggle"              "proxied"  nil)))

;; ── status / domain queries ─────────────────────────────────────────
(define host/ledger-by-status
  (fn (ledger status) (filter (fn (e) (= (get e :status) status)) ledger)))
(define host/ledger-migrated (fn (ledger) (host/ledger-by-status ledger "migrated")))
(define host/ledger-proxied  (fn (ledger) (host/ledger-by-status ledger "proxied")))
(define host/ledger-native   (fn (ledger) (host/ledger-by-status ledger "native")))
(define host/ledger-by-domain
  (fn (ledger domain) (filter (fn (e) (= (get e :domain) domain)) ledger)))

;; An endpoint is OFF Quart (served by the host) iff native or migrated.
(define host/ledger-served?
  (fn (e) (or (= (get e :status) "native") (= (get e :status) "migrated"))))

;; First entry matching (method, path), or nil.
(define host/ledger-find
  (fn (ledger method path)
    (let ((hits (filter
                  (fn (e) (and (= (get e :method) method) (= (get e :path) path)))
                  ledger)))
      (if (> (len hits) 0) (first hits) nil))))

;; Distinct domains in the catalogue (order: first-seen, reversed by cons).
(define host/ledger-domains
  (fn (ledger)
    (reduce
      (fn (acc e)
        (let ((d (get e :domain)))
          (if (some (fn (x) (= x d)) acc) acc (cons d acc))))
      (list)
      ledger)))

;; ── coverage ────────────────────────────────────────────────────────
;; served = off Quart (migrated + native); percent = served / total, floored.
(define host/ledger-coverage
  (fn (ledger)
    (let ((total (len ledger))
          (migrated (len (host/ledger-migrated ledger)))
          (proxied (len (host/ledger-proxied ledger)))
          (native (len (host/ledger-native ledger))))
      {:total total
       :migrated migrated
       :proxied proxied
       :native native
       :served (+ migrated native)
       :percent (if (= total 0) 0 (quotient (* 100 (+ migrated native)) total))})))