offering editor: per-showing ticket types with prices + per-offering caps
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 <noreply@anthropic.com>
This commit is contained in:
@@ -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 <details> 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:<id>".
|
||||
(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)
|
||||
|
||||
Reference in New Issue
Block a user