Skip to content

Commit

Permalink
update for IC compat
Browse files Browse the repository at this point in the history
  • Loading branch information
@xificurC
xificurC committed Dec 5, 2023
1 parent 7b1f836 commit b9553f0
Show file tree
Hide file tree
Showing 3 changed files with 94 additions and 92 deletions.
51 changes: 25 additions & 26 deletions src/hyperfiddle/hfql.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,22 +18,27 @@
([bindings query] `(new Render (precompile ~bindings ~query)))
([bindings query eid] `(new Render (precompile ~bindings ~query ~eid))))

(p/defn JoinArg [ctx-or-V]
(if (map? ctx-or-V)
(JoinAllTheTree. ctx-or-V)
(new ctx-or-V)))

(defn literal [collf & args] (collf args)) ; TODO rename

(s/fdef literal :args (s/cat :collf fn? :args any?) :ret any?)


(p/def Rec)

(defn -drop-wildcards "Given a context, build a sequence of key-value pairs, ignoring any wildcard"
[{:hyperfiddle.api/keys [keys values]}]
(remove (fn [[k _v]] (= '_ k)) (partition 2 (interleave keys values))))

(p/def Rec)

;; TODO Rename, this seems to just be "Render"
(p/defn EdnRender "Join all the tree, calling renderers when provided, return EDN" [V]
(binding [Rec (p/fn [{:hyperfiddle.api/keys [type render Value] :as ctx}]
(if render (render. ctx)
(case type
:hyperfiddle.api/leaf (Value.)
:hyperfiddle.api/keys (into {} (p/for [[k ctx] (-drop-wildcards ctx)]
[k (Rec. ctx)]))
(let [ctx (Value.)]
(cond
(vector? ctx) (p/for [ctx ctx] (Rec. ctx))
(map? ctx) (Rec. ctx)
:else ctx)))))]
(new Rec V)))

;; TODO Rename
(p/defn JoinAllTheTree "Join all the tree, does not call renderers, return EDN." [V]
(binding [Rec (p/fn [{:hyperfiddle.api/keys [type Value] :as ctx}]
Expand All @@ -50,20 +55,14 @@
ctx)))]
(new Rec V)))

;; TODO Rename, this seems to just be "Render"
(p/defn EdnRender "Join all the tree, calling renderers when provided, return EDN" [V]
(binding [Rec (p/fn [{:hyperfiddle.api/keys [type render Value] :as ctx}]
(if render (render. ctx)
(case type
:hyperfiddle.api/leaf (Value.)
:hyperfiddle.api/keys (into {} (p/for [[k ctx] (-drop-wildcards ctx)]
[k (Rec. ctx)]))
(let [ctx (Value.)]
(cond
(vector? ctx) (p/for [ctx ctx] (Rec. ctx))
(map? ctx) (Rec. ctx)
:else ctx)))))]
(new Rec V)))
(p/defn JoinArg [ctx-or-V]
(if (map? ctx-or-V)
(JoinAllTheTree. ctx-or-V)
(new ctx-or-V)))

(defn literal [collf & args] (collf args)) ; TODO rename

(s/fdef literal :args (s/cat :collf fn? :args any?) :ret any?)

(p/def Render JoinAllTheTree)

Expand Down
101 changes: 51 additions & 50 deletions src/hyperfiddle/hfql_tree_grid.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,7 +18,7 @@
[missionary.core :as m]
[hyperfiddle.history :as router])
(:import (hyperfiddle.electric Pending))
#?(:cljs (:require-macros [hyperfiddle.hfql-tree-grid]))
#?(:cljs (:require-macros [hyperfiddle.hfql-tree-grid :refer [options-props cell input-props input-validator gray-input-props applier with-gridsheet-renderer*]]))
#?(:cljs (:refer-clojure :exclude [List])))

(defn attr-spec [attr]
Expand Down Expand Up @@ -127,6 +127,33 @@
;; This should not be see in userland because it’s an implementation detail
;; driven by Photon not supporting mutual recursion as of today.

(defn get-computed-style [node] #?(:cljs (js/getComputedStyle node)))

#?(:cljs
(defn ticker [interval-ms]
(m/observe (fn [!]
(! ::tick)
(let [ref (.setInterval js/window #(! ::tick) interval-ms)]
#(.clearInterval js/window ref))))))

(p/defn Sampler [rate-ms f]
(p/client
(if (= "visible" p/dom-visibility-state)
(new (m/relieve {} (m/eduction (dedupe) (m/sample f (ticker rate-ms))))) ; one ticker per sampler, not shared
(throw (Pending.)))))

(p/defn ComputedStyle
"Calls the `keyfn` clojure function, passing it the given DOM node’s
CSSStyleDeclaration instance. `keyfn` is meant to extract properties from the
live computed style object."
;; Does not return CSSStyleDeclaration directly because a CSSStyleDeclaration
;; is a live object with a stable identity. m/cp would dedupe it even if
;; properties might have changed.
;; NOTE: beware of expensive keyfn
[keyfn node]
(let [live-object (get-computed-style node)]
(Sampler. 250 #(keyfn live-object))))

(defmacro with-gridsheet-renderer* [& body]
`(p/client ; FIXME don’t force body to run on the client
(binding [grid-row 1
Expand Down Expand Up @@ -178,23 +205,24 @@
(some? (seq (txn/filter-tx schema (fn [[_op e' a']] (and (= e e') (= a a'))) stage)))))

(p/defn Options [ctx]
(let [options (grab ctx ::hf/options)
option-label (grab ctx ::hf/option-label Identity)
continuation (grab ctx ::hf/continuation Identity)
tx (grab ctx ::hf/tx)
tx? (some? tx)
dom-props (data/select-ns :hyperfiddle.electric-dom2 ctx)
v (find-best-identity (hfql/JoinAllTheTree. ctx))
V! (if tx? (p/fn [v] (tx. ctx v)) Identity)
OptionLabel (p/fn [id] (option-label. (hfql/JoinAllTheTree. (continuation. id))))]
(case (->picker-type (has-needle? ctx) (= ::hf/many (Cardinality. ctx)))
::typeahead (ui4/typeahead v V! options OptionLabel (options-props (not tx?) dom-props))
::select (ui4/select v V! options OptionLabel (options-props (not tx?) dom-props))
::tag-picker (let [unV! (if-some [untx (grab ctx ::hf/untx)] (p/fn [v] (untx. ctx v)) Identity)]
(ui4/tag-picker v V! unV! options OptionLabel
(dom/props {::dom/class [(when (p/server (staged-statement? hf/schema hf/stage (::hf/entity ctx) (::hf/attribute ctx)))
"hyperfiddle-input-dirty-staged")]})
(options-props (not tx?) dom-props))))))
(p/server
(let [options (grab ctx ::hf/options)
option-label (grab ctx ::hf/option-label Identity)
continuation (grab ctx ::hf/continuation Identity)
tx (grab ctx ::hf/tx)
tx? (some? tx)
dom-props (data/select-ns :hyperfiddle.electric-dom2 ctx)
v (find-best-identity (hfql/JoinAllTheTree. ctx))
V! (if tx? (p/fn [v] (tx. ctx v)) Identity)
OptionLabel (p/fn [id] (option-label. (hfql/JoinAllTheTree. (continuation. id))))]
(case (->picker-type (has-needle? ctx) (= ::hf/many (Cardinality. ctx)))
::typeahead (ui4/typeahead v V! options OptionLabel (options-props (not tx?) dom-props))
::select (ui4/select v V! options OptionLabel (options-props (not tx?) dom-props))
::tag-picker (let [unV! (if-some [untx (grab ctx ::hf/untx)] (p/fn [v] (untx. ctx v)) Identity)]
(ui4/tag-picker v V! unV! options OptionLabel
(dom/props {::dom/class [(when (p/server (staged-statement? hf/schema hf/stage (::hf/entity ctx) (::hf/attribute ctx)))
"hyperfiddle-input-dirty-staged")]})
(options-props (not tx?) dom-props)))))))

(defmacro input-props [readonly? grid-row grid-col dom-for]
`(do
Expand Down Expand Up @@ -244,6 +272,10 @@

(p/defn Simple [ctx] (if (grab ctx ::hf/options) (Options. ctx) (Input. ctx)))

(p/def Popover)
(p/def Form)
(p/def Table)

;; TODO adapt to new HFQL macroexpansion
(p/defn Render-impl [{::hf/keys [type render popover Value] :as ctx}]
(cond
Expand Down Expand Up @@ -426,7 +458,7 @@
(when (some? tx)
(Apply. tx args)))))

(p/def Form)
(p/def default-height 10)

(p/defn Form-impl [{::hf/keys [keys values] :as ctx}]
(let [parent-ctx ctx
Expand Down Expand Up @@ -557,8 +589,6 @@
:?keys (::hf/keys ctx)})))))))))))
nil)

(p/def Popover)

(p/defn Row [{::hf/keys [keys values] :as ctx}]
(p/client
(dom/tr
Expand All @@ -575,15 +605,12 @@
Table Simple]
(Render. ctx))))))))))))

(p/def default-height 10)

(defn clamp [lower-bound upper-bound number] (max lower-bound (min number upper-bound)))

(defn give-card-n-contexts-a-unique-key [offset ctxs]
(let [offset (max offset 0)]
(into [] (map-indexed (fn [idx ctx] (assoc ctx ::key (+ offset idx)))) ctxs)))

(p/def Table)
(p/defn Table-impl [{::hf/keys [keys height Value] :as ctx}]
(let [actual-count (new (::hf/count ctx (p/fn [] 0)))
actual-height (min (or height default-height) actual-count)
Expand Down Expand Up @@ -686,32 +713,6 @@
(p/client
~@body)))))))

(defn get-computed-style [node] #?(:cljs (js/getComputedStyle node)))

#?(:cljs
(defn ticker [interval-ms]
(m/observe (fn [!]
(! ::tick)
(let [ref (.setInterval js/window #(! ::tick) interval-ms)]
#(.clearInterval js/window ref))))))

(p/defn Sampler [rate-ms f]
(if (= "visible" p/dom-visibility-state)
(new (m/relieve {} (m/eduction (dedupe) (m/sample f (ticker rate-ms))))) ; one ticker per sampler, not shared
(throw (Pending.))))

(p/defn ComputedStyle
"Calls the `keyfn` clojure function, passing it the given DOM node’s
CSSStyleDeclaration instance. `keyfn` is meant to extract properties from the
live computed style object."
;; Does not return CSSStyleDeclaration directly because a CSSStyleDeclaration
;; is a live object with a stable identity. m/cp would dedupe it even if
;; properties might have changed.
;; NOTE: beware of expensive keyfn
[keyfn node]
(let [live-object (get-computed-style node)]
(Sampler. 250 #(keyfn live-object))))

(p/defn Text [RenderF]
(p/fn [ctx]
(p/client
Expand Down
34 changes: 18 additions & 16 deletions src/hyperfiddle/popover2.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -26,24 +26,26 @@
(catch Pending _ nil)))))))

(e/defn PopoverBody2 [Validate Transact Body]
(dom/div (dom/props {:class "hyperfiddle popover-body"
:tabIndex "1"})
(dom/on! "click" (fn [e]
(when (= (.-target e) (.-currentTarget e)) ; click on self
(.focus (.-currentTarget e)))))
(BranchWrap2. Validate Transact (e/fn [] (Body.)))))
(e/client
(dom/div (dom/props {:class "hyperfiddle popover-body"
:tabIndex "1"})
(dom/on! "click" (fn [e]
(when (= (.-target e) (.-currentTarget e)) ; click on self
(.focus (.-currentTarget e)))))
(BranchWrap2. Validate Transact (e/fn [] (Body.))))))

(e/defn Popover [label anchor-props Validate Transact OnDiscard Body]
(let [!open? (atom false), open? (e/watch !open?)]
(dom/div (dom/props {:class "hyperfiddle popover-wrapper"})
(when (not-empty anchor-props) (dom/props anchor-props))
(ui/button (e/fn [] (swap! !open? not)) (dom/text label)) ; popover anchor
(when open?
(case (PopoverBody2. Validate Transact Body)
(:commit :discard) (case (OnDiscard.) ; sequence
(swap! !open? not))
nil (do))
nil))))
(e/client
(let [!open? (atom false), open? (e/watch !open?)]
(dom/div (dom/props {:class "hyperfiddle popover-wrapper"})
(when (not-empty anchor-props) (dom/props anchor-props))
(ui/button (e/fn [] (swap! !open? not)) (dom/text label)) ; popover anchor
(when open?
(case (PopoverBody2. Validate Transact Body)
(:commit :discard) (case (OnDiscard.) ; sequence
(swap! !open? not))
nil (do))
nil)))))

(defmacro ^:deprecated popover2*
([label body]
Expand Down

0 comments on commit b9553f0

Please sign in to comment.