Compare commits
20 Commits
4c4806c8dd
...
8f88e52b27
| Author | SHA1 | Date | |
|---|---|---|---|
| 8f88e52b27 | |||
| b8018ba385 | |||
| 95ffc0ecb7 | |||
| 477ce766ff | |||
| 98c1023b81 | |||
| b99e69d1bb | |||
| a425ea8ed4 | |||
| c82941d93c | |||
| 9b38ef2ce9 | |||
| 4d54be6b6b | |||
| 5d5512e74a | |||
| 8a530569a2 | |||
| b82fd7822d | |||
| e5dbe9f3da | |||
| 0174fbfea3 | |||
| cd7653d8c3 | |||
| ff6c1fab71 | |||
| e843602ac9 | |||
| c95e19dcf2 | |||
| 29c90a625b |
@@ -1,12 +1,12 @@
|
||||
;; Auth page components (device auth — account-specific)
|
||||
;; Login and check-email components are shared: see shared/sx/templates/auth.sx
|
||||
|
||||
(defcomp ~account-device-error (&key error)
|
||||
(defcomp ~account-device-error (&key (error :as string))
|
||||
(when error
|
||||
(div :class "bg-red-50 border border-red-200 text-red-700 p-3 rounded mb-4"
|
||||
error)))
|
||||
|
||||
(defcomp ~account-device-form (&key error action csrf-token code)
|
||||
(defcomp ~account-device-form (&key error (action :as string) (csrf-token :as string) (code :as string))
|
||||
(div :class "py-8 max-w-md mx-auto"
|
||||
(h1 :class "text-2xl font-bold mb-6" "Authorize device")
|
||||
(p :class "text-stone-600 mb-4" "Enter the code shown in your terminal to sign in.")
|
||||
@@ -29,21 +29,21 @@
|
||||
|
||||
;; Assembled auth page content — replaces Python _login_page_content etc.
|
||||
|
||||
(defcomp ~account-login-content (&key error email)
|
||||
(defcomp ~account-login-content (&key (error :as string?) (email :as string?))
|
||||
(~auth-login-form
|
||||
:error (when error (~auth-error-banner :error error))
|
||||
:action (url-for "auth.start_login")
|
||||
:csrf-token (csrf-token)
|
||||
:email (or email "")))
|
||||
|
||||
(defcomp ~account-device-content (&key error code)
|
||||
(defcomp ~account-device-content (&key (error :as string?) (code :as string?))
|
||||
(~account-device-form
|
||||
:error (when error (~account-device-error :error error))
|
||||
:action (url-for "auth.device_submit")
|
||||
:csrf-token (csrf-token)
|
||||
:code (or code "")))
|
||||
|
||||
(defcomp ~account-check-email-content (&key email email-error)
|
||||
(defcomp ~account-check-email-content (&key (email :as string?) (email-error :as string?))
|
||||
(~auth-check-email
|
||||
:email (escape (or email ""))
|
||||
:error (when email-error
|
||||
|
||||
@@ -1,26 +1,26 @@
|
||||
;; Account dashboard components
|
||||
|
||||
(defcomp ~account-error-banner (&key error)
|
||||
(defcomp ~account-error-banner (&key (error :as string))
|
||||
(when error
|
||||
(div :class "rounded-lg border border-red-200 bg-red-50 text-red-800 px-4 py-3 text-sm"
|
||||
error)))
|
||||
|
||||
(defcomp ~account-user-email (&key email)
|
||||
(defcomp ~account-user-email (&key (email :as string))
|
||||
(when email
|
||||
(p :class "text-sm text-stone-500 mt-1" email)))
|
||||
|
||||
(defcomp ~account-user-name (&key name)
|
||||
(defcomp ~account-user-name (&key (name :as string))
|
||||
(when name
|
||||
(p :class "text-sm text-stone-600" name)))
|
||||
|
||||
(defcomp ~account-logout-form (&key csrf-token)
|
||||
(defcomp ~account-logout-form (&key (csrf-token :as string))
|
||||
(form :action "/auth/logout/" :method "post"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf-token)
|
||||
(button :type "submit"
|
||||
:class "inline-flex items-center gap-2 rounded-full border border-stone-300 px-4 py-2 text-sm font-medium text-stone-700 hover:bg-stone-50 transition"
|
||||
(i :class "fa-solid fa-right-from-bracket text-xs") " Sign out")))
|
||||
|
||||
(defcomp ~account-label-item (&key name)
|
||||
(defcomp ~account-label-item (&key (name :as string))
|
||||
(span :class "inline-flex items-center rounded-full border border-stone-200 px-3 py-1 text-xs font-medium bg-white/60"
|
||||
name))
|
||||
|
||||
@@ -43,7 +43,7 @@
|
||||
labels)))
|
||||
|
||||
;; Assembled dashboard content — replaces Python _account_main_panel_sx
|
||||
(defcomp ~account-dashboard-content (&key error)
|
||||
(defcomp ~account-dashboard-content (&key (error :as string?))
|
||||
(let* ((user (current-user))
|
||||
(csrf (csrf-token)))
|
||||
(~account-main-panel
|
||||
|
||||
@@ -1,17 +1,17 @@
|
||||
;; Newsletter management components
|
||||
|
||||
(defcomp ~account-newsletter-desc (&key description)
|
||||
(defcomp ~account-newsletter-desc (&key (description :as string))
|
||||
(when description
|
||||
(p :class "text-xs text-stone-500 mt-0.5 truncate" description)))
|
||||
|
||||
(defcomp ~account-newsletter-toggle (&key id url hdrs target cls checked knob-cls)
|
||||
(defcomp ~account-newsletter-toggle (&key (id :as string) (url :as string) (hdrs :as dict) (target :as string) (cls :as string) (checked :as string) (knob-cls :as string))
|
||||
(div :id id :class "flex items-center"
|
||||
(button :sx-post url :sx-headers hdrs :sx-target target :sx-swap "outerHTML"
|
||||
:class cls :role "switch" :aria-checked checked
|
||||
(span :class knob-cls))))
|
||||
|
||||
|
||||
(defcomp ~account-newsletter-item (&key name desc toggle)
|
||||
(defcomp ~account-newsletter-item (&key (name :as string) desc toggle)
|
||||
(div :class "flex items-center justify-between py-4 first:pt-0 last:pb-0"
|
||||
(div :class "min-w-0 flex-1"
|
||||
(p :class "text-sm font-medium text-stone-800" name)
|
||||
@@ -32,7 +32,7 @@
|
||||
|
||||
;; Assembled newsletters content — replaces Python _newsletters_panel_sx
|
||||
;; Takes pre-fetched newsletter-list from page helper
|
||||
(defcomp ~account-newsletters-content (&key newsletter-list account-url)
|
||||
(defcomp ~account-newsletters-content (&key (newsletter-list :as list) (account-url :as string?))
|
||||
(let* ((csrf (csrf-token)))
|
||||
(if (empty? newsletter-list)
|
||||
(~account-newsletter-empty)
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Blog admin panel components
|
||||
|
||||
(defcomp ~blog-cache-panel (&key clear-url csrf)
|
||||
(defcomp ~blog-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"
|
||||
@@ -19,10 +19,10 @@
|
||||
:sx-headers hx-headers :class "text-sm border border-stone-300 rounded px-2 py-1"
|
||||
options))
|
||||
|
||||
(defcomp ~blog-snippet-option (&key value selected label)
|
||||
(defcomp ~blog-snippet-option (&key (value :as string) (selected :as boolean) (label :as string))
|
||||
(option :value value :selected selected label))
|
||||
|
||||
(defcomp ~blog-snippet-row (&key name owner badge-cls visibility extra)
|
||||
(defcomp ~blog-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)
|
||||
@@ -42,7 +42,7 @@
|
||||
(div :id "menu-item-form" :class "mb-6")
|
||||
(div :id "menu-items-list" list)))
|
||||
|
||||
(defcomp ~blog-menu-item-row (&key img label slug sort-order edit-url delete-url confirm-text hx-headers)
|
||||
(defcomp ~blog-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
|
||||
@@ -81,7 +81,7 @@
|
||||
(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 ~blog-tag-group-li (&key icon edit-href name slug sort-order)
|
||||
(defcomp ~blog-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"
|
||||
@@ -106,7 +106,7 @@
|
||||
|
||||
;; Tag group edit
|
||||
|
||||
(defcomp ~blog-tag-checkbox (&key tag-id checked img name)
|
||||
(defcomp ~blog-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)))
|
||||
@@ -114,7 +114,7 @@
|
||||
(defcomp ~blog-tag-checkbox-image (&key src)
|
||||
(img :src src :alt "" :class "h-4 w-4 rounded-full object-cover"))
|
||||
|
||||
(defcomp ~blog-tag-group-edit-form (&key save-url csrf name colour sort-order feature-image tags)
|
||||
(defcomp ~blog-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"
|
||||
@@ -133,7 +133,7 @@
|
||||
(div :class "flex gap-3"
|
||||
(button :type "submit" :class "border rounded px-4 py-2 bg-stone-800 text-white text-sm" "Save"))))
|
||||
|
||||
(defcomp ~blog-tag-group-delete-form (&key delete-url csrf)
|
||||
(defcomp ~blog-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)
|
||||
|
||||
@@ -4,17 +4,17 @@
|
||||
(div :class "absolute top-20 right-2 z-10 text-6xl md:text-4xl"
|
||||
(~blog-like-toggle :like-url like-url :hx-headers hx-headers :heart heart)))
|
||||
|
||||
(defcomp ~blog-draft-status (&key publish-requested timestamp)
|
||||
(defcomp ~blog-draft-status (&key (publish-requested :as boolean) (timestamp :as string?))
|
||||
(<> (div :class "flex justify-center gap-2 mt-1"
|
||||
(span :class "inline-block px-2 py-0.5 rounded-full text-xs font-semibold bg-amber-100 text-amber-800" "Draft")
|
||||
(when publish-requested (span :class "inline-block px-2 py-0.5 rounded-full text-xs font-semibold bg-blue-100 text-blue-800" "Publish requested")))
|
||||
(when timestamp (p :class "text-sm text-stone-500" (str "Updated: " timestamp)))))
|
||||
|
||||
(defcomp ~blog-published-status (&key timestamp)
|
||||
(defcomp ~blog-published-status (&key (timestamp :as string))
|
||||
(p :class "text-sm text-stone-500" (str "Published: " timestamp)))
|
||||
|
||||
;; Tag components — accept data, not HTML
|
||||
(defcomp ~blog-tag-icon (&key src name initial)
|
||||
(defcomp ~blog-tag-icon (&key (src :as string?) (name :as string) (initial :as string))
|
||||
(if src
|
||||
(img :src src :alt name :class "h-4 w-4 rounded-full object-cover border border-stone-300 flex-shrink-0")
|
||||
(div :class "h-4 w-4 rounded-full text-[8px] font-semibold flex items-center justify-center border border-stone-300 flex-shrink-0 bg-stone-200 text-stone-600" initial)))
|
||||
@@ -45,12 +45,12 @@
|
||||
(span :class "text-stone-700" name)))
|
||||
|
||||
;; Card — accepts pure data
|
||||
(defcomp ~blog-card (&key slug href hx-select title
|
||||
feature-image excerpt
|
||||
status is-draft publish-requested status-timestamp
|
||||
liked like-url csrf-token
|
||||
has-like
|
||||
tags authors widget)
|
||||
(defcomp ~blog-card (&key (slug :as string) (href :as string) (hx-select :as string?) (title :as string)
|
||||
(feature-image :as string?) (excerpt :as string?)
|
||||
status (is-draft :as boolean) (publish-requested :as boolean) (status-timestamp :as string?)
|
||||
(liked :as boolean) (like-url :as string?) (csrf-token :as string?)
|
||||
(has-like :as boolean)
|
||||
(tags :as list?) (authors :as list?) widget)
|
||||
(article :class "border-b pb-6 last:border-b-0 relative"
|
||||
(when has-like
|
||||
(~blog-like-button
|
||||
@@ -80,9 +80,9 @@
|
||||
(ul :class "flex flex-wrap gap-2 text-sm"
|
||||
(map (lambda (a) (~blog-author-item :image (get a "image") :name (get a "name"))) authors))))))))
|
||||
|
||||
(defcomp ~blog-card-tile (&key href hx-select feature-image title
|
||||
is-draft publish-requested status-timestamp
|
||||
excerpt tags authors)
|
||||
(defcomp ~blog-card-tile (&key (href :as string) (hx-select :as string?) (feature-image :as string?) (title :as string)
|
||||
(is-draft :as boolean) (publish-requested :as boolean) (status-timestamp :as string?)
|
||||
(excerpt :as string?) (tags :as list?) (authors :as list?))
|
||||
(article :class "relative"
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select (or hx-select "#main-panel") :sx-swap "outerHTML" :sx-push-url "true"
|
||||
@@ -107,7 +107,7 @@
|
||||
(map (lambda (a) (~blog-author-item :image (get a "image") :name (get a "name"))) authors))))))))
|
||||
|
||||
;; Data-driven blog cards list (replaces Python _blog_cards_sx loop)
|
||||
(defcomp ~blog-cards-from-data (&key posts view sentinel)
|
||||
(defcomp ~blog-cards-from-data (&key (posts :as list?) (view :as string?) sentinel)
|
||||
(<>
|
||||
(map (lambda (p)
|
||||
(if (= view "tile")
|
||||
@@ -131,7 +131,7 @@
|
||||
sentinel))
|
||||
|
||||
;; Data-driven page cards list (replaces Python _page_cards_sx loop)
|
||||
(defcomp ~page-cards-from-data (&key pages sentinel)
|
||||
(defcomp ~page-cards-from-data (&key (pages :as list?) sentinel)
|
||||
(<>
|
||||
(map (lambda (pg)
|
||||
(~blog-page-card
|
||||
@@ -150,7 +150,7 @@
|
||||
(when has-market (span :class "inline-block px-2 py-0.5 rounded-full text-xs font-semibold bg-green-100 text-green-800"
|
||||
(i :class "fa fa-shopping-bag mr-1") "Market"))))
|
||||
|
||||
(defcomp ~blog-page-card (&key href hx-select title has-calendar has-market pub-timestamp feature-image excerpt)
|
||||
(defcomp ~blog-page-card (&key (href :as string) (hx-select :as string?) (title :as string) (has-calendar :as boolean) (has-market :as boolean) (pub-timestamp :as string?) (feature-image :as string?) (excerpt :as string?))
|
||||
(article :class "border-b pb-6 last:border-b-0 relative"
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select (or hx-select "#main-panel") :sx-swap "outerHTML" :sx-push-url "true"
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Blog post detail components
|
||||
|
||||
(defcomp ~blog-detail-edit-link (&key href hx-select)
|
||||
(defcomp ~blog-detail-edit-link (&key (href :as string) (hx-select :as string))
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class "inline-block px-3 py-1 rounded-full text-sm font-semibold bg-stone-700 text-white hover:bg-stone-800 transition-colors"
|
||||
@@ -20,7 +20,7 @@
|
||||
(div :class "absolute top-2 right-2 z-10 text-8xl md:text-6xl"
|
||||
(~blog-like-toggle :like-url like-url :hx-headers hx-headers :heart heart)))
|
||||
|
||||
(defcomp ~blog-detail-excerpt (&key excerpt)
|
||||
(defcomp ~blog-detail-excerpt (&key (excerpt :as string))
|
||||
(div :class "w-full text-center italic text-3xl p-2" excerpt))
|
||||
|
||||
(defcomp ~blog-detail-chrome (&key like excerpt at-bar)
|
||||
@@ -43,10 +43,10 @@
|
||||
;; Data-driven composition — replaces _post_main_panel_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-post-detail-content (&key slug is-draft publish-requested can-edit edit-href
|
||||
is-page has-user liked like-url csrf
|
||||
custom-excerpt tags authors
|
||||
feature-image html-content sx-content)
|
||||
(defcomp ~blog-post-detail-content (&key (slug :as string) (is-draft :as boolean) (publish-requested :as boolean) (can-edit :as boolean) (edit-href :as string?)
|
||||
(is-page :as boolean) (has-user :as boolean) (liked :as boolean) (like-url :as string?) (csrf :as string?)
|
||||
(custom-excerpt :as string?) (tags :as list?) (authors :as list?)
|
||||
(feature-image :as string?) (html-content :as string?) (sx-content :as string?))
|
||||
(let* ((hx-select "#main-panel")
|
||||
(draft-sx (when is-draft
|
||||
(~blog-detail-draft
|
||||
@@ -70,7 +70,7 @@
|
||||
:html-content html-content
|
||||
:sx-content sx-content)))
|
||||
|
||||
(defcomp ~blog-meta (&key robots page-title desc canonical og-type og-title image twitter-card twitter-title)
|
||||
(defcomp ~blog-meta (&key (robots :as string) (page-title :as string) (desc :as string) (canonical :as string?) (og-type :as string) (og-title :as string) (image :as string?) (twitter-card :as string) (twitter-title :as string))
|
||||
(<>
|
||||
(meta :name "robots" :content robots)
|
||||
(title page-title)
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
(div :class "max-w-[768px] mx-auto mt-[16px] rounded-[8px] border border-red-300 bg-red-50 px-[16px] py-[12px] text-[14px] text-red-700"
|
||||
(strong "Save failed:") " " error))
|
||||
|
||||
(defcomp ~blog-editor-form (&key csrf title-placeholder create-label)
|
||||
(defcomp ~blog-editor-form (&key (csrf :as string) (title-placeholder :as string) (create-label :as string))
|
||||
(form :id "post-new-form" :method "post" :class "max-w-[768px] mx-auto pb-[48px]"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :id "lexical-json-input" :name "lexical" :value "")
|
||||
@@ -56,11 +56,11 @@
|
||||
:class "px-[20px] py-[6px] bg-stone-700 text-white text-[14px] rounded-[8px] hover:bg-stone-800 transition-colors cursor-pointer" create-label))))
|
||||
|
||||
;; Edit form — pre-populated version for /<slug>/admin/edit/
|
||||
(defcomp ~blog-editor-edit-form (&key csrf updated-at title-val excerpt-val
|
||||
feature-image feature-image-caption
|
||||
sx-content-val lexical-json
|
||||
has-sx title-placeholder
|
||||
status already-emailed
|
||||
(defcomp ~blog-editor-edit-form (&key (csrf :as string) (updated-at :as string) (title-val :as string?) (excerpt-val :as string?)
|
||||
(feature-image :as string?) (feature-image-caption :as string?)
|
||||
(sx-content-val :as string?) (lexical-json :as string?)
|
||||
(has-sx :as boolean) (title-placeholder :as string)
|
||||
(status :as string) (already-emailed :as boolean)
|
||||
newsletter-options footer-extra)
|
||||
(let* ((sel-cls "text-[14px] rounded-[4px] border border-stone-200 px-[8px] py-[6px] bg-white text-stone-600")
|
||||
(active "px-[12px] py-[6px] text-[13px] font-medium text-stone-700 border-b-2 border-stone-700 cursor-pointer bg-transparent")
|
||||
@@ -153,14 +153,14 @@
|
||||
" sync();"
|
||||
"})();"))
|
||||
|
||||
(defcomp ~blog-editor-styles (&key css-href)
|
||||
(defcomp ~blog-editor-styles (&key (css-href :as string))
|
||||
(<> (link :rel "stylesheet" :href css-href)
|
||||
(style
|
||||
"#lexical-editor { display: flow-root; }"
|
||||
"#lexical-editor [data-kg-card=\"html\"] * { float: none !important; }"
|
||||
"#lexical-editor [data-kg-card=\"html\"] table { width: 100% !important; }")))
|
||||
|
||||
(defcomp ~blog-editor-scripts (&key js-src sx-editor-js-src init-js)
|
||||
(defcomp ~blog-editor-scripts (&key (js-src :as string) (sx-editor-js-src :as string?) (init-js :as string))
|
||||
(<> (script :src js-src)
|
||||
(when sx-editor-js-src (script :src sx-editor-js-src))
|
||||
(script init-js)))
|
||||
|
||||
@@ -1,11 +1,11 @@
|
||||
;; Blog filter components
|
||||
|
||||
(defcomp ~blog-action-button (&key href hx-select btn-class title icon-class label)
|
||||
(defcomp ~blog-action-button (&key (href :as string) (hx-select :as string) (btn-class :as string) (title :as string) (icon-class :as string) (label :as string))
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class btn-class :title title (i :class icon-class) label))
|
||||
|
||||
(defcomp ~blog-drafts-button (&key href hx-select btn-class title label draft-count)
|
||||
(defcomp ~blog-drafts-button (&key (href :as string) (hx-select :as string) (btn-class :as string) (title :as string) (label :as string) (draft-count :as number))
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:class btn-class :title title (i :class "fa fa-file-text-o mr-1") " Drafts "
|
||||
@@ -61,7 +61,7 @@
|
||||
(span :class "flex-1")
|
||||
(span :class "inline-block bg-stone-100 text-stone-600 px-2 py-1 text-xs font-medium border border-stone-200" count))))
|
||||
|
||||
(defcomp ~blog-filter-summary (&key text)
|
||||
(defcomp ~blog-filter-summary (&key (text :as string))
|
||||
(span :class "text-sm text-stone-600" text))
|
||||
|
||||
;; Data-driven tag groups filter (replaces Python _tag_groups_filter_sx loop)
|
||||
|
||||
@@ -7,7 +7,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Image card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-image (&key src alt caption width href)
|
||||
(defcomp ~kg-image (&key (src :as string) (alt :as string?) (caption :as string?) (width :as string?) (href :as string?))
|
||||
(figure :class (str "kg-card kg-image-card"
|
||||
(if (= width "wide") " kg-width-wide"
|
||||
(if (= width "full") " kg-width-full" "")))
|
||||
@@ -19,7 +19,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Gallery card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-gallery (&key images caption)
|
||||
(defcomp ~kg-gallery (&key (images :as list) (caption :as string?))
|
||||
(figure :class "kg-card kg-gallery-card kg-width-wide"
|
||||
(div :class "kg-gallery-container"
|
||||
(map (lambda (row)
|
||||
@@ -48,7 +48,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Embed card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-embed (&key html caption)
|
||||
(defcomp ~kg-embed (&key (html :as string) (caption :as string?))
|
||||
(figure :class "kg-card kg-embed-card"
|
||||
(~rich-text :html html)
|
||||
(when caption (figcaption caption))))
|
||||
@@ -56,7 +56,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Bookmark card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-bookmark (&key url title description icon author publisher thumbnail caption)
|
||||
(defcomp ~kg-bookmark (&key (url :as string) (title :as string?) (description :as string?) (icon :as string?) (author :as string?) (publisher :as string?) (thumbnail :as string?) (caption :as string?))
|
||||
(figure :class "kg-card kg-bookmark-card"
|
||||
(a :class "kg-bookmark-container" :href url
|
||||
(div :class "kg-bookmark-content"
|
||||
@@ -75,7 +75,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Callout card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-callout (&key color emoji content)
|
||||
(defcomp ~kg-callout (&key (color :as string?) (emoji :as string?) (content :as string?))
|
||||
(div :class (str "kg-card kg-callout-card kg-callout-card-" (or color "grey"))
|
||||
(when emoji (div :class "kg-callout-emoji" emoji))
|
||||
(div :class "kg-callout-text" (or content ""))))
|
||||
@@ -83,14 +83,14 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Button card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-button (&key url text alignment)
|
||||
(defcomp ~kg-button (&key (url :as string) (text :as string?) (alignment :as string?))
|
||||
(div :class (str "kg-card kg-button-card kg-align-" (or alignment "center"))
|
||||
(a :href url :class "kg-btn kg-btn-accent" (or text ""))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Toggle card (accordion)
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-toggle (&key heading content)
|
||||
(defcomp ~kg-toggle (&key (heading :as string?) (content :as string?))
|
||||
(div :class "kg-card kg-toggle-card" :data-kg-toggle-state "close"
|
||||
(div :class "kg-toggle-heading"
|
||||
(h4 :class "kg-toggle-heading-text" (or heading ""))
|
||||
@@ -101,7 +101,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Audio card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-audio (&key src title duration thumbnail)
|
||||
(defcomp ~kg-audio (&key (src :as string) (title :as string?) (duration :as string?) (thumbnail :as string?))
|
||||
(div :class "kg-card kg-audio-card"
|
||||
(if thumbnail
|
||||
(img :src thumbnail :alt "audio-thumbnail" :class "kg-audio-thumbnail")
|
||||
@@ -124,7 +124,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Video card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-video (&key src caption width thumbnail loop)
|
||||
(defcomp ~kg-video (&key (src :as string) (caption :as string?) (width :as string?) (thumbnail :as string?) (loop :as boolean?))
|
||||
(figure :class (str "kg-card kg-video-card"
|
||||
(if (= width "wide") " kg-width-wide"
|
||||
(if (= width "full") " kg-width-full" "")))
|
||||
@@ -136,7 +136,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; File card
|
||||
;; ---------------------------------------------------------------------------
|
||||
(defcomp ~kg-file (&key src filename title filesize caption)
|
||||
(defcomp ~kg-file (&key (src :as string) (filename :as string?) (title :as string?) (filesize :as string?) (caption :as string?))
|
||||
(div :class "kg-card kg-file-card"
|
||||
(a :class "kg-file-card-container" :href src :download (or filename "")
|
||||
(div :class "kg-file-card-contents"
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Blog settings panel components (features, markets, associated entries)
|
||||
|
||||
(defcomp ~blog-features-form (&key features-url calendar-checked market-checked hs-trigger)
|
||||
(defcomp ~blog-features-form (&key (features-url :as string) (calendar-checked :as boolean) (market-checked :as boolean) (hs-trigger :as string))
|
||||
(form :sx-put features-url :sx-target "#features-panel" :sx-swap "outerHTML"
|
||||
:sx-headers {:Content-Type "application/json"} :sx-encoding "json" :class "space-y-3"
|
||||
(label :class "flex items-center gap-3 cursor-pointer"
|
||||
@@ -31,7 +31,7 @@
|
||||
|
||||
;; Markets panel
|
||||
|
||||
(defcomp ~blog-market-item (&key name slug delete-url confirm-text)
|
||||
(defcomp ~blog-market-item (&key (name :as string) (slug :as string) (delete-url :as string) (confirm-text :as string))
|
||||
(li :class "flex items-center justify-between p-3 bg-stone-50 rounded"
|
||||
(div (span :class "font-medium" name)
|
||||
(span :class "text-stone-400 text-sm ml-2" (str "/" slug "/")))
|
||||
@@ -93,11 +93,11 @@
|
||||
|
||||
;; Associated entries
|
||||
|
||||
(defcomp ~blog-entry-image (&key src title)
|
||||
(defcomp ~blog-entry-image (&key (src :as string?) (title :as string))
|
||||
(if src (img :src src :alt title :class "w-8 h-8 rounded-full object-cover flex-shrink-0")
|
||||
(div :class "w-8 h-8 rounded-full bg-stone-200 flex-shrink-0")))
|
||||
|
||||
(defcomp ~blog-associated-entry (&key confirm-text toggle-url hx-headers img name date-str)
|
||||
(defcomp ~blog-associated-entry (&key (confirm-text :as string) (toggle-url :as string) hx-headers img (name :as string) (date-str :as string))
|
||||
(button :type "button"
|
||||
:class "w-full text-left p-3 rounded border bg-green-50 border-green-300 transition hover:bg-green-100"
|
||||
:data-confirm "" :data-confirm-title "Remove entry?"
|
||||
@@ -150,7 +150,7 @@
|
||||
;; Entries browser composition — replaces _h_post_entries_content
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-calendar-browser-item (&key name title image view-url)
|
||||
(defcomp ~blog-calendar-browser-item (&key (name :as string) (title :as string) (image :as string?) (view-url :as string))
|
||||
(details :class "border rounded-lg bg-white" :data-toggle-group "calendar-browser"
|
||||
(summary :class "p-4 cursor-pointer hover:bg-stone-50 flex items-center gap-3"
|
||||
(if image
|
||||
@@ -182,11 +182,11 @@
|
||||
;; Post settings form composition — replaces _h_post_settings_content
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~blog-settings-field-label (&key text field-for)
|
||||
(defcomp ~blog-settings-field-label (&key (text :as string) (field-for :as string))
|
||||
(label :for field-for
|
||||
:class "block text-[13px] font-medium text-stone-500 mb-[4px]" text))
|
||||
|
||||
(defcomp ~blog-settings-section (&key title content is-open)
|
||||
(defcomp ~blog-settings-section (&key (title :as string) content (is-open :as boolean))
|
||||
(details :class "border border-stone-200 rounded-[8px] overflow-hidden" :open is-open
|
||||
(summary :class "px-[16px] py-[10px] bg-stone-50 text-[14px] font-medium text-stone-600 cursor-pointer select-none hover:bg-stone-100 transition-colors"
|
||||
title)
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Cart calendar entry components
|
||||
|
||||
(defcomp ~cart-cal-entry (&key name date-str cost)
|
||||
(defcomp ~cart-cal-entry (&key (name :as string) (date-str :as string) (cost :as string))
|
||||
(li :class "flex items-start justify-between text-sm"
|
||||
(div (div :class "font-medium" name)
|
||||
(div :class "text-xs text-stone-500" date-str))
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
;; Cart item components
|
||||
|
||||
(defcomp ~cart-item-img (&key src alt)
|
||||
(defcomp ~cart-item-img (&key (src :as string) (alt :as string))
|
||||
(img :src src :alt alt :class "w-24 h-24 sm:w-32 sm:h-28 object-cover rounded-xl border border-stone-100" :loading "lazy"))
|
||||
|
||||
(defcomp ~cart-item-price (&key text)
|
||||
(defcomp ~cart-item-price (&key (text :as string))
|
||||
(p :class "text-sm sm:text-base font-semibold text-stone-900" text))
|
||||
|
||||
(defcomp ~cart-item-price-was (&key text)
|
||||
(defcomp ~cart-item-price-was (&key (text :as string))
|
||||
(p :class "text-xs text-stone-400 line-through" text))
|
||||
|
||||
(defcomp ~cart-item-no-price ()
|
||||
@@ -17,13 +17,13 @@
|
||||
(i :class "fa-solid fa-triangle-exclamation text-[0.6rem]" :aria-hidden "true")
|
||||
" This item is no longer available or price has changed"))
|
||||
|
||||
(defcomp ~cart-item-brand (&key brand)
|
||||
(defcomp ~cart-item-brand (&key (brand :as string))
|
||||
(p :class "mt-0.5 text-[0.7rem] sm:text-xs text-stone-500" brand))
|
||||
|
||||
(defcomp ~cart-item-line-total (&key text)
|
||||
(defcomp ~cart-item-line-total (&key (text :as string))
|
||||
(p :class "text-sm sm:text-base font-semibold text-stone-900" text))
|
||||
|
||||
(defcomp ~cart-item (&key id img prod-url title brand deleted price qty-url csrf minus qty plus line-total)
|
||||
(defcomp ~cart-item (&key (id :as string) img (prod-url :as string) (title :as string) brand deleted price (qty-url :as string) (csrf :as string) (minus :as string) (qty :as string) (plus :as string) line-total)
|
||||
(article :id id :class "flex flex-col sm:flex-row gap-3 sm:gap-4 rounded-2xl bg-white shadow-sm border border-stone-200 p-3 sm:p-4 md:p-5"
|
||||
(div :class "w-full sm:w-32 shrink-0 flex justify-center sm:block" (when img img))
|
||||
(div :class "flex-1 min-w-0"
|
||||
@@ -54,7 +54,7 @@
|
||||
summary))))
|
||||
|
||||
;; Assembled cart item from serialized data — replaces Python _cart_item_sx
|
||||
(defcomp ~cart-item-from-data (&key item)
|
||||
(defcomp ~cart-item-from-data (&key (item :as dict))
|
||||
(let* ((slug (or (get item "slug") ""))
|
||||
(title (or (get item "title") ""))
|
||||
(image (get item "image"))
|
||||
@@ -96,7 +96,7 @@
|
||||
(~cart-item-line-total :text (str "Line total: " symbol (format-decimal line-total 2)))))))
|
||||
|
||||
;; Assembled calendar entries section — replaces Python _calendar_entries_sx
|
||||
(defcomp ~cart-cal-section-from-data (&key entries)
|
||||
(defcomp ~cart-cal-section-from-data (&key (entries :as list))
|
||||
(when (not (empty? entries))
|
||||
(~cart-cal-section
|
||||
:items (map (lambda (e)
|
||||
@@ -108,7 +108,7 @@
|
||||
entries))))
|
||||
|
||||
;; Assembled ticket groups section — replaces Python _ticket_groups_sx
|
||||
(defcomp ~cart-tickets-section-from-data (&key ticket-groups)
|
||||
(defcomp ~cart-tickets-section-from-data (&key (ticket-groups :as list))
|
||||
(when (not (empty? ticket-groups))
|
||||
(let* ((csrf (csrf-token))
|
||||
(qty-url (url-for "cart_global.update_ticket_quantity")))
|
||||
@@ -137,7 +137,7 @@
|
||||
ticket-groups)))))
|
||||
|
||||
;; Assembled cart summary — replaces Python _cart_summary_sx
|
||||
(defcomp ~cart-summary-from-data (&key item-count grand-total symbol is-logged-in checkout-action login-href user-email)
|
||||
(defcomp ~cart-summary-from-data (&key (item-count :as number) (grand-total :as number) (symbol :as string) (is-logged-in :as boolean) (checkout-action :as string) (login-href :as string) (user-email :as string?))
|
||||
(~cart-summary-panel
|
||||
:item-count (str item-count)
|
||||
:subtotal (str symbol (format-decimal grand-total 2))
|
||||
@@ -148,7 +148,7 @@
|
||||
(~cart-checkout-signin :href login-href))))
|
||||
|
||||
;; Assembled page cart content — replaces Python _page_cart_main_panel_sx
|
||||
(defcomp ~cart-page-cart-content (&key cart-items cal-entries ticket-groups summary)
|
||||
(defcomp ~cart-page-cart-content (&key (cart-items :as list?) (cal-entries :as list?) (ticket-groups :as list?) summary)
|
||||
(if (and (empty? (or cart-items (list)))
|
||||
(empty? (or cal-entries (list)))
|
||||
(empty? (or ticket-groups (list))))
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Cart overview components
|
||||
|
||||
(defcomp ~cart-badge (&key icon text)
|
||||
(defcomp ~cart-badge (&key (icon :as string) (text :as string))
|
||||
(span :class "inline-flex items-center gap-1 px-2 py-0.5 rounded-full bg-stone-100"
|
||||
(i :class icon :aria-hidden "true") text))
|
||||
|
||||
@@ -8,13 +8,13 @@
|
||||
(div :class "mt-1 flex flex-wrap gap-2 text-xs text-stone-600"
|
||||
badges))
|
||||
|
||||
(defcomp ~cart-group-card-img (&key src alt)
|
||||
(defcomp ~cart-group-card-img (&key (src :as string) (alt :as string))
|
||||
(img :src src :alt alt :class "h-16 w-16 rounded-xl object-cover border border-stone-200 flex-shrink-0"))
|
||||
|
||||
(defcomp ~cart-mp-subtitle (&key title)
|
||||
(defcomp ~cart-mp-subtitle (&key (title :as string))
|
||||
(p :class "text-xs text-stone-500 truncate" title))
|
||||
|
||||
(defcomp ~cart-group-card (&key href img display-title subtitle badges total)
|
||||
(defcomp ~cart-group-card (&key (href :as string) img (display-title :as string) subtitle badges (total :as string))
|
||||
(a :href href :class "block rounded-2xl border border-stone-200 bg-white shadow-sm hover:shadow-md hover:border-stone-300 transition p-4 sm:p-5"
|
||||
(div :class "flex items-start gap-4"
|
||||
img
|
||||
@@ -25,7 +25,7 @@
|
||||
(div :class "text-lg font-bold text-stone-900" total)
|
||||
(div :class "mt-1 text-xs text-emerald-700 font-medium" "View cart \u2192")))))
|
||||
|
||||
(defcomp ~cart-orphan-card (&key badges total)
|
||||
(defcomp ~cart-orphan-card (&key badges (total :as string))
|
||||
(div :class "rounded-2xl border border-dashed border-amber-300 bg-amber-50/60 p-4 sm:p-5"
|
||||
(div :class "flex items-start gap-4"
|
||||
(div :class "h-16 w-16 rounded-xl bg-amber-100 flex items-center justify-center flex-shrink-0"
|
||||
@@ -46,7 +46,7 @@
|
||||
(~empty-state :icon "fa fa-shopping-cart" :message "Your cart is empty" :cls "text-center"))))
|
||||
|
||||
;; Assembled page group card — replaces Python _page_group_card_sx
|
||||
(defcomp ~cart-page-group-card-from-data (&key grp cart-url-base)
|
||||
(defcomp ~cart-page-group-card-from-data (&key (grp :as dict) (cart-url-base :as string))
|
||||
(let* ((post (get grp "post"))
|
||||
(product-count (or (get grp "product_count") 0))
|
||||
(calendar-count (or (get grp "calendar_count") 0))
|
||||
@@ -85,7 +85,7 @@
|
||||
:total (str "\u00a3" (format-decimal total 2))))))
|
||||
|
||||
;; Assembled cart overview content — replaces Python _overview_main_panel_sx
|
||||
(defcomp ~cart-overview-content (&key page-groups cart-url-base)
|
||||
(defcomp ~cart-overview-content (&key (page-groups :as list) (cart-url-base :as string))
|
||||
(if (empty? page-groups)
|
||||
(~cart-empty)
|
||||
(~cart-overview-panel
|
||||
|
||||
@@ -1,17 +1,17 @@
|
||||
;; Cart summary / checkout components
|
||||
|
||||
(defcomp ~cart-checkout-form (&key action csrf label)
|
||||
(defcomp ~cart-checkout-form (&key (action :as string) (csrf :as string) (label :as string))
|
||||
(form :method "post" :action action :class "w-full"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class "w-full inline-flex items-center justify-center px-4 py-2 text-xs sm:text-sm rounded-full border border-emerald-600 bg-emerald-600 text-white hover:bg-emerald-700 transition"
|
||||
(i :class "fa-solid fa-credit-card mr-2" :aria-hidden "true") label)))
|
||||
|
||||
(defcomp ~cart-checkout-signin (&key href)
|
||||
(defcomp ~cart-checkout-signin (&key (href :as string))
|
||||
(div :class "w-full flex"
|
||||
(a :href href :class "w-full cursor-pointer flex flex-row items-center justify-center p-3 gap-2 rounded bg-stone-200 text-black hover:bg-stone-300 transition"
|
||||
(i :class "fa-solid fa-key") (span "sign in or register to checkout"))))
|
||||
|
||||
(defcomp ~cart-summary-panel (&key item-count subtotal checkout)
|
||||
(defcomp ~cart-summary-panel (&key (item-count :as string) (subtotal :as string) checkout)
|
||||
(aside :id "cart-summary" :class "lg:pl-2"
|
||||
(div :class "rounded-2xl bg-white shadow-sm border border-stone-200 p-4 sm:p-5"
|
||||
(h2 :class "text-sm sm:text-base font-semibold text-stone-900 mb-3 sm:mb-4" "Order summary")
|
||||
|
||||
@@ -1,12 +1,12 @@
|
||||
;; Cart ticket components
|
||||
|
||||
(defcomp ~cart-ticket-type-name (&key name)
|
||||
(defcomp ~cart-ticket-type-name (&key (name :as string))
|
||||
(p :class "mt-0.5 text-[0.7rem] sm:text-xs text-stone-500" name))
|
||||
|
||||
(defcomp ~cart-ticket-type-hidden (&key value)
|
||||
(defcomp ~cart-ticket-type-hidden (&key (value :as string))
|
||||
(input :type "hidden" :name "ticket_type_id" :value value))
|
||||
|
||||
(defcomp ~cart-ticket-article (&key name type-name date-str price qty-url csrf entry-id type-hidden minus qty plus line-total)
|
||||
(defcomp ~cart-ticket-article (&key (name :as string) type-name (date-str :as string) (price :as string) (qty-url :as string) (csrf :as string) (entry-id :as string) type-hidden (minus :as string) (qty :as string) (plus :as string) (line-total :as string))
|
||||
(article :class "flex flex-col sm:flex-row gap-3 sm:gap-4 rounded-2xl bg-white shadow-sm border border-stone-200 p-3 sm:p-4"
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "flex flex-col sm:flex-row sm:items-start justify-between gap-2 sm:gap-3"
|
||||
|
||||
@@ -1,28 +1,28 @@
|
||||
;; Events calendar components
|
||||
|
||||
(defcomp ~events-calendar-nav-arrow (&key pill-cls href label)
|
||||
(defcomp ~events-calendar-nav-arrow (&key (pill-cls :as string) (href :as string) (label :as string))
|
||||
(a :class (str pill-cls " text-xl") :href href
|
||||
:sx-get href :sx-target "#main-panel" :sx-select "#main-panel" :sx-swap "outerHTML" :sx-push-url "true" label))
|
||||
|
||||
(defcomp ~events-calendar-month-label (&key month-name year)
|
||||
(defcomp ~events-calendar-month-label (&key (month-name :as string) (year :as string))
|
||||
(div :class "px-3 font-medium" (str month-name " " year)))
|
||||
|
||||
(defcomp ~events-calendar-weekday (&key name)
|
||||
(defcomp ~events-calendar-weekday (&key (name :as string))
|
||||
(div :class "py-1" name))
|
||||
|
||||
(defcomp ~events-calendar-day-short (&key day-str)
|
||||
(defcomp ~events-calendar-day-short (&key (day-str :as string))
|
||||
(span :class "sm:hidden text-[16px] text-stone-500" day-str))
|
||||
|
||||
(defcomp ~events-calendar-day-num (&key pill-cls href num)
|
||||
(defcomp ~events-calendar-day-num (&key (pill-cls :as string) (href :as string) (num :as string))
|
||||
(a :class pill-cls :href href :sx-get href :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true" num))
|
||||
|
||||
(defcomp ~events-calendar-entry-badge (&key bg-cls name state-label)
|
||||
(defcomp ~events-calendar-entry-badge (&key (bg-cls :as string) (name :as string) (state-label :as string))
|
||||
(div :class (str "flex items-center justify-between gap-1 text-[11px] rounded px-1 py-0.5 " bg-cls)
|
||||
(span :class "truncate" name)
|
||||
(span :class "shrink-0 text-[10px] font-semibold uppercase tracking-tight" state-label)))
|
||||
|
||||
(defcomp ~events-calendar-cell (&key cell-cls day-short day-num badges)
|
||||
(defcomp ~events-calendar-cell (&key (cell-cls :as string) day-short day-num badges)
|
||||
(div :class cell-cls
|
||||
(div :class "flex justify-between items-center"
|
||||
(div :class "flex flex-col" day-short day-num))
|
||||
@@ -37,10 +37,10 @@
|
||||
(div :class "grid grid-cols-1 sm:grid-cols-7 gap-px bg-stone-200 rounded-xl overflow-hidden" cells))))
|
||||
|
||||
;; Calendar grid from data — all iteration in sx
|
||||
(defcomp ~events-calendar-grid-from-data (&key pill-cls month-name year
|
||||
prev-year-href prev-month-href
|
||||
next-month-href next-year-href
|
||||
weekday-names cells)
|
||||
(defcomp ~events-calendar-grid-from-data (&key (pill-cls :as string) (month-name :as string) (year :as string)
|
||||
(prev-year-href :as string) (prev-month-href :as string)
|
||||
(next-month-href :as string) (next-year-href :as string)
|
||||
(weekday-names :as list) (cells :as list))
|
||||
(~events-calendar-grid
|
||||
:arrows (<>
|
||||
(~events-calendar-nav-arrow :pill-cls pill-cls :href prev-year-href :label "\u00ab")
|
||||
@@ -66,7 +66,7 @@
|
||||
(get cell "badges"))))))
|
||||
(or cells (list))))))
|
||||
|
||||
(defcomp ~events-calendar-description-display (&key description edit-url)
|
||||
(defcomp ~events-calendar-description-display (&key (description :as string?) (edit-url :as string))
|
||||
(div :id "calendar-description"
|
||||
(if description
|
||||
(p :class "text-stone-700 whitespace-pre-line break-all" description)
|
||||
@@ -75,12 +75,12 @@
|
||||
:sx-get edit-url :sx-target "#calendar-description" :sx-swap "outerHTML"
|
||||
(i :class "fas fa-edit"))))
|
||||
|
||||
(defcomp ~events-calendar-description-title-oob (&key description)
|
||||
(defcomp ~events-calendar-description-title-oob (&key (description :as string))
|
||||
(div :id "calendar-description-title" :sx-swap-oob "outerHTML"
|
||||
:class "text-base font-normal break-words whitespace-normal min-w-0 break-all w-full text-center block"
|
||||
description))
|
||||
|
||||
(defcomp ~events-calendar-description-edit-form (&key save-url cancel-url csrf description)
|
||||
(defcomp ~events-calendar-description-edit-form (&key (save-url :as string) (cancel-url :as string) (csrf :as string) (description :as string?))
|
||||
(div :id "calendar-description"
|
||||
(form :sx-post save-url :sx-target "#calendar-description" :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Events day components
|
||||
|
||||
(defcomp ~events-day-entry-link (&key href name time-str)
|
||||
(defcomp ~events-day-entry-link (&key (href :as string) (name :as string) (time-str :as string))
|
||||
(a :href href :class "flex items-center gap-2 px-3 py-2 hover:bg-stone-100 rounded transition text-sm border sm:whitespace-nowrap sm:flex-shrink-0"
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "font-medium truncate" name)
|
||||
@@ -12,7 +12,7 @@
|
||||
(div :class "flex overflow-x-auto gap-1 scrollbar-thin"
|
||||
inner)))
|
||||
|
||||
(defcomp ~events-day-table (&key list-container rows pre-action add-url)
|
||||
(defcomp ~events-day-table (&key (list-container :as string) rows (pre-action :as string) (add-url :as string))
|
||||
(section :id "day-entries" :class list-container
|
||||
(table :class "w-full text-sm border table-fixed"
|
||||
(thead :class "bg-stone-100"
|
||||
@@ -32,27 +32,27 @@
|
||||
(defcomp ~events-day-empty-row ()
|
||||
(tr (td :colspan "6" :class "p-3 text-stone-500" "No entries yet.")))
|
||||
|
||||
(defcomp ~events-day-row-name (&key href pill-cls name)
|
||||
(defcomp ~events-day-row-name (&key (href :as string) (pill-cls :as string) (name :as string))
|
||||
(td :class "p-2 align-top w-2/6" (div :class "font-medium"
|
||||
(a :href href :class pill-cls :sx-get href :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true" name))))
|
||||
|
||||
(defcomp ~events-day-row-slot (&key href pill-cls slot-name time-str)
|
||||
(defcomp ~events-day-row-slot (&key (href :as string) (pill-cls :as string) (slot-name :as string) (time-str :as string))
|
||||
(td :class "p-2 align-top w-1/6" (div :class "text-xs font-medium"
|
||||
(a :href href :class pill-cls :sx-get href :sx-target "#main-panel" :sx-select "#main-panel"
|
||||
:sx-swap "outerHTML" :sx-push-url "true" slot-name)
|
||||
(span :class "text-stone-600 font-normal" time-str))))
|
||||
|
||||
(defcomp ~events-day-row-time (&key start end)
|
||||
(defcomp ~events-day-row-time (&key (start :as string) (end :as string))
|
||||
(td :class "p-2 align-top w-1/6" (div :class "text-xs text-stone-600" (str start end))))
|
||||
|
||||
(defcomp ~events-day-row-state (&key state-id badge)
|
||||
(defcomp ~events-day-row-state (&key (state-id :as string) badge)
|
||||
(td :class "p-2 align-top w-1/6" (div :id state-id badge)))
|
||||
|
||||
(defcomp ~events-day-row-cost (&key cost-str)
|
||||
(defcomp ~events-day-row-cost (&key (cost-str :as string))
|
||||
(td :class "p-2 align-top w-1/6" (span :class "font-medium text-green-600" cost-str)))
|
||||
|
||||
(defcomp ~events-day-row-tickets (&key price-str count-str)
|
||||
(defcomp ~events-day-row-tickets (&key (price-str :as string) (count-str :as string))
|
||||
(td :class "p-2 align-top w-1/6" (div :class "text-xs space-y-1"
|
||||
(div :class "font-medium text-green-600" price-str)
|
||||
(div :class "text-stone-600" count-str))))
|
||||
@@ -63,7 +63,7 @@
|
||||
(defcomp ~events-day-row-actions ()
|
||||
(td :class "p-2 align-top w-1/6"))
|
||||
|
||||
(defcomp ~events-day-row (&key tr-cls name slot state cost tickets actions)
|
||||
(defcomp ~events-day-row (&key (tr-cls :as string) name slot state cost tickets actions)
|
||||
(tr :class tr-cls name slot state cost tickets actions))
|
||||
|
||||
(defcomp ~events-day-admin-panel ()
|
||||
@@ -77,14 +77,14 @@
|
||||
:id "day-entries-nav-wrapper" :sx-swap-oob "true"
|
||||
(div :class "flex overflow-x-auto gap-1 scrollbar-thin" items)))
|
||||
|
||||
(defcomp ~events-day-nav-entry (&key href nav-btn name time-str)
|
||||
(defcomp ~events-day-nav-entry (&key (href :as string) (nav-btn :as string) (name :as string) (time-str :as string))
|
||||
(a :href href :class nav-btn
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "font-medium truncate" name)
|
||||
(div :class "text-xs text-stone-600 truncate" time-str))))
|
||||
|
||||
;; Day table from data — all row iteration in sx
|
||||
(defcomp ~events-day-table-from-data (&key list-container pre-action add-url tr-cls pill-cls rows)
|
||||
(defcomp ~events-day-table-from-data (&key (list-container :as string) (pre-action :as string) (add-url :as string) (tr-cls :as string) (pill-cls :as string) (rows :as list?))
|
||||
(~events-day-table
|
||||
:list-container list-container
|
||||
:rows (if (empty? (or rows (list)))
|
||||
@@ -112,7 +112,7 @@
|
||||
:pre-action pre-action :add-url add-url))
|
||||
|
||||
;; Day entries nav OOB from data
|
||||
(defcomp ~events-day-entries-nav-oob-from-data (&key nav-btn entries)
|
||||
(defcomp ~events-day-entries-nav-oob-from-data (&key (nav-btn :as string) (entries :as list?))
|
||||
(if (empty? (or entries (list)))
|
||||
(~events-day-entries-nav-oob-empty)
|
||||
(~events-day-entries-nav-oob
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Events ticket components
|
||||
|
||||
(defcomp ~events-ticket-card (&key href entry-name type-name time-str cal-name badge code-prefix)
|
||||
(defcomp ~events-ticket-card (&key (href :as string) (entry-name :as string) (type-name :as string?) (time-str :as string?) (cal-name :as string?) badge (code-prefix :as string))
|
||||
(a :href href :class "block rounded-xl border border-stone-200 bg-white p-4 hover:shadow-md transition"
|
||||
(div :class "flex items-start justify-between gap-4"
|
||||
(div :class "flex-1 min-w-0"
|
||||
@@ -12,7 +12,7 @@
|
||||
badge
|
||||
(span :class "text-xs text-stone-400 font-mono" (str code-prefix "..."))))))
|
||||
|
||||
(defcomp ~events-tickets-panel (&key list-container has-tickets cards)
|
||||
(defcomp ~events-tickets-panel (&key (list-container :as string) (has-tickets :as boolean) cards)
|
||||
(section :id "tickets-list" :class list-container
|
||||
(h1 :class "text-2xl font-bold mb-6" "My Tickets")
|
||||
(if has-tickets
|
||||
@@ -22,9 +22,9 @@
|
||||
(p :class "text-lg" "No tickets yet")
|
||||
(p :class "text-sm mt-1" "Tickets will appear here after you purchase them.")))))
|
||||
|
||||
(defcomp ~events-ticket-detail (&key list-container back-href header-bg entry-name badge
|
||||
type-name code time-date time-range cal-name
|
||||
type-desc checkin-str qr-script)
|
||||
(defcomp ~events-ticket-detail (&key (list-container :as string) (back-href :as string) (header-bg :as string) (entry-name :as string) badge
|
||||
(type-name :as string?) (code :as string) (time-date :as string?) (time-range :as string?) (cal-name :as string?)
|
||||
(type-desc :as string?) (checkin-str :as string?) (qr-script :as string))
|
||||
(section :id "ticket-detail" :class (str list-container " max-w-lg mx-auto")
|
||||
(a :href back-href :class "inline-flex items-center gap-1 text-sm text-stone-500 hover:text-stone-700 mb-4"
|
||||
(i :class "fa fa-arrow-left" :aria-hidden "true") " Back to my tickets")
|
||||
@@ -54,25 +54,25 @@
|
||||
(script :src "https://cdn.jsdelivr.net/npm/qrcode@1.5.3/build/qrcode.min.js")
|
||||
(script qr-script)))
|
||||
|
||||
(defcomp ~events-ticket-admin-stat (&key border bg text-cls label-cls value label)
|
||||
(defcomp ~events-ticket-admin-stat (&key (border :as string) (bg :as string) (text-cls :as string) (label-cls :as string) (value :as string) (label :as string))
|
||||
(div :class (str "rounded-xl border " border " " bg " p-4 text-center")
|
||||
(div :class (str "text-2xl font-bold " text-cls) value)
|
||||
(div :class (str "text-xs " label-cls " uppercase tracking-wide") label)))
|
||||
|
||||
(defcomp ~events-ticket-admin-date (&key date-str)
|
||||
(defcomp ~events-ticket-admin-date (&key (date-str :as string))
|
||||
(div :class "text-xs text-stone-500" date-str))
|
||||
|
||||
(defcomp ~events-ticket-admin-checkin-form (&key checkin-url code csrf)
|
||||
(defcomp ~events-ticket-admin-checkin-form (&key (checkin-url :as string) (code :as string) (csrf :as string))
|
||||
(form :sx-post checkin-url :sx-target (str "#ticket-row-" code) :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class "px-3 py-1 bg-blue-600 text-white text-xs rounded hover:bg-blue-700 transition"
|
||||
(i :class "fa fa-check mr-1" :aria-hidden "true") "Check in")))
|
||||
|
||||
(defcomp ~events-ticket-admin-checked-in (&key time-str)
|
||||
(defcomp ~events-ticket-admin-checked-in (&key (time-str :as string))
|
||||
(span :class "text-xs text-blue-600"
|
||||
(i :class "fa fa-check-circle" :aria-hidden "true") (str " " time-str)))
|
||||
|
||||
(defcomp ~events-ticket-admin-row (&key code code-short entry-name date type-name badge action)
|
||||
(defcomp ~events-ticket-admin-row (&key (code :as string) (code-short :as string) (entry-name :as string) date (type-name :as string) badge action)
|
||||
(tr :class "hover:bg-stone-50 transition" :id (str "ticket-row-" code)
|
||||
(td :class "px-4 py-3" (span :class "font-mono text-xs" code-short))
|
||||
(td :class "px-4 py-3" (div :class "font-medium" entry-name) date)
|
||||
@@ -80,7 +80,7 @@
|
||||
(td :class "px-4 py-3" badge)
|
||||
(td :class "px-4 py-3" action)))
|
||||
|
||||
(defcomp ~events-ticket-admin-panel (&key list-container stats lookup-url has-tickets rows)
|
||||
(defcomp ~events-ticket-admin-panel (&key (list-container :as string) stats (lookup-url :as string) (has-tickets :as boolean) rows)
|
||||
(section :id "ticket-admin" :class list-container
|
||||
(h1 :class "text-2xl font-bold mb-6" "Ticket Admin")
|
||||
(div :class "grid grid-cols-2 sm:grid-cols-4 gap-3 mb-8" stats)
|
||||
@@ -113,11 +113,11 @@
|
||||
(tbody :class "divide-y divide-stone-100" rows))
|
||||
(div :class "px-6 py-8 text-center text-stone-500" "No tickets yet"))))))
|
||||
|
||||
(defcomp ~events-checkin-error (&key message)
|
||||
(defcomp ~events-checkin-error (&key (message :as string))
|
||||
(div :class "rounded-lg border border-red-200 bg-red-50 p-3 text-sm text-red-800"
|
||||
(i :class "fa fa-exclamation-circle mr-2" :aria-hidden "true") message))
|
||||
|
||||
(defcomp ~events-checkin-success-row (&key code code-short entry-name date type-name badge time-str)
|
||||
(defcomp ~events-checkin-success-row (&key (code :as string) (code-short :as string) (entry-name :as string) date (type-name :as string) badge (time-str :as string))
|
||||
(tr :class "bg-blue-50" :id (str "ticket-row-" code)
|
||||
(td :class "px-4 py-3" (span :class "font-mono text-xs" code-short))
|
||||
(td :class "px-4 py-3" (div :class "font-medium" entry-name) date)
|
||||
@@ -127,29 +127,29 @@
|
||||
(span :class "text-xs text-blue-600"
|
||||
(i :class "fa fa-check-circle" :aria-hidden "true") (str " " time-str)))))
|
||||
|
||||
(defcomp ~events-lookup-error (&key message)
|
||||
(defcomp ~events-lookup-error (&key (message :as string))
|
||||
(div :class "rounded-lg border border-red-200 bg-red-50 p-4 text-sm text-red-800"
|
||||
(i :class "fa fa-exclamation-circle mr-2" :aria-hidden "true") message))
|
||||
|
||||
(defcomp ~events-lookup-info (&key entry-name)
|
||||
(defcomp ~events-lookup-info (&key (entry-name :as string))
|
||||
(div :class "font-semibold text-lg" entry-name))
|
||||
|
||||
(defcomp ~events-lookup-type (&key type-name)
|
||||
(defcomp ~events-lookup-type (&key (type-name :as string))
|
||||
(div :class "text-sm text-stone-600" type-name))
|
||||
|
||||
(defcomp ~events-lookup-date (&key date-str)
|
||||
(defcomp ~events-lookup-date (&key (date-str :as string))
|
||||
(div :class "text-sm text-stone-500 mt-1" date-str))
|
||||
|
||||
(defcomp ~events-lookup-cal (&key cal-name)
|
||||
(defcomp ~events-lookup-cal (&key (cal-name :as string))
|
||||
(div :class "text-xs text-stone-400 mt-0.5" cal-name))
|
||||
|
||||
(defcomp ~events-lookup-status (&key badge code)
|
||||
(defcomp ~events-lookup-status (&key badge (code :as string))
|
||||
(div :class "mt-2" badge (span :class "text-xs text-stone-400 ml-2 font-mono" code)))
|
||||
|
||||
(defcomp ~events-lookup-checkin-time (&key date-str)
|
||||
(defcomp ~events-lookup-checkin-time (&key (date-str :as string))
|
||||
(div :class "text-xs text-blue-600 mt-1" (str "Checked in: " date-str)))
|
||||
|
||||
(defcomp ~events-lookup-checkin-btn (&key checkin-url code csrf)
|
||||
(defcomp ~events-lookup-checkin-btn (&key (checkin-url :as string) (code :as string) (csrf :as string))
|
||||
(form :sx-post checkin-url :sx-target (str "#checkin-action-" code) :sx-swap "innerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit"
|
||||
@@ -166,20 +166,20 @@
|
||||
(i :class "fa fa-times-circle text-3xl" :aria-hidden "true")
|
||||
(div :class "text-sm font-medium mt-1" "Cancelled")))
|
||||
|
||||
(defcomp ~events-lookup-card (&key info code action)
|
||||
(defcomp ~events-lookup-card (&key info (code :as string) action)
|
||||
(div :class "rounded-lg border border-stone-200 bg-stone-50 p-4"
|
||||
(div :class "flex items-start justify-between gap-4"
|
||||
(div :class "flex-1" info)
|
||||
(div :id (str "checkin-action-" code) action))))
|
||||
|
||||
(defcomp ~events-entry-tickets-admin-row (&key code code-short type-name badge action)
|
||||
(defcomp ~events-entry-tickets-admin-row (&key (code :as string) (code-short :as string) (type-name :as string) badge action)
|
||||
(tr :class "hover:bg-stone-50" :id (str "entry-ticket-row-" code)
|
||||
(td :class "px-4 py-2 font-mono text-xs" code-short)
|
||||
(td :class "px-4 py-2" type-name)
|
||||
(td :class "px-4 py-2" badge)
|
||||
(td :class "px-4 py-2" action)))
|
||||
|
||||
(defcomp ~events-entry-tickets-admin-checkin (&key checkin-url code csrf)
|
||||
(defcomp ~events-entry-tickets-admin-checkin (&key (checkin-url :as string) (code :as string) (csrf :as string))
|
||||
(form :sx-post checkin-url :sx-target (str "#entry-ticket-row-" code) :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class "px-3 py-1 bg-blue-600 text-white text-xs rounded hover:bg-blue-700"
|
||||
@@ -198,7 +198,7 @@
|
||||
(defcomp ~events-entry-tickets-admin-empty ()
|
||||
(div :class "text-center py-6 text-stone-500 text-sm" "No tickets for this entry"))
|
||||
|
||||
(defcomp ~events-entry-tickets-admin-panel (&key entry-name count-label body)
|
||||
(defcomp ~events-entry-tickets-admin-panel (&key (entry-name :as string) (count-label :as string) body)
|
||||
(div :class "space-y-4"
|
||||
(div :class "flex items-center justify-between"
|
||||
(h3 :class "text-lg font-semibold" (str "Tickets for: " entry-name))
|
||||
@@ -211,7 +211,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; My tickets panel from data
|
||||
(defcomp ~events-tickets-panel-from-data (&key list-container tickets)
|
||||
(defcomp ~events-tickets-panel-from-data (&key (list-container :as string) (tickets :as list?))
|
||||
(~events-tickets-panel
|
||||
:list-container list-container
|
||||
:has-tickets (not (empty? (or tickets (list))))
|
||||
@@ -225,9 +225,9 @@
|
||||
(or tickets (list))))))
|
||||
|
||||
;; Ticket detail from data — uses lg badge variant
|
||||
(defcomp ~events-ticket-detail-from-data (&key list-container back-href header-bg entry-name
|
||||
state type-name code time-date time-range
|
||||
cal-name type-desc checkin-str qr-script)
|
||||
(defcomp ~events-ticket-detail-from-data (&key (list-container :as string) (back-href :as string) (header-bg :as string) (entry-name :as string)
|
||||
(state :as string) (type-name :as string?) (code :as string) (time-date :as string?) (time-range :as string?)
|
||||
(cal-name :as string?) (type-desc :as string?) (checkin-str :as string?) (qr-script :as string))
|
||||
(~events-ticket-detail
|
||||
:list-container list-container :back-href back-href
|
||||
:header-bg header-bg :entry-name entry-name
|
||||
@@ -238,9 +238,9 @@
|
||||
:checkin-str checkin-str :qr-script qr-script))
|
||||
|
||||
;; Ticket admin row from data — conditional action column
|
||||
(defcomp ~events-ticket-admin-row-from-data (&key code code-short entry-name date-str
|
||||
type-name state checkin-url csrf
|
||||
checked-in-time)
|
||||
(defcomp ~events-ticket-admin-row-from-data (&key (code :as string) (code-short :as string) (entry-name :as string) (date-str :as string?)
|
||||
(type-name :as string) (state :as string) (checkin-url :as string) (csrf :as string)
|
||||
(checked-in-time :as string?))
|
||||
(~events-ticket-admin-row
|
||||
:code code :code-short code-short
|
||||
:entry-name entry-name
|
||||
@@ -256,8 +256,8 @@
|
||||
(true nil))))
|
||||
|
||||
;; Ticket admin panel from data
|
||||
(defcomp ~events-ticket-admin-panel-from-data (&key list-container lookup-url tickets
|
||||
total confirmed checked-in reserved)
|
||||
(defcomp ~events-ticket-admin-panel-from-data (&key (list-container :as string) (lookup-url :as string) (tickets :as list?)
|
||||
(total :as number?) (confirmed :as number?) (checked-in :as number?) (reserved :as number?))
|
||||
(~events-ticket-admin-panel
|
||||
:list-container list-container
|
||||
:stats (<>
|
||||
@@ -285,7 +285,7 @@
|
||||
(or tickets (list))))))
|
||||
|
||||
;; Entry tickets admin from data
|
||||
(defcomp ~events-entry-tickets-admin-from-data (&key entry-name count-label tickets csrf)
|
||||
(defcomp ~events-entry-tickets-admin-from-data (&key (entry-name :as string) (count-label :as string) (tickets :as list?) (csrf :as string))
|
||||
(~events-entry-tickets-admin-panel
|
||||
:entry-name entry-name :count-label count-label
|
||||
:body (if (empty? (or tickets (list)))
|
||||
@@ -306,7 +306,7 @@
|
||||
(or tickets (list))))))))
|
||||
|
||||
;; Checkin success row from data
|
||||
(defcomp ~events-checkin-success-row-from-data (&key code code-short entry-name date-str type-name time-str)
|
||||
(defcomp ~events-checkin-success-row-from-data (&key (code :as string) (code-short :as string) (entry-name :as string) (date-str :as string?) (type-name :as string) (time-str :as string))
|
||||
(~events-checkin-success-row
|
||||
:code code :code-short code-short
|
||||
:entry-name entry-name
|
||||
@@ -316,8 +316,8 @@
|
||||
:time-str time-str))
|
||||
|
||||
;; Ticket types table from data
|
||||
(defcomp ~events-ticket-types-table-from-data (&key list-container ticket-types action-btn add-url
|
||||
tr-cls pill-cls hx-select csrf-hdr)
|
||||
(defcomp ~events-ticket-types-table-from-data (&key (list-container :as string) (ticket-types :as list?) (action-btn :as string) (add-url :as string)
|
||||
(tr-cls :as string) (pill-cls :as string) (hx-select :as string) (csrf-hdr :as string))
|
||||
(~events-ticket-types-table
|
||||
:list-container list-container
|
||||
:rows (if (empty? (or ticket-types (list)))
|
||||
@@ -333,9 +333,9 @@
|
||||
:action-btn action-btn :add-url add-url))
|
||||
|
||||
;; Lookup result from data
|
||||
(defcomp ~events-lookup-result-from-data (&key entry-name type-name date-str cal-name
|
||||
state code checked-in-str
|
||||
checkin-url csrf)
|
||||
(defcomp ~events-lookup-result-from-data (&key (entry-name :as string) (type-name :as string?) (date-str :as string?) (cal-name :as string?)
|
||||
(state :as string) (code :as string) (checked-in-str :as string?)
|
||||
(checkin-url :as string) (csrf :as string))
|
||||
(~events-lookup-card
|
||||
:info (<>
|
||||
(~events-lookup-info :entry-name entry-name)
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
;; Auth components (choose username — federation-specific)
|
||||
;; Login and check-email components are shared: see shared/sx/templates/auth.sx
|
||||
|
||||
(defcomp ~federation-choose-username (&key domain error csrf username check-url)
|
||||
(defcomp ~federation-choose-username (&key (domain :as string) error (csrf :as string) (username :as string) (check-url :as string))
|
||||
(div :class "py-8 max-w-md mx-auto"
|
||||
(h1 :class "text-2xl font-bold mb-2" "Choose your username")
|
||||
(p :class "text-stone-600 mb-6" "This will be your identity on the fediverse: "
|
||||
|
||||
@@ -1,9 +1,9 @@
|
||||
;; Notification components
|
||||
|
||||
(defcomp ~federation-notification-preview (&key preview)
|
||||
(defcomp ~federation-notification-preview (&key (preview :as string))
|
||||
(div :class "text-sm text-stone-500 mt-1 truncate" preview))
|
||||
|
||||
(defcomp ~federation-notification-card (&key cls avatar from-name from-username from-domain action-text preview time)
|
||||
(defcomp ~federation-notification-card (&key (cls :as string) avatar (from-name :as string) (from-username :as string) (from-domain :as string) (action-text :as string) preview (time :as string))
|
||||
(div :class cls
|
||||
(div :class "flex items-start gap-3"
|
||||
avatar
|
||||
@@ -15,14 +15,14 @@
|
||||
preview
|
||||
(div :class "text-xs text-stone-400 mt-1" time)))))
|
||||
|
||||
(defcomp ~federation-notifications-list (&key items)
|
||||
(defcomp ~federation-notifications-list (&key (items :as list))
|
||||
(div :class "space-y-2" items))
|
||||
|
||||
(defcomp ~federation-notifications-page (&key notifs)
|
||||
(h1 :class "text-2xl font-bold mb-6" "Notifications") notifs)
|
||||
|
||||
;; Assembled notification card — replaces Python _notification_sx
|
||||
(defcomp ~federation-notification-from-data (&key notif)
|
||||
(defcomp ~federation-notification-from-data (&key (notif :as dict))
|
||||
(let* ((from-name (or (get notif "from_actor_name") "?"))
|
||||
(from-username (or (get notif "from_actor_username") ""))
|
||||
(from-domain (or (get notif "from_actor_domain") ""))
|
||||
@@ -59,7 +59,7 @@
|
||||
:time created)))
|
||||
|
||||
;; Assembled notifications content — replaces Python _notifications_content_sx
|
||||
(defcomp ~federation-notifications-content (&key notifications)
|
||||
(defcomp ~federation-notifications-content (&key (notifications :as list))
|
||||
(~federation-notifications-page
|
||||
:notifs (if (empty? notifications)
|
||||
(~empty-state :message "No notifications yet." :cls "text-stone-500")
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Profile and actor timeline components
|
||||
|
||||
(defcomp ~federation-actor-profile-header (&key avatar display-name username domain summary follow)
|
||||
(defcomp ~federation-actor-profile-header (&key avatar (display-name :as string) (username :as string) (domain :as string) summary follow)
|
||||
(div :class "bg-white rounded-lg shadow-sm border border-stone-200 p-6 mb-6"
|
||||
(div :class "flex items-center gap-4"
|
||||
avatar
|
||||
@@ -14,35 +14,35 @@
|
||||
header
|
||||
(div :id "timeline" timeline))
|
||||
|
||||
(defcomp ~federation-follow-form (&key action csrf actor-url label cls)
|
||||
(defcomp ~federation-follow-form (&key (action :as string) (csrf :as string) (actor-url :as string) (label :as string) (cls :as string))
|
||||
(div :class "flex-shrink-0"
|
||||
(form :method "post" :action action
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
||||
(button :type "submit" :class cls label))))
|
||||
|
||||
(defcomp ~federation-profile-summary (&key summary)
|
||||
(defcomp ~federation-profile-summary (&key (summary :as string))
|
||||
(div :class "text-sm text-stone-600 mt-2" (~rich-text :html summary)))
|
||||
|
||||
;; Public profile page
|
||||
|
||||
(defcomp ~federation-activity-obj-type (&key obj-type)
|
||||
(defcomp ~federation-activity-obj-type (&key (obj-type :as string))
|
||||
(span :class "text-sm text-stone-500" obj-type))
|
||||
|
||||
(defcomp ~federation-activity-card (&key activity-type published obj-type)
|
||||
(defcomp ~federation-activity-card (&key (activity-type :as string) (published :as string) obj-type)
|
||||
(div :class "bg-white rounded-lg shadow p-4"
|
||||
(div :class "flex justify-between items-start"
|
||||
(span :class "font-medium" activity-type)
|
||||
(span :class "text-sm text-stone-400" published))
|
||||
obj-type))
|
||||
|
||||
(defcomp ~federation-activities-list (&key items)
|
||||
(defcomp ~federation-activities-list (&key (items :as list))
|
||||
(div :class "space-y-4" items))
|
||||
|
||||
(defcomp ~federation-activities-empty ()
|
||||
(p :class "text-stone-500" "No activities yet."))
|
||||
|
||||
(defcomp ~federation-profile-page (&key display-name username domain summary activities-heading activities)
|
||||
(defcomp ~federation-profile-page (&key (display-name :as string) (username :as string) (domain :as string) summary (activities-heading :as string) activities)
|
||||
(div :class "py-8"
|
||||
(div :class "bg-white rounded-lg shadow p-6 mb-6"
|
||||
(h1 :class "text-2xl font-bold" display-name)
|
||||
@@ -51,11 +51,11 @@
|
||||
(h2 :class "text-xl font-bold mb-4" activities-heading)
|
||||
activities))
|
||||
|
||||
(defcomp ~federation-profile-summary-text (&key text)
|
||||
(defcomp ~federation-profile-summary-text (&key (text :as string))
|
||||
(p :class "mt-2" text))
|
||||
|
||||
;; Assembled actor timeline content — replaces Python _actor_timeline_content_sx
|
||||
(defcomp ~federation-actor-timeline-content (&key remote-actor items is-following actor)
|
||||
(defcomp ~federation-actor-timeline-content (&key (remote-actor :as dict) (items :as list) (is-following :as boolean) actor)
|
||||
(let* ((display-name (or (get remote-actor "display_name") (get remote-actor "preferred_username") ""))
|
||||
(icon-url (get remote-actor "icon_url"))
|
||||
(summary (get remote-actor "summary"))
|
||||
@@ -92,7 +92,7 @@
|
||||
:before (get (last items) "before_cursor")))))))
|
||||
|
||||
;; Data-driven activities list (replaces Python loop in render_profile_page)
|
||||
(defcomp ~federation-activities-from-data (&key activities)
|
||||
(defcomp ~federation-activities-from-data (&key (activities :as list))
|
||||
(if (empty? (or activities (list)))
|
||||
(~federation-activities-empty)
|
||||
(~federation-activities-list
|
||||
|
||||
@@ -1,37 +1,37 @@
|
||||
;; Search and actor card components
|
||||
|
||||
;; Aliases — delegate to shared ~avatar
|
||||
(defcomp ~federation-actor-avatar-img (&key src cls)
|
||||
(defcomp ~federation-actor-avatar-img (&key (src :as string) (cls :as string))
|
||||
(~avatar :src src :cls cls))
|
||||
|
||||
(defcomp ~federation-actor-avatar-placeholder (&key cls initial)
|
||||
(defcomp ~federation-actor-avatar-placeholder (&key (cls :as string) (initial :as string))
|
||||
(~avatar :cls cls :initial initial))
|
||||
|
||||
(defcomp ~federation-actor-name-link (&key href name)
|
||||
(defcomp ~federation-actor-name-link (&key (href :as string) (name :as string))
|
||||
(a :href href :class "font-semibold text-stone-900 hover:underline" name))
|
||||
|
||||
(defcomp ~federation-actor-name-link-external (&key href name)
|
||||
(defcomp ~federation-actor-name-link-external (&key (href :as string) (name :as string))
|
||||
(a :href href :target "_blank" :rel "noopener"
|
||||
:class "font-semibold text-stone-900 hover:underline" name))
|
||||
|
||||
(defcomp ~federation-actor-summary (&key summary)
|
||||
(defcomp ~federation-actor-summary (&key (summary :as string))
|
||||
(div :class "text-sm text-stone-600 mt-1 truncate" (~rich-text :html summary)))
|
||||
|
||||
(defcomp ~federation-unfollow-button (&key action csrf actor-url)
|
||||
(defcomp ~federation-unfollow-button (&key (action :as string) (csrf :as string) (actor-url :as string))
|
||||
(div :class "flex-shrink-0"
|
||||
(form :method "post" :action action :sx-post action :sx-target "closest article" :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
||||
(button :type "submit" :class "text-sm border border-stone-300 rounded px-3 py-1 hover:bg-stone-100" "Unfollow"))))
|
||||
|
||||
(defcomp ~federation-follow-button (&key action csrf actor-url label)
|
||||
(defcomp ~federation-follow-button (&key (action :as string) (csrf :as string) (actor-url :as string) (label :as string))
|
||||
(div :class "flex-shrink-0"
|
||||
(form :method "post" :action action :sx-post action :sx-target "closest article" :sx-swap "outerHTML"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(input :type "hidden" :name "actor_url" :value actor-url)
|
||||
(button :type "submit" :class "text-sm bg-stone-800 text-white rounded px-3 py-1 hover:bg-stone-700" label))))
|
||||
|
||||
(defcomp ~federation-actor-card (&key cls id avatar name username domain summary button)
|
||||
(defcomp ~federation-actor-card (&key (cls :as string) (id :as string) avatar name (username :as string) (domain :as string) summary button)
|
||||
(article :class cls :id id
|
||||
avatar
|
||||
(div :class "flex-1 min-w-0"
|
||||
@@ -41,7 +41,7 @@
|
||||
button))
|
||||
|
||||
;; Data-driven actor card (replaces Python _actor_card_sx loop)
|
||||
(defcomp ~federation-actor-card-from-data (&key d has-actor csrf follow-url unfollow-url list-type)
|
||||
(defcomp ~federation-actor-card-from-data (&key (d :as dict) (has-actor :as boolean) (csrf :as string) (follow-url :as string) (unfollow-url :as string) (list-type :as string))
|
||||
(let* ((icon-url (get d "icon_url"))
|
||||
(display-name (get d "display_name"))
|
||||
(username (get d "username"))
|
||||
@@ -72,8 +72,8 @@
|
||||
:summary summary-sx :button button)))
|
||||
|
||||
;; Data-driven actor list (replaces Python _search_results_sx / _actor_list_items_sx loops)
|
||||
(defcomp ~federation-actor-list-from-data (&key actors next-url has-actor csrf
|
||||
follow-url unfollow-url list-type)
|
||||
(defcomp ~federation-actor-list-from-data (&key (actors :as list) (next-url :as string?) (has-actor :as boolean) (csrf :as string)
|
||||
(follow-url :as string) (unfollow-url :as string) (list-type :as string))
|
||||
(<>
|
||||
(map (lambda (d)
|
||||
(~federation-actor-card-from-data :d d :has-actor has-actor :csrf csrf
|
||||
@@ -81,10 +81,10 @@
|
||||
(or actors (list)))
|
||||
(when next-url (~federation-scroll-sentinel :url next-url))))
|
||||
|
||||
(defcomp ~federation-search-info (&key cls text)
|
||||
(defcomp ~federation-search-info (&key (cls :as string) (text :as string))
|
||||
(p :class cls text))
|
||||
|
||||
(defcomp ~federation-search-page (&key search-url search-page-url query info results)
|
||||
(defcomp ~federation-search-page (&key (search-url :as string) (search-page-url :as string) (query :as string) info results)
|
||||
(h1 :class "text-2xl font-bold mb-6" "Search")
|
||||
(form :method "get" :action search-url :class "mb-6"
|
||||
:sx-get search-page-url :sx-target "#search-results" :sx-push-url search-url
|
||||
@@ -97,7 +97,7 @@
|
||||
(div :id "search-results" results))
|
||||
|
||||
;; Following / Followers list page
|
||||
(defcomp ~federation-actor-list-page (&key title count-str items)
|
||||
(defcomp ~federation-actor-list-page (&key (title :as string) (count-str :as string) items)
|
||||
(h1 :class "text-2xl font-bold mb-6" title " "
|
||||
(span :class "text-stone-400 font-normal" count-str))
|
||||
(div :id "actor-list" items))
|
||||
@@ -106,7 +106,7 @@
|
||||
;; Assembled actor card — replaces Python _actor_card_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~federation-actor-card-from-data (&key a actor followed-urls list-type)
|
||||
(defcomp ~federation-actor-card-from-data (&key (a :as dict) actor (followed-urls :as list) (list-type :as string))
|
||||
(let* ((display-name (or (get a "display_name") (get a "preferred_username") ""))
|
||||
(username (or (get a "preferred_username") ""))
|
||||
(domain (or (get a "domain") ""))
|
||||
@@ -146,7 +146,7 @@
|
||||
:label (if (= list-type "followers") "Follow Back" "Follow")))))))
|
||||
|
||||
;; Assembled search content — replaces Python _search_content_sx
|
||||
(defcomp ~federation-search-content (&key query actors total followed-urls actor)
|
||||
(defcomp ~federation-search-content (&key (query :as string?) (actors :as list) (total :as number) (followed-urls :as list) actor)
|
||||
(~federation-search-page
|
||||
:search-url (url-for "social.defpage_search")
|
||||
:search-page-url (url-for "social.search_page")
|
||||
@@ -172,7 +172,7 @@
|
||||
:url (url-for "social.search_page" :q query :page 2)))))))
|
||||
|
||||
;; Assembled following/followers content — replaces Python _following_content_sx etc.
|
||||
(defcomp ~federation-following-content (&key actors total actor)
|
||||
(defcomp ~federation-following-content (&key (actors :as list) (total :as number) actor)
|
||||
(~federation-actor-list-page
|
||||
:title "Following" :count-str (str "(" total ")")
|
||||
:items (when (not (empty? actors))
|
||||
@@ -185,7 +185,7 @@
|
||||
(~federation-scroll-sentinel
|
||||
:url (url-for "social.following_list_page" :page 2)))))))
|
||||
|
||||
(defcomp ~federation-followers-content (&key actors total followed-urls actor)
|
||||
(defcomp ~federation-followers-content (&key (actors :as list) (total :as number) (followed-urls :as list) actor)
|
||||
(~federation-actor-list-page
|
||||
:title "Followers" :count-str (str "(" total ")")
|
||||
:items (when (not (empty? actors))
|
||||
|
||||
@@ -2,11 +2,11 @@
|
||||
|
||||
;; --- Navigation ---
|
||||
|
||||
(defcomp ~federation-nav-choose-username (&key url)
|
||||
(defcomp ~federation-nav-choose-username (&key (url :as string))
|
||||
(nav :class "flex gap-3 text-sm items-center"
|
||||
(a :href url :class "px-2 py-1 rounded hover:bg-stone-200 font-bold" "Choose username")))
|
||||
|
||||
(defcomp ~federation-nav-notification-link (&key href cls count-url)
|
||||
(defcomp ~federation-nav-notification-link (&key (href :as string) (cls :as string) (count-url :as string))
|
||||
(a :href href :class cls "Notifications"
|
||||
(span :sx-get count-url :sx-trigger "load, every 30s" :sx-swap "innerHTML"
|
||||
:class "absolute -top-2 -right-3 text-xs bg-red-500 text-white rounded-full px-1 empty:hidden")))
|
||||
@@ -20,28 +20,28 @@
|
||||
|
||||
;; --- Post card ---
|
||||
|
||||
(defcomp ~federation-boost-label (&key name)
|
||||
(defcomp ~federation-boost-label (&key (name :as string))
|
||||
(div :class "text-sm text-stone-500 mb-2" "Boosted by " name))
|
||||
|
||||
;; Aliases — delegate to shared ~avatar
|
||||
(defcomp ~federation-avatar-img (&key src cls)
|
||||
(defcomp ~federation-avatar-img (&key (src :as string) (cls :as string))
|
||||
(~avatar :src src :cls cls))
|
||||
|
||||
(defcomp ~federation-avatar-placeholder (&key cls initial)
|
||||
(defcomp ~federation-avatar-placeholder (&key (cls :as string) (initial :as string))
|
||||
(~avatar :cls cls :initial initial))
|
||||
|
||||
(defcomp ~federation-content (&key content summary)
|
||||
(defcomp ~federation-content (&key (content :as string) (summary :as string?))
|
||||
(if summary
|
||||
(details :class "mt-2"
|
||||
(summary :class "text-stone-500 cursor-pointer" "CW: " (~rich-text :html summary))
|
||||
(div :class "mt-2 prose prose-sm prose-stone max-w-none" (~rich-text :html content)))
|
||||
(div :class "mt-2 prose prose-sm prose-stone max-w-none" (~rich-text :html content))))
|
||||
|
||||
(defcomp ~federation-original-link (&key url)
|
||||
(defcomp ~federation-original-link (&key (url :as string))
|
||||
(a :href url :target "_blank" :rel "noopener"
|
||||
:class "text-sm text-stone-400 hover:underline mt-1 inline-block" "original"))
|
||||
|
||||
(defcomp ~federation-post-card (&key boost avatar actor-name actor-username domain time content original interactions)
|
||||
(defcomp ~federation-post-card (&key boost avatar (actor-name :as string) (actor-username :as string) (domain :as string) (time :as string) content original interactions)
|
||||
(article :class "bg-white rounded-lg shadow-sm border border-stone-200 p-4 mb-4"
|
||||
boost
|
||||
(div :class "flex items-start gap-3"
|
||||
@@ -55,17 +55,17 @@
|
||||
|
||||
;; --- Interaction buttons ---
|
||||
|
||||
(defcomp ~federation-reply-link (&key url)
|
||||
(defcomp ~federation-reply-link (&key (url :as string))
|
||||
(a :href url :class "hover:text-stone-700" "Reply"))
|
||||
|
||||
(defcomp ~federation-like-form (&key action target oid ainbox csrf cls icon count)
|
||||
(defcomp ~federation-like-form (&key (action :as string) (target :as string) (oid :as string) (ainbox :as string) (csrf :as string) (cls :as string) (icon :as string) count)
|
||||
(form :sx-post action :sx-target target :sx-swap "innerHTML"
|
||||
(input :type "hidden" :name "object_id" :value oid)
|
||||
(input :type "hidden" :name "author_inbox" :value ainbox)
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
(button :type "submit" :class cls (span icon) " " count)))
|
||||
|
||||
(defcomp ~federation-boost-form (&key action target oid ainbox csrf cls count)
|
||||
(defcomp ~federation-boost-form (&key (action :as string) (target :as string) (oid :as string) (ainbox :as string) (csrf :as string) (cls :as string) count)
|
||||
(form :sx-post action :sx-target target :sx-swap "innerHTML"
|
||||
(input :type "hidden" :name "object_id" :value oid)
|
||||
(input :type "hidden" :name "author_inbox" :value ainbox)
|
||||
@@ -78,13 +78,13 @@
|
||||
|
||||
;; --- Timeline ---
|
||||
|
||||
(defcomp ~federation-scroll-sentinel (&key url)
|
||||
(defcomp ~federation-scroll-sentinel (&key (url :as string))
|
||||
(div :sx-get url :sx-trigger "revealed" :sx-swap "outerHTML"))
|
||||
|
||||
(defcomp ~federation-compose-button (&key url)
|
||||
(defcomp ~federation-compose-button (&key (url :as string))
|
||||
(a :href url :class "bg-stone-800 text-white px-4 py-2 rounded hover:bg-stone-700" "Compose"))
|
||||
|
||||
(defcomp ~federation-timeline-page (&key label compose timeline)
|
||||
(defcomp ~federation-timeline-page (&key (label :as string) compose timeline)
|
||||
(div :class "flex items-center justify-between mb-6"
|
||||
(h1 :class "text-2xl font-bold" label " Timeline")
|
||||
compose)
|
||||
@@ -92,9 +92,9 @@
|
||||
|
||||
;; --- Data-driven post card (replaces Python _post_card_sx loop) ---
|
||||
|
||||
(defcomp ~federation-post-card-from-data (&key d has-actor csrf
|
||||
like-url unlike-url
|
||||
boost-url unboost-url)
|
||||
(defcomp ~federation-post-card-from-data (&key (d :as dict) (has-actor :as boolean) (csrf :as string)
|
||||
(like-url :as string) (unlike-url :as string)
|
||||
(boost-url :as string) (unboost-url :as string))
|
||||
(let* ((boosted-by (get d "boosted_by"))
|
||||
(actor-icon (get d "actor_icon"))
|
||||
(actor-name (get d "actor_name"))
|
||||
@@ -140,8 +140,8 @@
|
||||
:interactions interactions)))
|
||||
|
||||
;; Data-driven timeline items (replaces Python _timeline_items_sx loop)
|
||||
(defcomp ~federation-timeline-items-from-data (&key items next-url has-actor csrf
|
||||
like-url unlike-url boost-url unboost-url)
|
||||
(defcomp ~federation-timeline-items-from-data (&key (items :as list) (next-url :as string?) (has-actor :as boolean) (csrf :as string)
|
||||
(like-url :as string) (unlike-url :as string) (boost-url :as string) (unboost-url :as string))
|
||||
(<>
|
||||
(map (lambda (d)
|
||||
(~federation-post-card-from-data :d d :has-actor has-actor :csrf csrf
|
||||
@@ -151,11 +151,11 @@
|
||||
|
||||
;; --- Compose ---
|
||||
|
||||
(defcomp ~federation-compose-reply (&key reply-to)
|
||||
(defcomp ~federation-compose-reply (&key (reply-to :as string))
|
||||
(input :type "hidden" :name "in_reply_to" :value reply-to)
|
||||
(div :class "text-sm text-stone-500" "Replying to " (span :class "font-mono" reply-to)))
|
||||
|
||||
(defcomp ~federation-compose-form (&key action csrf reply)
|
||||
(defcomp ~federation-compose-form (&key (action :as string) (csrf :as string) reply)
|
||||
(h1 :class "text-2xl font-bold mb-6" "Compose")
|
||||
(form :method "post" :action action :class "space-y-4"
|
||||
(input :type "hidden" :name "csrf_token" :value csrf)
|
||||
@@ -208,7 +208,7 @@
|
||||
;; Assembled post card — replaces Python _post_card_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~federation-post-card-from-data (&key item actor)
|
||||
(defcomp ~federation-post-card-from-data (&key (item :as dict) actor)
|
||||
(let* ((boosted-by (get item "boosted_by"))
|
||||
(actor-icon (get item "actor_icon"))
|
||||
(actor-name (or (get item "actor_name") "?"))
|
||||
@@ -267,7 +267,7 @@
|
||||
;; Assembled timeline items — replaces Python _timeline_items_sx
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~federation-timeline-items (&key items timeline-type actor next-url)
|
||||
(defcomp ~federation-timeline-items (&key (items :as list) (timeline-type :as string) actor (next-url :as string?))
|
||||
(<>
|
||||
(map (lambda (item)
|
||||
(~federation-post-card-from-data :item item :actor actor))
|
||||
@@ -276,7 +276,7 @@
|
||||
(~federation-scroll-sentinel :url next-url))))
|
||||
|
||||
;; Assembled timeline content — replaces Python _timeline_content_sx
|
||||
(defcomp ~federation-timeline-content (&key items timeline-type actor)
|
||||
(defcomp ~federation-timeline-content (&key (items :as list) (timeline-type :as string) actor)
|
||||
(let* ((label (if (= timeline-type "home") "Home" "Public")))
|
||||
(~federation-timeline-page
|
||||
:label label
|
||||
@@ -289,7 +289,7 @@
|
||||
:before (get (last items) "before_cursor")))))))
|
||||
|
||||
;; Assembled compose content — replaces Python _compose_content_sx
|
||||
(defcomp ~federation-compose-content (&key reply-to)
|
||||
(defcomp ~federation-compose-content (&key (reply-to :as string?))
|
||||
(~federation-compose-form
|
||||
:action (url-for "social.compose_submit")
|
||||
:csrf (csrf-token)
|
||||
|
||||
@@ -1,10 +1,10 @@
|
||||
;; Market card components — pure data, no raw! HTML injection
|
||||
|
||||
(defcomp ~market-label-overlay (&key src)
|
||||
(defcomp ~market-label-overlay (&key (src :as string))
|
||||
(img :src src :alt ""
|
||||
:class "pointer-events-none absolute inset-0 w-full h-full object-contain object-top"))
|
||||
|
||||
(defcomp ~market-card-image (&key image labels brand brand-highlight)
|
||||
(defcomp ~market-card-image (&key (image :as string) (labels :as list?) (brand :as string) (brand-highlight :as string?))
|
||||
(div :class "w-full aspect-square bg-stone-100 relative"
|
||||
(figure :class "inline-block w-full h-full"
|
||||
(div :class "relative w-full h-full"
|
||||
@@ -12,35 +12,35 @@
|
||||
(when labels (map (lambda (src) (~market-label-overlay :src src)) labels)))
|
||||
(figcaption :class (str "mt-2 text-sm text-center" brand-highlight " text-stone-600") brand))))
|
||||
|
||||
(defcomp ~market-card-no-image (&key labels brand)
|
||||
(defcomp ~market-card-no-image (&key (labels :as list?) (brand :as string))
|
||||
(div :class "w-full aspect-square bg-stone-100 relative"
|
||||
(div :class "p-2 flex flex-col items-center justify-center gap-2 text-red-500 h-full relative"
|
||||
(div :class "text-stone-400 text-xs" "No image")
|
||||
(when labels (ul :class "flex flex-row gap-1" (map (lambda (l) (li l)) labels)))
|
||||
(div :class "text-stone-900 text-center line-clamp-3 break-words [overflow-wrap:anywhere]" brand))))
|
||||
|
||||
(defcomp ~market-card-sticker (&key src name ring-cls)
|
||||
(defcomp ~market-card-sticker (&key (src :as string) (name :as string) (ring-cls :as string?))
|
||||
(img :src src :alt name :class (str "w-6 h-6" ring-cls)))
|
||||
|
||||
(defcomp ~market-card-stickers (&key stickers)
|
||||
(defcomp ~market-card-stickers (&key (stickers :as list))
|
||||
(div :class "flex flex-row justify-center gap-2 p-2"
|
||||
(map (lambda (s) (~market-card-sticker :src (get s "src") :name (get s "name") :ring-cls (get s "ring-cls"))) stickers)))
|
||||
|
||||
(defcomp ~market-card-highlight (&key pre mid post)
|
||||
(defcomp ~market-card-highlight (&key (pre :as string) (mid :as string) (post :as string))
|
||||
(<> pre (mark mid) post))
|
||||
|
||||
;; Price — delegates to shared ~price
|
||||
(defcomp ~market-card-price (&key special-price regular-price)
|
||||
(defcomp ~market-card-price (&key (special-price :as string?) (regular-price :as string?))
|
||||
(~price :special-price special-price :regular-price regular-price))
|
||||
|
||||
;; Main product card — accepts pure data, composes sub-components
|
||||
(defcomp ~market-product-card (&key href hx-select
|
||||
has-like liked slug csrf like-action
|
||||
image labels brand brand-highlight
|
||||
special-price regular-price
|
||||
cart-action quantity cart-href
|
||||
stickers
|
||||
title has-highlight search-pre search-mid search-post)
|
||||
(defcomp ~market-product-card (&key (href :as string) (hx-select :as string)
|
||||
(has-like :as boolean) (liked :as boolean?) (slug :as string) (csrf :as string) (like-action :as string?)
|
||||
(image :as string?) (labels :as list?) (brand :as string) (brand-highlight :as string?)
|
||||
(special-price :as string?) (regular-price :as string?)
|
||||
(cart-action :as string) (quantity :as number?) (cart-href :as string)
|
||||
(stickers :as list?)
|
||||
(title :as string) (has-highlight :as boolean) (search-pre :as string?) (search-mid :as string?) (search-post :as string?))
|
||||
(div :class "flex flex-col rounded-xl bg-white shadow hover:shadow-md transition overflow-hidden relative"
|
||||
(when has-like
|
||||
(~market-like-button :form-id (str "like-" slug) :action like-action :slug slug :csrf csrf
|
||||
@@ -65,7 +65,7 @@
|
||||
(~market-card-highlight :pre search-pre :mid search-mid :post search-post)
|
||||
title)))))
|
||||
|
||||
(defcomp ~market-like-button (&key form-id action slug csrf icon-cls)
|
||||
(defcomp ~market-like-button (&key (form-id :as string) (action :as string) (slug :as string) (csrf :as string) (icon-cls :as string))
|
||||
(div :class "absolute top-2 right-2 z-10 text-6xl md:text-xl"
|
||||
(form :id form-id :action action :method "post"
|
||||
:sx-post action :sx-target (str "#like-" slug) :sx-swap "outerHTML"
|
||||
@@ -73,22 +73,22 @@
|
||||
(button :type "submit" :class "cursor-pointer"
|
||||
(i :class icon-cls :aria-hidden "true")))))
|
||||
|
||||
(defcomp ~market-market-card-title-link (&key href name)
|
||||
(defcomp ~market-market-card-title-link (&key (href :as string) (name :as string))
|
||||
(a :href href :class "hover:text-emerald-700"
|
||||
(h2 :class "text-lg font-semibold text-stone-900" name)))
|
||||
|
||||
(defcomp ~market-market-card-title (&key name)
|
||||
(defcomp ~market-market-card-title (&key (name :as string))
|
||||
(h2 :class "text-lg font-semibold text-stone-900" name))
|
||||
|
||||
(defcomp ~market-market-card-desc (&key description)
|
||||
(defcomp ~market-market-card-desc (&key (description :as string))
|
||||
(p :class "text-sm text-stone-600 mt-1 line-clamp-2" description))
|
||||
|
||||
(defcomp ~market-market-card-badge (&key href title)
|
||||
(defcomp ~market-market-card-badge (&key (href :as string) (title :as string))
|
||||
(div :class "flex flex-wrap items-center gap-1.5 mt-3"
|
||||
(a :href href :class "inline-block px-2 py-0.5 rounded-full text-xs font-medium bg-amber-100 text-amber-800 hover:bg-amber-200"
|
||||
title)))
|
||||
|
||||
(defcomp ~market-market-card (&key title-content desc-content badge-content title desc badge)
|
||||
(defcomp ~market-market-card (&key (title-content :as list?) (desc-content :as list?) (badge-content :as list?) (title :as string?) (desc :as string?) (badge :as string?))
|
||||
(article :class "rounded-xl bg-white shadow-sm border border-stone-200 p-5 flex flex-col justify-between hover:border-stone-400 transition-colors"
|
||||
(div
|
||||
(if title-content title-content (when title title))
|
||||
@@ -101,8 +101,8 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Product cards grid with infinite scroll sentinels
|
||||
(defcomp ~market-product-cards-content (&key products page total-pages next-url
|
||||
mobile-sentinel-hs desktop-sentinel-hs)
|
||||
(defcomp ~market-product-cards-content (&key (products :as list) (page :as number) (total-pages :as number) (next-url :as string)
|
||||
(mobile-sentinel-hs :as string?) (desktop-sentinel-hs :as string?))
|
||||
(<>
|
||||
(map (lambda (p)
|
||||
(~market-product-card
|
||||
@@ -126,7 +126,7 @@
|
||||
(~end-of-results))))
|
||||
|
||||
;; Single market card from data (handles conditional title/desc/badge)
|
||||
(defcomp ~market-card-from-data (&key name description href show-badge badge-href badge-title)
|
||||
(defcomp ~market-card-from-data (&key (name :as string) (description :as string?) (href :as string?) (show-badge :as boolean) (badge-href :as string?) (badge-title :as string?))
|
||||
(~market-market-card
|
||||
:title-content (if href
|
||||
(~market-market-card-title-link :href href :name name)
|
||||
@@ -137,7 +137,7 @@
|
||||
(~market-market-card-badge :href badge-href :title badge-title))))
|
||||
|
||||
;; Market cards list with infinite scroll sentinel
|
||||
(defcomp ~market-cards-content (&key markets page has-more next-url)
|
||||
(defcomp ~market-cards-content (&key (markets :as list) (page :as number) (has-more :as boolean) (next-url :as string))
|
||||
(<>
|
||||
(map (lambda (m)
|
||||
(~market-card-from-data
|
||||
@@ -149,7 +149,7 @@
|
||||
(~sentinel-simple :id (str "sentinel-" page) :next-url next-url))))
|
||||
|
||||
;; Market landing page content from data
|
||||
(defcomp ~market-landing-from-data (&key excerpt feature-image html)
|
||||
(defcomp ~market-landing-from-data (&key (excerpt :as string?) (feature-image :as string?) (html :as string?))
|
||||
(~market-landing-content :inner
|
||||
(<> (when excerpt (~market-landing-excerpt :text excerpt))
|
||||
(when feature-image (~market-landing-image :src feature-image))
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Market product detail components
|
||||
|
||||
(defcomp ~market-detail-gallery-inner (&key like image alt labels brand)
|
||||
(defcomp ~market-detail-gallery-inner (&key (like :as list?) (image :as string) (alt :as string) (labels :as list?) (brand :as string))
|
||||
(<> like
|
||||
(figure :class "inline-block"
|
||||
(div :class "relative w-full aspect-square"
|
||||
@@ -18,79 +18,79 @@
|
||||
:class "absolute right-2 top-1/2 -translate-y-1/2 z-10 grid place-items-center w-12 h-12 md:w-14 md:h-14 rounded-full bg-white/90 hover:bg-white shadow-lg text-3xl md:text-4xl"
|
||||
:title "Next" "\u203a")))
|
||||
|
||||
(defcomp ~market-detail-gallery (&key inner nav)
|
||||
(defcomp ~market-detail-gallery (&key (inner :as list) (nav :as list?))
|
||||
(div :class "relative rounded-xl overflow-hidden bg-stone-100"
|
||||
inner nav))
|
||||
|
||||
(defcomp ~market-detail-thumb (&key title src alt)
|
||||
(defcomp ~market-detail-thumb (&key (title :as string) (src :as string) (alt :as string))
|
||||
(<> (button :type "button" :data-thumb ""
|
||||
:class "shrink-0 rounded-lg overflow-hidden bg-stone-100 hover:opacity-90 ring-offset-2"
|
||||
:title title
|
||||
(img :src src :class "h-16 w-16 object-contain" :alt alt :loading "lazy" :decoding "async"))
|
||||
(span :data-image-src src :class "hidden")))
|
||||
|
||||
(defcomp ~market-detail-thumbs (&key thumbs)
|
||||
(defcomp ~market-detail-thumbs (&key (thumbs :as list))
|
||||
(div :class "flex flex-row justify-center"
|
||||
(div :class "mt-3 flex gap-2 overflow-x-auto no-scrollbar" thumbs)))
|
||||
|
||||
(defcomp ~market-detail-no-image (&key like)
|
||||
(defcomp ~market-detail-no-image (&key (like :as list?))
|
||||
(div :class "relative aspect-square bg-stone-100 rounded-xl flex items-center justify-center text-stone-400"
|
||||
like "No image"))
|
||||
|
||||
(defcomp ~market-detail-sticker (&key src name)
|
||||
(defcomp ~market-detail-sticker (&key (src :as string) (name :as string))
|
||||
(img :src src :alt name :class "w-10 h-10"))
|
||||
|
||||
(defcomp ~market-detail-stickers (&key items)
|
||||
(defcomp ~market-detail-stickers (&key (items :as list))
|
||||
(div :class "p-2 flex flex-row justify-center gap-2" items))
|
||||
|
||||
(defcomp ~market-detail-unit-price (&key price)
|
||||
(defcomp ~market-detail-unit-price (&key (price :as string))
|
||||
(div (str "Unit price: " price)))
|
||||
|
||||
(defcomp ~market-detail-case-size (&key size)
|
||||
(defcomp ~market-detail-case-size (&key (size :as string))
|
||||
(div (str "Case size: " size)))
|
||||
|
||||
(defcomp ~market-detail-extras (&key inner)
|
||||
(defcomp ~market-detail-extras (&key (inner :as list))
|
||||
(div :class "mt-2 space-y-1 text-sm text-stone-600" inner))
|
||||
|
||||
(defcomp ~market-detail-desc-short (&key text)
|
||||
(defcomp ~market-detail-desc-short (&key (text :as string))
|
||||
(p :class "leading-relaxed text-lg" text))
|
||||
|
||||
(defcomp ~market-detail-desc-html (&key html)
|
||||
(defcomp ~market-detail-desc-html (&key (html :as string))
|
||||
(div :class "max-w-none text-sm leading-relaxed" (~rich-text :html html)))
|
||||
|
||||
(defcomp ~market-detail-desc-wrapper (&key inner)
|
||||
(defcomp ~market-detail-desc-wrapper (&key (inner :as list))
|
||||
(div :class "mt-4 text-stone-800 space-y-3" inner))
|
||||
|
||||
(defcomp ~market-detail-section (&key title html)
|
||||
(defcomp ~market-detail-section (&key (title :as string) (html :as string))
|
||||
(details :class "group rounded-xl border bg-white shadow-sm open:shadow p-0"
|
||||
(summary :class "cursor-pointer select-none px-4 py-3 flex items-center justify-between"
|
||||
(span :class "font-medium" title)
|
||||
(span :class "ml-2 text-xl transition-transform group-open:rotate-180" "\u2304"))
|
||||
(div :class "px-4 pb-4 max-w-none text-sm leading-relaxed" (~rich-text :html html))))
|
||||
|
||||
(defcomp ~market-detail-sections (&key items)
|
||||
(defcomp ~market-detail-sections (&key (items :as list))
|
||||
(div :class "mt-8 space-y-3" items))
|
||||
|
||||
(defcomp ~market-detail-right-col (&key inner)
|
||||
(defcomp ~market-detail-right-col (&key (inner :as list))
|
||||
(div :class "md:col-span-3" inner))
|
||||
|
||||
(defcomp ~market-detail-layout (&key gallery stickers details)
|
||||
(defcomp ~market-detail-layout (&key (gallery :as list) (stickers :as list?) (details :as list))
|
||||
(<> (div :class "mt-3 grid grid-cols-1 md:grid-cols-5 gap-6" :data-gallery-root ""
|
||||
(div :class "md:col-span-2" gallery stickers)
|
||||
details)
|
||||
(div :class "pb-8")))
|
||||
|
||||
(defcomp ~market-landing-excerpt (&key text)
|
||||
(defcomp ~market-landing-excerpt (&key (text :as string))
|
||||
(div :class "w-full text-center italic text-3xl p-2" text))
|
||||
|
||||
(defcomp ~market-landing-image (&key src)
|
||||
(defcomp ~market-landing-image (&key (src :as string))
|
||||
(div :class "mb-3 flex justify-center"
|
||||
(img :src src :alt "" :class "rounded-lg w-full md:w-3/4 object-cover")))
|
||||
|
||||
(defcomp ~market-landing-html (&key html)
|
||||
(defcomp ~market-landing-html (&key (html :as string))
|
||||
(div :class "blog-content p-2" (~rich-text :html html)))
|
||||
|
||||
(defcomp ~market-landing-content (&key inner)
|
||||
(defcomp ~market-landing-content (&key (inner :as list))
|
||||
(<> (article :class "relative w-full" inner) (div :class "pb-8")))
|
||||
|
||||
|
||||
@@ -99,7 +99,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Gallery section from pre-computed data
|
||||
(defcomp ~market-detail-gallery-from-data (&key images labels brand like-data has-nav-buttons thumbs)
|
||||
(defcomp ~market-detail-gallery-from-data (&key (images :as list?) (labels :as list?) (brand :as string) (like-data :as dict?) (has-nav-buttons :as boolean) (thumbs :as list?))
|
||||
(let ((like-sx (when like-data
|
||||
(~market-like-button
|
||||
:form-id (get like-data "form-id") :action (get like-data "action")
|
||||
@@ -124,7 +124,7 @@
|
||||
(~market-detail-no-image :like like-sx))))
|
||||
|
||||
;; Right column details from data
|
||||
(defcomp ~market-detail-info-from-data (&key extras desc-short desc-html sections)
|
||||
(defcomp ~market-detail-info-from-data (&key (extras :as list?) (desc-short :as string?) (desc-html :as string?) (sections :as list?))
|
||||
(~market-detail-right-col :inner
|
||||
(<>
|
||||
(when extras
|
||||
@@ -145,9 +145,9 @@
|
||||
sections)))))))
|
||||
|
||||
;; Full product detail layout from data
|
||||
(defcomp ~market-product-detail-from-data (&key images labels brand like-data
|
||||
has-nav-buttons thumbs sticker-items
|
||||
extras desc-short desc-html sections)
|
||||
(defcomp ~market-product-detail-from-data (&key (images :as list?) (labels :as list?) (brand :as string) (like-data :as dict?)
|
||||
(has-nav-buttons :as boolean) (thumbs :as list?) (sticker-items :as list?)
|
||||
(extras :as list?) (desc-short :as string?) (desc-html :as string?) (sections :as list?))
|
||||
(~market-detail-layout
|
||||
:gallery (~market-detail-gallery-from-data
|
||||
:images images :labels labels :brand brand :like-data like-data
|
||||
|
||||
@@ -1,21 +1,21 @@
|
||||
;; Market meta/SEO components
|
||||
|
||||
(defcomp ~market-meta-title (&key title)
|
||||
(defcomp ~market-meta-title (&key (title :as string))
|
||||
(title title))
|
||||
|
||||
(defcomp ~market-meta-description (&key description)
|
||||
(defcomp ~market-meta-description (&key (description :as string))
|
||||
(meta :name "description" :content description))
|
||||
|
||||
(defcomp ~market-meta-canonical (&key href)
|
||||
(defcomp ~market-meta-canonical (&key (href :as string))
|
||||
(link :rel "canonical" :href href))
|
||||
|
||||
(defcomp ~market-meta-og (&key property content)
|
||||
(defcomp ~market-meta-og (&key (property :as string) (content :as string))
|
||||
(meta :property property :content content))
|
||||
|
||||
(defcomp ~market-meta-twitter (&key name content)
|
||||
(defcomp ~market-meta-twitter (&key (name :as string) (content :as string))
|
||||
(meta :name name :content content))
|
||||
|
||||
(defcomp ~market-meta-jsonld (&key json)
|
||||
(defcomp ~market-meta-jsonld (&key (json :as string))
|
||||
(script :type "application/ld+json" (~rich-text :html json)))
|
||||
|
||||
|
||||
@@ -23,9 +23,10 @@
|
||||
;; Composition: all product meta tags from data
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~market-product-meta-from-data (&key title description canonical image-url
|
||||
site-title brand price price-currency
|
||||
jsonld-json)
|
||||
(defcomp ~market-product-meta-from-data (&key (title :as string) (description :as string) (canonical :as string?)
|
||||
(image-url :as string?)
|
||||
(site-title :as string) (brand :as string?) (price :as string?) (price-currency :as string?)
|
||||
(jsonld-json :as string))
|
||||
(<>
|
||||
(~market-meta-title :title title)
|
||||
(~market-meta-description :description description)
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Market navigation components
|
||||
|
||||
(defcomp ~market-category-link (&key href hx-select active select-colours label)
|
||||
(defcomp ~market-category-link (&key (href :as string) (hx-select :as string) (active :as boolean) (select-colours :as string) (label :as string))
|
||||
(div :class "relative nav-group"
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
@@ -8,14 +8,14 @@
|
||||
:class (str "block px-2 py-1 rounded text-center whitespace-normal break-words leading-snug bg-stone-200 text-black " select-colours)
|
||||
label)))
|
||||
|
||||
(defcomp ~market-desktop-category-nav (&key links admin)
|
||||
(defcomp ~market-desktop-category-nav (&key (links :as list) (admin :as list?))
|
||||
(nav :class "hidden md:flex gap-4 text-sm ml-2 w-full justify-end items-center"
|
||||
links admin))
|
||||
|
||||
(defcomp ~market-mobile-nav-wrapper (&key items)
|
||||
(defcomp ~market-mobile-nav-wrapper (&key (items :as list))
|
||||
(div :class "px-4 py-2" (div :class "divide-y" items)))
|
||||
|
||||
(defcomp ~market-mobile-all-link (&key href hx-select active select-colours)
|
||||
(defcomp ~market-mobile-all-link (&key (href :as string) (hx-select :as string) (active :as boolean) (select-colours :as string))
|
||||
(a :role "option" :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
:aria-selected (if active "true" "false")
|
||||
@@ -28,7 +28,7 @@
|
||||
(path :fill-rule "evenodd" :clip-rule "evenodd"
|
||||
:d "M5.293 7.293a1 1 0 011.414 0L10 10.586l3.293-3.293a1 1 0 111.414 1.414l-4 4a1 1 0 01-1.414 0l-4-4a1 1 0 010-1.414z")))
|
||||
|
||||
(defcomp ~market-mobile-cat-summary (&key bg-cls href hx-select select-colours cat-name count-label count-str chevron)
|
||||
(defcomp ~market-mobile-cat-summary (&key (bg-cls :as string) (href :as string) (hx-select :as string) (select-colours :as string) (cat-name :as string) (count-label :as string) (count-str :as string) (chevron :as list))
|
||||
(summary :class (str "flex items-center justify-between cursor-pointer select-none block rounded-lg px-3 py-3 text-base hover:bg-stone-50" bg-cls)
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
@@ -37,7 +37,7 @@
|
||||
(div :aria-label count-label count-str))
|
||||
chevron))
|
||||
|
||||
(defcomp ~market-mobile-sub-link (&key select-colours active href hx-select label count-label count-str)
|
||||
(defcomp ~market-mobile-sub-link (&key (select-colours :as string) (active :as boolean) (href :as string) (hx-select :as string) (label :as string) (count-label :as string) (count-str :as string))
|
||||
(a :class (str "snap-start px-2 py-3 rounded " select-colours " flex flex-row gap-2")
|
||||
:aria-selected (if active "true" "false")
|
||||
:href href :sx-get href :sx-target "#main-panel"
|
||||
@@ -45,20 +45,20 @@
|
||||
(div label)
|
||||
(div :aria-label count-label count-str)))
|
||||
|
||||
(defcomp ~market-mobile-subs-panel (&key links)
|
||||
(defcomp ~market-mobile-subs-panel (&key (links :as list))
|
||||
(div :class "pb-3 pl-2"
|
||||
(div :data-peek-viewport "" :data-peek-size-px "18" :data-peek-edge "bottom" :data-peek-mask "true" :class "m-2 bg-stone-100"
|
||||
(div :data-peek-inner "" :class "grid grid-cols-1 gap-1 snap-y snap-mandatory pr-1" :aria-label "Subcategories"
|
||||
links))))
|
||||
|
||||
(defcomp ~market-mobile-view-all (&key href hx-select)
|
||||
(defcomp ~market-mobile-view-all (&key (href :as string) (hx-select :as string))
|
||||
(div :class "pb-3 pl-2"
|
||||
(a :class "px-2 py-1 rounded hover:bg-stone-100 block"
|
||||
:href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML" :sx-push-url "true"
|
||||
"View all")))
|
||||
|
||||
(defcomp ~market-mobile-cat-details (&key open summary subs)
|
||||
(defcomp ~market-mobile-cat-details (&key (open :as boolean) (summary :as list) (subs :as list))
|
||||
(details :class "group/cat py-1" :open open
|
||||
summary subs))
|
||||
|
||||
@@ -67,7 +67,7 @@
|
||||
;; Composition: mobile nav panel from pre-computed category data
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~market-mobile-nav-from-data (&key categories all-href all-active hx-select select-colours)
|
||||
(defcomp ~market-mobile-nav-from-data (&key (categories :as list) (all-href :as string) (all-active :as boolean) (hx-select :as string) (select-colours :as string))
|
||||
(~market-mobile-nav-wrapper :items
|
||||
(<>
|
||||
(~market-mobile-all-link :href all-href :hx-select hx-select
|
||||
|
||||
@@ -1,36 +1,36 @@
|
||||
;; Market price display components
|
||||
|
||||
(defcomp ~market-price-special (&key price)
|
||||
(defcomp ~market-price-special (&key (price :as string))
|
||||
(div :class "text-lg font-semibold text-emerald-700" price))
|
||||
|
||||
(defcomp ~market-price-regular-strike (&key price)
|
||||
(defcomp ~market-price-regular-strike (&key (price :as string))
|
||||
(div :class "text-sm line-through text-stone-500" price))
|
||||
|
||||
(defcomp ~market-price-regular (&key price)
|
||||
(defcomp ~market-price-regular (&key (price :as string))
|
||||
(div :class "mt-1 text-lg font-semibold" price))
|
||||
|
||||
(defcomp ~market-price-line (&key inner)
|
||||
(defcomp ~market-price-line (&key (inner :as list))
|
||||
(div :class "mt-1 flex items-baseline gap-2 justify-center" inner))
|
||||
|
||||
(defcomp ~market-header-price-special-label ()
|
||||
(div :class "text-md font-bold text-emerald-700" "Special price"))
|
||||
|
||||
(defcomp ~market-header-price-special (&key price)
|
||||
(defcomp ~market-header-price-special (&key (price :as string))
|
||||
(div :class "text-xl font-semibold text-emerald-700" price))
|
||||
|
||||
(defcomp ~market-header-price-strike (&key price)
|
||||
(defcomp ~market-header-price-strike (&key (price :as string))
|
||||
(div :class "text-base text-md line-through text-stone-500" price))
|
||||
|
||||
(defcomp ~market-header-price-regular-label ()
|
||||
(div :class "hidden md:block text-xl font-bold" "Our price"))
|
||||
|
||||
(defcomp ~market-header-price-regular (&key price)
|
||||
(defcomp ~market-header-price-regular (&key (price :as string))
|
||||
(div :class "text-xl font-semibold" price))
|
||||
|
||||
(defcomp ~market-header-rrp (&key rrp)
|
||||
(defcomp ~market-header-rrp (&key (rrp :as string))
|
||||
(div :class "text-base text-stone-400" (span "rrp:") " " (span rrp)))
|
||||
|
||||
(defcomp ~market-prices-row (&key inner)
|
||||
(defcomp ~market-prices-row (&key (inner :as list))
|
||||
(div :class "flex flex-row items-center justify-between md:gap-2 md:px-2" inner))
|
||||
|
||||
|
||||
@@ -38,8 +38,9 @@
|
||||
;; Composition: prices header + cart button from data
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~market-prices-header-from-data (&key cart-id cart-action csrf quantity cart-href
|
||||
sp-val sp-str rp-val rp-str rrp-str)
|
||||
(defcomp ~market-prices-header-from-data (&key (cart-id :as string) (cart-action :as string) (csrf :as string) (quantity :as number?)
|
||||
(cart-href :as string)
|
||||
(sp-val :as number?) (sp-str :as string?) (rp-val :as number?) (rp-str :as string?) (rrp-str :as string?))
|
||||
(~market-prices-row :inner
|
||||
(<>
|
||||
(if quantity
|
||||
@@ -57,7 +58,7 @@
|
||||
(when rrp-str (~market-header-rrp :rrp rrp-str)))))
|
||||
|
||||
;; Card price line from data (used in product cards)
|
||||
(defcomp ~market-card-price-from-data (&key sp-val sp-str rp-val rp-str)
|
||||
(defcomp ~market-card-price-from-data (&key (sp-val :as number?) (sp-str :as string?) (rp-val :as number?) (rp-str :as string?))
|
||||
(~market-price-line :inner
|
||||
(<>
|
||||
(when sp-val
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
;; Checkout return page components
|
||||
|
||||
(defcomp ~checkout-return-header (&key status)
|
||||
(defcomp ~checkout-return-header (&key (status :as string))
|
||||
(header :class "mb-1 sm:mb-2 flex flex-col sm:flex-row sm:items-center justify-between gap-3 sm:gap-4"
|
||||
(div :class "space-y-1"
|
||||
(h1 :class "text-xl sm:text-2xl md:text-3xl font-semibold tracking-tight"
|
||||
@@ -21,7 +21,7 @@
|
||||
(div :class "rounded-2xl border border-dashed border-rose-300 bg-rose-50/80 p-4 sm:p-6 text-sm text-rose-800"
|
||||
"We couldn\u2019t find that order. If you reached this page from an old link, please start a new order.")))
|
||||
|
||||
(defcomp ~checkout-return-failed (&key order-id)
|
||||
(defcomp ~checkout-return-failed (&key (order-id :as string))
|
||||
(div :class "rounded-2xl border border-rose-200 bg-rose-50/80 p-4 sm:p-6 text-sm text-rose-900 space-y-2"
|
||||
(p :class "font-medium" "Your payment was not completed.")
|
||||
(p "You can go back to your cart and try checkout again. If the problem persists, please contact us and mention order "
|
||||
@@ -32,7 +32,7 @@
|
||||
(p :class "font-medium" "All done!")
|
||||
(p "We\u2019ll start processing your order shortly.")))
|
||||
|
||||
(defcomp ~checkout-return-ticket (&key name pill state type-name date-str code price)
|
||||
(defcomp ~checkout-return-ticket (&key (name :as string) (pill :as string) (state :as string) (type-name :as string?) (date-str :as string) (code :as string) (price :as string))
|
||||
(li :class "px-4 py-3 flex items-start justify-between text-sm"
|
||||
(div
|
||||
(div :class "font-medium flex items-center gap-2"
|
||||
@@ -48,7 +48,7 @@
|
||||
(ul :class "divide-y divide-stone-200 rounded-2xl border border-stone-200 bg-white/80" items)))
|
||||
|
||||
;; Data-driven ticket items (replaces Python loop)
|
||||
(defcomp ~checkout-return-tickets-from-data (&key tickets)
|
||||
(defcomp ~checkout-return-tickets-from-data (&key (tickets :as list))
|
||||
(~checkout-return-tickets
|
||||
:items (<> (map (lambda (tk)
|
||||
(~checkout-return-ticket
|
||||
|
||||
@@ -3,13 +3,13 @@
|
||||
|
||||
;; --- orders layout: root + auth + orders rows ---
|
||||
|
||||
(defcomp ~orders-layout-full (&key list-url)
|
||||
(defcomp ~orders-layout-full (&key (list-url :as string))
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
:inner (<> (~auth-header-row-auto)
|
||||
(~orders-header-row :list-url (or list-url "/"))))))
|
||||
|
||||
(defcomp ~orders-layout-oob (&key list-url)
|
||||
(defcomp ~orders-layout-oob (&key (list-url :as string))
|
||||
(<> (~auth-header-row-auto true)
|
||||
(~oob-header-sx
|
||||
:parent-id "auth-header-child"
|
||||
@@ -21,7 +21,7 @@
|
||||
|
||||
;; --- order-detail layout: root + auth + orders + order rows ---
|
||||
|
||||
(defcomp ~order-detail-layout-full (&key list-url detail-url)
|
||||
(defcomp ~order-detail-layout-full (&key (list-url :as string) (detail-url :as string))
|
||||
(<> (~root-header-auto)
|
||||
(~order-detail-header-stack
|
||||
:auth (~auth-header-row-auto)
|
||||
@@ -30,7 +30,7 @@
|
||||
:link-href (or detail-url "/") :link-label "Order"
|
||||
:icon "fa fa-gbp"))))
|
||||
|
||||
(defcomp ~order-detail-layout-oob (&key detail-url)
|
||||
(defcomp ~order-detail-layout-oob (&key (detail-url :as string))
|
||||
(<> (~oob-header-sx
|
||||
:parent-id "orders-header-child"
|
||||
:row (~menu-row-sx :id "order-row" :level 3 :colour "sky"
|
||||
|
||||
@@ -14,7 +14,7 @@
|
||||
// =========================================================================
|
||||
|
||||
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
|
||||
var SX_VERSION = "2026-03-11T04:41:27Z";
|
||||
var SX_VERSION = "2026-03-11T21:11:04Z";
|
||||
|
||||
function isNil(x) { return x === NIL || x === null || x === undefined; }
|
||||
function isSxTruthy(x) { return x !== false && !isNil(x); }
|
||||
@@ -204,7 +204,7 @@
|
||||
|
||||
// JSON / dict helpers for island state serialization
|
||||
function jsonSerialize(obj) {
|
||||
try { return JSON.stringify(obj); } catch(e) { return "{}"; }
|
||||
return JSON.stringify(obj);
|
||||
}
|
||||
function isEmptyDict(d) {
|
||||
if (!d || typeof d !== "object") return true;
|
||||
@@ -214,11 +214,34 @@
|
||||
|
||||
function envHas(env, name) { return name in env; }
|
||||
function envGet(env, name) { return env[name]; }
|
||||
function envSet(env, name, val) { env[name] = val; }
|
||||
function envSet(env, name, val) {
|
||||
// Walk prototype chain to find where the variable is defined (for set!)
|
||||
var obj = env;
|
||||
while (obj !== null && obj !== Object.prototype) {
|
||||
if (obj.hasOwnProperty(name)) { obj[name] = val; return; }
|
||||
obj = Object.getPrototypeOf(obj);
|
||||
}
|
||||
// Not found in any parent scope — set on the immediate env
|
||||
env[name] = val;
|
||||
}
|
||||
function envExtend(env) { return Object.create(env); }
|
||||
function envMerge(base, overlay) {
|
||||
// Same env or overlay is descendant of base — just extend, no copy.
|
||||
// This prevents set! inside lambdas from modifying shadow copies.
|
||||
if (base === overlay) return Object.create(base);
|
||||
var p = overlay;
|
||||
for (var d = 0; p && p !== Object.prototype && d < 100; d++) {
|
||||
if (p === base) return Object.create(base);
|
||||
p = Object.getPrototypeOf(p);
|
||||
}
|
||||
// General case: extend base, copy ONLY overlay properties that don't
|
||||
// exist in the base chain (avoids shadowing closure bindings).
|
||||
var child = Object.create(base);
|
||||
if (overlay) for (var k in overlay) if (overlay.hasOwnProperty(k)) child[k] = overlay[k];
|
||||
if (overlay) {
|
||||
for (var k in overlay) {
|
||||
if (overlay.hasOwnProperty(k) && !(k in base)) child[k] = overlay[k];
|
||||
}
|
||||
}
|
||||
return child;
|
||||
}
|
||||
|
||||
@@ -252,6 +275,7 @@
|
||||
|
||||
function error(msg) { throw new Error(msg); }
|
||||
function inspect(x) { return JSON.stringify(x); }
|
||||
function debugLog() { console.error.apply(console, ["[sx-debug]"].concat(Array.prototype.slice.call(arguments))); }
|
||||
|
||||
|
||||
|
||||
@@ -332,7 +356,7 @@
|
||||
PRIMITIVES["index-of"] = function(s, needle, from) { return String(s).indexOf(needle, from || 0); };
|
||||
PRIMITIVES["starts-with?"] = function(s, p) { return String(s).indexOf(p) === 0; };
|
||||
PRIMITIVES["ends-with?"] = function(s, p) { var str = String(s); return str.indexOf(p, str.length - p.length) !== -1; };
|
||||
PRIMITIVES["slice"] = function(c, a, b) { return b !== undefined ? c.slice(a, b) : c.slice(a); };
|
||||
PRIMITIVES["slice"] = function(c, a, b) { if (!c || typeof c.slice !== "function") { console.error("[sx-debug] slice called on non-sliceable:", typeof c, c, "a=", a, "b=", b, new Error().stack); return []; } return b !== undefined ? c.slice(a, b) : c.slice(a); };
|
||||
PRIMITIVES["substring"] = function(s, a, b) { return String(s).substring(a, b); };
|
||||
PRIMITIVES["string-length"] = function(s) { return String(s).length; };
|
||||
PRIMITIVES["string-contains?"] = function(s, sub) { return String(s).indexOf(String(sub)) !== -1; };
|
||||
@@ -359,7 +383,7 @@
|
||||
PRIMITIVES["len"] = function(c) { return Array.isArray(c) ? c.length : typeof c === "string" ? c.length : Object.keys(c).length; };
|
||||
PRIMITIVES["first"] = function(c) { return c && c.length > 0 ? c[0] : NIL; };
|
||||
PRIMITIVES["last"] = function(c) { return c && c.length > 0 ? c[c.length - 1] : NIL; };
|
||||
PRIMITIVES["rest"] = function(c) { return c ? c.slice(1) : []; };
|
||||
PRIMITIVES["rest"] = function(c) { if (c && typeof c.slice !== "function") { console.error("[sx-debug] rest called on non-sliceable:", typeof c, c, new Error().stack); return []; } return c ? c.slice(1) : []; };
|
||||
PRIMITIVES["nth"] = function(c, n) { return c && n >= 0 && n < c.length ? c[n] : NIL; };
|
||||
PRIMITIVES["cons"] = function(x, c) { return [x].concat(c || []); };
|
||||
PRIMITIVES["append"] = function(c, x) { return (c || []).concat([x]); };
|
||||
@@ -696,7 +720,7 @@
|
||||
// eval-expr
|
||||
var evalExpr = function(expr, env) { return (function() { var _m = typeOf(expr); if (_m == "number") return expr; if (_m == "string") return expr; if (_m == "boolean") return expr; if (_m == "nil") return NIL; if (_m == "symbol") return (function() {
|
||||
var name = symbolName(expr);
|
||||
return (isSxTruthy(envHas(env, name)) ? envGet(env, name) : (isSxTruthy(isPrimitive(name)) ? getPrimitive(name) : (isSxTruthy((name == "true")) ? true : (isSxTruthy((name == "false")) ? false : (isSxTruthy((name == "nil")) ? NIL : error((String("Undefined symbol: ") + String(name))))))));
|
||||
return (isSxTruthy(envHas(env, name)) ? envGet(env, name) : (isSxTruthy(isPrimitive(name)) ? getPrimitive(name) : (isSxTruthy((name == "true")) ? true : (isSxTruthy((name == "false")) ? false : (isSxTruthy((name == "nil")) ? NIL : (debugLog("Undefined symbol:", name, "primitive?:", isPrimitive(name)), error((String("Undefined symbol: ") + String(name)))))))));
|
||||
})(); if (_m == "keyword") return keywordName(expr); if (_m == "dict") return mapDict(function(k, v) { return trampoline(evalExpr(v, env)); }, expr); if (_m == "list") return (isSxTruthy(isEmpty(expr)) ? [] : evalList(expr, env)); return expr; })(); };
|
||||
|
||||
// eval-list
|
||||
@@ -732,9 +756,9 @@
|
||||
var kwargs = first(parsed);
|
||||
var children = nth(parsed, 1);
|
||||
var local = envMerge(componentClosure(comp), env);
|
||||
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; local[p] = sxOr(dictGet(kwargs, p), NIL); } }
|
||||
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envSet(local, p, sxOr(dictGet(kwargs, p), NIL)); } }
|
||||
if (isSxTruthy(componentHasChildren(comp))) {
|
||||
local["children"] = children;
|
||||
envSet(local, "children", children);
|
||||
}
|
||||
return makeThunk(componentBody(comp), local);
|
||||
})(); };
|
||||
@@ -764,8 +788,11 @@
|
||||
return (isSxTruthy((isSxTruthy(condition) && !isSxTruthy(isNil(condition)))) ? (forEach(function(e) { return trampoline(evalExpr(e, env)); }, slice(args, 1, (len(args) - 1))), makeThunk(last(args), env)) : NIL);
|
||||
})(); };
|
||||
|
||||
// cond-scheme?
|
||||
var condScheme_p = function(clauses) { return isEvery(function(c) { return (isSxTruthy((typeOf(c) == "list")) && (len(c) == 2)); }, clauses); };
|
||||
|
||||
// sf-cond
|
||||
var sfCond = function(args, env) { return (isSxTruthy((isSxTruthy((typeOf(first(args)) == "list")) && (len(first(args)) == 2))) ? sfCondScheme(args, env) : sfCondClojure(args, env)); };
|
||||
var sfCond = function(args, env) { return (isSxTruthy(condScheme_p(args)) ? sfCondScheme(args, env) : sfCondClojure(args, env)); };
|
||||
|
||||
// sf-cond-scheme
|
||||
var sfCondScheme = function(clauses, env) { return (isSxTruthy(isEmpty(clauses)) ? NIL : (function() {
|
||||
@@ -841,7 +868,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var loopBody = (isSxTruthy((len(body) == 1)) ? first(body) : cons(makeSymbol("begin"), body));
|
||||
var loopFn = makeLambda(params, loopBody, env);
|
||||
loopFn.name = loopName;
|
||||
lambdaClosure(loopFn)[loopName] = loopFn;
|
||||
envSet(lambdaClosure(loopFn), loopName, loopFn);
|
||||
return (function() {
|
||||
var initVals = map(function(e) { return trampoline(evalExpr(e, env)); }, inits);
|
||||
return callLambda(loopFn, initVals, env);
|
||||
@@ -854,7 +881,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var paramsExpr = first(args);
|
||||
var bodyExprs = rest(args);
|
||||
var body = (isSxTruthy((len(bodyExprs) == 1)) ? first(bodyExprs) : cons(makeSymbol("begin"), bodyExprs));
|
||||
var paramNames = map(function(p) { return (isSxTruthy((typeOf(p) == "symbol")) ? symbolName(p) : p); }, paramsExpr);
|
||||
var paramNames = map(function(p) { return (isSxTruthy((typeOf(p) == "symbol")) ? symbolName(p) : (isSxTruthy((isSxTruthy((typeOf(p) == "list")) && isSxTruthy((len(p) == 3)) && isSxTruthy((typeOf(nth(p, 1)) == "keyword")) && (keywordName(nth(p, 1)) == "as"))) ? symbolName(first(p)) : p)); }, paramsExpr);
|
||||
return makeLambda(paramNames, body, env);
|
||||
})(); };
|
||||
|
||||
@@ -865,7 +892,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
if (isSxTruthy((isSxTruthy(isLambda(value)) && isNil(lambdaName(value))))) {
|
||||
value.name = symbolName(nameSym);
|
||||
}
|
||||
env[symbolName(nameSym)] = value;
|
||||
envSet(env, symbolName(nameSym), value);
|
||||
return value;
|
||||
})(); };
|
||||
|
||||
@@ -878,10 +905,14 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var parsed = parseCompParams(paramsRaw);
|
||||
var params = first(parsed);
|
||||
var hasChildren = nth(parsed, 1);
|
||||
var paramTypes = nth(parsed, 2);
|
||||
var affinity = defcompKwarg(args, "affinity", "auto");
|
||||
return (function() {
|
||||
var comp = makeComponent(compName, params, hasChildren, body, env, affinity);
|
||||
env[symbolName(nameSym)] = comp;
|
||||
if (isSxTruthy((isSxTruthy(!isSxTruthy(isNil(paramTypes))) && !isSxTruthy(isEmpty(keys(paramTypes)))))) {
|
||||
componentSetParamTypes_b(comp, paramTypes);
|
||||
}
|
||||
envSet(env, symbolName(nameSym), comp);
|
||||
return comp;
|
||||
})();
|
||||
})(); };
|
||||
@@ -902,15 +933,21 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
// parse-comp-params
|
||||
var parseCompParams = function(paramsExpr) { return (function() {
|
||||
var params = [];
|
||||
var paramTypes = {};
|
||||
var hasChildren = false;
|
||||
var inKey = false;
|
||||
{ var _c = paramsExpr; for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; if (isSxTruthy((typeOf(p) == "symbol"))) {
|
||||
(function() {
|
||||
{ var _c = paramsExpr; for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; (isSxTruthy((isSxTruthy((typeOf(p) == "list")) && isSxTruthy((len(p) == 3)) && isSxTruthy((typeOf(first(p)) == "symbol")) && isSxTruthy((typeOf(nth(p, 1)) == "keyword")) && (keywordName(nth(p, 1)) == "as"))) ? (function() {
|
||||
var name = symbolName(first(p));
|
||||
var ptype = nth(p, 2);
|
||||
return (function() {
|
||||
var typeVal = (isSxTruthy((typeOf(ptype) == "symbol")) ? symbolName(ptype) : ptype);
|
||||
return (isSxTruthy(!isSxTruthy(hasChildren)) ? (append_b(params, name), dictSet(paramTypes, name, typeVal)) : NIL);
|
||||
})();
|
||||
})() : (isSxTruthy((typeOf(p) == "symbol")) ? (function() {
|
||||
var name = symbolName(p);
|
||||
return (isSxTruthy((name == "&key")) ? (inKey = true) : (isSxTruthy((name == "&rest")) ? (hasChildren = true) : (isSxTruthy((name == "&children")) ? (hasChildren = true) : (isSxTruthy(hasChildren) ? NIL : (isSxTruthy(inKey) ? append_b(params, name) : append_b(params, name))))));
|
||||
})();
|
||||
} } }
|
||||
return [params, hasChildren];
|
||||
})() : NIL)); } }
|
||||
return [params, hasChildren, paramTypes];
|
||||
})(); };
|
||||
|
||||
// sf-defisland
|
||||
@@ -924,7 +961,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var hasChildren = nth(parsed, 1);
|
||||
return (function() {
|
||||
var island = makeIsland(compName, params, hasChildren, body, env);
|
||||
env[symbolName(nameSym)] = island;
|
||||
envSet(env, symbolName(nameSym), island);
|
||||
return island;
|
||||
})();
|
||||
})(); };
|
||||
@@ -939,7 +976,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var restParam = nth(parsed, 1);
|
||||
return (function() {
|
||||
var mac = makeMacro(params, restParam, body, env, symbolName(nameSym));
|
||||
env[symbolName(nameSym)] = mac;
|
||||
envSet(env, symbolName(nameSym), mac);
|
||||
return mac;
|
||||
})();
|
||||
})(); };
|
||||
@@ -956,7 +993,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var sfDefstyle = function(args, env) { return (function() {
|
||||
var nameSym = first(args);
|
||||
var value = trampoline(evalExpr(nth(args, 1), env));
|
||||
env[symbolName(nameSym)] = value;
|
||||
envSet(env, symbolName(nameSym), value);
|
||||
return value;
|
||||
})(); };
|
||||
|
||||
@@ -974,8 +1011,8 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var head = first(template);
|
||||
return (isSxTruthy((isSxTruthy((typeOf(head) == "symbol")) && (symbolName(head) == "unquote"))) ? trampoline(evalExpr(nth(template, 1), env)) : reduce(function(result, item) { return (isSxTruthy((isSxTruthy((typeOf(item) == "list")) && isSxTruthy((len(item) == 2)) && isSxTruthy((typeOf(first(item)) == "symbol")) && (symbolName(first(item)) == "splice-unquote"))) ? (function() {
|
||||
var spliced = trampoline(evalExpr(nth(item, 1), env));
|
||||
return (isSxTruthy((typeOf(spliced) == "list")) ? concat(result, spliced) : (isSxTruthy(isNil(spliced)) ? result : append(result, spliced)));
|
||||
})() : append(result, qqExpand(item, env))); }, [], template));
|
||||
return (isSxTruthy((typeOf(spliced) == "list")) ? concat(result, spliced) : (isSxTruthy(isNil(spliced)) ? result : concat(result, [spliced])));
|
||||
})() : concat(result, [qqExpand(item, env)])); }, [], template));
|
||||
})())); };
|
||||
|
||||
// sf-thread-first
|
||||
@@ -996,7 +1033,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
var sfSetBang = function(args, env) { return (function() {
|
||||
var name = symbolName(first(args));
|
||||
var value = trampoline(evalExpr(nth(args, 1), env));
|
||||
env[name] = value;
|
||||
envSet(env, name, value);
|
||||
return value;
|
||||
})(); };
|
||||
|
||||
@@ -1021,7 +1058,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
})(); }, NIL, range(0, (len(bindings) / 2))));
|
||||
(function() {
|
||||
var values = map(function(e) { return trampoline(evalExpr(e, local)); }, valExprs);
|
||||
{ var _c = zip(names, values); for (var _i = 0; _i < _c.length; _i++) { var pair = _c[_i]; local[first(pair)] = nth(pair, 1); } }
|
||||
{ var _c = zip(names, values); for (var _i = 0; _i < _c.length; _i++) { var pair = _c[_i]; envSet(local, first(pair), nth(pair, 1)); } }
|
||||
return forEach(function(val) { return (isSxTruthy(isLambda(val)) ? forEach(function(n) { return envSet(lambdaClosure(val), n, envGet(local, n)); }, names) : NIL); }, values);
|
||||
})();
|
||||
{ var _c = slice(body, 0, (len(body) - 1)); for (var _i = 0; _i < _c.length; _i++) { var e = _c[_i]; trampoline(evalExpr(e, local)); } }
|
||||
@@ -1046,9 +1083,9 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
// expand-macro
|
||||
var expandMacro = function(mac, rawArgs, env) { return (function() {
|
||||
var local = envMerge(macroClosure(mac), env);
|
||||
{ var _c = mapIndexed(function(i, p) { return [p, i]; }, macroParams(mac)); for (var _i = 0; _i < _c.length; _i++) { var pair = _c[_i]; local[first(pair)] = (isSxTruthy((nth(pair, 1) < len(rawArgs))) ? nth(rawArgs, nth(pair, 1)) : NIL); } }
|
||||
{ var _c = mapIndexed(function(i, p) { return [p, i]; }, macroParams(mac)); for (var _i = 0; _i < _c.length; _i++) { var pair = _c[_i]; envSet(local, first(pair), (isSxTruthy((nth(pair, 1) < len(rawArgs))) ? nth(rawArgs, nth(pair, 1)) : NIL)); } }
|
||||
if (isSxTruthy(macroRestParam(mac))) {
|
||||
local[macroRestParam(mac)] = slice(rawArgs, len(macroParams(mac)));
|
||||
envSet(local, macroRestParam(mac), slice(rawArgs, len(macroParams(mac))));
|
||||
}
|
||||
return trampoline(evalExpr(macroBody(mac), local));
|
||||
})(); };
|
||||
@@ -1143,7 +1180,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
})(); }, keys(attrs))); };
|
||||
|
||||
// eval-cond
|
||||
var evalCond = function(clauses, env) { return (isSxTruthy((isSxTruthy(!isSxTruthy(isEmpty(clauses))) && isSxTruthy((typeOf(first(clauses)) == "list")) && (len(first(clauses)) == 2))) ? evalCondScheme(clauses, env) : evalCondClojure(clauses, env)); };
|
||||
var evalCond = function(clauses, env) { return (isSxTruthy(condScheme_p(clauses)) ? evalCondScheme(clauses, env) : evalCondClojure(clauses, env)); };
|
||||
|
||||
// eval-cond-scheme
|
||||
var evalCondScheme = function(clauses, env) { return (isSxTruthy(isEmpty(clauses)) ? NIL : (function() {
|
||||
@@ -1162,7 +1199,7 @@ return append_b(inits, nth(binding, 1)); }, bindings) : reduce(function(acc, pai
|
||||
|
||||
// process-bindings
|
||||
var processBindings = function(bindings, env) { return (function() {
|
||||
var local = merge(env);
|
||||
var local = envExtend(env);
|
||||
{ var _c = bindings; for (var _i = 0; _i < _c.length; _i++) { var pair = _c[_i]; if (isSxTruthy((isSxTruthy((typeOf(pair) == "list")) && (len(pair) >= 2)))) {
|
||||
(function() {
|
||||
var name = (isSxTruthy((typeOf(first(pair)) == "symbol")) ? symbolName(first(pair)) : (String(first(pair))));
|
||||
@@ -1392,9 +1429,9 @@ return (function() { var _m = typeOf(expr); if (_m == "nil") return ""; if (_m =
|
||||
})(); }, {["i"]: 0, ["skip"]: false}, args);
|
||||
return (function() {
|
||||
var local = envMerge(componentClosure(comp), env);
|
||||
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; local[p] = (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL); } }
|
||||
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envSet(local, p, (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL)); } }
|
||||
if (isSxTruthy(componentHasChildren(comp))) {
|
||||
local["children"] = makeRawHtml(join("", map(function(c) { return renderToHtml(c, env); }, children)));
|
||||
envSet(local, "children", makeRawHtml(join("", map(function(c) { return renderToHtml(c, env); }, children))));
|
||||
}
|
||||
return renderToHtml(componentBody(comp), local);
|
||||
})();
|
||||
@@ -1458,20 +1495,20 @@ return (function() { var _m = typeOf(expr); if (_m == "nil") return ""; if (_m =
|
||||
return (function() {
|
||||
var local = envMerge(componentClosure(island), env);
|
||||
var islandName = componentName(island);
|
||||
{ var _c = componentParams(island); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; local[p] = (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL); } }
|
||||
{ var _c = componentParams(island); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envSet(local, p, (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL)); } }
|
||||
if (isSxTruthy(componentHasChildren(island))) {
|
||||
local["children"] = makeRawHtml(join("", map(function(c) { return renderToHtml(c, env); }, children)));
|
||||
envSet(local, "children", makeRawHtml(join("", map(function(c) { return renderToHtml(c, env); }, children))));
|
||||
}
|
||||
return (function() {
|
||||
var bodyHtml = renderToHtml(componentBody(island), local);
|
||||
var stateJson = serializeIslandState(kwargs);
|
||||
return (String("<span data-sx-island=\"") + String(escapeAttr(islandName)) + String("\"") + String((isSxTruthy(stateJson) ? (String(" data-sx-state=\"") + String(escapeAttr(stateJson)) + String("\"")) : "")) + String(">") + String(bodyHtml) + String("</span>"));
|
||||
var stateSx = serializeIslandState(kwargs);
|
||||
return (String("<span data-sx-island=\"") + String(escapeAttr(islandName)) + String("\"") + String((isSxTruthy(stateSx) ? (String(" data-sx-state=\"") + String(escapeAttr(stateSx)) + String("\"")) : "")) + String(">") + String(bodyHtml) + String("</span>"));
|
||||
})();
|
||||
})();
|
||||
})(); };
|
||||
|
||||
// serialize-island-state
|
||||
var serializeIslandState = function(kwargs) { return (isSxTruthy(isEmptyDict(kwargs)) ? NIL : jsonSerialize(kwargs)); };
|
||||
var serializeIslandState = function(kwargs) { return (isSxTruthy(isEmptyDict(kwargs)) ? NIL : sxSerialize(kwargs)); };
|
||||
|
||||
|
||||
// === Transpiled from adapter-sx ===
|
||||
@@ -1505,30 +1542,34 @@ return (function() { var _m = typeOf(expr); if (_m == "number") return expr; if
|
||||
|
||||
// aser-fragment
|
||||
var aserFragment = function(children, env) { return (function() {
|
||||
var parts = filter(function(x) { return !isSxTruthy(isNil(x)); }, map(function(c) { return aser(c, env); }, children));
|
||||
return (isSxTruthy(isEmpty(parts)) ? "" : (String("(<> ") + String(join(" ", map(serialize, parts))) + String(")")));
|
||||
var parts = [];
|
||||
{ var _c = children; for (var _i = 0; _i < _c.length; _i++) { var c = _c[_i]; (function() {
|
||||
var result = aser(c, env);
|
||||
return (isSxTruthy((typeOf(result) == "list")) ? forEach(function(item) { return (isSxTruthy(!isSxTruthy(isNil(item))) ? append_b(parts, serialize(item)) : NIL); }, result) : (isSxTruthy(!isSxTruthy(isNil(result))) ? append_b(parts, serialize(result)) : NIL));
|
||||
})(); } }
|
||||
return (isSxTruthy(isEmpty(parts)) ? "" : (String("(<> ") + String(join(" ", parts)) + String(")")));
|
||||
})(); };
|
||||
|
||||
// aser-call
|
||||
var aserCall = function(name, args, env) { return (function() {
|
||||
var parts = [name];
|
||||
reduce(function(state, arg) { return (function() {
|
||||
var skip = get(state, "skip");
|
||||
return (isSxTruthy(skip) ? assoc(state, "skip", false, "i", (get(state, "i") + 1)) : (isSxTruthy((isSxTruthy((typeOf(arg) == "keyword")) && ((get(state, "i") + 1) < len(args)))) ? (function() {
|
||||
var val = aser(nth(args, (get(state, "i") + 1)), env);
|
||||
var skip = false;
|
||||
var i = 0;
|
||||
{ var _c = args; for (var _i = 0; _i < _c.length; _i++) { var arg = _c[_i]; (isSxTruthy(skip) ? ((skip = false), (i = (i + 1))) : (isSxTruthy((isSxTruthy((typeOf(arg) == "keyword")) && ((i + 1) < len(args)))) ? (function() {
|
||||
var val = aser(nth(args, (i + 1)), env);
|
||||
if (isSxTruthy(!isSxTruthy(isNil(val)))) {
|
||||
parts.push((String(":") + String(keywordName(arg))));
|
||||
parts.push(serialize(val));
|
||||
}
|
||||
return assoc(state, "skip", true, "i", (get(state, "i") + 1));
|
||||
skip = true;
|
||||
return (i = (i + 1));
|
||||
})() : (function() {
|
||||
var val = aser(arg, env);
|
||||
if (isSxTruthy(!isSxTruthy(isNil(val)))) {
|
||||
parts.push(serialize(val));
|
||||
(isSxTruthy((typeOf(val) == "list")) ? forEach(function(item) { return (isSxTruthy(!isSxTruthy(isNil(item))) ? append_b(parts, serialize(item)) : NIL); }, val) : append_b(parts, serialize(val)));
|
||||
}
|
||||
return assoc(state, "i", (get(state, "i") + 1));
|
||||
})()));
|
||||
})(); }, {["i"]: 0, ["skip"]: false}, args);
|
||||
return (i = (i + 1));
|
||||
})())); } }
|
||||
return (String("(") + String(join(" ", parts)) + String(")"));
|
||||
})(); };
|
||||
|
||||
@@ -1582,7 +1623,7 @@ return result; }, args);
|
||||
var coll = trampoline(evalExpr(nth(args, 1), env));
|
||||
return map(function(item) { return (isSxTruthy(isLambda(f)) ? (function() {
|
||||
var local = envMerge(lambdaClosure(f), env);
|
||||
local[first(lambdaParams(f))] = item;
|
||||
envSet(local, first(lambdaParams(f)), item);
|
||||
return aser(lambdaBody(f), local);
|
||||
})() : invoke(f, item)); }, coll);
|
||||
})() : (isSxTruthy((name == "map-indexed")) ? (function() {
|
||||
@@ -1590,8 +1631,8 @@ return result; }, args);
|
||||
var coll = trampoline(evalExpr(nth(args, 1), env));
|
||||
return mapIndexed(function(i, item) { return (isSxTruthy(isLambda(f)) ? (function() {
|
||||
var local = envMerge(lambdaClosure(f), env);
|
||||
local[first(lambdaParams(f))] = i;
|
||||
local[nth(lambdaParams(f), 1)] = item;
|
||||
envSet(local, first(lambdaParams(f)), i);
|
||||
envSet(local, nth(lambdaParams(f), 1), item);
|
||||
return aser(lambdaBody(f), local);
|
||||
})() : invoke(f, i, item)); }, coll);
|
||||
})() : (isSxTruthy((name == "for-each")) ? (function() {
|
||||
@@ -1600,7 +1641,7 @@ return result; }, args);
|
||||
var results = [];
|
||||
{ var _c = coll; for (var _i = 0; _i < _c.length; _i++) { var item = _c[_i]; (isSxTruthy(isLambda(f)) ? (function() {
|
||||
var local = envMerge(lambdaClosure(f), env);
|
||||
local[first(lambdaParams(f))] = item;
|
||||
envSet(local, first(lambdaParams(f)), item);
|
||||
return append_b(results, aser(lambdaBody(f), local));
|
||||
})() : invoke(f, item)); } }
|
||||
return (isSxTruthy(isEmpty(results)) ? NIL : results);
|
||||
@@ -1692,7 +1733,7 @@ return (function() { var _m = typeOf(expr); if (_m == "nil") return createFragme
|
||||
})(); }, {["i"]: 0, ["skip"]: false}, args);
|
||||
return (function() {
|
||||
var local = envMerge(componentClosure(comp), env);
|
||||
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; local[p] = (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL); } }
|
||||
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envSet(local, p, (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL)); } }
|
||||
if (isSxTruthy(componentHasChildren(comp))) {
|
||||
(function() {
|
||||
var childFrag = createFragment();
|
||||
@@ -1883,7 +1924,7 @@ return (function() { var _m = typeOf(expr); if (_m == "nil") return createFragme
|
||||
return (function() {
|
||||
var local = envMerge(componentClosure(island), env);
|
||||
var islandName = componentName(island);
|
||||
{ var _c = componentParams(island); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; local[p] = (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL); } }
|
||||
{ var _c = componentParams(island); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envSet(local, p, (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL)); } }
|
||||
if (isSxTruthy(componentHasChildren(island))) {
|
||||
(function() {
|
||||
var childFrag = createFragment();
|
||||
@@ -2998,9 +3039,9 @@ return postSwap(target); }))) : NIL);
|
||||
var exprs = sxParse(body);
|
||||
return domListen(el, eventName, function(e) { return (function() {
|
||||
var handlerEnv = envExtend({});
|
||||
handlerEnv["event"] = e;
|
||||
handlerEnv["this"] = el;
|
||||
handlerEnv["detail"] = eventDetail(e);
|
||||
envSet(handlerEnv, "event", e);
|
||||
envSet(handlerEnv, "this", el);
|
||||
envSet(handlerEnv, "detail", eventDetail(e));
|
||||
return forEach(function(expr) { return evalExpr(expr, handlerEnv); }, exprs);
|
||||
})(); });
|
||||
})()) : NIL);
|
||||
@@ -3229,17 +3270,17 @@ callExpr.push(dictGet(kwargs, k)); } }
|
||||
// hydrate-island
|
||||
var hydrateIsland = function(el) { return (function() {
|
||||
var name = domGetAttr(el, "data-sx-island");
|
||||
var stateJson = sxOr(domGetAttr(el, "data-sx-state"), "{}");
|
||||
var stateSx = sxOr(domGetAttr(el, "data-sx-state"), "{}");
|
||||
return (function() {
|
||||
var compName = (String("~") + String(name));
|
||||
var env = getRenderEnv(NIL);
|
||||
return (function() {
|
||||
var comp = envGet(env, compName);
|
||||
return (isSxTruthy(!isSxTruthy(sxOr(isComponent(comp), isIsland(comp)))) ? logWarn((String("hydrate-island: unknown island ") + String(compName))) : (function() {
|
||||
var kwargs = jsonParse(stateJson);
|
||||
var kwargs = sxOr(first(sxParse(stateSx)), {});
|
||||
var disposers = [];
|
||||
var local = envMerge(componentClosure(comp), env);
|
||||
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; local[p] = (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL); } }
|
||||
{ var _c = componentParams(comp); for (var _i = 0; _i < _c.length; _i++) { var p = _c[_i]; envSet(local, p, (isSxTruthy(dictHas(kwargs, p)) ? dictGet(kwargs, p) : NIL)); } }
|
||||
return (function() {
|
||||
var bodyDom = withIslandScope(function(disposable) { return append_b(disposers, disposable); }, function() { return renderToDom(componentBody(comp), local, NIL); });
|
||||
domSetTextContent(el, "");
|
||||
@@ -3433,6 +3474,125 @@ callExpr.push(dictGet(kwargs, k)); } }
|
||||
})(); }, keys(env)); };
|
||||
|
||||
|
||||
// === Transpiled from page-helpers (pure data transformation helpers) ===
|
||||
|
||||
// special-form-category-map
|
||||
var specialFormCategoryMap = {"if": "Control Flow", "when": "Control Flow", "cond": "Control Flow", "case": "Control Flow", "and": "Control Flow", "or": "Control Flow", "let": "Binding", "let*": "Binding", "letrec": "Binding", "define": "Binding", "set!": "Binding", "lambda": "Functions & Components", "fn": "Functions & Components", "defcomp": "Functions & Components", "defmacro": "Functions & Components", "begin": "Sequencing & Threading", "do": "Sequencing & Threading", "->": "Sequencing & Threading", "quote": "Quoting", "quasiquote": "Quoting", "reset": "Continuations", "shift": "Continuations", "dynamic-wind": "Guards", "map": "Higher-Order Forms", "map-indexed": "Higher-Order Forms", "filter": "Higher-Order Forms", "reduce": "Higher-Order Forms", "some": "Higher-Order Forms", "every?": "Higher-Order Forms", "for-each": "Higher-Order Forms", "defstyle": "Domain Definitions", "defhandler": "Domain Definitions", "defpage": "Domain Definitions", "defquery": "Domain Definitions", "defaction": "Domain Definitions"};
|
||||
|
||||
// extract-define-kwargs
|
||||
var extractDefineKwargs = function(expr) { return (function() {
|
||||
var result = {};
|
||||
var items = slice(expr, 2);
|
||||
var n = len(items);
|
||||
{ var _c = range(0, n); for (var _i = 0; _i < _c.length; _i++) { var idx = _c[_i]; if (isSxTruthy((isSxTruthy(((idx + 1) < n)) && (typeOf(nth(items, idx)) == "keyword")))) {
|
||||
(function() {
|
||||
var key = keywordName(nth(items, idx));
|
||||
var val = nth(items, (idx + 1));
|
||||
return dictSet(result, key, (isSxTruthy((typeOf(val) == "list")) ? (String("(") + String(join(" ", map(serialize, val))) + String(")")) : (String(val))));
|
||||
})();
|
||||
} } }
|
||||
return result;
|
||||
})(); };
|
||||
|
||||
// categorize-special-forms
|
||||
var categorizeSpecialForms = function(parsedExprs) { return (function() {
|
||||
var categories = {};
|
||||
{ var _c = parsedExprs; for (var _i = 0; _i < _c.length; _i++) { var expr = _c[_i]; if (isSxTruthy((isSxTruthy((typeOf(expr) == "list")) && isSxTruthy((len(expr) >= 2)) && isSxTruthy((typeOf(first(expr)) == "symbol")) && (symbolName(first(expr)) == "define-special-form")))) {
|
||||
(function() {
|
||||
var name = nth(expr, 1);
|
||||
var kwargs = extractDefineKwargs(expr);
|
||||
var category = sxOr(get(specialFormCategoryMap, name), "Other");
|
||||
if (isSxTruthy(!isSxTruthy(dictHas(categories, category)))) {
|
||||
categories[category] = [];
|
||||
}
|
||||
return append_b(get(categories, category), {"name": name, "syntax": sxOr(get(kwargs, "syntax"), ""), "doc": sxOr(get(kwargs, "doc"), ""), "tail-position": sxOr(get(kwargs, "tail-position"), ""), "example": sxOr(get(kwargs, "example"), "")});
|
||||
})();
|
||||
} } }
|
||||
return categories;
|
||||
})(); };
|
||||
|
||||
// build-ref-items-with-href
|
||||
var buildRefItemsWithHref = function(items, basePath, detailKeys, nFields) { return map(function(item) { return (isSxTruthy((nFields == 3)) ? (function() {
|
||||
var name = nth(item, 0);
|
||||
var field2 = nth(item, 1);
|
||||
var field3 = nth(item, 2);
|
||||
return {"name": name, "desc": field2, "exists": field3, "href": (isSxTruthy((isSxTruthy(field3) && some(function(k) { return (k == name); }, detailKeys))) ? (String(basePath) + String(name)) : NIL)};
|
||||
})() : (function() {
|
||||
var name = nth(item, 0);
|
||||
var desc = nth(item, 1);
|
||||
return {"name": name, "desc": desc, "href": (isSxTruthy(some(function(k) { return (k == name); }, detailKeys)) ? (String(basePath) + String(name)) : NIL)};
|
||||
})()); }, items); };
|
||||
|
||||
// build-reference-data
|
||||
var buildReferenceData = function(slug, rawData, detailKeys) { return (function() { var _m = slug; if (_m == "attributes") return {"req-attrs": buildRefItemsWithHref(get(rawData, "req-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3), "beh-attrs": buildRefItemsWithHref(get(rawData, "beh-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3), "uniq-attrs": buildRefItemsWithHref(get(rawData, "uniq-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3)}; if (_m == "headers") return {"req-headers": buildRefItemsWithHref(get(rawData, "req-headers"), "/geography/hypermedia/reference/headers/", detailKeys, 3), "resp-headers": buildRefItemsWithHref(get(rawData, "resp-headers"), "/geography/hypermedia/reference/headers/", detailKeys, 3)}; if (_m == "events") return {"events-list": buildRefItemsWithHref(get(rawData, "events-list"), "/geography/hypermedia/reference/events/", detailKeys, 2)}; if (_m == "js-api") return {"js-api-list": map(function(item) { return {"name": nth(item, 0), "desc": nth(item, 1)}; }, get(rawData, "js-api-list"))}; return {"req-attrs": buildRefItemsWithHref(get(rawData, "req-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3), "beh-attrs": buildRefItemsWithHref(get(rawData, "beh-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3), "uniq-attrs": buildRefItemsWithHref(get(rawData, "uniq-attrs"), "/geography/hypermedia/reference/attributes/", detailKeys, 3)}; })(); };
|
||||
|
||||
// build-attr-detail
|
||||
var buildAttrDetail = function(slug, detail) { return (isSxTruthy(isNil(detail)) ? {"attr-not-found": true} : {"attr-not-found": NIL, "attr-title": slug, "attr-description": get(detail, "description"), "attr-example": get(detail, "example"), "attr-handler": get(detail, "handler"), "attr-demo": get(detail, "demo"), "attr-wire-id": (isSxTruthy(dictHas(detail, "handler")) ? (String("ref-wire-") + String(replace_(replace_(slug, ":", "-"), "*", "star"))) : NIL)}); };
|
||||
|
||||
// build-header-detail
|
||||
var buildHeaderDetail = function(slug, detail) { return (isSxTruthy(isNil(detail)) ? {"header-not-found": true} : {"header-not-found": NIL, "header-title": slug, "header-direction": get(detail, "direction"), "header-description": get(detail, "description"), "header-example": get(detail, "example"), "header-demo": get(detail, "demo")}); };
|
||||
|
||||
// build-event-detail
|
||||
var buildEventDetail = function(slug, detail) { return (isSxTruthy(isNil(detail)) ? {"event-not-found": true} : {"event-not-found": NIL, "event-title": slug, "event-description": get(detail, "description"), "event-example": get(detail, "example"), "event-demo": get(detail, "demo")}); };
|
||||
|
||||
// build-component-source
|
||||
var buildComponentSource = function(compData) { return (function() {
|
||||
var compType = get(compData, "type");
|
||||
var name = get(compData, "name");
|
||||
var params = get(compData, "params");
|
||||
var hasChildren = get(compData, "has-children");
|
||||
var bodySx = get(compData, "body-sx");
|
||||
var affinity = get(compData, "affinity");
|
||||
return (isSxTruthy((compType == "not-found")) ? (String(";; component ") + String(name) + String(" not found")) : (function() {
|
||||
var paramStrs = (isSxTruthy(isEmpty(params)) ? (isSxTruthy(hasChildren) ? ["&rest", "children"] : []) : (isSxTruthy(hasChildren) ? append(cons("&key", params), ["&rest", "children"]) : cons("&key", params)));
|
||||
var paramsSx = (String("(") + String(join(" ", paramStrs)) + String(")"));
|
||||
var formName = (isSxTruthy((compType == "island")) ? "defisland" : "defcomp");
|
||||
var affinityStr = (isSxTruthy((isSxTruthy((compType == "component")) && isSxTruthy(!isSxTruthy(isNil(affinity))) && !isSxTruthy((affinity == "auto")))) ? (String(" :affinity ") + String(affinity)) : "");
|
||||
return (String("(") + String(formName) + String(" ") + String(name) + String(" ") + String(paramsSx) + String(affinityStr) + String("\n ") + String(bodySx) + String(")"));
|
||||
})());
|
||||
})(); };
|
||||
|
||||
// build-bundle-analysis
|
||||
var buildBundleAnalysis = function(pagesRaw, componentsRaw, totalComponents, totalMacros, pureCount, ioCount) { return (function() {
|
||||
var pagesData = [];
|
||||
{ var _c = pagesRaw; for (var _i = 0; _i < _c.length; _i++) { var page = _c[_i]; (function() {
|
||||
var neededNames = get(page, "needed-names");
|
||||
var n = len(neededNames);
|
||||
var pct = (isSxTruthy((totalComponents > 0)) ? round(((n / totalComponents) * 100)) : 0);
|
||||
var savings = (100 - pct);
|
||||
var pureInPage = 0;
|
||||
var ioInPage = 0;
|
||||
var pageIoRefs = [];
|
||||
var compDetails = [];
|
||||
{ var _c = neededNames; for (var _i = 0; _i < _c.length; _i++) { var compName = _c[_i]; (function() {
|
||||
var info = get(componentsRaw, compName);
|
||||
return (isSxTruthy(!isSxTruthy(isNil(info))) ? ((isSxTruthy(get(info, "is-pure")) ? (pureInPage = (pureInPage + 1)) : ((ioInPage = (ioInPage + 1)), forEach(function(ref) { return (isSxTruthy(!isSxTruthy(some(function(r) { return (r == ref); }, pageIoRefs))) ? append_b(pageIoRefs, ref) : NIL); }, sxOr(get(info, "io-refs"), [])))), append_b(compDetails, {"name": compName, "is-pure": get(info, "is-pure"), "affinity": get(info, "affinity"), "render-target": get(info, "render-target"), "io-refs": sxOr(get(info, "io-refs"), []), "deps": sxOr(get(info, "deps"), []), "source": get(info, "source")})) : NIL);
|
||||
})(); } }
|
||||
return append_b(pagesData, {"name": get(page, "name"), "path": get(page, "path"), "direct": get(page, "direct"), "needed": n, "pct": pct, "savings": savings, "io-refs": len(pageIoRefs), "pure-in-page": pureInPage, "io-in-page": ioInPage, "components": compDetails});
|
||||
})(); } }
|
||||
return {"pages": pagesData, "total-components": totalComponents, "total-macros": totalMacros, "pure-count": pureCount, "io-count": ioCount};
|
||||
})(); };
|
||||
|
||||
// build-routing-analysis
|
||||
var buildRoutingAnalysis = function(pagesRaw) { return (function() {
|
||||
var pagesData = [];
|
||||
var clientCount = 0;
|
||||
var serverCount = 0;
|
||||
{ var _c = pagesRaw; for (var _i = 0; _i < _c.length; _i++) { var page = _c[_i]; (function() {
|
||||
var hasData = get(page, "has-data");
|
||||
var contentSrc = sxOr(get(page, "content-src"), "");
|
||||
var mode = NIL;
|
||||
var reason = "";
|
||||
(isSxTruthy(hasData) ? ((mode = "server"), (reason = "Has :data expression — needs server IO"), (serverCount = (serverCount + 1))) : (isSxTruthy(isEmpty(contentSrc)) ? ((mode = "server"), (reason = "No content expression"), (serverCount = (serverCount + 1))) : ((mode = "client"), (clientCount = (clientCount + 1)))));
|
||||
return append_b(pagesData, {"name": get(page, "name"), "path": get(page, "path"), "mode": mode, "has-data": hasData, "content-expr": (isSxTruthy((len(contentSrc) > 80)) ? (String(slice(contentSrc, 0, 80)) + String("...")) : contentSrc), "reason": reason});
|
||||
})(); } }
|
||||
return {"pages": pagesData, "total-pages": (clientCount + serverCount), "client-count": clientCount, "server-count": serverCount};
|
||||
})(); };
|
||||
|
||||
// build-affinity-analysis
|
||||
var buildAffinityAnalysis = function(demoComponents, pagePlans) { return {"components": demoComponents, "page-plans": pagePlans}; };
|
||||
|
||||
|
||||
// === Transpiled from router (client-side route matching) ===
|
||||
|
||||
// split-path-segments
|
||||
@@ -3835,6 +3995,26 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
|
||||
function domGetProp(el, name) { return el ? el[name] : NIL; }
|
||||
function domSetProp(el, name, val) { if (el) el[name] = val; }
|
||||
// Call a method on an object with correct this binding: (dom-call-method obj "methodName" arg1 arg2 ...)
|
||||
function domCallMethod() {
|
||||
var obj = arguments[0], method = arguments[1];
|
||||
var args = Array.prototype.slice.call(arguments, 2);
|
||||
if (obj && typeof obj[method] === 'function') {
|
||||
try { return obj[method].apply(obj, args); }
|
||||
catch(e) { console.error("[sx] dom-call-method error:", e); return NIL; }
|
||||
}
|
||||
return NIL;
|
||||
}
|
||||
// Post a message to an iframe's contentWindow without exposing the cross-origin
|
||||
// Window object to the SX evaluator (which would trigger _thunk access errors).
|
||||
function domPostMessage(iframe, msg, origin) {
|
||||
try {
|
||||
if (iframe && iframe.contentWindow) {
|
||||
iframe.contentWindow.postMessage(msg, origin || '*');
|
||||
}
|
||||
} catch(e) { console.error("[sx] domPostMessage error:", e); }
|
||||
return NIL;
|
||||
}
|
||||
|
||||
function domAddClass(el, cls) {
|
||||
if (el && el.classList) el.classList.add(cls);
|
||||
@@ -3853,8 +4033,11 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
function domListen(el, name, handler) {
|
||||
if (!_hasDom || !el) return function() {};
|
||||
// Wrap SX lambdas from runtime-evaluated island code into native fns
|
||||
// If lambda takes 0 params, call without event arg (convenience for on-click handlers)
|
||||
var wrapped = isLambda(handler)
|
||||
? function(e) { try { invoke(handler, e); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } }
|
||||
? (lambdaParams(handler).length === 0
|
||||
? function(e) { try { invoke(handler); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } }
|
||||
: function(e) { try { invoke(handler, e); } catch(err) { console.error("[sx-ref] domListen handler error:", name, err); } })
|
||||
: handler;
|
||||
if (name === "click") logInfo("domListen: click on <" + (el.tagName||"?").toLowerCase() + "> text=" + (el.textContent||"").substring(0,20) + " isLambda=" + isLambda(handler));
|
||||
el.addEventListener(name, wrapped);
|
||||
@@ -3947,7 +4130,7 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
}
|
||||
}
|
||||
|
||||
function nowMs() { return Date.now(); }
|
||||
function nowMs() { return (typeof performance !== "undefined") ? performance.now() : Date.now(); }
|
||||
|
||||
function parseHeaderValue(s) {
|
||||
if (!s) return null;
|
||||
@@ -5036,6 +5219,9 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
PRIMITIVES["dom-focus"] = domFocus;
|
||||
PRIMITIVES["dom-tag-name"] = domTagName;
|
||||
PRIMITIVES["dom-get-prop"] = domGetProp;
|
||||
PRIMITIVES["dom-set-prop"] = domSetProp;
|
||||
PRIMITIVES["dom-call-method"] = domCallMethod;
|
||||
PRIMITIVES["dom-post-message"] = domPostMessage;
|
||||
PRIMITIVES["stop-propagation"] = stopPropagation_;
|
||||
PRIMITIVES["error-message"] = errorMessage;
|
||||
PRIMITIVES["schedule-idle"] = scheduleIdle;
|
||||
@@ -5060,6 +5246,11 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
if (typeof elementValue === "function") PRIMITIVES["element-value"] = elementValue;
|
||||
if (typeof domOuterHtml === "function") PRIMITIVES["dom-outer-html"] = domOuterHtml;
|
||||
if (typeof domInnerHtml === "function") PRIMITIVES["dom-inner-html"] = domInnerHtml;
|
||||
if (typeof domTextContent === "function") PRIMITIVES["dom-text-content"] = domTextContent;
|
||||
if (typeof jsonParse === "function") PRIMITIVES["json-parse"] = jsonParse;
|
||||
if (typeof nowMs === "function") PRIMITIVES["now-ms"] = nowMs;
|
||||
PRIMITIVES["sx-parse"] = sxParse;
|
||||
PRIMITIVES["console-log"] = function() { console.log.apply(console, ["[sx]"].concat(Array.prototype.slice.call(arguments))); return arguments.length > 0 ? arguments[0] : NIL; };
|
||||
|
||||
// Expose deps module functions as primitives so runtime-evaluated SX code
|
||||
// (e.g. test-deps.sx in browser) can call them
|
||||
@@ -5090,6 +5281,19 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
PRIMITIVES["render-target"] = renderTarget;
|
||||
PRIMITIVES["page-render-plan"] = pageRenderPlan;
|
||||
|
||||
// Expose page-helper functions as primitives
|
||||
PRIMITIVES["categorize-special-forms"] = categorizeSpecialForms;
|
||||
PRIMITIVES["extract-define-kwargs"] = extractDefineKwargs;
|
||||
PRIMITIVES["build-reference-data"] = buildReferenceData;
|
||||
PRIMITIVES["build-ref-items-with-href"] = buildRefItemsWithHref;
|
||||
PRIMITIVES["build-attr-detail"] = buildAttrDetail;
|
||||
PRIMITIVES["build-header-detail"] = buildHeaderDetail;
|
||||
PRIMITIVES["build-event-detail"] = buildEventDetail;
|
||||
PRIMITIVES["build-component-source"] = buildComponentSource;
|
||||
PRIMITIVES["build-bundle-analysis"] = buildBundleAnalysis;
|
||||
PRIMITIVES["build-routing-analysis"] = buildRoutingAnalysis;
|
||||
PRIMITIVES["build-affinity-analysis"] = buildAffinityAnalysis;
|
||||
|
||||
// =========================================================================
|
||||
// Async IO: Promise-aware rendering for client-side IO primitives
|
||||
// =========================================================================
|
||||
@@ -5823,6 +6027,15 @@ return (isSxTruthy((_batchDepth == 0)) ? (function() {
|
||||
transitiveIoRefs: transitiveIoRefs,
|
||||
computeAllIoRefs: computeAllIoRefs,
|
||||
componentPure_p: componentPure_p,
|
||||
categorizeSpecialForms: categorizeSpecialForms,
|
||||
buildReferenceData: buildReferenceData,
|
||||
buildAttrDetail: buildAttrDetail,
|
||||
buildHeaderDetail: buildHeaderDetail,
|
||||
buildEventDetail: buildEventDetail,
|
||||
buildComponentSource: buildComponentSource,
|
||||
buildBundleAnalysis: buildBundleAnalysis,
|
||||
buildRoutingAnalysis: buildRoutingAnalysis,
|
||||
buildAffinityAnalysis: buildAffinityAnalysis,
|
||||
splitPathSegments: splitPathSegments,
|
||||
parseRoutePattern: parseRoutePattern,
|
||||
matchRoute: matchRoute,
|
||||
|
||||
@@ -14,7 +14,7 @@
|
||||
var IDB_NAME = "sx-offline";
|
||||
var IDB_VERSION = 1;
|
||||
var IDB_STORE = "responses";
|
||||
var STATIC_CACHE = "sx-static-v1";
|
||||
var STATIC_CACHE = "sx-static-v2";
|
||||
|
||||
// ---------------------------------------------------------------------------
|
||||
// IndexedDB helpers
|
||||
|
||||
@@ -31,11 +31,8 @@ from .parser import (
|
||||
parse_all,
|
||||
serialize,
|
||||
)
|
||||
from .evaluator import (
|
||||
EvalError,
|
||||
evaluate,
|
||||
make_env,
|
||||
)
|
||||
from .types import EvalError
|
||||
from .ref.sx_ref import evaluate, make_env
|
||||
|
||||
from .primitives import (
|
||||
all_primitives,
|
||||
|
||||
@@ -53,7 +53,8 @@ from .types import Component, Island, Keyword, Lambda, Macro, NIL, Symbol
|
||||
_expand_components: contextvars.ContextVar[bool] = contextvars.ContextVar(
|
||||
"_expand_components", default=False
|
||||
)
|
||||
from .evaluator import _expand_macro, EvalError
|
||||
from .ref.sx_ref import expand_macro as _expand_macro
|
||||
from .types import EvalError
|
||||
from .primitives import _PRIMITIVES
|
||||
from .primitives_io import IO_PRIMITIVES, RequestContext, execute_io
|
||||
from .parser import SxExpr, serialize
|
||||
@@ -420,23 +421,23 @@ async def _asf_define(expr, env, ctx):
|
||||
|
||||
|
||||
async def _asf_defcomp(expr, env, ctx):
|
||||
from .evaluator import _sf_defcomp
|
||||
return _sf_defcomp(expr, env)
|
||||
from .ref.sx_ref import sf_defcomp
|
||||
return sf_defcomp(expr[1:], env)
|
||||
|
||||
|
||||
async def _asf_defstyle(expr, env, ctx):
|
||||
from .evaluator import _sf_defstyle
|
||||
return _sf_defstyle(expr, env)
|
||||
from .ref.sx_ref import sf_defstyle
|
||||
return sf_defstyle(expr[1:], env)
|
||||
|
||||
|
||||
async def _asf_defmacro(expr, env, ctx):
|
||||
from .evaluator import _sf_defmacro
|
||||
return _sf_defmacro(expr, env)
|
||||
from .ref.sx_ref import sf_defmacro
|
||||
return sf_defmacro(expr[1:], env)
|
||||
|
||||
|
||||
async def _asf_defhandler(expr, env, ctx):
|
||||
from .evaluator import _sf_defhandler
|
||||
return _sf_defhandler(expr, env)
|
||||
from .ref.sx_ref import sf_defhandler
|
||||
return sf_defhandler(expr[1:], env)
|
||||
|
||||
|
||||
async def _asf_begin(expr, env, ctx):
|
||||
@@ -599,7 +600,7 @@ async def _asf_reset(expr, env, ctx):
|
||||
_ASYNC_RESET_RESUME.append(value if value is not None else NIL)
|
||||
try:
|
||||
# Sync re-evaluation; the async caller will trampoline
|
||||
from .evaluator import _eval as sync_eval, _trampoline
|
||||
from .ref.sx_ref import eval_expr as sync_eval, trampoline as _trampoline
|
||||
return _trampoline(sync_eval(body, env))
|
||||
finally:
|
||||
_ASYNC_RESET_RESUME.pop()
|
||||
|
||||
@@ -1,94 +0,0 @@
|
||||
"""
|
||||
S-expression evaluator — thin shim over bootstrapped sx_ref.py.
|
||||
|
||||
All evaluation logic lives in the spec (shared/sx/ref/eval.sx) and is
|
||||
bootstrapped to Python (shared/sx/ref/sx_ref.py). This module re-exports
|
||||
the public API and internal helpers under their historical names so that
|
||||
existing callers don't need updating.
|
||||
|
||||
Imports are lazy (inside functions/properties) to avoid circular imports
|
||||
during bootstrapping: bootstrap_py.py → parser → __init__ → evaluator → sx_ref.
|
||||
"""
|
||||
|
||||
from __future__ import annotations
|
||||
|
||||
|
||||
def _ref():
|
||||
"""Lazy import of the bootstrapped evaluator."""
|
||||
from .ref import sx_ref
|
||||
return sx_ref
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Public API — these are the most used, so we make them importable directly
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
class EvalError(Exception):
|
||||
"""Error during expression evaluation.
|
||||
|
||||
Delegates to the bootstrapped EvalError at runtime but is defined here
|
||||
so imports don't fail during bootstrapping.
|
||||
"""
|
||||
pass
|
||||
|
||||
|
||||
def evaluate(expr, env=None):
|
||||
return _ref().evaluate(expr, env)
|
||||
|
||||
|
||||
def make_env(**kwargs):
|
||||
return _ref().make_env(**kwargs)
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Internal helpers — used by html.py, async_eval.py, handlers.py, etc.
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
def _eval(expr, env):
|
||||
return _ref().eval_expr(expr, env)
|
||||
|
||||
|
||||
def _trampoline(val):
|
||||
return _ref().trampoline(val)
|
||||
|
||||
|
||||
def _call_lambda(fn, args, caller_env):
|
||||
return _ref().call_lambda(fn, args, caller_env)
|
||||
|
||||
|
||||
def _call_component(comp, raw_args, env):
|
||||
return _ref().call_component(comp, raw_args, env)
|
||||
|
||||
|
||||
def _expand_macro(macro, raw_args, env):
|
||||
return _ref().expand_macro(macro, raw_args, env)
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Special-form wrappers: callers pass (expr, env) with expr[0] = head symbol.
|
||||
# sx_ref.py special forms take (args, env) where args = expr[1:].
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
def _sf_defcomp(expr, env):
|
||||
return _ref().sf_defcomp(expr[1:], env)
|
||||
|
||||
def _sf_defisland(expr, env):
|
||||
return _ref().sf_defisland(expr[1:], env)
|
||||
|
||||
def _sf_defstyle(expr, env):
|
||||
return _ref().sf_defstyle(expr[1:], env)
|
||||
|
||||
def _sf_defmacro(expr, env):
|
||||
return _ref().sf_defmacro(expr[1:], env)
|
||||
|
||||
def _sf_defhandler(expr, env):
|
||||
return _ref().sf_defhandler(expr[1:], env)
|
||||
|
||||
def _sf_defpage(expr, env):
|
||||
return _ref().sf_defpage(expr[1:], env)
|
||||
|
||||
def _sf_defquery(expr, env):
|
||||
return _ref().sf_defquery(expr[1:], env)
|
||||
|
||||
def _sf_defaction(expr, env):
|
||||
return _ref().sf_defaction(expr[1:], env)
|
||||
@@ -70,10 +70,7 @@ def load_handler_file(filepath: str, service_name: str) -> list[HandlerDef]:
|
||||
"""Parse an .sx file, evaluate it, and register any HandlerDef values."""
|
||||
from .parser import parse_all
|
||||
import os
|
||||
if os.environ.get("SX_USE_REF") == "1":
|
||||
from .ref.sx_ref import eval_expr as _raw_eval, trampoline as _trampoline
|
||||
else:
|
||||
from .evaluator import _eval as _raw_eval, _trampoline
|
||||
_eval = lambda expr, env: _trampoline(_raw_eval(expr, env))
|
||||
from .jinja_bridge import get_component_env
|
||||
|
||||
|
||||
@@ -28,7 +28,7 @@ import contextvars
|
||||
from typing import Any
|
||||
|
||||
from .types import Component, Island, Keyword, Lambda, Macro, NIL, Symbol
|
||||
from .evaluator import _eval as _raw_eval, _call_component as _raw_call_component, _expand_macro, _trampoline
|
||||
from .ref.sx_ref import eval_expr as _raw_eval, call_component as _raw_call_component, expand_macro as _expand_macro, trampoline as _trampoline
|
||||
|
||||
def _eval(expr, env):
|
||||
"""Evaluate and unwrap thunks — all html.py _eval calls are non-tail."""
|
||||
@@ -414,10 +414,10 @@ def _render_component(comp: Component, args: list, env: dict[str, Any]) -> str:
|
||||
def _render_island(island: Island, args: list, env: dict[str, Any]) -> str:
|
||||
"""Render an island as static HTML with hydration attributes.
|
||||
|
||||
Produces: <span data-sx-island="name" data-sx-state='{"k":"v",...}'>body HTML</span>
|
||||
The client hydrates this into a reactive island.
|
||||
Produces: <span data-sx-island="name" data-sx-state="{:k "v"}">body HTML</span>
|
||||
The client hydrates this into a reactive island via sx-parse (not JSON).
|
||||
"""
|
||||
import json as _json
|
||||
from .parser import serialize as _sx_serialize
|
||||
|
||||
kwargs: dict[str, Any] = {}
|
||||
children: list[Any] = []
|
||||
@@ -443,26 +443,13 @@ def _render_island(island: Island, args: list, env: dict[str, Any]) -> str:
|
||||
|
||||
body_html = _render(island.body, local)
|
||||
|
||||
# Serialize state for hydration — only keyword args
|
||||
state = {}
|
||||
for k, v in kwargs.items():
|
||||
if isinstance(v, (str, int, float, bool)):
|
||||
state[k] = v
|
||||
elif v is NIL or v is None:
|
||||
state[k] = None
|
||||
elif isinstance(v, list):
|
||||
state[k] = v
|
||||
elif isinstance(v, dict):
|
||||
state[k] = v
|
||||
else:
|
||||
state[k] = str(v)
|
||||
|
||||
state_json = _escape_attr(_json.dumps(state, separators=(",", ":"))) if state else ""
|
||||
# Serialize state for hydration — SX format (not JSON)
|
||||
state_sx = _escape_attr(_sx_serialize(kwargs)) if kwargs else ""
|
||||
island_name = _escape_attr(island.name)
|
||||
|
||||
parts = [f'<span data-sx-island="{island_name}"']
|
||||
if state_json:
|
||||
parts.append(f' data-sx-state="{state_json}"')
|
||||
if state_sx:
|
||||
parts.append(f' data-sx-state="{state_sx}"')
|
||||
parts.append(">")
|
||||
parts.append(body_html)
|
||||
parts.append("</span>")
|
||||
|
||||
@@ -229,10 +229,7 @@ def register_components(sx_source: str) -> None:
|
||||
(div :class "..." (div :class "..." title)))))
|
||||
''')
|
||||
"""
|
||||
if _os.environ.get("SX_USE_REF") == "1":
|
||||
from .ref.sx_ref import eval_expr as _raw_eval, trampoline as _trampoline
|
||||
else:
|
||||
from .evaluator import _eval as _raw_eval, _trampoline
|
||||
_eval = lambda expr, env: _trampoline(_raw_eval(expr, env))
|
||||
from .parser import parse_all
|
||||
from .css_registry import scan_classes_from_sx
|
||||
|
||||
@@ -76,7 +76,7 @@ def register_page_helpers(service: str, helpers: dict[str, Any]) -> None:
|
||||
Then in .sx::
|
||||
|
||||
(defpage docs-page
|
||||
:path "/docs/<slug>"
|
||||
:path "/language/docs/<slug>"
|
||||
:auth :public
|
||||
:content (docs-content slug))
|
||||
"""
|
||||
@@ -127,7 +127,7 @@ def get_page_helpers(service: str) -> dict[str, Any]:
|
||||
def load_page_file(filepath: str, service_name: str) -> list[PageDef]:
|
||||
"""Parse an .sx file, evaluate it, and register any PageDef values."""
|
||||
from .parser import parse_all
|
||||
from .evaluator import _eval as _raw_eval, _trampoline
|
||||
from .ref.sx_ref import eval_expr as _raw_eval, trampoline as _trampoline
|
||||
_eval = lambda expr, env: _trampoline(_raw_eval(expr, env))
|
||||
from .jinja_bridge import get_component_env
|
||||
|
||||
@@ -170,6 +170,10 @@ async def _eval_slot(expr: Any, env: dict, ctx: Any) -> str:
|
||||
Expands component calls (so IO in the body executes) but serializes
|
||||
the result as SX wire format, not HTML.
|
||||
"""
|
||||
import os
|
||||
if os.environ.get("SX_USE_REF") == "1":
|
||||
from .ref.async_eval_ref import async_eval_slot_to_sx
|
||||
else:
|
||||
from .async_eval import async_eval_slot_to_sx
|
||||
return await async_eval_slot_to_sx(expr, env, ctx)
|
||||
|
||||
|
||||
@@ -41,7 +41,7 @@ def _resolve_sx_reader_macro(name: str):
|
||||
"""
|
||||
try:
|
||||
from .jinja_bridge import get_component_env
|
||||
from .evaluator import _trampoline, _call_lambda
|
||||
from .ref.sx_ref import trampoline as _trampoline, call_lambda as _call_lambda
|
||||
from .types import Lambda
|
||||
except ImportError:
|
||||
return None
|
||||
|
||||
@@ -78,7 +78,7 @@ def clear(service: str | None = None) -> None:
|
||||
def load_query_file(filepath: str, service_name: str) -> list[QueryDef]:
|
||||
"""Parse an .sx file and register any defquery definitions."""
|
||||
from .parser import parse_all
|
||||
from .evaluator import _eval as _raw_eval, _trampoline
|
||||
from .ref.sx_ref import eval_expr as _raw_eval, trampoline as _trampoline
|
||||
_eval = lambda expr, env: _trampoline(_raw_eval(expr, env))
|
||||
from .jinja_bridge import get_component_env
|
||||
|
||||
@@ -103,7 +103,7 @@ def load_query_file(filepath: str, service_name: str) -> list[QueryDef]:
|
||||
def load_action_file(filepath: str, service_name: str) -> list[ActionDef]:
|
||||
"""Parse an .sx file and register any defaction definitions."""
|
||||
from .parser import parse_all
|
||||
from .evaluator import _eval as _raw_eval, _trampoline
|
||||
from .ref.sx_ref import eval_expr as _raw_eval, trampoline as _trampoline
|
||||
_eval = lambda expr, env: _trampoline(_raw_eval(expr, env))
|
||||
from .jinja_bridge import get_component_env
|
||||
|
||||
|
||||
1262
shared/sx/ref/adapter-async.sx
Normal file
1262
shared/sx/ref/adapter-async.sx
Normal file
File diff suppressed because it is too large
Load Diff
@@ -19,7 +19,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-to-dom
|
||||
(fn (expr env ns)
|
||||
(fn (expr (env :as dict) (ns :as string))
|
||||
(set-render-active! true)
|
||||
(case (type-of expr)
|
||||
;; nil / boolean false / boolean true → empty fragment
|
||||
@@ -67,7 +67,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-list
|
||||
(fn (expr env ns)
|
||||
(fn (expr (env :as dict) (ns :as string))
|
||||
(let ((head (first expr)))
|
||||
(cond
|
||||
;; Symbol head — dispatch on name
|
||||
@@ -166,7 +166,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-element
|
||||
(fn (tag args env ns)
|
||||
(fn ((tag :as string) (args :as list) (env :as dict) (ns :as string))
|
||||
;; Detect namespace from tag
|
||||
(let ((new-ns (cond (= tag "svg") SVG_NS
|
||||
(= tag "math") MATH_NS
|
||||
@@ -237,7 +237,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-component
|
||||
(fn (comp args env ns)
|
||||
(fn ((comp :as component) (args :as list) (env :as dict) (ns :as string))
|
||||
;; Parse kwargs and children, bind into component env, render body.
|
||||
(let ((kwargs (dict))
|
||||
(children (list)))
|
||||
@@ -284,7 +284,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-fragment
|
||||
(fn (args env ns)
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((frag (create-fragment)))
|
||||
(for-each
|
||||
(fn (x) (dom-append frag (render-to-dom x env ns)))
|
||||
@@ -297,7 +297,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-raw
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((frag (create-fragment)))
|
||||
(for-each
|
||||
(fn (arg)
|
||||
@@ -318,7 +318,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-dom-unknown-component
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(error (str "Unknown component: " name))))
|
||||
|
||||
|
||||
@@ -335,11 +335,11 @@
|
||||
"error-boundary"))
|
||||
|
||||
(define render-dom-form?
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(contains? RENDER_DOM_FORMS name)))
|
||||
|
||||
(define dispatch-render-form
|
||||
(fn (name expr env ns)
|
||||
(fn ((name :as string) expr (env :as dict) (ns :as string))
|
||||
(cond
|
||||
;; if — reactive inside islands (re-renders when signal deps change)
|
||||
(= name "if")
|
||||
@@ -581,7 +581,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-lambda-dom
|
||||
(fn (f args env ns)
|
||||
(fn ((f :as lambda) (args :as list) (env :as dict) (ns :as string))
|
||||
;; Bind lambda params and render body as DOM
|
||||
(let ((local (env-merge (lambda-closure f) env)))
|
||||
(for-each-indexed
|
||||
@@ -605,7 +605,7 @@
|
||||
;; - Conditional fragments: (when (deref sig) ...) → reactive show/hide
|
||||
|
||||
(define render-dom-island
|
||||
(fn (island args env ns)
|
||||
(fn ((island :as island) (args :as list) (env :as dict) (ns :as string))
|
||||
;; Parse kwargs and children (same as component)
|
||||
(let ((kwargs (dict))
|
||||
(children (list)))
|
||||
@@ -679,7 +679,7 @@
|
||||
;; Supports :tag keyword to change wrapper element (default "div").
|
||||
|
||||
(define render-dom-lake
|
||||
(fn (args env ns)
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((lake-id nil)
|
||||
(lake-tag "div")
|
||||
(children (list)))
|
||||
@@ -723,7 +723,7 @@
|
||||
;; Stores the island env and transform on the element for morph retrieval.
|
||||
|
||||
(define render-dom-marsh
|
||||
(fn (args env ns)
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((marsh-id nil)
|
||||
(marsh-tag "div")
|
||||
(marsh-transform nil)
|
||||
@@ -781,7 +781,7 @@
|
||||
;; Marks the attribute name on the element via data-sx-reactive-attrs so
|
||||
;; the morph algorithm knows not to overwrite it with server content.
|
||||
(define reactive-attr
|
||||
(fn (el attr-name compute-fn)
|
||||
(fn (el (attr-name :as string) (compute-fn :as lambda))
|
||||
;; Mark this attribute as reactively managed
|
||||
(let ((existing (or (dom-get-attr el "data-sx-reactive-attrs") ""))
|
||||
(updated (if (empty? existing) attr-name (str existing "," attr-name))))
|
||||
@@ -802,7 +802,7 @@
|
||||
;; reactive-fragment — conditionally render a fragment based on a signal
|
||||
;; Used for (when (deref sig) ...) or (if (deref sig) ...) inside an island.
|
||||
(define reactive-fragment
|
||||
(fn (test-fn render-fn env ns)
|
||||
(fn ((test-fn :as lambda) (render-fn :as lambda) (env :as dict) (ns :as string))
|
||||
(let ((marker (create-comment "island-fragment"))
|
||||
(current-nodes (list)))
|
||||
(effect (fn ()
|
||||
@@ -824,13 +824,13 @@
|
||||
;; and reorderings touch the DOM. Without keys, falls back to clear+rerender.
|
||||
|
||||
(define render-list-item
|
||||
(fn (map-fn item env ns)
|
||||
(fn ((map-fn :as lambda) item (env :as dict) (ns :as string))
|
||||
(if (lambda? map-fn)
|
||||
(render-lambda-dom map-fn (list item) env ns)
|
||||
(render-to-dom (apply map-fn (list item)) env ns))))
|
||||
|
||||
(define extract-key
|
||||
(fn (node index)
|
||||
(fn (node (index :as number))
|
||||
;; Extract key from rendered node: :key attr, data-key, or index fallback
|
||||
(let ((k (dom-get-attr node "key")))
|
||||
(if k
|
||||
@@ -839,7 +839,7 @@
|
||||
(if dk (str dk) (str "__idx_" index)))))))
|
||||
|
||||
(define reactive-list
|
||||
(fn (map-fn items-sig env ns)
|
||||
(fn ((map-fn :as lambda) (items-sig :as signal) (env :as dict) (ns :as string))
|
||||
(let ((container (create-fragment))
|
||||
(marker (create-comment "island-list"))
|
||||
(key-map (dict))
|
||||
@@ -925,7 +925,7 @@
|
||||
;; Handles: input[text/number/email/...], textarea, select, checkbox, radio
|
||||
|
||||
(define bind-input
|
||||
(fn (el sig)
|
||||
(fn (el (sig :as signal))
|
||||
(let ((input-type (lower (or (dom-get-attr el "type") "")))
|
||||
(is-checkbox (or (= input-type "checkbox")
|
||||
(= input-type "radio"))))
|
||||
@@ -960,7 +960,7 @@
|
||||
;; teardown.
|
||||
|
||||
(define render-dom-portal
|
||||
(fn (args env ns)
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((selector (trampoline (eval-expr (first args) env)))
|
||||
(target (or (dom-query selector)
|
||||
(dom-ensure-element selector))))
|
||||
@@ -1000,7 +1000,7 @@
|
||||
;; Calling (retry) re-renders the body, replacing the fallback.
|
||||
|
||||
(define render-dom-error-boundary
|
||||
(fn (args env ns)
|
||||
(fn ((args :as list) (env :as dict) (ns :as string))
|
||||
(let ((fallback-expr (first args))
|
||||
(body-exprs (rest args))
|
||||
(container (dom-create-element "div" nil))
|
||||
|
||||
@@ -14,7 +14,7 @@
|
||||
|
||||
|
||||
(define render-to-html
|
||||
(fn (expr env)
|
||||
(fn (expr (env :as dict))
|
||||
(set-render-active! true)
|
||||
(case (type-of expr)
|
||||
;; Literals — render directly
|
||||
@@ -34,7 +34,7 @@
|
||||
:else (render-value-to-html (trampoline (eval-expr expr env)) env))))
|
||||
|
||||
(define render-value-to-html
|
||||
(fn (val env)
|
||||
(fn (val (env :as dict))
|
||||
(case (type-of val)
|
||||
"nil" ""
|
||||
"string" (escape-html val)
|
||||
@@ -55,7 +55,7 @@
|
||||
"map" "map-indexed" "filter" "for-each"))
|
||||
|
||||
(define render-html-form?
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(contains? RENDER_HTML_FORMS name)))
|
||||
|
||||
|
||||
@@ -64,7 +64,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-list-to-html
|
||||
(fn (expr env)
|
||||
(fn ((expr :as list) (env :as dict))
|
||||
(if (empty? expr)
|
||||
""
|
||||
(let ((head (first expr)))
|
||||
@@ -135,7 +135,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dispatch-html-form
|
||||
(fn (name expr env)
|
||||
(fn ((name :as string) (expr :as list) (env :as dict))
|
||||
(cond
|
||||
;; if
|
||||
(= name "if")
|
||||
@@ -235,7 +235,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-lambda-html
|
||||
(fn (f args env)
|
||||
(fn ((f :as lambda) (args :as list) (env :as dict))
|
||||
(let ((local (env-merge (lambda-closure f) env)))
|
||||
(for-each-indexed
|
||||
(fn (i p)
|
||||
@@ -249,7 +249,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define render-html-component
|
||||
(fn (comp args env)
|
||||
(fn ((comp :as component) (args :as list) (env :as dict))
|
||||
;; Expand component and render body through HTML adapter.
|
||||
;; Component body contains rendering forms (HTML tags) that only the
|
||||
;; adapter understands, so expansion must happen here, not in eval-expr.
|
||||
@@ -288,7 +288,7 @@
|
||||
|
||||
|
||||
(define render-html-element
|
||||
(fn (tag args env)
|
||||
(fn ((tag :as string) (args :as list) (env :as dict))
|
||||
(let ((parsed (parse-element-args args env))
|
||||
(attrs (first parsed))
|
||||
(children (nth parsed 1))
|
||||
@@ -312,7 +312,7 @@
|
||||
;; content while preserving surrounding reactive DOM.
|
||||
|
||||
(define render-html-lake
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((lake-id nil)
|
||||
(lake-tag "div")
|
||||
(children (list)))
|
||||
@@ -351,7 +351,7 @@
|
||||
;; the :transform is a client-only concern.
|
||||
|
||||
(define render-html-marsh
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((marsh-id nil)
|
||||
(marsh-tag "div")
|
||||
(children (list)))
|
||||
@@ -394,7 +394,7 @@
|
||||
;; (swap! s f) → no-op
|
||||
|
||||
(define render-html-island
|
||||
(fn (island args env)
|
||||
(fn ((island :as island) (args :as list) (env :as dict))
|
||||
;; Parse kwargs and children (same pattern as render-html-component)
|
||||
(let ((kwargs (dict))
|
||||
(children (list)))
|
||||
@@ -433,11 +433,11 @@
|
||||
|
||||
;; Render the island body as HTML
|
||||
(let ((body-html (render-to-html (component-body island) local))
|
||||
(state-json (serialize-island-state kwargs)))
|
||||
(state-sx (serialize-island-state kwargs)))
|
||||
;; Wrap in container with hydration attributes
|
||||
(str "<span data-sx-island=\"" (escape-attr island-name) "\""
|
||||
(if state-json
|
||||
(str " data-sx-state=\"" (escape-attr state-json) "\"")
|
||||
(if state-sx
|
||||
(str " data-sx-state=\"" (escape-attr state-sx) "\"")
|
||||
"")
|
||||
">"
|
||||
body-html
|
||||
@@ -445,17 +445,17 @@
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; serialize-island-state — serialize kwargs to JSON for hydration
|
||||
;; serialize-island-state — serialize kwargs to SX for hydration
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; Only serializes simple values (numbers, strings, booleans, nil, lists, dicts).
|
||||
;; Functions, components, and other non-serializable values are skipped.
|
||||
;; Uses the SX serializer (not JSON) so the client can parse with sx-parse.
|
||||
;; Handles all SX types natively: numbers, strings, booleans, nil, lists, dicts.
|
||||
|
||||
(define serialize-island-state
|
||||
(fn (kwargs)
|
||||
(fn ((kwargs :as dict))
|
||||
(if (empty-dict? kwargs)
|
||||
nil
|
||||
(json-serialize kwargs))))
|
||||
(sx-serialize kwargs))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -476,8 +476,8 @@
|
||||
;; Raw HTML construction:
|
||||
;; (make-raw-html s) → wrap string as raw HTML (not double-escaped)
|
||||
;;
|
||||
;; JSON serialization (for island state):
|
||||
;; (json-serialize dict) → JSON string
|
||||
;; Island state serialization:
|
||||
;; (sx-serialize val) → SX source string (from parser.sx)
|
||||
;; (empty-dict? d) → boolean
|
||||
;; (escape-attr s) → HTML attribute escape
|
||||
;;
|
||||
|
||||
@@ -12,7 +12,7 @@
|
||||
|
||||
|
||||
(define render-to-sx
|
||||
(fn (expr env)
|
||||
(fn (expr (env :as dict))
|
||||
(let ((result (aser expr env)))
|
||||
;; aser-call already returns serialized SX strings;
|
||||
;; only serialize non-string values
|
||||
@@ -21,7 +21,7 @@
|
||||
(serialize result)))))
|
||||
|
||||
(define aser
|
||||
(fn (expr env)
|
||||
(fn (expr (env :as dict))
|
||||
;; Evaluate for SX wire format — serialize rendering forms,
|
||||
;; evaluate control flow and function calls.
|
||||
(set-render-active! true)
|
||||
@@ -52,7 +52,7 @@
|
||||
|
||||
|
||||
(define aser-list
|
||||
(fn (expr env)
|
||||
(fn ((expr :as list) (env :as dict))
|
||||
(let ((head (first expr))
|
||||
(args (rest expr)))
|
||||
(if (not (= (type-of head) "symbol"))
|
||||
@@ -104,37 +104,58 @@
|
||||
|
||||
|
||||
(define aser-fragment
|
||||
(fn (children env)
|
||||
(fn ((children :as list) (env :as dict))
|
||||
;; Serialize (<> child1 child2 ...) to sx source string
|
||||
(let ((parts (filter
|
||||
(fn (x) (not (nil? x)))
|
||||
(map (fn (c) (aser c env)) children))))
|
||||
;; Must flatten list results (e.g. from map/filter) to avoid nested parens
|
||||
(let ((parts (list)))
|
||||
(for-each
|
||||
(fn (c)
|
||||
(let ((result (aser c env)))
|
||||
(if (= (type-of result) "list")
|
||||
(for-each
|
||||
(fn (item)
|
||||
(when (not (nil? item))
|
||||
(append! parts (serialize item))))
|
||||
result)
|
||||
(when (not (nil? result))
|
||||
(append! parts (serialize result))))))
|
||||
children)
|
||||
(if (empty? parts)
|
||||
""
|
||||
(str "(<> " (join " " (map serialize parts)) ")")))))
|
||||
(str "(<> " (join " " parts) ")")))))
|
||||
|
||||
|
||||
(define aser-call
|
||||
(fn (name args env)
|
||||
(fn ((name :as string) (args :as list) (env :as dict))
|
||||
;; Serialize (name :key val child ...) — evaluate args but keep as sx
|
||||
(let ((parts (list name)))
|
||||
(reduce
|
||||
(fn (state arg)
|
||||
(let ((skip (get state "skip")))
|
||||
;; Uses for-each + mutable state (not reduce) so bootstrapper emits for-loops
|
||||
;; that can contain nested for-each for list flattening.
|
||||
(let ((parts (list name))
|
||||
(skip false)
|
||||
(i 0))
|
||||
(for-each
|
||||
(fn (arg)
|
||||
(if skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
(do (set! skip false)
|
||||
(set! i (inc i)))
|
||||
(if (and (= (type-of arg) "keyword")
|
||||
(< (inc (get state "i")) (len args)))
|
||||
(let ((val (aser (nth args (inc (get state "i"))) env)))
|
||||
(< (inc i) (len args)))
|
||||
(let ((val (aser (nth args (inc i)) env)))
|
||||
(when (not (nil? val))
|
||||
(append! parts (str ":" (keyword-name arg)))
|
||||
(append! parts (serialize val)))
|
||||
(assoc state "skip" true "i" (inc (get state "i"))))
|
||||
(set! skip true)
|
||||
(set! i (inc i)))
|
||||
(let ((val (aser arg env)))
|
||||
(when (not (nil? val))
|
||||
(append! parts (serialize val)))
|
||||
(assoc state "i" (inc (get state "i"))))))))
|
||||
(dict "i" 0 "skip" false)
|
||||
(if (= (type-of val) "list")
|
||||
(for-each
|
||||
(fn (item)
|
||||
(when (not (nil? item))
|
||||
(append! parts (serialize item))))
|
||||
val)
|
||||
(append! parts (serialize val))))
|
||||
(set! i (inc i))))))
|
||||
args)
|
||||
(str "(" (join " " parts) ")"))))
|
||||
|
||||
@@ -156,11 +177,11 @@
|
||||
"some" "every?" "for-each"))
|
||||
|
||||
(define special-form?
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(contains? SPECIAL_FORM_NAMES name)))
|
||||
|
||||
(define ho-form?
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(contains? HO_FORM_NAMES name)))
|
||||
|
||||
|
||||
@@ -173,7 +194,7 @@
|
||||
;; Definition forms evaluate for side effects and return nil.
|
||||
|
||||
(define aser-special
|
||||
(fn (name expr env)
|
||||
(fn ((name :as string) (expr :as list) (env :as dict))
|
||||
(let ((args (rest expr)))
|
||||
(cond
|
||||
;; if — evaluate condition, aser chosen branch
|
||||
@@ -293,7 +314,7 @@
|
||||
|
||||
;; Helper: case dispatch for aser mode
|
||||
(define eval-case-aser
|
||||
(fn (match-val clauses env)
|
||||
(fn (match-val (clauses :as list) (env :as dict))
|
||||
(if (< (len clauses) 2)
|
||||
nil
|
||||
(let ((test (first clauses))
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -72,7 +72,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-mount
|
||||
(fn (target source extra-env)
|
||||
(fn (target (source :as string) (extra-env :as dict))
|
||||
;; Render SX source string into target element.
|
||||
;; target: Element or CSS selector string
|
||||
;; source: SX source string
|
||||
@@ -101,7 +101,7 @@
|
||||
;; new SX content, and replaces the wrapper's children.
|
||||
|
||||
(define resolve-suspense
|
||||
(fn (id sx)
|
||||
(fn ((id :as string) (sx :as string))
|
||||
;; Process any new <script type="text/sx"> tags that arrived via
|
||||
;; streaming (e.g. extra component defs) before resolving.
|
||||
(process-sx-scripts nil)
|
||||
@@ -166,7 +166,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sx-render-component
|
||||
(fn (name kwargs extra-env)
|
||||
(fn ((name :as string) (kwargs :as dict) (extra-env :as dict))
|
||||
;; Render a named component with keyword args.
|
||||
;; name: component name (with or without ~ prefix)
|
||||
;; kwargs: dict of param-name → value
|
||||
@@ -179,7 +179,7 @@
|
||||
;; Build synthetic call expression
|
||||
(let ((call-expr (list (make-symbol full-name))))
|
||||
(for-each
|
||||
(fn (k)
|
||||
(fn ((k :as string))
|
||||
(append! call-expr (make-keyword (to-kebab k)))
|
||||
(append! call-expr (dict-get kwargs k)))
|
||||
(keys kwargs))
|
||||
@@ -236,7 +236,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-component-script
|
||||
(fn (script text)
|
||||
(fn (script (text :as string))
|
||||
;; Handle <script type="text/sx" data-components data-hash="...">
|
||||
(let ((hash (dom-get-attr script "data-hash")))
|
||||
(if (nil? hash)
|
||||
@@ -304,7 +304,7 @@
|
||||
(let ((pages (parse text)))
|
||||
(log-info (str "pages: parsed " (len pages) " entries"))
|
||||
(for-each
|
||||
(fn (page)
|
||||
(fn ((page :as dict))
|
||||
(append! _page-routes
|
||||
(merge page
|
||||
{"parsed" (parse-route-pattern (get page "path"))})))
|
||||
@@ -344,21 +344,21 @@
|
||||
(define hydrate-island
|
||||
(fn (el)
|
||||
(let ((name (dom-get-attr el "data-sx-island"))
|
||||
(state-json (or (dom-get-attr el "data-sx-state") "{}")))
|
||||
(state-sx (or (dom-get-attr el "data-sx-state") "{}")))
|
||||
(let ((comp-name (str "~" name))
|
||||
(env (get-render-env nil)))
|
||||
(let ((comp (env-get env comp-name)))
|
||||
(if (not (or (component? comp) (island? comp)))
|
||||
(log-warn (str "hydrate-island: unknown island " comp-name))
|
||||
|
||||
;; Parse state and build keyword args
|
||||
(let ((kwargs (json-parse state-json))
|
||||
;; Parse state and build keyword args — SX format, not JSON
|
||||
(let ((kwargs (or (first (sx-parse state-sx)) {}))
|
||||
(disposers (list))
|
||||
(local (env-merge (component-closure comp) env)))
|
||||
|
||||
;; Bind params from kwargs
|
||||
(for-each
|
||||
(fn (p)
|
||||
(fn ((p :as string))
|
||||
(env-set! local p (if (dict-has? kwargs p) (dict-get kwargs p) nil)))
|
||||
(component-params comp))
|
||||
|
||||
@@ -393,7 +393,7 @@
|
||||
(let ((disposers (dom-get-data el "sx-disposers")))
|
||||
(when disposers
|
||||
(for-each
|
||||
(fn (d)
|
||||
(fn ((d :as lambda))
|
||||
(when (callable? d) (d)))
|
||||
disposers)
|
||||
(dom-set-data el "sx-disposers" nil)))))
|
||||
@@ -494,8 +494,8 @@
|
||||
;; (log-info msg) → void (console.log with prefix)
|
||||
;; (log-parse-error label text err) → void (diagnostic parse error)
|
||||
;;
|
||||
;; === JSON ===
|
||||
;; (json-parse str) → dict/list/value (JSON.parse)
|
||||
;; === Parsing (island state) ===
|
||||
;; (sx-parse str) → list of AST expressions (from parser.sx)
|
||||
;;
|
||||
;; === Processing markers ===
|
||||
;; (mark-processed! el key) → void
|
||||
|
||||
@@ -49,6 +49,8 @@ class PyEmitter:
|
||||
|
||||
def __init__(self):
|
||||
self.indent = 0
|
||||
self._async_names: set[str] = set() # SX names of define-async functions
|
||||
self._in_async: bool = False # Currently emitting async def body?
|
||||
|
||||
def emit(self, expr) -> str:
|
||||
"""Emit a Python expression from an SX AST node."""
|
||||
@@ -80,6 +82,8 @@ class PyEmitter:
|
||||
name = head.name
|
||||
if name == "define":
|
||||
return self._emit_define(expr, indent)
|
||||
if name == "define-async":
|
||||
return self._emit_define_async(expr, indent)
|
||||
if name == "set!":
|
||||
return f"{pad}{self._mangle(expr[1].name)} = {self.emit(expr[2])}"
|
||||
if name == "when":
|
||||
@@ -138,6 +142,8 @@ class PyEmitter:
|
||||
"component-has-children?": "component_has_children",
|
||||
"component-name": "component_name",
|
||||
"component-affinity": "component_affinity",
|
||||
"component-param-types": "component_param_types",
|
||||
"component-set-param-types!": "component_set_param_types",
|
||||
"macro-params": "macro_params",
|
||||
"macro-rest-param": "macro_rest_param",
|
||||
"macro-body": "macro_body",
|
||||
@@ -275,6 +281,19 @@ class PyEmitter:
|
||||
"sf-defisland": "sf_defisland",
|
||||
# adapter-sx.sx
|
||||
"render-to-sx": "render_to_sx",
|
||||
# adapter-async.sx platform primitives
|
||||
"svg-context-set!": "svg_context_set",
|
||||
"svg-context-reset!": "svg_context_reset",
|
||||
"css-class-collect!": "css_class_collect",
|
||||
"is-raw-html?": "is_raw_html",
|
||||
"async-coroutine?": "is_async_coroutine",
|
||||
"async-await!": "async_await",
|
||||
"is-sx-expr?": "is_sx_expr",
|
||||
"sx-expr?": "is_sx_expr",
|
||||
"io-primitive?": "io_primitive_p",
|
||||
"expand-components?": "expand_components_p",
|
||||
"svg-context?": "svg_context_p",
|
||||
"make-sx-expr": "make_sx_expr",
|
||||
"aser": "aser",
|
||||
"eval-case-aser": "eval_case_aser",
|
||||
"sx-serialize": "sx_serialize",
|
||||
@@ -417,10 +436,21 @@ class PyEmitter:
|
||||
# Regular function call
|
||||
fn_name = self._mangle(name)
|
||||
args = ", ".join(self.emit(x) for x in expr[1:])
|
||||
if self._in_async and name in self._async_names:
|
||||
return f"(await {fn_name}({args}))"
|
||||
return f"{fn_name}({args})"
|
||||
|
||||
# --- Special form emitters ---
|
||||
|
||||
@staticmethod
|
||||
def _extract_param_name(p):
|
||||
"""Extract the name from a param, handling (name :as type) annotations."""
|
||||
if isinstance(p, list) and len(p) == 3 and isinstance(p[1], Keyword) and p[1].name == "as":
|
||||
return p[0].name if isinstance(p[0], Symbol) else str(p[0])
|
||||
if isinstance(p, Symbol):
|
||||
return p.name
|
||||
return str(p)
|
||||
|
||||
def _emit_fn(self, expr) -> str:
|
||||
params = expr[1]
|
||||
body = expr[2:]
|
||||
@@ -432,16 +462,13 @@ class PyEmitter:
|
||||
if isinstance(p, Symbol) and p.name == "&rest":
|
||||
# Next param is the rest parameter
|
||||
if i + 1 < len(params):
|
||||
rest_name = self._mangle(params[i + 1].name if isinstance(params[i + 1], Symbol) else str(params[i + 1]))
|
||||
rest_name = self._mangle(self._extract_param_name(params[i + 1]))
|
||||
i += 2
|
||||
continue
|
||||
else:
|
||||
i += 1
|
||||
continue
|
||||
if isinstance(p, Symbol):
|
||||
param_names.append(self._mangle(p.name))
|
||||
else:
|
||||
param_names.append(str(p))
|
||||
param_names.append(self._mangle(self._extract_param_name(p)))
|
||||
i += 1
|
||||
if rest_name:
|
||||
param_names.append(f"*{rest_name}")
|
||||
@@ -513,13 +540,16 @@ class PyEmitter:
|
||||
body_parts = expr[2:]
|
||||
lines = [f"{pad}if sx_truthy({cond}):"]
|
||||
for b in body_parts:
|
||||
lines.append(self.emit_statement(b, indent + 1))
|
||||
self._emit_stmt_recursive(b, lines, indent + 1)
|
||||
return "\n".join(lines)
|
||||
|
||||
def _emit_cond(self, expr) -> str:
|
||||
clauses = expr[1:]
|
||||
if not clauses:
|
||||
return "NIL"
|
||||
# Check ALL clauses are 2-element lists (scheme-style).
|
||||
# Checking only the first is ambiguous — (nil? x) is a 2-element
|
||||
# function call, not a scheme clause ((test body)).
|
||||
is_scheme = (
|
||||
all(isinstance(c, list) and len(c) == 2 for c in clauses)
|
||||
and not any(isinstance(c, Keyword) for c in clauses)
|
||||
@@ -642,6 +672,16 @@ class PyEmitter:
|
||||
val = self.emit(val_expr)
|
||||
return f"{pad}{self._mangle(name)} = {val}"
|
||||
|
||||
def _emit_define_async(self, expr, indent: int = 0) -> str:
|
||||
"""Emit a define-async form as an async def statement."""
|
||||
name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1])
|
||||
val_expr = expr[2]
|
||||
if (isinstance(val_expr, list) and val_expr and
|
||||
isinstance(val_expr[0], Symbol) and val_expr[0].name in ("fn", "lambda")):
|
||||
return self._emit_define_as_def(name, val_expr, indent, is_async=True)
|
||||
# Shouldn't happen — define-async should always wrap fn/lambda
|
||||
return self._emit_define(expr, indent)
|
||||
|
||||
def _body_uses_set(self, fn_expr) -> bool:
|
||||
"""Check if a fn expression's body (recursively) uses set!."""
|
||||
def _has_set(node):
|
||||
@@ -654,12 +694,16 @@ class PyEmitter:
|
||||
body = fn_expr[2:]
|
||||
return any(_has_set(b) for b in body)
|
||||
|
||||
def _emit_define_as_def(self, name: str, fn_expr, indent: int = 0) -> str:
|
||||
def _emit_define_as_def(self, name: str, fn_expr, indent: int = 0,
|
||||
is_async: bool = False) -> str:
|
||||
"""Emit a define with fn value as a proper def statement.
|
||||
|
||||
This is used for functions that contain set! — Python closures can't
|
||||
rebind outer lambda params, so we need proper def + local variables.
|
||||
Variables mutated by set! from nested lambdas use a _cells dict.
|
||||
|
||||
When is_async=True, emits 'async def' and sets _in_async so that
|
||||
calls to other async functions receive 'await'.
|
||||
"""
|
||||
pad = " " * indent
|
||||
params = fn_expr[1]
|
||||
@@ -670,30 +714,32 @@ class PyEmitter:
|
||||
p = params[i]
|
||||
if isinstance(p, Symbol) and p.name == "&rest":
|
||||
if i + 1 < len(params):
|
||||
rest_name = self._mangle(params[i + 1].name if isinstance(params[i + 1], Symbol) else str(params[i + 1]))
|
||||
rest_name = self._mangle(self._extract_param_name(params[i + 1]))
|
||||
param_names.append(f"*{rest_name}")
|
||||
i += 2
|
||||
continue
|
||||
else:
|
||||
i += 1
|
||||
continue
|
||||
if isinstance(p, Symbol):
|
||||
param_names.append(self._mangle(p.name))
|
||||
else:
|
||||
param_names.append(str(p))
|
||||
param_names.append(self._mangle(self._extract_param_name(p)))
|
||||
i += 1
|
||||
params_str = ", ".join(param_names)
|
||||
py_name = self._mangle(name)
|
||||
# Find set! target variables that are used from nested lambda scopes
|
||||
nested_set_vars = self._find_nested_set_vars(body)
|
||||
lines = [f"{pad}def {py_name}({params_str}):"]
|
||||
def_kw = "async def" if is_async else "def"
|
||||
lines = [f"{pad}{def_kw} {py_name}({params_str}):"]
|
||||
if nested_set_vars:
|
||||
lines.append(f"{pad} _cells = {{}}")
|
||||
# Emit body with cell var tracking
|
||||
# Emit body with cell var tracking (and async context if needed)
|
||||
old_cells = getattr(self, '_current_cell_vars', set())
|
||||
old_async = self._in_async
|
||||
self._current_cell_vars = nested_set_vars
|
||||
if is_async:
|
||||
self._in_async = True
|
||||
self._emit_body_stmts(body, lines, indent + 1)
|
||||
self._current_cell_vars = old_cells
|
||||
self._in_async = old_async
|
||||
return "\n".join(lines)
|
||||
|
||||
def _find_nested_set_vars(self, body) -> set[str]:
|
||||
@@ -750,7 +796,7 @@ class PyEmitter:
|
||||
if is_last:
|
||||
self._emit_return_expr(expr, lines, indent)
|
||||
else:
|
||||
lines.append(self.emit_statement(expr, indent))
|
||||
self._emit_stmt_recursive(expr, lines, indent)
|
||||
|
||||
def _emit_return_expr(self, expr, lines: list, indent: int) -> None:
|
||||
"""Emit an expression in return position, flattening control flow."""
|
||||
@@ -775,6 +821,11 @@ class PyEmitter:
|
||||
if name in ("do", "begin"):
|
||||
self._emit_body_stmts(expr[1:], lines, indent)
|
||||
return
|
||||
if name == "for-each":
|
||||
# for-each in return position: emit as statement, return NIL
|
||||
lines.append(self._emit_for_each_stmt(expr, indent))
|
||||
lines.append(f"{pad}return NIL")
|
||||
return
|
||||
lines.append(f"{pad}return {self.emit(expr)}")
|
||||
|
||||
def _emit_if_return(self, expr, lines: list, indent: int) -> None:
|
||||
@@ -908,7 +959,7 @@ class PyEmitter:
|
||||
if isinstance(fn_expr, list) and isinstance(fn_expr[0], Symbol) and fn_expr[0].name == "fn":
|
||||
params = fn_expr[1]
|
||||
body = fn_expr[2:]
|
||||
p = params[0].name if isinstance(params[0], Symbol) else str(params[0])
|
||||
p = self._extract_param_name(params[0])
|
||||
p_py = self._mangle(p)
|
||||
lines = [f"{pad}for {p_py} in {coll}:"]
|
||||
# Emit body as statements with proper let/set! handling
|
||||
@@ -1034,12 +1085,15 @@ class PyEmitter:
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
def extract_defines(source: str) -> list[tuple[str, list]]:
|
||||
"""Parse .sx source, return list of (name, define-expr) for top-level defines."""
|
||||
"""Parse .sx source, return list of (name, define-expr) for top-level defines.
|
||||
|
||||
Extracts both (define ...) and (define-async ...) forms.
|
||||
"""
|
||||
exprs = parse_all(source)
|
||||
defines = []
|
||||
for expr in exprs:
|
||||
if isinstance(expr, list) and expr and isinstance(expr[0], Symbol):
|
||||
if expr[0].name == "define":
|
||||
if expr[0].name in ("define", "define-async"):
|
||||
name = expr[1].name if isinstance(expr[1], Symbol) else str(expr[1])
|
||||
defines.append((name, expr))
|
||||
return defines
|
||||
@@ -1196,6 +1250,8 @@ def compile_ref_to_py(
|
||||
spec_mod_set.add("deps")
|
||||
if "signals" in SPEC_MODULES:
|
||||
spec_mod_set.add("signals")
|
||||
if "page-helpers" in SPEC_MODULES:
|
||||
spec_mod_set.add("page-helpers")
|
||||
has_deps = "deps" in spec_mod_set
|
||||
|
||||
# Core files always included, then selected adapters, then spec modules
|
||||
@@ -1210,6 +1266,28 @@ def compile_ref_to_py(
|
||||
for name in sorted(spec_mod_set):
|
||||
sx_files.append(SPEC_MODULES[name])
|
||||
|
||||
# Pre-scan define-async names (needed before transpilation so emitter
|
||||
# knows which calls require 'await')
|
||||
has_async = "async" in adapter_set
|
||||
if has_async:
|
||||
async_filename = ADAPTER_FILES["async"][0]
|
||||
async_filepath = os.path.join(ref_dir, async_filename)
|
||||
if os.path.exists(async_filepath):
|
||||
with open(async_filepath) as f:
|
||||
async_src = f.read()
|
||||
for aexpr in parse_all(async_src):
|
||||
if (isinstance(aexpr, list) and aexpr
|
||||
and isinstance(aexpr[0], Symbol)
|
||||
and aexpr[0].name == "define-async"):
|
||||
aname = aexpr[1].name if isinstance(aexpr[1], Symbol) else str(aexpr[1])
|
||||
emitter._async_names.add(aname)
|
||||
# Platform async primitives (provided by host, also need await)
|
||||
emitter._async_names.update({
|
||||
"async-eval", "execute-io", "async-await!",
|
||||
})
|
||||
# Async adapter is transpiled last (after sync adapters)
|
||||
sx_files.append(ADAPTER_FILES["async"])
|
||||
|
||||
all_sections = []
|
||||
for filename, label in sx_files:
|
||||
filepath = os.path.join(ref_dir, filename)
|
||||
@@ -1246,6 +1324,9 @@ def compile_ref_to_py(
|
||||
if has_deps:
|
||||
parts.append(PLATFORM_DEPS_PY)
|
||||
|
||||
if has_async:
|
||||
parts.append(PLATFORM_ASYNC_PY)
|
||||
|
||||
for label, defines in all_sections:
|
||||
parts.append(f"\n# === Transpiled from {label} ===\n")
|
||||
for name, expr in defines:
|
||||
@@ -1256,7 +1337,7 @@ def compile_ref_to_py(
|
||||
parts.append(FIXUPS_PY)
|
||||
if has_continuations:
|
||||
parts.append(CONTINUATIONS_PY)
|
||||
parts.append(public_api_py(has_html, has_sx, has_deps))
|
||||
parts.append(public_api_py(has_html, has_sx, has_deps, has_async))
|
||||
return "\n".join(parts)
|
||||
|
||||
|
||||
|
||||
@@ -143,7 +143,7 @@ def _emit_py(suites: list[dict], preamble: list) -> str:
|
||||
lines.append('')
|
||||
lines.append('import pytest')
|
||||
lines.append('from shared.sx.parser import parse_all')
|
||||
lines.append('from shared.sx.evaluator import _eval, _trampoline')
|
||||
lines.append('from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline')
|
||||
lines.append('')
|
||||
lines.append('')
|
||||
lines.append(f"_PREAMBLE = '''{preamble_escaped}'''")
|
||||
|
||||
@@ -169,6 +169,83 @@ def parse_primitives_by_module() -> dict[str, frozenset[str]]:
|
||||
return {mod: frozenset(names) for mod, names in modules.items()}
|
||||
|
||||
|
||||
def _parse_param_type(param) -> tuple[str, str | None, bool]:
|
||||
"""Parse a single param entry from a :params list.
|
||||
|
||||
Returns (name, type_or_none, is_rest).
|
||||
A bare symbol like ``x`` → ("x", None, False).
|
||||
A typed form ``(x :as number)`` → ("x", "number", False).
|
||||
The ``&rest`` marker is tracked externally.
|
||||
"""
|
||||
if isinstance(param, Symbol):
|
||||
return (param.name, None, False)
|
||||
if isinstance(param, list) and len(param) == 3:
|
||||
# (name :as type)
|
||||
name_sym, kw, type_val = param
|
||||
if (isinstance(name_sym, Symbol)
|
||||
and isinstance(kw, Keyword) and kw.name == "as"):
|
||||
type_str = type_val.name if isinstance(type_val, Symbol) else str(type_val)
|
||||
return (name_sym.name, type_str, False)
|
||||
return (str(param), None, False)
|
||||
|
||||
|
||||
def parse_primitive_param_types() -> dict[str, dict]:
|
||||
"""Parse primitives.sx and extract param type info for each primitive.
|
||||
|
||||
Returns a dict mapping primitive name to param type descriptor::
|
||||
|
||||
{
|
||||
"+": {"positional": [], "rest_type": "number"},
|
||||
"/": {"positional": [("a", "number"), ("b", "number")], "rest_type": None},
|
||||
"get": {"positional": [("coll", None), ("key", None)], "rest_type": None},
|
||||
}
|
||||
|
||||
Each positional entry is (name, type_or_none). rest_type is the
|
||||
type of the &rest parameter (or None if no &rest, or None if untyped &rest).
|
||||
"""
|
||||
source = _read_file("primitives.sx")
|
||||
exprs = parse_all(source)
|
||||
result: dict[str, dict] = {}
|
||||
|
||||
for expr in exprs:
|
||||
if not isinstance(expr, list) or len(expr) < 2:
|
||||
continue
|
||||
if not isinstance(expr[0], Symbol) or expr[0].name != "define-primitive":
|
||||
continue
|
||||
|
||||
name = expr[1]
|
||||
if not isinstance(name, str):
|
||||
continue
|
||||
|
||||
params_list = _extract_keyword_arg(expr, "params")
|
||||
if not isinstance(params_list, list):
|
||||
continue
|
||||
|
||||
positional: list[tuple[str, str | None]] = []
|
||||
rest_type: str | None = None
|
||||
i = 0
|
||||
while i < len(params_list):
|
||||
item = params_list[i]
|
||||
if isinstance(item, Symbol) and item.name == "&rest":
|
||||
# Next item is the rest param
|
||||
if i + 1 < len(params_list):
|
||||
rname, rtype, _ = _parse_param_type(params_list[i + 1])
|
||||
rest_type = rtype
|
||||
i += 2
|
||||
else:
|
||||
pname, ptype, _ = _parse_param_type(item)
|
||||
if pname != "&rest":
|
||||
positional.append((pname, ptype))
|
||||
i += 1
|
||||
|
||||
# Only store if at least one param has a type
|
||||
has_types = rest_type is not None or any(t is not None for _, t in positional)
|
||||
if has_types:
|
||||
result[name] = {"positional": positional, "rest_type": rest_type}
|
||||
|
||||
return result
|
||||
|
||||
|
||||
def parse_boundary_sx() -> tuple[frozenset[str], dict[str, frozenset[str]]]:
|
||||
"""Parse all boundary sources and return (io_names, {service: helper_names}).
|
||||
|
||||
|
||||
@@ -82,7 +82,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-reset
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; Single argument: the body expression.
|
||||
;; Install a continuation delimiter, then evaluate body.
|
||||
;; The implementation is target-specific:
|
||||
@@ -136,7 +136,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-shift
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; Two arguments: the continuation variable name, and the body.
|
||||
(let ((k-name (symbol-name (first args)))
|
||||
(body (second args)))
|
||||
|
||||
@@ -39,7 +39,7 @@
|
||||
|
||||
|
||||
(define scan-refs-walk
|
||||
(fn (node refs)
|
||||
(fn (node (refs :as list))
|
||||
(cond
|
||||
;; Symbol starting with ~ → component reference
|
||||
(= (type-of node) "symbol")
|
||||
@@ -68,26 +68,26 @@
|
||||
;; that it can transitively render. Handles cycles via seen-set.
|
||||
|
||||
(define transitive-deps-walk
|
||||
(fn (n seen env)
|
||||
(fn ((n :as string) (seen :as list) (env :as dict))
|
||||
(when (not (contains? seen n))
|
||||
(append! seen n)
|
||||
(let ((val (env-get env n)))
|
||||
(cond
|
||||
(= (type-of val) "component")
|
||||
(for-each (fn (ref) (transitive-deps-walk ref seen env))
|
||||
(for-each (fn ((ref :as string)) (transitive-deps-walk ref seen env))
|
||||
(scan-refs (component-body val)))
|
||||
(= (type-of val) "macro")
|
||||
(for-each (fn (ref) (transitive-deps-walk ref seen env))
|
||||
(for-each (fn ((ref :as string)) (transitive-deps-walk ref seen env))
|
||||
(scan-refs (macro-body val)))
|
||||
:else nil)))))
|
||||
|
||||
|
||||
(define transitive-deps
|
||||
(fn (name env)
|
||||
(fn ((name :as string) (env :as dict))
|
||||
(let ((seen (list))
|
||||
(key (if (starts-with? name "~") name (str "~" name))))
|
||||
(transitive-deps-walk key seen env)
|
||||
(filter (fn (x) (not (= x key))) seen))))
|
||||
(filter (fn ((x :as string)) (not (= x key))) seen))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -101,9 +101,9 @@
|
||||
;; (component-set-deps! comp deps) → store deps on component
|
||||
|
||||
(define compute-all-deps
|
||||
(fn (env)
|
||||
(fn ((env :as dict))
|
||||
(for-each
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(let ((val (env-get env name)))
|
||||
(when (= (type-of val) "component")
|
||||
(component-set-deps! val (transitive-deps name env)))))
|
||||
@@ -120,9 +120,9 @@
|
||||
;; (regex-find-all pattern source) → list of matched group strings
|
||||
|
||||
(define scan-components-from-source
|
||||
(fn (source)
|
||||
(fn ((source :as string))
|
||||
(let ((matches (regex-find-all "\\(~([a-zA-Z_][a-zA-Z0-9_\\-]*)" source)))
|
||||
(map (fn (m) (str "~" m)) matches))))
|
||||
(map (fn ((m :as string)) (str "~" m)) matches))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -132,13 +132,13 @@
|
||||
;; the transitive closure. Returns list of ~names.
|
||||
|
||||
(define components-needed
|
||||
(fn (page-source env)
|
||||
(fn ((page-source :as string) (env :as dict))
|
||||
(let ((direct (scan-components-from-source page-source))
|
||||
(all-needed (list)))
|
||||
|
||||
;; Add each direct ref + its transitive deps
|
||||
(for-each
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(when (not (contains? all-needed name))
|
||||
(append! all-needed name))
|
||||
(let ((val (env-get env name)))
|
||||
@@ -147,7 +147,7 @@
|
||||
(component-deps val)
|
||||
(transitive-deps name env))))
|
||||
(for-each
|
||||
(fn (dep)
|
||||
(fn ((dep :as string))
|
||||
(when (not (contains? all-needed dep))
|
||||
(append! all-needed dep)))
|
||||
deps))))
|
||||
@@ -166,7 +166,7 @@
|
||||
;; This replaces the "send everything" approach with per-page bundles.
|
||||
|
||||
(define page-component-bundle
|
||||
(fn (page-source env)
|
||||
(fn ((page-source :as string) (env :as dict))
|
||||
(components-needed page-source env)))
|
||||
|
||||
|
||||
@@ -181,17 +181,17 @@
|
||||
;; (scan-css-classes source) → set/list of class strings from source
|
||||
|
||||
(define page-css-classes
|
||||
(fn (page-source env)
|
||||
(fn ((page-source :as string) (env :as dict))
|
||||
(let ((needed (components-needed page-source env))
|
||||
(classes (list)))
|
||||
|
||||
;; Collect classes from needed components
|
||||
(for-each
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(let ((val (env-get env name)))
|
||||
(when (= (type-of val) "component")
|
||||
(for-each
|
||||
(fn (cls)
|
||||
(fn ((cls :as string))
|
||||
(when (not (contains? classes cls))
|
||||
(append! classes cls)))
|
||||
(component-css-classes val)))))
|
||||
@@ -199,7 +199,7 @@
|
||||
|
||||
;; Add classes from page source
|
||||
(for-each
|
||||
(fn (cls)
|
||||
(fn ((cls :as string))
|
||||
(when (not (contains? classes cls))
|
||||
(append! classes cls)))
|
||||
(scan-css-classes page-source))
|
||||
@@ -219,7 +219,7 @@
|
||||
;; (component-set-io-refs! c r) → cache IO refs on component
|
||||
|
||||
(define scan-io-refs-walk
|
||||
(fn (node io-names refs)
|
||||
(fn (node (io-names :as list) (refs :as list))
|
||||
(cond
|
||||
;; Symbol → check if name is in the IO set
|
||||
(= (type-of node) "symbol")
|
||||
@@ -242,7 +242,7 @@
|
||||
|
||||
|
||||
(define scan-io-refs
|
||||
(fn (node io-names)
|
||||
(fn (node (io-names :as list))
|
||||
(let ((refs (list)))
|
||||
(scan-io-refs-walk node io-names refs)
|
||||
refs)))
|
||||
@@ -253,7 +253,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define transitive-io-refs-walk
|
||||
(fn (n seen all-refs env io-names)
|
||||
(fn ((n :as string) (seen :as list) (all-refs :as list) (env :as dict) (io-names :as list))
|
||||
(when (not (contains? seen n))
|
||||
(append! seen n)
|
||||
(let ((val (env-get env n)))
|
||||
@@ -262,31 +262,31 @@
|
||||
(do
|
||||
;; Scan this component's body for IO refs
|
||||
(for-each
|
||||
(fn (ref)
|
||||
(fn ((ref :as string))
|
||||
(when (not (contains? all-refs ref))
|
||||
(append! all-refs ref)))
|
||||
(scan-io-refs (component-body val) io-names))
|
||||
;; Recurse into component deps
|
||||
(for-each
|
||||
(fn (dep) (transitive-io-refs-walk dep seen all-refs env io-names))
|
||||
(fn ((dep :as string)) (transitive-io-refs-walk dep seen all-refs env io-names))
|
||||
(scan-refs (component-body val))))
|
||||
|
||||
(= (type-of val) "macro")
|
||||
(do
|
||||
(for-each
|
||||
(fn (ref)
|
||||
(fn ((ref :as string))
|
||||
(when (not (contains? all-refs ref))
|
||||
(append! all-refs ref)))
|
||||
(scan-io-refs (macro-body val) io-names))
|
||||
(for-each
|
||||
(fn (dep) (transitive-io-refs-walk dep seen all-refs env io-names))
|
||||
(fn ((dep :as string)) (transitive-io-refs-walk dep seen all-refs env io-names))
|
||||
(scan-refs (macro-body val))))
|
||||
|
||||
:else nil)))))
|
||||
|
||||
|
||||
(define transitive-io-refs
|
||||
(fn (name env io-names)
|
||||
(fn ((name :as string) (env :as dict) (io-names :as list))
|
||||
(let ((all-refs (list))
|
||||
(seen (list))
|
||||
(key (if (starts-with? name "~") name (str "~" name))))
|
||||
@@ -299,9 +299,9 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define compute-all-io-refs
|
||||
(fn (env io-names)
|
||||
(fn ((env :as dict) (io-names :as list))
|
||||
(for-each
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(let ((val (env-get env name)))
|
||||
(when (= (type-of val) "component")
|
||||
(component-set-io-refs! val (transitive-io-refs name env io-names)))))
|
||||
@@ -309,7 +309,7 @@
|
||||
|
||||
|
||||
(define component-io-refs-cached
|
||||
(fn (name env io-names)
|
||||
(fn ((name :as string) (env :as dict) (io-names :as list))
|
||||
(let ((key (if (starts-with? name "~") name (str "~" name))))
|
||||
(let ((val (env-get env key)))
|
||||
(if (and (= (type-of val) "component")
|
||||
@@ -320,7 +320,7 @@
|
||||
(transitive-io-refs name env io-names))))))
|
||||
|
||||
(define component-pure?
|
||||
(fn (name env io-names)
|
||||
(fn ((name :as string) (env :as dict) (io-names :as list))
|
||||
(let ((key (if (starts-with? name "~") name (str "~" name))))
|
||||
(let ((val (env-get env key)))
|
||||
(if (and (= (type-of val) "component")
|
||||
@@ -344,7 +344,7 @@
|
||||
;; Returns: "server" | "client"
|
||||
|
||||
(define render-target
|
||||
(fn (name env io-names)
|
||||
(fn ((name :as string) (env :as dict) (io-names :as list))
|
||||
(let ((key (if (starts-with? name "~") name (str "~" name))))
|
||||
(let ((val (env-get env key)))
|
||||
(if (not (= (type-of val) "component"))
|
||||
@@ -373,7 +373,7 @@
|
||||
;; without recomputing at every request.
|
||||
|
||||
(define page-render-plan
|
||||
(fn (page-source env io-names)
|
||||
(fn ((page-source :as string) (env :as dict) (io-names :as list))
|
||||
(let ((needed (components-needed page-source env))
|
||||
(comp-targets (dict))
|
||||
(server-list (list))
|
||||
@@ -381,7 +381,7 @@
|
||||
(io-deps (list)))
|
||||
|
||||
(for-each
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(let ((target (render-target name env io-names)))
|
||||
(dict-set! comp-targets name target)
|
||||
(if (= target "server")
|
||||
@@ -389,7 +389,7 @@
|
||||
(append! server-list name)
|
||||
;; Collect IO deps from server components (use cache)
|
||||
(for-each
|
||||
(fn (io-ref)
|
||||
(fn ((io-ref :as string))
|
||||
(when (not (contains? io-deps io-ref))
|
||||
(append! io-deps io-ref)))
|
||||
(component-io-refs-cached name env io-names)))
|
||||
@@ -451,9 +451,9 @@
|
||||
;; Moved from platform to spec: pure logic using type predicates.
|
||||
|
||||
(define env-components
|
||||
(fn (env)
|
||||
(fn ((env :as dict))
|
||||
(filter
|
||||
(fn (k)
|
||||
(fn ((k :as string))
|
||||
(let ((v (env-get env k)))
|
||||
(or (component? v) (macro? v))))
|
||||
(keys env))))
|
||||
|
||||
@@ -32,17 +32,18 @@
|
||||
;; Each descriptor is a dict with "event" and "modifiers" keys.
|
||||
|
||||
(define parse-time
|
||||
(fn (s)
|
||||
(fn ((s :as string))
|
||||
;; Parse time string: "2s" → 2000, "500ms" → 500
|
||||
(cond
|
||||
(nil? s) 0
|
||||
(ends-with? s "ms") (parse-int s 0)
|
||||
(ends-with? s "s") (* (parse-int (replace s "s" "") 0) 1000)
|
||||
:else (parse-int s 0))))
|
||||
;; Uses nested if (not cond) because cond misclassifies 2-element
|
||||
;; function calls like (nil? s) as scheme-style ((test body)) clauses.
|
||||
(if (nil? s) 0
|
||||
(if (ends-with? s "ms") (parse-int s 0)
|
||||
(if (ends-with? s "s") (* (parse-int (replace s "s" "") 0) 1000)
|
||||
(parse-int s 0))))))
|
||||
|
||||
|
||||
(define parse-trigger-spec
|
||||
(fn (spec)
|
||||
(fn ((spec :as string))
|
||||
;; Parse "click delay:500ms once,change" → list of trigger descriptors
|
||||
(if (nil? spec)
|
||||
nil
|
||||
@@ -50,7 +51,7 @@
|
||||
(filter
|
||||
(fn (x) (not (nil? x)))
|
||||
(map
|
||||
(fn (part)
|
||||
(fn ((part :as string))
|
||||
(let ((tokens (split (trim part) " ")))
|
||||
(if (empty? tokens)
|
||||
nil
|
||||
@@ -62,7 +63,7 @@
|
||||
;; Normal trigger with optional modifiers
|
||||
(let ((mods (dict)))
|
||||
(for-each
|
||||
(fn (tok)
|
||||
(fn ((tok :as string))
|
||||
(cond
|
||||
(= tok "once")
|
||||
(dict-set! mods "once" true)
|
||||
@@ -80,7 +81,7 @@
|
||||
|
||||
|
||||
(define default-trigger
|
||||
(fn (tag-name)
|
||||
(fn ((tag-name :as string))
|
||||
;; Default trigger for element type
|
||||
(cond
|
||||
(= tag-name "FORM")
|
||||
@@ -101,7 +102,7 @@
|
||||
(fn (el)
|
||||
;; Check element for sx-get, sx-post, etc. Returns (dict "method" "url") or nil.
|
||||
(some
|
||||
(fn (verb)
|
||||
(fn ((verb :as string))
|
||||
(let ((url (dom-get-attr el (str "sx-" verb))))
|
||||
(if url
|
||||
(dict "method" (upper verb) "url" url)
|
||||
@@ -114,7 +115,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define build-request-headers
|
||||
(fn (el loaded-components css-hash)
|
||||
(fn (el (loaded-components :as list) (css-hash :as string))
|
||||
;; Build the SX request headers dict
|
||||
(let ((headers (dict
|
||||
"SX-Request" "true"
|
||||
@@ -139,7 +140,7 @@
|
||||
(let ((parsed (parse-header-value extra-h)))
|
||||
(when parsed
|
||||
(for-each
|
||||
(fn (key) (dict-set! headers key (str (get parsed key))))
|
||||
(fn ((key :as string)) (dict-set! headers key (str (get parsed key))))
|
||||
(keys parsed))))))
|
||||
|
||||
headers)))
|
||||
@@ -150,7 +151,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-response-headers
|
||||
(fn (get-header)
|
||||
(fn ((get-header :as lambda))
|
||||
;; Extract all SX response header directives into a dict.
|
||||
;; get-header is (fn (name) → string or nil).
|
||||
(dict
|
||||
@@ -174,13 +175,13 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define parse-swap-spec
|
||||
(fn (raw-swap global-transitions?)
|
||||
(fn ((raw-swap :as string) (global-transitions? :as boolean))
|
||||
;; Parse "innerHTML transition:true" → dict with style + transition flag
|
||||
(let ((parts (split (or raw-swap DEFAULT_SWAP) " "))
|
||||
(style (first parts))
|
||||
(use-transition global-transitions?))
|
||||
(for-each
|
||||
(fn (p)
|
||||
(fn ((p :as string))
|
||||
(cond
|
||||
(= p "transition:true") (set! use-transition true)
|
||||
(= p "transition:false") (set! use-transition false)))
|
||||
@@ -193,7 +194,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define parse-retry-spec
|
||||
(fn (retry-attr)
|
||||
(fn ((retry-attr :as string))
|
||||
;; Parse "exponential:1000:30000" → spec dict or nil
|
||||
(if (nil? retry-attr)
|
||||
nil
|
||||
@@ -205,7 +206,7 @@
|
||||
|
||||
|
||||
(define next-retry-ms
|
||||
(fn (current-ms cap-ms)
|
||||
(fn ((current-ms :as number) (cap-ms :as number))
|
||||
;; Exponential backoff: double current, cap at max
|
||||
(min (* current-ms 2) cap-ms)))
|
||||
|
||||
@@ -215,24 +216,23 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define filter-params
|
||||
(fn (params-spec all-params)
|
||||
(fn ((params-spec :as string) (all-params :as list))
|
||||
;; Filter form parameters by sx-params spec.
|
||||
;; all-params is a list of (key value) pairs.
|
||||
;; Returns filtered list of (key value) pairs.
|
||||
(cond
|
||||
(nil? params-spec) all-params
|
||||
(= params-spec "none") (list)
|
||||
(= params-spec "*") all-params
|
||||
(starts-with? params-spec "not ")
|
||||
;; Uses nested if (not cond) — see parse-time comment.
|
||||
(if (nil? params-spec) all-params
|
||||
(if (= params-spec "none") (list)
|
||||
(if (= params-spec "*") all-params
|
||||
(if (starts-with? params-spec "not ")
|
||||
(let ((excluded (map trim (split (slice params-spec 4) ","))))
|
||||
(filter
|
||||
(fn (p) (not (contains? excluded (first p))))
|
||||
(fn ((p :as list)) (not (contains? excluded (first p))))
|
||||
all-params))
|
||||
:else
|
||||
(let ((allowed (map trim (split params-spec ","))))
|
||||
(filter
|
||||
(fn (p) (contains? allowed (first p)))
|
||||
all-params)))))
|
||||
(fn ((p :as list)) (contains? allowed (first p)))
|
||||
all-params))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -279,7 +279,7 @@
|
||||
|
||||
|
||||
(define revert-optimistic
|
||||
(fn (state)
|
||||
(fn ((state :as dict))
|
||||
;; Revert an optimistic update
|
||||
(when state
|
||||
(let ((target (get state "target"))
|
||||
@@ -305,7 +305,7 @@
|
||||
;; Returns list of (dict "element" el "swap-type" type "target-id" id).
|
||||
(let ((results (list)))
|
||||
(for-each
|
||||
(fn (attr)
|
||||
(fn ((attr :as string))
|
||||
(let ((oob-els (dom-query-all container (str "[" attr "]"))))
|
||||
(for-each
|
||||
(fn (oob)
|
||||
@@ -380,7 +380,7 @@
|
||||
(reactive-attrs (if (empty? ra-str) (list) (split ra-str ","))))
|
||||
;; Add/update attributes from new, skip reactive ones
|
||||
(for-each
|
||||
(fn (attr)
|
||||
(fn ((attr :as list))
|
||||
(let ((name (first attr))
|
||||
(val (nth attr 1)))
|
||||
(when (and (not (= (dom-get-attr old-el name) val))
|
||||
@@ -389,7 +389,7 @@
|
||||
(dom-attr-list new-el))
|
||||
;; Remove attributes not in new, skip reactive + marker attrs
|
||||
(for-each
|
||||
(fn (attr)
|
||||
(fn ((attr :as list))
|
||||
(let ((aname (first attr)))
|
||||
(when (and (not (dom-has-attr? new-el aname))
|
||||
(not (contains? reactive-attrs aname))
|
||||
@@ -406,7 +406,7 @@
|
||||
(new-kids (dom-child-list new-parent))
|
||||
;; Build ID map of old children for keyed matching
|
||||
(old-by-id (reduce
|
||||
(fn (acc kid)
|
||||
(fn ((acc :as dict) kid)
|
||||
(let ((id (dom-id kid)))
|
||||
(if id (do (dict-set! acc id kid) acc) acc)))
|
||||
(dict) old-kids))
|
||||
@@ -447,7 +447,7 @@
|
||||
|
||||
;; Remove leftover old children
|
||||
(for-each
|
||||
(fn (i)
|
||||
(fn ((i :as number))
|
||||
(when (>= i oi)
|
||||
(let ((leftover (nth old-kids i)))
|
||||
(when (and (dom-is-child-of? leftover old-parent)
|
||||
@@ -577,7 +577,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define swap-dom-nodes
|
||||
(fn (target new-nodes strategy)
|
||||
(fn (target new-nodes (strategy :as string))
|
||||
;; Execute a swap strategy on live DOM nodes.
|
||||
;; new-nodes is typically a DocumentFragment or Element.
|
||||
(case strategy
|
||||
@@ -644,7 +644,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define swap-html-string
|
||||
(fn (target html strategy)
|
||||
(fn (target (html :as string) (strategy :as string))
|
||||
;; Execute a swap strategy using an HTML string (DOMParser pipeline).
|
||||
(case strategy
|
||||
"innerHTML"
|
||||
@@ -675,7 +675,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-history
|
||||
(fn (el url resp-headers)
|
||||
(fn (el (url :as string) (resp-headers :as dict))
|
||||
;; Process history push/replace based on element attrs and response headers
|
||||
(let ((push-url (dom-get-attr el "sx-push-url"))
|
||||
(replace-url (dom-get-attr el "sx-replace-url"))
|
||||
@@ -701,7 +701,7 @@
|
||||
(define PRELOAD_TTL 30000) ;; 30 seconds
|
||||
|
||||
(define preload-cache-get
|
||||
(fn (cache url)
|
||||
(fn ((cache :as dict) (url :as string))
|
||||
;; Get and consume a cached preload response.
|
||||
;; Returns (dict "text" ... "content-type" ...) or nil.
|
||||
(let ((entry (dict-get cache url)))
|
||||
@@ -713,7 +713,7 @@
|
||||
|
||||
|
||||
(define preload-cache-set
|
||||
(fn (cache url text content-type)
|
||||
(fn ((cache :as dict) (url :as string) (text :as string) (content-type :as string))
|
||||
;; Store a preloaded response
|
||||
(dict-set! cache url
|
||||
(dict "text" text "content-type" content-type "timestamp" (now-ms)))))
|
||||
@@ -726,7 +726,7 @@
|
||||
;; This is the logic; actual browser event binding is platform interface.
|
||||
|
||||
(define classify-trigger
|
||||
(fn (trigger)
|
||||
(fn ((trigger :as dict))
|
||||
;; Classify a parsed trigger descriptor for binding.
|
||||
;; Returns one of: "poll", "intersect", "load", "revealed", "event"
|
||||
(let ((event (get trigger "event")))
|
||||
|
||||
@@ -73,7 +73,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define eval-expr
|
||||
(fn (expr env)
|
||||
(fn (expr (env :as dict))
|
||||
(case (type-of expr)
|
||||
|
||||
;; --- literals pass through ---
|
||||
@@ -91,7 +91,8 @@
|
||||
(= name "true") true
|
||||
(= name "false") false
|
||||
(= name "nil") nil
|
||||
:else (error (str "Undefined symbol: " name))))
|
||||
:else (do (debug-log "Undefined symbol:" name "primitive?:" (primitive? name))
|
||||
(error (str "Undefined symbol: " name)))))
|
||||
|
||||
;; --- keyword → its string name ---
|
||||
"keyword" (keyword-name expr)
|
||||
@@ -115,7 +116,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define eval-list
|
||||
(fn (expr env)
|
||||
(fn (expr (env :as dict))
|
||||
(let ((head (first expr))
|
||||
(args (rest expr)))
|
||||
|
||||
@@ -190,7 +191,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define eval-call
|
||||
(fn (head args env)
|
||||
(fn (head (args :as list) (env :as dict))
|
||||
(let ((f (trampoline (eval-expr head env)))
|
||||
(evaluated-args (map (fn (a) (trampoline (eval-expr a env))) args)))
|
||||
(cond
|
||||
@@ -214,7 +215,7 @@
|
||||
|
||||
|
||||
(define call-lambda
|
||||
(fn (f args caller-env)
|
||||
(fn ((f :as lambda) (args :as list) (caller-env :as dict))
|
||||
(let ((params (lambda-params f))
|
||||
(local (env-merge (lambda-closure f) caller-env)))
|
||||
;; Too many args is an error; too few pads with nil
|
||||
@@ -234,7 +235,7 @@
|
||||
|
||||
|
||||
(define call-component
|
||||
(fn (comp raw-args env)
|
||||
(fn ((comp :as component) (raw-args :as list) (env :as dict))
|
||||
;; Parse keyword args and children from unevaluated arg list
|
||||
(let ((parsed (parse-keyword-args raw-args env))
|
||||
(kwargs (first parsed))
|
||||
@@ -252,7 +253,7 @@
|
||||
|
||||
|
||||
(define parse-keyword-args
|
||||
(fn (raw-args env)
|
||||
(fn ((raw-args :as list) (env :as dict))
|
||||
;; Walk args: keyword + next-val → kwargs dict, else → children list
|
||||
(let ((kwargs (dict))
|
||||
(children (list))
|
||||
@@ -286,7 +287,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-if
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((condition (trampoline (eval-expr (first args) env))))
|
||||
(if (and condition (not (nil? condition)))
|
||||
(make-thunk (nth args 1) env)
|
||||
@@ -296,7 +297,7 @@
|
||||
|
||||
|
||||
(define sf-when
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((condition (trampoline (eval-expr (first args) env))))
|
||||
(if (and condition (not (nil? condition)))
|
||||
(do
|
||||
@@ -309,18 +310,22 @@
|
||||
nil))))
|
||||
|
||||
|
||||
;; cond-scheme? — check if ALL clauses are 2-element lists (scheme-style).
|
||||
;; Checking only the first arg is ambiguous — (nil? x) is a 2-element
|
||||
;; function call, not a scheme clause ((test body)).
|
||||
(define cond-scheme?
|
||||
(fn ((clauses :as list))
|
||||
(every? (fn (c) (and (= (type-of c) "list") (= (len c) 2)))
|
||||
clauses)))
|
||||
|
||||
(define sf-cond
|
||||
(fn (args env)
|
||||
;; Detect scheme-style: first arg is a 2-element list
|
||||
(if (and (= (type-of (first args)) "list")
|
||||
(= (len (first args)) 2))
|
||||
;; Scheme-style: ((test body) ...)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(if (cond-scheme? args)
|
||||
(sf-cond-scheme args env)
|
||||
;; Clojure-style: test body test body ...
|
||||
(sf-cond-clojure args env))))
|
||||
|
||||
(define sf-cond-scheme
|
||||
(fn (clauses env)
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (empty? clauses)
|
||||
nil
|
||||
(let ((clause (first clauses))
|
||||
@@ -337,7 +342,7 @@
|
||||
(sf-cond-scheme (rest clauses) env)))))))
|
||||
|
||||
(define sf-cond-clojure
|
||||
(fn (clauses env)
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (< (len clauses) 2)
|
||||
nil
|
||||
(let ((test (first clauses))
|
||||
@@ -353,13 +358,13 @@
|
||||
|
||||
|
||||
(define sf-case
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((match-val (trampoline (eval-expr (first args) env)))
|
||||
(clauses (rest args)))
|
||||
(sf-case-loop match-val clauses env))))
|
||||
|
||||
(define sf-case-loop
|
||||
(fn (match-val clauses env)
|
||||
(fn (match-val (clauses :as list) (env :as dict))
|
||||
(if (< (len clauses) 2)
|
||||
nil
|
||||
(let ((test (first clauses))
|
||||
@@ -375,7 +380,7 @@
|
||||
|
||||
|
||||
(define sf-and
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(if (empty? args)
|
||||
true
|
||||
(let ((val (trampoline (eval-expr (first args) env))))
|
||||
@@ -387,7 +392,7 @@
|
||||
|
||||
|
||||
(define sf-or
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(if (empty? args)
|
||||
false
|
||||
(let ((val (trampoline (eval-expr (first args) env))))
|
||||
@@ -397,7 +402,7 @@
|
||||
|
||||
|
||||
(define sf-let
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; Detect named let: (let name ((x 0) ...) body)
|
||||
;; If first arg is a symbol, delegate to sf-named-let.
|
||||
(if (= (type-of (first args)) "symbol")
|
||||
@@ -438,7 +443,7 @@
|
||||
;; Desugars to a self-recursive lambda called with initial values.
|
||||
;; The loop name is bound in the body so recursive calls produce TCO thunks.
|
||||
(define sf-named-let
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((loop-name (symbol-name (first args)))
|
||||
(bindings (nth args 1))
|
||||
(body (slice args 2))
|
||||
@@ -478,22 +483,29 @@
|
||||
|
||||
|
||||
(define sf-lambda
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((params-expr (first args))
|
||||
(body-exprs (rest args))
|
||||
(body (if (= (len body-exprs) 1)
|
||||
(first body-exprs)
|
||||
(cons (make-symbol "begin") body-exprs)))
|
||||
(param-names (map (fn (p)
|
||||
(if (= (type-of p) "symbol")
|
||||
(cond
|
||||
(= (type-of p) "symbol")
|
||||
(symbol-name p)
|
||||
p))
|
||||
;; Annotated param: (name :as type) → extract name
|
||||
(and (= (type-of p) "list")
|
||||
(= (len p) 3)
|
||||
(= (type-of (nth p 1)) "keyword")
|
||||
(= (keyword-name (nth p 1)) "as"))
|
||||
(symbol-name (first p))
|
||||
:else p))
|
||||
params-expr)))
|
||||
(make-lambda param-names body env))))
|
||||
|
||||
|
||||
(define sf-define
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((name-sym (first args))
|
||||
(value (trampoline (eval-expr (nth args 1) env))))
|
||||
(when (and (lambda? value) (nil? (lambda-name value)))
|
||||
@@ -503,7 +515,7 @@
|
||||
|
||||
|
||||
(define sf-defcomp
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; (defcomp ~name (params) [:affinity :client|:server] body)
|
||||
;; Body is always the last element. Optional keyword annotations
|
||||
;; may appear between the params list and the body.
|
||||
@@ -514,13 +526,18 @@
|
||||
(parsed (parse-comp-params params-raw))
|
||||
(params (first parsed))
|
||||
(has-children (nth parsed 1))
|
||||
(param-types (nth parsed 2))
|
||||
(affinity (defcomp-kwarg args "affinity" "auto")))
|
||||
(let ((comp (make-component comp-name params has-children body env affinity)))
|
||||
;; Store type annotations if any were declared
|
||||
(when (and (not (nil? param-types))
|
||||
(not (empty? (keys param-types))))
|
||||
(component-set-param-types! comp param-types))
|
||||
(env-set! env (symbol-name name-sym) comp)
|
||||
comp))))
|
||||
|
||||
(define defcomp-kwarg
|
||||
(fn (args key default)
|
||||
(fn ((args :as list) (key :as string) default)
|
||||
;; Search for :key value between params (index 2) and body (last).
|
||||
(let ((end (- (len args) 1))
|
||||
(result default))
|
||||
@@ -536,14 +553,34 @@
|
||||
result)))
|
||||
|
||||
(define parse-comp-params
|
||||
(fn (params-expr)
|
||||
;; Parse (&key param1 param2 &children) → (params has-children)
|
||||
(fn ((params-expr :as list))
|
||||
;; Parse (&key param1 param2 &children) → (params has-children param-types)
|
||||
;; Also accepts &rest as synonym for &children.
|
||||
;; Supports typed params: (name :as type) — a 3-element list where
|
||||
;; the second element is the keyword :as. Unannotated params get no
|
||||
;; type entry. param-types is a dict {name → type-expr} or empty dict.
|
||||
(let ((params (list))
|
||||
(param-types (dict))
|
||||
(has-children false)
|
||||
(in-key false))
|
||||
(for-each
|
||||
(fn (p)
|
||||
(if (and (= (type-of p) "list")
|
||||
(= (len p) 3)
|
||||
(= (type-of (first p)) "symbol")
|
||||
(= (type-of (nth p 1)) "keyword")
|
||||
(= (keyword-name (nth p 1)) "as"))
|
||||
;; Typed param: (name :as type)
|
||||
(let ((name (symbol-name (first p)))
|
||||
(ptype (nth p 2)))
|
||||
;; Convert type to string if it's a symbol
|
||||
(let ((type-val (if (= (type-of ptype) "symbol")
|
||||
(symbol-name ptype)
|
||||
ptype)))
|
||||
(when (not has-children)
|
||||
(append! params name)
|
||||
(dict-set! param-types name type-val))))
|
||||
;; Untyped param or marker
|
||||
(when (= (type-of p) "symbol")
|
||||
(let ((name (symbol-name p)))
|
||||
(cond
|
||||
@@ -552,13 +589,13 @@
|
||||
(= name "&children") (set! has-children true)
|
||||
has-children nil ;; skip params after &children/&rest
|
||||
in-key (append! params name)
|
||||
:else (append! params name)))))
|
||||
:else (append! params name))))))
|
||||
params-expr)
|
||||
(list params has-children))))
|
||||
(list params has-children param-types))))
|
||||
|
||||
|
||||
(define sf-defisland
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; (defisland ~name (params) body)
|
||||
;; Like defcomp but creates an island (reactive component).
|
||||
;; Islands have the same calling convention as components but
|
||||
@@ -576,7 +613,7 @@
|
||||
|
||||
|
||||
(define sf-defmacro
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((name-sym (first args))
|
||||
(params-raw (nth args 1))
|
||||
(body (nth args 2))
|
||||
@@ -588,7 +625,7 @@
|
||||
mac))))
|
||||
|
||||
(define parse-macro-params
|
||||
(fn (params-expr)
|
||||
(fn ((params-expr :as list))
|
||||
;; Parse (a b &rest rest) → ((a b) rest)
|
||||
(let ((params (list))
|
||||
(rest-param nil))
|
||||
@@ -609,7 +646,7 @@
|
||||
|
||||
|
||||
(define sf-defstyle
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; (defstyle name expr) — bind name to evaluated expr (string, function, etc.)
|
||||
(let ((name-sym (first args))
|
||||
(value (trampoline (eval-expr (nth args 1) env))))
|
||||
@@ -618,7 +655,7 @@
|
||||
|
||||
|
||||
(define sf-begin
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(if (empty? args)
|
||||
nil
|
||||
(do
|
||||
@@ -629,16 +666,16 @@
|
||||
|
||||
|
||||
(define sf-quote
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(if (empty? args) nil (first args))))
|
||||
|
||||
|
||||
(define sf-quasiquote
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(qq-expand (first args) env)))
|
||||
|
||||
(define qq-expand
|
||||
(fn (template env)
|
||||
(fn (template (env :as dict))
|
||||
(if (not (= (type-of template) "list"))
|
||||
template
|
||||
(if (empty? template)
|
||||
@@ -663,7 +700,7 @@
|
||||
|
||||
|
||||
(define sf-thread-first
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((val (trampoline (eval-expr (first args) env))))
|
||||
(reduce
|
||||
(fn (result form)
|
||||
@@ -690,7 +727,7 @@
|
||||
|
||||
|
||||
(define sf-set!
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((name (symbol-name (first args)))
|
||||
(value (trampoline (eval-expr (nth args 1) env))))
|
||||
(env-set! env name value)
|
||||
@@ -711,7 +748,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-letrec
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((bindings (first args))
|
||||
(body (rest args))
|
||||
(local (env-extend env))
|
||||
@@ -786,7 +823,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-dynamic-wind
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((before (trampoline (eval-expr (first args) env)))
|
||||
(body (trampoline (eval-expr (nth args 1) env)))
|
||||
(after (trampoline (eval-expr (nth args 2) env))))
|
||||
@@ -805,7 +842,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define expand-macro
|
||||
(fn (mac raw-args env)
|
||||
(fn ((mac :as macro) (raw-args :as list) (env :as dict))
|
||||
(let ((local (env-merge (macro-closure mac) env)))
|
||||
;; Bind positional params (unevaluated)
|
||||
(for-each
|
||||
@@ -829,20 +866,20 @@
|
||||
|
||||
;; call-fn: unified caller for HO forms — handles both Lambda and native callable
|
||||
(define call-fn
|
||||
(fn (f args env)
|
||||
(fn (f (args :as list) (env :as dict))
|
||||
(cond
|
||||
(lambda? f) (trampoline (call-lambda f args env))
|
||||
(callable? f) (apply f args)
|
||||
:else (error (str "Not callable in HO form: " (inspect f))))))
|
||||
|
||||
(define ho-map
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((f (trampoline (eval-expr (first args) env)))
|
||||
(coll (trampoline (eval-expr (nth args 1) env))))
|
||||
(map (fn (item) (call-fn f (list item) env)) coll))))
|
||||
|
||||
(define ho-map-indexed
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((f (trampoline (eval-expr (first args) env)))
|
||||
(coll (trampoline (eval-expr (nth args 1) env))))
|
||||
(map-indexed
|
||||
@@ -850,7 +887,7 @@
|
||||
coll))))
|
||||
|
||||
(define ho-filter
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((f (trampoline (eval-expr (first args) env)))
|
||||
(coll (trampoline (eval-expr (nth args 1) env))))
|
||||
(filter
|
||||
@@ -858,7 +895,7 @@
|
||||
coll))))
|
||||
|
||||
(define ho-reduce
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((f (trampoline (eval-expr (first args) env)))
|
||||
(init (trampoline (eval-expr (nth args 1) env)))
|
||||
(coll (trampoline (eval-expr (nth args 2) env))))
|
||||
@@ -868,7 +905,7 @@
|
||||
coll))))
|
||||
|
||||
(define ho-some
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((f (trampoline (eval-expr (first args) env)))
|
||||
(coll (trampoline (eval-expr (nth args 1) env))))
|
||||
(some
|
||||
@@ -876,7 +913,7 @@
|
||||
coll))))
|
||||
|
||||
(define ho-every
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((f (trampoline (eval-expr (first args) env)))
|
||||
(coll (trampoline (eval-expr (nth args 1) env))))
|
||||
(every?
|
||||
@@ -885,7 +922,7 @@
|
||||
|
||||
|
||||
(define ho-for-each
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((f (trampoline (eval-expr (first args) env)))
|
||||
(coll (trampoline (eval-expr (nth args 1) env))))
|
||||
(for-each
|
||||
|
||||
@@ -22,7 +22,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define parse-key-params
|
||||
(fn (params-expr)
|
||||
(fn ((params-expr :as list))
|
||||
(let ((params (list))
|
||||
(in-key false))
|
||||
(for-each
|
||||
@@ -42,7 +42,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-defhandler
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((name-sym (first args))
|
||||
(params-raw (nth args 1))
|
||||
(body (nth args 2))
|
||||
@@ -58,7 +58,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-defquery
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((name-sym (first args))
|
||||
(params-raw (nth args 1))
|
||||
(name (symbol-name name-sym))
|
||||
@@ -77,7 +77,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-defaction
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((name-sym (first args))
|
||||
(params-raw (nth args 1))
|
||||
(name (symbol-name name-sym))
|
||||
@@ -98,7 +98,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define sf-defpage
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
(let ((name-sym (first args))
|
||||
(name (symbol-name name-sym))
|
||||
(slots {}))
|
||||
@@ -106,7 +106,7 @@
|
||||
(let ((i 1)
|
||||
(max-i (len args)))
|
||||
(for-each
|
||||
(fn (idx)
|
||||
(fn ((idx :as number))
|
||||
(when (and (< idx max-i)
|
||||
(= (type-of (nth args idx)) "keyword"))
|
||||
(when (< (+ idx 1) max-i)
|
||||
@@ -195,28 +195,28 @@
|
||||
|
||||
;; Extract stream-id from a data chunk dict, defaulting to "stream-content"
|
||||
(define stream-chunk-id
|
||||
(fn (chunk)
|
||||
(fn ((chunk :as dict))
|
||||
(if (has-key? chunk "stream-id")
|
||||
(get chunk "stream-id")
|
||||
"stream-content")))
|
||||
|
||||
;; Remove stream-id from chunk, returning only the bindings
|
||||
(define stream-chunk-bindings
|
||||
(fn (chunk)
|
||||
(fn ((chunk :as dict))
|
||||
(dissoc chunk "stream-id")))
|
||||
|
||||
;; Normalize binding keys: underscore → hyphen
|
||||
(define normalize-binding-key
|
||||
(fn (key)
|
||||
(fn ((key :as string))
|
||||
(replace key "_" "-")))
|
||||
|
||||
;; Bind a data chunk's keys into a fresh env (isolated per chunk)
|
||||
(define bind-stream-chunk
|
||||
(fn (chunk base-env)
|
||||
(fn ((chunk :as dict) (base-env :as dict))
|
||||
(let ((env (merge {} base-env))
|
||||
(bindings (stream-chunk-bindings chunk)))
|
||||
(for-each
|
||||
(fn (key)
|
||||
(fn ((key :as string))
|
||||
(env-set! env (normalize-binding-key key)
|
||||
(get bindings key)))
|
||||
(keys bindings))
|
||||
|
||||
@@ -528,7 +528,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-mangle
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(let ((renamed (get js-renames name)))
|
||||
(if (not (nil? renamed))
|
||||
renamed
|
||||
@@ -549,7 +549,7 @@
|
||||
result))))))))
|
||||
|
||||
(define js-kebab-to-camel
|
||||
(fn (s)
|
||||
(fn ((s :as string))
|
||||
(let ((parts (split s "-")))
|
||||
(if (<= (len parts) 1)
|
||||
s
|
||||
@@ -557,7 +557,7 @@
|
||||
(join "" (map (fn (p) (js-capitalize p)) (rest parts))))))))
|
||||
|
||||
(define js-capitalize
|
||||
(fn (s)
|
||||
(fn ((s :as string))
|
||||
(if (empty? s) s
|
||||
(str (upper (slice s 0 1)) (slice s 1)))))
|
||||
|
||||
@@ -567,7 +567,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-quote-string
|
||||
(fn (s)
|
||||
(fn ((s :as string))
|
||||
(str "\""
|
||||
(replace (replace (replace (replace (replace (replace
|
||||
s "\\" "\\\\") "\"" "\\\"") "\n" "\\n") "\r" "\\r") "\t" "\\t") "\0" "\\0")
|
||||
@@ -582,11 +582,11 @@
|
||||
(list "+" "-" "*" "/" "=" "!=" "<" ">" "<=" ">=" "mod"))
|
||||
|
||||
(define js-infix?
|
||||
(fn (op)
|
||||
(fn ((op :as string))
|
||||
(some (fn (x) (= x op)) js-infix-ops)))
|
||||
|
||||
(define js-op-symbol
|
||||
(fn (op)
|
||||
(fn ((op :as string))
|
||||
(case op
|
||||
"=" "=="
|
||||
"!=" "!="
|
||||
@@ -599,13 +599,13 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-is-self-tail-recursive?
|
||||
(fn (name body)
|
||||
(fn ((name :as string) (body :as list))
|
||||
(if (empty? body)
|
||||
false
|
||||
(js-has-tail-call? name (last body)))))
|
||||
|
||||
(define js-has-tail-call?
|
||||
(fn (name expr)
|
||||
(fn ((name :as string) expr)
|
||||
(if (not (and (list? expr) (not (empty? expr))))
|
||||
false
|
||||
(let ((head (first expr)))
|
||||
@@ -642,7 +642,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-tail-as-stmt
|
||||
(fn (name expr)
|
||||
(fn ((name :as string) expr)
|
||||
(if (not (and (list? expr) (not (empty? expr))))
|
||||
(str "return " (js-expr expr) ";")
|
||||
(let ((head (first expr)))
|
||||
@@ -702,7 +702,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-cond-as-loop-stmt
|
||||
(fn (name clauses)
|
||||
(fn ((name :as string) (clauses :as list))
|
||||
(if (empty? clauses)
|
||||
"return NIL;"
|
||||
;; Detect scheme vs clojure
|
||||
@@ -714,7 +714,7 @@
|
||||
(js-cond-clojure-loop name clauses 0 0 false))))))
|
||||
|
||||
(define js-cond-scheme-loop
|
||||
(fn (name clauses i)
|
||||
(fn ((name :as string) (clauses :as list) (i :as number))
|
||||
(if (>= i (len clauses))
|
||||
"else { return NIL; }"
|
||||
(let ((clause (nth clauses i))
|
||||
@@ -728,7 +728,7 @@
|
||||
(js-cond-scheme-loop name clauses (+ i 1))))))))
|
||||
|
||||
(define js-cond-clojure-loop
|
||||
(fn (name clauses i clause-idx has-else)
|
||||
(fn ((name :as string) (clauses :as list) (i :as number) (clause-idx :as number) (has-else :as boolean))
|
||||
(if (>= i (len clauses))
|
||||
(if has-else "" " else { return NIL; }")
|
||||
(let ((c (nth clauses i)))
|
||||
@@ -749,7 +749,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-loop-body
|
||||
(fn (name body)
|
||||
(fn ((name :as string) (body :as list))
|
||||
(if (empty? body)
|
||||
"return NIL;"
|
||||
(str (join "\n" (map (fn (e) (js-statement e))
|
||||
@@ -805,7 +805,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-native-dict
|
||||
(fn (d)
|
||||
(fn ((d :as dict))
|
||||
(let ((items (keys d)))
|
||||
(str "{" (join ", " (map (fn (k)
|
||||
(str (js-quote-string k) ": " (js-expr (get d k))))
|
||||
@@ -963,11 +963,11 @@
|
||||
(str "function(" params-str ") { " (join "\n" parts) " }")))))))))
|
||||
|
||||
(define js-collect-params
|
||||
(fn (params)
|
||||
(fn ((params :as list))
|
||||
(js-collect-params-loop params 0 (list) nil)))
|
||||
|
||||
(define js-collect-params-loop
|
||||
(fn (params i result rest-name)
|
||||
(fn ((params :as list) (i :as number) (result :as list) rest-name)
|
||||
(if (>= i (len params))
|
||||
(list result rest-name)
|
||||
(let ((p (nth params i)))
|
||||
@@ -975,13 +975,25 @@
|
||||
;; &rest marker
|
||||
(and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
|
||||
(if (< (+ i 1) (len params))
|
||||
(let ((rp (nth params (+ i 1))))
|
||||
(js-collect-params-loop params (+ i 2) result
|
||||
(js-mangle (symbol-name (nth params (+ i 1)))))
|
||||
(js-mangle
|
||||
(if (and (= (type-of rp) "list") (= (len rp) 3)
|
||||
(= (type-of (nth rp 1)) "keyword")
|
||||
(= (keyword-name (nth rp 1)) "as"))
|
||||
(symbol-name (first rp))
|
||||
(if (= (type-of rp) "symbol") (symbol-name rp) (str rp))))))
|
||||
(js-collect-params-loop params (+ i 1) result rest-name))
|
||||
;; Normal param
|
||||
(= (type-of p) "symbol")
|
||||
(js-collect-params-loop params (+ i 1)
|
||||
(append result (js-mangle (symbol-name p))) rest-name)
|
||||
;; Annotated param: (name :as type) → extract name
|
||||
(and (= (type-of p) "list") (= (len p) 3)
|
||||
(= (type-of (nth p 1)) "keyword")
|
||||
(= (keyword-name (nth p 1)) "as"))
|
||||
(js-collect-params-loop params (+ i 1)
|
||||
(append result (js-mangle (symbol-name (first p)))) rest-name)
|
||||
;; Something else
|
||||
:else
|
||||
(js-collect-params-loop params (+ i 1)
|
||||
@@ -1024,7 +1036,7 @@
|
||||
(js-parse-clojure-let-bindings bindings 0 (list))))))
|
||||
|
||||
(define js-parse-clojure-let-bindings
|
||||
(fn (bindings i result)
|
||||
(fn (bindings (i :as number) (result :as list))
|
||||
(if (>= i (- (len bindings) 1))
|
||||
result
|
||||
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
||||
@@ -1050,7 +1062,7 @@
|
||||
(str (js-emit-clojure-let-vars bindings 0 (list)) " ")))))
|
||||
|
||||
(define js-emit-clojure-let-vars
|
||||
(fn (bindings i result)
|
||||
(fn (bindings (i :as number) (result :as list))
|
||||
(if (>= i (- (len bindings) 1))
|
||||
(join " " result)
|
||||
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
||||
@@ -1062,7 +1074,7 @@
|
||||
|
||||
;; Helper to append let binding var declarations to a parts list
|
||||
(define js-append-let-binding-parts
|
||||
(fn (bindings parts)
|
||||
(fn (bindings (parts :as list))
|
||||
(when (and (list? bindings) (not (empty? bindings)))
|
||||
(if (list? (first bindings))
|
||||
;; Scheme-style
|
||||
@@ -1076,7 +1088,7 @@
|
||||
(js-append-clojure-bindings bindings parts 0)))))
|
||||
|
||||
(define js-append-clojure-bindings
|
||||
(fn (bindings parts i)
|
||||
(fn (bindings (parts :as list) (i :as number))
|
||||
(when (< i (- (len bindings) 1))
|
||||
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
||||
(symbol-name (nth bindings i))
|
||||
@@ -1105,7 +1117,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-cond
|
||||
(fn (clauses)
|
||||
(fn ((clauses :as list))
|
||||
(if (empty? clauses)
|
||||
"NIL"
|
||||
;; Detect scheme vs clojure style
|
||||
@@ -1123,7 +1135,7 @@
|
||||
(and (= (type-of test) "keyword") (= (keyword-name test) "else")))))
|
||||
|
||||
(define js-cond-scheme
|
||||
(fn (clauses)
|
||||
(fn ((clauses :as list))
|
||||
(if (empty? clauses)
|
||||
"NIL"
|
||||
(let ((clause (first clauses))
|
||||
@@ -1135,7 +1147,7 @@
|
||||
" : " (js-cond-scheme (rest clauses)) ")"))))))
|
||||
|
||||
(define js-cond-clojure
|
||||
(fn (clauses)
|
||||
(fn ((clauses :as list))
|
||||
(if (< (len clauses) 2)
|
||||
"NIL"
|
||||
(let ((test (first clauses))
|
||||
@@ -1151,14 +1163,14 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-case
|
||||
(fn (args)
|
||||
(fn ((args :as list))
|
||||
(let ((match-expr (js-expr (first args)))
|
||||
(clauses (rest args)))
|
||||
(str "(function() { var _m = " match-expr "; "
|
||||
(js-case-chain clauses) " })()"))))
|
||||
|
||||
(define js-case-chain
|
||||
(fn (clauses)
|
||||
(fn ((clauses :as list))
|
||||
(if (< (len clauses) 2)
|
||||
"return NIL;"
|
||||
(let ((test (nth clauses 0))
|
||||
@@ -1175,7 +1187,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-and
|
||||
(fn (args)
|
||||
(fn ((args :as list))
|
||||
(let ((parts (map js-expr args)))
|
||||
(if (= (len parts) 1)
|
||||
(first parts)
|
||||
@@ -1190,7 +1202,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-or
|
||||
(fn (args)
|
||||
(fn ((args :as list))
|
||||
(if (= (len args) 1)
|
||||
(js-expr (first args))
|
||||
(str "sxOr(" (join ", " (map js-expr args)) ")"))))
|
||||
@@ -1201,7 +1213,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-do
|
||||
(fn (args)
|
||||
(fn ((args :as list))
|
||||
(if (= (len args) 1)
|
||||
(js-expr (first args))
|
||||
(str "(" (join ", " (map js-expr args)) ")"))))
|
||||
@@ -1212,11 +1224,11 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-dict-literal
|
||||
(fn (pairs)
|
||||
(fn ((pairs :as list))
|
||||
(str "{" (js-dict-pairs-str pairs 0 (list)) "}")))
|
||||
|
||||
(define js-dict-pairs-str
|
||||
(fn (pairs i result)
|
||||
(fn ((pairs :as list) (i :as number) (result :as list))
|
||||
(if (>= i (- (len pairs) 1))
|
||||
(join ", " result)
|
||||
(let ((key (nth pairs i))
|
||||
@@ -1234,7 +1246,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-emit-infix
|
||||
(fn (op args)
|
||||
(fn ((op :as string) (args :as list))
|
||||
(let ((js-op (js-op-symbol op)))
|
||||
(if (and (= (len args) 1) (= op "-"))
|
||||
(str "(-" (js-expr (first args)) ")")
|
||||
@@ -1290,8 +1302,9 @@
|
||||
(= name "append!")
|
||||
(str (js-expr (nth expr 1)) ".push(" (js-expr (nth expr 2)) ");")
|
||||
(= name "env-set!")
|
||||
(str (js-expr (nth expr 1)) "[" (js-expr (nth expr 2))
|
||||
"] = " (js-expr (nth expr 3)) ";")
|
||||
(str "envSet(" (js-expr (nth expr 1))
|
||||
", " (js-expr (nth expr 2))
|
||||
", " (js-expr (nth expr 3)) ");")
|
||||
(= name "set-lambda-name!")
|
||||
(str (js-expr (nth expr 1)) ".name = " (js-expr (nth expr 2)) ";")
|
||||
:else
|
||||
@@ -1356,9 +1369,16 @@
|
||||
;; Inline lambda → for loop
|
||||
(let ((params (nth fn-expr 1))
|
||||
(body (rest (rest fn-expr)))
|
||||
(p (if (= (type-of (first params)) "symbol")
|
||||
(symbol-name (first params))
|
||||
(str (first params))))
|
||||
(raw-p (first params))
|
||||
(p (cond
|
||||
(= (type-of raw-p) "symbol")
|
||||
(symbol-name raw-p)
|
||||
;; (name :as type) annotation → extract name
|
||||
(and (= (type-of raw-p) "list") (= (len raw-p) 3)
|
||||
(= (type-of (nth raw-p 1)) "keyword")
|
||||
(= (keyword-name (nth raw-p 1)) "as"))
|
||||
(symbol-name (first raw-p))
|
||||
:else (str raw-p)))
|
||||
(p-js (js-mangle p)))
|
||||
(str "{ var _c = " coll "; for (var _i = 0; _i < _c.length; _i++) { var "
|
||||
p-js " = _c[_i]; "
|
||||
@@ -1373,7 +1393,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define js-translate-file
|
||||
(fn (defines)
|
||||
(fn ((defines :as list))
|
||||
(join "\n" (map (fn (pair)
|
||||
(let ((name (first pair))
|
||||
(expr (nth pair 1)))
|
||||
|
||||
@@ -34,7 +34,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define dispatch-trigger-events
|
||||
(fn (el header-val)
|
||||
(fn (el (header-val :as string))
|
||||
;; Dispatch events from SX-Trigger / SX-Trigger-After-Swap headers.
|
||||
;; Value can be JSON object (name → detail) or comma-separated names.
|
||||
(when header-val
|
||||
@@ -42,12 +42,12 @@
|
||||
(if parsed
|
||||
;; JSON object: keys are event names, values are detail
|
||||
(for-each
|
||||
(fn (key)
|
||||
(fn ((key :as string))
|
||||
(dom-dispatch el key (get parsed key)))
|
||||
(keys parsed))
|
||||
;; Comma-separated event names
|
||||
(for-each
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(let ((trimmed (trim name)))
|
||||
(when (not (empty? trimmed))
|
||||
(dom-dispatch el trimmed (dict)))))
|
||||
@@ -73,7 +73,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define execute-request
|
||||
(fn (el verbInfo extraParams)
|
||||
(fn (el (verbInfo :as dict) (extraParams :as dict))
|
||||
;; Gate checks then delegate to do-fetch.
|
||||
;; verbInfo: dict with "method" and "url" (or nil to read from element).
|
||||
;; Re-read from element in case attributes were morphed since binding.
|
||||
@@ -106,7 +106,7 @@
|
||||
|
||||
|
||||
(define do-fetch
|
||||
(fn (el verb method url extraParams)
|
||||
(fn (el (verb :as string) (method :as string) (url :as string) (extraParams :as dict))
|
||||
;; Execute the actual fetch. Manages abort, headers, body, loading state.
|
||||
(let ((sync (dom-get-attr el "sx-sync")))
|
||||
;; Abort previous if sync mode (per-element)
|
||||
@@ -140,7 +140,7 @@
|
||||
;; Merge extra params as headers
|
||||
(when extraParams
|
||||
(for-each
|
||||
(fn (k) (dict-set! headers k (get extraParams k)))
|
||||
(fn ((k :as string)) (dict-set! headers k (get extraParams k)))
|
||||
(keys extraParams)))
|
||||
|
||||
;; Content-Type
|
||||
@@ -172,7 +172,7 @@
|
||||
"cross-origin" (cross-origin? final-url)
|
||||
"preloaded" cached)
|
||||
;; Success callback
|
||||
(fn (resp-ok status get-header text)
|
||||
(fn ((resp-ok :as boolean) (status :as number) get-header (text :as string))
|
||||
(do
|
||||
(clear-loading-state el indicator disabled-elts)
|
||||
(revert-optimistic optimistic-state)
|
||||
@@ -202,7 +202,7 @@
|
||||
|
||||
|
||||
(define handle-fetch-success
|
||||
(fn (el url verb extraParams get-header text)
|
||||
(fn (el (url :as string) (verb :as string) (extraParams :as dict) get-header (text :as string))
|
||||
;; Route a successful response through the appropriate handler.
|
||||
(let ((resp-headers (process-response-headers get-header)))
|
||||
;; CSS hash update
|
||||
@@ -270,7 +270,7 @@
|
||||
|
||||
|
||||
(define handle-sx-response
|
||||
(fn (el target text swap-style use-transition)
|
||||
(fn (el target (text :as string) (swap-style :as string) (use-transition :as boolean))
|
||||
;; Handle SX-format response: strip components, extract CSS, render, swap.
|
||||
(let ((cleaned (strip-component-scripts text)))
|
||||
(let ((final (extract-response-css cleaned)))
|
||||
@@ -281,7 +281,7 @@
|
||||
(dom-append container rendered)
|
||||
;; Process OOB swaps
|
||||
(process-oob-swaps container
|
||||
(fn (t oob s)
|
||||
(fn (t oob (s :as string))
|
||||
(dispose-islands-in t)
|
||||
(swap-dom-nodes t oob s)
|
||||
(sx-hydrate t)
|
||||
@@ -301,7 +301,7 @@
|
||||
|
||||
|
||||
(define handle-html-response
|
||||
(fn (el target text swap-style use-transition)
|
||||
(fn (el target (text :as string) (swap-style :as string) (use-transition :as boolean))
|
||||
;; Handle HTML-format response: parse, OOB, select, swap.
|
||||
(let ((doc (dom-parse-html-document text)))
|
||||
(when doc
|
||||
@@ -320,7 +320,7 @@
|
||||
(dom-set-inner-html container (dom-body-inner-html doc))
|
||||
;; Process OOB swaps
|
||||
(process-oob-swaps container
|
||||
(fn (t oob s)
|
||||
(fn (t oob (s :as string))
|
||||
(dispose-islands-in t)
|
||||
(swap-dom-nodes t oob s)
|
||||
(post-swap t)))
|
||||
@@ -338,7 +338,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-retry
|
||||
(fn (el verb method url extraParams)
|
||||
(fn (el (verb :as string) (method :as string) (url :as string) (extraParams :as dict))
|
||||
;; Handle retry on failure if sx-retry is configured
|
||||
(let ((retry-attr (dom-get-attr el "sx-retry"))
|
||||
(spec (parse-retry-spec retry-attr)))
|
||||
@@ -358,12 +358,12 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define bind-triggers
|
||||
(fn (el verbInfo)
|
||||
(fn (el (verbInfo :as dict))
|
||||
;; Bind triggers from sx-trigger attribute (or defaults)
|
||||
(let ((triggers (or (parse-trigger-spec (dom-get-attr el "sx-trigger"))
|
||||
(default-trigger (dom-tag-name el)))))
|
||||
(for-each
|
||||
(fn (trigger)
|
||||
(fn ((trigger :as dict))
|
||||
(let ((kind (classify-trigger trigger))
|
||||
(mods (get trigger "modifiers")))
|
||||
(cond
|
||||
@@ -393,7 +393,7 @@
|
||||
|
||||
|
||||
(define bind-event
|
||||
(fn (el event-name mods verbInfo)
|
||||
(fn (el (event-name :as string) (mods :as dict) (verbInfo :as dict))
|
||||
;; Bind a standard DOM event trigger.
|
||||
;; Handles delay, once, changed, optimistic, preventDefault.
|
||||
(let ((timer nil)
|
||||
@@ -506,12 +506,12 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define process-oob-swaps
|
||||
(fn (container swap-fn)
|
||||
(fn (container (swap-fn :as lambda))
|
||||
;; Find and process out-of-band swaps in container.
|
||||
;; swap-fn is (fn (target oob-element swap-type) ...).
|
||||
(let ((oobs (find-oob-swaps container)))
|
||||
(for-each
|
||||
(fn (oob)
|
||||
(fn ((oob :as dict))
|
||||
(let ((target-id (get oob "target-id"))
|
||||
(target (dom-query-by-id target-id))
|
||||
(oob-el (get oob "element"))
|
||||
@@ -610,7 +610,7 @@
|
||||
(define _page-data-cache-ttl 30000) ;; 30 seconds in ms
|
||||
|
||||
(define page-data-cache-key
|
||||
(fn (page-name params)
|
||||
(fn ((page-name :as string) (params :as dict))
|
||||
;; Build a cache key from page name + params.
|
||||
;; Params are from route matching so order is deterministic.
|
||||
(let ((base page-name))
|
||||
@@ -618,13 +618,13 @@
|
||||
base
|
||||
(let ((parts (list)))
|
||||
(for-each
|
||||
(fn (k)
|
||||
(fn ((k :as string))
|
||||
(append! parts (str k "=" (get params k))))
|
||||
(keys params))
|
||||
(str base ":" (join "&" parts)))))))
|
||||
|
||||
(define page-data-cache-get
|
||||
(fn (cache-key)
|
||||
(fn ((cache-key :as string))
|
||||
;; Return cached data if fresh, else nil.
|
||||
(let ((entry (get _page-data-cache cache-key)))
|
||||
(if (nil? entry)
|
||||
@@ -636,7 +636,7 @@
|
||||
(get entry "data"))))))
|
||||
|
||||
(define page-data-cache-set
|
||||
(fn (cache-key data)
|
||||
(fn ((cache-key :as string) data)
|
||||
;; Store data with current timestamp.
|
||||
(dict-set! _page-data-cache cache-key
|
||||
{"data" data "ts" (now-ms)})))
|
||||
@@ -647,12 +647,12 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define invalidate-page-cache
|
||||
(fn (page-name)
|
||||
(fn ((page-name :as string))
|
||||
;; Clear cached data for a page. Removes all cache entries whose key
|
||||
;; matches page-name (exact) or starts with "page-name:" (with params).
|
||||
;; Also notifies the service worker to clear its IndexedDB entries.
|
||||
(for-each
|
||||
(fn (k)
|
||||
(fn ((k :as string))
|
||||
(when (or (= k page-name) (starts-with? k (str page-name ":")))
|
||||
(dict-set! _page-data-cache k nil)))
|
||||
(keys _page-data-cache))
|
||||
@@ -667,7 +667,7 @@
|
||||
(log-info "sx:cache invalidate *")))
|
||||
|
||||
(define update-page-cache
|
||||
(fn (page-name data)
|
||||
(fn ((page-name :as string) data)
|
||||
;; Replace cached data for a page with server-provided data.
|
||||
;; Uses a bare page-name key (no params) — the server knows the
|
||||
;; canonical data shape for the page.
|
||||
@@ -676,7 +676,7 @@
|
||||
(log-info (str "sx:cache update " page-name)))))
|
||||
|
||||
(define process-cache-directives
|
||||
(fn (el resp-headers response-text)
|
||||
(fn (el (resp-headers :as dict) (response-text :as string))
|
||||
;; Process cache invalidation and update directives from both
|
||||
;; element attributes and response headers.
|
||||
;;
|
||||
@@ -722,7 +722,7 @@
|
||||
(define _optimistic-snapshots (dict))
|
||||
|
||||
(define optimistic-cache-update
|
||||
(fn (cache-key mutator)
|
||||
(fn ((cache-key :as string) (mutator :as lambda))
|
||||
;; Apply predicted mutation to cached data. Saves snapshot for rollback.
|
||||
;; Returns predicted data or nil if no cached data exists.
|
||||
(let ((cached (page-data-cache-get cache-key)))
|
||||
@@ -735,7 +735,7 @@
|
||||
predicted)))))
|
||||
|
||||
(define optimistic-cache-revert
|
||||
(fn (cache-key)
|
||||
(fn ((cache-key :as string))
|
||||
;; Revert to pre-mutation snapshot. Returns restored data or nil.
|
||||
(let ((snapshot (get _optimistic-snapshots cache-key)))
|
||||
(when snapshot
|
||||
@@ -744,12 +744,12 @@
|
||||
snapshot))))
|
||||
|
||||
(define optimistic-cache-confirm
|
||||
(fn (cache-key)
|
||||
(fn ((cache-key :as string))
|
||||
;; Server accepted — discard the rollback snapshot.
|
||||
(dict-delete! _optimistic-snapshots cache-key)))
|
||||
|
||||
(define submit-mutation
|
||||
(fn (page-name params action-name payload mutator-fn on-complete)
|
||||
(fn ((page-name :as string) (params :as dict) (action-name :as string) payload (mutator-fn :as lambda) (on-complete :as lambda))
|
||||
;; Optimistic mutation: predict locally, send to server, confirm or revert.
|
||||
;; on-complete is called with "confirmed" or "reverted" status.
|
||||
(let ((cache-key (page-data-cache-key page-name params))
|
||||
@@ -768,7 +768,7 @@
|
||||
(try-rerender-page page-name params result))
|
||||
(log-info (str "sx:optimistic confirmed " page-name))
|
||||
(when on-complete (on-complete "confirmed")))
|
||||
(fn (error)
|
||||
(fn ((error :as string))
|
||||
;; Failure: revert to snapshot
|
||||
(let ((reverted (optimistic-cache-revert cache-key)))
|
||||
(when reverted
|
||||
@@ -791,11 +791,11 @@
|
||||
(fn () _is-online))
|
||||
|
||||
(define offline-set-online!
|
||||
(fn (val)
|
||||
(fn ((val :as boolean))
|
||||
(set! _is-online val)))
|
||||
|
||||
(define offline-queue-mutation
|
||||
(fn (action-name payload page-name params mutator-fn)
|
||||
(fn ((action-name :as string) payload (page-name :as string) (params :as dict) (mutator-fn :as lambda))
|
||||
;; Queue a mutation for later sync. Apply optimistic update locally.
|
||||
(let ((cache-key (page-data-cache-key page-name params))
|
||||
(entry (dict
|
||||
@@ -816,26 +816,26 @@
|
||||
(define offline-sync
|
||||
(fn ()
|
||||
;; Replay all pending mutations. Called on reconnect.
|
||||
(let ((pending (filter (fn (e) (= (get e "status") "pending")) _offline-queue)))
|
||||
(let ((pending (filter (fn ((e :as dict)) (= (get e "status") "pending")) _offline-queue)))
|
||||
(when (not (empty? pending))
|
||||
(log-info (str "sx:offline syncing " (len pending) " mutations"))
|
||||
(for-each
|
||||
(fn (entry)
|
||||
(fn ((entry :as dict))
|
||||
(execute-action (get entry "action") (get entry "payload")
|
||||
(fn (result)
|
||||
(dict-set! entry "status" "synced")
|
||||
(log-info (str "sx:offline synced " (get entry "action"))))
|
||||
(fn (error)
|
||||
(fn ((error :as string))
|
||||
(dict-set! entry "status" "failed")
|
||||
(log-warn (str "sx:offline sync failed " (get entry "action") ": " error)))))
|
||||
pending)))))
|
||||
|
||||
(define offline-pending-count
|
||||
(fn ()
|
||||
(len (filter (fn (e) (= (get e "status") "pending")) _offline-queue))))
|
||||
(len (filter (fn ((e :as dict)) (= (get e "status") "pending")) _offline-queue))))
|
||||
|
||||
(define offline-aware-mutation
|
||||
(fn (page-name params action-name payload mutator-fn on-complete)
|
||||
(fn ((page-name :as string) (params :as dict) (action-name :as string) payload (mutator-fn :as lambda) (on-complete :as lambda))
|
||||
;; Top-level mutation function. Routes to submit-mutation when online,
|
||||
;; offline-queue-mutation when offline.
|
||||
(if _is-online
|
||||
@@ -860,7 +860,7 @@
|
||||
|
||||
|
||||
(define swap-rendered-content
|
||||
(fn (target rendered pathname)
|
||||
(fn (target rendered (pathname :as string))
|
||||
;; Swap rendered DOM content into target and run post-processing.
|
||||
;; Shared by pure and data page client routes.
|
||||
(do
|
||||
@@ -876,7 +876,7 @@
|
||||
|
||||
|
||||
(define resolve-route-target
|
||||
(fn (target-sel)
|
||||
(fn ((target-sel :as string))
|
||||
;; Resolve a target selector to a DOM element, or nil.
|
||||
(if (and target-sel (not (= target-sel "true")))
|
||||
(dom-query target-sel)
|
||||
@@ -884,17 +884,17 @@
|
||||
|
||||
|
||||
(define deps-satisfied?
|
||||
(fn (match)
|
||||
(fn ((match :as dict))
|
||||
;; Check if all component deps for a page are loaded client-side.
|
||||
(let ((deps (get match "deps"))
|
||||
(loaded (loaded-component-names)))
|
||||
(if (or (nil? deps) (empty? deps))
|
||||
true
|
||||
(every? (fn (dep) (contains? loaded dep)) deps)))))
|
||||
(every? (fn ((dep :as string)) (contains? loaded dep)) deps)))))
|
||||
|
||||
|
||||
(define try-client-route
|
||||
(fn (pathname target-sel)
|
||||
(fn ((pathname :as string) (target-sel :as string))
|
||||
;; Try to render a page client-side. Returns true if successful, false otherwise.
|
||||
;; target-sel is the CSS selector for the swap target (from sx-boost value).
|
||||
;; For pure pages: renders immediately. For :data pages: fetches data then renders.
|
||||
@@ -968,7 +968,7 @@
|
||||
(do
|
||||
(log-info (str "sx:route client+data " pathname))
|
||||
(resolve-page-data page-name params
|
||||
(fn (data)
|
||||
(fn ((data :as dict))
|
||||
(page-data-cache-set cache-key data)
|
||||
(let ((env (merge closure params data)))
|
||||
(if has-io
|
||||
@@ -1012,7 +1012,7 @@
|
||||
|
||||
|
||||
(define bind-client-route-link
|
||||
(fn (link href)
|
||||
(fn (link (href :as string))
|
||||
;; Bind a boost link with client-side routing. If the route can be
|
||||
;; rendered client-side (pure page, no :data), do so. Otherwise
|
||||
;; fall back to standard server fetch via bind-boost-link.
|
||||
@@ -1045,12 +1045,12 @@
|
||||
(let ((source (event-source-connect url el))
|
||||
(event-name (parse-sse-swap el)))
|
||||
(event-source-listen source event-name
|
||||
(fn (data)
|
||||
(fn ((data :as string))
|
||||
(bind-sse-swap el data))))))))
|
||||
|
||||
|
||||
(define bind-sse-swap
|
||||
(fn (el data)
|
||||
(fn (el (data :as string))
|
||||
;; Handle an SSE event: swap data into element
|
||||
(let ((target (resolve-target el))
|
||||
(swap-spec (parse-swap-spec
|
||||
@@ -1089,7 +1089,7 @@
|
||||
(for-each
|
||||
(fn (el)
|
||||
(for-each
|
||||
(fn (attr)
|
||||
(fn ((attr :as list))
|
||||
(let ((name (first attr))
|
||||
(body (nth attr 1)))
|
||||
(when (starts-with? name "sx-on:")
|
||||
@@ -1135,7 +1135,7 @@
|
||||
|
||||
|
||||
(define do-preload
|
||||
(fn (url headers)
|
||||
(fn ((url :as string) (headers :as dict))
|
||||
;; Execute a preload fetch into the cache
|
||||
(when (nil? (preload-cache-get _preload-cache url))
|
||||
(fetch-preload url headers _preload-cache))))
|
||||
@@ -1215,7 +1215,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define handle-popstate
|
||||
(fn (scrollY)
|
||||
(fn ((scrollY :as number))
|
||||
;; Handle browser back/forward navigation.
|
||||
;; Derive target from [sx-boost] container or fall back to #main-panel.
|
||||
;; Try client-side route first, fall back to server fetch.
|
||||
|
||||
368
shared/sx/ref/page-helpers.sx
Normal file
368
shared/sx/ref/page-helpers.sx
Normal file
@@ -0,0 +1,368 @@
|
||||
;; ==========================================================================
|
||||
;; page-helpers.sx — Pure data-transformation page helpers
|
||||
;;
|
||||
;; These functions take raw data (from Python I/O edge) and return
|
||||
;; structured dicts for page rendering. No I/O — pure transformations
|
||||
;; only. Bootstrapped to every host.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; categorize-special-forms
|
||||
;;
|
||||
;; Parses define-special-form declarations from special-forms.sx AST,
|
||||
;; categorizes each form by name lookup, returns dict of category → forms.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define special-form-category-map
|
||||
{"if" "Control Flow" "when" "Control Flow" "cond" "Control Flow"
|
||||
"case" "Control Flow" "and" "Control Flow" "or" "Control Flow"
|
||||
"let" "Binding" "let*" "Binding" "letrec" "Binding"
|
||||
"define" "Binding" "set!" "Binding"
|
||||
"lambda" "Functions & Components" "fn" "Functions & Components"
|
||||
"defcomp" "Functions & Components" "defmacro" "Functions & Components"
|
||||
"begin" "Sequencing & Threading" "do" "Sequencing & Threading"
|
||||
"->" "Sequencing & Threading"
|
||||
"quote" "Quoting" "quasiquote" "Quoting"
|
||||
"reset" "Continuations" "shift" "Continuations"
|
||||
"dynamic-wind" "Guards"
|
||||
"map" "Higher-Order Forms" "map-indexed" "Higher-Order Forms"
|
||||
"filter" "Higher-Order Forms" "reduce" "Higher-Order Forms"
|
||||
"some" "Higher-Order Forms" "every?" "Higher-Order Forms"
|
||||
"for-each" "Higher-Order Forms"
|
||||
"defstyle" "Domain Definitions"
|
||||
"defhandler" "Domain Definitions" "defpage" "Domain Definitions"
|
||||
"defquery" "Domain Definitions" "defaction" "Domain Definitions"})
|
||||
|
||||
|
||||
(define extract-define-kwargs
|
||||
(fn ((expr :as list))
|
||||
;; Extract keyword args from a define-special-form expression.
|
||||
;; Returns dict of keyword-name → string value.
|
||||
;; Walks items pairwise: when item[i] is a keyword, item[i+1] is its value.
|
||||
(let ((result {})
|
||||
(items (slice expr 2))
|
||||
(n (len items)))
|
||||
(for-each
|
||||
(fn ((idx :as number))
|
||||
(when (and (< (+ idx 1) n)
|
||||
(= (type-of (nth items idx)) "keyword"))
|
||||
(let ((key (keyword-name (nth items idx)))
|
||||
(val (nth items (+ idx 1))))
|
||||
(dict-set! result key
|
||||
(if (= (type-of val) "list")
|
||||
(str "(" (join " " (map serialize val)) ")")
|
||||
(str val))))))
|
||||
(range 0 n))
|
||||
result)))
|
||||
|
||||
|
||||
(define categorize-special-forms
|
||||
(fn ((parsed-exprs :as list))
|
||||
;; parsed-exprs: result of parse-all on special-forms.sx
|
||||
;; Returns dict of category-name → list of form dicts.
|
||||
(let ((categories {}))
|
||||
(for-each
|
||||
(fn (expr)
|
||||
(when (and (= (type-of expr) "list")
|
||||
(>= (len expr) 2)
|
||||
(= (type-of (first expr)) "symbol")
|
||||
(= (symbol-name (first expr)) "define-special-form"))
|
||||
(let ((name (nth expr 1))
|
||||
(kwargs (extract-define-kwargs expr))
|
||||
(category (or (get special-form-category-map name) "Other")))
|
||||
(when (not (has-key? categories category))
|
||||
(dict-set! categories category (list)))
|
||||
(append! (get categories category)
|
||||
{"name" name
|
||||
"syntax" (or (get kwargs "syntax") "")
|
||||
"doc" (or (get kwargs "doc") "")
|
||||
"tail-position" (or (get kwargs "tail-position") "")
|
||||
"example" (or (get kwargs "example") "")}))))
|
||||
parsed-exprs)
|
||||
categories)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; build-reference-data
|
||||
;;
|
||||
;; Takes a slug and raw reference data, returns structured dict for rendering.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define build-ref-items-with-href
|
||||
(fn ((items :as list) (base-path :as string) (detail-keys :as list) (n-fields :as number))
|
||||
;; items: list of lists (tuples), each with n-fields elements
|
||||
;; base-path: e.g. "/geography/hypermedia/reference/attributes/"
|
||||
;; detail-keys: list of strings (keys that have detail pages)
|
||||
;; n-fields: 2 or 3 (number of fields per tuple)
|
||||
(map
|
||||
(fn ((item :as list))
|
||||
(if (= n-fields 3)
|
||||
;; [name, desc/value, exists/desc]
|
||||
(let ((name (nth item 0))
|
||||
(field2 (nth item 1))
|
||||
(field3 (nth item 2)))
|
||||
{"name" name
|
||||
"desc" field2
|
||||
"exists" field3
|
||||
"href" (if (and field3 (some (fn ((k :as string)) (= k name)) detail-keys))
|
||||
(str base-path name)
|
||||
nil)})
|
||||
;; [name, desc]
|
||||
(let ((name (nth item 0))
|
||||
(desc (nth item 1)))
|
||||
{"name" name
|
||||
"desc" desc
|
||||
"href" (if (some (fn ((k :as string)) (= k name)) detail-keys)
|
||||
(str base-path name)
|
||||
nil)})))
|
||||
items)))
|
||||
|
||||
|
||||
(define build-reference-data
|
||||
(fn ((slug :as string) (raw-data :as dict) (detail-keys :as list))
|
||||
;; slug: "attributes", "headers", "events", "js-api"
|
||||
;; raw-data: dict with the raw data lists for this slug
|
||||
;; detail-keys: list of names that have detail pages
|
||||
(case slug
|
||||
"attributes"
|
||||
{"req-attrs" (build-ref-items-with-href
|
||||
(get raw-data "req-attrs")
|
||||
"/geography/hypermedia/reference/attributes/" detail-keys 3)
|
||||
"beh-attrs" (build-ref-items-with-href
|
||||
(get raw-data "beh-attrs")
|
||||
"/geography/hypermedia/reference/attributes/" detail-keys 3)
|
||||
"uniq-attrs" (build-ref-items-with-href
|
||||
(get raw-data "uniq-attrs")
|
||||
"/geography/hypermedia/reference/attributes/" detail-keys 3)}
|
||||
|
||||
"headers"
|
||||
{"req-headers" (build-ref-items-with-href
|
||||
(get raw-data "req-headers")
|
||||
"/geography/hypermedia/reference/headers/" detail-keys 3)
|
||||
"resp-headers" (build-ref-items-with-href
|
||||
(get raw-data "resp-headers")
|
||||
"/geography/hypermedia/reference/headers/" detail-keys 3)}
|
||||
|
||||
"events"
|
||||
{"events-list" (build-ref-items-with-href
|
||||
(get raw-data "events-list")
|
||||
"/geography/hypermedia/reference/events/" detail-keys 2)}
|
||||
|
||||
"js-api"
|
||||
{"js-api-list" (map (fn ((item :as list)) {"name" (nth item 0) "desc" (nth item 1)})
|
||||
(get raw-data "js-api-list"))}
|
||||
|
||||
;; default: attributes
|
||||
:else
|
||||
{"req-attrs" (build-ref-items-with-href
|
||||
(get raw-data "req-attrs")
|
||||
"/geography/hypermedia/reference/attributes/" detail-keys 3)
|
||||
"beh-attrs" (build-ref-items-with-href
|
||||
(get raw-data "beh-attrs")
|
||||
"/geography/hypermedia/reference/attributes/" detail-keys 3)
|
||||
"uniq-attrs" (build-ref-items-with-href
|
||||
(get raw-data "uniq-attrs")
|
||||
"/geography/hypermedia/reference/attributes/" detail-keys 3)})))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; build-attr-detail / build-header-detail / build-event-detail
|
||||
;;
|
||||
;; Lookup a slug in a detail dict, reshape for page rendering.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define build-attr-detail
|
||||
(fn ((slug :as string) detail)
|
||||
;; detail: dict with "description", "example", "handler", "demo" keys or nil
|
||||
(if (nil? detail)
|
||||
{"attr-not-found" true}
|
||||
{"attr-not-found" nil
|
||||
"attr-title" slug
|
||||
"attr-description" (get detail "description")
|
||||
"attr-example" (get detail "example")
|
||||
"attr-handler" (get detail "handler")
|
||||
"attr-demo" (get detail "demo")
|
||||
"attr-wire-id" (if (has-key? detail "handler")
|
||||
(str "ref-wire-"
|
||||
(replace (replace slug ":" "-") "*" "star"))
|
||||
nil)})))
|
||||
|
||||
|
||||
(define build-header-detail
|
||||
(fn ((slug :as string) detail)
|
||||
(if (nil? detail)
|
||||
{"header-not-found" true}
|
||||
{"header-not-found" nil
|
||||
"header-title" slug
|
||||
"header-direction" (get detail "direction")
|
||||
"header-description" (get detail "description")
|
||||
"header-example" (get detail "example")
|
||||
"header-demo" (get detail "demo")})))
|
||||
|
||||
|
||||
(define build-event-detail
|
||||
(fn ((slug :as string) detail)
|
||||
(if (nil? detail)
|
||||
{"event-not-found" true}
|
||||
{"event-not-found" nil
|
||||
"event-title" slug
|
||||
"event-description" (get detail "description")
|
||||
"event-example" (get detail "example")
|
||||
"event-demo" (get detail "demo")})))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; build-component-source
|
||||
;;
|
||||
;; Reconstruct defcomp/defisland source from component metadata.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define build-component-source
|
||||
(fn ((comp-data :as dict))
|
||||
;; comp-data: dict with "type", "name", "params", "has-children", "body-sx", "affinity"
|
||||
(let ((comp-type (get comp-data "type"))
|
||||
(name (get comp-data "name"))
|
||||
(params (get comp-data "params"))
|
||||
(has-children (get comp-data "has-children"))
|
||||
(body-sx (get comp-data "body-sx"))
|
||||
(affinity (get comp-data "affinity")))
|
||||
(if (= comp-type "not-found")
|
||||
(str ";; component " name " not found")
|
||||
(let ((param-strs (if (empty? params)
|
||||
(if has-children
|
||||
(list "&rest" "children")
|
||||
(list))
|
||||
(if has-children
|
||||
(append (cons "&key" params) (list "&rest" "children"))
|
||||
(cons "&key" params))))
|
||||
(params-sx (str "(" (join " " param-strs) ")"))
|
||||
(form-name (if (= comp-type "island") "defisland" "defcomp"))
|
||||
(affinity-str (if (and (= comp-type "component")
|
||||
(not (nil? affinity))
|
||||
(not (= affinity "auto")))
|
||||
(str " :affinity " affinity)
|
||||
"")))
|
||||
(str "(" form-name " " name " " params-sx affinity-str "\n " body-sx ")"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; build-bundle-analysis
|
||||
;;
|
||||
;; Compute per-page bundle stats from pre-extracted component data.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define build-bundle-analysis
|
||||
(fn ((pages-raw :as list) (components-raw :as dict) (total-components :as number) (total-macros :as number) (pure-count :as number) (io-count :as number))
|
||||
;; pages-raw: list of {:name :path :direct :needed-names}
|
||||
;; components-raw: dict of name → {:is-pure :affinity :render-target :io-refs :deps :source}
|
||||
(let ((pages-data (list)))
|
||||
(for-each
|
||||
(fn ((page :as dict))
|
||||
(let ((needed-names (get page "needed-names"))
|
||||
(n (len needed-names))
|
||||
(pct (if (> total-components 0)
|
||||
(round (* (/ n total-components) 100))
|
||||
0))
|
||||
(savings (- 100 pct))
|
||||
(pure-in-page 0)
|
||||
(io-in-page 0)
|
||||
(page-io-refs (list))
|
||||
(comp-details (list)))
|
||||
;; Walk needed components
|
||||
(for-each
|
||||
(fn ((comp-name :as string))
|
||||
(let ((info (get components-raw comp-name)))
|
||||
(when (not (nil? info))
|
||||
(if (get info "is-pure")
|
||||
(set! pure-in-page (+ pure-in-page 1))
|
||||
(do
|
||||
(set! io-in-page (+ io-in-page 1))
|
||||
(for-each
|
||||
(fn ((ref :as string)) (when (not (some (fn ((r :as string)) (= r ref)) page-io-refs))
|
||||
(append! page-io-refs ref)))
|
||||
(or (get info "io-refs") (list)))))
|
||||
(append! comp-details
|
||||
{"name" comp-name
|
||||
"is-pure" (get info "is-pure")
|
||||
"affinity" (get info "affinity")
|
||||
"render-target" (get info "render-target")
|
||||
"io-refs" (or (get info "io-refs") (list))
|
||||
"deps" (or (get info "deps") (list))
|
||||
"source" (get info "source")}))))
|
||||
needed-names)
|
||||
(append! pages-data
|
||||
{"name" (get page "name")
|
||||
"path" (get page "path")
|
||||
"direct" (get page "direct")
|
||||
"needed" n
|
||||
"pct" pct
|
||||
"savings" savings
|
||||
"io-refs" (len page-io-refs)
|
||||
"pure-in-page" pure-in-page
|
||||
"io-in-page" io-in-page
|
||||
"components" comp-details})))
|
||||
pages-raw)
|
||||
{"pages" pages-data
|
||||
"total-components" total-components
|
||||
"total-macros" total-macros
|
||||
"pure-count" pure-count
|
||||
"io-count" io-count})))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; build-routing-analysis
|
||||
;;
|
||||
;; Classify pages by routing mode (client vs server).
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define build-routing-analysis
|
||||
(fn ((pages-raw :as list))
|
||||
;; pages-raw: list of {:name :path :has-data :content-src}
|
||||
(let ((pages-data (list))
|
||||
(client-count 0)
|
||||
(server-count 0))
|
||||
(for-each
|
||||
(fn ((page :as dict))
|
||||
(let ((has-data (get page "has-data"))
|
||||
(content-src (or (get page "content-src") ""))
|
||||
(mode nil)
|
||||
(reason ""))
|
||||
(cond
|
||||
has-data
|
||||
(do (set! mode "server")
|
||||
(set! reason "Has :data expression — needs server IO")
|
||||
(set! server-count (+ server-count 1)))
|
||||
(empty? content-src)
|
||||
(do (set! mode "server")
|
||||
(set! reason "No content expression")
|
||||
(set! server-count (+ server-count 1)))
|
||||
:else
|
||||
(do (set! mode "client")
|
||||
(set! client-count (+ client-count 1))))
|
||||
(append! pages-data
|
||||
{"name" (get page "name")
|
||||
"path" (get page "path")
|
||||
"mode" mode
|
||||
"has-data" has-data
|
||||
"content-expr" (if (> (len content-src) 80)
|
||||
(str (slice content-src 0 80) "...")
|
||||
content-src)
|
||||
"reason" reason})))
|
||||
pages-raw)
|
||||
{"pages" pages-data
|
||||
"total-pages" (+ client-count server-count)
|
||||
"client-count" client-count
|
||||
"server-count" server-count})))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; build-affinity-analysis
|
||||
;;
|
||||
;; Package component affinity info + page render plans for display.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define build-affinity-analysis
|
||||
(fn ((demo-components :as list) (page-plans :as list))
|
||||
{"components" demo-components
|
||||
"page-plans" page-plans}))
|
||||
@@ -50,7 +50,7 @@
|
||||
;; Returns a list of top-level AST expressions.
|
||||
|
||||
(define sx-parse
|
||||
(fn (source)
|
||||
(fn ((source :as string))
|
||||
(let ((pos 0)
|
||||
(len-src (len source)))
|
||||
|
||||
@@ -170,7 +170,7 @@
|
||||
;; -- Composite readers --
|
||||
|
||||
(define read-list
|
||||
(fn (close-ch)
|
||||
(fn ((close-ch :as string))
|
||||
(let ((items (list)))
|
||||
(define read-list-loop
|
||||
(fn ()
|
||||
@@ -352,11 +352,11 @@
|
||||
|
||||
|
||||
(define sx-serialize-dict
|
||||
(fn (d)
|
||||
(fn ((d :as dict))
|
||||
(str "{"
|
||||
(join " "
|
||||
(reduce
|
||||
(fn (acc key)
|
||||
(fn ((acc :as list) (key :as string))
|
||||
(concat acc (list (str ":" key) (sx-serialize (dict-get d key)))))
|
||||
(list)
|
||||
(keys d)))
|
||||
|
||||
3214
shared/sx/ref/platform_js.py
Normal file
3214
shared/sx/ref/platform_js.py
Normal file
File diff suppressed because it is too large
Load Diff
@@ -307,6 +307,14 @@ def component_affinity(c):
|
||||
return getattr(c, 'affinity', 'auto')
|
||||
|
||||
|
||||
def component_param_types(c):
|
||||
return getattr(c, 'param_types', None)
|
||||
|
||||
|
||||
def component_set_param_types(c, d):
|
||||
c.param_types = d
|
||||
|
||||
|
||||
def macro_params(m):
|
||||
return m.params
|
||||
|
||||
@@ -462,10 +470,7 @@ def invoke(f, *args):
|
||||
|
||||
def json_serialize(obj):
|
||||
import json
|
||||
try:
|
||||
return json.dumps(obj)
|
||||
except (TypeError, ValueError):
|
||||
return "{}"
|
||||
|
||||
|
||||
def is_empty_dict(d):
|
||||
@@ -600,7 +605,7 @@ def sx_expr_source(x):
|
||||
|
||||
|
||||
try:
|
||||
from shared.sx.evaluator import EvalError
|
||||
from shared.sx.types import EvalError
|
||||
except ImportError:
|
||||
class EvalError(Exception):
|
||||
pass
|
||||
@@ -1067,10 +1072,19 @@ import inspect
|
||||
|
||||
from shared.sx.primitives_io import (
|
||||
IO_PRIMITIVES, RequestContext, execute_io,
|
||||
css_class_collector as _css_class_collector_cv,
|
||||
_svg_context as _svg_context_cv,
|
||||
)
|
||||
|
||||
# Lazy imports to avoid circular dependency (html.py imports sx_ref.py)
|
||||
_css_class_collector_cv = None
|
||||
_svg_context_cv = None
|
||||
|
||||
def _ensure_html_imports():
|
||||
global _css_class_collector_cv, _svg_context_cv
|
||||
if _css_class_collector_cv is None:
|
||||
from shared.sx.html import css_class_collector, _svg_context
|
||||
_css_class_collector_cv = css_class_collector
|
||||
_svg_context_cv = _svg_context
|
||||
|
||||
# When True, async_aser expands known components server-side
|
||||
_expand_components_cv: contextvars.ContextVar[bool] = contextvars.ContextVar(
|
||||
"_expand_components_ref", default=False
|
||||
@@ -1094,18 +1108,22 @@ def expand_components_p():
|
||||
|
||||
|
||||
def svg_context_p():
|
||||
_ensure_html_imports()
|
||||
return _svg_context_cv.get(False)
|
||||
|
||||
|
||||
def svg_context_set(val):
|
||||
_ensure_html_imports()
|
||||
return _svg_context_cv.set(val)
|
||||
|
||||
|
||||
def svg_context_reset(token):
|
||||
_ensure_html_imports()
|
||||
_svg_context_cv.reset(token)
|
||||
|
||||
|
||||
def css_class_collect(val):
|
||||
_ensure_html_imports()
|
||||
collector = _css_class_collector_cv.get(None)
|
||||
if collector is not None:
|
||||
collector.update(str(val).split())
|
||||
@@ -1123,6 +1141,25 @@ def is_sx_expr(x):
|
||||
return isinstance(x, SxExpr)
|
||||
|
||||
|
||||
# Predicate helpers used by adapter-async (these are in PRIMITIVES but
|
||||
# the bootstrapped code calls them as plain functions)
|
||||
def string_p(x):
|
||||
return isinstance(x, str)
|
||||
|
||||
|
||||
def list_p(x):
|
||||
return isinstance(x, _b_list)
|
||||
|
||||
|
||||
def number_p(x):
|
||||
return isinstance(x, (int, float)) and not isinstance(x, bool)
|
||||
|
||||
|
||||
def sx_parse(src):
|
||||
from shared.sx.parser import parse_all
|
||||
return parse_all(src)
|
||||
|
||||
|
||||
def is_async_coroutine(x):
|
||||
return inspect.iscoroutine(x)
|
||||
|
||||
@@ -1199,48 +1236,16 @@ async def async_eval_slot_to_sx(expr, env, ctx=None):
|
||||
ctx = RequestContext()
|
||||
token = _expand_components_cv.set(True)
|
||||
try:
|
||||
return await _eval_slot_inner(expr, env, ctx)
|
||||
result = await async_eval_slot_inner(expr, env, ctx)
|
||||
if isinstance(result, SxExpr):
|
||||
return result
|
||||
if result is None or result is NIL:
|
||||
return SxExpr("")
|
||||
if isinstance(result, str):
|
||||
return SxExpr(result)
|
||||
return SxExpr(sx_serialize(result))
|
||||
finally:
|
||||
_expand_components_cv.reset(token)
|
||||
|
||||
|
||||
async def _eval_slot_inner(expr, env, ctx):
|
||||
if isinstance(expr, list) and expr:
|
||||
head = expr[0]
|
||||
if isinstance(head, Symbol) and head.name.startswith("~"):
|
||||
comp = env.get(head.name)
|
||||
if isinstance(comp, Component):
|
||||
result = await async_aser_component(comp, expr[1:], env, ctx)
|
||||
if isinstance(result, SxExpr):
|
||||
return result
|
||||
if result is None or result is NIL:
|
||||
return SxExpr("")
|
||||
if isinstance(result, str):
|
||||
return SxExpr(result)
|
||||
return SxExpr(sx_serialize(result))
|
||||
result = await async_aser(expr, env, ctx)
|
||||
result = await _maybe_expand_component_result(result, env, ctx)
|
||||
if isinstance(result, SxExpr):
|
||||
return result
|
||||
if result is None or result is NIL:
|
||||
return SxExpr("")
|
||||
if isinstance(result, str):
|
||||
return SxExpr(result)
|
||||
return SxExpr(sx_serialize(result))
|
||||
|
||||
|
||||
async def _maybe_expand_component_result(result, env, ctx):
|
||||
raw = None
|
||||
if isinstance(result, SxExpr):
|
||||
raw = str(result).strip()
|
||||
elif isinstance(result, str):
|
||||
raw = result.strip()
|
||||
if raw and raw.startswith("(~"):
|
||||
from shared.sx.parser import parse_all as _pa
|
||||
parsed = _pa(raw)
|
||||
if parsed:
|
||||
return await async_eval_slot_to_sx(parsed[0], env, ctx)
|
||||
return result
|
||||
'''
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
@@ -1366,7 +1371,8 @@ aser_special = _aser_special_with_continuations
|
||||
# Public API generator
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
def public_api_py(has_html: bool, has_sx: bool, has_deps: bool = False) -> str:
|
||||
def public_api_py(has_html: bool, has_sx: bool, has_deps: bool = False,
|
||||
has_async: bool = False) -> str:
|
||||
lines = [
|
||||
'',
|
||||
'# =========================================================================',
|
||||
@@ -1421,6 +1427,7 @@ def public_api_py(has_html: bool, has_sx: bool, has_deps: bool = False) -> str:
|
||||
ADAPTER_FILES = {
|
||||
"html": ("adapter-html.sx", "adapter-html"),
|
||||
"sx": ("adapter-sx.sx", "adapter-sx"),
|
||||
"async": ("adapter-async.sx", "adapter-async"),
|
||||
}
|
||||
|
||||
SPEC_MODULES = {
|
||||
@@ -1428,6 +1435,8 @@ SPEC_MODULES = {
|
||||
"router": ("router.sx", "router (client-side route matching)"),
|
||||
"engine": ("engine.sx", "engine (fetch/swap/trigger pure logic)"),
|
||||
"signals": ("signals.sx", "signals (reactive signal runtime)"),
|
||||
"page-helpers": ("page-helpers.sx", "page-helpers (pure data transformation helpers)"),
|
||||
"types": ("types.sx", "types (gradual type system)"),
|
||||
}
|
||||
|
||||
EXTENSION_NAMES = {"continuations"}
|
||||
|
||||
@@ -15,6 +15,15 @@
|
||||
;; :doc "description"
|
||||
;; :body (reference-implementation ...))
|
||||
;;
|
||||
;; Typed params use (name :as type) syntax:
|
||||
;; (define-primitive "+"
|
||||
;; :params (&rest (args :as number))
|
||||
;; :returns "number"
|
||||
;; :doc "Sum all arguments.")
|
||||
;;
|
||||
;; Untyped params default to `any`. Typed params enable the gradual
|
||||
;; type checker (types.sx) to catch mistyped primitive calls.
|
||||
;;
|
||||
;; The :body is optional — when provided, it gives a reference
|
||||
;; implementation in SX that bootstrap compilers MAY use for testing
|
||||
;; or as a fallback. Most targets will implement natively for performance.
|
||||
@@ -32,89 +41,89 @@
|
||||
(define-module :core.arithmetic)
|
||||
|
||||
(define-primitive "+"
|
||||
:params (&rest args)
|
||||
:params (&rest (args :as number))
|
||||
:returns "number"
|
||||
:doc "Sum all arguments."
|
||||
:body (reduce (fn (a b) (native-add a b)) 0 args))
|
||||
|
||||
(define-primitive "-"
|
||||
:params (a &rest b)
|
||||
:params ((a :as number) &rest (b :as number))
|
||||
:returns "number"
|
||||
:doc "Subtract. Unary: negate. Binary: a - b."
|
||||
:body (if (empty? b) (native-neg a) (native-sub a (first b))))
|
||||
|
||||
(define-primitive "*"
|
||||
:params (&rest args)
|
||||
:params (&rest (args :as number))
|
||||
:returns "number"
|
||||
:doc "Multiply all arguments."
|
||||
:body (reduce (fn (a b) (native-mul a b)) 1 args))
|
||||
|
||||
(define-primitive "/"
|
||||
:params (a b)
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "number"
|
||||
:doc "Divide a by b."
|
||||
:body (native-div a b))
|
||||
|
||||
(define-primitive "mod"
|
||||
:params (a b)
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "number"
|
||||
:doc "Modulo a % b."
|
||||
:body (native-mod a b))
|
||||
|
||||
(define-primitive "sqrt"
|
||||
:params (x)
|
||||
:params ((x :as number))
|
||||
:returns "number"
|
||||
:doc "Square root.")
|
||||
|
||||
(define-primitive "pow"
|
||||
:params (x n)
|
||||
:params ((x :as number) (n :as number))
|
||||
:returns "number"
|
||||
:doc "x raised to power n.")
|
||||
|
||||
(define-primitive "abs"
|
||||
:params (x)
|
||||
:params ((x :as number))
|
||||
:returns "number"
|
||||
:doc "Absolute value.")
|
||||
|
||||
(define-primitive "floor"
|
||||
:params (x)
|
||||
:params ((x :as number))
|
||||
:returns "number"
|
||||
:doc "Floor to integer.")
|
||||
|
||||
(define-primitive "ceil"
|
||||
:params (x)
|
||||
:params ((x :as number))
|
||||
:returns "number"
|
||||
:doc "Ceiling to integer.")
|
||||
|
||||
(define-primitive "round"
|
||||
:params (x &rest ndigits)
|
||||
:params ((x :as number) &rest (ndigits :as number))
|
||||
:returns "number"
|
||||
:doc "Round to ndigits decimal places (default 0).")
|
||||
|
||||
(define-primitive "min"
|
||||
:params (&rest args)
|
||||
:params (&rest (args :as number))
|
||||
:returns "number"
|
||||
:doc "Minimum. Single list arg or variadic.")
|
||||
|
||||
(define-primitive "max"
|
||||
:params (&rest args)
|
||||
:params (&rest (args :as number))
|
||||
:returns "number"
|
||||
:doc "Maximum. Single list arg or variadic.")
|
||||
|
||||
(define-primitive "clamp"
|
||||
:params (x lo hi)
|
||||
:params ((x :as number) (lo :as number) (hi :as number))
|
||||
:returns "number"
|
||||
:doc "Clamp x to range [lo, hi]."
|
||||
:body (max lo (min hi x)))
|
||||
|
||||
(define-primitive "inc"
|
||||
:params (n)
|
||||
:params ((n :as number))
|
||||
:returns "number"
|
||||
:doc "Increment by 1."
|
||||
:body (+ n 1))
|
||||
|
||||
(define-primitive "dec"
|
||||
:params (n)
|
||||
:params ((n :as number))
|
||||
:returns "number"
|
||||
:doc "Decrement by 1."
|
||||
:body (- n 1))
|
||||
@@ -159,22 +168,22 @@
|
||||
Same semantics as = but explicit Scheme name.")
|
||||
|
||||
(define-primitive "<"
|
||||
:params (a b)
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "boolean"
|
||||
:doc "Less than.")
|
||||
|
||||
(define-primitive ">"
|
||||
:params (a b)
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "boolean"
|
||||
:doc "Greater than.")
|
||||
|
||||
(define-primitive "<="
|
||||
:params (a b)
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "boolean"
|
||||
:doc "Less than or equal.")
|
||||
|
||||
(define-primitive ">="
|
||||
:params (a b)
|
||||
:params ((a :as number) (b :as number))
|
||||
:returns "boolean"
|
||||
:doc "Greater than or equal.")
|
||||
|
||||
@@ -186,19 +195,19 @@
|
||||
(define-module :core.predicates)
|
||||
|
||||
(define-primitive "odd?"
|
||||
:params (n)
|
||||
:params ((n :as number))
|
||||
:returns "boolean"
|
||||
:doc "True if n is odd."
|
||||
:body (= (mod n 2) 1))
|
||||
|
||||
(define-primitive "even?"
|
||||
:params (n)
|
||||
:params ((n :as number))
|
||||
:returns "boolean"
|
||||
:doc "True if n is even."
|
||||
:body (= (mod n 2) 0))
|
||||
|
||||
(define-primitive "zero?"
|
||||
:params (n)
|
||||
:params ((n :as number))
|
||||
:returns "boolean"
|
||||
:doc "True if n is zero."
|
||||
:body (= n 0))
|
||||
@@ -274,82 +283,82 @@
|
||||
:doc "Concatenate all args as strings. nil → empty string, bool → true/false.")
|
||||
|
||||
(define-primitive "concat"
|
||||
:params (&rest colls)
|
||||
:params (&rest (colls :as list))
|
||||
:returns "list"
|
||||
:doc "Concatenate multiple lists into one. Skips nil values.")
|
||||
|
||||
(define-primitive "upper"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "string"
|
||||
:doc "Uppercase string.")
|
||||
|
||||
(define-primitive "upcase"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "string"
|
||||
:doc "Alias for upper. Uppercase string.")
|
||||
|
||||
(define-primitive "lower"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "string"
|
||||
:doc "Lowercase string.")
|
||||
|
||||
(define-primitive "downcase"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "string"
|
||||
:doc "Alias for lower. Lowercase string.")
|
||||
|
||||
(define-primitive "string-length"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "number"
|
||||
:doc "Length of string in characters.")
|
||||
|
||||
(define-primitive "substring"
|
||||
:params (s start end)
|
||||
:params ((s :as string) (start :as number) (end :as number))
|
||||
:returns "string"
|
||||
:doc "Extract substring from start (inclusive) to end (exclusive).")
|
||||
|
||||
(define-primitive "string-contains?"
|
||||
:params (s needle)
|
||||
:params ((s :as string) (needle :as string))
|
||||
:returns "boolean"
|
||||
:doc "True if string s contains substring needle.")
|
||||
|
||||
(define-primitive "trim"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "string"
|
||||
:doc "Strip leading/trailing whitespace.")
|
||||
|
||||
(define-primitive "split"
|
||||
:params (s &rest sep)
|
||||
:params ((s :as string) &rest (sep :as string))
|
||||
:returns "list"
|
||||
:doc "Split string by separator (default space).")
|
||||
|
||||
(define-primitive "join"
|
||||
:params (sep coll)
|
||||
:params ((sep :as string) (coll :as list))
|
||||
:returns "string"
|
||||
:doc "Join collection items with separator string.")
|
||||
|
||||
(define-primitive "replace"
|
||||
:params (s old new)
|
||||
:params ((s :as string) (old :as string) (new :as string))
|
||||
:returns "string"
|
||||
:doc "Replace all occurrences of old with new in s.")
|
||||
|
||||
(define-primitive "slice"
|
||||
:params (coll start &rest end)
|
||||
:params (coll (start :as number) &rest (end :as number))
|
||||
:returns "any"
|
||||
:doc "Slice a string or list from start to end (exclusive). End is optional.")
|
||||
|
||||
(define-primitive "index-of"
|
||||
:params (s needle &rest from)
|
||||
:params ((s :as string) (needle :as string) &rest (from :as number))
|
||||
:returns "number"
|
||||
:doc "Index of first occurrence of needle in s, or -1 if not found. Optional start index.")
|
||||
|
||||
(define-primitive "starts-with?"
|
||||
:params (s prefix)
|
||||
:params ((s :as string) (prefix :as string))
|
||||
:returns "boolean"
|
||||
:doc "True if string s starts with prefix.")
|
||||
|
||||
(define-primitive "ends-with?"
|
||||
:params (s suffix)
|
||||
:params ((s :as string) (suffix :as string))
|
||||
:returns "boolean"
|
||||
:doc "True if string s ends with suffix.")
|
||||
|
||||
@@ -371,7 +380,7 @@
|
||||
:doc "Create a dict from key/value pairs: (dict :a 1 :b 2).")
|
||||
|
||||
(define-primitive "range"
|
||||
:params (start end &rest step)
|
||||
:params ((start :as number) (end :as number) &rest (step :as number))
|
||||
:returns "list"
|
||||
:doc "Integer range [start, end) with optional step.")
|
||||
|
||||
@@ -386,57 +395,57 @@
|
||||
:doc "Length of string, list, or dict.")
|
||||
|
||||
(define-primitive "first"
|
||||
:params (coll)
|
||||
:params ((coll :as list))
|
||||
:returns "any"
|
||||
:doc "First element, or nil if empty.")
|
||||
|
||||
(define-primitive "last"
|
||||
:params (coll)
|
||||
:params ((coll :as list))
|
||||
:returns "any"
|
||||
:doc "Last element, or nil if empty.")
|
||||
|
||||
(define-primitive "rest"
|
||||
:params (coll)
|
||||
:params ((coll :as list))
|
||||
:returns "list"
|
||||
:doc "All elements except the first.")
|
||||
|
||||
(define-primitive "nth"
|
||||
:params (coll n)
|
||||
:params ((coll :as list) (n :as number))
|
||||
:returns "any"
|
||||
:doc "Element at index n, or nil if out of bounds.")
|
||||
|
||||
(define-primitive "cons"
|
||||
:params (x coll)
|
||||
:params (x (coll :as list))
|
||||
:returns "list"
|
||||
:doc "Prepend x to coll.")
|
||||
|
||||
(define-primitive "append"
|
||||
:params (coll x)
|
||||
:params ((coll :as list) x)
|
||||
:returns "list"
|
||||
:doc "If x is a list, concatenate. Otherwise append x as single element.")
|
||||
|
||||
(define-primitive "append!"
|
||||
:params (coll x)
|
||||
:params ((coll :as list) x)
|
||||
:returns "list"
|
||||
:doc "Mutate coll by appending x in-place. Returns coll.")
|
||||
|
||||
(define-primitive "reverse"
|
||||
:params (coll)
|
||||
:params ((coll :as list))
|
||||
:returns "list"
|
||||
:doc "Return coll in reverse order.")
|
||||
|
||||
(define-primitive "flatten"
|
||||
:params (coll)
|
||||
:params ((coll :as list))
|
||||
:returns "list"
|
||||
:doc "Flatten one level of nesting. Nested lists become top-level elements.")
|
||||
|
||||
(define-primitive "chunk-every"
|
||||
:params (coll n)
|
||||
:params ((coll :as list) (n :as number))
|
||||
:returns "list"
|
||||
:doc "Split coll into sub-lists of size n.")
|
||||
|
||||
(define-primitive "zip-pairs"
|
||||
:params (coll)
|
||||
:params ((coll :as list))
|
||||
:returns "list"
|
||||
:doc "Consecutive pairs: (1 2 3 4) → ((1 2) (2 3) (3 4)).")
|
||||
|
||||
@@ -448,37 +457,37 @@
|
||||
(define-module :core.dict)
|
||||
|
||||
(define-primitive "keys"
|
||||
:params (d)
|
||||
:params ((d :as dict))
|
||||
:returns "list"
|
||||
:doc "List of dict keys.")
|
||||
|
||||
(define-primitive "vals"
|
||||
:params (d)
|
||||
:params ((d :as dict))
|
||||
:returns "list"
|
||||
:doc "List of dict values.")
|
||||
|
||||
(define-primitive "merge"
|
||||
:params (&rest dicts)
|
||||
:params (&rest (dicts :as dict))
|
||||
:returns "dict"
|
||||
:doc "Merge dicts left to right. Later keys win. Skips nil.")
|
||||
|
||||
(define-primitive "has-key?"
|
||||
:params (d key)
|
||||
:params ((d :as dict) key)
|
||||
:returns "boolean"
|
||||
:doc "True if dict d contains key.")
|
||||
|
||||
(define-primitive "assoc"
|
||||
:params (d &rest pairs)
|
||||
:params ((d :as dict) &rest pairs)
|
||||
:returns "dict"
|
||||
:doc "Return new dict with key/value pairs added/overwritten.")
|
||||
|
||||
(define-primitive "dissoc"
|
||||
:params (d &rest keys)
|
||||
:params ((d :as dict) &rest keys)
|
||||
:returns "dict"
|
||||
:doc "Return new dict with keys removed.")
|
||||
|
||||
(define-primitive "dict-set!"
|
||||
:params (d key val)
|
||||
:params ((d :as dict) key val)
|
||||
:returns "any"
|
||||
:doc "Mutate dict d by setting key to val in-place. Returns val.")
|
||||
|
||||
@@ -495,12 +504,12 @@
|
||||
(define-module :stdlib.format)
|
||||
|
||||
(define-primitive "format-date"
|
||||
:params (date-str fmt)
|
||||
:params ((date-str :as string) (fmt :as string))
|
||||
:returns "string"
|
||||
:doc "Parse ISO date string and format with strftime-style format.")
|
||||
|
||||
(define-primitive "format-decimal"
|
||||
:params (val &rest places)
|
||||
:params ((val :as number) &rest (places :as number))
|
||||
:returns "string"
|
||||
:doc "Format number with fixed decimal places (default 2).")
|
||||
|
||||
@@ -510,7 +519,7 @@
|
||||
:doc "Parse string to integer with optional default on failure.")
|
||||
|
||||
(define-primitive "parse-datetime"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "string"
|
||||
:doc "Parse datetime string — identity passthrough (returns string or nil).")
|
||||
|
||||
@@ -522,17 +531,17 @@
|
||||
(define-module :stdlib.text)
|
||||
|
||||
(define-primitive "pluralize"
|
||||
:params (count &rest forms)
|
||||
:params ((count :as number) &rest (forms :as string))
|
||||
:returns "string"
|
||||
:doc "Pluralize: (pluralize 1) → \"\", (pluralize 2) → \"s\". Or (pluralize n \"item\" \"items\").")
|
||||
|
||||
(define-primitive "escape"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "string"
|
||||
:doc "HTML-escape a string (&, <, >, \", ').")
|
||||
|
||||
(define-primitive "strip-tags"
|
||||
:params (s)
|
||||
:params ((s :as string))
|
||||
:returns "string"
|
||||
:doc "Remove HTML tags from string.")
|
||||
|
||||
@@ -567,16 +576,16 @@
|
||||
:doc "Return type name: number, string, boolean, nil, symbol, keyword, list, dict, lambda, component, island, macro.")
|
||||
|
||||
(define-primitive "symbol-name"
|
||||
:params (sym)
|
||||
:params ((sym :as symbol))
|
||||
:returns "string"
|
||||
:doc "Return the name string of a symbol.")
|
||||
|
||||
(define-primitive "keyword-name"
|
||||
:params (kw)
|
||||
:params ((kw :as keyword))
|
||||
:returns "string"
|
||||
:doc "Return the name string of a keyword.")
|
||||
|
||||
(define-primitive "sx-parse"
|
||||
:params (source)
|
||||
:params ((source :as string))
|
||||
:returns "list"
|
||||
:doc "Parse SX source string into a list of AST expressions.")
|
||||
|
||||
@@ -25,7 +25,7 @@
|
||||
|
||||
;; Evaluate an SMT-LIB expression in a variable environment
|
||||
(define smt-eval
|
||||
(fn (expr env)
|
||||
(fn (expr (env :as dict))
|
||||
(cond
|
||||
;; Numbers
|
||||
(number? expr) expr
|
||||
@@ -136,11 +136,11 @@
|
||||
|
||||
;; Bind parameter names to values
|
||||
(define smt-bind-params
|
||||
(fn (params vals)
|
||||
(fn ((params :as list) (vals :as list))
|
||||
(smt-bind-loop params vals {})))
|
||||
|
||||
(define smt-bind-loop
|
||||
(fn (params vals acc)
|
||||
(fn ((params :as list) (vals :as list) (acc :as dict))
|
||||
(if (or (empty? params) (empty? vals))
|
||||
acc
|
||||
(smt-bind-loop (rest params) (rest vals)
|
||||
@@ -153,11 +153,11 @@
|
||||
|
||||
;; Extract declarations and assertions from parsed SMT-LIB
|
||||
(define smt-extract-statements
|
||||
(fn (exprs)
|
||||
(fn ((exprs :as list))
|
||||
(smt-extract-loop exprs {} (list))))
|
||||
|
||||
(define smt-extract-loop
|
||||
(fn (exprs decls assertions)
|
||||
(fn ((exprs :as list) (decls :as dict) (assertions :as list))
|
||||
(if (empty? exprs)
|
||||
{:decls decls :assertions assertions}
|
||||
(let ((expr (first exprs))
|
||||
@@ -286,7 +286,7 @@
|
||||
|
||||
;; Verify a single definitional assertion by construction + evaluation
|
||||
(define smt-verify-definition
|
||||
(fn (def-info decls)
|
||||
(fn ((def-info :as dict) (decls :as dict))
|
||||
(let ((name (get def-info "name"))
|
||||
(params (get def-info "params"))
|
||||
(body (get def-info "body"))
|
||||
@@ -295,10 +295,10 @@
|
||||
;; Build the model: define f = λparams.body
|
||||
(let ((model (assoc decls name {:params params :body body}))
|
||||
;; Select test values matching arity
|
||||
(tests (filter (fn (tv) (= (len tv) n-params)) smt-test-values))
|
||||
(tests (filter (fn ((tv :as list)) (= (len tv) n-params)) smt-test-values))
|
||||
;; Run tests
|
||||
(results (map
|
||||
(fn (test-vals)
|
||||
(fn ((test-vals :as list))
|
||||
(let ((env (merge model (smt-bind-params params test-vals)))
|
||||
;; Evaluate body directly
|
||||
(body-result (smt-eval body env))
|
||||
@@ -311,9 +311,9 @@
|
||||
:equal (= body-result call-result)}))
|
||||
tests)))
|
||||
{:name name
|
||||
:status (if (every? (fn (r) (get r "equal")) results) "sat" "FAIL")
|
||||
:status (if (every? (fn ((r :as dict)) (get r "equal")) results) "sat" "FAIL")
|
||||
:proof "by construction (definition is the model)"
|
||||
:tests-passed (len (filter (fn (r) (get r "equal")) results))
|
||||
:tests-passed (len (filter (fn ((r :as dict)) (get r "equal")) results))
|
||||
:tests-total (len results)
|
||||
:sample (if (empty? results) nil (first results))}))))
|
||||
|
||||
@@ -325,16 +325,16 @@
|
||||
;; Strip SMT-LIB comment lines (starting with ;) and return only actual forms.
|
||||
;; Handles comments that contain ( characters.
|
||||
(define smt-strip-comments
|
||||
(fn (s)
|
||||
(fn ((s :as string))
|
||||
(let ((lines (split s "\n"))
|
||||
(non-comment (filter
|
||||
(fn (line) (not (starts-with? (trim line) ";")))
|
||||
(fn ((line :as string)) (not (starts-with? (trim line) ";")))
|
||||
lines)))
|
||||
(join "\n" non-comment))))
|
||||
|
||||
;; Verify SMT-LIB output (string) — parse, classify, prove
|
||||
(define prove-check
|
||||
(fn (smtlib-str)
|
||||
(fn ((smtlib-str :as string))
|
||||
(let ((parsed (sx-parse (smt-strip-comments smtlib-str)))
|
||||
(stmts (smt-extract-statements parsed))
|
||||
(decls (get stmts "decls"))
|
||||
@@ -351,7 +351,7 @@
|
||||
{:status "unknown"
|
||||
:reason "non-definitional assertion (needs full SMT solver)"}))
|
||||
assertions)))
|
||||
{:status (if (every? (fn (r) (= (get r "status") "sat")) results)
|
||||
{:status (if (every? (fn ((r :as dict)) (= (get r "status") "sat")) results)
|
||||
"sat" "unknown")
|
||||
:assertions (len assertions)
|
||||
:results results})))))
|
||||
@@ -377,7 +377,7 @@
|
||||
|
||||
;; Batch verify: translate and prove all define-* forms
|
||||
(define prove-file
|
||||
(fn (exprs)
|
||||
(fn ((exprs :as list))
|
||||
(let ((translatable
|
||||
(filter
|
||||
(fn (expr)
|
||||
@@ -396,7 +396,7 @@
|
||||
(name (nth expr 1)))
|
||||
(assoc proof "name" name)))
|
||||
translatable))
|
||||
(sat-count (len (filter (fn (r) (= (get r "status") "sat")) results)))
|
||||
(sat-count (len (filter (fn ((r :as dict)) (= (get r "status") "sat")) results)))
|
||||
(total (len results)))
|
||||
{:total total
|
||||
:sat sat-count
|
||||
@@ -424,7 +424,7 @@
|
||||
|
||||
;; Default domain bounds by arity — balance coverage vs. combinatorics
|
||||
(define prove-domain-for
|
||||
(fn (arity)
|
||||
(fn ((arity :as number))
|
||||
(cond
|
||||
(<= arity 1) (range -50 51) ;; 101 values
|
||||
(= arity 2) (range -20 21) ;; 41^2 = 1,681 pairs
|
||||
@@ -433,7 +433,7 @@
|
||||
|
||||
;; Cartesian product: all n-tuples from a domain
|
||||
(define prove-tuples
|
||||
(fn (domain arity)
|
||||
(fn ((domain :as list) (arity :as number))
|
||||
(if (<= arity 0) (list (list))
|
||||
(if (= arity 1)
|
||||
(map (fn (x) (list x)) domain)
|
||||
@@ -441,12 +441,12 @@
|
||||
(prove-tuples-expand domain sub (list)))))))
|
||||
|
||||
(define prove-tuples-expand
|
||||
(fn (domain sub acc)
|
||||
(fn ((domain :as list) (sub :as list) (acc :as list))
|
||||
(if (empty? domain) acc
|
||||
(prove-tuples-expand
|
||||
(rest domain) sub
|
||||
(append acc
|
||||
(map (fn (t) (cons (first domain) t)) sub))))))
|
||||
(map (fn ((t :as list)) (cons (first domain) t)) sub))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -454,7 +454,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define prove-call
|
||||
(fn (f vals)
|
||||
(fn ((f :as lambda) (vals :as list))
|
||||
(let ((n (len vals)))
|
||||
(cond
|
||||
(= n 0) (f)
|
||||
@@ -472,13 +472,13 @@
|
||||
;; Search for a counterexample. Returns nil if property holds for all tested
|
||||
;; values, or the first counterexample found.
|
||||
(define prove-search
|
||||
(fn (test-fn given-fn domain vars)
|
||||
(fn ((test-fn :as lambda) given-fn (domain :as list) (vars :as list))
|
||||
(let ((arity (len vars))
|
||||
(tuples (prove-tuples domain arity)))
|
||||
(prove-search-loop test-fn given-fn tuples 0 0))))
|
||||
|
||||
(define prove-search-loop
|
||||
(fn (test-fn given-fn tuples tested skipped)
|
||||
(fn ((test-fn :as lambda) given-fn (tuples :as list) (tested :as number) (skipped :as number))
|
||||
(if (empty? tuples)
|
||||
{:status "verified" :tested tested :skipped skipped}
|
||||
(let ((vals (first tuples))
|
||||
@@ -505,7 +505,7 @@
|
||||
|
||||
;; Verify a single property via bounded model checking
|
||||
(define prove-property
|
||||
(fn (prop)
|
||||
(fn ((prop :as dict))
|
||||
(let ((name (get prop "name"))
|
||||
(vars (get prop "vars"))
|
||||
(test-fn (get prop "test"))
|
||||
@@ -519,10 +519,10 @@
|
||||
|
||||
;; Batch verify a list of properties
|
||||
(define prove-properties
|
||||
(fn (props)
|
||||
(fn ((props :as list))
|
||||
(let ((results (map prove-property props))
|
||||
(verified (filter (fn (r) (= (get r "status") "verified")) results))
|
||||
(falsified (filter (fn (r) (= (get r "status") "falsified")) results)))
|
||||
(verified (filter (fn ((r :as dict)) (= (get r "status") "verified")) results))
|
||||
(falsified (filter (fn ((r :as dict)) (= (get r "status") "falsified")) results)))
|
||||
{:total (len results)
|
||||
:verified (len verified)
|
||||
:falsified (len falsified)
|
||||
@@ -537,13 +537,13 @@
|
||||
;; Generate SMT-LIB for a property — asserts (not (forall ...)) so that
|
||||
;; Z3 returning "unsat" proves the property holds universally.
|
||||
(define prove-property-smtlib
|
||||
(fn (prop)
|
||||
(fn ((prop :as dict))
|
||||
(let ((name (get prop "name"))
|
||||
(vars (get prop "vars"))
|
||||
(holds (get prop "holds"))
|
||||
(given-e (get prop "given-expr" nil))
|
||||
(bindings (join " "
|
||||
(map (fn (v) (str "(" v " Int)")) vars)))
|
||||
(map (fn ((v :as string)) (str "(" v " Int)")) vars)))
|
||||
(holds-smt (z3-expr holds))
|
||||
(body (if (nil? given-e)
|
||||
holds-smt
|
||||
@@ -556,7 +556,7 @@
|
||||
|
||||
;; Generate SMT-LIB for all properties, including necessary definitions
|
||||
(define prove-properties-smtlib
|
||||
(fn (props primitives-exprs)
|
||||
(fn ((props :as list) (primitives-exprs :as list))
|
||||
(let ((defs (z3-translate-file primitives-exprs))
|
||||
(prop-smts (map prove-property-smtlib props)))
|
||||
(str ";; ================================================================\n"
|
||||
|
||||
@@ -253,7 +253,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-mangle
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(let ((renamed (get py-renames name)))
|
||||
(if (not (nil? renamed))
|
||||
renamed
|
||||
@@ -279,7 +279,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-quote-string
|
||||
(fn (s)
|
||||
(fn ((s :as string))
|
||||
;; Produce a Python repr-style string literal
|
||||
(str "'" (replace (replace (replace (replace s "\\" "\\\\") "'" "\\'") "\n" "\\n") "\t" "\\t") "'")))
|
||||
|
||||
@@ -292,11 +292,11 @@
|
||||
(list "+" "-" "*" "/" "=" "!=" "<" ">" "<=" ">=" "mod"))
|
||||
|
||||
(define py-infix?
|
||||
(fn (op)
|
||||
(fn ((op :as string))
|
||||
(some (fn (x) (= x op)) py-infix-ops)))
|
||||
|
||||
(define py-op-symbol
|
||||
(fn (op)
|
||||
(fn ((op :as string))
|
||||
(case op
|
||||
"=" "=="
|
||||
"!=" "!="
|
||||
@@ -309,7 +309,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-find-nested-set-vars
|
||||
(fn (body)
|
||||
(fn ((body :as list))
|
||||
;; Returns a list of mangled variable names that are set! from within
|
||||
;; nested fn/lambda bodies
|
||||
(let ((result (list)))
|
||||
@@ -318,7 +318,7 @@
|
||||
result))))
|
||||
|
||||
(define py-scan-set-vars
|
||||
(fn (node in-nested result)
|
||||
(fn (node (in-nested :as boolean) (result :as list))
|
||||
(when (and (list? node) (not (empty? node)))
|
||||
(let ((head (first node)))
|
||||
(cond
|
||||
@@ -353,7 +353,7 @@
|
||||
(py-has-set? body))))
|
||||
|
||||
(define py-has-set?
|
||||
(fn (nodes)
|
||||
(fn ((nodes :as list))
|
||||
(some (fn (node)
|
||||
(and (list? node)
|
||||
(not (empty? node))
|
||||
@@ -372,7 +372,7 @@
|
||||
(py-expr-with-cells expr (list))))
|
||||
|
||||
(define py-expr-with-cells
|
||||
(fn (expr cell-vars)
|
||||
(fn (expr (cell-vars :as list))
|
||||
(cond
|
||||
;; Bool MUST come before number check (Python: bool is subclass of int)
|
||||
(= (type-of expr) "boolean")
|
||||
@@ -417,7 +417,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-native-dict
|
||||
(fn (d cell-vars)
|
||||
(fn ((d :as dict) (cell-vars :as list))
|
||||
(let ((items (keys d)))
|
||||
(str "{" (join ", " (map (fn (k)
|
||||
(str (py-quote-string k) ": " (py-expr-with-cells (get d k) cell-vars)))
|
||||
@@ -429,7 +429,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-list
|
||||
(fn (expr cell-vars)
|
||||
(fn (expr (cell-vars :as list))
|
||||
(let ((head (first expr))
|
||||
(args (rest expr)))
|
||||
(if (not (= (type-of head) "symbol"))
|
||||
@@ -548,7 +548,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-fn
|
||||
(fn (expr cell-vars)
|
||||
(fn (expr (cell-vars :as list))
|
||||
(let ((params (nth expr 1))
|
||||
(body (rest (rest expr)))
|
||||
(param-strs (py-collect-params params)))
|
||||
@@ -562,11 +562,11 @@
|
||||
"\n)[-1])"))))))
|
||||
|
||||
(define py-collect-params
|
||||
(fn (params)
|
||||
(fn ((params :as list))
|
||||
(py-collect-params-loop params 0 (list))))
|
||||
|
||||
(define py-collect-params-loop
|
||||
(fn (params i result)
|
||||
(fn ((params :as list) (i :as number) (result :as list))
|
||||
(if (>= i (len params))
|
||||
result
|
||||
(let ((p (nth params i)))
|
||||
@@ -574,13 +574,25 @@
|
||||
;; &rest marker
|
||||
(and (= (type-of p) "symbol") (= (symbol-name p) "&rest"))
|
||||
(if (< (+ i 1) (len params))
|
||||
(let ((rp (nth params (+ i 1))))
|
||||
(py-collect-params-loop params (+ i 2)
|
||||
(append result (str "*" (py-mangle (symbol-name (nth params (+ i 1)))))))
|
||||
(append result (str "*" (py-mangle
|
||||
(if (and (= (type-of rp) "list") (= (len rp) 3)
|
||||
(= (type-of (nth rp 1)) "keyword")
|
||||
(= (keyword-name (nth rp 1)) "as"))
|
||||
(symbol-name (first rp))
|
||||
(if (= (type-of rp) "symbol") (symbol-name rp) (str rp))))))))
|
||||
(py-collect-params-loop params (+ i 1) result))
|
||||
;; Normal param
|
||||
(= (type-of p) "symbol")
|
||||
(py-collect-params-loop params (+ i 1)
|
||||
(append result (py-mangle (symbol-name p))))
|
||||
;; Annotated param: (name :as type) → extract name
|
||||
(and (= (type-of p) "list") (= (len p) 3)
|
||||
(= (type-of (nth p 1)) "keyword")
|
||||
(= (keyword-name (nth p 1)) "as"))
|
||||
(py-collect-params-loop params (+ i 1)
|
||||
(append result (py-mangle (symbol-name (first p)))))
|
||||
;; Something else
|
||||
:else
|
||||
(py-collect-params-loop params (+ i 1)
|
||||
@@ -592,7 +604,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-let
|
||||
(fn (expr cell-vars)
|
||||
(fn (expr (cell-vars :as list))
|
||||
(let ((bindings (nth expr 1))
|
||||
(body (rest (rest expr))))
|
||||
(let ((assignments (py-parse-bindings bindings cell-vars)))
|
||||
@@ -603,7 +615,7 @@
|
||||
(py-wrap-let-bindings assignments body-str cell-vars))))))
|
||||
|
||||
(define py-parse-bindings
|
||||
(fn (bindings cell-vars)
|
||||
(fn (bindings (cell-vars :as list))
|
||||
(if (and (list? bindings) (not (empty? bindings)))
|
||||
(if (list? (first bindings))
|
||||
;; Scheme-style: ((name val) ...)
|
||||
@@ -618,7 +630,7 @@
|
||||
(list))))
|
||||
|
||||
(define py-parse-clojure-bindings
|
||||
(fn (bindings i result cell-vars)
|
||||
(fn (bindings (i :as number) (result :as list) (cell-vars :as list))
|
||||
(if (>= i (- (len bindings) 1))
|
||||
result
|
||||
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
||||
@@ -629,7 +641,7 @@
|
||||
cell-vars)))))
|
||||
|
||||
(define py-wrap-let-bindings
|
||||
(fn (assignments body-str cell-vars)
|
||||
(fn ((assignments :as list) (body-str :as string) (cell-vars :as list))
|
||||
(if (empty? assignments)
|
||||
body-str
|
||||
(let ((binding (last assignments))
|
||||
@@ -649,7 +661,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-when
|
||||
(fn (expr cell-vars)
|
||||
(fn (expr (cell-vars :as list))
|
||||
(let ((cond-e (py-expr-with-cells (nth expr 1) cell-vars))
|
||||
(body-parts (rest (rest expr))))
|
||||
(if (= (len body-parts) 1)
|
||||
@@ -663,7 +675,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-cond
|
||||
(fn (clauses cell-vars)
|
||||
(fn ((clauses :as list) (cell-vars :as list))
|
||||
(if (empty? clauses)
|
||||
"NIL"
|
||||
;; Detect scheme vs clojure style
|
||||
@@ -681,7 +693,7 @@
|
||||
(and (= (type-of test) "keyword") (= (keyword-name test) "else")))))
|
||||
|
||||
(define py-cond-scheme
|
||||
(fn (clauses cell-vars)
|
||||
(fn ((clauses :as list) (cell-vars :as list))
|
||||
(if (empty? clauses)
|
||||
"NIL"
|
||||
(let ((clause (first clauses))
|
||||
@@ -694,7 +706,7 @@
|
||||
") else " (py-cond-scheme (rest clauses) cell-vars) ")"))))))
|
||||
|
||||
(define py-cond-clojure
|
||||
(fn (clauses cell-vars)
|
||||
(fn ((clauses :as list) (cell-vars :as list))
|
||||
(if (< (len clauses) 2)
|
||||
"NIL"
|
||||
(let ((test (first clauses))
|
||||
@@ -711,17 +723,17 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-case
|
||||
(fn (args cell-vars)
|
||||
(fn ((args :as list) (cell-vars :as list))
|
||||
(let ((match-expr (py-expr-with-cells (first args) cell-vars))
|
||||
(clauses (rest args)))
|
||||
(str "_sx_case(" match-expr ", [" (py-case-pairs clauses cell-vars) "])"))))
|
||||
|
||||
(define py-case-pairs
|
||||
(fn (clauses cell-vars)
|
||||
(fn ((clauses :as list) (cell-vars :as list))
|
||||
(py-case-pairs-loop clauses 0 (list) cell-vars)))
|
||||
|
||||
(define py-case-pairs-loop
|
||||
(fn (clauses i result cell-vars)
|
||||
(fn ((clauses :as list) (i :as number) (result :as list) (cell-vars :as list))
|
||||
(if (>= i (- (len clauses) 1))
|
||||
(join ", " result)
|
||||
(let ((test (nth clauses i))
|
||||
@@ -738,28 +750,28 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-and
|
||||
(fn (args cell-vars)
|
||||
(fn ((args :as list) (cell-vars :as list))
|
||||
(let ((parts (map (fn (x) (py-expr-with-cells x cell-vars)) args)))
|
||||
(if (= (len parts) 1)
|
||||
(first parts)
|
||||
(py-and-chain parts)))))
|
||||
|
||||
(define py-and-chain
|
||||
(fn (parts)
|
||||
(fn ((parts :as list))
|
||||
(if (= (len parts) 1)
|
||||
(first parts)
|
||||
(let ((p (first parts)))
|
||||
(str "(" p " if not sx_truthy(" p ") else " (py-and-chain (rest parts)) ")")))))
|
||||
|
||||
(define py-emit-or
|
||||
(fn (args cell-vars)
|
||||
(fn ((args :as list) (cell-vars :as list))
|
||||
(if (= (len args) 1)
|
||||
(py-expr-with-cells (first args) cell-vars)
|
||||
(let ((parts (map (fn (x) (py-expr-with-cells x cell-vars)) args)))
|
||||
(py-or-chain parts)))))
|
||||
|
||||
(define py-or-chain
|
||||
(fn (parts)
|
||||
(fn ((parts :as list))
|
||||
(if (= (len parts) 1)
|
||||
(first parts)
|
||||
(let ((p (first parts)))
|
||||
@@ -771,7 +783,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-do
|
||||
(fn (args cell-vars)
|
||||
(fn ((args :as list) (cell-vars :as list))
|
||||
(if (= (len args) 1)
|
||||
(py-expr-with-cells (first args) cell-vars)
|
||||
(str "_sx_begin(" (join ", " (map (fn (e) (py-expr-with-cells e cell-vars)) args)) ")"))))
|
||||
@@ -782,11 +794,11 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-dict-literal
|
||||
(fn (pairs cell-vars)
|
||||
(fn ((pairs :as list) (cell-vars :as list))
|
||||
(str "{" (py-dict-pairs-str pairs 0 (list) cell-vars) "}")))
|
||||
|
||||
(define py-dict-pairs-str
|
||||
(fn (pairs i result cell-vars)
|
||||
(fn ((pairs :as list) (i :as number) (result :as list) (cell-vars :as list))
|
||||
(if (>= i (- (len pairs) 1))
|
||||
(join ", " result)
|
||||
(let ((key (nth pairs i))
|
||||
@@ -805,7 +817,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-infix
|
||||
(fn (op args cell-vars)
|
||||
(fn ((op :as string) (args :as list) (cell-vars :as list))
|
||||
(let ((py-op (py-op-symbol op)))
|
||||
(if (and (= (len args) 1) (= op "-"))
|
||||
(str "(-" (py-expr-with-cells (first args) cell-vars) ")")
|
||||
@@ -839,15 +851,15 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-pad
|
||||
(fn (indent)
|
||||
(fn ((indent :as number))
|
||||
(join "" (map (fn (i) " ") (range 0 indent)))))
|
||||
|
||||
(define py-statement
|
||||
(fn (expr indent)
|
||||
(fn (expr (indent :as number))
|
||||
(py-statement-with-cells expr indent (list))))
|
||||
|
||||
(define py-statement-with-cells
|
||||
(fn (expr indent cell-vars)
|
||||
(fn (expr (indent :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent)))
|
||||
(if (and (list? expr) (not (empty? expr))
|
||||
(= (type-of (first expr)) "symbol"))
|
||||
@@ -889,7 +901,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-define
|
||||
(fn (expr indent cell-vars)
|
||||
(fn (expr (indent :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent))
|
||||
(name (if (= (type-of (nth expr 1)) "symbol")
|
||||
(symbol-name (nth expr 1))
|
||||
@@ -911,7 +923,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-define-as-def
|
||||
(fn (name fn-expr indent)
|
||||
(fn ((name :as string) fn-expr (indent :as number))
|
||||
(let ((pad (py-pad indent))
|
||||
(params (nth fn-expr 1))
|
||||
(body (rest (rest fn-expr)))
|
||||
@@ -932,13 +944,13 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-body-stmts
|
||||
(fn (body lines indent cell-vars)
|
||||
(fn ((body :as list) (lines :as list) (indent :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent))
|
||||
(total (len body)))
|
||||
(py-emit-body-stmts-loop body lines indent cell-vars 0 total pad))))
|
||||
|
||||
(define py-emit-body-stmts-loop
|
||||
(fn (body lines indent cell-vars i total pad)
|
||||
(fn ((body :as list) (lines :as list) (indent :as number) (cell-vars :as list) (i :as number) (total :as number) (pad :as string))
|
||||
(when (< i total)
|
||||
(let ((expr (nth body i))
|
||||
(is-last (= i (- total 1))))
|
||||
@@ -968,7 +980,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-let-as-stmts
|
||||
(fn (expr lines indent is-last cell-vars)
|
||||
(fn (expr (lines :as list) (indent :as number) (is-last :as boolean) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent))
|
||||
(bindings (nth expr 1))
|
||||
(body (rest (rest expr))))
|
||||
@@ -981,7 +993,7 @@
|
||||
(for-each (fn (b) (py-emit-stmt-recursive b lines indent cell-vars)) body))))))
|
||||
|
||||
(define py-emit-binding-assignments
|
||||
(fn (bindings lines indent cell-vars)
|
||||
(fn (bindings (lines :as list) (indent :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent)))
|
||||
(when (and (list? bindings) (not (empty? bindings)))
|
||||
(if (list? (first bindings))
|
||||
@@ -1002,7 +1014,7 @@
|
||||
(py-emit-clojure-binding-assignments bindings lines indent 0 cell-vars))))))
|
||||
|
||||
(define py-emit-clojure-binding-assignments
|
||||
(fn (bindings lines indent i cell-vars)
|
||||
(fn (bindings (lines :as list) (indent :as number) (i :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent)))
|
||||
(when (< i (- (len bindings) 1))
|
||||
(let ((vname (if (= (type-of (nth bindings i)) "symbol")
|
||||
@@ -1024,7 +1036,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-stmt-recursive
|
||||
(fn (expr lines indent cell-vars)
|
||||
(fn (expr (lines :as list) (indent :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent)))
|
||||
(if (not (and (list? expr) (not (empty? expr))))
|
||||
(append! lines (py-statement-with-cells expr indent cell-vars))
|
||||
@@ -1082,7 +1094,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-cond-stmt
|
||||
(fn (expr lines indent cell-vars)
|
||||
(fn (expr (lines :as list) (indent :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent))
|
||||
(clauses (rest expr)))
|
||||
;; Detect scheme vs clojure
|
||||
@@ -1094,7 +1106,7 @@
|
||||
(py-cond-stmt-clojure clauses lines indent 0 true cell-vars))))))
|
||||
|
||||
(define py-cond-stmt-scheme
|
||||
(fn (clauses lines indent first-clause cell-vars)
|
||||
(fn ((clauses :as list) (lines :as list) (indent :as number) (first-clause :as boolean) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent)))
|
||||
(when (not (empty? clauses))
|
||||
(let ((clause (first clauses))
|
||||
@@ -1111,7 +1123,7 @@
|
||||
(py-cond-stmt-scheme (rest clauses) lines indent false cell-vars)))))))
|
||||
|
||||
(define py-cond-stmt-clojure
|
||||
(fn (clauses lines indent i first-clause cell-vars)
|
||||
(fn ((clauses :as list) (lines :as list) (indent :as number) (i :as number) (first-clause :as boolean) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent)))
|
||||
(when (< i (- (len clauses) 1))
|
||||
(let ((test (nth clauses i))
|
||||
@@ -1132,7 +1144,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-when-stmt
|
||||
(fn (expr indent cell-vars)
|
||||
(fn (expr (indent :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent))
|
||||
(cond-e (py-expr-with-cells (nth expr 1) cell-vars))
|
||||
(body-parts (rest (rest expr))))
|
||||
@@ -1146,7 +1158,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-emit-for-each-stmt
|
||||
(fn (expr indent cell-vars)
|
||||
(fn (expr (indent :as number) (cell-vars :as list))
|
||||
(let ((pad (py-pad indent))
|
||||
(fn-expr (nth expr 1))
|
||||
(coll-expr (nth expr 2))
|
||||
@@ -1175,7 +1187,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define py-translate-file
|
||||
(fn (defines)
|
||||
(fn ((defines :as list))
|
||||
(join "\n" (map (fn (pair)
|
||||
(let ((name (first pair))
|
||||
(expr (nth pair 1)))
|
||||
|
||||
@@ -39,7 +39,7 @@ def _get_z3_env() -> dict[str, Any]:
|
||||
return _z3_env
|
||||
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.evaluator import make_env, _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import make_env, eval_expr as _eval, trampoline as _trampoline
|
||||
|
||||
env = make_env()
|
||||
z3_path = os.path.join(os.path.dirname(__file__), "z3.sx")
|
||||
@@ -60,7 +60,7 @@ def z3_translate(expr: Any) -> str:
|
||||
|
||||
Delegates to z3-translate defined in z3.sx.
|
||||
"""
|
||||
from shared.sx.evaluator import _trampoline, _call_lambda
|
||||
from shared.sx.ref.sx_ref import trampoline as _trampoline, call_lambda as _call_lambda
|
||||
|
||||
env = _get_z3_env()
|
||||
return _trampoline(_call_lambda(env["z3-translate"], [expr], env))
|
||||
@@ -72,7 +72,7 @@ def z3_translate_file(source: str) -> str:
|
||||
Delegates to z3-translate-file defined in z3.sx.
|
||||
"""
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.evaluator import _trampoline, _call_lambda
|
||||
from shared.sx.ref.sx_ref import trampoline as _trampoline, call_lambda as _call_lambda
|
||||
|
||||
env = _get_z3_env()
|
||||
exprs = parse_all(source)
|
||||
|
||||
@@ -72,18 +72,18 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define definition-form?
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(or (= name "define") (= name "defcomp") (= name "defisland")
|
||||
(= name "defmacro") (= name "defstyle") (= name "defhandler"))))
|
||||
|
||||
|
||||
(define parse-element-args
|
||||
(fn (args env)
|
||||
(fn ((args :as list) (env :as dict))
|
||||
;; Parse (:key val :key2 val2 child1 child2) into (attrs-dict children-list)
|
||||
(let ((attrs (dict))
|
||||
(children (list)))
|
||||
(reduce
|
||||
(fn (state arg)
|
||||
(fn ((state :as dict) arg)
|
||||
(let ((skip (get state "skip")))
|
||||
(if skip
|
||||
(assoc state "skip" false "i" (inc (get state "i")))
|
||||
@@ -101,12 +101,12 @@
|
||||
|
||||
|
||||
(define render-attrs
|
||||
(fn (attrs)
|
||||
(fn ((attrs :as dict))
|
||||
;; Render an attrs dict to an HTML attribute string.
|
||||
;; Used by adapter-html.sx and adapter-sx.sx.
|
||||
(join ""
|
||||
(map
|
||||
(fn (key)
|
||||
(fn ((key :as string))
|
||||
(let ((val (dict-get attrs key)))
|
||||
(cond
|
||||
;; Boolean attrs
|
||||
@@ -133,17 +133,13 @@
|
||||
;; Handles both scheme-style ((test body) ...) and clojure-style
|
||||
;; (test body test body ...).
|
||||
(define eval-cond
|
||||
(fn (clauses env)
|
||||
(if (and (not (empty? clauses))
|
||||
(= (type-of (first clauses)) "list")
|
||||
(= (len (first clauses)) 2))
|
||||
;; Scheme-style
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (cond-scheme? clauses)
|
||||
(eval-cond-scheme clauses env)
|
||||
;; Clojure-style
|
||||
(eval-cond-clojure clauses env))))
|
||||
|
||||
(define eval-cond-scheme
|
||||
(fn (clauses env)
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (empty? clauses)
|
||||
nil
|
||||
(let ((clause (first clauses))
|
||||
@@ -160,7 +156,7 @@
|
||||
(eval-cond-scheme (rest clauses) env)))))))
|
||||
|
||||
(define eval-cond-clojure
|
||||
(fn (clauses env)
|
||||
(fn ((clauses :as list) (env :as dict))
|
||||
(if (< (len clauses) 2)
|
||||
nil
|
||||
(let ((test (first clauses))
|
||||
@@ -177,10 +173,12 @@
|
||||
;; process-bindings: evaluate let-binding pairs, return extended env.
|
||||
;; bindings = ((name1 expr1) (name2 expr2) ...)
|
||||
(define process-bindings
|
||||
(fn (bindings env)
|
||||
(let ((local (merge env)))
|
||||
(fn ((bindings :as list) (env :as dict))
|
||||
;; env-extend (not merge) — Env is not a dict subclass, so merge()
|
||||
;; returns an empty dict, losing all parent scope bindings.
|
||||
(let ((local (env-extend env)))
|
||||
(for-each
|
||||
(fn (pair)
|
||||
(fn ((pair :as list))
|
||||
(when (and (= (type-of pair) "list") (>= (len pair) 2))
|
||||
(let ((name (if (= (type-of (first pair)) "symbol")
|
||||
(symbol-name (first pair))
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
;; "/docs/" → ("docs")
|
||||
|
||||
(define split-path-segments
|
||||
(fn (path)
|
||||
(fn ((path :as string))
|
||||
(let ((trimmed (if (starts-with? path "/") (slice path 1) path)))
|
||||
(let ((trimmed2 (if (and (not (empty? trimmed))
|
||||
(ends-with? trimmed "/"))
|
||||
@@ -36,7 +36,7 @@
|
||||
;; {"type" "param" "value" "slug"})
|
||||
|
||||
(define make-route-segment
|
||||
(fn (seg)
|
||||
(fn ((seg :as string))
|
||||
(if (and (starts-with? seg "<") (ends-with? seg ">"))
|
||||
(let ((param-name (slice seg 1 (- (len seg) 1))))
|
||||
(let ((d {}))
|
||||
@@ -49,7 +49,7 @@
|
||||
d))))
|
||||
|
||||
(define parse-route-pattern
|
||||
(fn (pattern)
|
||||
(fn ((pattern :as string))
|
||||
(let ((segments (split-path-segments pattern)))
|
||||
(map make-route-segment segments))))
|
||||
|
||||
@@ -60,13 +60,13 @@
|
||||
;; Returns params dict if match, nil if no match.
|
||||
|
||||
(define match-route-segments
|
||||
(fn (path-segs parsed-segs)
|
||||
(fn ((path-segs :as list) (parsed-segs :as list))
|
||||
(if (not (= (len path-segs) (len parsed-segs)))
|
||||
nil
|
||||
(let ((params {})
|
||||
(matched true))
|
||||
(for-each-indexed
|
||||
(fn (i parsed-seg)
|
||||
(fn ((i :as number) (parsed-seg :as dict))
|
||||
(when matched
|
||||
(let ((path-seg (nth path-segs i))
|
||||
(seg-type (get parsed-seg "type")))
|
||||
@@ -88,7 +88,7 @@
|
||||
;; Returns params dict (may be empty for exact matches) or nil.
|
||||
|
||||
(define match-route
|
||||
(fn (path pattern)
|
||||
(fn ((path :as string) (pattern :as string))
|
||||
(let ((path-segs (split-path-segments path))
|
||||
(parsed-segs (parse-route-pattern pattern)))
|
||||
(match-route-segments path-segs parsed-segs))))
|
||||
@@ -101,11 +101,11 @@
|
||||
;; Returns matching entry with "params" added, or nil.
|
||||
|
||||
(define find-matching-route
|
||||
(fn (path routes)
|
||||
(fn ((path :as string) (routes :as list))
|
||||
(let ((path-segs (split-path-segments path))
|
||||
(result nil))
|
||||
(for-each
|
||||
(fn (route)
|
||||
(fn ((route :as dict))
|
||||
(when (nil? result)
|
||||
(let ((params (match-route-segments path-segs (get route "parsed"))))
|
||||
(when (not (nil? params))
|
||||
|
||||
@@ -49,7 +49,7 @@ def load_js_sx() -> dict:
|
||||
|
||||
exprs = parse_all(source)
|
||||
|
||||
from shared.sx.evaluator import evaluate, make_env
|
||||
from shared.sx.ref.sx_ref import evaluate, make_env
|
||||
|
||||
env = make_env()
|
||||
for expr in exprs:
|
||||
@@ -74,7 +74,7 @@ def compile_ref_to_js(
|
||||
spec_modules: List of spec modules (deps, router, signals). None = auto.
|
||||
"""
|
||||
from datetime import datetime, timezone
|
||||
from shared.sx.evaluator import evaluate
|
||||
from shared.sx.ref.sx_ref import evaluate
|
||||
|
||||
ref_dir = _HERE
|
||||
env = load_js_sx()
|
||||
@@ -103,8 +103,11 @@ def compile_ref_to_js(
|
||||
if "boot" in adapter_set:
|
||||
spec_mod_set.add("router")
|
||||
spec_mod_set.add("deps")
|
||||
if "page-helpers" in SPEC_MODULES:
|
||||
spec_mod_set.add("page-helpers")
|
||||
has_deps = "deps" in spec_mod_set
|
||||
has_router = "router" in spec_mod_set
|
||||
has_page_helpers = "page-helpers" in spec_mod_set
|
||||
|
||||
# Resolve extensions
|
||||
ext_set = set()
|
||||
@@ -198,12 +201,12 @@ def compile_ref_to_js(
|
||||
if name in adapter_set and name in adapter_platform:
|
||||
parts.append(adapter_platform[name])
|
||||
|
||||
parts.append(fixups_js(has_html, has_sx, has_dom, has_signals, has_deps))
|
||||
parts.append(fixups_js(has_html, has_sx, has_dom, has_signals, has_deps, has_page_helpers))
|
||||
if has_continuations:
|
||||
parts.append(CONTINUATIONS_JS)
|
||||
if has_dom:
|
||||
parts.append(ASYNC_IO_JS)
|
||||
parts.append(public_api_js(has_html, has_sx, has_dom, has_engine, has_orch, has_boot, has_parser, adapter_label, has_deps, has_router, has_signals))
|
||||
parts.append(public_api_js(has_html, has_sx, has_dom, has_engine, has_orch, has_boot, has_parser, adapter_label, has_deps, has_router, has_signals, has_page_helpers))
|
||||
parts.append(EPILOGUE)
|
||||
|
||||
build_ts = datetime.now(timezone.utc).strftime("%Y-%m-%dT%H:%M:%SZ")
|
||||
|
||||
@@ -38,7 +38,7 @@ def load_py_sx(evaluator_env: dict) -> dict:
|
||||
exprs = parse_all(source)
|
||||
|
||||
# Import the evaluator
|
||||
from shared.sx.evaluator import evaluate, make_env
|
||||
from shared.sx.ref.sx_ref import evaluate, make_env
|
||||
|
||||
env = make_env()
|
||||
for expr in exprs:
|
||||
@@ -60,7 +60,7 @@ def extract_defines(source: str) -> list[tuple[str, list]]:
|
||||
|
||||
|
||||
def main():
|
||||
from shared.sx.evaluator import evaluate
|
||||
from shared.sx.ref.sx_ref import evaluate
|
||||
|
||||
# Load py.sx into evaluator
|
||||
env = load_py_sx({})
|
||||
|
||||
@@ -72,7 +72,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define reset!
|
||||
(fn (s value)
|
||||
(fn ((s :as signal) value)
|
||||
(when (signal? s)
|
||||
(let ((old (signal-value s)))
|
||||
(when (not (identical? old value))
|
||||
@@ -85,7 +85,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define swap!
|
||||
(fn (s f &rest args)
|
||||
(fn ((s :as signal) (f :as lambda) &rest args)
|
||||
(when (signal? s)
|
||||
(let ((old (signal-value s))
|
||||
(new-val (apply f (cons old args))))
|
||||
@@ -103,7 +103,7 @@
|
||||
;; by tracking deref calls during evaluation.
|
||||
|
||||
(define computed
|
||||
(fn (compute-fn)
|
||||
(fn ((compute-fn :as lambda))
|
||||
(let ((s (make-signal nil))
|
||||
(deps (list))
|
||||
(compute-ctx nil))
|
||||
@@ -113,7 +113,7 @@
|
||||
(fn ()
|
||||
;; Unsubscribe from old deps
|
||||
(for-each
|
||||
(fn (dep) (signal-remove-sub! dep recompute))
|
||||
(fn ((dep :as signal)) (signal-remove-sub! dep recompute))
|
||||
(signal-deps s))
|
||||
(signal-set-deps! s (list))
|
||||
|
||||
@@ -146,7 +146,7 @@
|
||||
;; function that tears down the effect.
|
||||
|
||||
(define effect
|
||||
(fn (effect-fn)
|
||||
(fn ((effect-fn :as lambda))
|
||||
(let ((deps (list))
|
||||
(disposed false)
|
||||
(cleanup-fn nil))
|
||||
@@ -159,7 +159,7 @@
|
||||
|
||||
;; Unsubscribe from old deps
|
||||
(for-each
|
||||
(fn (dep) (signal-remove-sub! dep run-effect))
|
||||
(fn ((dep :as signal)) (signal-remove-sub! dep run-effect))
|
||||
deps)
|
||||
(set! deps (list))
|
||||
|
||||
@@ -183,7 +183,7 @@
|
||||
(set! disposed true)
|
||||
(when cleanup-fn (invoke cleanup-fn))
|
||||
(for-each
|
||||
(fn (dep) (signal-remove-sub! dep run-effect))
|
||||
(fn ((dep :as signal)) (signal-remove-sub! dep run-effect))
|
||||
deps)
|
||||
(set! deps (list)))))
|
||||
;; Auto-register with island scope so disposal happens on swap
|
||||
@@ -202,7 +202,7 @@
|
||||
(define *batch-queue* (list))
|
||||
|
||||
(define batch
|
||||
(fn (thunk)
|
||||
(fn ((thunk :as lambda))
|
||||
(set! *batch-depth* (+ *batch-depth* 1))
|
||||
(invoke thunk)
|
||||
(set! *batch-depth* (- *batch-depth* 1))
|
||||
@@ -214,15 +214,15 @@
|
||||
(let ((seen (list))
|
||||
(pending (list)))
|
||||
(for-each
|
||||
(fn (s)
|
||||
(fn ((s :as signal))
|
||||
(for-each
|
||||
(fn (sub)
|
||||
(fn ((sub :as lambda))
|
||||
(when (not (contains? seen sub))
|
||||
(append! seen sub)
|
||||
(append! pending sub)))
|
||||
(signal-subscribers s)))
|
||||
queue)
|
||||
(for-each (fn (sub) (sub)) pending))))))
|
||||
(for-each (fn ((sub :as lambda)) (sub)) pending))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -232,16 +232,16 @@
|
||||
;; If inside a batch, queues the signal. Otherwise, notifies immediately.
|
||||
|
||||
(define notify-subscribers
|
||||
(fn (s)
|
||||
(fn ((s :as signal))
|
||||
(if (> *batch-depth* 0)
|
||||
(when (not (contains? *batch-queue* s))
|
||||
(append! *batch-queue* s))
|
||||
(flush-subscribers s))))
|
||||
|
||||
(define flush-subscribers
|
||||
(fn (s)
|
||||
(fn ((s :as signal))
|
||||
(for-each
|
||||
(fn (sub) (sub))
|
||||
(fn ((sub :as lambda)) (sub))
|
||||
(signal-subscribers s))))
|
||||
|
||||
|
||||
@@ -269,10 +269,10 @@
|
||||
;; For effects, the dispose function is returned by effect itself.
|
||||
|
||||
(define dispose-computed
|
||||
(fn (s)
|
||||
(fn ((s :as signal))
|
||||
(when (signal? s)
|
||||
(for-each
|
||||
(fn (dep) (signal-remove-sub! dep nil))
|
||||
(fn ((dep :as signal)) (signal-remove-sub! dep nil))
|
||||
(signal-deps s))
|
||||
(signal-set-deps! s (list)))))
|
||||
|
||||
@@ -288,7 +288,7 @@
|
||||
(define *island-scope* nil)
|
||||
|
||||
(define with-island-scope
|
||||
(fn (scope-fn body-fn)
|
||||
(fn ((scope-fn :as lambda) (body-fn :as lambda))
|
||||
(let ((prev *island-scope*))
|
||||
(set! *island-scope* scope-fn)
|
||||
(let ((result (body-fn)))
|
||||
@@ -300,7 +300,7 @@
|
||||
;; *island-scope* is non-nil.
|
||||
|
||||
(define register-in-scope
|
||||
(fn (disposable)
|
||||
(fn ((disposable :as lambda))
|
||||
(when *island-scope*
|
||||
(*island-scope* disposable))))
|
||||
|
||||
@@ -323,7 +323,7 @@
|
||||
;; (dom-get-data el key) → any — retrieve stored value
|
||||
|
||||
(define with-marsh-scope
|
||||
(fn (marsh-el body-fn)
|
||||
(fn (marsh-el (body-fn :as lambda))
|
||||
;; Execute body-fn collecting all disposables into a marsh-local list.
|
||||
;; Nested under the current island scope — if the island is disposed,
|
||||
;; the marsh is disposed too (because island scope collected the marsh's
|
||||
@@ -341,7 +341,7 @@
|
||||
;; Parent island scope and sibling marshes are unaffected.
|
||||
(let ((disposers (dom-get-data marsh-el "sx-marsh-disposers")))
|
||||
(when disposers
|
||||
(for-each (fn (d) (invoke d)) disposers)
|
||||
(for-each (fn ((d :as lambda)) (invoke d)) disposers)
|
||||
(dom-set-data marsh-el "sx-marsh-disposers" nil)))))
|
||||
|
||||
|
||||
@@ -359,7 +359,7 @@
|
||||
(define *store-registry* (dict))
|
||||
|
||||
(define def-store
|
||||
(fn (name init-fn)
|
||||
(fn ((name :as string) (init-fn :as lambda))
|
||||
(let ((registry *store-registry*))
|
||||
;; Only create the store once — subsequent calls return existing
|
||||
(when (not (has-key? registry name))
|
||||
@@ -367,7 +367,7 @@
|
||||
(get *store-registry* name))))
|
||||
|
||||
(define use-store
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(if (has-key? *store-registry* name)
|
||||
(get *store-registry* name)
|
||||
(error (str "Store not found: " name
|
||||
@@ -402,11 +402,11 @@
|
||||
;; These are platform primitives because they require browser DOM APIs.
|
||||
|
||||
(define emit-event
|
||||
(fn (el event-name detail)
|
||||
(fn (el (event-name :as string) detail)
|
||||
(dom-dispatch el event-name detail)))
|
||||
|
||||
(define on-event
|
||||
(fn (el event-name handler)
|
||||
(fn (el (event-name :as string) (handler :as lambda))
|
||||
(dom-listen el event-name handler)))
|
||||
|
||||
;; Convenience: create an effect that listens for a DOM event on an
|
||||
@@ -416,7 +416,7 @@
|
||||
;; removed automatically via the cleanup return.
|
||||
|
||||
(define bridge-event
|
||||
(fn (el event-name target-signal transform-fn)
|
||||
(fn (el (event-name :as string) (target-signal :as signal) transform-fn)
|
||||
(effect (fn ()
|
||||
(let ((remove (dom-listen el event-name
|
||||
(fn (e)
|
||||
@@ -450,7 +450,7 @@
|
||||
;; (promise-then promise on-resolve on-reject) → void
|
||||
|
||||
(define resource
|
||||
(fn (fetch-fn)
|
||||
(fn ((fetch-fn :as lambda))
|
||||
(let ((state (signal (dict "loading" true "data" nil "error" nil))))
|
||||
;; Kick off the async operation
|
||||
(promise-then (invoke fetch-fn)
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
272
shared/sx/ref/test-aser.sx
Normal file
272
shared/sx/ref/test-aser.sx
Normal file
@@ -0,0 +1,272 @@
|
||||
;; ==========================================================================
|
||||
;; test-aser.sx — Tests for the SX wire format (aser) adapter
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded first.
|
||||
;; Modules tested: adapter-sx.sx (aser, aser-call, aser-fragment, aser-special)
|
||||
;;
|
||||
;; Platform functions required (beyond test framework):
|
||||
;; render-sx (sx-source) -> SX wire format string
|
||||
;; Parses the sx-source string, evaluates via aser in a
|
||||
;; fresh env, and returns the resulting SX wire format string.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Basic serialization
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-basics"
|
||||
(deftest "number literal passes through"
|
||||
(assert-equal "42"
|
||||
(render-sx "42")))
|
||||
|
||||
(deftest "string literal passes through"
|
||||
;; aser returns the raw string value; render-sx concatenates it directly
|
||||
(assert-equal "hello"
|
||||
(render-sx "\"hello\"")))
|
||||
|
||||
(deftest "boolean true passes through"
|
||||
(assert-equal "true"
|
||||
(render-sx "true")))
|
||||
|
||||
(deftest "boolean false passes through"
|
||||
(assert-equal "false"
|
||||
(render-sx "false")))
|
||||
|
||||
(deftest "nil produces empty"
|
||||
(assert-equal ""
|
||||
(render-sx "nil"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; HTML tag serialization
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-tags"
|
||||
(deftest "simple div"
|
||||
(assert-equal "(div \"hello\")"
|
||||
(render-sx "(div \"hello\")")))
|
||||
|
||||
(deftest "nested tags"
|
||||
(assert-equal "(div (span \"hi\"))"
|
||||
(render-sx "(div (span \"hi\"))")))
|
||||
|
||||
(deftest "multiple children"
|
||||
(assert-equal "(div (p \"a\") (p \"b\"))"
|
||||
(render-sx "(div (p \"a\") (p \"b\"))")))
|
||||
|
||||
(deftest "attributes serialize"
|
||||
(assert-equal "(div :class \"foo\" \"bar\")"
|
||||
(render-sx "(div :class \"foo\" \"bar\")")))
|
||||
|
||||
(deftest "multiple attributes"
|
||||
(assert-equal "(a :href \"/home\" :class \"link\" \"Home\")"
|
||||
(render-sx "(a :href \"/home\" :class \"link\" \"Home\")")))
|
||||
|
||||
(deftest "void elements"
|
||||
(assert-equal "(br)"
|
||||
(render-sx "(br)")))
|
||||
|
||||
(deftest "void element with attrs"
|
||||
(assert-equal "(img :src \"pic.jpg\")"
|
||||
(render-sx "(img :src \"pic.jpg\")"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Fragment serialization
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-fragments"
|
||||
(deftest "simple fragment"
|
||||
(assert-equal "(<> (p \"a\") (p \"b\"))"
|
||||
(render-sx "(<> (p \"a\") (p \"b\"))")))
|
||||
|
||||
(deftest "empty fragment"
|
||||
(assert-equal ""
|
||||
(render-sx "(<>)")))
|
||||
|
||||
(deftest "single-child fragment"
|
||||
(assert-equal "(<> (div \"x\"))"
|
||||
(render-sx "(<> (div \"x\"))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Control flow in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-control-flow"
|
||||
(deftest "if true branch"
|
||||
(assert-equal "(p \"yes\")"
|
||||
(render-sx "(if true (p \"yes\") (p \"no\"))")))
|
||||
|
||||
(deftest "if false branch"
|
||||
(assert-equal "(p \"no\")"
|
||||
(render-sx "(if false (p \"yes\") (p \"no\"))")))
|
||||
|
||||
(deftest "when true"
|
||||
(assert-equal "(p \"ok\")"
|
||||
(render-sx "(when true (p \"ok\"))")))
|
||||
|
||||
(deftest "when false"
|
||||
(assert-equal ""
|
||||
(render-sx "(when false (p \"ok\"))")))
|
||||
|
||||
(deftest "cond serializes matching branch"
|
||||
(assert-equal "(p \"two\")"
|
||||
(render-sx "(cond false (p \"one\") true (p \"two\") :else (p \"three\"))")))
|
||||
|
||||
(deftest "cond with 2-element predicate test"
|
||||
;; Regression: cond misclassifies (nil? x) as scheme-style clause.
|
||||
(assert-equal "(p \"yes\")"
|
||||
(render-sx "(cond (nil? nil) (p \"yes\") :else (p \"no\"))"))
|
||||
(assert-equal "(p \"no\")"
|
||||
(render-sx "(cond (nil? \"x\") (p \"yes\") :else (p \"no\"))")))
|
||||
|
||||
(deftest "let binds then serializes"
|
||||
(assert-equal "(p \"hello\")"
|
||||
(render-sx "(let ((x \"hello\")) (p x))")))
|
||||
|
||||
(deftest "let preserves outer scope bindings"
|
||||
;; Regression: process-bindings must preserve parent env scope chain.
|
||||
;; Using merge() instead of env-extend loses parent scope items.
|
||||
(assert-equal "(p \"outer\")"
|
||||
(render-sx "(do (define theme \"outer\") (let ((x 1)) (p theme)))")))
|
||||
|
||||
(deftest "nested let preserves outer scope"
|
||||
(assert-equal "(div (span \"hello\") (span \"world\"))"
|
||||
(render-sx "(do (define a \"hello\")
|
||||
(define b \"world\")
|
||||
(div (let ((x 1)) (span a))
|
||||
(let ((y 2)) (span b))))")))
|
||||
|
||||
(deftest "begin serializes last"
|
||||
(assert-equal "(p \"last\")"
|
||||
(render-sx "(begin (p \"first\") (p \"last\"))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; THE BUG — map/filter list flattening in children (critical regression)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-list-flattening"
|
||||
(deftest "map inside tag flattens children"
|
||||
(assert-equal "(div (span \"a\") (span \"b\") (span \"c\"))"
|
||||
(render-sx "(do (define items (list \"a\" \"b\" \"c\"))
|
||||
(div (map (fn (x) (span x)) items)))")))
|
||||
|
||||
(deftest "map inside tag with other children"
|
||||
(assert-equal "(ul (li \"first\") (li \"a\") (li \"b\"))"
|
||||
(render-sx "(do (define items (list \"a\" \"b\"))
|
||||
(ul (li \"first\") (map (fn (x) (li x)) items)))")))
|
||||
|
||||
(deftest "filter result via let binding as children"
|
||||
;; Note: (filter ...) is treated as an SVG tag in aser dispatch (SVG has <filter>),
|
||||
;; so we evaluate filter via let binding + map to serialize children
|
||||
(assert-equal "(ul (li \"a\") (li \"b\"))"
|
||||
(render-sx "(do (define items (list \"a\" nil \"b\"))
|
||||
(define kept (filter (fn (x) (not (nil? x))) items))
|
||||
(ul (map (fn (x) (li x)) kept)))")))
|
||||
|
||||
(deftest "map inside fragment flattens"
|
||||
(assert-equal "(<> (p \"a\") (p \"b\"))"
|
||||
(render-sx "(do (define items (list \"a\" \"b\"))
|
||||
(<> (map (fn (x) (p x)) items)))")))
|
||||
|
||||
(deftest "nested map does not double-wrap"
|
||||
(assert-equal "(div (span \"1\") (span \"2\"))"
|
||||
(render-sx "(do (define nums (list 1 2))
|
||||
(div (map (fn (n) (span (str n))) nums)))")))
|
||||
|
||||
(deftest "map with component-like output flattens"
|
||||
(assert-equal "(div (li \"x\") (li \"y\"))"
|
||||
(render-sx "(do (define items (list \"x\" \"y\"))
|
||||
(div (map (fn (x) (li x)) items)))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Component serialization (NOT expanded in basic aser mode)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-components"
|
||||
(deftest "unknown component serializes as-is"
|
||||
(assert-equal "(~foo :title \"bar\")"
|
||||
(render-sx "(~foo :title \"bar\")")))
|
||||
|
||||
(deftest "defcomp then unexpanded component call"
|
||||
(assert-equal "(~card :title \"Hi\")"
|
||||
(render-sx "(do (defcomp ~card (&key title) (h1 title)) (~card :title \"Hi\"))")))
|
||||
|
||||
(deftest "component with children serializes unexpanded"
|
||||
(assert-equal "(~box (p \"inside\"))"
|
||||
(render-sx "(do (defcomp ~box (&key &rest children) (div children))
|
||||
(~box (p \"inside\")))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Definition forms in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-definitions"
|
||||
(deftest "define evaluates for side effects, returns nil"
|
||||
(assert-equal "(p 42)"
|
||||
(render-sx "(do (define x 42) (p x))")))
|
||||
|
||||
(deftest "defcomp evaluates and returns nil"
|
||||
(assert-equal "(~tag :x 1)"
|
||||
(render-sx "(do (defcomp ~tag (&key x) (span x)) (~tag :x 1))")))
|
||||
|
||||
(deftest "defisland evaluates AND serializes"
|
||||
(let ((result (render-sx "(defisland ~counter (&key count) (span count))")))
|
||||
(assert-true (string-contains? result "defisland")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Function calls in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-function-calls"
|
||||
(deftest "named function call evaluates fully"
|
||||
(assert-equal "3"
|
||||
(render-sx "(do (define inc1 (fn (x) (+ x 1))) (inc1 2))")))
|
||||
|
||||
(deftest "define + call"
|
||||
(assert-equal "10"
|
||||
(render-sx "(do (define double (fn (x) (* x 2))) (double 5))")))
|
||||
|
||||
(deftest "native callable with multiple args"
|
||||
;; Regression: async-aser-eval-call passed evaled-args list to
|
||||
;; async-invoke (&rest), wrapping it in another list. apply(f, [list])
|
||||
;; calls f(list) instead of f(*list).
|
||||
(assert-equal "3"
|
||||
(render-sx "(do (define my-add +) (my-add 1 2))")))
|
||||
|
||||
(deftest "native callable with two args via alias"
|
||||
(assert-equal "hello world"
|
||||
(render-sx "(do (define my-join str) (my-join \"hello\" \" world\"))")))
|
||||
|
||||
(deftest "higher-order: map returns list"
|
||||
(let ((result (render-sx "(map (fn (x) (+ x 1)) (list 1 2 3))")))
|
||||
;; map at top level returns a list, not serialized tags
|
||||
(assert-true (not (nil? result))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; and/or short-circuit in aser mode
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "aser-logic"
|
||||
(deftest "and short-circuits on false"
|
||||
(assert-equal "false"
|
||||
(render-sx "(and true false true)")))
|
||||
|
||||
(deftest "and returns last truthy"
|
||||
(assert-equal "3"
|
||||
(render-sx "(and 1 2 3)")))
|
||||
|
||||
(deftest "or short-circuits on true"
|
||||
(assert-equal "1"
|
||||
(render-sx "(or 1 2 3)")))
|
||||
|
||||
(deftest "or returns last falsy"
|
||||
(assert-equal "false"
|
||||
(render-sx "(or false false)"))))
|
||||
@@ -277,6 +277,29 @@
|
||||
false "b"
|
||||
:else "c")))
|
||||
|
||||
(deftest "cond with 2-element predicate as first test"
|
||||
;; Regression: cond misclassifies Clojure-style as scheme-style when
|
||||
;; the first test is a 2-element list like (nil? x) or (empty? x).
|
||||
;; The evaluator checks: is first arg a 2-element list? If yes, treats
|
||||
;; as scheme-style ((test body) ...) — returning the arg instead of
|
||||
;; evaluating the predicate call.
|
||||
(assert-equal 0 (cond (nil? nil) 0 :else 1))
|
||||
(assert-equal 1 (cond (nil? "x") 0 :else 1))
|
||||
(assert-equal "empty" (cond (empty? (list)) "empty" :else "not-empty"))
|
||||
(assert-equal "not-empty" (cond (empty? (list 1)) "empty" :else "not-empty"))
|
||||
(assert-equal "yes" (cond (not false) "yes" :else "no"))
|
||||
(assert-equal "no" (cond (not true) "yes" :else "no")))
|
||||
|
||||
(deftest "cond with 2-element predicate and no :else"
|
||||
;; Same bug, but without :else — this is the worst case because the
|
||||
;; bootstrapper heuristic also breaks (all clauses are 2-element lists).
|
||||
(assert-equal "found"
|
||||
(cond (nil? nil) "found"
|
||||
(nil? "x") "other"))
|
||||
(assert-equal "b"
|
||||
(cond (nil? "x") "a"
|
||||
(not false) "b")))
|
||||
|
||||
(deftest "and"
|
||||
(assert-true (and true true))
|
||||
(assert-false (and true false))
|
||||
|
||||
@@ -57,7 +57,7 @@
|
||||
(assert (nil? val) (str "Expected nil but got " (str val)))))
|
||||
|
||||
(define assert-type
|
||||
(fn (expected-type val)
|
||||
(fn ((expected-type :as string) val)
|
||||
(let ((actual-type
|
||||
(if (nil? val) "nil"
|
||||
(if (boolean? val) "boolean"
|
||||
@@ -70,17 +70,17 @@
|
||||
(str "Expected type " expected-type " but got " actual-type)))))
|
||||
|
||||
(define assert-length
|
||||
(fn (expected-len col)
|
||||
(fn ((expected-len :as number) (col :as list))
|
||||
(assert (= (len col) expected-len)
|
||||
(str "Expected length " expected-len " but got " (len col)))))
|
||||
|
||||
(define assert-contains
|
||||
(fn (item col)
|
||||
(fn (item (col :as list))
|
||||
(assert (some (fn (x) (equal? x item)) col)
|
||||
(str "Expected collection to contain " (str item)))))
|
||||
|
||||
(define assert-throws
|
||||
(fn (thunk)
|
||||
(fn ((thunk :as lambda))
|
||||
(let ((result (try-call thunk)))
|
||||
(assert (not (get result "ok"))
|
||||
"Expected an error to be thrown but none was"))))
|
||||
|
||||
@@ -149,7 +149,27 @@
|
||||
|
||||
(deftest "let in render context"
|
||||
(assert-equal "<p>hello</p>"
|
||||
(render-html "(let ((x \"hello\")) (p x))"))))
|
||||
(render-html "(let ((x \"hello\")) (p x))")))
|
||||
|
||||
(deftest "cond with 2-element predicate test"
|
||||
;; Regression: cond misclassifies (nil? x) as scheme-style clause.
|
||||
(assert-equal "<p>yes</p>"
|
||||
(render-html "(cond (nil? nil) (p \"yes\") :else (p \"no\"))"))
|
||||
(assert-equal "<p>no</p>"
|
||||
(render-html "(cond (nil? \"x\") (p \"yes\") :else (p \"no\"))")))
|
||||
|
||||
(deftest "let preserves outer scope bindings"
|
||||
;; Regression: process-bindings must preserve parent env scope chain.
|
||||
;; Using merge() on Env objects returns empty dict (Env is not dict subclass).
|
||||
(assert-equal "<p>outer</p>"
|
||||
(render-html "(do (define theme \"outer\") (let ((x 1)) (p theme)))")))
|
||||
|
||||
(deftest "nested let preserves outer scope"
|
||||
(assert-equal "<div><span>hello</span><span>world</span></div>"
|
||||
(render-html "(do (define a \"hello\")
|
||||
(define b \"world\")
|
||||
(div (let ((x 1)) (span a))
|
||||
(let ((y 2)) (span b))))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -165,3 +185,46 @@
|
||||
(let ((html (render-html "(do (defcomp ~box (&key &rest children) (div :class \"box\" children)) (~box (p \"inside\")))")))
|
||||
(assert-true (string-contains? html "class=\"box\""))
|
||||
(assert-true (string-contains? html "<p>inside</p>")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Map/filter producing multiple children (aser-adjacent regression tests)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-map-children"
|
||||
(deftest "map producing multiple children inside tag"
|
||||
(assert-equal "<ul><li>a</li><li>b</li><li>c</li></ul>"
|
||||
(render-html "(do (define items (list \"a\" \"b\" \"c\"))
|
||||
(ul (map (fn (x) (li x)) items)))")))
|
||||
|
||||
(deftest "map with other siblings"
|
||||
(assert-equal "<ul><li>first</li><li>a</li><li>b</li></ul>"
|
||||
(render-html "(do (define items (list \"a\" \"b\"))
|
||||
(ul (li \"first\") (map (fn (x) (li x)) items)))")))
|
||||
|
||||
(deftest "filter with nil results inside tag"
|
||||
(assert-equal "<ul><li>a</li><li>c</li></ul>"
|
||||
(render-html "(do (define items (list \"a\" nil \"c\"))
|
||||
(ul (map (fn (x) (li x))
|
||||
(filter (fn (x) (not (nil? x))) items))))")))
|
||||
|
||||
(deftest "nested map inside let"
|
||||
(assert-equal "<div><span>1</span><span>2</span></div>"
|
||||
(render-html "(let ((nums (list 1 2)))
|
||||
(div (map (fn (n) (span n)) nums)))")))
|
||||
|
||||
(deftest "component with &rest receiving mapped results"
|
||||
(let ((html (render-html "(do (defcomp ~list-box (&key &rest children) (div :class \"lb\" children))
|
||||
(define items (list \"x\" \"y\"))
|
||||
(~list-box (map (fn (x) (p x)) items)))")))
|
||||
(assert-true (string-contains? html "class=\"lb\""))
|
||||
(assert-true (string-contains? html "<p>x</p>"))
|
||||
(assert-true (string-contains? html "<p>y</p>"))))
|
||||
|
||||
(deftest "map-indexed renders with index"
|
||||
(assert-equal "<li>0: a</li><li>1: b</li>"
|
||||
(render-html "(map-indexed (fn (i x) (li (str i \": \" x))) (list \"a\" \"b\"))")))
|
||||
|
||||
(deftest "for-each renders each item"
|
||||
(assert-equal "<p>1</p><p>2</p>"
|
||||
(render-html "(for-each (fn (x) (p x)) (list 1 2))"))))
|
||||
|
||||
432
shared/sx/ref/test-types.sx
Normal file
432
shared/sx/ref/test-types.sx
Normal file
@@ -0,0 +1,432 @@
|
||||
;; ==========================================================================
|
||||
;; test-types.sx — Tests for the SX gradual type system
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded first.
|
||||
;; Modules tested: types.sx (subtype?, infer-type, check-component, etc.)
|
||||
;;
|
||||
;; Platform functions required (beyond test framework):
|
||||
;; All type system functions from types.sx must be loaded.
|
||||
;; test-prim-types — a dict of primitive return types for testing.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Subtype checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "subtype-basics"
|
||||
(deftest "any accepts everything"
|
||||
(assert-true (subtype? "number" "any"))
|
||||
(assert-true (subtype? "string" "any"))
|
||||
(assert-true (subtype? "nil" "any"))
|
||||
(assert-true (subtype? "boolean" "any"))
|
||||
(assert-true (subtype? "any" "any")))
|
||||
|
||||
(deftest "never is subtype of everything"
|
||||
(assert-true (subtype? "never" "number"))
|
||||
(assert-true (subtype? "never" "string"))
|
||||
(assert-true (subtype? "never" "any"))
|
||||
(assert-true (subtype? "never" "nil")))
|
||||
|
||||
(deftest "identical types"
|
||||
(assert-true (subtype? "number" "number"))
|
||||
(assert-true (subtype? "string" "string"))
|
||||
(assert-true (subtype? "boolean" "boolean"))
|
||||
(assert-true (subtype? "nil" "nil")))
|
||||
|
||||
(deftest "different base types are not subtypes"
|
||||
(assert-false (subtype? "number" "string"))
|
||||
(assert-false (subtype? "string" "number"))
|
||||
(assert-false (subtype? "boolean" "number"))
|
||||
(assert-false (subtype? "string" "boolean")))
|
||||
|
||||
(deftest "any is not subtype of specific type"
|
||||
(assert-false (subtype? "any" "number"))
|
||||
(assert-false (subtype? "any" "string"))))
|
||||
|
||||
|
||||
(defsuite "subtype-nullable"
|
||||
(deftest "nil is subtype of nullable types"
|
||||
(assert-true (subtype? "nil" "string?"))
|
||||
(assert-true (subtype? "nil" "number?"))
|
||||
(assert-true (subtype? "nil" "dict?"))
|
||||
(assert-true (subtype? "nil" "boolean?")))
|
||||
|
||||
(deftest "base is subtype of its nullable"
|
||||
(assert-true (subtype? "string" "string?"))
|
||||
(assert-true (subtype? "number" "number?"))
|
||||
(assert-true (subtype? "dict" "dict?")))
|
||||
|
||||
(deftest "nullable is not subtype of base"
|
||||
(assert-false (subtype? "string?" "string"))
|
||||
(assert-false (subtype? "number?" "number")))
|
||||
|
||||
(deftest "different nullable types are not subtypes"
|
||||
(assert-false (subtype? "number" "string?"))
|
||||
(assert-false (subtype? "string" "number?"))))
|
||||
|
||||
|
||||
(defsuite "subtype-unions"
|
||||
(deftest "member is subtype of union"
|
||||
(assert-true (subtype? "number" (list "or" "number" "string")))
|
||||
(assert-true (subtype? "string" (list "or" "number" "string"))))
|
||||
|
||||
(deftest "non-member is not subtype of union"
|
||||
(assert-false (subtype? "boolean" (list "or" "number" "string"))))
|
||||
|
||||
(deftest "union is subtype if all members are"
|
||||
(assert-true (subtype? (list "or" "number" "string")
|
||||
(list "or" "number" "string" "boolean")))
|
||||
(assert-true (subtype? (list "or" "number" "string") "any")))
|
||||
|
||||
(deftest "union is not subtype if any member is not"
|
||||
(assert-false (subtype? (list "or" "number" "string") "number"))))
|
||||
|
||||
|
||||
(defsuite "subtype-list-of"
|
||||
(deftest "list-of covariance"
|
||||
(assert-true (subtype? (list "list-of" "number") (list "list-of" "number")))
|
||||
(assert-true (subtype? (list "list-of" "number") (list "list-of" "any"))))
|
||||
|
||||
(deftest "list-of is subtype of list"
|
||||
(assert-true (subtype? (list "list-of" "number") "list")))
|
||||
|
||||
(deftest "list is subtype of list-of any"
|
||||
(assert-true (subtype? "list" (list "list-of" "any")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type union
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "type-union"
|
||||
(deftest "same types"
|
||||
(assert-equal "number" (type-union "number" "number"))
|
||||
(assert-equal "string" (type-union "string" "string")))
|
||||
|
||||
(deftest "any absorbs"
|
||||
(assert-equal "any" (type-union "any" "number"))
|
||||
(assert-equal "any" (type-union "number" "any")))
|
||||
|
||||
(deftest "never is identity"
|
||||
(assert-equal "number" (type-union "never" "number"))
|
||||
(assert-equal "string" (type-union "string" "never")))
|
||||
|
||||
(deftest "nil + base creates nullable"
|
||||
(assert-equal "string?" (type-union "nil" "string"))
|
||||
(assert-equal "number?" (type-union "number" "nil")))
|
||||
|
||||
(deftest "subtype collapses"
|
||||
(assert-equal "string?" (type-union "string" "string?"))
|
||||
(assert-equal "string?" (type-union "string?" "string")))
|
||||
|
||||
(deftest "incompatible creates union"
|
||||
(let ((result (type-union "number" "string")))
|
||||
(assert-true (= (type-of result) "list"))
|
||||
(assert-equal "or" (first result))
|
||||
(assert-true (contains? result "number"))
|
||||
(assert-true (contains? result "string")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type narrowing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "type-narrowing"
|
||||
(deftest "nil? narrows to nil in then branch"
|
||||
(let ((result (narrow-type "string?" "nil?")))
|
||||
(assert-equal "nil" (first result))
|
||||
(assert-equal "string" (nth result 1))))
|
||||
|
||||
(deftest "nil? narrows any stays any"
|
||||
(let ((result (narrow-type "any" "nil?")))
|
||||
(assert-equal "nil" (first result))
|
||||
(assert-equal "any" (nth result 1))))
|
||||
|
||||
(deftest "string? narrows to string in then branch"
|
||||
(let ((result (narrow-type "any" "string?")))
|
||||
(assert-equal "string" (first result))
|
||||
;; else branch — can't narrow any
|
||||
(assert-equal "any" (nth result 1))))
|
||||
|
||||
(deftest "nil? on nil type narrows to never in else"
|
||||
(let ((result (narrow-type "nil" "nil?")))
|
||||
(assert-equal "nil" (first result))
|
||||
(assert-equal "never" (nth result 1)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type inference
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "infer-literals"
|
||||
(deftest "number literal"
|
||||
(assert-equal "number" (infer-type 42 (dict) (test-prim-types))))
|
||||
|
||||
(deftest "string literal"
|
||||
(assert-equal "string" (infer-type "hello" (dict) (test-prim-types))))
|
||||
|
||||
(deftest "boolean literal"
|
||||
(assert-equal "boolean" (infer-type true (dict) (test-prim-types))))
|
||||
|
||||
(deftest "nil"
|
||||
(assert-equal "nil" (infer-type nil (dict) (test-prim-types)))))
|
||||
|
||||
|
||||
(defsuite "infer-calls"
|
||||
(deftest "known primitive return type"
|
||||
;; (+ 1 2) → number
|
||||
(let ((expr (sx-parse "(+ 1 2)")))
|
||||
(assert-equal "number"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "str returns string"
|
||||
(let ((expr (sx-parse "(str 1 2)")))
|
||||
(assert-equal "string"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "comparison returns boolean"
|
||||
(let ((expr (sx-parse "(= 1 2)")))
|
||||
(assert-equal "boolean"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "component call returns element"
|
||||
(let ((expr (sx-parse "(~card :title \"hi\")")))
|
||||
(assert-equal "element"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "unknown function returns any"
|
||||
(let ((expr (sx-parse "(unknown-fn 1 2)")))
|
||||
(assert-equal "any"
|
||||
(infer-type (first expr) (dict) (test-prim-types))))))
|
||||
|
||||
|
||||
(defsuite "infer-special-forms"
|
||||
(deftest "if produces union of branches"
|
||||
(let ((expr (sx-parse "(if true 42 \"hello\")")))
|
||||
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
|
||||
;; number | string — should be a union
|
||||
(assert-true (or (= t (list "or" "number" "string"))
|
||||
(= t "any"))))))
|
||||
|
||||
(deftest "if with no else includes nil"
|
||||
(let ((expr (sx-parse "(if true 42)")))
|
||||
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
|
||||
(assert-equal "number?" t))))
|
||||
|
||||
(deftest "when includes nil"
|
||||
(let ((expr (sx-parse "(when true 42)")))
|
||||
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
|
||||
(assert-equal "number?" t))))
|
||||
|
||||
(deftest "do returns last type"
|
||||
(let ((expr (sx-parse "(do 1 2 \"hello\")")))
|
||||
(assert-equal "string"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "let infers binding types"
|
||||
(let ((expr (sx-parse "(let ((x 42)) x)")))
|
||||
(assert-equal "number"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "lambda returns lambda"
|
||||
(let ((expr (sx-parse "(fn (x) (+ x 1))")))
|
||||
(assert-equal "lambda"
|
||||
(infer-type (first expr) (dict) (test-prim-types))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Component call checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "check-component-calls"
|
||||
(deftest "type mismatch produces error"
|
||||
;; Create a component with typed params, then check a bad call
|
||||
(let ((env (test-env)))
|
||||
;; Define a typed component
|
||||
(do
|
||||
(define dummy-env env)
|
||||
(defcomp ~typed-card (&key title price) (div title price))
|
||||
(component-set-param-types! ~typed-card
|
||||
{:title "string" :price "number"}))
|
||||
;; Check a call with wrong type
|
||||
(let ((diagnostics
|
||||
(check-component-call "~typed-card" ~typed-card
|
||||
(rest (first (sx-parse "(~typed-card :title 42 :price \"bad\")")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (dict-get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "correct call produces no errors"
|
||||
(let ((env (test-env)))
|
||||
(do
|
||||
(define dummy-env env)
|
||||
(defcomp ~ok-card (&key title price) (div title price))
|
||||
(component-set-param-types! ~ok-card
|
||||
{:title "string" :price "number"}))
|
||||
(let ((diagnostics
|
||||
(check-component-call "~ok-card" ~ok-card
|
||||
(rest (first (sx-parse "(~ok-card :title \"hi\" :price 42)")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "unknown kwarg produces warning"
|
||||
(let ((env (test-env)))
|
||||
(do
|
||||
(define dummy-env env)
|
||||
(defcomp ~warn-card (&key title) (div title))
|
||||
(component-set-param-types! ~warn-card
|
||||
{:title "string"}))
|
||||
(let ((diagnostics
|
||||
(check-component-call "~warn-card" ~warn-card
|
||||
(rest (first (sx-parse "(~warn-card :title \"hi\" :colour \"red\")")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "warning" (dict-get (first diagnostics) "level"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Annotation syntax: (name :as type) in defcomp params
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "typed-defcomp"
|
||||
(deftest "typed params are parsed and stored"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~typed-widget (&key (title :as string) (count :as number)) (div title count))
|
||||
(let ((pt (component-param-types ~typed-widget)))
|
||||
(assert-true (not (nil? pt)))
|
||||
(assert-equal "string" (dict-get pt "title"))
|
||||
(assert-equal "number" (dict-get pt "count")))))
|
||||
|
||||
(deftest "mixed typed and untyped params"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~mixed-widget (&key (title :as string) subtitle) (div title subtitle))
|
||||
(let ((pt (component-param-types ~mixed-widget)))
|
||||
(assert-true (not (nil? pt)))
|
||||
(assert-equal "string" (dict-get pt "title"))
|
||||
;; subtitle has no annotation — should not be in param-types
|
||||
(assert-false (has-key? pt "subtitle")))))
|
||||
|
||||
(deftest "untyped defcomp has nil param-types"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~plain-widget (&key title subtitle) (div title subtitle))
|
||||
(assert-true (nil? (component-param-types ~plain-widget)))))
|
||||
|
||||
(deftest "typed component catches type error on call"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~strict-card (&key (title :as string) (price :as number)) (div title price))
|
||||
;; Call with wrong types
|
||||
(let ((diagnostics
|
||||
(check-component-call "~strict-card" ~strict-card
|
||||
(rest (first (sx-parse "(~strict-card :title 42 :price \"bad\")")))
|
||||
(dict) (test-prim-types))))
|
||||
;; Should have errors for both wrong-type args
|
||||
(assert-true (>= (len diagnostics) 1))
|
||||
(assert-equal "error" (dict-get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "typed component passes correct call"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~ok-widget (&key (name :as string) (age :as number)) (div name age))
|
||||
(let ((diagnostics
|
||||
(check-component-call "~ok-widget" ~ok-widget
|
||||
(rest (first (sx-parse "(~ok-widget :name \"Alice\" :age 30)")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "nullable type accepts nil"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~nullable-widget (&key (title :as string) (subtitle :as string?)) (div title subtitle))
|
||||
;; Passing nil for nullable param should be fine
|
||||
(let ((diagnostics
|
||||
(check-component-call "~nullable-widget" ~nullable-widget
|
||||
(rest (first (sx-parse "(~nullable-widget :title \"hi\" :subtitle nil)")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-equal 0 (len diagnostics))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Primitive call checking (Phase 5)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "check-primitive-calls"
|
||||
(deftest "correct types produce no errors"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "+" (rest (first (sx-parse "(+ 1 2 3)")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "string arg to numeric primitive produces error"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "+" (rest (first (sx-parse "(+ 1 \"hello\")")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "number arg to string primitive produces error"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "upper" (rest (first (sx-parse "(upper 42)")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "positional and rest params both checked"
|
||||
;; (- "bad" 1) — first positional arg is string, expects number
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "-" (rest (first (sx-parse "(- \"bad\" 1)")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0)))))
|
||||
|
||||
(deftest "dict arg to keys is valid"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "keys" (rest (first (sx-parse "(keys {:a 1})")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "number arg to keys produces error"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "keys" (rest (first (sx-parse "(keys 42)")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0)))))
|
||||
|
||||
(deftest "variable with known type passes check"
|
||||
;; Variable n is known to be number in type-env
|
||||
(let ((ppt (test-prim-param-types))
|
||||
(tenv {"n" "number"}))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "inc" (rest (first (sx-parse "(inc n)")))
|
||||
tenv (test-prim-types) ppt nil)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "variable with wrong type fails check"
|
||||
;; Variable s is known to be string in type-env
|
||||
(let ((ppt (test-prim-param-types))
|
||||
(tenv {"s" "string"}))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "inc" (rest (first (sx-parse "(inc s)")))
|
||||
tenv (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0)))))
|
||||
|
||||
(deftest "any-typed variable skips check"
|
||||
;; Variable x has type any — should not produce errors
|
||||
(let ((ppt (test-prim-param-types))
|
||||
(tenv {"x" "any"}))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "upper" (rest (first (sx-parse "(upper x)")))
|
||||
tenv (test-prim-types) ppt nil)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "body-walk catches primitive errors in component"
|
||||
;; Manually build a component and check it via check-body-walk directly
|
||||
(let ((ppt (test-prim-param-types))
|
||||
(body (first (sx-parse "(div (+ name 1))")))
|
||||
(type-env {"name" "string"})
|
||||
(diagnostics (list)))
|
||||
(check-body-walk body "~bad-math" type-env (test-prim-types) ppt (test-env) diagnostics)
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
657
shared/sx/ref/types.sx
Normal file
657
shared/sx/ref/types.sx
Normal file
@@ -0,0 +1,657 @@
|
||||
;; ==========================================================================
|
||||
;; types.sx — Gradual type system for SX
|
||||
;;
|
||||
;; Registration-time type checking: zero runtime cost.
|
||||
;; Annotations are optional — unannotated code defaults to `any`.
|
||||
;;
|
||||
;; Depends on: eval.sx (type-of, component accessors, env ops)
|
||||
;; primitives.sx, boundary.sx (return type declarations)
|
||||
;;
|
||||
;; Platform interface (from eval.sx, already provided):
|
||||
;; (type-of x) → type string
|
||||
;; (symbol-name s) → string
|
||||
;; (keyword-name k) → string
|
||||
;; (component-body c) → AST
|
||||
;; (component-params c) → list of param name strings
|
||||
;; (component-has-children c) → boolean
|
||||
;; (env-get env k) → value or nil
|
||||
;;
|
||||
;; New platform functions for types.sx:
|
||||
;; (component-param-types c) → dict {param-name → type} or nil
|
||||
;; (component-set-param-types! c d) → store param types on component
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 1. Type representation
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Types are plain SX values:
|
||||
;; - Strings for base types: "number", "string", "boolean", "nil",
|
||||
;; "symbol", "keyword", "element", "any", "never"
|
||||
;; - Nullable shorthand: "string?", "number?", "dict?", "boolean?"
|
||||
;; → equivalent to (or string nil) etc.
|
||||
;; - Lists for compound types:
|
||||
;; (or t1 t2 ...) — union
|
||||
;; (list-of t) — homogeneous list
|
||||
;; (dict-of tk tv) — typed dict
|
||||
;; (-> t1 t2 ... treturn) — function type (last is return)
|
||||
|
||||
;; Base type names
|
||||
(define base-types
|
||||
(list "number" "string" "boolean" "nil" "symbol" "keyword"
|
||||
"element" "any" "never" "list" "dict"
|
||||
"lambda" "component" "island" "macro" "signal"))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 2. Type predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define type-any?
|
||||
(fn (t) (= t "any")))
|
||||
|
||||
(define type-never?
|
||||
(fn (t) (= t "never")))
|
||||
|
||||
(define type-nullable?
|
||||
(fn (t)
|
||||
;; A type is nullable if it's "any", "nil", a "?" shorthand, or
|
||||
;; a union containing "nil".
|
||||
(if (= t "any") true
|
||||
(if (= t "nil") true
|
||||
(if (and (= (type-of t) "string") (ends-with? t "?")) true
|
||||
(if (and (= (type-of t) "list")
|
||||
(not (empty? t))
|
||||
(= (first t) "or"))
|
||||
(contains? (rest t) "nil")
|
||||
false))))))
|
||||
|
||||
(define nullable-base
|
||||
(fn (t)
|
||||
;; Strip "?" from nullable shorthand: "string?" → "string"
|
||||
(if (and (= (type-of t) "string")
|
||||
(ends-with? t "?")
|
||||
(not (= t "?")))
|
||||
(slice t 0 (- (string-length t) 1))
|
||||
t)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3. Subtype checking
|
||||
;; --------------------------------------------------------------------------
|
||||
;; subtype?(a, b) — is type `a` assignable to type `b`?
|
||||
|
||||
(define subtype?
|
||||
(fn (a b)
|
||||
;; any accepts everything
|
||||
(if (type-any? b) true
|
||||
;; never is subtype of everything
|
||||
(if (type-never? a) true
|
||||
;; any is not a subtype of a specific type
|
||||
(if (type-any? a) false
|
||||
;; identical types
|
||||
(if (= a b) true
|
||||
;; nil is subtype of nullable types
|
||||
(if (= a "nil")
|
||||
(type-nullable? b)
|
||||
;; nullable shorthand: "string?" = (or string nil)
|
||||
(if (and (= (type-of b) "string") (ends-with? b "?"))
|
||||
(let ((base (nullable-base b)))
|
||||
(or (= a base) (= a "nil")))
|
||||
;; a is a union: (or t1 t2 ...) <: b if ALL members <: b
|
||||
;; Must check before b-union — (or A B) <: (or A B C) needs
|
||||
;; each member of a checked against the full union b.
|
||||
(if (and (= (type-of a) "list")
|
||||
(not (empty? a))
|
||||
(= (first a) "or"))
|
||||
(every? (fn (member) (subtype? member b)) (rest a))
|
||||
;; union: a <: (or t1 t2 ...) if a <: any member
|
||||
(if (and (= (type-of b) "list")
|
||||
(not (empty? b))
|
||||
(= (first b) "or"))
|
||||
(some (fn (member) (subtype? a member)) (rest b))
|
||||
;; list-of covariance
|
||||
(if (and (= (type-of a) "list") (= (type-of b) "list")
|
||||
(= (len a) 2) (= (len b) 2)
|
||||
(= (first a) "list-of") (= (first b) "list-of"))
|
||||
(subtype? (nth a 1) (nth b 1))
|
||||
;; "list" <: (list-of any)
|
||||
(if (and (= a "list")
|
||||
(= (type-of b) "list")
|
||||
(= (len b) 2)
|
||||
(= (first b) "list-of"))
|
||||
(type-any? (nth b 1))
|
||||
;; (list-of t) <: "list"
|
||||
(if (and (= (type-of a) "list")
|
||||
(= (len a) 2)
|
||||
(= (first a) "list-of")
|
||||
(= b "list"))
|
||||
true
|
||||
;; "element" is subtype of "string?" (rendered HTML)
|
||||
false)))))))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 4. Type union
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define type-union
|
||||
(fn (a b)
|
||||
;; Compute the smallest type that encompasses both a and b.
|
||||
(if (= a b) a
|
||||
(if (type-any? a) "any"
|
||||
(if (type-any? b) "any"
|
||||
(if (type-never? a) b
|
||||
(if (type-never? b) a
|
||||
(if (subtype? a b) b
|
||||
(if (subtype? b a) a
|
||||
;; neither is subtype — create a union
|
||||
(if (= a "nil")
|
||||
;; nil + string → string?
|
||||
(if (and (= (type-of b) "string")
|
||||
(not (ends-with? b "?")))
|
||||
(str b "?")
|
||||
(list "or" a b))
|
||||
(if (= b "nil")
|
||||
(if (and (= (type-of a) "string")
|
||||
(not (ends-with? a "?")))
|
||||
(str a "?")
|
||||
(list "or" a b))
|
||||
(list "or" a b))))))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 5. Type narrowing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define narrow-type
|
||||
(fn (t (predicate-name :as string))
|
||||
;; Narrow type based on a predicate test in a truthy branch.
|
||||
;; (if (nil? x) ..then.. ..else..) → in else, x excludes nil.
|
||||
;; Returns (narrowed-then narrowed-else).
|
||||
(if (= predicate-name "nil?")
|
||||
(list "nil" (narrow-exclude-nil t))
|
||||
(if (= predicate-name "string?")
|
||||
(list "string" (narrow-exclude t "string"))
|
||||
(if (= predicate-name "number?")
|
||||
(list "number" (narrow-exclude t "number"))
|
||||
(if (= predicate-name "list?")
|
||||
(list "list" (narrow-exclude t "list"))
|
||||
(if (= predicate-name "dict?")
|
||||
(list "dict" (narrow-exclude t "dict"))
|
||||
(if (= predicate-name "boolean?")
|
||||
(list "boolean" (narrow-exclude t "boolean"))
|
||||
;; Unknown predicate — no narrowing
|
||||
(list t t)))))))))
|
||||
|
||||
|
||||
(define narrow-exclude-nil
|
||||
(fn (t)
|
||||
;; Remove nil from a type.
|
||||
(if (= t "nil") "never"
|
||||
(if (= t "any") "any" ;; can't narrow any
|
||||
(if (and (= (type-of t) "string") (ends-with? t "?"))
|
||||
(nullable-base t)
|
||||
(if (and (= (type-of t) "list")
|
||||
(not (empty? t))
|
||||
(= (first t) "or"))
|
||||
(let ((members (filter (fn (m) (not (= m "nil"))) (rest t))))
|
||||
(if (= (len members) 1) (first members)
|
||||
(if (empty? members) "never"
|
||||
(cons "or" members))))
|
||||
t))))))
|
||||
|
||||
|
||||
(define narrow-exclude
|
||||
(fn (t excluded)
|
||||
;; Remove a specific type from a union.
|
||||
(if (= t excluded) "never"
|
||||
(if (= t "any") "any"
|
||||
(if (and (= (type-of t) "list")
|
||||
(not (empty? t))
|
||||
(= (first t) "or"))
|
||||
(let ((members (filter (fn (m) (not (= m excluded))) (rest t))))
|
||||
(if (= (len members) 1) (first members)
|
||||
(if (empty? members) "never"
|
||||
(cons "or" members))))
|
||||
t)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 6. Type inference
|
||||
;; --------------------------------------------------------------------------
|
||||
;; infer-type walks an AST node and returns its inferred type.
|
||||
;; type-env is a dict mapping variable names → types.
|
||||
|
||||
(define infer-type
|
||||
(fn (node (type-env :as dict) (prim-types :as dict))
|
||||
(let ((kind (type-of node)))
|
||||
(if (= kind "number") "number"
|
||||
(if (= kind "string") "string"
|
||||
(if (= kind "boolean") "boolean"
|
||||
(if (nil? node) "nil"
|
||||
(if (= kind "keyword") "keyword"
|
||||
(if (= kind "symbol")
|
||||
(let ((name (symbol-name node)))
|
||||
;; Look up in type env
|
||||
(if (dict-has? type-env name)
|
||||
(dict-get type-env name)
|
||||
;; Builtins
|
||||
(if (= name "true") "boolean"
|
||||
(if (= name "false") "boolean"
|
||||
(if (= name "nil") "nil"
|
||||
;; Check primitive return types
|
||||
(if (dict-has? prim-types name)
|
||||
(dict-get prim-types name)
|
||||
"any"))))))
|
||||
(if (= kind "dict") "dict"
|
||||
(if (= kind "list")
|
||||
(infer-list-type node type-env prim-types)
|
||||
"any")))))))))))
|
||||
|
||||
|
||||
(define infer-list-type
|
||||
(fn (node (type-env :as dict) (prim-types :as dict))
|
||||
;; Infer type of a list expression (function call, special form, etc.)
|
||||
(if (empty? node) "list"
|
||||
(let ((head (first node))
|
||||
(args (rest node)))
|
||||
(if (not (= (type-of head) "symbol"))
|
||||
"any" ;; complex head — can't infer
|
||||
(let ((name (symbol-name head)))
|
||||
;; Special forms
|
||||
(if (= name "if")
|
||||
(infer-if-type args type-env prim-types)
|
||||
(if (= name "when")
|
||||
(if (>= (len args) 2)
|
||||
(type-union (infer-type (last args) type-env prim-types) "nil")
|
||||
"nil")
|
||||
(if (or (= name "cond") (= name "case"))
|
||||
"any" ;; complex — could be refined later
|
||||
(if (= name "let")
|
||||
(infer-let-type args type-env prim-types)
|
||||
(if (or (= name "do") (= name "begin"))
|
||||
(if (empty? args) "nil"
|
||||
(infer-type (last args) type-env prim-types))
|
||||
(if (or (= name "lambda") (= name "fn"))
|
||||
"lambda"
|
||||
(if (= name "and")
|
||||
(if (empty? args) "boolean"
|
||||
(infer-type (last args) type-env prim-types))
|
||||
(if (= name "or")
|
||||
(if (empty? args) "boolean"
|
||||
;; or returns first truthy — union of all args
|
||||
(reduce type-union "never"
|
||||
(map (fn (a) (infer-type a type-env prim-types)) args)))
|
||||
(if (= name "map")
|
||||
;; map returns a list
|
||||
(if (>= (len args) 2)
|
||||
(let ((fn-type (infer-type (first args) type-env prim-types)))
|
||||
;; If the fn's return type is known, produce (list-of return-type)
|
||||
(if (and (= (type-of fn-type) "list")
|
||||
(= (first fn-type) "->"))
|
||||
(list "list-of" (last fn-type))
|
||||
"list"))
|
||||
"list")
|
||||
(if (= name "filter")
|
||||
;; filter preserves element type
|
||||
(if (>= (len args) 2)
|
||||
(infer-type (nth args 1) type-env prim-types)
|
||||
"list")
|
||||
(if (= name "reduce")
|
||||
;; reduce returns the accumulator type — too complex to infer
|
||||
"any"
|
||||
(if (= name "list")
|
||||
"list"
|
||||
(if (= name "dict")
|
||||
"dict"
|
||||
(if (= name "quote")
|
||||
"any"
|
||||
(if (= name "str")
|
||||
"string"
|
||||
(if (= name "not")
|
||||
"boolean"
|
||||
(if (starts-with? name "~")
|
||||
"element" ;; component call
|
||||
;; Regular function call: look up return type
|
||||
(if (dict-has? prim-types name)
|
||||
(dict-get prim-types name)
|
||||
"any"))))))))))))))))))))))))
|
||||
|
||||
|
||||
(define infer-if-type
|
||||
(fn ((args :as list) (type-env :as dict) (prim-types :as dict))
|
||||
;; (if test then else?) → union of then and else types
|
||||
(if (< (len args) 2) "nil"
|
||||
(let ((then-type (infer-type (nth args 1) type-env prim-types)))
|
||||
(if (>= (len args) 3)
|
||||
(type-union then-type (infer-type (nth args 2) type-env prim-types))
|
||||
(type-union then-type "nil"))))))
|
||||
|
||||
|
||||
(define infer-let-type
|
||||
(fn ((args :as list) (type-env :as dict) (prim-types :as dict))
|
||||
;; (let ((x expr) ...) body) → type of body in extended type-env
|
||||
(if (< (len args) 2) "nil"
|
||||
(let ((bindings (first args))
|
||||
(body (last args))
|
||||
(extended (merge type-env (dict))))
|
||||
;; Add binding types
|
||||
(for-each
|
||||
(fn (binding)
|
||||
(when (and (= (type-of binding) "list") (>= (len binding) 2))
|
||||
(let ((name (if (= (type-of (first binding)) "symbol")
|
||||
(symbol-name (first binding))
|
||||
(str (first binding))))
|
||||
(val-type (infer-type (nth binding 1) extended prim-types)))
|
||||
(dict-set! extended name val-type))))
|
||||
bindings)
|
||||
(infer-type body extended prim-types)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 7. Diagnostic types
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Diagnostics are dicts:
|
||||
;; {:level "error"|"warning"|"info"
|
||||
;; :message "human-readable explanation"
|
||||
;; :component "~name" (or nil for top-level)
|
||||
;; :expr <the offending AST node>}
|
||||
|
||||
(define make-diagnostic
|
||||
(fn ((level :as string) (message :as string) component expr)
|
||||
{:level level
|
||||
:message message
|
||||
:component component
|
||||
:expr expr}))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 8. Call-site checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define check-primitive-call
|
||||
(fn ((name :as string) (args :as list) (type-env :as dict) (prim-types :as dict) prim-param-types (comp-name :as string))
|
||||
;; Check a primitive call site against declared param types.
|
||||
;; prim-param-types is a dict: {prim-name → {:positional [...] :rest-type type-or-nil}}
|
||||
;; Each positional entry is a list (name type-or-nil).
|
||||
;; Returns list of diagnostics.
|
||||
(let ((diagnostics (list)))
|
||||
(when (and (not (nil? prim-param-types))
|
||||
(dict-has? prim-param-types name))
|
||||
(let ((sig (get prim-param-types name))
|
||||
(positional (get sig "positional"))
|
||||
(rest-type (get sig "rest-type")))
|
||||
;; Check each positional arg
|
||||
(for-each
|
||||
(fn (idx)
|
||||
(when (< idx (len args))
|
||||
(if (< idx (len positional))
|
||||
;; Positional param — check against declared type
|
||||
(let ((param-info (nth positional idx))
|
||||
(arg-expr (nth args idx)))
|
||||
(let ((expected-type (nth param-info 1)))
|
||||
(when (not (nil? expected-type))
|
||||
(let ((actual (infer-type arg-expr type-env prim-types)))
|
||||
(when (and (not (type-any? expected-type))
|
||||
(not (type-any? actual))
|
||||
(not (subtype? actual expected-type)))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "error"
|
||||
(str "Argument " (+ idx 1) " of `" name
|
||||
"` expects " expected-type ", got " actual)
|
||||
comp-name arg-expr)))))))
|
||||
;; Rest param — check against rest-type
|
||||
(when (not (nil? rest-type))
|
||||
(let ((arg-expr (nth args idx))
|
||||
(actual (infer-type arg-expr type-env prim-types)))
|
||||
(when (and (not (type-any? rest-type))
|
||||
(not (type-any? actual))
|
||||
(not (subtype? actual rest-type)))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "error"
|
||||
(str "Argument " (+ idx 1) " of `" name
|
||||
"` expects " rest-type ", got " actual)
|
||||
comp-name arg-expr))))))))
|
||||
(range 0 (len args) 1))))
|
||||
diagnostics)))
|
||||
|
||||
|
||||
(define check-component-call
|
||||
(fn ((comp-name :as string) (comp :as component) (call-args :as list) (type-env :as dict) (prim-types :as dict))
|
||||
;; Check a component call site against its declared param types.
|
||||
;; comp is the component value, call-args is the list of args
|
||||
;; from the call site (after the component name).
|
||||
(let ((diagnostics (list))
|
||||
(param-types (component-param-types comp))
|
||||
(params (component-params comp)))
|
||||
(when (and (not (nil? param-types))
|
||||
(not (empty? (keys param-types))))
|
||||
;; Parse keyword args from call site
|
||||
(let ((i 0)
|
||||
(provided-keys (list)))
|
||||
(for-each
|
||||
(fn (idx)
|
||||
(when (< idx (len call-args))
|
||||
(let ((arg (nth call-args idx)))
|
||||
(when (= (type-of arg) "keyword")
|
||||
(let ((key-name (keyword-name arg)))
|
||||
(append! provided-keys key-name)
|
||||
(when (< (+ idx 1) (len call-args))
|
||||
(let ((val-expr (nth call-args (+ idx 1))))
|
||||
;; Check type of value against declared param type
|
||||
(when (dict-has? param-types key-name)
|
||||
(let ((expected (dict-get param-types key-name))
|
||||
(actual (infer-type val-expr type-env prim-types)))
|
||||
(when (and (not (type-any? expected))
|
||||
(not (type-any? actual))
|
||||
(not (subtype? actual expected)))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "error"
|
||||
(str "Keyword :" key-name " of " comp-name
|
||||
" expects " expected ", got " actual)
|
||||
comp-name val-expr))))))))))))
|
||||
(range 0 (len call-args) 1))
|
||||
|
||||
;; Check for missing required params (those with declared types)
|
||||
(for-each
|
||||
(fn (param-name)
|
||||
(when (and (dict-has? param-types param-name)
|
||||
(not (contains? provided-keys param-name))
|
||||
(not (type-nullable? (dict-get param-types param-name))))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "warning"
|
||||
(str "Required param :" param-name " of " comp-name " not provided")
|
||||
comp-name nil))))
|
||||
params)
|
||||
|
||||
;; Check for unknown kwargs
|
||||
(for-each
|
||||
(fn (key)
|
||||
(when (not (contains? params key))
|
||||
(append! diagnostics
|
||||
(make-diagnostic "warning"
|
||||
(str "Unknown keyword :" key " passed to " comp-name)
|
||||
comp-name nil))))
|
||||
provided-keys)))
|
||||
diagnostics)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 9. AST walker — check a component body
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define check-body-walk
|
||||
(fn (node (comp-name :as string) (type-env :as dict) (prim-types :as dict) prim-param-types env (diagnostics :as list))
|
||||
;; Recursively walk an AST and collect diagnostics.
|
||||
;; prim-param-types: dict of {name → {:positional [...] :rest-type t}} or nil
|
||||
(let ((kind (type-of node)))
|
||||
(when (= kind "list")
|
||||
(when (not (empty? node))
|
||||
(let ((head (first node))
|
||||
(args (rest node)))
|
||||
;; Check calls when head is a symbol
|
||||
(when (= (type-of head) "symbol")
|
||||
(let ((name (symbol-name head)))
|
||||
;; Component call
|
||||
(when (starts-with? name "~")
|
||||
(let ((comp-val (env-get env name)))
|
||||
(when (= (type-of comp-val) "component")
|
||||
(for-each
|
||||
(fn (d) (append! diagnostics d))
|
||||
(check-component-call name comp-val args
|
||||
type-env prim-types)))))
|
||||
|
||||
;; Primitive call — check param types
|
||||
(when (and (not (starts-with? name "~"))
|
||||
(not (nil? prim-param-types))
|
||||
(dict-has? prim-param-types name))
|
||||
(for-each
|
||||
(fn (d) (append! diagnostics d))
|
||||
(check-primitive-call name args type-env prim-types
|
||||
prim-param-types comp-name)))
|
||||
|
||||
;; Recurse into let with extended type env
|
||||
(when (or (= name "let") (= name "let*"))
|
||||
(when (>= (len args) 2)
|
||||
(let ((bindings (first args))
|
||||
(body-exprs (rest args))
|
||||
(extended (merge type-env (dict))))
|
||||
(for-each
|
||||
(fn (binding)
|
||||
(when (and (= (type-of binding) "list")
|
||||
(>= (len binding) 2))
|
||||
(let ((bname (if (= (type-of (first binding)) "symbol")
|
||||
(symbol-name (first binding))
|
||||
(str (first binding))))
|
||||
(val-type (infer-type (nth binding 1) extended prim-types)))
|
||||
(dict-set! extended bname val-type))))
|
||||
bindings)
|
||||
(for-each
|
||||
(fn (body)
|
||||
(check-body-walk body comp-name extended prim-types prim-param-types env diagnostics))
|
||||
body-exprs))))
|
||||
|
||||
;; Recurse into define with type binding
|
||||
(when (= name "define")
|
||||
(when (>= (len args) 2)
|
||||
(let ((def-name (if (= (type-of (first args)) "symbol")
|
||||
(symbol-name (first args))
|
||||
nil))
|
||||
(def-val (nth args 1)))
|
||||
(when def-name
|
||||
(dict-set! type-env def-name
|
||||
(infer-type def-val type-env prim-types)))
|
||||
(check-body-walk def-val comp-name type-env prim-types prim-param-types env diagnostics))))))
|
||||
|
||||
;; Recurse into all child expressions
|
||||
(for-each
|
||||
(fn (child)
|
||||
(check-body-walk child comp-name type-env prim-types prim-param-types env diagnostics))
|
||||
args)))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 10. Check a single component
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define check-component
|
||||
(fn ((comp-name :as string) env (prim-types :as dict) prim-param-types)
|
||||
;; Type-check a component's body. Returns list of diagnostics.
|
||||
;; prim-param-types: dict of param type info, or nil to skip primitive checking.
|
||||
(let ((comp (env-get env comp-name))
|
||||
(diagnostics (list)))
|
||||
(when (= (type-of comp) "component")
|
||||
(let ((body (component-body comp))
|
||||
(params (component-params comp))
|
||||
(param-types (component-param-types comp))
|
||||
;; Build initial type env from component params
|
||||
(type-env (dict)))
|
||||
;; Add param types (annotated or default to any)
|
||||
(for-each
|
||||
(fn (p)
|
||||
(dict-set! type-env p
|
||||
(if (and (not (nil? param-types))
|
||||
(dict-has? param-types p))
|
||||
(dict-get param-types p)
|
||||
"any")))
|
||||
params)
|
||||
;; Add children as (list-of element) if component has children
|
||||
(when (component-has-children comp)
|
||||
(dict-set! type-env "children" (list "list-of" "element")))
|
||||
|
||||
(check-body-walk body comp-name type-env prim-types prim-param-types env diagnostics)))
|
||||
diagnostics)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 11. Check all components in an environment
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define check-all
|
||||
(fn (env (prim-types :as dict) prim-param-types)
|
||||
;; Type-check every component in the environment.
|
||||
;; prim-param-types: dict of param type info, or nil to skip primitive checking.
|
||||
;; Returns list of all diagnostics.
|
||||
(let ((all-diagnostics (list)))
|
||||
(for-each
|
||||
(fn (name)
|
||||
(let ((val (env-get env name)))
|
||||
(when (= (type-of val) "component")
|
||||
(for-each
|
||||
(fn (d) (append! all-diagnostics d))
|
||||
(check-component name env prim-types prim-param-types)))))
|
||||
(keys env))
|
||||
all-diagnostics)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 12. Build primitive type registry
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Builds a dict mapping primitive-name → return-type from
|
||||
;; the declarations parsed by boundary_parser.py.
|
||||
;; This is called by the host at startup with the parsed declarations.
|
||||
|
||||
(define build-type-registry
|
||||
(fn ((prim-declarations :as list) (io-declarations :as list))
|
||||
;; Both are lists of dicts: {:name "+" :returns "number" :params (...)}
|
||||
;; Returns a flat dict: {"+" "number", "str" "string", ...}
|
||||
(let ((registry (dict)))
|
||||
(for-each
|
||||
(fn (decl)
|
||||
(let ((name (dict-get decl "name"))
|
||||
(returns (dict-get decl "returns")))
|
||||
(when (and (not (nil? name)) (not (nil? returns)))
|
||||
(dict-set! registry name returns))))
|
||||
prim-declarations)
|
||||
(for-each
|
||||
(fn (decl)
|
||||
(let ((name (dict-get decl "name"))
|
||||
(returns (dict-get decl "returns")))
|
||||
(when (and (not (nil? name)) (not (nil? returns)))
|
||||
(dict-set! registry name returns))))
|
||||
io-declarations)
|
||||
registry)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Platform interface summary
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; From eval.sx (already provided):
|
||||
;; (type-of x), (symbol-name s), (keyword-name k), (env-get env k)
|
||||
;; (component-body c), (component-params c), (component-has-children c)
|
||||
;;
|
||||
;; New for types.sx (each host implements):
|
||||
;; (component-param-types c) → dict {param-name → type} or nil
|
||||
;; (component-set-param-types! c d) → store param types on component
|
||||
;; (merge d1 d2) → new dict merging d1 and d2
|
||||
;;
|
||||
;; Primitive param types:
|
||||
;; The host provides prim-param-types as a dict mapping primitive names
|
||||
;; to param type descriptors. Each descriptor is a dict:
|
||||
;; {"positional" [["name" "type-or-nil"] ...] "rest-type" "type-or-nil"}
|
||||
;; Built by boundary_parser.parse_primitive_param_types() in Python.
|
||||
;; Passed to check-component/check-all as an optional extra argument.
|
||||
;;
|
||||
;; --------------------------------------------------------------------------
|
||||
@@ -25,7 +25,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define z3-sort
|
||||
(fn (sx-type)
|
||||
(fn ((sx-type :as string))
|
||||
(case sx-type
|
||||
"number" "Int"
|
||||
"boolean" "Bool"
|
||||
@@ -40,7 +40,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define z3-name
|
||||
(fn (name)
|
||||
(fn ((name :as string))
|
||||
(cond
|
||||
(= name "!=") "neq"
|
||||
(= name "+") "+"
|
||||
@@ -74,7 +74,7 @@
|
||||
|
||||
;; Operators that get renamed
|
||||
(define z3-rename-op
|
||||
(fn (op)
|
||||
(fn ((op :as string))
|
||||
(case op
|
||||
"if" "ite"
|
||||
"str" "str.++"
|
||||
@@ -176,7 +176,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define z3-extract-kwargs
|
||||
(fn (expr)
|
||||
(fn ((expr :as list))
|
||||
;; Returns a dict of keyword args from a define-* form
|
||||
;; (define-primitive "name" :params (...) :returns "type" ...) → {:params ... :returns ...}
|
||||
(let ((result {})
|
||||
@@ -184,7 +184,7 @@
|
||||
(z3-extract-kwargs-loop items result))))
|
||||
|
||||
(define z3-extract-kwargs-loop
|
||||
(fn (items result)
|
||||
(fn ((items :as list) (result :as dict))
|
||||
(if (or (empty? items) (< (len items) 2))
|
||||
result
|
||||
(if (= (type-of (first items)) "keyword")
|
||||
@@ -199,12 +199,12 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define z3-params-to-sorts
|
||||
(fn (params)
|
||||
(fn ((params :as list))
|
||||
;; Convert SX param list to list of (name sort) pairs, skipping &rest/&key
|
||||
(z3-params-loop params false (list))))
|
||||
|
||||
(define z3-params-loop
|
||||
(fn (params skip-next acc)
|
||||
(fn ((params :as list) (skip-next :as boolean) (acc :as list))
|
||||
(if (empty? params)
|
||||
acc
|
||||
(let ((p (first params))
|
||||
@@ -227,7 +227,7 @@
|
||||
(z3-params-loop rest-p false acc))))))
|
||||
|
||||
(define z3-has-rest?
|
||||
(fn (params)
|
||||
(fn ((params :as list))
|
||||
(some (fn (p) (and (= (type-of p) "symbol") (= (symbol-name p) "&rest")))
|
||||
params)))
|
||||
|
||||
@@ -237,7 +237,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define z3-translate-primitive
|
||||
(fn (expr)
|
||||
(fn ((expr :as list))
|
||||
(let ((name (nth expr 1))
|
||||
(kwargs (z3-extract-kwargs expr))
|
||||
(params (or (get kwargs "params") (list)))
|
||||
@@ -282,7 +282,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define z3-translate-io
|
||||
(fn (expr)
|
||||
(fn ((expr :as list))
|
||||
(let ((name (nth expr 1))
|
||||
(kwargs (z3-extract-kwargs expr))
|
||||
(doc (or (get kwargs "doc") ""))
|
||||
@@ -297,7 +297,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define z3-translate-special-form
|
||||
(fn (expr)
|
||||
(fn ((expr :as list))
|
||||
(let ((name (nth expr 1))
|
||||
(kwargs (z3-extract-kwargs expr))
|
||||
(doc (or (get kwargs "doc") "")))
|
||||
@@ -342,7 +342,7 @@
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define z3-translate-file
|
||||
(fn (exprs)
|
||||
(fn ((exprs :as list))
|
||||
;; Filter to translatable forms and translate each
|
||||
(let ((translatable
|
||||
(filter
|
||||
|
||||
@@ -31,7 +31,7 @@ import asyncio
|
||||
from typing import Any
|
||||
|
||||
from .types import Component, Keyword, Lambda, NIL, Symbol
|
||||
from .evaluator import _eval as _raw_eval, _trampoline
|
||||
from .ref.sx_ref import eval_expr as _raw_eval, trampoline as _trampoline
|
||||
|
||||
def _eval(expr, env):
|
||||
"""Evaluate and unwrap thunks — all resolver.py _eval calls are non-tail."""
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Auth section nav items (newsletters link + account_nav slot)
|
||||
(defcomp ~auth-nav-items (&key account-url select-colours account-nav)
|
||||
(defcomp ~auth-nav-items (&key (account-url :as string?) (select-colours :as string?) account-nav)
|
||||
(<>
|
||||
(~nav-link :href (str (or account-url "") "/newsletters/")
|
||||
:label "newsletters"
|
||||
@@ -14,7 +14,7 @@
|
||||
(when account-nav account-nav)))
|
||||
|
||||
;; Auth header row — wraps ~menu-row-sx for account section
|
||||
(defcomp ~auth-header-row (&key account-url select-colours account-nav oob)
|
||||
(defcomp ~auth-header-row (&key (account-url :as string?) (select-colours :as string?) account-nav (oob :as boolean?))
|
||||
(~menu-row-sx :id "auth-row" :level 1 :colour "sky"
|
||||
:link-href (str (or account-url "") "/")
|
||||
:link-label "account" :icon "fa-solid fa-user"
|
||||
@@ -24,7 +24,7 @@
|
||||
:child-id "auth-header-child" :oob oob))
|
||||
|
||||
;; Auth header row without nav (for cart service)
|
||||
(defcomp ~auth-header-row-simple (&key account-url oob)
|
||||
(defcomp ~auth-header-row-simple (&key (account-url :as string?) (oob :as boolean?))
|
||||
(~menu-row-sx :id "auth-row" :level 1 :colour "sky"
|
||||
:link-href (str (or account-url "") "/")
|
||||
:link-label "account" :icon "fa-solid fa-user"
|
||||
@@ -52,7 +52,7 @@
|
||||
:account-nav (account-nav-ctx))))
|
||||
|
||||
;; Orders header row
|
||||
(defcomp ~orders-header-row (&key list-url)
|
||||
(defcomp ~orders-header-row (&key (list-url :as string))
|
||||
(~menu-row-sx :id "orders-row" :level 2 :colour "sky"
|
||||
:link-href list-url :link-label "Orders" :icon "fa fa-gbp"
|
||||
:child-id "orders-header-child"))
|
||||
@@ -61,12 +61,12 @@
|
||||
;; Auth forms — login flow, check email
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~auth-error-banner (&key error)
|
||||
(defcomp ~auth-error-banner (&key (error :as string?))
|
||||
(when error
|
||||
(div :class "bg-red-50 border border-red-200 text-red-700 p-3 rounded mb-4"
|
||||
error)))
|
||||
|
||||
(defcomp ~auth-login-form (&key error action csrf-token email)
|
||||
(defcomp ~auth-login-form (&key error (action :as string) (csrf-token :as string) (email :as string?))
|
||||
(div :class "py-8 max-w-md mx-auto"
|
||||
(h1 :class "text-2xl font-bold mb-6" "Sign in")
|
||||
error
|
||||
@@ -80,12 +80,12 @@
|
||||
:class "w-full bg-stone-800 text-white py-2 px-4 rounded hover:bg-stone-700 transition"
|
||||
"Send magic link"))))
|
||||
|
||||
(defcomp ~auth-check-email-error (&key error)
|
||||
(defcomp ~auth-check-email-error (&key (error :as string?))
|
||||
(when error
|
||||
(div :class "bg-yellow-50 border border-yellow-200 text-yellow-700 p-3 rounded mt-4"
|
||||
error)))
|
||||
|
||||
(defcomp ~auth-check-email (&key email error)
|
||||
(defcomp ~auth-check-email (&key (email :as string) error)
|
||||
(div :class "py-8 max-w-md mx-auto text-center"
|
||||
(h1 :class "text-2xl font-bold mb-4" "Check your email")
|
||||
(p :class "text-stone-600 mb-2" "We sent a sign-in link to " (strong email) ".")
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
(defcomp ~post-card (&key title slug href feature-image excerpt
|
||||
status published-at updated-at publish-requested
|
||||
hx-select like widgets at-bar)
|
||||
(defcomp ~post-card (&key (title :as string) (slug :as string) (href :as string) (feature-image :as string?)
|
||||
(excerpt :as string?) (status :as string?) (published-at :as string?) (updated-at :as string?)
|
||||
(publish-requested :as boolean?) (hx-select :as string?) like widgets at-bar)
|
||||
(article :class "border-b pb-6 last:border-b-0 relative"
|
||||
(when like like)
|
||||
(a :href href
|
||||
@@ -31,7 +31,8 @@
|
||||
(when widgets widgets)
|
||||
(when at-bar at-bar)))
|
||||
|
||||
(defcomp ~order-summary-card (&key order-id created-at description status currency total-amount)
|
||||
(defcomp ~order-summary-card (&key (order-id :as string) (created-at :as string?) (description :as string?)
|
||||
(status :as string?) (currency :as string?) (total-amount :as string?))
|
||||
(div :class "rounded-2xl border border-stone-200 bg-white/80 p-4 sm:p-6 space-y-2 text-xs sm:text-sm text-stone-800"
|
||||
(p (span :class "font-medium" "Order ID:") " " (span :class "font-mono" (str "#" order-id)))
|
||||
(p (span :class "font-medium" "Created:") " " (or created-at "\u2014"))
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
(defcomp ~search-mobile (&key current-local-href search search-count hx-select search-headers-mobile)
|
||||
(defcomp ~search-mobile (&key (current-local-href :as string) (search :as string?) (search-count :as number?)
|
||||
(hx-select :as string?) (search-headers-mobile :as string?))
|
||||
(div :id "search-mobile-wrapper"
|
||||
:class "flex flex-row gap-2 items-center flex-1 min-w-0 pr-2"
|
||||
(input :id "search-mobile"
|
||||
@@ -20,7 +21,8 @@
|
||||
:class (if (not search-count) "text-xl text-red-500" "")
|
||||
(when search (str search-count)))))
|
||||
|
||||
(defcomp ~search-desktop (&key current-local-href search search-count hx-select search-headers-desktop)
|
||||
(defcomp ~search-desktop (&key (current-local-href :as string) (search :as string?) (search-count :as number?)
|
||||
(hx-select :as string?) (search-headers-desktop :as string?))
|
||||
(div :id "search-desktop-wrapper"
|
||||
:class "flex flex-row gap-2 items-center"
|
||||
(input :id "search-desktop"
|
||||
@@ -62,7 +64,8 @@
|
||||
(div :id "filter-details-mobile" :style "display:contents"
|
||||
(when filter-details filter-details))))
|
||||
|
||||
(defcomp ~infinite-scroll (&key url page total-pages id-prefix colspan)
|
||||
(defcomp ~infinite-scroll (&key (url :as string) (page :as number) (total-pages :as number)
|
||||
(id-prefix :as string) (colspan :as number))
|
||||
(if (< page total-pages)
|
||||
(tr :id (str id-prefix "-sentinel-" page)
|
||||
:sx-get url
|
||||
@@ -82,7 +85,7 @@
|
||||
(tr (td :colspan colspan :class "px-3 py-4 text-center text-xs text-stone-400"
|
||||
"End of results"))))
|
||||
|
||||
(defcomp ~status-pill (&key status size)
|
||||
(defcomp ~status-pill (&key (status :as string?) (size :as string?))
|
||||
(let* ((s (or status "pending"))
|
||||
(lower (lower s))
|
||||
(sz (or size "xs"))
|
||||
|
||||
@@ -1,4 +1,5 @@
|
||||
(defcomp ~link-card (&key link title image icon subtitle detail data-app)
|
||||
(defcomp ~link-card (&key (link :as string) (title :as string) (image :as string?) (icon :as string?)
|
||||
(subtitle :as string?) (detail :as string?) (data-app :as string?))
|
||||
(a :href link
|
||||
:class "block rounded border border-stone-200 bg-white hover:bg-stone-50 transition-colors no-underline"
|
||||
:data-fragment "link-card"
|
||||
@@ -16,7 +17,7 @@
|
||||
(when detail
|
||||
(div :class "text-xs text-stone-400 mt-1" detail))))))
|
||||
|
||||
(defcomp ~cart-mini (&key cart-count blog-url cart-url oob)
|
||||
(defcomp ~cart-mini (&key (cart-count :as number) (blog-url :as string) (cart-url :as string) (oob :as string?))
|
||||
(div :id "cart-mini"
|
||||
:sx-swap-oob oob
|
||||
(if (= cart-count 0)
|
||||
@@ -33,7 +34,7 @@
|
||||
(span :class "absolute top-1/2 left-1/2 -translate-x-1/2 -translate-y-1/2 inline-flex items-center justify-center rounded-full bg-emerald-600 text-white text-sm w-5 h-5"
|
||||
cart-count)))))
|
||||
|
||||
(defcomp ~auth-menu (&key user-email account-url)
|
||||
(defcomp ~auth-menu (&key (user-email :as string?) (account-url :as string))
|
||||
(<>
|
||||
(span :id "auth-menu-desktop" :class "hidden md:inline-flex"
|
||||
(if user-email
|
||||
@@ -65,7 +66,7 @@
|
||||
(i :class "fa-solid fa-key")
|
||||
(span "sign in or register"))))))
|
||||
|
||||
(defcomp ~account-nav-item (&key href label)
|
||||
(defcomp ~account-nav-item (&key (href :as string) (label :as string))
|
||||
(div :class "relative nav-group"
|
||||
(a :href href
|
||||
:class "justify-center cursor-pointer flex flex-row items-center gap-2 rounded bg-stone-200 text-black p-3"
|
||||
|
||||
@@ -48,19 +48,19 @@
|
||||
:class "w-12 h-12 rotate-180 transition-transform group-open/root:block hidden self-start"
|
||||
(path :d "M6 9l6 6 6-6" :fill "currentColor"))))
|
||||
|
||||
(defcomp ~post-label (&key feature-image title)
|
||||
(defcomp ~post-label (&key (feature-image :as string?) (title :as string))
|
||||
(<> (when feature-image
|
||||
(img :src feature-image :class "h-8 w-8 rounded-full object-cover border border-stone-300 flex-shrink-0"))
|
||||
(span title)))
|
||||
|
||||
(defcomp ~page-cart-badge (&key href count)
|
||||
(defcomp ~page-cart-badge (&key (href :as string) (count :as string))
|
||||
(a :href href :class "relative inline-flex items-center gap-1.5 px-3 py-1.5 text-sm rounded-full border border-emerald-300 bg-emerald-50 text-emerald-800 hover:bg-emerald-100 transition"
|
||||
(i :class "fa fa-shopping-cart" :aria-hidden "true")
|
||||
(span count)))
|
||||
|
||||
(defcomp ~header-row-sx (&key cart-mini blog-url site-title app-label
|
||||
nav-tree auth-menu nav-panel
|
||||
settings-url is-admin oob)
|
||||
(defcomp ~header-row-sx (&key cart-mini (blog-url :as string?) (site-title :as string?)
|
||||
(app-label :as string?) nav-tree auth-menu nav-panel
|
||||
(settings-url :as string?) (is-admin :as boolean?) (oob :as boolean?))
|
||||
(<>
|
||||
(div :id "root-row"
|
||||
:sx-swap-oob (if oob "outerHTML" nil)
|
||||
@@ -85,8 +85,10 @@
|
||||
|
||||
; @css bg-sky-400 bg-sky-300 bg-sky-200 bg-sky-100 bg-violet-400 bg-violet-300 bg-violet-200 bg-violet-100
|
||||
; @css aria-selected:bg-violet-200 aria-selected:text-violet-900 aria-selected:bg-stone-500 aria-selected:text-white
|
||||
(defcomp ~menu-row-sx (&key id level colour link-href link-label link-label-content icon
|
||||
selected hx-select nav child-id child oob external)
|
||||
(defcomp ~menu-row-sx (&key (id :as string) (level :as number?) (colour :as string?)
|
||||
(link-href :as string) (link-label :as string?) link-label-content
|
||||
(icon :as string?) (selected :as string?) (hx-select :as string?)
|
||||
nav (child-id :as string?) child (oob :as boolean?) (external :as boolean?))
|
||||
(let* ((c (or colour "sky"))
|
||||
(lv (or level 1))
|
||||
(shade (str (- 500 (* lv 100)))))
|
||||
@@ -115,11 +117,11 @@
|
||||
(div :id child-id :class "flex flex-col w-full items-center"
|
||||
(when child child))))))
|
||||
|
||||
(defcomp ~oob-header-sx (&key parent-id row)
|
||||
(defcomp ~oob-header-sx (&key (parent-id :as string) row)
|
||||
(div :id parent-id :sx-swap-oob "outerHTML" :class "flex flex-col w-full items-center"
|
||||
row))
|
||||
|
||||
(defcomp ~header-child-sx (&key id inner)
|
||||
(defcomp ~header-child-sx (&key (id :as string?) inner)
|
||||
(div :id (or id "root-header-child") :class "flex flex-col w-full items-center" inner))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
@@ -127,7 +129,8 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Labelled section: colour bar header + vertical nav items
|
||||
(defcomp ~mobile-menu-section (&key label href colour level items)
|
||||
(defcomp ~mobile-menu-section (&key (label :as string) (href :as string?) (colour :as string?)
|
||||
(level :as number?) items)
|
||||
(let* ((c (or colour "sky"))
|
||||
(lv (or level 1))
|
||||
(shade (str (- 500 (* lv 100)))))
|
||||
@@ -153,8 +156,9 @@
|
||||
;; nested component calls in _aser are serialized without expansion.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~root-header (&key cart-mini blog-url site-title app-label
|
||||
nav-tree auth-menu nav-panel settings-url is-admin oob)
|
||||
(defcomp ~root-header (&key cart-mini (blog-url :as string?) (site-title :as string?)
|
||||
(app-label :as string?) nav-tree auth-menu nav-panel
|
||||
(settings-url :as string?) (is-admin :as boolean?) (oob :as boolean?))
|
||||
(~header-row-sx :cart-mini cart-mini :blog-url blog-url :site-title site-title
|
||||
:app-label app-label :nav-tree nav-tree :auth-menu auth-menu
|
||||
:nav-panel nav-panel :settings-url settings-url :is-admin is-admin
|
||||
@@ -226,18 +230,18 @@
|
||||
(~root-mobile-auto))))
|
||||
|
||||
;; Post-admin layout — root + post header with nested admin row
|
||||
(defcomp ~layout-post-admin-full (&key selected)
|
||||
(defcomp ~layout-post-admin-full (&key (selected :as string?))
|
||||
(let ((__admin-hdr (~post-admin-header-auto nil selected)))
|
||||
(<> (~root-header-auto)
|
||||
(~header-child-sx
|
||||
:inner (~post-header-auto nil)))))
|
||||
|
||||
(defcomp ~layout-post-admin-oob (&key selected)
|
||||
(defcomp ~layout-post-admin-oob (&key (selected :as string?))
|
||||
(<> (~post-header-auto true)
|
||||
(~oob-header-sx :parent-id "post-header-child"
|
||||
:row (~post-admin-header-auto nil selected))))
|
||||
|
||||
(defcomp ~layout-post-admin-mobile (&key selected)
|
||||
(defcomp ~layout-post-admin-mobile (&key (selected :as string?))
|
||||
(let ((__phctx (post-header-ctx)))
|
||||
(<>
|
||||
(when (get __phctx "slug")
|
||||
@@ -254,7 +258,7 @@
|
||||
:items (~post-nav-auto)))
|
||||
(~root-mobile-auto))))
|
||||
|
||||
(defcomp ~error-content (&key errnum message image)
|
||||
(defcomp ~error-content (&key (errnum :as string) (message :as string) (image :as string?))
|
||||
(div :class "text-center p-8 max-w-lg mx-auto"
|
||||
(div :class "font-bold text-2xl md:text-4xl text-red-500 mb-4" errnum)
|
||||
(div :class "text-stone-600 mb-4" message)
|
||||
@@ -262,7 +266,7 @@
|
||||
(div :class "flex justify-center"
|
||||
(img :src image :width "300" :height "300")))))
|
||||
|
||||
(defcomp ~clear-oob-div (&key id)
|
||||
(defcomp ~clear-oob-div (&key (id :as string))
|
||||
(div :id id :sx-swap-oob "outerHTML"))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
@@ -354,21 +358,22 @@
|
||||
content))
|
||||
|
||||
; @css justify-center cursor-pointer flex flex-row items-center gap-2 rounded bg-stone-200 text-black p-3 !bg-stone-500 !text-white
|
||||
(defcomp ~admin-cog-button (&key href is-admin-page)
|
||||
(defcomp ~admin-cog-button (&key (href :as string) (is-admin-page :as boolean?))
|
||||
(div :class "relative nav-group"
|
||||
(a :href href
|
||||
:class (str "justify-center cursor-pointer flex flex-row items-center gap-2 rounded bg-stone-200 text-black p-3 "
|
||||
(if is-admin-page "!bg-stone-500 !text-white" ""))
|
||||
(i :class "fa fa-cog" :aria-hidden "true"))))
|
||||
|
||||
(defcomp ~post-admin-label (&key selected)
|
||||
(defcomp ~post-admin-label (&key (selected :as string?))
|
||||
(<>
|
||||
(i :class "fa fa-shield-halved" :aria-hidden "true")
|
||||
" admin"
|
||||
(when selected
|
||||
(span :class "text-white" selected))))
|
||||
|
||||
(defcomp ~nav-link (&key href hx-select label icon aclass select-colours is-selected)
|
||||
(defcomp ~nav-link (&key (href :as string) (hx-select :as string?) (label :as string?) (icon :as string?)
|
||||
(aclass :as string?) (select-colours :as string?) (is-selected :as string?))
|
||||
(div :class "relative nav-group"
|
||||
(a :href href
|
||||
:sx-get href
|
||||
|
||||
@@ -2,32 +2,33 @@
|
||||
|
||||
;; The single place where raw! lives — for CMS content (Ghost post body,
|
||||
;; product descriptions, etc.) that arrives as pre-rendered HTML.
|
||||
(defcomp ~rich-text (&key html)
|
||||
(defcomp ~rich-text (&key (html :as string))
|
||||
(raw! html))
|
||||
|
||||
(defcomp ~error-inline (&key message)
|
||||
(defcomp ~error-inline (&key (message :as string))
|
||||
(div :class "text-red-600 text-sm" message))
|
||||
|
||||
(defcomp ~notification-badge (&key count)
|
||||
(defcomp ~notification-badge (&key (count :as number))
|
||||
(span :class "bg-red-500 text-white text-xs rounded-full px-1.5 py-0.5" count))
|
||||
|
||||
(defcomp ~cache-cleared (&key time-str)
|
||||
(defcomp ~cache-cleared (&key (time-str :as string))
|
||||
(span :class "text-green-600 font-bold" "Cache cleared at " time-str))
|
||||
|
||||
(defcomp ~error-list (&key items)
|
||||
(defcomp ~error-list (&key (items :as list?))
|
||||
(ul :class "list-disc pl-5 space-y-1 text-sm text-red-600"
|
||||
(when items items)))
|
||||
|
||||
(defcomp ~error-list-item (&key message)
|
||||
(defcomp ~error-list-item (&key (message :as string))
|
||||
(li message))
|
||||
|
||||
(defcomp ~fragment-error (&key service)
|
||||
(defcomp ~fragment-error (&key (service :as string))
|
||||
(p :class "text-sm text-red-600" "Service " (b service) " is unavailable."))
|
||||
|
||||
(defcomp ~htmx-sentinel (&key id hx-get hx-trigger hx-swap class extra-attrs)
|
||||
(defcomp ~htmx-sentinel (&key (id :as string) (hx-get :as string) (hx-trigger :as string)
|
||||
(hx-swap :as string) (class :as string?) extra-attrs)
|
||||
(div :id id :sx-get hx-get :sx-trigger hx-trigger :sx-swap hx-swap :class class))
|
||||
|
||||
(defcomp ~nav-group-link (&key href hx-select nav-class label)
|
||||
(defcomp ~nav-group-link (&key (href :as string) (hx-select :as string?) (nav-class :as string?) (label :as string))
|
||||
(div :class "relative nav-group"
|
||||
(a :href href :sx-get href :sx-target "#main-panel"
|
||||
:sx-select hx-select :sx-swap "outerHTML"
|
||||
@@ -38,7 +39,7 @@
|
||||
;; Shared sentinel components — infinite scroll triggers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~sentinel-mobile (&key id next-url hyperscript)
|
||||
(defcomp ~sentinel-mobile (&key (id :as string) (next-url :as string) (hyperscript :as string?))
|
||||
(div :id id :class "block md:hidden h-[60vh] opacity-0 pointer-events-none js-mobile-sentinel"
|
||||
:sx-get next-url :sx-trigger "intersect once delay:250ms, sentinelmobile:retry"
|
||||
:sx-swap "outerHTML" :_ hyperscript
|
||||
@@ -49,7 +50,7 @@
|
||||
(i :class "fa fa-exclamation-triangle text-2xl")
|
||||
(p :class "mt-2" "Loading failed \u2014 retrying\u2026"))))
|
||||
|
||||
(defcomp ~sentinel-desktop (&key id next-url hyperscript)
|
||||
(defcomp ~sentinel-desktop (&key (id :as string) (next-url :as string) (hyperscript :as string?))
|
||||
(div :id id :class "hidden md:block h-4 opacity-0 pointer-events-none"
|
||||
:sx-get next-url :sx-trigger "intersect once delay:250ms, sentinel:retry"
|
||||
:sx-swap "outerHTML" :_ hyperscript
|
||||
@@ -58,20 +59,20 @@
|
||||
(div :class "animate-spin h-6 w-6 border-2 border-stone-300 border-t-stone-600 rounded-full"))
|
||||
(div :class "js-neterr hidden text-center py-2 text-stone-400 text-sm" "Retry\u2026")))
|
||||
|
||||
(defcomp ~sentinel-simple (&key id next-url)
|
||||
(defcomp ~sentinel-simple (&key (id :as string) (next-url :as string))
|
||||
(div :id id :class "h-4 opacity-0 pointer-events-none"
|
||||
:sx-get next-url :sx-trigger "intersect once delay:250ms" :sx-swap "outerHTML"
|
||||
:role "status" :aria-hidden "true"
|
||||
(div :class "text-center text-xs text-stone-400" "loading...")))
|
||||
|
||||
(defcomp ~end-of-results (&key cls)
|
||||
(defcomp ~end-of-results (&key (cls :as string?))
|
||||
(div :class (or cls "col-span-full mt-4 text-center text-xs text-stone-400") "End of results"))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Shared empty state — icon + message + optional action
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~empty-state (&key icon message cls &rest children)
|
||||
(defcomp ~empty-state (&key (icon :as string?) (message :as string) (cls :as string?) &rest children)
|
||||
(div :class (or cls "p-8 text-center text-stone-400")
|
||||
(when icon (div (i :class (str icon " text-4xl mb-2") :aria-hidden "true")))
|
||||
(p message)
|
||||
@@ -81,7 +82,7 @@
|
||||
;; Shared badge — inline pill with configurable colours
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~badge (&key label cls)
|
||||
(defcomp ~badge (&key (label :as string) (cls :as string?))
|
||||
(span :class (str "inline-flex items-center rounded-full px-2 py-0.5 text-xs font-medium " (or cls "bg-stone-100 text-stone-700"))
|
||||
label))
|
||||
|
||||
@@ -89,8 +90,9 @@
|
||||
;; Shared delete button with confirm dialog
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~delete-btn (&key url trigger-target title text confirm-text cancel-text
|
||||
sx-headers cls)
|
||||
(defcomp ~delete-btn (&key (url :as string) (trigger-target :as string) (title :as string?)
|
||||
(text :as string?) (confirm-text :as string?) (cancel-text :as string?)
|
||||
(sx-headers :as string?) (cls :as string?))
|
||||
(button :type "button"
|
||||
:data-confirm "" :data-confirm-title (or title "Delete?")
|
||||
:data-confirm-text (or text "Are you sure?")
|
||||
@@ -108,7 +110,7 @@
|
||||
;; Shared price display — special + regular with strikethrough
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~price (&key special-price regular-price)
|
||||
(defcomp ~price (&key (special-price :as string?) (regular-price :as string?))
|
||||
(div :class "mt-1 flex items-baseline gap-2 justify-center"
|
||||
(when special-price (div :class "text-lg font-semibold text-emerald-700" special-price))
|
||||
(when (and special-price regular-price) (div :class "text-sm line-through text-stone-500" regular-price))
|
||||
@@ -118,7 +120,8 @@
|
||||
;; Shared image-or-placeholder
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~img-or-placeholder (&key src alt size-cls placeholder-icon placeholder-text)
|
||||
(defcomp ~img-or-placeholder (&key (src :as string?) (alt :as string?) (size-cls :as string?)
|
||||
(placeholder-icon :as string?) (placeholder-text :as string?))
|
||||
(if src
|
||||
(img :src src :alt (or alt "") :class (or size-cls "w-12 h-12 rounded-full object-cover flex-shrink-0"))
|
||||
(div :class (str (or size-cls "w-12 h-12 rounded-full") " bg-stone-200 flex items-center justify-center flex-shrink-0")
|
||||
@@ -141,8 +144,9 @@
|
||||
(path :stroke-linecap "round" :stroke-linejoin "round"
|
||||
:d "M4 5a1 1 0 011-1h4a1 1 0 011 1v4a1 1 0 01-1 1H5a1 1 0 01-1-1V5zM14 5a1 1 0 011-1h4a1 1 0 011 1v4a1 1 0 01-1 1h-4a1 1 0 01-1-1V5zM4 15a1 1 0 011-1h4a1 1 0 011 1v4a1 1 0 01-1 1H5a1 1 0 01-1-1v-4zM14 15a1 1 0 011-1h4a1 1 0 011 1v4a1 1 0 01-1 1h-4a1 1 0 01-1-1v-4z")))
|
||||
|
||||
(defcomp ~view-toggle (&key list-href tile-href hx-select list-cls tile-cls
|
||||
storage-key list-svg tile-svg)
|
||||
(defcomp ~view-toggle (&key (list-href :as string) (tile-href :as string) (hx-select :as string?)
|
||||
(list-cls :as string?) (tile-cls :as string?) (storage-key :as string?)
|
||||
list-svg tile-svg)
|
||||
(div :class "hidden md:flex justify-end px-3 pt-3 gap-1"
|
||||
(a :href list-href :sx-get list-href :sx-target "#main-panel" :sx-select hx-select
|
||||
:sx-swap "outerHTML" :sx-push-url "true" :class (str "p-1.5 rounded " list-cls) :title "List view"
|
||||
@@ -157,7 +161,9 @@
|
||||
;; Shared CRUD admin panel — for calendars, markets, etc.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~crud-create-form (&key create-url csrf errors-id list-id placeholder label btn-label)
|
||||
(defcomp ~crud-create-form (&key (create-url :as string) (csrf :as string) (errors-id :as string?)
|
||||
(list-id :as string?) (placeholder :as string?) (label :as string?)
|
||||
(btn-label :as string?))
|
||||
(<>
|
||||
(div :id (or errors-id "crud-create-errors") :class "mt-2 text-sm text-red-600")
|
||||
(form :class "mt-4 flex gap-2 items-end" :sx-post create-url
|
||||
@@ -171,13 +177,14 @@
|
||||
:placeholder (or placeholder "Name")))
|
||||
(button :type "submit" :class "border rounded px-3 py-2" (or btn-label "Add")))))
|
||||
|
||||
(defcomp ~crud-panel (&key form list list-id)
|
||||
(defcomp ~crud-panel (&key form list (list-id :as string?))
|
||||
(section :class "p-4"
|
||||
form
|
||||
(div :id (or list-id "crud-list") :class "mt-6" list)))
|
||||
|
||||
(defcomp ~crud-item (&key href name slug del-url csrf-hdr list-id
|
||||
confirm-title confirm-text)
|
||||
(defcomp ~crud-item (&key (href :as string) (name :as string) (slug :as string) (del-url :as string)
|
||||
(csrf-hdr :as string) (list-id :as string?) (confirm-title :as string?)
|
||||
(confirm-text :as string?))
|
||||
(div :class "mt-6 border rounded-lg p-4"
|
||||
(div :class "flex items-center justify-between gap-3"
|
||||
(a :class "flex items-baseline gap-3" :href href
|
||||
@@ -199,9 +206,10 @@
|
||||
;; checkout prefix) used by blog, events, and cart admin panels.
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~sumup-settings-form (&key update-url csrf merchant-code placeholder
|
||||
input-cls sumup-configured checkout-prefix
|
||||
panel-id sx-select)
|
||||
(defcomp ~sumup-settings-form (&key (update-url :as string) (csrf :as string?) (merchant-code :as string?)
|
||||
(placeholder :as string?) (input-cls :as string?)
|
||||
(sumup-configured :as boolean?) (checkout-prefix :as string?)
|
||||
(panel-id :as string?) (sx-select :as string?))
|
||||
(div :id (or panel-id "payments-panel") :class "space-y-4 p-4 bg-white rounded-lg border border-stone-200"
|
||||
(h3 :class "text-lg font-semibold text-stone-800"
|
||||
(i :class "fa fa-credit-card text-purple-600 mr-1") " SumUp Payment")
|
||||
@@ -233,7 +241,7 @@
|
||||
;; Shared avatar — image or initial-letter placeholder
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~avatar (&key src cls initial)
|
||||
(defcomp ~avatar (&key (src :as string?) (cls :as string?) (initial :as string?))
|
||||
(if src
|
||||
(img :src src :alt "" :class cls)
|
||||
(div :class cls initial)))
|
||||
@@ -242,7 +250,9 @@
|
||||
;; Shared scroll-nav wrapper — horizontal scrollable nav with arrows
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~scroll-nav-wrapper (&key wrapper-id container-id arrow-cls left-hs scroll-hs right-hs items oob)
|
||||
(defcomp ~scroll-nav-wrapper (&key (wrapper-id :as string) (container-id :as string) (arrow-cls :as string?)
|
||||
(left-hs :as string?) (scroll-hs :as string?) (right-hs :as string?)
|
||||
items (oob :as boolean?))
|
||||
(div :class "flex flex-col sm:flex-row sm:items-center gap-2 border-r border-stone-200 mr-2 sm:max-w-2xl"
|
||||
:id wrapper-id :sx-swap-oob (if oob "outerHTML" nil)
|
||||
(button :class (str (or arrow-cls "nav-arrow") " hidden flex-shrink-0 p-2 hover:bg-stone-200 rounded")
|
||||
|
||||
@@ -1,11 +1,12 @@
|
||||
(defcomp ~calendar-entry-nav (&key href name date-str nav-class)
|
||||
(defcomp ~calendar-entry-nav (&key (href :as string) (name :as string) (date-str :as string) (nav-class :as string?))
|
||||
(a :href href :class nav-class
|
||||
(div :class "w-8 h-8 rounded bg-stone-200 flex-shrink-0")
|
||||
(div :class "flex-1 min-w-0"
|
||||
(div :class "font-medium truncate" name)
|
||||
(div :class "text-xs text-stone-600 truncate" date-str))))
|
||||
|
||||
(defcomp ~calendar-link-nav (&key href name nav-class is-selected select-colours)
|
||||
(defcomp ~calendar-link-nav (&key (href :as string) (name :as string) (nav-class :as string?)
|
||||
(is-selected :as string?) (select-colours :as string?))
|
||||
(a :href href
|
||||
:sx-get href
|
||||
:sx-target "#main-panel"
|
||||
@@ -17,12 +18,14 @@
|
||||
(i :class "fa fa-calendar" :aria-hidden "true")
|
||||
(span name)))
|
||||
|
||||
(defcomp ~market-link-nav (&key href name nav-class select-colours)
|
||||
(defcomp ~market-link-nav (&key (href :as string) (name :as string) (nav-class :as string?)
|
||||
(select-colours :as string?))
|
||||
(a :href href :class (str (or nav-class "") " " (or select-colours ""))
|
||||
(i :class "fa fa-shopping-bag" :aria-hidden "true")
|
||||
(span name)))
|
||||
|
||||
(defcomp ~relation-nav (&key href name icon nav-class relation-type)
|
||||
(defcomp ~relation-nav (&key (href :as string) (name :as string) (icon :as string?)
|
||||
(nav-class :as string?) (relation-type :as string?))
|
||||
(a :href href :class (or nav-class "flex items-center gap-3 rounded-lg py-2 px-3 text-sm text-stone-700 hover:bg-stone-100 transition-colors")
|
||||
(when icon
|
||||
(div :class "w-8 h-8 rounded bg-stone-200 flex items-center justify-center flex-shrink-0"
|
||||
|
||||
@@ -6,7 +6,8 @@
|
||||
;; Order table rows
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~order-row-desktop (&key oid created desc total pill status url)
|
||||
(defcomp ~order-row-desktop (&key (oid :as string) (created :as string) (desc :as string) (total :as string)
|
||||
(pill :as string) (status :as string) (url :as string))
|
||||
(tr :class "hidden sm:table-row border-t border-stone-100 hover:bg-stone-50/60"
|
||||
(td :class "px-3 py-2 align-top" (span :class "font-mono text-[11px] sm:text-xs" oid))
|
||||
(td :class "px-3 py-2 align-top text-stone-700 text-xs sm:text-sm" created)
|
||||
@@ -16,7 +17,8 @@
|
||||
(td :class "px-3 py-0.5 align-top text-right"
|
||||
(a :href url :class "inline-flex items-center px-3 py-1.5 text-xs sm:text-sm rounded-full border border-stone-300 bg-white hover:bg-stone-50 transition" "View"))))
|
||||
|
||||
(defcomp ~order-row-mobile (&key oid created total pill status url)
|
||||
(defcomp ~order-row-mobile (&key (oid :as string) (created :as string) (total :as string)
|
||||
(pill :as string) (status :as string) (url :as string))
|
||||
(tr :class "sm:hidden border-t border-stone-100"
|
||||
(td :colspan "5" :class "px-3 py-3"
|
||||
(div :class "flex flex-col gap-2 text-xs"
|
||||
@@ -61,13 +63,14 @@
|
||||
;; Order detail panels
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~order-item-image (&key src alt)
|
||||
(defcomp ~order-item-image (&key (src :as string) (alt :as string))
|
||||
(img :src src :alt alt :class "w-full h-full object-contain object-center" :loading "lazy" :decoding "async"))
|
||||
|
||||
(defcomp ~order-item-no-image ()
|
||||
(div :class "w-full h-full flex items-center justify-center text-[9px] text-stone-400" "No image"))
|
||||
|
||||
(defcomp ~order-item-row (&key href img title pid qty price)
|
||||
(defcomp ~order-item-row (&key (href :as string) img (title :as string) (pid :as string)
|
||||
(qty :as string) (price :as string))
|
||||
(li (a :class "w-full py-2 flex gap-3" :href href
|
||||
(div :class "w-12 h-12 sm:w-14 sm:h-14 rounded-md bg-stone-100 flex-shrink-0 overflow-hidden" img)
|
||||
(div :class "flex-1 flex justify-between gap-3"
|
||||
@@ -83,7 +86,8 @@
|
||||
(h2 :class "text-sm sm:text-base font-semibold mb-3" "Items")
|
||||
(ul :class "divide-y divide-stone-100 text-xs sm:text-sm" items)))
|
||||
|
||||
(defcomp ~order-calendar-entry (&key name pill status date-str cost)
|
||||
(defcomp ~order-calendar-entry (&key (name :as string) (pill :as string) (status :as string)
|
||||
(date-str :as string) (cost :as string))
|
||||
(li :class "px-4 py-3 flex items-start justify-between text-sm"
|
||||
(div (div :class "font-medium flex items-center gap-2"
|
||||
name (span :class pill status))
|
||||
@@ -98,11 +102,12 @@
|
||||
(defcomp ~order-detail-panel (&key summary items calendar)
|
||||
(div :class "max-w-full px-3 py-3 space-y-4" summary items calendar))
|
||||
|
||||
(defcomp ~order-pay-btn (&key url)
|
||||
(defcomp ~order-pay-btn (&key (url :as string))
|
||||
(a :href url :class "inline-flex items-center px-3 py-2 text-xs sm:text-sm rounded-full border border-emerald-600 bg-emerald-600 text-white hover:bg-emerald-700 transition"
|
||||
(i :class "fa fa-credit-card mr-2" :aria-hidden "true") "Open payment page"))
|
||||
|
||||
(defcomp ~order-detail-filter (&key info list-url recheck-url csrf pay)
|
||||
(defcomp ~order-detail-filter (&key (info :as string) (list-url :as string) (recheck-url :as string)
|
||||
(csrf :as string) pay)
|
||||
(header :class "mb-6 sm:mb-8 flex flex-col sm:flex-row sm:items-center justify-between gap-3 sm:gap-4"
|
||||
(div :class "space-y-1"
|
||||
(p :class "text-xs sm:text-sm text-stone-600" info))
|
||||
@@ -124,7 +129,8 @@
|
||||
;; Data-driven order rows (replaces Python loop)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~order-rows-from-data (&key orders page total-pages next-url)
|
||||
(defcomp ~order-rows-from-data (&key (orders :as list?) (page :as number) (total-pages :as number)
|
||||
(next-url :as string?))
|
||||
(<>
|
||||
(map (lambda (o)
|
||||
(<>
|
||||
@@ -144,7 +150,7 @@
|
||||
;; Data-driven order items (replaces Python loop)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~order-items-from-data (&key items)
|
||||
(defcomp ~order-items-from-data (&key (items :as list?))
|
||||
(~order-items-panel
|
||||
:items (<> (map (lambda (item)
|
||||
(let* ((img (if (get item "product_image")
|
||||
@@ -162,7 +168,7 @@
|
||||
;; Data-driven calendar entries (replaces Python loop)
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~order-calendar-from-data (&key entries)
|
||||
(defcomp ~order-calendar-from-data (&key (entries :as list?))
|
||||
(~order-calendar-section
|
||||
:items (<> (map (lambda (e)
|
||||
(~order-calendar-entry
|
||||
@@ -180,7 +186,7 @@
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; Status pill class mapping
|
||||
(defcomp ~order-status-pill-cls (&key status)
|
||||
(defcomp ~order-status-pill-cls (&key (status :as string?))
|
||||
(let* ((sl (lower (or status ""))))
|
||||
(cond
|
||||
((= sl "paid") "border-emerald-300 bg-emerald-50 text-emerald-700")
|
||||
@@ -188,7 +194,7 @@
|
||||
(true "border-stone-300 bg-stone-50 text-stone-700"))))
|
||||
|
||||
;; Single order row pair (desktop + mobile) — takes serialized order data dict
|
||||
(defcomp ~order-row-pair (&key order detail-url-prefix)
|
||||
(defcomp ~order-row-pair (&key (order :as dict) (detail-url-prefix :as string))
|
||||
(let* ((status (or (get order "status") "pending"))
|
||||
(pill-base (~order-status-pill-cls :status status))
|
||||
(oid (str "#" (get order "id")))
|
||||
@@ -207,7 +213,8 @@
|
||||
:status status :url url))))
|
||||
|
||||
;; Assembled orders list content
|
||||
(defcomp ~orders-list-content (&key orders page total-pages rows-url detail-url-prefix)
|
||||
(defcomp ~orders-list-content (&key (orders :as list) (page :as number) (total-pages :as number)
|
||||
(rows-url :as string) (detail-url-prefix :as string))
|
||||
(if (empty? orders)
|
||||
(~order-empty-state)
|
||||
(~order-table
|
||||
@@ -223,7 +230,7 @@
|
||||
(~order-end-row))))))
|
||||
|
||||
;; Assembled order detail content — replaces Python _order_main_sx
|
||||
(defcomp ~order-detail-content (&key order calendar-entries)
|
||||
(defcomp ~order-detail-content (&key (order :as dict) (calendar-entries :as list?))
|
||||
(let* ((items (get order "items")))
|
||||
(~order-detail-panel
|
||||
:summary (~order-summary-card
|
||||
@@ -265,7 +272,8 @@
|
||||
calendar-entries))))))
|
||||
|
||||
;; Assembled order detail filter — replaces Python _order_filter_sx
|
||||
(defcomp ~order-detail-filter-content (&key order list-url recheck-url pay-url csrf)
|
||||
(defcomp ~order-detail-filter-content (&key (order :as dict) (list-url :as string) (recheck-url :as string)
|
||||
(pay-url :as string) (csrf :as string))
|
||||
(let* ((status (or (get order "status") "pending"))
|
||||
(created (or (get order "created_at_formatted") "\u2014")))
|
||||
(~order-detail-filter
|
||||
@@ -280,7 +288,7 @@
|
||||
;; Checkout return components
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~checkout-return-header (&key status)
|
||||
(defcomp ~checkout-return-header (&key (status :as string))
|
||||
(header :class "mb-6 sm:mb-8"
|
||||
(h1 :class "text-xl sm:text-2xl md:text-3xl font-semibold tracking-tight" "Payment complete")
|
||||
(p :class "text-xs sm:text-sm text-stone-600"
|
||||
@@ -290,7 +298,9 @@
|
||||
(div :class "max-w-full px-3 py-3 space-y-4"
|
||||
(p :class "text-sm text-stone-600" "Order not found.")))
|
||||
|
||||
(defcomp ~checkout-return-ticket (&key name pill state type-name date-str code price)
|
||||
(defcomp ~checkout-return-ticket (&key (name :as string) (pill :as string) (state :as string)
|
||||
(type-name :as string?) (date-str :as string) (code :as string?)
|
||||
(price :as string))
|
||||
(li :class "px-4 py-3 flex items-start justify-between text-sm"
|
||||
(div
|
||||
(div :class "font-medium flex items-center gap-2"
|
||||
@@ -305,7 +315,7 @@
|
||||
(h2 :class "text-base sm:text-lg font-semibold" "Tickets")
|
||||
(ul :class "divide-y divide-stone-200 rounded-2xl border border-stone-200 bg-white/80" items)))
|
||||
|
||||
(defcomp ~checkout-return-failed (&key order-id)
|
||||
(defcomp ~checkout-return-failed (&key (order-id :as string?))
|
||||
(div :class "rounded-lg border border-rose-200 bg-rose-50 p-4 text-sm text-rose-900"
|
||||
(p :class "font-medium" "Payment failed")
|
||||
(p "Please try again or contact support."
|
||||
@@ -329,10 +339,10 @@
|
||||
(h1 :class "text-xl sm:text-2xl md:text-3xl font-semibold tracking-tight" "Checkout error")
|
||||
(p :class "text-xs sm:text-sm text-stone-600" "We tried to start your payment with SumUp but hit a problem.")))
|
||||
|
||||
(defcomp ~checkout-error-order-id (&key oid)
|
||||
(defcomp ~checkout-error-order-id (&key (oid :as string))
|
||||
(p :class "text-xs text-rose-800/80" "Order ID: " (span :class "font-mono" oid)))
|
||||
|
||||
(defcomp ~checkout-error-content (&key msg order back-url)
|
||||
(defcomp ~checkout-error-content (&key (msg :as string) order (back-url :as string))
|
||||
(div :class "max-w-full px-3 py-3 space-y-4"
|
||||
(div :class "rounded-2xl border border-rose-200 bg-rose-50/80 p-4 sm:p-6 text-sm text-rose-900 space-y-2"
|
||||
(p :class "font-medium" "Something went wrong.")
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(defcomp ~base-shell (&key title asset-url &rest children)
|
||||
(defcomp ~base-shell (&key (title :as string) (asset-url :as string) &rest children)
|
||||
(<>
|
||||
(raw! "<!doctype html>")
|
||||
(html :lang "en"
|
||||
@@ -23,13 +23,13 @@
|
||||
;; <script>__sxResolve("id", "(resolved sx ...)")</script>
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~suspense (&key id fallback &rest children)
|
||||
(defcomp ~suspense (&key (id :as string) fallback &rest children)
|
||||
(div :id (str "sx-suspense-" id)
|
||||
:data-suspense id
|
||||
:style "display:contents"
|
||||
(if (not (empty? children)) children fallback)))
|
||||
|
||||
(defcomp ~error-page (&key title message image asset-url)
|
||||
(defcomp ~error-page (&key (title :as string) (message :as string) (image :as string?) (asset-url :as string))
|
||||
(~base-shell :title title :asset-url asset-url
|
||||
(div :class "text-center p-8 max-w-lg mx-auto"
|
||||
(div :class "font-bold text-2xl md:text-4xl text-red-500 mb-4"
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
(defcomp ~relation-attach (&key create-url label icon)
|
||||
(defcomp ~relation-attach (&key (create-url :as string) (label :as string?) (icon :as string?))
|
||||
(a :href create-url
|
||||
:sx-get create-url
|
||||
:sx-target "#main-panel"
|
||||
@@ -8,7 +8,7 @@
|
||||
(when icon (i :class icon))
|
||||
(span (or label "Add"))))
|
||||
|
||||
(defcomp ~relation-detach (&key detach-url name)
|
||||
(defcomp ~relation-detach (&key (detach-url :as string) (name :as string?))
|
||||
(button :sx-delete detach-url
|
||||
:sx-confirm (str "Remove " (or name "this item") "?")
|
||||
:class "text-red-500 hover:text-red-700 text-sm p-1 rounded hover:bg-red-50 transition-colors"
|
||||
|
||||
@@ -11,13 +11,13 @@
|
||||
;; - Pre-rendered meta HTML from callers
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defcomp ~sx-page-shell (&key title meta-html csrf
|
||||
sx-css sx-css-classes
|
||||
component-hash component-defs
|
||||
pages-sx page-sx
|
||||
asset-url sx-js-hash body-js-hash
|
||||
head-scripts inline-css inline-head-js
|
||||
init-sx body-scripts)
|
||||
(defcomp ~sx-page-shell (&key (title :as string) (meta-html :as string?) (csrf :as string)
|
||||
(sx-css :as string?) (sx-css-classes :as string?)
|
||||
(component-hash :as string?) (component-defs :as string?)
|
||||
(pages-sx :as string?) (page-sx :as string?)
|
||||
(asset-url :as string) (sx-js-hash :as string) (body-js-hash :as string?)
|
||||
(head-scripts :as list?) (inline-css :as string?) (inline-head-js :as string?)
|
||||
(init-sx :as string?) (body-scripts :as list?))
|
||||
(<>
|
||||
(raw! "<!doctype html>")
|
||||
(html :lang "en"
|
||||
|
||||
@@ -20,7 +20,7 @@ _PROJECT = os.path.abspath(os.path.join(_HERE, "..", "..", ".."))
|
||||
sys.path.insert(0, _PROJECT)
|
||||
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.evaluator import _eval, _trampoline, _call_lambda
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline, call_lambda as _call_lambda
|
||||
from shared.sx.types import Symbol, Keyword, Lambda, NIL, Component, Island
|
||||
|
||||
# --- Test state ---
|
||||
@@ -127,13 +127,38 @@ def render_html(sx_source):
|
||||
except ImportError:
|
||||
raise RuntimeError("render-to-html not available — sx_ref.py not built")
|
||||
exprs = parse_all(sx_source)
|
||||
render_env = dict(env)
|
||||
# Use Env (not flat dict) so tests exercise the real scope chain path.
|
||||
render_env = _Env(dict(env))
|
||||
result = ""
|
||||
for expr in exprs:
|
||||
result += _render_to_html(expr, render_env)
|
||||
return result
|
||||
|
||||
|
||||
# --- Render SX (aser) platform function ---
|
||||
|
||||
def render_sx(sx_source):
|
||||
"""Parse SX source and serialize to SX wire format via the bootstrapped evaluator."""
|
||||
try:
|
||||
from shared.sx.ref.sx_ref import aser as _aser, serialize as _serialize
|
||||
except ImportError:
|
||||
raise RuntimeError("aser not available — sx_ref.py not built")
|
||||
exprs = parse_all(sx_source)
|
||||
# Use Env (not flat dict) so tests exercise the real scope chain path.
|
||||
# Using dict(env) hides bugs where merge() drops Env parent scopes.
|
||||
render_env = _Env(dict(env))
|
||||
result = ""
|
||||
for expr in exprs:
|
||||
val = _aser(expr, render_env)
|
||||
if isinstance(val, str):
|
||||
result += val
|
||||
elif val is None or val is NIL:
|
||||
pass
|
||||
else:
|
||||
result += _serialize(val)
|
||||
return result
|
||||
|
||||
|
||||
# --- Signal platform primitives ---
|
||||
# Implements the signal runtime platform interface for testing signals.sx
|
||||
|
||||
@@ -258,10 +283,12 @@ SPECS = {
|
||||
"parser": {"file": "test-parser.sx", "needs": ["sx-parse"]},
|
||||
"router": {"file": "test-router.sx", "needs": []},
|
||||
"render": {"file": "test-render.sx", "needs": ["render-html"]},
|
||||
"aser": {"file": "test-aser.sx", "needs": ["render-sx"]},
|
||||
"deps": {"file": "test-deps.sx", "needs": []},
|
||||
"engine": {"file": "test-engine.sx", "needs": []},
|
||||
"orchestration": {"file": "test-orchestration.sx", "needs": []},
|
||||
"signals": {"file": "test-signals.sx", "needs": ["make-signal"]},
|
||||
"types": {"file": "test-types.sx", "needs": []},
|
||||
}
|
||||
|
||||
REF_DIR = os.path.join(_HERE, "..", "ref")
|
||||
@@ -296,8 +323,9 @@ env = _Env({
|
||||
"make-keyword": make_keyword,
|
||||
"symbol-name": symbol_name,
|
||||
"keyword-name": keyword_name,
|
||||
# Render platform function
|
||||
# Render platform functions
|
||||
"render-html": render_html,
|
||||
"render-sx": render_sx,
|
||||
# Extra primitives needed by spec modules (router.sx, deps.sx)
|
||||
"for-each-indexed": "_deferred", # replaced below
|
||||
"dict-set!": "_deferred",
|
||||
@@ -722,6 +750,165 @@ def _load_signals(env):
|
||||
env["batch"] = _batch
|
||||
|
||||
|
||||
def _load_types(env):
|
||||
"""Load types.sx spec — gradual type system."""
|
||||
from shared.sx.types import Component
|
||||
|
||||
def _component_param_types(c):
|
||||
return getattr(c, 'param_types', None)
|
||||
|
||||
def _component_set_param_types(c, d):
|
||||
c.param_types = d
|
||||
|
||||
env["component-param-types"] = _component_param_types
|
||||
env["component-set-param-types!"] = _component_set_param_types
|
||||
|
||||
# test-prim-types: a minimal type registry for testing
|
||||
def _test_prim_types():
|
||||
return {
|
||||
"+": "number", "-": "number", "*": "number", "/": "number",
|
||||
"mod": "number", "abs": "number", "floor": "number",
|
||||
"ceil": "number", "round": "number", "min": "number",
|
||||
"max": "number", "parse-int": "number", "parse-float": "number",
|
||||
"=": "boolean", "!=": "boolean", "<": "boolean", ">": "boolean",
|
||||
"<=": "boolean", ">=": "boolean",
|
||||
"str": "string", "string-length": "number",
|
||||
"substring": "string", "upcase": "string", "downcase": "string",
|
||||
"trim": "string", "split": "list", "join": "string",
|
||||
"string-contains?": "boolean", "starts-with?": "boolean",
|
||||
"ends-with?": "boolean", "replace": "string",
|
||||
"not": "boolean", "nil?": "boolean", "number?": "boolean",
|
||||
"string?": "boolean", "list?": "boolean", "dict?": "boolean",
|
||||
"boolean?": "boolean", "symbol?": "boolean", "empty?": "boolean",
|
||||
"list": "list", "first": "any", "rest": "list", "nth": "any",
|
||||
"last": "any", "cons": "list", "append": "list",
|
||||
"reverse": "list", "len": "number", "contains?": "boolean",
|
||||
"flatten": "list", "concat": "list", "slice": "list",
|
||||
"range": "list", "sort": "list", "sort-by": "list",
|
||||
"map": "list", "filter": "list", "reduce": "any",
|
||||
"some": "boolean", "every?": "boolean",
|
||||
"dict": "dict", "assoc": "dict", "dissoc": "dict",
|
||||
"get": "any", "keys": "list", "vals": "list",
|
||||
"has-key?": "boolean", "merge": "dict",
|
||||
}
|
||||
|
||||
env["test-prim-types"] = _test_prim_types
|
||||
|
||||
# test-prim-param-types: param type signatures for primitive call checking
|
||||
def _test_prim_param_types():
|
||||
# Each entry: {"positional": [["name", "type"|None], ...], "rest-type": "type"|None}
|
||||
return {
|
||||
"+": {"positional": [], "rest-type": "number"},
|
||||
"-": {"positional": [["a", "number"]], "rest-type": "number"},
|
||||
"*": {"positional": [], "rest-type": "number"},
|
||||
"/": {"positional": [["a", "number"], ["b", "number"]], "rest-type": None},
|
||||
"mod": {"positional": [["a", "number"], ["b", "number"]], "rest-type": None},
|
||||
"sqrt": {"positional": [["x", "number"]], "rest-type": None},
|
||||
"pow": {"positional": [["x", "number"], ["n", "number"]], "rest-type": None},
|
||||
"abs": {"positional": [["x", "number"]], "rest-type": None},
|
||||
"floor": {"positional": [["x", "number"]], "rest-type": None},
|
||||
"ceil": {"positional": [["x", "number"]], "rest-type": None},
|
||||
"round": {"positional": [["x", "number"]], "rest-type": "number"},
|
||||
"min": {"positional": [], "rest-type": "number"},
|
||||
"max": {"positional": [], "rest-type": "number"},
|
||||
"clamp": {"positional": [["x", "number"], ["lo", "number"], ["hi", "number"]], "rest-type": None},
|
||||
"inc": {"positional": [["n", "number"]], "rest-type": None},
|
||||
"dec": {"positional": [["n", "number"]], "rest-type": None},
|
||||
"<": {"positional": [["a", "number"], ["b", "number"]], "rest-type": None},
|
||||
">": {"positional": [["a", "number"], ["b", "number"]], "rest-type": None},
|
||||
"<=": {"positional": [["a", "number"], ["b", "number"]], "rest-type": None},
|
||||
">=": {"positional": [["a", "number"], ["b", "number"]], "rest-type": None},
|
||||
"odd?": {"positional": [["n", "number"]], "rest-type": None},
|
||||
"even?": {"positional": [["n", "number"]], "rest-type": None},
|
||||
"zero?": {"positional": [["n", "number"]], "rest-type": None},
|
||||
"upper": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"upcase": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"lower": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"downcase": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"string-length": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"substring": {"positional": [["s", "string"], ["start", "number"], ["end", "number"]], "rest-type": None},
|
||||
"string-contains?": {"positional": [["s", "string"], ["needle", "string"]], "rest-type": None},
|
||||
"trim": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"split": {"positional": [["s", "string"]], "rest-type": "string"},
|
||||
"join": {"positional": [["sep", "string"], ["coll", "list"]], "rest-type": None},
|
||||
"replace": {"positional": [["s", "string"], ["old", "string"], ["new", "string"]], "rest-type": None},
|
||||
"index-of": {"positional": [["s", "string"], ["needle", "string"]], "rest-type": "number"},
|
||||
"starts-with?": {"positional": [["s", "string"], ["prefix", "string"]], "rest-type": None},
|
||||
"ends-with?": {"positional": [["s", "string"], ["suffix", "string"]], "rest-type": None},
|
||||
"concat": {"positional": [], "rest-type": "list"},
|
||||
"range": {"positional": [["start", "number"], ["end", "number"]], "rest-type": "number"},
|
||||
"first": {"positional": [["coll", "list"]], "rest-type": None},
|
||||
"last": {"positional": [["coll", "list"]], "rest-type": None},
|
||||
"rest": {"positional": [["coll", "list"]], "rest-type": None},
|
||||
"nth": {"positional": [["coll", "list"], ["n", "number"]], "rest-type": None},
|
||||
"cons": {"positional": [["x", None], ["coll", "list"]], "rest-type": None},
|
||||
"append": {"positional": [["coll", "list"]], "rest-type": None},
|
||||
"append!": {"positional": [["coll", "list"]], "rest-type": None},
|
||||
"reverse": {"positional": [["coll", "list"]], "rest-type": None},
|
||||
"flatten": {"positional": [["coll", "list"]], "rest-type": None},
|
||||
"chunk-every": {"positional": [["coll", "list"], ["n", "number"]], "rest-type": None},
|
||||
"zip-pairs": {"positional": [["coll", "list"]], "rest-type": None},
|
||||
"keys": {"positional": [["d", "dict"]], "rest-type": None},
|
||||
"vals": {"positional": [["d", "dict"]], "rest-type": None},
|
||||
"merge": {"positional": [], "rest-type": "dict"},
|
||||
"has-key?": {"positional": [["d", "dict"]], "rest-type": None},
|
||||
"assoc": {"positional": [["d", "dict"]], "rest-type": None},
|
||||
"dissoc": {"positional": [["d", "dict"]], "rest-type": None},
|
||||
"dict-set!": {"positional": [["d", "dict"]], "rest-type": None},
|
||||
"format-date": {"positional": [["date-str", "string"], ["fmt", "string"]], "rest-type": None},
|
||||
"format-decimal": {"positional": [["val", "number"]], "rest-type": "number"},
|
||||
"parse-datetime": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"pluralize": {"positional": [["count", "number"]], "rest-type": "string"},
|
||||
"escape": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"strip-tags": {"positional": [["s", "string"]], "rest-type": None},
|
||||
"symbol-name": {"positional": [["sym", "symbol"]], "rest-type": None},
|
||||
"keyword-name": {"positional": [["kw", "keyword"]], "rest-type": None},
|
||||
"sx-parse": {"positional": [["source", "string"]], "rest-type": None},
|
||||
}
|
||||
|
||||
env["test-prim-param-types"] = _test_prim_param_types
|
||||
env["test-env"] = lambda: env
|
||||
|
||||
# Platform functions needed by types.sx check-body-walk
|
||||
if "env-get" not in env:
|
||||
env["env-get"] = lambda e, k: e.get(k) if hasattr(e, 'get') else None
|
||||
if "env-has?" not in env:
|
||||
env["env-has?"] = lambda e, k: k in e
|
||||
if "dict-has?" not in env:
|
||||
env["dict-has?"] = lambda d, k: k in d if isinstance(d, dict) else False
|
||||
if "dict-get" not in env:
|
||||
env["dict-get"] = lambda d, k, *default: d.get(k, default[0] if default else None) if isinstance(d, dict) else (default[0] if default else None)
|
||||
# types.sx uses component-has-children (no ?), test runner has component-has-children?
|
||||
if "component-has-children" not in env:
|
||||
env["component-has-children"] = lambda c: getattr(c, 'has_children', False)
|
||||
|
||||
# Try bootstrapped types first, fall back to eval
|
||||
try:
|
||||
from shared.sx.ref.sx_ref import (
|
||||
subtype_p, type_union, narrow_type,
|
||||
infer_type, check_component_call, check_component,
|
||||
check_all, build_type_registry, type_any_p,
|
||||
type_never_p, type_nullable_p, nullable_base,
|
||||
narrow_exclude_nil, narrow_exclude,
|
||||
)
|
||||
env["subtype?"] = subtype_p
|
||||
env["type-union"] = type_union
|
||||
env["narrow-type"] = narrow_type
|
||||
env["infer-type"] = infer_type
|
||||
env["check-component-call"] = check_component_call
|
||||
env["check-component"] = check_component
|
||||
env["check-all"] = check_all
|
||||
env["build-type-registry"] = build_type_registry
|
||||
env["type-any?"] = type_any_p
|
||||
env["type-never?"] = type_never_p
|
||||
env["type-nullable?"] = type_nullable_p
|
||||
env["nullable-base"] = nullable_base
|
||||
env["narrow-exclude-nil"] = narrow_exclude_nil
|
||||
env["narrow-exclude"] = narrow_exclude
|
||||
except ImportError:
|
||||
eval_file("types.sx", env)
|
||||
|
||||
|
||||
def main():
|
||||
global passed, failed, test_num
|
||||
|
||||
@@ -769,13 +956,15 @@ def main():
|
||||
_load_orchestration(env)
|
||||
if spec_name == "signals":
|
||||
_load_signals(env)
|
||||
if spec_name == "types":
|
||||
_load_types(env)
|
||||
|
||||
print(f"# --- {spec_name} ---")
|
||||
eval_file(spec["file"], env)
|
||||
|
||||
# Reset render state after render tests to avoid leaking
|
||||
# Reset render state after render/aser tests to avoid leaking
|
||||
# into subsequent specs (bootstrapped evaluator checks render_active)
|
||||
if spec_name == "render":
|
||||
if spec_name in ("render", "aser"):
|
||||
try:
|
||||
from shared.sx.ref.sx_ref import set_render_active_b
|
||||
set_render_active_b(False)
|
||||
|
||||
@@ -21,7 +21,7 @@ class TestJsSxTranslation:
|
||||
|
||||
def _translate(self, sx_source: str) -> str:
|
||||
"""Translate a single SX expression to JS using js.sx."""
|
||||
from shared.sx.evaluator import evaluate
|
||||
from shared.sx.ref.sx_ref import evaluate
|
||||
env = load_js_sx()
|
||||
expr = parse(sx_source)
|
||||
env["_def_expr"] = expr
|
||||
|
||||
@@ -18,7 +18,7 @@ from shared.sx.deps import (
|
||||
|
||||
def make_env(*sx_sources: str) -> dict:
|
||||
"""Parse and evaluate component definitions into an env dict."""
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
env: dict = {}
|
||||
for source in sx_sources:
|
||||
exprs = parse_all(source)
|
||||
|
||||
@@ -23,7 +23,7 @@ from shared.sx.deps import (
|
||||
|
||||
def make_env(*sx_sources: str) -> dict:
|
||||
"""Parse and evaluate component definitions into an env dict."""
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
env: dict = {}
|
||||
for source in sx_sources:
|
||||
exprs = parse_all(source)
|
||||
|
||||
@@ -20,7 +20,7 @@ from shared.sx.deps import (
|
||||
|
||||
def make_env(*sx_sources: str) -> dict:
|
||||
"""Parse and evaluate component definitions into an env dict."""
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
env: dict = {}
|
||||
for source in sx_sources:
|
||||
exprs = parse_all(source)
|
||||
@@ -282,7 +282,7 @@ class TestIoRoutingLogic:
|
||||
"""
|
||||
|
||||
def _eval(self, src, env):
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
result = None
|
||||
for expr in parse_all(src):
|
||||
result = _trampoline(_eval(expr, env))
|
||||
|
||||
@@ -156,7 +156,7 @@ class TestDataPageDeps:
|
||||
def test_deps_computed_for_data_page(self):
|
||||
from shared.sx.deps import components_needed
|
||||
from shared.sx.parser import parse_all as pa
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
|
||||
# Define a component
|
||||
env = {}
|
||||
@@ -172,7 +172,7 @@ class TestDataPageDeps:
|
||||
def test_deps_transitive_for_data_page(self):
|
||||
from shared.sx.deps import components_needed
|
||||
from shared.sx.parser import parse_all as pa
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
|
||||
env = {}
|
||||
source = """
|
||||
@@ -205,7 +205,7 @@ class TestDataPipelineSimulation:
|
||||
|
||||
def test_full_pipeline(self):
|
||||
from shared.sx.parser import parse_all as pa
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
|
||||
# 1. Define a component that uses only pure primitives
|
||||
env = {}
|
||||
@@ -236,7 +236,7 @@ class TestDataPipelineSimulation:
|
||||
|
||||
def test_pipeline_with_list_data(self):
|
||||
from shared.sx.parser import parse_all as pa
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
|
||||
env = {}
|
||||
for expr in pa('''
|
||||
@@ -262,7 +262,7 @@ class TestDataPipelineSimulation:
|
||||
def test_pipeline_data_isolation(self):
|
||||
"""Different data for the same content produces different results."""
|
||||
from shared.sx.parser import parse_all as pa
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
|
||||
env = {}
|
||||
for expr in pa('(defcomp ~page (&key title count) (str title ": " count))'):
|
||||
@@ -298,7 +298,7 @@ class TestDataCache:
|
||||
def _make_env(self, current_time_ms=1000):
|
||||
"""Create an env with cache functions and a controllable now-ms."""
|
||||
from shared.sx.parser import parse_all as pa
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
|
||||
env = {}
|
||||
# Mock now-ms as a callable that returns current_time_ms
|
||||
@@ -344,7 +344,7 @@ class TestDataCache:
|
||||
|
||||
def _eval(self, src, env):
|
||||
from shared.sx.parser import parse_all as pa
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
result = None
|
||||
for expr in pa(src):
|
||||
result = _trampoline(_eval(expr, env))
|
||||
|
||||
@@ -18,7 +18,7 @@ from shared.sx.types import Symbol, Keyword, Lambda, Component, Macro, NIL
|
||||
|
||||
def hw_eval(text, env=None):
|
||||
"""Evaluate via hand-written evaluator.py."""
|
||||
from shared.sx.evaluator import evaluate as _evaluate, EvalError
|
||||
from shared.sx.ref.sx_ref import evaluate as _evaluate
|
||||
if env is None:
|
||||
env = {}
|
||||
return _evaluate(parse(text), env)
|
||||
@@ -50,7 +50,7 @@ def ref_render(text, env=None):
|
||||
|
||||
def hw_eval_multi(text, env=None):
|
||||
"""Evaluate multiple expressions (e.g. defines then call)."""
|
||||
from shared.sx.evaluator import evaluate as _evaluate
|
||||
from shared.sx.ref.sx_ref import evaluate as _evaluate
|
||||
if env is None:
|
||||
env = {}
|
||||
result = None
|
||||
@@ -736,7 +736,7 @@ class TestParityDeps:
|
||||
|
||||
class TestParityErrors:
|
||||
def test_undefined_symbol(self):
|
||||
from shared.sx.evaluator import EvalError as HwError
|
||||
from shared.sx.types import EvalError as HwError
|
||||
from shared.sx.ref.sx_ref import EvalError as RefError
|
||||
with pytest.raises(HwError):
|
||||
hw_eval("undefined_var")
|
||||
|
||||
@@ -12,7 +12,7 @@ import pytest
|
||||
|
||||
from shared.sx.parser import parse, parse_all
|
||||
from shared.sx.html import render as py_render
|
||||
from shared.sx.evaluator import evaluate
|
||||
from shared.sx.ref.sx_ref import evaluate
|
||||
|
||||
SX_JS = Path(__file__).resolve().parents[2] / "static" / "scripts" / "sx.js"
|
||||
SX_TEST_JS = Path(__file__).resolve().parents[2] / "static" / "scripts" / "sx-test.js"
|
||||
|
||||
@@ -7,7 +7,7 @@ from __future__ import annotations
|
||||
|
||||
import pytest
|
||||
from shared.sx.parser import parse_all
|
||||
from shared.sx.evaluator import _eval, _trampoline
|
||||
from shared.sx.ref.sx_ref import eval_expr as _eval, trampoline as _trampoline
|
||||
|
||||
|
||||
_PREAMBLE = '''(define assert-equal (fn (expected actual) (assert (equal? expected actual) (str "Expected " (str expected) " but got " (str actual)))))
|
||||
|
||||
@@ -170,6 +170,7 @@ class Component:
|
||||
deps: set[str] = field(default_factory=set) # transitive component deps (~names)
|
||||
io_refs: set[str] | None = None # transitive IO primitive refs (None = not computed)
|
||||
affinity: str = "auto" # "auto" | "client" | "server"
|
||||
param_types: dict[str, Any] | None = None # {param_name: type_expr} for gradual typing
|
||||
|
||||
@property
|
||||
def is_pure(self) -> bool:
|
||||
@@ -375,6 +376,15 @@ class _ShiftSignal(BaseException):
|
||||
self.env = env
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# EvalError
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
class EvalError(Exception):
|
||||
"""Error during expression evaluation."""
|
||||
pass
|
||||
|
||||
|
||||
# ---------------------------------------------------------------------------
|
||||
# Type alias
|
||||
# ---------------------------------------------------------------------------
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user