From ee4dbf3be9bc7613478de0cd8ffc6d9a6de944dc Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 3 Jul 2026 08:43:31 +0000 Subject: [PATCH] offering editor: per-showing ticket types with prices + per-offering caps MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Each showing's offerings are now independently editable — the 'some / all / extra + special offer, different prices, different caps' from the cinema model. - host/blog--offering-editor: a collapsible '⚙ Manage offerings' panel on the showing page — per offering an inline price+cap Save form and a Remove button, plus an Add-offering form. - host/blog-offering-update: edit an offering's price + cap. - host/blog-offering-remove: unlink an offering from the showing (sold tickets keep their record). - host/blog-offering-add: add an offering, CREATING the ticket type first if new (e.g. special-offer → seeds the ticket-type + is-a). host/blog--offering-showing resolves the parent showing. - Per-offering CAP enforcement: host/blog--offering-available? (offering sold < its cap, else only the showing capacity limits it). buy-ticket checks it and tallies offering --sold--> ticket per offering; the tickets section shows 'type — £price (sold/cap)'. This covers the layout-style variable caps too (seated / tables / standing = per-offering caps). LIVE: on the Dune showing — set adult £12 cap 2, added special-offer £5 cap 1, removed u18; buying the special-offer twice yields 1/1 sold (second blocked). blog 218/218. Co-Authored-By: Claude Opus 4.8 --- lib/host/blog.sx | 98 +++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 93 insertions(+), 5 deletions(-) diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 30e67376..66d4c4a5 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -3171,6 +3171,41 @@ (if (= (len screens) 0) 0 (parse-int (or (get (host/blog-field-values-of (first screens)) "capacity") "0") 0))))))))) ;; the TICKETS section shown on a showing's page: capacity/sold + a Buy form per Offering. +;; the admin editor for a showing's offerings — edit price/cap, remove, and add (incl. brand-new +;; ticket types like special-offer). Collapsed in a
so it doesn't clutter the buy view. +(define host/blog--offering-editor + (fn (slug) + (quasiquote + (details :style "margin-top:0.8em;font-size:0.9em" + (summary :style "cursor:pointer;color:#a58" "⚙ Manage offerings") + (unquote + (cons (quote div) + (map (fn (off) + (let ((tt (host/blog--out-raw off "of-type")) + (price (get (host/blog-field-values-of off) "price")) + (ocap (get (host/blog-field-values-of off) "cap"))) + (quasiquote (div :style "margin:0.3em 0;padding:0.3em 0;border-bottom:1px solid #eee" + (b (unquote (if (> (len tt) 0) (first tt) off))) " " + (form :method "post" :action (unquote (str "/offering-update?offering=" off)) :style "display:inline" + "£" (input :name "price" :value (unquote (or price "")) :style "width:4em") + " cap " (input :name "cap" :value (unquote (or ocap "")) :placeholder "∞" :style "width:4em") + " " (button :type "submit" "Save")) + " " + (form :method "post" :action (unquote (str "/offering-remove?offering=" off)) :style "display:inline" + (button :type "submit" "Remove")))))) + (host/blog--out-raw slug "offers")))) + (form :method "post" :action (unquote (str "/offering-add?showing=" slug)) + :style "margin-top:0.4em;padding:0.4em;background:#f2f2f2;border-radius:3px" + (b "Add: ") (input :name "tickettype" :placeholder "ticket type (e.g. special-offer)" :style "width:12em") + " £" (input :name "price" :placeholder "price" :style "width:4em") + " cap " (input :name "cap" :placeholder "∞" :style "width:4em") + " " (button :type "submit" "Add offering")))))) +;; is an offering still available? — its own cap if set, else limited only by the showing capacity. +(define host/blog--offering-available? + (fn (off) + (let ((cap (get (host/blog-field-values-of off) "cap"))) + (if (or (not cap) (= cap "")) true + (< (len (host/blog--out-raw off "sold")) (parse-int cap 0)))))) (define host/blog--showing-extras (fn (slug) (if (not (contains? (host/blog--out-raw slug "is-a") "showing")) "" @@ -3183,15 +3218,22 @@ (unquote (cons (quote div) (map (fn (off) - (let ((tt (host/blog--out-raw off "of-type")) (price (get (host/blog-field-values-of off) "price"))) + (let ((tt (host/blog--out-raw off "of-type")) + (price (get (host/blog-field-values-of off) "price")) + (ocap (get (host/blog-field-values-of off) "cap")) + (osold (len (host/blog--out-raw off "sold")))) (quasiquote (div :style "margin:0.35em 0" - (b (unquote (if (> (len tt) 0) (first tt) off))) (unquote (str " — £" (or price "?") " ")) - (unquote (if (>= sold cap) (quote (span :style "color:#999" "sold out")) + (b (unquote (if (> (len tt) 0) (first tt) off))) (unquote (str " — £" (or price "?"))) + (unquote (if (and ocap (not (= ocap ""))) (str " (" (str osold) "/" ocap " sold)") "")) + " " + (unquote (if (or (>= sold cap) (not (host/blog--offering-available? off))) + (quote (span :style "color:#999" "sold out")) (quasiquote (form :method "post" :action (unquote (str "/buy-ticket?showing=" slug "&offering=" off)) :style "display:inline" (input :name "email" :placeholder "your email" :style "width:12em") " " (button :type "submit" "Buy"))))))))) - (host/blog--out-raw slug "offers")))))))))) + (host/blog--out-raw slug "offers")))) + (unquote (host/blog--offering-editor slug)))))))) ;; events: buy a ticket for a showing/offering — CAPACITY-CHECKED, then a cross-domain order on shop. (define host/blog-buy-ticket @@ -3201,12 +3243,55 @@ (begin (when (and showing offering (not (= email "")) (< (len (host/blog--out-raw showing "sold")) (host/blog--showing-capacity showing)) + (host/blog--offering-available? offering) (not (= host/blog--shop-base ""))) (let ((body (get (http-request "POST" (str host/blog--shop-base "/ticket?showing=" showing "&offering=" offering "&email=" email) {} "") "body"))) (when (starts-with? body "ticket:") - (host/blog-relate! showing (substr body 7 (- (len body) 7)) "sold")))) + (let ((tid (substr body 7 (- (len body) 7)))) + (begin + (host/blog-relate! showing tid "sold") + (host/blog-relate! offering tid "sold")))))) ;; per-offering tally too + (dream-redirect (str "/" showing "/")))))) +;; the showing an offering belongs to (showing --offers--> offering). +(define host/blog--offering-showing + (fn (off) (let ((ss (host/blog-in off "offers"))) (if (> (len ss) 0) (first ss) "cinema")))) +;; edit an offering's price + cap. +(define host/blog-offering-update + (fn (req) + (let ((off (dream-query-param req "offering")) + (price (or (host/field req "price") "")) (cap (or (host/field req "cap") ""))) + (begin + (when off (host/blog--set-field-values! off {"price" price "cap" cap})) + (dream-redirect (str "/" (host/blog--offering-showing off) "/")))))) +;; remove an offering from a showing (unlink; tickets already sold keep their record). +(define host/blog-offering-remove + (fn (req) + (let ((off (dream-query-param req "offering"))) + (let ((showing (host/blog--offering-showing off))) + (begin + (when off (host/blog-unrelate! showing off "offers")) + (dream-redirect (str "/" showing "/"))))))) +;; add an offering to a showing — creating the ticket type first if it's new (e.g. special-offer). +(define host/blog-offering-add + (fn (req) + (let ((showing (dream-query-param req "showing")) + (tt (host/blog-slugify (or (host/field req "tickettype") ""))) + (price (or (host/field req "price") "0")) (cap (or (host/field req "cap") ""))) + (begin + (when (and showing (not (= tt ""))) + (begin + (when (not (host/blog-exists? tt)) + (begin (host/blog-seed! tt tt (str "(article (h1 \"" tt "\"))") "published") + (host/blog-relate! tt "ticket-type" "is-a"))) + (let ((off (str showing "--" tt))) + (begin + (host/blog-seed! off (str tt " @ " showing) "(article (h1 \"Offering\"))" "published") + (host/blog-relate! off "offering" "is-a") + (host/blog-relate! showing off "offers") + (host/blog-relate! off tt "of-type") + (host/blog--set-field-values! off {"price" price "cap" cap}))))) (dream-redirect (str "/" showing "/")))))) ;; shop: issue a ticket (is-a ticket, for showing, bought-as offering, owned-by person) → "ticket:". (define host/blog-ticket @@ -3353,6 +3438,9 @@ (dream-post "/new-film" host/blog-new-film) (dream-post "/new-showing" host/blog-new-showing) (dream-post "/buy-ticket" host/blog-buy-ticket) + (dream-post "/offering-add" host/blog-offering-add) + (dream-post "/offering-update" host/blog-offering-update) + (dream-post "/offering-remove" host/blog-offering-remove) (dream-post "/ticket" host/blog-ticket) (dream-post "/person" host/blog-person) (dream-post "/new-event" host/blog-new-event)