fix let block scoping

Signed-off-by: Julien Eluard <julien.eluard@gmail.com>
2025-02-24 00:18:16 +00:00 · 2018-10-17 07:16:38 -04:00 · 2018-10-17 07:16:38 -04:00 · 3de4566223
commit 3de4566223
parent d962fae9eb
5 changed files with 332 additions and 34 deletions
--- a/.gitignore
+++ b/.gitignore
@ -14,4 +14,5 @@ resources/public/js/
 website/build/
 website/static/js/
 website/static/extensions/
-\.\#*
+\.\#*
+.nrepl-port
--- a/src/pluto/reader/blocks.cljc
+++ b/src/pluto/reader/blocks.cljc
@ -24,14 +24,23 @@
    ;; TODO handle errors
    (:data (destructuring/destructure k v))))

+(defn substitute-query-values [m v]
+  (if (vector? v)
+    (walk/prewalk #(or (get m %) %) v)
+    v))
+
 (defn assoc-binding
  [m k v]
-  (let [resolved-value (resolve-binding-value v)
+  (let [resolved-value (resolve-binding-value
+                        (substitute-query-values m v))
        o (resolve-binding-key k resolved-value)]
    (if (symbol? o)
      (assoc m o resolved-value)
      (merge m o))))

+(defn interpolate [values s]
+  (reduce-kv #(string/replace %1 (str "${" (str %2) "}") (str %3)) s values))
+
 (defn replace-atom [values o]
  (cond (contains? values o) (get values o)
        (symbol? o) nil
@ -39,10 +48,31 @@
        (and (fn? o) (= :event (meta o))) #(o % values) ;; Intercept events and inject the env. TODO remove this hack
        :else o))

-(defn let-block [{:keys [env]} children]
-  ;; TODO nested let block should accumulate the env
-  (let [values (reduce-kv assoc-binding {} env)]
-    (walk/prewalk #(replace-atom values %) children)))
+(defn walkup-upto-leaf [f lp? lf tree]
+  (if (lp? tree)
+    (lf tree)
+    (let [res (f tree)
+          f2 (partial walkup-upto-leaf f lp? lf)]
+      (cond (list? res) (apply list (map f2 res))
+            (map-entry? res) (vec (map f2 res))
+            (seq? res) (doall (map f2 res))
+            (coll? res) (into (empty res) (map f2 res))
+            :else res))))
+
+(declare let-block bindings->env)
+
+(defn let-block [{:keys [prev-env ctx ext bindings env]} children]
+  ;; env here is always a destructured set of properties
+  (let [env' (merge env prev-env)
+        {:keys [data errors]} (bindings->env env' ctx ext bindings)
+        ;; this can be moved to into bindings->env now
+        
+        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)))

 (defn properties? [o]
  (= 'properties o))
@ -55,7 +85,7 @@

 (defn valid-bindings? [k v]
  (and (or (symbol? k) (map? k))
-       (or (symbol? v) (static-value? v) (query? v) (query? v))))
+       (or (symbol? v) (static-value? v) (query? v))))

 (defn- resolve-symbol [m s]
  (if (and (symbol? s) (not= 'properties s))
@ -90,18 +120,52 @@
 (defn- valid-bindings-form? [bindings]
  (even? (count bindings)))

-(defn bindings->env [ctx ext bindings]
+;; errors are a problem here we shouldn't be returning data errors anymore
+(defn bindings->env [prev-env ctx ext bindings]
+  (doall
+   (reduce (fn [accum [k v]]
+             (resolve-env ctx ext accum k
+                          (resolve-symbol (:data accum) v)))
+           {:data prev-env}
+           (partition 2 bindings))))
+
+;; we also need a set of available symbols bound at this point
+(defn validate-bindings [bindings]
  (if (valid-bindings-form? bindings)
-    (reduce-kv #(resolve-env ctx ext %1 %2 (resolve-symbol (:data %1) %3)) {} (apply hash-map bindings))
-    {:errors [(errors/error ::errors/invalid-bindings-format bindings)]}))
+    (not-empty
+     (let [binding-pairs (partition 2 bindings)]
+       (concat
+        (->> binding-pairs
+             (filter #(not (apply valid-bindings? %)))
+             (mapv #(errors/error ::errors/invalid-bindings %)))
+        (->> binding-pairs
+             (map first)
+             (filter (some-fn sequential? map?))
+             (mapcat destructuring/validate-destructure-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]]
-  (let [{:keys [data errors] :as m} (bindings->env ctx ext bindings)]
+  (if-let [errors (validate-bindings bindings)]
+    {:errors errors}
    ;; TODO fail if some symbol are not defined in the env
    (if (= 1 (count body))
-      (merge {:data [let-block {:env data} (last body)]}
-             (when errors
-               {:errors errors}))
+      (let [prop-env (prop-env-from-bindings bindings)]
+        {:data [let-block (cond-> {:ctx ctx
+                                 :ext ext
+                                 :bindings bindings}
+                            prop-env (assoc :env prop-env))
+              (last body)]})
      {:errors [(errors/error ::errors/invalid-let-body {:value body})]})))

 (defn when-block [{:keys [test]} body]
--- a/src/pluto/reader/destructuring.cljc
+++ b/src/pluto/reader/destructuring.cljc
@ -53,6 +53,23 @@
    (reduce-kv #(merge-assoc-bindings s %1 %2 %3) {} bindings)
    {:errors [(errors/error ::errors/invalid-destructuring-format {:type :assoc :data bindings})]}))

+;; recursively validate destructure bindings form
+(defn validate-destructure-bindings [bindings]
+  (not-empty
+   (cond
+    (map? bindings)
+    (if (valid-assoc-format? bindings)
+      (mapcat
+       validate-destructure-bindings
+       (filter (some-fn sequential? map?) (keys bindings)))
+      [(errors/error ::errors/invalid-destructuring-format {:type :assoc :data bindings})])
+    (sequential? bindings)
+    (if (every? valid-bindings-form? bindings)
+      (mapcat
+       validate-destructure-bindings
+       (filter (some-fn sequential? map?) bindings))
+      [(errors/error ::errors/invalid-destructuring-format {:type :assoc :data bindings})]))))
+
 (defn destructure
  "Given a pattern and an associated data structure, return a map of either:
   * :data, a map of extracted symbol / value pairs
--- a/test/pluto/reader/block_test.cljc
+++ b/test/pluto/reader/block_test.cljc
@ -1,39 +1,54 @@
 (ns pluto.reader.block-test
  (:require [clojure.test :refer [is deftest testing]]
+            [pluto.reader :as reader]            
            [pluto.reader.errors :as errors]
-            [pluto.reader.blocks :as blocks]))
+            [pluto.reader.blocks :as blocks]
+            [re-frame.core :as re-frame]))

 (deftest bindings->env
-  (is (= {:data '{a 1}} (blocks/bindings->env {} {} '[a 1])))
-  (is (= {:errors [(errors/error ::errors/invalid-bindings-format '[a 1 2])]}
-         (blocks/bindings->env {} {} '[a 1 2])))
-  (is (= {:errors [(errors/error ::errors/invalid-bindings '[1 2])]}
-         (blocks/bindings->env {} {} '[1 2])))
-  (is (= {:data '{x 1}} (blocks/bindings->env {} {} '[{x :x} {:x 1}]))))
+  (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
  (testing "parse"
-    (is (= {:data [blocks/let-block {:env {'s "Hello"}} 's]}
+    (is (= {:data [blocks/let-block '{:ctx {}, :ext {}, :bindings [s "Hello"]} 's]}
           (blocks/parse {} {} '(let [s "Hello"] s))))
    (is (empty?
          (:errors (blocks/parse {:capacities {:queries {'aa {:value :a}}}} {} '(let [{a :a} [aa]] a)))))

-    (is (= {:data [blocks/let-block {:env '{a {:b 1} b 1}} 'b]}
+    (is (= {:data [blocks/let-block
+                   '{:ctx {}, :ext {}, :bindings [{a :a} {:a {:b 1}} {b :b} a]}
+                   'b]}
           (blocks/parse {} {} '(let [{a :a} {:a {:b 1}} {b :b} a] b))))
    (is (empty?
-           (:errors (blocks/parse {:capacities {:queries {'aa {:value :a :arguments {:x :string}}}}} {} '(let [x 1 {a :a} [aa {:x x}]] a)))))
-
-    (is (= {:data [blocks/let-block {:env {'s "Hello"}} ['test {} 's]]}
+         (:errors (blocks/parse {:capacities
+                                 {:queries {'aa {:value :a :arguments {:x :string}}}}}
+                                {}
+                                '(let [x 1 {a :a} [aa {:x x}]] a)))))
+    (is (= {:data [blocks/let-block '{:ctx {}, :ext {}, :bindings [s "Hello"]}
+                   ['test {} 's]]}
           (blocks/parse {} {} (list 'let ['s "Hello"] ['test {} 's]))))
-    (is (= {:data [blocks/let-block {:env nil}
-                   ['test {} 's]]
-            :errors [(errors/error ::errors/invalid-bindings-format ['s "Hello" 1])]}
-           (blocks/parse {} {} (list 'let ['s "Hello" 1] ['test {} 's]))))
-    (is (= {:data [blocks/let-block {:env {'a 1}} ['test {} 'a]]}
-           (blocks/parse {} {} (list 'let ['{a :a} {:a 1}] ['test {} 'a]))))))
+    (is (= (blocks/validate-bindings '[s "Hello" 1])
+           [(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]))))
+  
+  (is (= {:data [blocks/let-block '{:ctx {}, :ext {}, :bindings [{a :a} {:a 1}]}
+                 '[test {} a]]}
+         (blocks/parse {} {} '(let [{a :a} {:a 1}] [test {} a]))))
+
+)

 (deftest let-block-resolution
-  (is (= [identity {} 1] (blocks/let-block {:env {'a 1}} [identity {} 'a])))
+  (is (= [identity {} 1] (blocks/let-block {:bindings '[a 1] } [identity {} 'a])))
  #_
  (is (= ['test {} 1] (blocks/let-block {:env '{{a :a} [:aa]}} '[test {} a]))))

@ -51,3 +66,197 @@
         :pluto.reader.errors/invalid-when-block))
  (is (= (first-error-type (blocks/parse {} {} '(when asdf)))
         :pluto.reader.errors/invalid-when-block)))
+
+
+;; The following is all set up so that we can fake "render" the blocks
+;; in the resulting view tree
+
+;; this will allow us to verify basic binding replacement behaviors of let blocks
+
+(defn view-component   [& args] [:view args])
+(defn text-component   [& args] [:text args])
+(defn button-component [& args] [:button args])
+
+(re-frame/reg-sub ::identity-query
+                  (fn [db [_ {:keys [x]}]] x))
+
+(re-frame/reg-sub ::identity-map
+                  (fn [db [_ {:keys [x]}]] {:asdf x}))
+
+(def let-test-capacities
+  {:components {'view   {:properties {}
+                         :value      view-component}
+                'button {:properties {:on-click :event}
+                         :value      button-component}
+                'text   {:properties {}
+                         :value      text-component}}
+   :queries '{identity-query {:value ::identity-query :arguments {:x :string}}
+              identity-map {:value ::identity-map :arguments {:x :string}}}
+   :events {'alert
+            {:value :alert}}
+   :hooks {:main
+           {:properties {:view :view}}}})
+
+(defn exec [parsed]
+  (cond-> parsed
+    (not (:errors parsed))
+    (assoc 
+     :execed
+     ((get-in parsed [:data :hooks :main :demo :parsed :view])
+      {:name "test-name-prop"}))))
+
+(defn test-parse [extention]
+  (-> (reader/parse {:capacities let-test-capacities} extention)
+      exec))
+
+(defn simple-render-tree-blocks [[x & xs]]
+  (cond
+    (and (fn? x) (#{pluto.reader.blocks/if-block
+                    pluto.reader.blocks/when-block
+                    pluto.reader.blocks/let-block} x))
+    (let [new-tree (apply x xs)]
+      (if (sequential? new-tree)
+        (simple-render-tree-blocks new-tree)
+        new-tree))
+    :else 
+    (apply
+     vector
+     x
+     (map #(if (sequential? %)
+             (simple-render-tree-blocks %)
+             %)
+          xs))))
+
+(defn blocks-render [block-syn]
+  (let [{:keys [execed errors] :as res}
+        (test-parse (-> '{meta
+                          {:name "Test Ext",
+                           :description "A test extension",
+                           :documentation "Nothing."},
+                          hooks/main.demo {:view [main]}}
+                        (assoc 'views/main block-syn)))]
+    ;; for dev time
+    #?(:clj
+       (when-not (nil? errors)
+         (clojure.pprint/pprint errors)
+         (assert (nil? errors))))
+    (when (and execed (sequential? execed))
+      (simple-render-tree-blocks execed))))
+
+;; end of rendering util to support tesing block rendering
+
+(deftest if-when-block-rendering
+  ;; need to set up a query to have a false value?
+  (is (= [view-component "true"]
+         (blocks-render '(let [a "asdf"]
+                           (if a
+                             [view "true"]
+                             [view "false"])))))
+  
+    (is (= [view-component "false"]
+           (blocks-render '(let [a [identity-query {:x false}]]
+                             (if a
+                               [view "true"]
+                               [view "false"])))))
+  (is (= [view-component "true"]
+         (blocks-render '(let [a "asdf"]
+                           (when a [view "true"])))))
+  
+  (is (= [view-component nil]
+         (blocks-render '(let [a [identity-query {:x false}]]
+                           [view (when a [view "true"])]))))
+  )
+
+(deftest basic-let-block-replacement []
+  (is (= [view-component "hello"]
+         (blocks-render '(let [a "hello"]
+                           [view a]))))
+  (is (= [view-component "hello" "jenny"
+          [text-component "jenny" "hello"]
+          [text-component "hello" "darlene"]]
+         (blocks-render '(let [a "hello"
+                               b "jenny"
+                               c "darlene"]
+                           [view a b
+                            [text b a]
+                            [text a c]]))))
+  (is (= [view-component "john"]
+         (blocks-render '(let [a "john"
+                               b a]
+                           [view b]))))
+  (is (= [view-component "john"]
+         (blocks-render '(let [a "john"
+                               b a]
+                           [view b]))))
+  (is (= [view-component "john"]
+         (blocks-render '(let [a "john"]
+                           (let [b a]
+                             [view b])))))
+  (is (= [view-component "john"]
+         (blocks-render '(let [a "john"
+                               dd a]
+                           (let [b a
+                                 c b]
+                             [view b]))))))
+
+(deftest let-blocks-with-properties
+  (is (= [view-component "test-name-prop"]
+         (blocks-render '(let [{name :name} properties]
+                           [view name]))))
+
+  (is (= [view-component "test-name-prop"]
+         (blocks-render '(let [{name :name} properties
+                               b name]
+                           [view b]))))
+
+  (is (= [view-component "jolly"]
+         (blocks-render '(let [{name :name} properties
+                               b name]
+                           (let [name "jolly"]
+                             [view name])))))
+
+  ;; doesn't work and should work
+  ;; this is caused by the way that properties are bound
+  ;; seperately
+  #_(is (= [view-component "test-name-prop"]
+           (blocks-render '(let [name "jolly"
+                                 {name :name} properties]
+                             [view name]))
+           ))
+
+  )
+
+(deftest let-blocks-with-queries
+  (is (= [view-component "a temp"]
+         (blocks-render '(let [temp [identity-query {:x "a temp"}]]
+                           [view temp]))))
+
+  (is (= [view-component "a temp" "a temp"]
+         (blocks-render '(let [a "a temp"
+                               temp [identity-query {:x a}]]
+                           [view a temp]))))
+
+  (is (= [view-component "a temp" "charmed"]
+         (blocks-render '(let [a "a temp"
+                               {asdf :asdf} [identity-map {:x "charmed"}]]
+                           [view a asdf]))))
+  
+ 
+   ;; this should work as well but ...
+  #_(is (= [view-component "a temp" "a temp"]
+           (blocks-render '(let [a "a temp"
+                                 temp [identity-query {:x a}]
+                                 ouch temp]
+                             [view temp ouch]))
+           
+         ))
+
+  (is (= [view-component "a temp" "a temp"]
+         (blocks-render '(let [a "a temp"
+                               temp [identity-query {:x a}]]
+                           (let [ouch temp]
+                               [view temp ouch])))))
+
+  
+  )
+
--- a/test/pluto/reader_test.cljc
+++ b/test/pluto/reader_test.cljc
@ -61,7 +61,14 @@
  ((get-in m [:data :hooks :main :a :parsed :view]) {}))

 (deftest parse-blocks
-  (is (= [blocks/let-block {:env {'s "Hello"}} '[text {} s]]
+  (is (= [blocks/let-block
+          '{:bindings [s "Hello"],
+           :ctx {:capacities {:components {text :text, view :view},
+                              :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]]
         (view (reader/parse default-capacities
                             (extension {'views/main   (list 'let ['s "Hello"] ['text {} 's])
                                         'hooks/main.a {:view ['views/main]}})))))