diff --git a/lib/host/blog.sx b/lib/host/blog.sx index 4cdb2e15..338a1e3a 100644 --- a/lib/host/blog.sx +++ b/lib/host/blog.sx @@ -3045,6 +3045,118 @@ (host/blog-relate! oid "order" "is-a") (host/blog-relate! oid event "for") (dream-response 200 {:content-type "text/plain; charset=utf-8"} (str "order:" oid))))))) +;; ── the CINEMA model (events domain): Cinema → Screen → Calendar, Film, TicketType, Showing, Offering ── +;; Seed the type-posts + Rose Ash Cinema with two screens (each with a default capacity + a calendar) +;; + a set of ticket types. Idempotent (seed!/relate! are sets). +(define host/blog-seed-cinema! + (fn () + (begin + (for-each (fn (t) (host/blog-seed! t t (str "(article (h1 \"" t "\"))") "published")) + (list "cinema" "screen" "calendar" "film" "ticket-type" "showing" "offering")) + (host/blog-seed! "rose-ash-cinema" "Rose Ash Cinema" "(article (h1 \"Rose Ash Cinema\"))" "published") + (host/blog-relate! "rose-ash-cinema" "cinema" "is-a") + (for-each (fn (n) + (let ((scr (str "screen-" n)) (cal (str "cal-screen-" n))) + (begin + (host/blog-seed! scr (str "Screen " n) (str "(article (h1 \"Screen " n "\"))") "published") + (host/blog-relate! scr "screen" "is-a") + (host/blog-relate! "rose-ash-cinema" scr "has-screen") + (host/blog--set-field-values! scr {"capacity" "100"}) + (host/blog-seed! cal (str "Screen " n " Calendar") "(article (h1 \"Calendar\"))" "published") + (host/blog-relate! cal "calendar" "is-a") + (host/blog-relate! scr cal "has-calendar")))) + (list "1" "2")) + (for-each (fn (tt) (begin (host/blog-seed! tt tt (str "(article (h1 \"" tt "\"))") "published") + (host/blog-relate! tt "ticket-type" "is-a"))) + (list "adult" "u18" "concession" "standing"))))) + +;; the showings scheduled on a calendar (calendar --scheduled--> showing). +(define host/blog--calendar-view + (fn (cal) + (let ((showings (host/blog--out-raw cal "scheduled"))) + (quasiquote (div :style "margin:0.2em 0 0.2em 1em;font-size:0.9em" + (i (unquote (str cal))) ": " + (unquote (if (= (len showings) 0) (quote (span :style "color:#999" "no showings")) + (cons (quote span) (map (fn (s) (quasiquote (span (a :href (unquote (str "/" s "/")) (unquote (str s))) " "))) showings))))))))) +;; the cinema's screens (with capacity) + each screen's calendar + its showings. +(define host/blog--screens-view + (fn (cinema) + (cons (quote div) + (map (fn (scr) + (let ((cap (get (host/blog-field-values-of scr) "capacity")) (cals (host/blog--out-raw scr "has-calendar"))) + (quasiquote (div :style "margin:0.4em 0;padding:0.4em 0.6em;border:1px solid #ddd;border-radius:4px" + (b (unquote (str scr))) (unquote (str " · capacity " (or cap "?"))) + (unquote (cons (quote div) (map host/blog--calendar-view cals))))))) + (host/blog--out-raw cinema "has-screen"))))) +;; the films + their default ticket types. +(define host/blog--films-view + (fn () + (let ((films (host/blog-in "film" "is-a"))) + (if (= (len films) 0) (quote (p :style "color:#999" (em "No films yet."))) + (cons (quote ul) + (map (fn (f) (quasiquote (li (b (unquote (str f))) + (unquote (str " · ticket types: " (join ", " (host/blog--out-raw f "has-ticket-type"))))))) + films)))))) + +;; add a film (+ its default ticket types: adult, u18). +(define host/blog-new-film + (fn (req) + (let ((title (host/field req "title"))) + (begin + (when (and title (not (= title ""))) + (let ((slug (host/blog-slugify title))) + (begin + (host/blog-seed! slug title (str "(article (h1 \"" title "\"))") "published") + (host/blog-relate! slug "film" "is-a") + (for-each (fn (tt) (host/blog-relate! slug tt "has-ticket-type")) (list "adult" "u18"))))) + (dream-redirect "/cinema"))))) +;; book a showing: a Film onto a Calendar at a time; snapshot the film's ticket types as Offerings. +(define host/blog-new-showing + (fn (req) + (let ((film (host/field req "film")) (calendar (host/field req "calendar")) + (time (or (host/field req "time") "")) (cap (or (host/field req "capacity") ""))) + (begin + (when (and film (not (= film "")) calendar (not (= calendar ""))) + (let ((slug (host/blog-slugify (str film "-" calendar "-" time)))) + (begin + (host/blog-seed! slug (str film " showing") (str "(article (h1 \"Showing: " film "\") (p \"" time "\"))") "published") + (host/blog-relate! slug "showing" "is-a") + (host/blog-relate! slug film "of-film") + (host/blog-relate! calendar slug "scheduled") + (host/blog-relate! slug calendar "on-calendar") + (host/blog--set-field-values! slug {"time" time "capacity" cap}) + (for-each (fn (tt) + (let ((off (str slug "--" tt))) + (begin + (host/blog-seed! off (str tt " @ " slug) "(article (h1 \"Offering\"))" "published") + (host/blog-relate! off "offering" "is-a") + (host/blog-relate! slug off "offers") + (host/blog-relate! off tt "of-type") + (host/blog--set-field-values! off {"price" "10"})))) + (host/blog--out-raw film "has-ticket-type"))))) + (dream-redirect "/cinema"))))) +;; ── /cinema — the events domain admin: screens/calendars/showings, add a film, book a showing ── +(define host/blog-cinema + (fn (req) + (host/blog--resp req 200 + (host/blog--page req "Rose Ash Cinema" + (quasiquote + (div (h1 "🎬 Rose Ash Cinema") + (h3 :style "margin:0.8em 0 0.2em" "Screens & calendars") + (unquote (host/blog--screens-view "rose-ash-cinema")) + (h3 :style "margin:0.8em 0 0.2em" "Films") + (unquote (host/blog--films-view)) + (form :method "post" :action "/new-film" :style "margin:0.4em 0" + (input :name "title" :placeholder "Film title") " " (button :type "submit" "Add film")) + (h3 :style "margin:0.8em 0 0.2em" "Book a showing") + (form :method "post" :action "/new-showing" + :style "padding:0.5em;border:1px dashed #bbb;background:#fafafa;font-size:0.9em" + (input :name "film" :placeholder "film slug" :style "width:9em") " " + (input :name "calendar" :placeholder "cal-screen-1" :style "width:9em") " " + (input :name "time" :placeholder "Fri 8pm" :style "width:7em") " " + (input :name "capacity" :placeholder "cap (opt)" :style "width:6em") " " + (button :type "submit" "Book showing")))))))) + ;; ── /orders — the shop domain view: ticket orders placed for events (federated from events) ── (define host/blog-orders (fn (req) @@ -3141,7 +3253,10 @@ (dream-get "/flows" host/blog-flows) (dream-get "/fed-tick" host/blog-fed-tick) (dream-get "/calendars" host/blog-calendars) + (dream-get "/cinema" host/blog-cinema) (dream-get "/orders" host/blog-orders) + (dream-post "/new-film" host/blog-new-film) + (dream-post "/new-showing" host/blog-new-showing) (dream-post "/new-event" host/blog-new-event) (dream-post "/buy" host/blog-buy) (dream-post "/order" host/blog-order) diff --git a/lib/host/serve.sh b/lib/host/serve.sh index e56bc643..edee57ab 100755 --- a/lib/host/serve.sh +++ b/lib/host/serve.sh @@ -250,6 +250,10 @@ EPOCH=1 echo "(epoch $EPOCH)" echo "(eval \"(host/blog--set-shop-base! \\\"${SX_SHOP_BASE:-}\\\")\")" EPOCH=$((EPOCH+1)) + # The CINEMA model: Cinema → Screen → Calendar, Film, TicketType, Showing, Offering. + echo "(epoch $EPOCH)" + echo "(eval \"(host/blog-seed-cinema!)\")" + EPOCH=$((EPOCH+1)) elif [ "${SX_DOMAIN:-blog}" = "shop" ]; then # The SHOP domain: an "order" type. POST /order?event= creates an order (is-a order) for an event. echo "(epoch $EPOCH)"