mirror of
https://github.com/status-im/pluto.git
synced 2025-02-24 00:18:16 +00:00
Introducing for blocks
Signed-off-by: Julien Eluard <julien.eluard@gmail.com>
This commit is contained in:
parent
9f6d5ff364
commit
8b612900ef
@ -38,7 +38,9 @@
|
|||||||
:random)
|
:random)
|
||||||
|
|
||||||
(defn render [h el]
|
(defn render [h el]
|
||||||
(reagent/render (h {:name "Test Extension"}) el))
|
(reagent/render (h {:name "Test Extension"
|
||||||
|
:users [{:nm "Jane"}
|
||||||
|
{:nm "Sue"}]}) el))
|
||||||
|
|
||||||
(defn errors-list [v]
|
(defn errors-list [v]
|
||||||
(fn []
|
(fn []
|
||||||
|
@ -11,7 +11,7 @@
|
|||||||
[alert {:value "Eh! ${you}"}])
|
[alert {:value "Eh! ${you}"}])
|
||||||
|
|
||||||
views/main
|
views/main
|
||||||
(let [{name :name} properties
|
(let [{name :name users :users} properties
|
||||||
{cond? :cond?} [random-boolean]]
|
{cond? :cond?} [random-boolean]]
|
||||||
[view
|
[view
|
||||||
[button {:on-click [my-alert {:arg name}]}
|
[button {:on-click [my-alert {:arg name}]}
|
||||||
@ -20,4 +20,8 @@
|
|||||||
[text {:style {:color "green"}}
|
[text {:style {:color "green"}}
|
||||||
name]
|
name]
|
||||||
[text {:style {:color "red"}}
|
[text {:style {:color "red"}}
|
||||||
name])])}
|
name])
|
||||||
|
[view "Nested for block"]
|
||||||
|
(for [{nm :nm} users]
|
||||||
|
(for [{nm2 :nm} users]
|
||||||
|
[view nm " and " nm2]))])}
|
||||||
|
@ -13,30 +13,27 @@
|
|||||||
"Parse a block element. Return hiccup data."
|
"Parse a block element. Return hiccup data."
|
||||||
(fn [ctx ext [type]] type))
|
(fn [ctx ext [type]] type))
|
||||||
|
|
||||||
(defn resolve-binding-value [v]
|
|
||||||
(cond
|
|
||||||
(vector? v) @(re-frame/subscribe v) ;; TODO better abstract query
|
|
||||||
(not (list? v)) v))
|
|
||||||
|
|
||||||
(defn resolve-binding-key [k v]
|
|
||||||
(if (symbol? k)
|
|
||||||
k
|
|
||||||
;; TODO handle errors
|
|
||||||
(:data (destructuring/destructure k v))))
|
|
||||||
|
|
||||||
(defn substitute-query-values [m v]
|
(defn substitute-query-values [m v]
|
||||||
(if (vector? v)
|
(walk/prewalk #(or (get m %) %) v))
|
||||||
(walk/prewalk #(or (get m %) %) v)
|
|
||||||
v))
|
|
||||||
|
|
||||||
(defn assoc-binding
|
(defn resolve-rhs [env v]
|
||||||
[m k v]
|
(cond
|
||||||
(let [resolved-value (resolve-binding-value
|
(= v 'properties) (get env :pluto.reader/properties)
|
||||||
(substitute-query-values m v))
|
(symbol? v) (get env v)
|
||||||
o (resolve-binding-key k resolved-value)]
|
(vector? v) (some-> (re-frame/subscribe (substitute-query-values env v)) deref)
|
||||||
(if (symbol? o)
|
:else v))
|
||||||
(assoc m o resolved-value)
|
|
||||||
(merge m o))))
|
(defn destructure-into [env k v]
|
||||||
|
(if (map? k)
|
||||||
|
(into env (:data (destructuring/destructure k v)))
|
||||||
|
(assoc env k v)))
|
||||||
|
|
||||||
|
(defn resolve-binding [env k v]
|
||||||
|
(let [v' (resolve-rhs env v)]
|
||||||
|
(destructure-into env k v')))
|
||||||
|
|
||||||
|
(defn resolve-bindings-into [env bindings]
|
||||||
|
(reduce #(apply resolve-binding %1 %2) (or env {}) (partition 2 bindings)))
|
||||||
|
|
||||||
(defn replace-atom [values o]
|
(defn replace-atom [values o]
|
||||||
(cond (contains? values o) (get values o)
|
(cond (contains? values o) (get values o)
|
||||||
@ -56,23 +53,24 @@
|
|||||||
(coll? res) (into (empty res) (map f2 res))
|
(coll? res) (into (empty res) (map f2 res))
|
||||||
:else res))))
|
:else res))))
|
||||||
|
|
||||||
(declare let-block bindings->env)
|
(declare let-block for-block)
|
||||||
|
|
||||||
(defn let-block [{:keys [prev-env ctx ext bindings env]} children]
|
(defn let-block [{:keys [prev-env bindings]} children]
|
||||||
;; env here is always a destructured set of properties
|
(let [new-env (resolve-bindings-into prev-env bindings)]
|
||||||
(let [env' (merge env prev-env)
|
(walkup-upto-leaf #(replace-atom new-env %)
|
||||||
{:keys [data errors]} (bindings->env env' ctx ext bindings)
|
#(and (vector? %) (#{for-block let-block} (first %)))
|
||||||
;; this can be moved to into bindings->env now
|
(fn [[x props children]]
|
||||||
|
[x (assoc props :prev-env new-env) children])
|
||||||
values (reduce-kv assoc-binding env' data)]
|
|
||||||
(walkup-upto-leaf #(replace-atom values %)
|
|
||||||
#(and (vector? %) (= let-block (first %)))
|
|
||||||
(fn [[_ props children]]
|
|
||||||
[let-block (assoc props :prev-env values) children])
|
|
||||||
children)))
|
children)))
|
||||||
|
|
||||||
(defn properties? [o]
|
(defn for-block [{:keys [wrapper-component prev-env bindings]} children]
|
||||||
(= 'properties o))
|
(let [[k v] bindings
|
||||||
|
for-values (resolve-rhs prev-env v)]
|
||||||
|
(when (sequential? for-values)
|
||||||
|
(into [wrapper-component {}]
|
||||||
|
(for [val for-values]
|
||||||
|
(let-block {:prev-env prev-env :bindings [k val]}
|
||||||
|
children))))))
|
||||||
|
|
||||||
(defn static-value? [v]
|
(defn static-value? [v]
|
||||||
(or (utils/primitive? v) (map? v)))
|
(or (utils/primitive? v) (map? v)))
|
||||||
@ -84,47 +82,19 @@
|
|||||||
(and (or (symbol? k) (map? k))
|
(and (or (symbol? k) (map? k))
|
||||||
(or (symbol? v) (static-value? v) (query? v))))
|
(or (symbol? v) (static-value? v) (query? v))))
|
||||||
|
|
||||||
(defn- resolve-symbol [m s]
|
|
||||||
(if (and (symbol? s) (not= 'properties s))
|
|
||||||
(resolve-symbol m (get m s))
|
|
||||||
s))
|
|
||||||
|
|
||||||
(defn resolve-env
|
|
||||||
"Resolve key/value pairs, specifically:
|
|
||||||
* 'properties are kept as is
|
|
||||||
* symbol values are replaced by their respective values if already present in the let scope
|
|
||||||
* queries (defined as vectors) are replaced by atoms
|
|
||||||
|
|
||||||
Returns a map of:
|
|
||||||
* :data the resolved values
|
|
||||||
* :errors the errors"
|
|
||||||
[ctx ext {:keys [data] :as m} k v]
|
|
||||||
;; TODO Do not duplicate checks
|
|
||||||
(if (valid-bindings? k v)
|
|
||||||
(cond
|
|
||||||
(properties? v) (assoc-in m [:data 'properties] k)
|
|
||||||
(static-value? v)
|
|
||||||
(if (map? k)
|
|
||||||
(if-let [o (destructuring/destructure k v)]
|
|
||||||
(errors/merge-results m o)
|
|
||||||
{:errors [(errors/error ::errors/invalid-destructuring-format [k v])]})
|
|
||||||
(assoc-in m [:data k] v))
|
|
||||||
(query? v)
|
|
||||||
(let [{:keys [data errors]} (types/resolve ctx ext :query v)]
|
|
||||||
(errors/merge-errors (assoc-in m [:data k] data) errors)))
|
|
||||||
{:errors [(errors/error ::errors/invalid-bindings [k v])]}))
|
|
||||||
|
|
||||||
(defn- valid-bindings-form? [bindings]
|
(defn- valid-bindings-form? [bindings]
|
||||||
(even? (count bindings)))
|
(even? (count bindings)))
|
||||||
|
|
||||||
;; errors are a problem here we shouldn't be returning data errors anymore
|
(defn resolve-and-validate-queries [ctx ext bindings]
|
||||||
(defn bindings->env [prev-env ctx ext bindings]
|
(reduce (fn [accum [k v]]
|
||||||
(doall
|
(if (vector? v)
|
||||||
(reduce (fn [accum [k v]]
|
(let [{:keys [data errors]} (types/resolve ctx ext :query v)]
|
||||||
(resolve-env ctx ext accum k
|
(if (not-empty errors)
|
||||||
(resolve-symbol (:data accum) v)))
|
(update accum :errors concat errors)
|
||||||
{:data prev-env}
|
(update accum :data concat [k data])))
|
||||||
(partition 2 bindings))))
|
(update accum :data concat [k v])))
|
||||||
|
{:data []}
|
||||||
|
(partition 2 bindings)))
|
||||||
|
|
||||||
;; we also need a set of available symbols bound at this point
|
;; we also need a set of available symbols bound at this point
|
||||||
(defn validate-bindings [bindings]
|
(defn validate-bindings [bindings]
|
||||||
@ -139,31 +109,39 @@
|
|||||||
(map first)
|
(map first)
|
||||||
(filter (some-fn sequential? map?))
|
(filter (some-fn sequential? map?))
|
||||||
(mapcat destructuring/validate-destructure-bindings)))))
|
(mapcat destructuring/validate-destructure-bindings)))))
|
||||||
|
|
||||||
[(errors/error ::errors/invalid-bindings-format bindings)]))
|
[(errors/error ::errors/invalid-bindings-format bindings)]))
|
||||||
|
|
||||||
;; shouldn't need to do this really should inject props
|
|
||||||
;; into the initial map from the top
|
|
||||||
(defn prop-env-from-bindings [bindings]
|
|
||||||
(some->> bindings
|
|
||||||
(partition 2)
|
|
||||||
(filter #(= (second %) 'properties))
|
|
||||||
first
|
|
||||||
reverse
|
|
||||||
(apply hash-map)))
|
|
||||||
|
|
||||||
(defmethod parse 'let [ctx ext [_ bindings & body]]
|
(defmethod parse 'let [ctx ext [_ bindings & body]]
|
||||||
(if-let [errors (validate-bindings bindings)]
|
;; TODO fail if some symbol are not defined in the env
|
||||||
{:errors errors}
|
(if (not= 1 (count body))
|
||||||
;; TODO fail if some symbol are not defined in the env
|
{:errors [(errors/error ::errors/invalid-let-body {:value body})]}
|
||||||
(if (= 1 (count body))
|
(let [binding-errors (validate-bindings bindings)]
|
||||||
(let [prop-env (prop-env-from-bindings bindings)]
|
(if (not-empty binding-errors)
|
||||||
{:data [let-block (cond-> {:ctx ctx
|
{:errors binding-errors}
|
||||||
:ext ext
|
(let [{:keys [errors data]} (resolve-and-validate-queries ctx ext bindings)]
|
||||||
:bindings bindings}
|
(if (not-empty errors)
|
||||||
prop-env (assoc :env prop-env))
|
{:errors errors}
|
||||||
(last body)]})
|
{:data [let-block {:bindings data} (last body)]}))))))
|
||||||
{:errors [(errors/error ::errors/invalid-let-body {:value body})]})))
|
|
||||||
|
(defmethod parse 'for [ctx ext [_ binding & body]]
|
||||||
|
(cond
|
||||||
|
(not= 1 (count body))
|
||||||
|
{:errors [(errors/error ::errors/invalid-for-body body)]}
|
||||||
|
(or (not= 2 (count binding))
|
||||||
|
(not ((some-fn symbol? map?) (first binding))))
|
||||||
|
{:errors [(errors/error ::errors/invalid-for-binding binding)]}
|
||||||
|
:else
|
||||||
|
(let [wrapper-component (get-in ctx [:capacities :components 'view :value])
|
||||||
|
{:keys [errors data] :as result} (resolve-and-validate-queries ctx ext binding)
|
||||||
|
errors (cond-> errors
|
||||||
|
(nil? wrapper-component)
|
||||||
|
(conj errors (errors/error ::errors/unknown-component 'wrapper-component)))]
|
||||||
|
(if (not-empty errors)
|
||||||
|
{:errors errors}
|
||||||
|
(let [binding' data]
|
||||||
|
{:data [for-block {:bindings data
|
||||||
|
:wrapper-component wrapper-component}
|
||||||
|
(last body)]})))))
|
||||||
|
|
||||||
(defn when-block [{:keys [test]} body]
|
(defn when-block [{:keys [test]} body]
|
||||||
(when test body))
|
(when test body))
|
||||||
|
@ -15,6 +15,8 @@
|
|||||||
::invalid-reference
|
::invalid-reference
|
||||||
::invalid-destructuring-format
|
::invalid-destructuring-format
|
||||||
::invalid-let-body
|
::invalid-let-body
|
||||||
|
::invalid-for-body
|
||||||
|
::invalid-for-binding
|
||||||
::invalid-bindings
|
::invalid-bindings
|
||||||
::invalid-bindings-format
|
::invalid-bindings-format
|
||||||
::missing-property
|
::missing-property
|
||||||
|
@ -132,24 +132,15 @@
|
|||||||
errors))
|
errors))
|
||||||
(parse-hiccup-element ctx ext o)))
|
(parse-hiccup-element ctx ext o)))
|
||||||
|
|
||||||
(defn- inject-properties [m properties]
|
|
||||||
(if-let [ps (get-in m [:env 'properties])]
|
|
||||||
(let [{:keys [data errors]} (destructuring/destructure ps properties)]
|
|
||||||
(errors/merge-errors
|
|
||||||
{:data
|
|
||||||
(-> m
|
|
||||||
(update :env dissoc 'properties)
|
|
||||||
(update :env merge data))}
|
|
||||||
errors))
|
|
||||||
{:data m}))
|
|
||||||
|
|
||||||
(defn- hiccup-with-properties [h properties]
|
(defn- hiccup-with-properties [h properties]
|
||||||
(if (vector? h)
|
(if (vector? h)
|
||||||
(let [[tag & properties-children] h
|
(let [[tag & properties-children] h
|
||||||
[props children] (resolve-properties-children properties-children)
|
[props children] (resolve-properties-children properties-children)
|
||||||
{:keys [data]} (when properties
|
;; really only need to add this to the first let block but no harm really
|
||||||
(inject-properties props properties))]
|
props (if (and properties (= tag blocks/let-block))
|
||||||
(apply conj (if data [tag data] [tag])
|
(assoc-in props [:prev-env :pluto.reader/properties] properties)
|
||||||
|
props)]
|
||||||
|
(apply conj (if props [tag props] [tag])
|
||||||
(map #(hiccup-with-properties % properties) children)))
|
(map #(hiccup-with-properties % properties) children)))
|
||||||
h))
|
h))
|
||||||
|
|
||||||
|
@ -3,25 +3,19 @@
|
|||||||
[pluto.reader :as reader]
|
[pluto.reader :as reader]
|
||||||
[pluto.reader.errors :as errors]
|
[pluto.reader.errors :as errors]
|
||||||
[pluto.reader.blocks :as blocks]
|
[pluto.reader.blocks :as blocks]
|
||||||
[re-frame.core :as re-frame]))
|
[re-frame.core :as re-frame])
|
||||||
|
#?(:cljs (:require-macros
|
||||||
(deftest bindings->env
|
[pluto.reader.block-test :refer [with-fetch-data]])))
|
||||||
(is (= {:data '{a 1}} (blocks/bindings->env {} {} {} '[a 1])))
|
|
||||||
(is (= (blocks/validate-bindings '[a 1 2])
|
|
||||||
[(errors/error ::errors/invalid-bindings-format '[a 1 2])]))
|
|
||||||
(is (= (blocks/validate-bindings [1 2])
|
|
||||||
[(errors/error ::errors/invalid-bindings [1 2])]))
|
|
||||||
(is (= {:data '{x 1}} (blocks/bindings->env {} {} {} '[{x :x} {:x 1}]))))
|
|
||||||
|
|
||||||
(deftest let-block
|
(deftest let-block
|
||||||
(testing "parse"
|
(testing "parse"
|
||||||
(is (= {:data [blocks/let-block '{:ctx {}, :ext {}, :bindings [s "Hello"]} 's]}
|
(is (= {:data [blocks/let-block '{:bindings [s "Hello"]} 's]}
|
||||||
(blocks/parse {} {} '(let [s "Hello"] s))))
|
(blocks/parse {} {} '(let [s "Hello"] s))))
|
||||||
(is (empty?
|
(is (empty?
|
||||||
(:errors (blocks/parse {:capacities {:queries {'aa {:value :a}}}} {} '(let [{a :a} [aa]] a)))))
|
(:errors (blocks/parse {:capacities {:queries {'aa {:value :a}}}} {} '(let [{a :a} [aa]] a)))))
|
||||||
|
|
||||||
(is (= {:data [blocks/let-block
|
(is (= {:data [blocks/let-block
|
||||||
'{:ctx {}, :ext {}, :bindings [{a :a} {:a {:b 1}} {b :b} a]}
|
'{:bindings [{a :a} {:a {:b 1}} {b :b} a]}
|
||||||
'b]}
|
'b]}
|
||||||
(blocks/parse {} {} '(let [{a :a} {:a {:b 1}} {b :b} a] b))))
|
(blocks/parse {} {} '(let [{a :a} {:a {:b 1}} {b :b} a] b))))
|
||||||
(is (empty?
|
(is (empty?
|
||||||
@ -29,7 +23,8 @@
|
|||||||
{:queries {'aa {:value :a :arguments {:x :string}}}}}
|
{:queries {'aa {:value :a :arguments {:x :string}}}}}
|
||||||
{}
|
{}
|
||||||
'(let [x 1 {a :a} [aa {:x x}]] a)))))
|
'(let [x 1 {a :a} [aa {:x x}]] a)))))
|
||||||
(is (= {:data [blocks/let-block '{:ctx {}, :ext {}, :bindings [s "Hello"]}
|
|
||||||
|
(is (= {:data [blocks/let-block '{:bindings [s "Hello"]}
|
||||||
['test {} 's]]}
|
['test {} 's]]}
|
||||||
(blocks/parse {} {} (list 'let ['s "Hello"] ['test {} 's]))))
|
(blocks/parse {} {} (list 'let ['s "Hello"] ['test {} 's]))))
|
||||||
(is (= (blocks/validate-bindings '[s "Hello" 1])
|
(is (= (blocks/validate-bindings '[s "Hello" 1])
|
||||||
@ -41,7 +36,7 @@
|
|||||||
(is (= {:errors [(errors/error ::errors/invalid-bindings-format ['s "Hello" 1])]}
|
(is (= {:errors [(errors/error ::errors/invalid-bindings-format ['s "Hello" 1])]}
|
||||||
(blocks/parse {} {} (list 'let ['s "Hello" 1] ['test {} 's]))))
|
(blocks/parse {} {} (list 'let ['s "Hello" 1] ['test {} 's]))))
|
||||||
|
|
||||||
(is (= {:data [blocks/let-block '{:ctx {}, :ext {}, :bindings [{a :a} {:a 1}]}
|
(is (= {:data [blocks/let-block '{:bindings [{a :a} {:a 1}]}
|
||||||
'[test {} a]]}
|
'[test {} a]]}
|
||||||
(blocks/parse {} {} '(let [{a :a} {:a 1}] [test {} a]))))
|
(blocks/parse {} {} '(let [{a :a} {:a 1}] [test {} a]))))
|
||||||
|
|
||||||
@ -67,6 +62,50 @@
|
|||||||
(is (= (first-error-type (blocks/parse {} {} '(when asdf)))
|
(is (= (first-error-type (blocks/parse {} {} '(when asdf)))
|
||||||
:pluto.reader.errors/invalid-when-block)))
|
:pluto.reader.errors/invalid-when-block)))
|
||||||
|
|
||||||
|
(declare let-test-capacities)
|
||||||
|
|
||||||
|
(deftest resolve-bindings
|
||||||
|
(is (= '{a "asdf"
|
||||||
|
b "asdf"}
|
||||||
|
(blocks/resolve-binding '{a "asdf"} 'b 'a)))
|
||||||
|
(is (= '{a {:asdf "foo"}, asdf "foo"}
|
||||||
|
(blocks/resolve-binding '{a {:asdf "foo"}} '{asdf :asdf} 'a)))
|
||||||
|
(is (= '{:pluto.reader/properties {:asdf "foo"}, asdf "foo"}
|
||||||
|
(blocks/resolve-binding
|
||||||
|
'{:pluto.reader/properties {:asdf "foo"}} '{asdf :asdf} 'properties)))
|
||||||
|
(is (= "asdfg"
|
||||||
|
(blocks/resolve-rhs {} '[::identity-query {:x "asdfg"}])))
|
||||||
|
|
||||||
|
(is (= "asdfg"
|
||||||
|
(blocks/resolve-rhs '{a "asdfg"} '[::identity-query {:x a}])))
|
||||||
|
|
||||||
|
(is (= '{a "asdf", b "asdf", c "asdf" :hey 1}
|
||||||
|
(blocks/resolve-bindings-into {:hey 1} '[a "asdf" b a c b])))
|
||||||
|
|
||||||
|
|
||||||
|
)
|
||||||
|
|
||||||
|
(deftest resolve-and-validate-queries
|
||||||
|
(is (= {:data
|
||||||
|
'[a [:pluto.reader.block-test/identity-query {:x "asdf"}]
|
||||||
|
g "asdf"
|
||||||
|
b [:pluto.reader.block-test/identity-map {:x "asdf"}]]}
|
||||||
|
|
||||||
|
(blocks/resolve-and-validate-queries
|
||||||
|
{:capacities let-test-capacities} {}
|
||||||
|
'[a [identity-query {:x "asdf"}]
|
||||||
|
g "asdf"
|
||||||
|
b [identity-map {:x "asdf"}]])))
|
||||||
|
|
||||||
|
(is (not-empty (:errors (blocks/resolve-and-validate-queries
|
||||||
|
{:capacities let-test-capacities} {}
|
||||||
|
'[a [identity-querye {:x "asdf"}]]))))
|
||||||
|
|
||||||
|
(is (empty? (:errors (blocks/resolve-and-validate-queries
|
||||||
|
{:capacities let-test-capacities} {}
|
||||||
|
'[a [identity-query {:x a}]]))))
|
||||||
|
|
||||||
|
)
|
||||||
|
|
||||||
;; The following is all set up so that we can fake "render" the blocks
|
;; The following is all set up so that we can fake "render" the blocks
|
||||||
;; in the resulting view tree
|
;; in the resulting view tree
|
||||||
@ -80,9 +119,26 @@
|
|||||||
(re-frame/reg-sub ::identity-query
|
(re-frame/reg-sub ::identity-query
|
||||||
(fn [db [_ {:keys [x]}]] x))
|
(fn [db [_ {:keys [x]}]] x))
|
||||||
|
|
||||||
|
(re-frame/reg-sub ::bool-query
|
||||||
|
(fn [db [_ {:keys [x]}]] (= x "true")))
|
||||||
|
|
||||||
|
(re-frame/reg-sub ::array-query
|
||||||
|
(fn [db [_ {:keys [x y]}]] (cond-> []
|
||||||
|
x (conj x)
|
||||||
|
y (conj y))))
|
||||||
|
|
||||||
(re-frame/reg-sub ::identity-map
|
(re-frame/reg-sub ::identity-map
|
||||||
(fn [db [_ {:keys [x]}]] {:asdf x}))
|
(fn [db [_ {:keys [x]}]] {:asdf x}))
|
||||||
|
|
||||||
|
(def fetch-data (atom {}))
|
||||||
|
|
||||||
|
(re-frame/reg-sub ::fetch-data
|
||||||
|
(fn [db [_ {:keys [id]}]] (get @fetch-data id)))
|
||||||
|
|
||||||
|
#?(:clj (defmacro with-fetch-data [data & body]
|
||||||
|
`(do (swap! fetch-data merge ~data)
|
||||||
|
~@body)))
|
||||||
|
|
||||||
(def let-test-capacities
|
(def let-test-capacities
|
||||||
{:components {'view {:properties {}
|
{:components {'view {:properties {}
|
||||||
:value view-component}
|
:value view-component}
|
||||||
@ -91,7 +147,10 @@
|
|||||||
'text {:properties {}
|
'text {:properties {}
|
||||||
:value text-component}}
|
:value text-component}}
|
||||||
:queries '{identity-query {:value ::identity-query :arguments {:x :string}}
|
:queries '{identity-query {:value ::identity-query :arguments {:x :string}}
|
||||||
identity-map {:value ::identity-map :arguments {:x :string}}}
|
identity-map {:value ::identity-map :arguments {:x :string}}
|
||||||
|
bool-query {:value ::bool-query :arguments {:x :string}}
|
||||||
|
fetch-data {:value ::fetch-data :arguments {:id :string}}
|
||||||
|
array-query {:value ::array-query :arguments {:x :string :y :string}}}
|
||||||
:events {'alert
|
:events {'alert
|
||||||
{:value :alert}}
|
{:value :alert}}
|
||||||
:hooks {:main
|
:hooks {:main
|
||||||
@ -109,23 +168,36 @@
|
|||||||
(-> (reader/parse {:capacities let-test-capacities} extention)
|
(-> (reader/parse {:capacities let-test-capacities} extention)
|
||||||
exec))
|
exec))
|
||||||
|
|
||||||
(defn simple-render-tree-blocks [[x & xs]]
|
(defn valid-input [val]
|
||||||
|
(or (seq? val)
|
||||||
|
(nil? val)
|
||||||
|
(map? val)
|
||||||
|
(vector? val)
|
||||||
|
(symbol? val)
|
||||||
|
(string? val)
|
||||||
|
(number? val)))
|
||||||
|
|
||||||
|
; vector-tag | list-of-vector-tags => list-of-vector-tags
|
||||||
|
(defn simple-render-tree-blocks [current]
|
||||||
|
{:pre [(valid-input current)]
|
||||||
|
:post [(or (seq? %) (nil? %))]}
|
||||||
(cond
|
(cond
|
||||||
(and (fn? x) (#{pluto.reader.blocks/if-block
|
(seq? current)
|
||||||
pluto.reader.blocks/when-block
|
(mapcat simple-render-tree-blocks current)
|
||||||
pluto.reader.blocks/let-block} x))
|
(vector? current)
|
||||||
(let [new-tree (apply x xs)]
|
(let [[x & xs] current]
|
||||||
(if (sequential? new-tree)
|
(cond
|
||||||
(simple-render-tree-blocks new-tree)
|
(and (fn? x) (#{pluto.reader.blocks/if-block
|
||||||
new-tree))
|
pluto.reader.blocks/when-block
|
||||||
:else
|
pluto.reader.blocks/let-block
|
||||||
(apply
|
pluto.reader.blocks/for-block
|
||||||
vector
|
} x))
|
||||||
x
|
(let [new-tree (apply x xs)]
|
||||||
(map #(if (sequential? %)
|
(simple-render-tree-blocks new-tree))
|
||||||
(simple-render-tree-blocks %)
|
:else
|
||||||
%)
|
(list (apply vector x (mapcat simple-render-tree-blocks xs)))))
|
||||||
xs))))
|
(nil? current) current
|
||||||
|
:else (list current)))
|
||||||
|
|
||||||
(defn blocks-render [block-syn]
|
(defn blocks-render [block-syn]
|
||||||
(let [{:keys [execed errors] :as res}
|
(let [{:keys [execed errors] :as res}
|
||||||
@ -147,116 +219,176 @@
|
|||||||
|
|
||||||
(deftest if-when-block-rendering
|
(deftest if-when-block-rendering
|
||||||
;; need to set up a query to have a false value?
|
;; need to set up a query to have a false value?
|
||||||
(is (= [view-component "true"]
|
(is (= [[view-component "true"]]
|
||||||
(blocks-render '(let [a "asdf"]
|
(blocks-render '(let [a "asdf"]
|
||||||
(if a
|
(if a
|
||||||
[view "true"]
|
[view "true"]
|
||||||
[view "false"])))))
|
[view "false"])))))
|
||||||
|
|
||||||
(is (= [view-component "false"]
|
(is (= [[view-component "false"]]
|
||||||
(blocks-render '(let [a [identity-query {:x false}]]
|
(blocks-render '(let [a [bool-query {:x "false"}]]
|
||||||
(if a
|
(if a
|
||||||
[view "true"]
|
[view "true"]
|
||||||
[view "false"])))))
|
[view "false"])))))
|
||||||
(is (= [view-component "true"]
|
|
||||||
|
(is (= [[view-component "true"]]
|
||||||
|
(blocks-render '(let [a [bool-query {:x "true"}]]
|
||||||
|
(if a
|
||||||
|
[view "true"]
|
||||||
|
[view "false"])))))
|
||||||
|
|
||||||
|
(is (= [[view-component "true"]]
|
||||||
(blocks-render '(let [a "asdf"]
|
(blocks-render '(let [a "asdf"]
|
||||||
(when a [view "true"])))))
|
(when a [view "true"])))))
|
||||||
|
|
||||||
(is (= [view-component nil]
|
(is (= [[view-component]]
|
||||||
(blocks-render '(let [a [identity-query {:x false}]]
|
(blocks-render '(let [a [bool-query {:x "false"}]]
|
||||||
[view (when a [view "true"])]))))
|
[view (when a [view "true"])]))))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(deftest basic-let-block-replacement []
|
(deftest basic-let-block-replacement []
|
||||||
(is (= [view-component "hello"]
|
(is (= [[view-component "hello"]]
|
||||||
(blocks-render '(let [a "hello"]
|
(blocks-render '(let [a "hello"]
|
||||||
[view a]))))
|
[view a]))))
|
||||||
(is (= [view-component "hello" "jenny"
|
|
||||||
[text-component "jenny" "hello"]
|
(is (= [[view-component "hello" "jenny"
|
||||||
[text-component "hello" "darlene"]]
|
[text-component "jenny" "hello"]
|
||||||
|
[text-component "hello" "darlene"]]]
|
||||||
(blocks-render '(let [a "hello"
|
(blocks-render '(let [a "hello"
|
||||||
b "jenny"
|
b "jenny"
|
||||||
c "darlene"]
|
c "darlene"]
|
||||||
[view a b
|
[view a b
|
||||||
[text b a]
|
[text b a]
|
||||||
[text a c]]))))
|
[text a c]]))))
|
||||||
(is (= [view-component "john"]
|
(is (= [[view-component "john"]]
|
||||||
(blocks-render '(let [a "john"
|
(blocks-render '(let [a "john"
|
||||||
b a]
|
b a]
|
||||||
[view b]))))
|
[view b]))))
|
||||||
(is (= [view-component "john"]
|
(is (= [[view-component "john"]]
|
||||||
(blocks-render '(let [a "john"
|
(blocks-render '(let [a "john"
|
||||||
b a]
|
b a]
|
||||||
[view b]))))
|
[view b]))))
|
||||||
(is (= [view-component "john"]
|
(is (= [[view-component "john"]]
|
||||||
(blocks-render '(let [a "john"]
|
(blocks-render '(let [a "john"]
|
||||||
(let [b a]
|
(let [b a]
|
||||||
[view b])))))
|
[view b])))))
|
||||||
(is (= [view-component "john"]
|
(is (= [[view-component "john"]]
|
||||||
(blocks-render '(let [a "john"
|
(blocks-render '(let [a "john"
|
||||||
dd a]
|
dd a]
|
||||||
(let [b a
|
(let [b a
|
||||||
c b]
|
c b]
|
||||||
[view b]))))))
|
[view b])))))
|
||||||
|
)
|
||||||
|
|
||||||
(deftest let-blocks-with-properties
|
(deftest let-blocks-with-properties
|
||||||
(is (= [view-component "test-name-prop"]
|
(is (= [[view-component "test-name-prop"]]
|
||||||
(blocks-render '(let [{name :name} properties]
|
(blocks-render '(let [{name :name} properties]
|
||||||
[view name]))))
|
[view name]))))
|
||||||
|
|
||||||
(is (= [view-component "test-name-prop"]
|
(is (= [[view-component "test-name-prop"]]
|
||||||
(blocks-render '(let [{name :name} properties
|
(blocks-render '(let [{name :name} properties
|
||||||
b name]
|
b name]
|
||||||
[view b]))))
|
[view b]))))
|
||||||
|
|
||||||
(is (= [view-component "jolly"]
|
(is (= [[view-component "jolly"]]
|
||||||
(blocks-render '(let [{name :name} properties
|
(blocks-render '(let [{name :name} properties
|
||||||
b name]
|
b name]
|
||||||
(let [name "jolly"]
|
(let [name "jolly"]
|
||||||
[view name])))))
|
[view name])))))
|
||||||
|
|
||||||
;; doesn't work and should work
|
(is (= [[view-component "test-name-prop"]]
|
||||||
;; this is caused by the way that properties are bound
|
(blocks-render '(let [name "jolly"
|
||||||
;; seperately
|
{name :name} properties]
|
||||||
#_(is (= [view-component "test-name-prop"]
|
[view name]))))
|
||||||
(blocks-render '(let [name "jolly"
|
|
||||||
{name :name} properties]
|
|
||||||
[view name]))
|
|
||||||
))
|
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(deftest let-blocks-with-queries
|
(deftest let-blocks-with-queries
|
||||||
(is (= [view-component "a temp"]
|
(is (= [[view-component "a temp"]]
|
||||||
(blocks-render '(let [temp [identity-query {:x "a temp"}]]
|
(blocks-render '(let [temp [identity-query {:x "a temp"}]]
|
||||||
[view temp]))))
|
[view temp]))))
|
||||||
|
|
||||||
(is (= [view-component "a temp" "a temp"]
|
(is (= [[view-component "a temp" "a temp"]]
|
||||||
(blocks-render '(let [a "a temp"
|
(blocks-render '(let [a "a temp"
|
||||||
temp [identity-query {:x a}]]
|
temp [identity-query {:x a}]]
|
||||||
[view a temp]))))
|
[view a temp]))))
|
||||||
|
|
||||||
(is (= [view-component "a temp" "charmed"]
|
(is (= [[view-component "a temp" "charmed"]]
|
||||||
(blocks-render '(let [a "a temp"
|
(blocks-render '(let [a "a temp"
|
||||||
{asdf :asdf} [identity-map {:x "charmed"}]]
|
{asdf :asdf} [identity-map {:x "charmed"}]]
|
||||||
[view a asdf]))))
|
[view a asdf]))))
|
||||||
|
|
||||||
|
|
||||||
;; this should work as well but ...
|
(is (= [[view-component "a temp" "a temp"]]
|
||||||
#_(is (= [view-component "a temp" "a temp"]
|
(blocks-render '(let [a "a temp"
|
||||||
(blocks-render '(let [a "a temp"
|
temp [identity-query {:x a}]
|
||||||
temp [identity-query {:x a}]
|
|
||||||
ouch temp]
|
ouch temp]
|
||||||
[view temp ouch]))
|
[view temp ouch]))))
|
||||||
|
|
||||||
))
|
|
||||||
|
|
||||||
(is (= [view-component "a temp" "a temp"]
|
(is (= [[view-component "a temp" "a temp"]]
|
||||||
(blocks-render '(let [a "a temp"
|
(blocks-render '(let [a "a temp"
|
||||||
temp [identity-query {:x a}]]
|
temp [identity-query {:x a}]]
|
||||||
(let [ouch temp]
|
(let [ouch temp]
|
||||||
[view temp ouch])))))
|
[view temp ouch])))))
|
||||||
|
|
||||||
|
(is (= [[view-component "hello"]]
|
||||||
|
(with-fetch-data {"data-id" {:foo "hello"}}
|
||||||
|
(blocks-render '(let [{foo :foo} [fetch-data {:id "data-id"}]]
|
||||||
|
[view foo])))))
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
|
(deftest for-block-parse
|
||||||
|
(is (= {:data
|
||||||
|
[blocks/for-block
|
||||||
|
{:bindings '(a [:pluto.reader.block-test/identity-query {:x a}])
|
||||||
|
:wrapper-component view-component}
|
||||||
|
'asdf]}
|
||||||
|
(blocks/parse {:capacities let-test-capacities} {}
|
||||||
|
'[for [a [identity-query {:x a}]] asdf]))
|
||||||
|
))
|
||||||
|
|
||||||
|
(deftest for-blocks
|
||||||
|
(is (= [[view-component {} [view-component "foo"] [view-component "bar"]]]
|
||||||
|
(blocks-render '(for [a [array-query {:x "foo" :y "bar"}]]
|
||||||
|
[view a]))))
|
||||||
|
|
||||||
|
(is (= [[view-component {} [view-component "foo"] [view-component "bar"]]]
|
||||||
|
(blocks-render '(let [b "bar"]
|
||||||
|
(for [a [array-query {:x "foo" :y b}]]
|
||||||
|
[view a])))))
|
||||||
|
|
||||||
|
(is (= [[view-component {} [view-component "foo"] [view-component "bar"]]]
|
||||||
|
(blocks-render '(let [b "bar"
|
||||||
|
c [array-query {:x "foo" :y b}]]
|
||||||
|
(for [a c]
|
||||||
|
[view a])))))
|
||||||
|
|
||||||
|
(is (= [[view-component {} [view-component "foo"] [view-component "bar"]]]
|
||||||
|
(blocks-render '(for [a [array-query {:x "foo" :y "bar"}]]
|
||||||
|
(let [b a]
|
||||||
|
[view b])))))
|
||||||
|
|
||||||
|
(with-fetch-data {"for-blocks-data" [{:name "Jane"} {:name "John"} {:name "Sue"}]}
|
||||||
|
|
||||||
|
(is (= [[view-component {}
|
||||||
|
[view-component "Jane"]
|
||||||
|
[view-component "John"]
|
||||||
|
[view-component "Sue"]]]
|
||||||
|
(blocks-render
|
||||||
|
'(for [{name :name} [fetch-data {:id "for-blocks-data"}]]
|
||||||
|
[view name]))))
|
||||||
|
|
||||||
|
(is (= [[view-component {}
|
||||||
|
[view-component "Jane"]
|
||||||
|
[view-component "John"]
|
||||||
|
[view-component "Sue"]]]
|
||||||
|
(blocks-render '(for [{name :name} [fetch-data {:id "for-blocks-data"}]]
|
||||||
|
(let [b name]
|
||||||
|
[view b])))))
|
||||||
|
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
)
|
||||||
|
@ -62,12 +62,8 @@
|
|||||||
|
|
||||||
(deftest parse-blocks
|
(deftest parse-blocks
|
||||||
(is (= [blocks/let-block
|
(is (= [blocks/let-block
|
||||||
'{:bindings [s "Hello"],
|
'{:bindings [s "Hello"]
|
||||||
:ctx {:capacities {:components {text :text, view :view},
|
:prev-env {:pluto.reader/properties {}}}
|
||||||
:hooks {:main {:properties {:view :view}}}}},
|
|
||||||
:ext {meta {:description "", :documentation "", :name ""},
|
|
||||||
hooks/main.a {:view [views/main]},
|
|
||||||
views/main (let [s "Hello"] [text {} s])}}
|
|
||||||
'[text {} s]]
|
'[text {} s]]
|
||||||
(view (reader/parse default-capacities
|
(view (reader/parse default-capacities
|
||||||
(extension {'views/main (list 'let ['s "Hello"] ['text {} 's])
|
(extension {'views/main (list 'let ['s "Hello"] ['text {} 's])
|
||||||
|
Loading…
x
Reference in New Issue
Block a user