giles
c0665ba58e
112 conversions across 19 .sx files using match, let-match, and pipe operators: match (17): type/value dispatch replacing cond/if chains - lib/vm.sx: HO form dispatch (for-each/map/filter/reduce/some/every?) - lib/tree-tools.sx: node-display, node-matches?, rename, count, replace, free-symbols - lib/types.sx: narrow-type, substitute-in-type, infer-type, resolve-type - web/engine.sx: default-trigger, resolve-target, classify-trigger - web/deps.sx: scan-refs-walk, scan-io-refs-walk let-match (89): dict destructuring replacing (get d "key") patterns - shared/page-functions.sx (20), blog/admin.sx (17), pub-api.sx (13) - events/ layouts/page/tickets/entries/forms (27 total) - specs-explorer.sx (7), federation/social.sx (3), lib/ small files (3) -> pipes (6): replacing triple-chained gets in lib/vm.sx - frame-closure → closure-code → code-bytecode chains Also: lib/vm.sx accessor upgrades (get vm "sp" → vm-sp vm throughout) 2650/2650 tests pass, zero regressions. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
833 lines
34 KiB
Plaintext
833 lines
34 KiB
Plaintext
;; Blog admin panel components
|
|
|
|
(defcomp ~admin/cache-panel (&key (clear-url :as string) (csrf :as string))
|
|
(div :class "max-w-2xl mx-auto px-4 py-6 space-y-6"
|
|
(div :class "flex flex-col md:flex-row gap-3 items-start"
|
|
(form :sx-post clear-url :sx-trigger "submit" :sx-target "#cache-status" :sx-swap "innerHTML"
|
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
|
(button :class "border rounded px-4 py-2 bg-stone-800 text-white text-sm" :type "submit" "Clear cache"))
|
|
(div :id "cache-status" :class "py-2"))))
|
|
|
|
(defcomp ~admin/snippets-panel (&key list)
|
|
(div :class "max-w-4xl mx-auto p-6"
|
|
(div :class "mb-6 flex justify-between items-center"
|
|
(h1 :class "text-3xl font-bold" "Snippets"))
|
|
(div :id "snippets-list" list)))
|
|
|
|
(defcomp ~admin/snippet-visibility-select (&key patch-url hx-headers options cls)
|
|
(select :name "visibility" :sx-patch patch-url :sx-target "#snippets-list" :sx-swap "innerHTML"
|
|
:sx-headers hx-headers :class "text-sm border border-stone-300 rounded px-2 py-1"
|
|
options))
|
|
|
|
(defcomp ~admin/snippet-option (&key (value :as string) (selected :as boolean) (label :as string))
|
|
(option :value value :selected selected label))
|
|
|
|
(defcomp ~admin/snippet-row (&key (name :as string) (owner :as string) (badge-cls :as string) (visibility :as string) extra)
|
|
(div :class "flex items-center gap-4 p-4 hover:bg-stone-50 transition"
|
|
(div :class "flex-1 min-w-0"
|
|
(div :class "font-medium truncate" name)
|
|
(div :class "text-xs text-stone-500" owner))
|
|
(span :class (str "inline-flex items-center px-2.5 py-0.5 rounded-full text-xs font-medium " badge-cls) visibility)
|
|
extra))
|
|
|
|
(defcomp ~admin/snippets-list (&key rows)
|
|
(div :class "bg-white rounded-lg shadow" (div :class "divide-y" rows)))
|
|
|
|
(defcomp ~admin/menu-items-panel (&key new-url list)
|
|
(div :class "max-w-4xl mx-auto p-6"
|
|
(div :class "mb-6 flex justify-end items-center"
|
|
(button :type "button" :sx-get new-url :sx-target "#menu-item-form" :sx-swap "innerHTML"
|
|
:class "px-4 py-2 bg-blue-600 text-white rounded hover:bg-blue-700"
|
|
(i :class "fa fa-plus") " Add Menu Item"))
|
|
(div :id "menu-item-form" :class "mb-6")
|
|
(div :id "menu-items-list" list)))
|
|
|
|
(defcomp ~admin/menu-item-row (&key img (label :as string) (slug :as string) (sort-order :as string) (edit-url :as string) (delete-url :as string) (confirm-text :as string) hx-headers)
|
|
(div :class "flex items-center gap-4 p-4 hover:bg-stone-50 transition"
|
|
(div :class "text-stone-400 cursor-move" (i :class "fa fa-grip-vertical"))
|
|
img
|
|
(div :class "flex-1 min-w-0"
|
|
(div :class "font-medium truncate" label)
|
|
(div :class "text-xs text-stone-500 truncate" slug))
|
|
(div :class "text-sm text-stone-500" (str "Order: " sort-order))
|
|
(div :class "flex gap-2 flex-shrink-0"
|
|
(button :type "button" :sx-get edit-url :sx-target "#menu-item-form" :sx-swap "innerHTML"
|
|
:class "px-3 py-1 text-sm bg-stone-200 hover:bg-stone-300 rounded"
|
|
(i :class "fa fa-edit") " Edit")
|
|
(~shared:misc/delete-btn :url delete-url :trigger-target "#menu-items-list"
|
|
:title "Delete menu item?" :text confirm-text
|
|
:sx-headers hx-headers))))
|
|
|
|
(defcomp ~admin/menu-items-list (&key rows)
|
|
(div :class "bg-white rounded-lg shadow" (div :class "divide-y" rows)))
|
|
|
|
;; Tag groups admin
|
|
|
|
(defcomp ~admin/tag-groups-create-form (&key create-url csrf)
|
|
(form :method "post" :action create-url :class "border rounded p-4 bg-white space-y-3"
|
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
|
(h3 :class "text-sm font-semibold text-stone-700" "New Group")
|
|
(div :class "flex flex-col sm:flex-row gap-3"
|
|
(input :type "text" :name "name" :placeholder "Group name" :required "" :class "flex-1 border rounded px-3 py-2 text-sm")
|
|
(input :type "text" :name "colour" :placeholder "#colour" :class "w-28 border rounded px-3 py-2 text-sm")
|
|
(input :type "number" :name "sort_order" :placeholder "Order" :value "0" :class "w-20 border rounded px-3 py-2 text-sm"))
|
|
(input :type "text" :name "feature_image" :placeholder "Image URL (optional)" :class "w-full border rounded px-3 py-2 text-sm")
|
|
(button :type "submit" :class "border rounded px-4 py-2 bg-stone-800 text-white text-sm" "Create")))
|
|
|
|
(defcomp ~admin/tag-group-icon-image (&key src name)
|
|
(img :src src :alt name :class "h-8 w-8 rounded-full object-cover border border-stone-300 flex-shrink-0"))
|
|
|
|
(defcomp ~admin/tag-group-icon-color (&key style initial)
|
|
(div :class "h-8 w-8 rounded-full text-xs font-semibold flex items-center justify-center border border-stone-300 flex-shrink-0"
|
|
:style style initial))
|
|
|
|
(defcomp ~admin/tag-group-li (&key icon (edit-href :as string) (name :as string) (slug :as string) (sort-order :as number))
|
|
(li :class "border rounded p-3 bg-white flex items-center gap-3"
|
|
icon
|
|
(div :class "flex-1"
|
|
(a :href edit-href :class "font-medium text-stone-800 hover:underline" name)
|
|
(span :class "text-xs text-stone-500 ml-2" slug))
|
|
(span :class "text-xs text-stone-500" (str "order: " sort-order))))
|
|
|
|
(defcomp ~admin/tag-groups-list (&key items)
|
|
(ul :class "space-y-2" items))
|
|
|
|
(defcomp ~admin/unassigned-tag (&key name)
|
|
(span :class "inline-block bg-stone-100 text-stone-600 px-2 py-1 text-xs font-medium border border-stone-200 rounded" name))
|
|
|
|
(defcomp ~admin/unassigned-tags (&key heading spans)
|
|
(div :class "border-t pt-4"
|
|
(h3 :class "text-sm font-semibold text-stone-700 mb-2" heading)
|
|
(div :class "flex flex-wrap gap-2" spans)))
|
|
|
|
(defcomp ~admin/tag-groups-main (&key form groups unassigned)
|
|
(div :class "max-w-2xl mx-auto px-4 py-6 space-y-8"
|
|
form groups unassigned))
|
|
|
|
;; Tag group edit
|
|
|
|
(defcomp ~admin/tag-checkbox (&key (tag-id :as string) (checked :as boolean) img (name :as string))
|
|
(label :class "flex items-center gap-2 px-2 py-1 hover:bg-stone-50 rounded text-sm cursor-pointer"
|
|
(input :type "checkbox" :name "tag_ids" :value tag-id :checked checked :class "rounded border-stone-300")
|
|
img (span name)))
|
|
|
|
(defcomp ~admin/tag-checkbox-image (&key src)
|
|
(img :src src :alt "" :class "h-4 w-4 rounded-full object-cover"))
|
|
|
|
(defcomp ~admin/tag-group-edit-form (&key (save-url :as string) (csrf :as string) (name :as string) (colour :as string?) (sort-order :as number) (feature-image :as string?) tags)
|
|
(form :method "post" :action save-url :class "border rounded p-4 bg-white space-y-4"
|
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
|
(div :class "space-y-3"
|
|
(div (label :class "block text-xs font-medium text-stone-600 mb-1" "Name")
|
|
(input :type "text" :name "name" :value name :required "" :class "w-full border rounded px-3 py-2 text-sm"))
|
|
(div :class "flex gap-3"
|
|
(div :class "flex-1" (label :class "block text-xs font-medium text-stone-600 mb-1" "Colour")
|
|
(input :type "text" :name "colour" :value colour :placeholder "#hex" :class "w-full border rounded px-3 py-2 text-sm"))
|
|
(div :class "w-24" (label :class "block text-xs font-medium text-stone-600 mb-1" "Order")
|
|
(input :type "number" :name "sort_order" :value sort-order :class "w-full border rounded px-3 py-2 text-sm")))
|
|
(div (label :class "block text-xs font-medium text-stone-600 mb-1" "Feature Image URL")
|
|
(input :type "text" :name "feature_image" :value feature-image :placeholder "https://..." :class "w-full border rounded px-3 py-2 text-sm")))
|
|
(div (label :class "block text-xs font-medium text-stone-600 mb-2" "Assign Tags")
|
|
(div :class "grid grid-cols-1 sm:grid-cols-2 gap-1 max-h-64 overflow-y-auto border rounded p-2"
|
|
tags))
|
|
(div :class "flex gap-3"
|
|
(button :type "submit" :class "border rounded px-4 py-2 bg-stone-800 text-white text-sm" "Save"))))
|
|
|
|
(defcomp ~admin/tag-group-delete-form (&key (delete-url :as string) (csrf :as string))
|
|
(form :method "post" :action delete-url :class "border-t pt-4"
|
|
:onsubmit "return confirm('Delete this tag group? Tags will not be deleted.')"
|
|
(input :type "hidden" :name "csrf_token" :value csrf)
|
|
(button :type "submit" :class "border rounded px-4 py-2 bg-red-600 text-white text-sm" "Delete Group")))
|
|
|
|
(defcomp ~admin/tag-group-edit-main (&key edit-form delete-form)
|
|
(div :class "max-w-2xl mx-auto px-4 py-6 space-y-6"
|
|
edit-form delete-form))
|
|
|
|
;; Data-driven snippets list (replaces Python _snippets_sx loop)
|
|
(defcomp
|
|
~admin/snippets-from-data
|
|
(&key snippets user-id is-admin csrf badge-colours)
|
|
(~admin/snippets-list
|
|
:rows (<>
|
|
(map
|
|
(lambda
|
|
(s)
|
|
(let-match
|
|
{:visibility s-vis :delete_url delete-url :patch_url patch-url :id s-id :user_id s-uid :name s-name}
|
|
s
|
|
(let*
|
|
((owner (if (= s-uid user-id) "You" (str "User #" s-uid)))
|
|
(badge-cls
|
|
(or (get badge-colours s-vis) "bg-stone-200 text-stone-700"))
|
|
(extra
|
|
(<>
|
|
(when
|
|
is-admin
|
|
(~admin/snippet-visibility-select
|
|
:patch-url patch-url
|
|
:hx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
|
:options (<>
|
|
(~admin/snippet-option
|
|
:value "private"
|
|
:selected (= s-vis "private")
|
|
:label "private")
|
|
(~admin/snippet-option
|
|
:value "shared"
|
|
:selected (= s-vis "shared")
|
|
:label "shared")
|
|
(~admin/snippet-option
|
|
:value "admin"
|
|
:selected (= s-vis "admin")
|
|
:label "admin"))
|
|
:cls "text-sm border border-stone-300 rounded px-2 py-0.5"))
|
|
(when
|
|
(or (= s-uid user-id) is-admin)
|
|
(~shared:misc/delete-btn
|
|
:url delete-url
|
|
:trigger-target "#snippets-list"
|
|
:title "Delete snippet?"
|
|
:text (str "Delete \"" s-name "\"?")
|
|
:sx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
|
:cls "px-3 py-1 text-sm bg-red-200 hover:bg-red-300 text-red-800 rounded-full")))))
|
|
(~admin/snippet-row
|
|
:name s-name
|
|
:owner owner
|
|
:badge-cls badge-cls
|
|
:visibility s-vis
|
|
:extra extra))))
|
|
(or snippets (list))))))
|
|
|
|
;; Data-driven menu items list (replaces Python _menu_items_list_sx loop)
|
|
(defcomp
|
|
~admin/menu-items-from-data
|
|
(&key items csrf)
|
|
(~admin/menu-items-list
|
|
:rows (<>
|
|
(map
|
|
(lambda
|
|
(item)
|
|
(let-match
|
|
{:delete_url delete-url :sort_order sort-order :edit_url edit-url :feature_image feature-image :label label :slug slug}
|
|
item
|
|
(let
|
|
((img (~shared:misc/img-or-placeholder :src feature-image :alt label :size-cls "w-12 h-12 rounded-full object-cover flex-shrink-0")))
|
|
(~admin/menu-item-row
|
|
:img img
|
|
:label label
|
|
:slug slug
|
|
:sort-order sort-order
|
|
:edit-url edit-url
|
|
:delete-url delete-url
|
|
:confirm-text (str "Remove " label " from the menu?")
|
|
:hx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")))))
|
|
(or items (list))))))
|
|
|
|
;; Data-driven tag groups main (replaces Python _tag_groups_main_panel_sx loops)
|
|
(defcomp
|
|
~admin/tag-groups-from-data
|
|
(&key groups unassigned-tags csrf create-url)
|
|
(~admin/tag-groups-main
|
|
:form (~admin/tag-groups-create-form :create-url create-url :csrf csrf)
|
|
:groups (if
|
|
(empty? (or groups (list)))
|
|
(~shared:misc/empty-state
|
|
:message "No tag groups yet."
|
|
:cls "text-stone-500 text-sm")
|
|
(~admin/tag-groups-list
|
|
:items (<>
|
|
(map
|
|
(lambda
|
|
(g)
|
|
(let-match
|
|
{:sort_order sort-order :feature_image feature-image :slug slug :edit_href edit-href :initial initial :name name :style style}
|
|
g
|
|
(let
|
|
((icon (if feature-image (~admin/tag-group-icon-image :src feature-image :name name) (~admin/tag-group-icon-color :style style :initial initial))))
|
|
(~admin/tag-group-li
|
|
:icon icon
|
|
:edit-href edit-href
|
|
:name name
|
|
:slug slug
|
|
:sort-order sort-order))))
|
|
groups))))
|
|
:unassigned (when
|
|
(not (empty? (or unassigned-tags (list))))
|
|
(~admin/unassigned-tags
|
|
:heading (str "Unassigned Tags (" (len unassigned-tags) ")")
|
|
:spans (<>
|
|
(map
|
|
(lambda (t) (~admin/unassigned-tag :name (get t "name")))
|
|
unassigned-tags))))))
|
|
|
|
;; Data-driven tag group edit (replaces Python _tag_groups_edit_main_panel_sx loop)
|
|
(defcomp
|
|
~admin/tag-checkboxes-from-data
|
|
(&key tags)
|
|
(<>
|
|
(map
|
|
(lambda
|
|
(t)
|
|
(let-match
|
|
{:tag_id tag-id :checked checked :feature_image feature-image :name name}
|
|
t
|
|
(~admin/tag-checkbox
|
|
:tag-id tag-id
|
|
:checked checked
|
|
:img (when
|
|
feature-image
|
|
(~admin/tag-checkbox-image :src feature-image))
|
|
:name name)))
|
|
(or tags (list)))))
|
|
|
|
;; Preview panel components
|
|
|
|
(defcomp ~admin/preview-panel (&key sections)
|
|
(div :class "max-w-4xl mx-auto px-4 py-6 space-y-4"
|
|
(style "
|
|
.sx-pretty, .json-pretty { font-family: monospace; font-size: 12px; line-height: 1.6; white-space: pre-wrap; }
|
|
.sx-list, .json-obj, .json-arr { display: block; }
|
|
.sx-paren { color: #64748b; }
|
|
.sx-sym { color: #0369a1; }
|
|
.sx-kw { color: #7c3aed; }
|
|
.sx-str { color: #15803d; }
|
|
.sx-num { color: #c2410c; }
|
|
.sx-bool { color: #b91c1c; font-weight: 600; }
|
|
.json-brace, .json-bracket { color: #64748b; }
|
|
.json-key { color: #7c3aed; }
|
|
.json-str { color: #15803d; }
|
|
.json-num { color: #c2410c; }
|
|
.json-lit { color: #b91c1c; font-weight: 600; }
|
|
.json-field { display: block; }
|
|
")
|
|
sections))
|
|
|
|
(defcomp ~admin/preview-section (&key title content)
|
|
(details :class "border rounded bg-white"
|
|
(summary :class "cursor-pointer px-4 py-3 font-medium text-sm bg-stone-100 hover:bg-stone-200 select-none" title)
|
|
(div :class "p-4 overflow-x-auto text-xs" content)))
|
|
|
|
(defcomp ~admin/preview-rendered (&key html)
|
|
(div :class "blog-content prose max-w-none" (raw! html)))
|
|
|
|
(defcomp ~admin/preview-empty ()
|
|
(div :class "p-8 text-stone-500" "No content to preview."))
|
|
|
|
(defcomp ~admin/placeholder ()
|
|
(div :class "pb-8"))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Data-driven content defcomps (called from defpages with service data)
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
;; Snippets — receives serialized snippet dicts from service
|
|
(defcomp
|
|
~admin/snippets-content
|
|
(&key snippets is-admin csrf)
|
|
(~admin/snippets-panel
|
|
:list (if
|
|
(empty? (or snippets (list)))
|
|
(~shared:misc/empty-state
|
|
:icon "fa fa-puzzle-piece"
|
|
:message "No snippets yet. Create one from the blog editor.")
|
|
(~admin/snippets-list
|
|
:rows (map
|
|
(lambda
|
|
(s)
|
|
(let-match
|
|
{:visibility vis* :delete_url delete-url :owner owner :can_delete can-delete :patch_url patch-url :name name}
|
|
s
|
|
(let*
|
|
((vis (or vis* "private"))
|
|
(badge-colours
|
|
(dict
|
|
"private"
|
|
"bg-stone-200 text-stone-700"
|
|
"shared"
|
|
"bg-blue-100 text-blue-700"
|
|
"admin"
|
|
"bg-amber-100 text-amber-700"))
|
|
(badge-cls
|
|
(or (get badge-colours vis) "bg-stone-200 text-stone-700")))
|
|
(~admin/snippet-row
|
|
:name name
|
|
:owner owner
|
|
:badge-cls badge-cls
|
|
:visibility vis
|
|
:extra (<>
|
|
(when
|
|
is-admin
|
|
(~admin/snippet-visibility-select
|
|
:patch-url patch-url
|
|
:hx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
|
:options (<>
|
|
(~admin/snippet-option
|
|
:value "private"
|
|
:selected (= vis "private")
|
|
:label "private")
|
|
(~admin/snippet-option
|
|
:value "shared"
|
|
:selected (= vis "shared")
|
|
:label "shared")
|
|
(~admin/snippet-option
|
|
:value "admin"
|
|
:selected (= vis "admin")
|
|
:label "admin"))))
|
|
(when
|
|
can-delete
|
|
(~shared:misc/delete-btn
|
|
:url delete-url
|
|
:trigger-target "#snippets-list"
|
|
:title "Delete snippet?"
|
|
:text (str "Delete \"" name "\"?")
|
|
:sx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
|
:cls "px-3 py-1 text-sm bg-red-200 hover:bg-red-300 text-red-800 rounded-full")))))))
|
|
(or snippets (list)))))))
|
|
|
|
;; Menu Items — receives serialized menu item dicts from service
|
|
(defcomp
|
|
~admin/menu-items-content
|
|
(&key menu-items new-url csrf)
|
|
(~admin/menu-items-panel
|
|
:new-url new-url
|
|
:list (if
|
|
(empty? (or menu-items (list)))
|
|
(~shared:misc/empty-state
|
|
:icon "fa fa-inbox"
|
|
:message "No menu items yet. Add one to get started!")
|
|
(~admin/menu-items-list
|
|
:rows (map
|
|
(lambda
|
|
(mi)
|
|
(let-match
|
|
{:delete_url delete-url :url url :sort_order sort-order :edit_url edit-url :feature_image feature-image :label label}
|
|
mi
|
|
(~admin/menu-item-row
|
|
:img (~shared:misc/img-or-placeholder
|
|
:src feature-image
|
|
:alt label
|
|
:size-cls "w-12 h-12 rounded-full object-cover flex-shrink-0")
|
|
:label label
|
|
:slug url
|
|
:sort-order (str (or sort-order 0))
|
|
:edit-url edit-url
|
|
:delete-url delete-url
|
|
:confirm-text (str "Remove " label " from the menu?")
|
|
:hx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}"))))
|
|
(or menu-items (list)))))))
|
|
|
|
;; Tag Groups — receives serialized tag group data from service
|
|
(defcomp
|
|
~admin/tag-groups-content
|
|
(&key groups unassigned-tags create-url csrf)
|
|
(~admin/tag-groups-main
|
|
:form (~admin/tag-groups-create-form :create-url create-url :csrf csrf)
|
|
:groups (if
|
|
(empty? (or groups (list)))
|
|
(~shared:misc/empty-state
|
|
:icon "fa fa-tags"
|
|
:message "No tag groups yet.")
|
|
(~admin/tag-groups-list
|
|
:items (map
|
|
(lambda
|
|
(g)
|
|
(let-match
|
|
{:colour colour :sort_order sort-order* :feature_image fi :edit_href edit-href :slug slug* :name name}
|
|
g
|
|
(let*
|
|
((initial (slice (or name "?") 0 1))
|
|
(icon
|
|
(if
|
|
fi
|
|
(~admin/tag-group-icon-image :src fi :name name)
|
|
(~admin/tag-group-icon-color
|
|
:style (if
|
|
colour
|
|
(str "background:" colour)
|
|
"background:#e7e5e4")
|
|
:initial initial))))
|
|
(~admin/tag-group-li
|
|
:icon icon
|
|
:edit-href edit-href
|
|
:name name
|
|
:slug (or slug* "")
|
|
:sort-order (or sort-order* 0)))))
|
|
(or groups (list)))))
|
|
:unassigned (when
|
|
(not (empty? (or unassigned-tags (list))))
|
|
(~admin/unassigned-tags
|
|
:heading (str (len (or unassigned-tags (list))) " Unassigned Tags")
|
|
:spans (map
|
|
(lambda (t) (~admin/unassigned-tag :name (get t "name")))
|
|
(or unassigned-tags (list)))))))
|
|
|
|
;; Tag Group Edit — receives serialized tag group + tags from service
|
|
(defcomp
|
|
~admin/tag-group-edit-content
|
|
(&key group all-tags save-url delete-url csrf)
|
|
(~admin/tag-group-edit-main
|
|
:edit-form (let-match
|
|
{:colour colour :sort_order sort-order :feature_image feature-image :name name}
|
|
group
|
|
(~admin/tag-group-edit-form
|
|
:save-url save-url
|
|
:csrf csrf
|
|
:name name
|
|
:colour colour
|
|
:sort-order sort-order
|
|
:feature-image feature-image
|
|
:tags (map
|
|
(lambda
|
|
(t)
|
|
(let-match
|
|
{:checked checked :feature_image t-feature-image :id tag-id :name t-name}
|
|
t
|
|
(~admin/tag-checkbox
|
|
:tag-id tag-id
|
|
:checked checked
|
|
:img (when
|
|
t-feature-image
|
|
(~admin/tag-checkbox-image :src t-feature-image))
|
|
:name t-name)))
|
|
(or all-tags (list)))))
|
|
:delete-form (~admin/tag-group-delete-form :delete-url delete-url :csrf csrf)))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Preview content composition — replaces _h_post_preview_content
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
(defcomp ~admin/preview-content (&key sx-pretty json-pretty sx-rendered lex-rendered)
|
|
(let* ((sections (list)))
|
|
(if (and (not sx-pretty) (not json-pretty) (not sx-rendered) (not lex-rendered))
|
|
(~admin/preview-empty)
|
|
(~admin/preview-panel :sections
|
|
(<>
|
|
(when sx-pretty
|
|
(~admin/preview-section :title "S-Expression Source" :content sx-pretty))
|
|
(when json-pretty
|
|
(~admin/preview-section :title "Lexical JSON" :content json-pretty))
|
|
(when sx-rendered
|
|
(~admin/preview-section :title "SX Rendered"
|
|
:content (~admin/preview-rendered :html sx-rendered)))
|
|
(when lex-rendered
|
|
(~admin/preview-section :title "Lexical Rendered"
|
|
:content (~admin/preview-rendered :html lex-rendered))))))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Data introspection composition — replaces _h_post_data_content
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
(defcomp ~admin/data-value-cell (&key value value-type)
|
|
(if (= value-type "nil")
|
|
(span :class "text-neutral-400" "\u2014")
|
|
(pre :class "whitespace-pre-wrap break-words break-all text-xs"
|
|
(if (or (= value-type "date") (= value-type "other"))
|
|
(code value)
|
|
value))))
|
|
|
|
(defcomp
|
|
~admin/data-scalar-table
|
|
(&key columns)
|
|
(div
|
|
:class "w-full overflow-x-auto sm:overflow-visible"
|
|
(table
|
|
:class "w-full table-fixed text-sm border border-neutral-200 rounded-xl overflow-hidden"
|
|
(thead
|
|
:class "bg-neutral-50/70"
|
|
(tr
|
|
(th :class "px-3 py-2 text-left font-medium w-40 sm:w-56" "Field")
|
|
(th :class "px-3 py-2 text-left font-medium" "Value")))
|
|
(tbody
|
|
(map
|
|
(lambda
|
|
(col)
|
|
(let-match
|
|
{:value value :key key :type type}
|
|
col
|
|
(tr
|
|
:class "border-t border-neutral-200 align-top"
|
|
(td :class "px-3 py-2 whitespace-nowrap text-neutral-600" key)
|
|
(td
|
|
:class "px-3 py-2 align-top"
|
|
(~admin/data-value-cell :value value :value-type type)))))
|
|
(or columns (list)))))))
|
|
|
|
(defcomp
|
|
~admin/data-relationship-item
|
|
(&key index summary children)
|
|
(tr
|
|
:class "border-t border-neutral-200 align-top"
|
|
(td :class "px-2 py-1 whitespace-nowrap align-top" (str index))
|
|
(td
|
|
:class "px-2 py-1 align-top"
|
|
(pre
|
|
:class "whitespace-pre-wrap break-words break-all text-xs"
|
|
(code summary))
|
|
(when
|
|
children
|
|
(div
|
|
:class "mt-2 pl-3 border-l border-neutral-200"
|
|
(let-match
|
|
{:relationships relationships :columns columns}
|
|
children
|
|
(~admin/data-model-content
|
|
:columns columns
|
|
:relationships relationships)))))))
|
|
|
|
(defcomp ~admin/data-relationship (&key name cardinality class-name loaded value)
|
|
(div :class "rounded-xl border border-neutral-200"
|
|
(div :class "px-3 py-2 bg-neutral-50/70 text-sm font-medium"
|
|
"Relationship: " (span :class "font-semibold" name)
|
|
(span :class "ml-2 text-xs text-neutral-500"
|
|
cardinality " \u2192 " class-name
|
|
(when (not loaded) " \u2022 " (em "not loaded"))))
|
|
(div :class "p-3 text-sm"
|
|
(if (not value)
|
|
(span :class "text-neutral-400" "\u2014")
|
|
(if (get value "is_list")
|
|
(<>
|
|
(div :class "text-neutral-500 mb-2"
|
|
(str (get value "count") " item" (if (= (get value "count") 1) "" "s")))
|
|
(when (get value "items")
|
|
(div :class "w-full overflow-x-auto sm:overflow-visible"
|
|
(table :class "w-full table-fixed text-sm border border-neutral-200 rounded-lg overflow-hidden"
|
|
(thead :class "bg-neutral-50/70"
|
|
(tr (th :class "px-2 py-1 text-left w-10" "#")
|
|
(th :class "px-2 py-1 text-left" "Summary")))
|
|
(tbody
|
|
(map (lambda (item)
|
|
(~admin/data-relationship-item
|
|
:index (get item "index")
|
|
:summary (get item "summary")
|
|
:children (get item "children")))
|
|
(get value "items")))))))
|
|
;; Single value
|
|
(<>
|
|
(pre :class "whitespace-pre-wrap break-words break-all text-xs mb-2"
|
|
(code (get value "summary")))
|
|
(when (get value "children")
|
|
(div :class "pl-3 border-l border-neutral-200"
|
|
(~admin/data-model-content
|
|
:columns (get (get value "children") "columns")
|
|
:relationships (get (get value "children") "relationships"))))))))))
|
|
|
|
(defcomp
|
|
~admin/data-model-content
|
|
(&key columns relationships)
|
|
(div
|
|
:class "space-y-4"
|
|
(~admin/data-scalar-table :columns columns)
|
|
(when
|
|
(not (empty? (or relationships (list))))
|
|
(div
|
|
:class "space-y-3"
|
|
(map
|
|
(lambda
|
|
(rel)
|
|
(let-match
|
|
{:cardinality cardinality :class_name class-name :loaded loaded :value value :name name}
|
|
rel
|
|
(~admin/data-relationship
|
|
:name name
|
|
:cardinality cardinality
|
|
:class-name class-name
|
|
:loaded loaded
|
|
:value value)))
|
|
relationships)))))
|
|
|
|
(defcomp
|
|
~admin/data-table-content
|
|
(&key tablename model-data)
|
|
(if
|
|
(not model-data)
|
|
(div :class "px-4 py-8 text-stone-400" "No post data available.")
|
|
(div
|
|
:class "px-4 py-8"
|
|
(div
|
|
:class "mb-6 text-sm text-neutral-500"
|
|
"Model: "
|
|
(code "Post")
|
|
" • Table: "
|
|
(code tablename))
|
|
(let-match
|
|
{:relationships relationships :columns columns}
|
|
model-data
|
|
(~admin/data-model-content
|
|
:columns columns
|
|
:relationships relationships)))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Calendar month view for browsing/toggling entries (B1)
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
(defcomp ~admin/cal-entry-associated (&key name toggle-url csrf)
|
|
(div :class "flex items-center gap-1 text-[10px] rounded px-1 py-0.5 bg-green-200 text-green-900"
|
|
(span :class "truncate flex-1" name)
|
|
(button :type "button" :class "flex-shrink-0 hover:text-red-600"
|
|
:data-confirm "" :data-confirm-title "Remove entry?"
|
|
:data-confirm-text (str "Remove " name " from this post?")
|
|
:data-confirm-icon "warning" :data-confirm-confirm-text "Yes, remove it"
|
|
:data-confirm-cancel-text "Cancel" :data-confirm-event "confirmed"
|
|
:sx-post toggle-url :sx-trigger "confirmed"
|
|
:sx-target "#associated-entries-list" :sx-swap "outerHTML"
|
|
:sx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
|
:sx-on:afterSwap "document.body.dispatchEvent(new CustomEvent('entryToggled'))"
|
|
(i :class "fa fa-times"))))
|
|
|
|
(defcomp ~admin/cal-entry-unassociated (&key name toggle-url csrf)
|
|
(button :type "button"
|
|
:class "w-full text-left text-[10px] rounded px-1 py-0.5 bg-stone-100 text-stone-700 hover:bg-stone-200"
|
|
:data-confirm "" :data-confirm-title "Add entry?"
|
|
:data-confirm-text (str "Add " name " to this post?")
|
|
:data-confirm-icon "question" :data-confirm-confirm-text "Yes, add it"
|
|
:data-confirm-cancel-text "Cancel" :data-confirm-event "confirmed"
|
|
:sx-post toggle-url :sx-trigger "confirmed"
|
|
:sx-target "#associated-entries-list" :sx-swap "outerHTML"
|
|
:sx-headers (str "{\"X-CSRFToken\": \"" csrf "\"}")
|
|
:sx-on:afterSwap "document.body.dispatchEvent(new CustomEvent('entryToggled'))"
|
|
(span :class "truncate block" name)))
|
|
|
|
(defcomp
|
|
~admin/calendar-view
|
|
(&key
|
|
cal-id
|
|
year
|
|
month-name
|
|
current-url
|
|
prev-month-url
|
|
prev-year-url
|
|
next-month-url
|
|
next-year-url
|
|
weekday-names
|
|
days
|
|
csrf)
|
|
(let*
|
|
((target (str "#calendar-view-" cal-id)))
|
|
(div
|
|
:id (str "calendar-view-" cal-id)
|
|
:sx-get current-url
|
|
:sx-trigger "entryToggled from:body"
|
|
:sx-swap "outerHTML"
|
|
(header
|
|
:class "flex items-center justify-center mb-4"
|
|
(nav
|
|
:class "flex items-center gap-2 text-xl"
|
|
(a
|
|
:class "px-2 py-1 hover:bg-stone-100 rounded"
|
|
:sx-get prev-year-url
|
|
:sx-target target
|
|
:sx-swap "outerHTML"
|
|
(raw! "«"))
|
|
(a
|
|
:class "px-2 py-1 hover:bg-stone-100 rounded"
|
|
:sx-get prev-month-url
|
|
:sx-target target
|
|
:sx-swap "outerHTML"
|
|
(raw! "‹"))
|
|
(div :class "px-3 font-medium" (str month-name " " year))
|
|
(a
|
|
:class "px-2 py-1 hover:bg-stone-100 rounded"
|
|
:sx-get next-month-url
|
|
:sx-target target
|
|
:sx-swap "outerHTML"
|
|
(raw! "›"))
|
|
(a
|
|
:class "px-2 py-1 hover:bg-stone-100 rounded"
|
|
:sx-get next-year-url
|
|
:sx-target target
|
|
:sx-swap "outerHTML"
|
|
(raw! "»"))))
|
|
(div
|
|
:class "rounded border bg-white"
|
|
(div
|
|
:class "hidden sm:grid grid-cols-7 text-center text-xs font-semibold text-stone-700 bg-stone-50 border-b"
|
|
(map
|
|
(lambda (wd) (div :class "py-2" wd))
|
|
(or weekday-names (list))))
|
|
(div
|
|
:class "grid grid-cols-1 sm:grid-cols-7 gap-px bg-stone-200"
|
|
(map
|
|
(lambda
|
|
(day)
|
|
(let-match
|
|
{:entries entries* :in_month in-month :day day-num}
|
|
day
|
|
(let*
|
|
((extra-cls (if in-month "" " bg-stone-50 text-stone-400"))
|
|
(entries (or entries* (list))))
|
|
(div
|
|
:class (str "min-h-20 bg-white px-2 py-2 text-xs" extra-cls)
|
|
(div :class "font-medium mb-1" (str day-num))
|
|
(when
|
|
(not (empty? entries))
|
|
(div
|
|
:class "space-y-0.5"
|
|
(map
|
|
(lambda
|
|
(e)
|
|
(let-match
|
|
{:is_associated is-associated :toggle_url toggle-url :name name}
|
|
e
|
|
(if
|
|
is-associated
|
|
(~admin/cal-entry-associated
|
|
:name name
|
|
:toggle-url toggle-url
|
|
:csrf csrf)
|
|
(~admin/cal-entry-unassociated
|
|
:name name
|
|
:toggle-url toggle-url
|
|
:csrf csrf))))
|
|
entries)))))))
|
|
(or days (list))))))))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; Nav entries OOB — renders associated entry/calendar items in scroll wrapper (B2)
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
(defcomp
|
|
~admin/nav-entries-oob
|
|
(&key entries calendars)
|
|
(let*
|
|
((entry-list (or entries (list)))
|
|
(cal-list (or calendars (list)))
|
|
(has-items (or (not (empty? entry-list)) (not (empty? cal-list))))
|
|
(nav-cls
|
|
"justify-center cursor-pointer flex flex-row items-center gap-2 rounded bg-stone-200 text-black [.hover-capable_&]:hover:bg-yellow-300 aria-selected:bg-stone-500 aria-selected:text-white [.hover-capable_&[aria-selected=true]:hover]:bg-orange-500 p-2")
|
|
(scroll-hs
|
|
"on load or scroll if window.innerWidth >= 640 and my.scrollWidth > my.clientWidth remove .hidden from .entries-nav-arrow add .flex to .entries-nav-arrow else add .hidden to .entries-nav-arrow remove .flex from .entries-nav-arrow end"))
|
|
(if
|
|
(not has-items)
|
|
(~shared:nav/blog-nav-entries-empty)
|
|
(~shared:misc/scroll-nav-wrapper
|
|
:wrapper-id "entries-calendars-nav-wrapper"
|
|
:container-id "associated-items-container"
|
|
:arrow-cls "entries-nav-arrow"
|
|
:left-hs "on click set #associated-items-container.scrollLeft to #associated-items-container.scrollLeft - 200"
|
|
:scroll-hs scroll-hs
|
|
:right-hs "on click set #associated-items-container.scrollLeft to #associated-items-container.scrollLeft + 200"
|
|
:items (<>
|
|
(map
|
|
(lambda
|
|
(e)
|
|
(let-match
|
|
{:href href :date_str date-str :name name}
|
|
e
|
|
(~shared:navigation/calendar-entry-nav
|
|
:href href
|
|
:nav-class nav-cls
|
|
:name name
|
|
:date-str date-str)))
|
|
entry-list)
|
|
(map
|
|
(lambda
|
|
(c)
|
|
(let-match
|
|
{:href href :name name}
|
|
c
|
|
(~shared:nav/blog-nav-calendar-item
|
|
:href href
|
|
:nav-cls nav-cls
|
|
:name name)))
|
|
cal-list))
|
|
:oob true))))
|