Basic knowledge

Basic knowledge

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -1,804 +1,79 @@
 (ns aurora.language
-  (:require [clojure.set :refer [union intersection difference subset?]]
-            [aurora.data :as data])
-  (:require-macros [aurora.macros :refer [console-time set!! conj!! disj!! assoc!! apush apush* avec aclear]]
-                   [aurora.language :refer [deffact]]))
+  (:require [aurora.btree :as btree])
+  (:require-macros [aurora.macros :refer [apush set!!]]))

-(declare resolve)
+;; TODO what do we do if `fields` is not the same set of fields as the fact?

-(extend-protocol ISeqable
-  TransientArrayMap
-  (-seq [this]
-        (if (.-editable? this)
-          (persistent-array-map-seq (.-arr this) 0 nil)
-          (throw (js/Error. "seq after persistent"))))
-  TransientHashMap
-  (-seq [this]
-        (if (.-edit this)
-          (when (pos? (.-count this))
-            (let [s (if-not (nil? (.-root this)) (.inode-seq (.-root this)))]
-              (if (.-has-nil? this)
-                (cons [nil (.-nil-val this)] s)
-                s)))
-          (throw (js/Error. "seq after persistent"))))
-  TransientHashSet
-  (-seq [this]
-        (keys (.-transient-map this))))
+(defn keymap [from-fields to-fields]
+  (let [keymap (make-array (alength to-fields))]
+    (dotimes [i (alength from-fields)]
+      (dotimes [j (alength to-fields)]
+        (when (= (aget from-fields i) (aget to-fields j))
+          (aset keymap j i))))
+    (dotimes [j (alength keymap)]
+      (assert (not (nil? (aget keymap j))))) ;; ie every to-field is in from-fields somewhere
+    keymap))

-(defn arr== [arr-a arr-b]
-  (and (== (alength arr-a) (alength arr-b))
-       (loop [i 0]
-         (if (>= i (alength arr-a))
-           true
-           (if (== (aget arr-a i) (aget arr-b i))
-             (recur (+ i 1))
-             false)))))
+(defn with-keymap [keymap key]
+  (assert (== (alength keymap) (alength key)))
+  (let [new-key (make-array (alength key))]
+    (dotimes [i (alength keymap)]
+      (aset new-key i (aget key (aget keymap i))))
+    new-key))

-(defn arr= [arr-a arr-b]
-  (and (== (alength arr-a) (alength arr-b))
-       (loop [i 0]
-         (if (>= i (alength arr-a))
-           true
-           (if (= (aget arr-a i) (aget arr-b i))
-             (recur (+ i 1))
-             false)))))
+(defn -add-facts [from-array from-fields to-index to-fields]
+  (let [changed? false
+        keymap (keymap from-fields to-fields)]
+    (dotimes [i (alength from-array)]
+      (when-not (.assoc! to-index (with-keymap keymap (aget from-array i)) nil)
+        (set!! changed? true)))
+    changed?))

-;; TODO facts and plans need to be serializable
+(deftype Knowledge [^:mutable kind->name->fields->index ^:mutable version]
+  Object
+  (get-or-create-index [this kind name fields]
+                       (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
+                       (or (get-in kind->name->fields->index [kind name (vec fields)])
+                           (let [index (btree/tree 10 (alength fields))]
+                             (when-let [[other-fields other-index] (first (get-in kind->name->fields->index [kind name]))]
+                               (-add-facts (btree/iterator->keys (btree/iterator other-index)) (into-array other-fields) index fields))
+                             (set! kind->name->fields->index (assoc-in kind->name->fields->index [kind name (vec fields)] index))
+                             index)))
+  (add-facts [this kind name fields facts]
+             (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
+             (let [changed? false
+                   indexes (get-in kind->name->fields->index [kind name])]
+               (assert (seq indexes))
+               (doseq [[other-fields other-index] indexes]
+                 (when (-add-facts facts fields other-index (into-array other-fields))
+                   (set!! changed? true)))
+               (when changed?
+                 (set! version (+ version 1)))))
+  (tick [this])
+  (tock [this]))

-;; FACTS
+(defn knowledge []
+  (Knowledge. {} 0))

-(deftype FactShape [id madlib keys]
-  Object
-  (toString [this]
-            (apply str (interleave madlib (concat (map (fn [k] (str "[" (name k) "]")) keys) [""]))))
-  IEquiv
-  (-equiv [this other]
-          (and (instance? FactShape other)
-               (= id (.-id other)))))
-
-;; if given a shape behaves like a record, otherwise behaves like a vector
-(deftype Fact [shape values ^:mutable __hash]
-  Object
-  (toString [this]
-            (if (and shape (instance? FactShape shape))
-              (apply str (interleave (.-madlib shape) (map (fn [k v] (str "[" (name k) " = " (pr-str v) "]")) (.-keys shape) values)))
-              (apply str (when shape (str " " shape " ")) (map (fn [v] (str "[_ = " (pr-str v) "]")) values))))
-  (hash [this]
-        (if __hash
-          __hash
-          (let [hash (if (> (alength values) 0)
-                       (loop [result 0
-                              i 0]
-                         (if (< i (alength values))
-                           (let [value (aget values i)
-                                 h (if (string? value)
-                                     (js/goog.string.hashCode value)
-                                     (js-mod (js/Math.floor value) 2147483647))]
-                             (recur (hash-combine result h) (+ i 1)))
-                           result))
-                       0)]
-            (set! __hash hash)
-            hash)))
-
-  IEquiv
-  (-equiv [this other]
-          (and (instance? Fact other)
-               (= shape (.-shape other))
-               (arr== values (.-values other))))
-
-  IHash
-  (-hash [this]
-         (.hash this))
-
-  IIndexed
-  (-nth [this n]
-        (-nth this n nil))
-  (-nth [this n not-found]
-        (if (and (<= 0 n) (< n (alength values)))
-          (aget values n)
-          not-found))
-
-  ILookup
-  (-lookup [this k]
-           (-lookup this k nil))
-  (-lookup [this k not-found]
-           (if (number? k)
-             (-nth this k not-found)
-             (when shape
-               (loop [i 0]
-                 (when (< i (alength (.-keys shape)))
-                   (if (= k (aget (.-keys shape) i))
-                     (aget values i)
-                     (recur (+ i 1)))))))))
-
-(defn fact-shape [id madlib&keys]
-  (let [split-madlib&keys (clojure.string/split madlib&keys #"\[|\]")
-        [madlib keys] [(take-nth 2 split-madlib&keys) (map keyword (take-nth 2 (rest split-madlib&keys)))]]
-    (FactShape. id (into-array madlib) (into-array keys))))
-
-(defn fact
-  ([values]
-   (assert (array? values) (pr-str values))
-   (Fact. nil values nil))
-  ([shape values]
-   (assert (or (instance? FactShape shape) (keyword? shape) (string? shape)) (pr-str shape))
-   (assert (array? values) (pr-str values))
-   (if (instance? FactShape shape)
-     (assert (= (alength values) (alength (.-keys shape))) (pr-str values shape)))
-   (Fact. shape values nil)))
-
-(defn fact-ix [fact ix]
-  (aget (.-values fact) ix))
-
-(defn fact-ixes [fact ixes]
-  (let [result #js []
-        values (.-values fact)]
-    (dotimes [i (count ixes)]
-      (apush result (aget values (aget ixes i))))
-    (Fact. nil result nil)))
-
-(defn fact-join [left-fact right-fact]
-  (let [values (.concat (.-values left-fact) (.-values right-fact))]
-    (Fact. nil values nil)))
-
-(comment
-  (fact-shape ::eg "[a] has a [b] with a [c]")
-  (fact-shape ::eg "The [a] has a [b] with a [c]")
-
-  (fact #js [0 1 2])
-  (fact (fact-shape ::eg "The [a] has a [b] with a [c]") #js [0 1 2])
-
-  (deffact eg "[a] has a [b] with a [c]")
-  (.-id eg)
-
-  eg
-
-  (.-id (.-shape (fact (fact-shape ::eg "[a] has a [b] with a [c]") #js ["a" "b" "c"])))
-
-  (def x (->eg "a" "b" "c"))
-  (nth x 1)
-  (get x 1)
-  (get x :b)
-
-  (= eg (fact-shape ::eg "[a] has a [b] with a [c]"))
-
-  (fact (fact-shape ::eg "[a] has a [b] with a [c]") #js ["a" "b" "c"])
-
-  (= x x)
-  (= x (fact (fact-shape ::eg "[a] has a [b] with a [c]") #js ["a" "b" "c"]))
-  (= x (fact (resolve ::eg) #js ["a" "b" "c"]))
-  (= x (fact eg #js ["a" "b" "c"]))
-  (= x (->eg "a" "b" "c"))
-  (= (Fact. nil #js ["a" "b" "c"]) (Fact. nil #js ["a" "b" "c"]))
-
-  (= x (Fact. nil #js ["a" "b" "c"]))
-  (= x (Fact. eg #js ["a" "b" 0]))
-  (= x (fact (fact-shape ::foo "[a] has a [b] with a [c]") #js ["a" "b" "c"]))
-
-  (fact-ixes x #js [2 1])
-  )
-
-;; FLOW STATE
-
-(defrecord FlowState [node->state node->out-nodes node->facts node->update! node->stats trace plan])
-
-(def trace? true)
-
-(defn fixpoint! [{:keys [node->state node->out-nodes node->facts node->update! node->stats trace plan] :as flow-state}]
-  (js/console.time "fixpoint!")
-  (loop [node 0]
-    (when (< node (alength node->facts))
-      (let [in-facts (aget node->facts node)]
-        (if (== 0 (alength in-facts))
-          (recur (+ node 1))
-          (let [out-facts #js []]
-            (.call (aget node->update! node) nil node node->state node->stats in-facts out-facts)
-            (aset node->facts node #js [])
-            (aset node->stats node "count-in" (+ (aget node->stats node "count-in") (alength in-facts)))
-            (aset node->stats node "count-out" (+ (aget node->stats node "count-out") (alength out-facts)))
-            (when trace? (.push trace #js [node in-facts out-facts]))
-            ;; (prn node in-facts out-facts (nth (:node->flow plan) node))
-            (if (> (alength out-facts) 0)
-              (let [out-nodes (aget node->out-nodes node)
-                    min-out-node (areduce out-nodes i min-out-node (+ node 1)
-                                          (let [out-node (aget out-nodes i)]
-                                            (apush* (aget node->facts out-node) out-facts)
-                                            (min out-node min-out-node)))]
-                (recur min-out-node))
-              (recur (+ node 1))))))))
-  (js/console.timeEnd "fixpoint!")
-  flow-state)
-
-(defn filter-map-update! [fun]
-  (fn [node node->state node->stats in-facts out-facts]
-    (dotimes [i (alength in-facts)]
-      (let [fact (aget in-facts i)]
-        (when-let [new-fact (.call fun nil fact)]
-          (apush out-facts new-fact))))))
-
-(defn union-update! []
-  (fn [node node->state node->stats in-facts out-facts]
-    (let [facts (aget node->state node)]
-      (dotimes [i (alength in-facts)]
-        (let [fact (aget in-facts i)]
-          (if (.assoc! facts fact true)
-            (apush out-facts fact)
-            (aset node->stats node "dupes" (+ (aget node->stats node "dupes") 1))))))))
-
-(defn index-update! [key-ixes]
-  (fn [node node->state node->stats in-facts out-facts]
-    (let [index (aget node->state node)]
-      (dotimes [i (alength in-facts)]
-        (let [fact (aget in-facts i)
-              key (fact-ixes fact key-ixes)
-              facts (or (.lookup index key)
-                        (do (let [facts (data/fact-map)]
-                              (.assoc! index key facts)
-                              facts)))]
-          (if (.assoc! facts fact true)
-            (apush out-facts fact)
-            (aset node->stats node "dupes" (+ (aget node->stats node "dupes") 1))))))))
-
-(defn lookup-update! [index-node key-ixes reverse?]
-  (fn [node node->state node->stats in-facts out-facts]
-    (let [index (aget node->state index-node)]
-      (dotimes [i (alength in-facts)]
-        (let [left-fact (aget in-facts i)
-              key (fact-ixes left-fact key-ixes)]
-          (doseq [right-fact (keys (.lookup index key))]
-              (apush out-facts (if reverse? (fact-join right-fact left-fact) (fact-join left-fact right-fact)))))))))
-
-;; FLOWS
-
-(defrecord Union [nodes])
-(defrecord FilterMap [nodes fun&args])
-(defrecord Index [nodes key-ixes])
-(defrecord Lookup [nodes index-node key-ixes reverse?])
-
-(defn flow->nodes [flow]
-  (:nodes flow))
-
-;; FLOW PLAN
-
-(defrecord FlowPlan [node->flow flow->node memory->shape->node kind->shape])
-
-(defn flow-plan->flow-state [{:keys [node->flow] :as plan}]
-  (let [node->state (make-array (count node->flow))
-        node->out-nodes (make-array (count node->flow))
-        node->facts (make-array (count node->flow))
-        node->update! (make-array (count node->flow))
-        node->stats (make-array (count node->flow))
-        trace #js []]
-    (dotimes [node (count node->flow)]
-      (aset node->out-nodes node #js [])
-      (aset node->facts node #js []))
-    (dotimes [node (count node->flow)]
-      (let [flow (nth node->flow node)]
-        (aset node->state node
-              (condp = (type flow)
-                Union (data/fact-map)
-                FilterMap nil
-                Index (data/fact-map)
-                Lookup nil))
-        (doseq [in-node (:nodes flow)]
-          (apush (aget node->out-nodes in-node) node))
-        (aset node->update! node
-              (condp = (type flow)
-                Union (union-update!)
-                FilterMap (filter-map-update! (apply (resolve (first (:fun&args flow))) (rest (:fun&args flow))))
-                Index (index-update! (:key-ixes flow))
-                Lookup (lookup-update! (:index-node flow) (:key-ixes flow) (:reverse? flow))))
-        (aset node->stats node
-              (condp = (type flow)
-                Union #js {:count-in 0 :count-out 0 :dupes 0}
-                FilterMap #js {:count-in 0 :count-out 0 :dupes 0}
-                Index #js {:count-in 0 :count-out 0 :dupes 0}
-                Lookup #js {:count-in 0 :count-out 0 :dupes 0}))))
-    (FlowState. node->state node->out-nodes node->facts node->update! node->stats trace plan)))
-
-(defn empty-state-of [plan state]
-  (if (= plan (:plan state))
-    (let [node->flow (:node->flow plan)
-          node->state (make-array (count node->flow))
-          node->out-nodes (:node->out-nodes state)
-          node->facts (make-array (count node->flow))
-          node->update! (:node->update! state)
-          node->stats (make-array (count node->flow))
-          trace #js []]
-      (dotimes [node (alength node->out-nodes)]
-        (aset node->facts node #js [])
-        (let [flow (nth node->flow node)]
-          (aset node->state node
-              (condp = (type flow)
-                Union (data/fact-map)
-                FilterMap nil
-                Index (data/fact-map)
-                Lookup nil))
-          (aset node->stats node
-              (condp = (type flow)
-                Union #js {:count-in 0 :count-out 0 :dupes 0}
-                FilterMap #js {:count-in 0 :count-out 0 :dupes 0}
-                Index #js {:count-in 0 :count-out 0 :dupes 0}
-                Lookup #js {:count-in 0 :count-out 0 :dupes 0}))))
-      (FlowState. node->state node->out-nodes node->facts node->update! node->stats trace plan))
-    (do (println "Rebuilding state!")
-      (flow-plan->flow-state plan))))
-
-(def empty-flow-plan
-  (FlowPlan. [] {} {} {}))
-
-(defn add-flow-without-memo [{:keys [node->flow flow->node] :as flow-plan} flow]
-  (let [node (count node->flow)
-        node->flow (conj node->flow flow)
-        flow->node (assoc flow->node flow node)]
-    [(assoc flow-plan :node->flow node->flow :flow->node flow->node) node]))
-
-(defn add-flow [{:keys [node->flow flow->node] :as flow-plan} flow]
-  (if-let [node (get flow->node flow)]
-    [flow-plan node]
-    (add-flow-without-memo flow-plan flow)))
-
-(defn memory! [memory]
-  (assert (#{:known|pretended :remembered :forgotten} memory) (pr-str memory)))
-
-(defn add-memory [{:keys [node->flow memory->shape->node] :as flow-plan} memory shape]
-  (memory! memory)
-  (let [[flow-plan node] (add-flow-without-memo flow-plan (assoc (Union. #{}) :memory memory :shape shape))
-        memory->shape->node (assoc-in memory->shape->node [memory shape] node)]
-    (assoc flow-plan :memory->shape->node memory->shape->node)))
-
-(defn add-shape [flow-plan kind shape]
-  (case kind
-    :pretended (-> flow-plan
-                   (add-memory :known|pretended shape)
-                   (update-in [:kind->shape kind] #(conj (or % #{}) shape)))
-    :known (-> flow-plan
-               (add-memory :known|pretended shape)
-               (add-memory :remembered shape)
-               (add-memory :forgotten shape)
-               (update-in [:kind->shape kind] #(conj (or % #{}) shape)))))
-
-(defn get-memory [{:keys [memory->shape->node] :as flow-plan} memory shape]
-  (memory! memory)
-  (or (get-in memory->shape->node [memory shape])
-      (assert false (str "No node for " (pr-str memory) " " (pr-str shape) " in " (pr-str flow-plan)))))
-
-(defn add-input [flow-plan output-node memory shape]
-  (update-in flow-plan [:node->flow output-node :nodes] conj (get-memory flow-plan memory shape)))
-
-(defn add-output [flow-plan input-node memory shape]
-  (update-in flow-plan [:node->flow (get-memory flow-plan memory shape) :nodes] conj input-node))
-
-;; IXES
-
-(defn ix-of [vector value]
-  (let [count (count vector)]
-    (loop [ix 0]
-      (if (< ix count)
-        (if (= value (nth vector ix))
-          ix
-          (recur (+ ix 1)))
-        (assert false (str (pr-str value) " is not contained in " (pr-str vector)))))))
-
-(defn ixes-of [vector values]
-  (into-array (map #(ix-of vector %) values)))
-
-;; EXPRS
-
-(defn expr->fun [vars expr]
-  (apply js/Function (conj (vec vars) (str "return " expr ";"))))
-
-(defn when->fun [vars expr]
-  (let [when-fun (expr->fun vars expr)]
-    (fn [fact]
-      (let [values (.-values fact)]
-        (when (.apply when-fun nil values)
-          fact)))))
-
-(defn let->fun [vars expr]
-  (let [let-fun (expr->fun vars expr)]
-    (fn [fact]
-      (let [values (.-values fact)
-            new-values (aclone values)
-            new-value (.apply let-fun nil values)]
-        (apush new-values new-value)
-        (Fact. nil new-values nil)))))
-
-(defn when-let->fun [name-ix vars expr]
-  (let [let-fun (expr->fun vars expr)]
-    (fn [fact]
-      (let [values (.-values fact)
-            old-value (aget values name-ix)
-            new-value (.apply let-fun nil values)]
-        (when (= old-value new-value)
-          fact)))))
-
-;; PATTERNS
-
-(defn pattern->vars [pattern]
-  (vec (for [value (.-values pattern)]
-         (if (symbol? value)
-           value
-           '_))))
-
-(defn pattern->filter [pattern]
-  `(pattern->filter* ~(.-shape pattern)))
-
-(defn pattern->filter* [shape]
-  (fn [fact]
-    (when (= shape (.-shape fact))
-      fact)))
-
-(defn pattern->constructor [source-vars pattern]
-  (let [shape (.-shape pattern)
-        values (.-values pattern)
-        source-ixes #js []
-        sink-ixes #js []]
-    (doseq [[value ix] (map vector (.-values pattern) (range))]
-      (when (symbol? value)
-        (do
-          (apush source-ixes (ix-of source-vars value))
-          (apush sink-ixes ix))))
-    `(pattern->constructor* ~shape ~values ~source-ixes ~sink-ixes)))
-
-(defn pattern->constructor* [shape values source-ixes sink-ixes]
-  (fn [fact]
-    (let [source (.-values fact)
-          sink (aclone values)]
-      (dotimes [i (alength source-ixes)]
-        (aset sink (aget sink-ixes i) (aget source (aget source-ixes i))))
-      (Fact. shape sink nil))))
-
-(defn pattern->deconstructor [pattern]
-  (let [seen? (atom {})
-        constant-values #js []
-        constant-ixes #js []
-        dup-value-ixes #js []
-        dup-var-ixes #js []]
-    (doseq [[value ix] (map vector (.-values pattern) (range))]
-      (if (symbol? value)
-        (if-let [dup-value-ix (@seen? value)]
-          (do
-            (apush dup-value-ixes dup-value-ix)
-            (apush dup-var-ixes ix))
-          (swap! seen? assoc value ix))
-        (do
-          (apush constant-values value)
-          (apush constant-ixes ix))))
-    (when (or (seq constant-values) (seq dup-value-ixes))
-      `(pattern->deconstructor* ~constant-values ~constant-ixes ~dup-value-ixes ~dup-var-ixes))))
-
-(defn pattern->deconstructor* [constant-values constant-ixes dup-value-ixes dup-var-ixes]
-  (fn [fact]
-    (let [source (.-values fact)]
-      (loop [i 0]
-        (if (< i (alength constant-values))
-          (when (== (aget constant-values i) (aget source (aget constant-ixes i)))
-            (recur (+ i 1)))
-          (loop [i 0]
-            (if (< i (alength dup-value-ixes))
-              (when (== (aget source (aget dup-value-ixes i)) (aget source (aget dup-var-ixes i)))
-                (recur (+ i 1)))
-              fact)))))))
-
-;; CLAUSES
-
-(defrecord Recall [memory pattern]) ;; memory is one of :known|pretended :remembered :forgotten
-(defrecord Compute [pattern])
-(defrecord Output [memory pattern]) ;; memory is one of :pretended :remembered :forgotten
-
-;; horrible non-relational things
-(deffact Let "Let [name] be the result of [vars] [expr]")
-(deffact When "When [vars] [expr]")
-
-;; if clause can be calculated somehow then return a new [plan node vars] pair that calculates it
-;; otherwise return nil
-(defn add-clause [plan nodes vars clause]
-  (condp = (type clause)
-    Recall (let [{:keys [memory pattern]} clause
-                 input-node (get-memory plan memory (.-shape pattern))
-                 [plan node] (if-let [deconstructor (pattern->deconstructor pattern)]
-                               (add-flow plan (FilterMap. #{input-node} deconstructor))
-                               [plan input-node])]
-             [plan [node] (pattern->vars pattern)])
-    Compute (let [{:keys [pattern]} clause]
-              (condp = (.-shape pattern)
-                Let (when (every? (conj (set vars) '_) (:vars pattern))
-                      (let [fun&args (if (contains? (set vars) (:name pattern))
-                                       `(when-let->fun ~(ix-of vars (:name pattern)) ~vars ~(:expr pattern))
-                                       `(let->fun ~vars ~(:expr pattern)))
-                            [plan node] (add-flow plan (->FilterMap nodes fun&args))]
-                        [plan [node] (conj vars (:name pattern))]))
-                When (when (every? (conj (set vars) '_) (:vars pattern))
-                       (let [[plan node] (add-flow plan (->FilterMap nodes `(when->fun ~vars ~(:expr pattern))))]
-                         [plan [node] vars]))))
-    Output (let [{:keys [memory pattern]} clause
-                 _ (assert (every? (conj (set vars) '_) (pattern->vars pattern)))
-                 [plan output-node] (add-flow plan (FilterMap. nodes (pattern->constructor vars pattern)))
-                 output-memory (case memory
-                                 :pretended :known|pretended
-                                 :remembered :remembered
-                                 :forgotten :forgotten)
-                 plan (add-output plan output-node output-memory (.-shape pattern))]
-             [plan nodes vars])))
-
-;; RULES
-
-(defrecord Rule [clauses])
-
-;; Correctness: Each clause must appear at least once in the plan
-;; Heuristic: Each Recall clause is used at most once in the plan
-;; Heuristic: Each Filter/Let clause is used at most once per path in the plan
-
-(defn add-computes [plan&nodes&vars computes]
-  (let [plan&nodes&vars (atom plan&nodes&vars)
-        computes-skipped #js []]
-    (doseq [compute computes]
-      (if-let [new-plan&nodes&vars (apply add-clause (conj @plan&nodes&vars compute))]
-        (reset! plan&nodes&vars new-plan&nodes&vars)
-        (apush computes-skipped compute)))
-    (if (= (count computes) (count computes-skipped))
-      @plan&nodes&vars
-      (recur @plan&nodes&vars computes-skipped))))
-
-(defn join-clauses [plan nodes-a vars-a nodes-b vars-b]
-  (let [key-vars (disj (intersection (set vars-a) (set vars-b)) '_)
-        key-vars-a (sort-by #(ix-of vars-a %) key-vars)
-        key-vars-b (sort-by #(ix-of vars-b %) key-vars)
-        val-vars (disj (union (set vars-a) (set vars-b)) '_)
-        index-ixes-a (ixes-of vars-a key-vars-a)
-        index-ixes-b (ixes-of vars-b key-vars-b)
-        lookup-ixes-a (ixes-of vars-a key-vars-b)
-        lookup-ixes-b (ixes-of vars-b key-vars-a)
-        [plan index-a] (add-flow plan (->Index nodes-a index-ixes-a))
-        index-b (inc (count (:node->flow plan))) ;; gross :(
-        [plan lookup-a] (add-flow plan (->Lookup [index-a] index-b lookup-ixes-a false))
-        [plan index-b'] (add-flow plan (->Index nodes-b index-ixes-b))
-        _ (assert (= index-b index-b'))
-        [plan lookup-b] (add-flow plan (->Lookup [index-b] index-a lookup-ixes-b true))]
-    [plan [lookup-a lookup-b] (vec (concat vars-a vars-b))]))
-
-(defn add-rule [plan rule]
-  (let [recalls (filter #(= Recall (type %)) (:clauses rule))
-        computes (set (filter #(= Compute (type %)) (:clauses rule)))
-        outputs (filter #(= Output (type %)) (:clauses rule))
-        main-plan (atom plan)
-        nodes&vars (for [recall recalls]
-                     (let [[plan node vars] (add-computes (add-clause @main-plan nil nil recall) computes)]
-                       (reset! main-plan plan)
-                       [node vars]))
-        [nodes vars] (reduce (fn [[nodes-a vars-a] [nodes-b vars-b]]
-                               (let [computes-unapplied (difference computes
-                                                                    (filter #(add-clause @main-plan nodes-a vars-a %) computes)
-                                                                    (filter #(add-clause @main-plan nodes-b vars-b %) computes))
-                                     [plan nodes vars] (add-computes
-                                                        (join-clauses @main-plan nodes-a vars-a nodes-b vars-b)
-                                                        computes-unapplied)]
-                                 (reset! main-plan plan)
-                                 [nodes vars]))
-                             nodes&vars)
-        computes-unapplied (filter #(not (add-clause @main-plan nodes vars %)) computes)]
-    (assert (empty? computes-unapplied) (str "Could not apply " (pr-str computes-unapplied) " to " (pr-str vars)))
-    (doseq [output outputs]
-      (let [[plan node vars] (add-clause @main-plan nodes vars output)]
-        (reset! main-plan plan)))
-    @main-plan))
-
-(defn add-rules [plan rules]
-  ;; TODO stratify
-  (reduce add-rule plan rules))
-
-;; TIME AND CHANGE
-
-(defn add-facts [state memory shape facts]
-  (memory! memory)
-  (let [node (get-memory (:plan state) memory shape)
-        arr (aget (:node->facts state) node)]
-    (doseq [fact facts]
-      (apush arr fact))
-    state))
-
-(defn get-facts [state memory shape]
-  (memory! memory)
-  (let [node (get-memory (:plan state) memory shape)]
-    (into-array (keys (aget (:node->state state) node)))))
-
-;; TODO make this incremental
-(defn tick
-  ([plan] (tick plan (flow-plan->flow-state plan)))
-  ([plan state]
-   (js/console.time "plan->state")
-   (let [new-state (empty-state-of plan state)]
-     (js/console.timeEnd "plan->state")
-     (js/console.time "tick")
-     (doseq [shape (get-in state [:plan :kind->shape :known])] ;; using old plan here
-       (let [known (aget (:node->state state) (get-memory (:plan state) :known|pretended shape))
-             remembered (aget (:node->state state) (get-memory (:plan state) :remembered shape))
-             forgotten (aget (:node->state state) (get-memory (:plan state) :forgotten shape))
-             new-known (aget (:node->facts new-state) (get-memory (:plan new-state) :known|pretended shape))]
-         (doseq [fact (keys known)]
-           (when (or (not (.lookup forgotten fact)) (.lookup remembered fact))
-             (apush new-known fact)))
-         (doseq [fact (keys remembered)]
-           (when (and (not (.lookup known fact)) (not (.lookup forgotten fact)))
-             (apush new-known fact)))))
-     (js/console.timeEnd "tick")
-     new-state)))
-
-(defn tick&fixpoint [plan state]
-  (fixpoint! (tick plan state)))
-
-(defn clauses->rule [clauses]
-  (Rule. clauses))
-
-;; RESOLVE
-
-(def symbol->fun
-  #js {"let->fun" let->fun
-       "when->fun" when->fun
-       "when-let->fun" when-let->fun
-       "pattern->filter*" pattern->filter*
-       "pattern->constructor*" pattern->constructor*
-       "pattern->deconstructor*" pattern->deconstructor*})
-
-(defn resolve [symbol]
-  (let [fun (aget symbol->fun (name symbol))]
-    (assert fun (str "Could not find " symbol))
-    fun))
-
-;; TEMPORARY SHIMS
-
-(defn add-facts-compat [state memory facts]
-  (memory! memory)
-  (doseq [fact facts]
-    (let [shape (.-shape fact)
-          node (get-memory (:plan state) memory shape)
-          arr (aget (:node->facts state) node)]
-      (apush arr fact)))
-  state)
-
-(defn get-facts-compat [state memory]
-  (memory! memory)
-  (let [facts #js []]
-    (doseq [[shape node] (get-in state [:plan :memory->shape->node memory])
-            fact (get-facts state memory shape)]
-      (apush facts fact))
-    facts))
-
-(defn shapes&kinds&rules->plan [shapes&kinds rules]
-  (add-rules (reduce (fn [plan [shape kind]] (add-shape plan kind shape)) empty-flow-plan shapes&kinds) rules))
-
-;; assume state is :known unless it is used in pretend or is overridden in stdlib
-(defn rules->shapes&kinds [rules facts]
-  (let [shape->kind (atom {})]
-    (doseq [rule rules
-            clause (:clauses rule)]
-      (when (= Recall (type clause))
-        (swap! shape->kind assoc (.-shape (:pattern clause)) :known)))
-    (doseq [rule rules
-            clause (:clauses rule)]
-      (when (= Output (type clause))
-        (if (= :pretended (:memory clause))
-          (swap! shape->kind assoc (.-shape (:pattern clause)) :pretended)
-          (swap! shape->kind assoc (.-shape (:pattern clause)) :known))))
-    (doseq [fact facts]
-      (swap! shape->kind assoc (.-shape fact) :known))
-    (doseq [[shape v] aurora.runtime.stdlib/madlibs]
-      (if-not (:remembered v)
-        (swap! shape->kind assoc shape :pretended)
-        (swap! shape->kind assoc shape :known)))
-    @shape->kind))
-
-(defn rules->plan [rules facts]
-  (shapes&kinds&rules->plan (rules->shapes&kinds rules facts) rules))
-
-(defn unchanged? [old-state new-state]
-  (js/console.time "unchanged?")
-  (let [unchanged? (and (= (:plan old-state) (:plan new-state))
-                        (every?
-                         (fn [shape]
-                           (arr= (get-facts old-state :known|pretended shape) (get-facts new-state :known|pretended shape)))
-                         (get-in old-state [:plan :kind->shape :known])))]
-    (js/console.timeEnd "unchanged?")
-    unchanged?))
-
-;; TESTS
-
-(comment
-  (deffact edge "[x] has an edge to [y]")
-  (deffact connected "[x] is connected to [y]")
-
-  (let [plan (-> empty-flow-plan
-                 (add-shape :known edge)
-                 (add-shape :pretended connected)
-                 (add-rules [(Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                                     (Output. :pretended (->connected 'x 'y))])
-                             (Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                                     (Recall. :known|pretended (->connected 'y 'z))
-                                     (Output. :pretended (->connected 'x 'z))])]))
-        state (flow-plan->flow-state plan)]
-    (add-facts state :known|pretended edge #js [(->edge 0 1) (->edge 1 2) (->edge 2 3) (->edge 3 1)])
-    (time (fixpoint! state))
-    (get-facts state :known|pretended connected))
-
-  (enable-console-print!)
-
-  (let [plan (-> empty-flow-plan
-                 (add-shape :known edge)
-                 (add-shape :pretended connected)
-                 (add-rules [(Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                                     (Output. :pretended (->connected 'x 'y))])
-                             (Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                                     (Recall. :known|pretended (->connected 'y 'z))
-                                     (Output. :pretended (->connected 'x 'z))])]))
-        state (flow-plan->flow-state plan)]
-    (add-facts state :known|pretended edge (into-array (for [i (range 100)] (->edge i (inc i)))))
-    (js/console.time "new")
-    (fixpoint! state)
-    (js/console.timeEnd "new")
-    (get-facts state :known|pretended connected))
-  ;; 5 => 1 ms
-  ;; 10 => 8 ms
-  ;; 50 => 1093 ms
-  ;; 100 => 11492 ms
-
-  (let [plan (-> empty-flow-plan
-                 (add-shape :known edge)
-                 (add-shape :pretended connected)
-                 (add-rules [(Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                                     (Compute. (->Let 'z '[x y] "x + y"))
-                                     (Output. :pretended (->connected 'z 'z))])]))
-        state (flow-plan->flow-state plan)]
-    (add-facts state :known|pretended edge (into-array (for [i (range 100)]
-                                                         (->edge i (inc i)))))
-    (fixpoint! state)
-    (get-facts state :known|pretended connected))
-
-  (deffact return "[x] is connected to 2")
-
-  (let [plan (-> empty-flow-plan
-                 (add-shape :known edge)
-                 (add-shape :pretended connected)
-                 (add-shape :pretended return)
-                 (add-rules [(Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                                     (Output. :pretended (->connected 'x 'y))])
-                             (Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                                     (Recall. :known|pretended (->connected 'y 'z))
-                                     (Output. :pretended (->connected 'x 'z))])
-                             (Rule. [(Recall. :known|pretended (->connected 'x 2))
-                                     (Output. :pretended (->return 'x))])]))
-        state (flow-plan->flow-state plan)]
-    (add-facts state :known|pretended edge #js [(->edge 0 1) (->edge 1 2) (->edge 2 3) (->edge 3 1)])
-    (time (fixpoint! state))
-    (get-facts state :known|pretended return))
-  )
-
-(comment
-  (deffact edge "[x] has an edge to [y]")
-  (deffact connected "[x] is connected to [y]")
-
-  (let [plan (-> empty-flow-plan
-                 (add-shape :known edge)
-                 (add-shape :known connected)
-                 (add-rules
-                  [(Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                           (Output. :remembered (->connected 'x 'y))])
-                   (Rule. [(Recall. :known|pretended (->edge 'x 'y))
-                           (Recall. :known|pretended (->connected 'y 'z))
-                           (Output. :remembered (->connected 'x 'z))])]))
-        state-0 (flow-plan->flow-state plan)]
-    (add-facts state-0 :known|pretended edge #js [(->edge 0 1) (->edge 1 2) (->edge 2 3) (->edge 3 1)])
-  (fixpoint! state-0)
-  (for [state (take 5 (iterate #(tick&fixpoint plan %) state-0))]
-    (count (get-facts state :known|pretended connected))))
-  )

 (comment

-  (let [u (transient {})]
-    (time
-     (dotimes [i 1000000]
-       (let [fact (fact #js [(mod i 1000) (mod i 100) (mod i 10)])]
-         (assoc!! u fact fact)))))
+  (def kn (knowledge))
+
+  (.get-or-create-index kn "known" "heights" #js ["name" "height"])
+
+  (.add-facts kn "known" "heights" #js ["name" "height"] #js [#js ["chris" "short"] #js ["rob" "spade hands"]])
+
+  (.get-or-create-index kn "known" "heights" #js ["name" "height"])
+
+  (.get-or-create-index kn "known" "heights" #js ["height" "name"])
+
+  (.-kind->name->fields->index kn)
+
+  (.add-facts kn "known" "heights" #js ["name" "height"] #js [#js ["jamie" "just right"]])
+
+  (.get-or-create-index kn "known" "heights" #js ["name" "height"])
+
+  (.get-or-create-index kn "known" "heights" #js ["height" "name"])

   )


Fix figwheel-main starting a server in repl phase

Reference https://github.com/bhauman/figwheel-main/issues/183

If figwheel looks at the server and it has been stopped, it will attempt
to start a server for you.
This causes port conflicts, as we control the server via the system
outside of this.

--- lib/edge.app.dev/src/dev_extras.clj
+++ lib/edge.app.dev/src/dev_extras.clj
@@ -97,9 +97,11 @@
        `(do
           (require 'figwheel.main.api)
           (require 'figwheel.main)
+          (require 'figwheel.repl)
           (let [builds# (keys @figwheel.main/build-registry)]
             (if (= (count builds#) 1)
-              (figwheel.main.api/cljs-repl (first builds#))
+              (binding [figwheel.repl/*server* true]
+                (figwheel.main.api/cljs-repl (first builds#)))
               (throw (ex-info "A build must be specified, please call with an argument"
                               {:builds builds#}))))))))
   ([build-id]
@@ -109,4 +111,6 @@
    (eval
      `(do
         (require 'figwheel.main.api)
-        (figwheel.main.api/cljs-repl ~build-id)))))
+        (require 'figwheel.repl)
+        (binding [figwheel.repl/*server* true]
+          (figwheel.main.api/cljs-repl ~build-id))))))


Allow loading AOT bundled cljc artifacts

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -485,7 +485,7 @@

 (defn- add-suffix
   [file suffix]
-  (let [candidate (s/replace file #".cljs$" suffix)]
+  (let [candidate (s/replace file #".clj[sc]$" suffix)]
     (if (gstring/endsWith candidate suffix)
       candidate
       (str file suffix))))


Fix bugs in lazily loading source-maps

Fix bugs in lazily loading source-maps

Fix bugs introduced with https://github.com/mfikes/planck/commit/97f1a0f47eb3b2f17a5c62ad9e74396566def0e8

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -1076,22 +1076,22 @@

 (defn- load-bundled-source-maps!
   [ns-syms]
-  (when-not (get (:source-maps @planck.repl/st) 'cljs.core)
-    (let [source-map-path  (fn [ns-sym]
-                             (str (cljs.js/ns->relpath ns-sym) ".js.map"))
-          load-source-maps (fn [ns-sym]
-                             (when-not (get-in [:source-maps ns-sym] @st)
-                               (when-let [sm-text (->> ns-sym
-                                                    source-map-path
-                                                    js/PLANCK_LOAD
-                                                    first)]
-                                 ;; Detect if we have source maps in need of decoding
-                                 ;; or if they are AOT decoded.
-                                 (if (or (string/starts-with? sm-text "{\"version\"")
-                                         (string/starts-with? sm-text "{\n\"version\""))
-                                   (cljs/load-source-map! st ns-sym sm-text)
-                                   (swap! st assoc-in [:source-maps ns-sym] (transit-json->cljs sm-text))))))]
-      (run! load-source-maps ns-syms))))
+  (let [source-map-path  (fn [ns-sym]
+                           (str (cljs.js/ns->relpath ns-sym) ".js.map"))
+        load-source-maps (fn [ns-sym]
+                           (when-not (get-in @st [:source-maps ns-sym])
+                             (if-let [sm-text (->> ns-sym
+                                                  source-map-path
+                                                  js/PLANCK_LOAD
+                                                  first)]
+                               ;; Detect if we have source maps in need of decoding
+                               ;; or if they are AOT decoded.
+                               (if (or (string/starts-with? sm-text "{\"version\"")
+                                       (string/starts-with? sm-text "{\n\"version\""))
+                                 (cljs/load-source-map! st ns-sym sm-text)
+                                 (swap! st assoc-in [:source-maps ns-sym] (transit-json->cljs sm-text)))
+                               (swap! st assoc-in [:source-maps ns-sym] {}))))]
+    (run! load-source-maps ns-syms)))

 (defn- load-core-macros-source-maps! []
   (load-bundled-source-maps! '[cljs.core$macros]))


Support for exporting all words (both dictionaries) to CSV format

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -367,6 +367,7 @@
             "/all-words/text"         (process-wordlist-text request nil)
             "/all-words/xml"          (process-wordlist-xml  request nil)
             "/all-words/edn"          (process-wordlist-edn  request nil)
+            "/all-words/csv"          (process-wordlist-csv  request nil)
             "/whitelist/json"         (process-wordlist-json request :whitelist)
             "/whitelist/text"         (process-wordlist-text request :whitelist)
             "/whitelist/xml"          (process-wordlist-xml  request :whitelist)


Add test cases to check for deep paths

Add test cases to check for deep paths

--- test/cljc/reitit/core_test.cljc
+++ test/cljc/reitit/core_test.cljc
@@ -347,7 +347,19 @@
           [["/a" {:conflicting true}]
            ["/:b" {:conflicting true}]
            ["/c" {:conflicting true}]
-           ["/*d" {:conflicting true}]] :quarantine-router)
+           ["/*d" {:conflicting true}]] :quarantine-router
+          [["/:a"
+            ["/:b" {:conflicting true}]
+            ["/:c" {:conflicting true}]
+            ["/:d"
+             ["/:e" {:conflicting true}]
+             ["/:f" {:conflicting true}]]]] :quarantine-router
+          [["/:a" {:conflicting true}
+            ["/:b"]
+            ["/:c"]
+            ["/:d"
+             ["/:e"]
+             ["/:f"]]]] :quarantine-router)
         (testing "unmarked path conflicts throw"
           (are [paths]
             (is (thrown-with-msg?


minor changes to tests in forma.matrix.walk

--- test/forma/matrix/walk_test.clj
+++ test/forma/matrix/walk_test.clj
@@ -59,7 +59,7 @@
                     [10 11 12 13 14]
                     [15 16 17 18 19]
                     [20 21 22 23 24]]]
-    (windowed-function 1 max num-square) => [6 7 8 9 9
+    (windowed-function 1 max num-square) => [ 6  7  8  9  9
                                              11 12 13 14 14
                                              16 17 18 19 19
                                              21 22 23 24 24
@@ -70,4 +70,3 @@
   (let [test-mat (for [i (range 5) :let [j (* i 5)]]
                    (range j (+ j 5)))]
     (count (windowed-function 1 + test-mat)) => (count (flatten test-mat))))
-


:lipstick: Cosmetic changes on text shape component.

--- frontend/src/uxbox/main/ui/shapes/text.cljs
+++ frontend/src/uxbox/main/ui/shapes/text.cljs
@@ -106,35 +106,19 @@

 ;; --- Text Shape Edit

-(mf/def text-shape-edit
-  :mixins [mf/memo]
-
-  :init
-  (fn [own props]
-    (assoc own ::container (mf/create-ref)))
-
-  :did-mount
-  (fn [own]
-    (let [shape (get-in own [::mf/props :shape])
-          dom (mf/ref-node (::container own))]
-      (set! (.-textContent dom) (:content shape ""))
-      (.focus dom)
-      own))
-
-  :will-unmount
-  (fn [own]
-    (let [dom (mf/ref-val (::container own))
-          shape (get-in own [::mf/props :shape])
-          content (dom/get-value dom)]
-      (st/emit! (udw/update-shape (:id shape) {:content content}))
-      own))
-
-  :render
-  (fn [own {:keys [shape] :as props}]
-    (let [{:keys [id x y content width height]} shape]
-      [:foreignObject {:x x :y y :width width :height height}
-       [:textarea {:style (make-style shape)
-                   :ref (::container own)}]])))
+(mf/defc text-shape-edit
+  [{:keys [shape] :as props}]
+  (let [ref (mf/use-ref)
+        {:keys [id x y width height content]} shape]
+    (mf/use-effect
+     #(fn []
+        (let [content (-> (mf/ref-val ref)
+                          (dom/get-value))]
+          (st/emit! (udw/update-shape id {:content content})))))
+    [:foreignObject {:x x :y y :width width :height height}
+     [:textarea {:style (make-style shape)
+                 :default-value content
+                 :ref ref}]]))

 ;; --- Text Shape Wrapper


A little more space between the file and namespace

--- src/midje/emission/plugins/util.clj
+++ src/midje/emission/plugins/util.clj
@@ -82,7 +82,7 @@
 (defn position-str
   "Describe a failure with its namespace"
   [[filename line-num] namespace]
-  (let [namespace (if namespace (str " " namespace) "")]
+  (let [namespace (if namespace (str "  " namespace) "")]
       (format "(%s:%s%s)" filename line-num namespace)))

 ;; TODO: The binding-note comes pre-formatted. Would probably be better


Set tone duration to 8 bars

Set tone duration to 8 bars

--- src/overtone_workspace/grunbles.clj
+++ src/overtone_workspace/grunbles.clj
@@ -3,10 +3,10 @@

 ;; Inspired by an example in an early chapter of the SuperCollider book

-(definst grumble [speed 6 freq-mul 1]
+(definst grumble [speed 6 freq-mul 1 attack 10 release 50]
   (let [snd (mix (map #(* (lf-tri (* % freq-mul 100))
                           (max 0 (+ (lf-noise1:kr speed)
-                                    (env-gen (perc 20 100) :action FREE))))
+                                    (env-gen (perc attack release) :action FREE))))
                       [1 (/ 2 3) (/ 3 2) 2]))]
     (pan2 snd (sin-osc:kr 0.125))))

@@ -19,23 +19,26 @@
 ;; (grumble :freq-mul 2)
 ;; (ctl grumble :speed 3000)

-(volume (/  4  127))
+(volume (/  10  127))

 (def metro (metronome 128))

-(defn player [beat notes]
-  (let [notes (if (empty? notes)
-                [4 8 2 1.5]
-                notes)]
+(defn player [beat rates]
+  (let [rates (if (empty? rates)
+                [4 8 2 2 1.5 1.5]
+                rates)
+        bpm (metro :bpm)
+        dur (/ 60.0 bpm)
+        attack (* dur 4) ; 1bar
+        rel (* dur (* 4 7))]  ; 7bars
     (at (metro beat)
         (do
-          (if (zero? (mod beat 8)) (grumble :freq-mul 0.5))
-          (if (zero? (mod beat 8)) (grumble :freq-mul 1))
+          (if (zero? (mod beat 8)) (grumble :freq-mul 0.5 :attack attack :release rel))
+          (if (zero? (mod beat 8)) (grumble :freq-mul 1 :attack attack :release rel))
+          (if (zero? (mod beat 16))
+            (grumble :freq-mul (choose rates) :attack attack :release rel))
           ))
-    (at (metro (+ 0.5 beat))
-        (if (zero? (mod beat 16))
-          (grumble :freq-mul (choose notes))))
-    (apply-by (metro (inc beat)) #'player (inc beat) (next notes) [])
+    (apply-by (metro (inc beat)) #'player (inc beat) (next rates) [])
     ))

 ;;(player (metro) [])


(PDB-3096) Factor out command-processed message logging

Also pre-stringify the command duration to make sure it doesn't get logged with
locale-specific number formatting.

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -263,6 +263,18 @@
       (when command-stream
         (.close command-stream)))))

+(defn log-command-processed-messsage [id received-time start-time command-kw certname & [opts]]
+  ;; manually stringify these to avoid locale-specific formatting
+  (let [id (str id)
+        received-time (str (tcoerce/to-long received-time))
+        duration (str (in-millis (interval start-time (now))))
+        command-name (command-names command-kw)]
+    (if-let [{:keys [puppet-version]} opts]
+      (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' puppet v{4} command processed for {5}"
+                     id received-time duration command-name puppet-version certname))
+      (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' command processed for {4}"
+                     id received-time duration command-name certname)))))
+
 ;; Catalog replacement

 (defn replace-catalog*
@@ -271,12 +283,7 @@
     (jdbc/with-transacted-connection' db :repeatable-read
       (scf-storage/maybe-activate-node! certname producer-timestamp)
       (scf-storage/replace-catalog! catalog received))
-    (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' command processed for {4}"
-                   (str id)
-                   (str (tcoerce/to-long received))
-                   (in-millis (interval start-time (now)))
-                   (command-names :replace-catalog)
-                   certname))))
+    (log-command-processed-messsage id received start-time :replace-catalog certname)))

 (defn replace-catalog [{:keys [payload received version] :as command} start-time db]
   (let [validated-payload (upon-error-throw-fatality
@@ -294,12 +301,7 @@
     (jdbc/with-transacted-connection' db :repeatable-read
       (scf-storage/maybe-activate-node! certname producer-timestamp)
       (scf-storage/replace-facts! fact-data))
-    (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' command processed for {4}"
-                   (str id)
-                   (str (tcoerce/to-long received))
-                   (in-millis (interval start-time (now)))
-                   (command-names :replace-facts)
-                   certname))))
+    (log-command-processed-messsage id received start-time :replace-facts certname)))

 (defn replace-facts [{:keys [payload version received] :as command} start-time db]
   (replace-facts* (upon-error-throw-fatality
@@ -326,12 +328,7 @@
       (when-not (scf-storage/certname-exists? certname)
         (scf-storage/add-certname! certname))
       (scf-storage/deactivate-node! certname producer-timestamp))
-    (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' command processed for {4}"
-                   (str id)
-                   (str (tcoerce/to-long received))
-                   (in-millis (interval start-time (now)))
-                   (command-names :deactivate-node)
-                   certname))))
+    (log-command-processed-messsage id received start-time :deactivate-node certname)))

 (defn deactivate-node [{:keys [payload version] :as command} start-time db]
   (-> command
@@ -350,13 +347,8 @@
     (jdbc/with-transacted-connection db
       (scf-storage/maybe-activate-node! certname producer-timestamp)
       (scf-storage/add-report! report received))
-    (log/info (trs "[{0}-{1}] [{2} ms] ''{3}'' puppet v{4} command processed for {5}"
-                   (str id)
-                   (str (tcoerce/to-long received))
-                   (in-millis (interval start-time (now)))
-                   (command-names :store-report)
-                   puppet_version
-                   certname))))
+    (log-command-processed-messsage id received start-time :store-report certname
+                                    {:puppet-version puppet_version})))

 (defn store-report [{:keys [payload version received] :as command} start-time db]
   (let [validated-payload (upon-error-throw-fatality


clearing bouncer

clearing bouncer

--- src/celestial/config.clj
+++ src/celestial/config.clj
@@ -15,8 +15,6 @@
   (:use
     [subs.core :only (validate! combine validation when-not-nil)]
     [clojure.pprint :only (pprint)]
-    [bouncer [core :as b] [validators :as v]]
-    [bouncer.validators :only (defvalidator)]
     [taoensso.timbre :only (set-config! set-level! debug info error warn trace)]
     [clojure.core.strint :only (<<)]
     [clojure.java.io :only (file)]


CMR-3003: Add more docs for compare-vectors

--- common-lib/src/cmr/common/util.clj
+++ common-lib/src/cmr/common/util.clj
@@ -644,7 +644,12 @@
       (vec result))))

 (defn compare-vectors
-  "Compares two vectors of potentially unequal size"
+  "Compares two vectors of potentially unequal size. The default comparator
+   for vectors considers length first, regardless of contents. compare-vectors
+   compares in a manner similar to strings, where contents are considered first.
+
+   > (compare [1 2 3] [2 1]) => 1
+   > (compare-vectors [1 2 3] [2 1]) => -1"
   [v0 v1]
   (let [len (min (count v0) (count v1))
         cmp (compare (subvec v0 0 len) (subvec v1 0 len))]


cljs.closure/get-upstream-deps: Add optional CLASSLOADER arg.

Weasel & Piggieback don't run this function from the main thread, which
is why the function fails to gather the dependencies.

This introduces an optional (to keep the old behavior around) argument
which allows the caller to specify the classloader to use.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -906,13 +906,17 @@

 (defn get-upstream-deps*
-  "returns a merged map containing all upstream dependencies defined by libraries on the classpath"
-  []
-  (let [classloader (. (Thread/currentThread) (getContextClassLoader))
-        upstream-deps (map #(read-string (slurp %)) (enumeration-seq (. classloader (findResources "deps.cljs"))))]
-    #_(doseq [dep upstream-deps]
-      (println (str "Upstream deps.cljs found on classpath. " dep " This is an EXPERIMENTAL FEATURE and is not guarenteed to remain stable in future versions.")))
-    (apply merge-with concat upstream-deps)))
+  "returns a merged map containing all upstream dependencies defined
+  by libraries on the classpath. Should be run in the main thread. If
+  not, pass (java.lang.ClassLoader/getSystemClassLoader) to use the
+  system classloder."
+  ([]
+   (get-upstream-deps* (. (Thread/currentThread) (getContextClassLoader))))
+  ([classloader]
+   (let [upstream-deps (map #(read-string (slurp %)) (enumeration-seq (. classloader (findResources "deps.cljs"))))]
+     #_(doseq [dep upstream-deps]
+         (println (str "Upstream deps.cljs found on classpath. " dep " This is an EXPERIMENTAL FEATURE and is not guarenteed to remain stable in future versions.")))
+     (apply merge-with concat upstream-deps))))

 (def get-upstream-deps (memoize get-upstream-deps*))


Shorten version hash in email

Shorten version hash in email

Closes #10

--- src/clj/runbld/email.clj
+++ src/clj/runbld/email.clj
@@ -119,7 +119,9 @@
                  (format "%s %s %s"
                          (-> build :process :status)
                          (-> build :build :org-project-branch)
-                         (-> build :vcs :commit-short))))))
+                         (-> build :vcs :commit-short)))
+       (update-in [:version :hash]
+                  #(->> % (take 7) (apply str))))))

 (defn maybe-send! [opts {:keys [index type id] :as addr}]
   (let [build-doc (store/get (-> opts :es :conn) addr)


Print out simulation timestamp properly

Print out simulation timestamp properly

--- src/clj_gatling/core.clj
+++ src/clj_gatling/core.clj
@@ -1,6 +1,8 @@
 (ns clj-gatling.core
-  (:use [clojure.set :only [rename-keys]])
-  (:import (io.gatling.charts.report ReportsGenerator)
+  (:use [clojure.set :only [rename-keys]]
+        [clj-time.format :only [formatter unparse-local]])
+  (:import (org.joda.time LocalDateTime)
+           (io.gatling.charts.report ReportsGenerator)
            (io.gatling.charts.result.reader FileDataReader)
            (io.gatling.core.config GatlingConfiguration))
   (:require [clojure.core.async :as async :refer [go <! >!]]
@@ -66,7 +68,8 @@
     (conj requests ["SCENARIO" "Scenario name" (.toString (:id scenario)) start end])))

 (defn create-result-lines [result]
-  (let [header ["RUN" "20140124213040" "basicexamplesimulation" "\u0020"]
+  (let [timestamp (unparse-local (formatter "yyyyMMddhhmmss") (LocalDateTime.))
+        header ["RUN" timestamp "simulation" "\u0020"]
         scenarios (apply concat (map #(vector (map-scenario %)) result))
        result-lines (conj (flatten-one-level scenarios) header)]
     (println result-lines)


Return summary from run-simulation

Return summary from run-simulation

Summary is following map
{:ok <number-of-successful-requests> :ko <number-of-failed-requests>}

--- src/clj_gatling/core.clj
+++ src/clj_gatling/core.clj
@@ -16,19 +16,20 @@
    (spit (str path "/simulation" idx ".log") csv)))

 (defn run-simulation [scenarios concurrency & [options]]
- (let [start-time (LocalDateTime.)
-       results-dir (str (or (:root options) "target/results")
-                        "/"
-                        (timestamp-str))
-       step-timeout (or (:timeout-in-ms options) 5000)
-       result (simulation/run-scenarios {:runner (choose-runner scenarios concurrency options)
-                                         :timeout step-timeout
-                                         :context (:context options)}
-                                        (weighted-scenarios (range concurrency) scenarios))]
-   (create-dir (str results-dir "/input"))
-   (report/create-result-lines start-time
-                               buffer-size
-                               result
-                               (partial gatling-csv-writer (str results-dir "/input")))
-   (chart/create-chart results-dir)
-   (println (str "Open " results-dir "/index.html"))))
+  (let [start-time (LocalDateTime.)
+        results-dir (str (or (:root options) "target/results")
+                         "/"
+                         (timestamp-str))
+        step-timeout (or (:timeout-in-ms options) 5000)
+        result (simulation/run-scenarios {:runner (choose-runner scenarios concurrency options)
+                                          :timeout step-timeout
+                                          :context (:context options)}
+                                         (weighted-scenarios (range concurrency) scenarios))]
+    (create-dir (str results-dir "/input"))
+    (let [summary (report/create-result-lines start-time
+                                              buffer-size
+                                              result
+                                              (partial gatling-csv-writer (str results-dir "/input")))]
+      (chart/create-chart results-dir)
+      (println (str "Open " results-dir "/index.html"))
+      summary)))


Add main function `run` for executing clj-gatling using new schema

--- src/clj_gatling/core.clj
+++ src/clj_gatling/core.clj
@@ -15,17 +15,20 @@
   (let [csv (csv/write-csv result-lines :delimiter "\t" :end-of-line "\n")]
    (spit (str path "/simulation" idx ".log") csv)))

+(defn- create-results-dir [root]
+  (let [results-dir (str root "/" (timestamp-str))]
+    (create-dir (str results-dir "/input"))
+    results-dir))
+
 (defn run-simulation [scenarios concurrency & [options]]
   (let [start-time (LocalDateTime.)
-        results-dir (str (or (:root options) "target/results")
-                         "/"
-                         (timestamp-str))
+        results-dir (create-results-dir (or (:root options) "target/results"))
         step-timeout (or (:timeout-in-ms options) 5000)
         result (simulation/run-scenarios {:runner (choose-runner scenarios concurrency options)
-                                          :timeout step-timeout
+                                          :timeout-in-ms step-timeout
                                           :context (:context options)}
-                                         (weighted-scenarios (range concurrency) scenarios))]
-    (create-dir (str results-dir "/input"))
+                                         (weighted-scenarios (range concurrency) scenarios)
+                                         true)]
     (let [summary (report/create-result-lines start-time
                                               buffer-size
                                               result
@@ -33,3 +36,23 @@
       (chart/create-chart results-dir)
       (println (str "Open " results-dir "/index.html"))
       summary)))
+
+(defn run [simulation {:keys [concurrency root timeout-in-ms context requests duration]
+                       :or {concurrency 1
+                            root "target/results"
+                            timeout-in-ms 5000
+                            context {}}}]
+  (let [start-time (LocalDateTime.)
+        results-dir (create-results-dir root)
+        result (simulation/run simulation {:concurrency concurrency
+                                           :timeout-in-ms timeout-in-ms
+                                           :context context
+                                           :requests requests
+                                           :duration duration})
+        summary (report/create-result-lines start-time
+                                            buffer-size
+                                            result
+                                            (partial gatling-csv-writer (str results-dir "/input")))]
+    (chart/create-chart results-dir)
+    (println (str "Open file://" results-dir "/index.html"))
+    summary))


remove lectures temporarily

remove lectures temporarily

--- src/cljs/cs95/views.cljs
+++ src/cljs/cs95/views.cljs
@@ -25,7 +25,7 @@
 (def nav-data
   [{:event-key :home :href "#/" :title "Overview"}
    {:event-key :syllabus :href "#/syllabus" :title "Syllabus"}
-   {:event-key :lectures :href "#/lectures" :title "Lectures"}
+   #_{:event-key :lectures :href "#/lectures" :title "Lectures"}
    #_{:event-key :assignments :href "#/assignments" :title "Assignments"}
    {:event-key :resources :href "#/resources" :title "Resources"}
    {:event-key :candy :href "#/candy" :title "Candy"}])


Replaced table of raw timing with a relative performance (per-test) table.

--- src/validation_benchmark/report.clj
+++ src/validation_benchmark/report.clj
@@ -8,6 +8,7 @@

 (declare calculate-summary
+         calculate-relative-performance
          render-html)

@@ -15,13 +16,32 @@
   (let [current-directory (System/getProperty "user.dir")
         html-path (str report-path "/index.html")
         chart-path (str report-path "/chart.png")
-        summary (calculate-summary groups results)]
+        summary (calculate-summary groups results)
+        relative-performance (calculate-relative-performance summary)]
     (println "Summary: "
              (str "file://" current-directory "/" html-path))
     (make-parents html-path)
     (with-open [w (writer html-path)]
-      (.write w (render-html summary)))
+      (.write w (render-html relative-performance)))
     (make-chart summary chart-path)))
+
+
+(defn calculate-relative-performance [summary]
+  (let [last-of-each (partial mapv last)
+        normalize #(let [m (apply min %)]
+                     (mapv (fn [k] (/ k m)) %))
+        group-by-first (partial group-by first)
+        f (comp normalize last-of-each)
+        rows (->> summary
+                  (group-by-first)
+                  (map (fn [[k v]] [k (f v)]))
+                  (into (sorted-map)))
+        columns (->> summary
+                     (group-by-first)
+                     (vals)
+                     (first)
+                     (mapv second))]
+    [columns rows]))

 (defn calculate-summary [groups results]
@@ -66,22 +86,24 @@
    [:img {:src "chart.png"}]])

-(defn- relative-performance-table [summary]
-  [:div
-   [:h2 {:id "relative-performance-table"} "Relative performance table"]
-   (->> (for [[t l m] summary]
-          [:tr
-           [:td (pr-str t)]
-           [:td (pr-str l)]
-           [:td (format "%10.3f" m)]])
-        (into [:table {:class "table"}
-               [:tr
-                [:th "Test name"]
-                [:th "Library"]
-                [:th "Mean (ns)"]]]))])
+(defn- relative-performance-table [[columns rows]]
+  (let [header (->> columns (map (partial vector :th))
+                    (into [:tr [:th "Test"]]))]
+    [:div
+     [:h2 {:id "relative-performance-table"} "Relative performance table"]
+     (into [:table {:class "table"} header]
+           (for [[k vs] rows]
+             (into [:tr [:td [:code (pr-str k)]]]
+                   (map (fn [v]
+
+                          [:td {:class (cond
+                                         (<= v 1.05) "success"
+                                         (<= v 3.0) "warning"
+                                         :else "danger")}
+                           (format "%.3f" v)]) vs))))]))

-(defn- render-html [summary]
+(defn- render-html [relative-performance]
   (html5 [:head
           [:link {:rel "stylesheet"
                   :href "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.6/css/bootstrap.min.css"
@@ -111,7 +133,7 @@
            [:div {:class "row"}
             [:div {:class "col-md-10"}
              (about)
-             (relative-performance-table summary)
+             (relative-performance-table relative-performance)
              (performance-graph)]
             [:div {:id "navbar"
                    :class "col-md-2"}


Correctly show pokemon

Correctly show pokemon

--- frontend/src/cruncher/views.cljs
+++ frontend/src/cruncher/views.cljs
@@ -82,14 +82,14 @@
   (dom/form #js {:id   "google-ptc-switch"
                  :role "form"}
             (dom/label #js {:className "radio-inline"}
-                       (dom/input #js {:type "radio"
+                       (dom/input #js {:type    "radio"
                                        :onClick #(commit-component-state this :service "google")
-                                       :name "google-ptc-switch"})
+                                       :name    "google-ptc-switch"})
                        "Google")
             (dom/label #js {:className "radio-inline"}
-                       (dom/input #js {:type "radio"
+                       (dom/input #js {:type    "radio"
                                        :onClick #(commit-component-state this :service "ptc")
-                                       :name "google-ptc-switch"})
+                                       :name    "google-ptc-switch"})
                        "Pokemon Trainer Club")))

 (defui Login
@@ -133,22 +133,22 @@

 (defn view-dispatcher
   "Dispatch current template in main view by the app state."
-  []
+  [this]
   (let [view (lib/current-view)]
     (cond
-      (= view :login) (login)
-      (not (lib/logged-in?)) (login)
-      :else (poketable))))
+      (= view :login) (login (om/props this))
+      (not (lib/logged-in?)) (login (om/props this))
+      :else (poketable (om/props this)))))

 (defui ErrorMessage
   Object
   (render [this]
     (when (lib/error?)
       (dom/div #js {:className "alert alert-warning"}
-               (dom/a #js {:href "#"
-                           :className "close"
+               (dom/a #js {:href         "#"
+                           :className    "close"
                            :data-dismiss "alert"
-                           :aria-label "close"}
+                           :aria-label   "close"}
                       (vlib/safe-html "×"))
                (dom/strong nil "Error: ")
                (lib/get-error)))))
@@ -160,7 +160,7 @@
     (dom/div nil
              (dom/div nil (header (om/props this)))
              (dom/div nil (error-message (om/props this)))
-             (view-dispatcher)
+             (view-dispatcher this)
              #_(dom/div nil (poketable (om/props this)))
              #_(dom/div nil (login))
              (dom/div nil (vlib/loader)))))


Upgrade karma to 5.1.1

Upgrade karma to 5.1.1

--- src/deps.cljs
+++ src/deps.cljs
@@ -1,5 +1,5 @@
 {:npm-dev-deps {"shadow-cljs"           "2.11.0"
-                "karma"                 "4.4.1"
+                "karma"                 "5.1.1"
                 "karma-chrome-launcher" "3.1.0"
                 "karma-cljs-test"       "0.1.0"
                 "karma-junit-reporter"  "2.0.1"}}


CMR-3527: Modified relations.clj

CMR-3527: Modified relations.clj

--- spatial-lib/src/cmr/spatial/relations.clj
+++ spatial-lib/src/cmr/spatial/relations.clj
@@ -107,7 +107,7 @@

   (pt
     [line]
-    (-> line :point1))
+    (-> line :points first))

   (contains-north-pole?
     [line]


shorten sharing menu copy for public

shorten sharing menu copy for public

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -268,8 +268,8 @@
            [:h2
             [:span "This document is "]
             [:span.privacy-public-word "public."]]
-           [:p.privacy-public-words "It's visible to everyone who can guess the URL.
-               Email a friend to invite them to collaborate."]
+           [:p.privacy-public-words "It's visible to anyone with the url.
+                                    Email a friend to invite them to collaborate."]
            (if-not (:cust app)
              [:a.menu-button {:href (auth/auth-url)
                               :on-click #(do


everyone can copy/paste, now

everyone can copy/paste, now

--- src-cljs/frontend/components/overlay.cljs
+++ src-cljs/frontend/components/overlay.cljs
@@ -575,7 +575,6 @@
 (defn shortcuts [app owner]
   (reify
     om/IDisplayName (display-name [_] "Overlay Shortcuts")
-    om/IInitState (init-state [_] {:copy-paste-works? (ua/isChrome)})
     om/IRender
     (render [_]
       (let [cast! (om/get-shared owner :cast!)]
@@ -625,22 +624,18 @@
              ;;
              [:tr.make
               [:td {:col-span "2"}]]
-             (when (om/get-state owner [:copy-paste-works?])
-               (list
-                (html
-                 [:tr.make
-                  [:td
-                   [:div.shortcuts-keys
-                    [:div.shortcuts-key {:title "Command Key"} (common/icon :command)]
-                    [:div.shortcuts-key {:title "C Key"} "C"]]]
-                  [:td [:div.shortcuts-result {:title "Hold command, press \"C\"."} "Copy"]]])
-                (html
-                 [:tr.make
-                  [:td
-                   [:div.shortcuts-keys
-                    [:div.shortcuts-key {:title "Command Key"} (common/icon :command)]
-                    [:div.shortcuts-key {:title "V Key"} "V"]]]
-                  [:td [:div.shortcuts-result {:title "Hold command, press \"V\"."} "Paste"]]])))
+             [:tr.make
+              [:td
+               [:div.shortcuts-keys
+                [:div.shortcuts-key {:title "Command Key"} (common/icon :command)]
+                [:div.shortcuts-key {:title "C Key"} "C"]]]
+              [:td [:div.shortcuts-result {:title "Hold command, press \"C\"."} "Copy"]]]
+             [:tr.make
+              [:td
+               [:div.shortcuts-keys
+                [:div.shortcuts-key {:title "Command Key"} (common/icon :command)]
+                [:div.shortcuts-key {:title "V Key"} "V"]]]
+              [:td [:div.shortcuts-result {:title "Hold command, press \"V\"."} "Paste"]]]
              [:tr.make
               [:td
                [:div.shortcuts-keys


Fix production not finding the clicked event class

--- src/constraint/edit.cljs
+++ src/constraint/edit.cljs
@@ -95,11 +95,10 @@

 (defn event->class [e]
-  (-> e
-      (js->clj)
-      (.-target)
-      (.-className)
-      (.-baseVal)))
+  (.item (-> e
+             (js->clj)
+             (.-target)
+             (.-classList)) 0))

 (defn is-connected? [vertex [_ [from to _]]]
   (or (= vertex from)


cljs-value? check should survive advanced mode optimizations

--- src/devtools/format.cljs
+++ src/devtools/format.cljs
@@ -39,8 +39,8 @@
 ; [14:05:00] dnolen: this property is unlikely to change - still it's probably not something anything anyone should use w/o a really good reason
 (defn cljs-value? [value]
   (try
-    (exists? (aget value "constructor" "cljs$lang$type"))
-    (catch js/Object _
+    (.. value -constructor -cljs$lang$type)
+    (catch :default _
       false)))

 (defn surrogate? [value]


Have a working (but hideous) version of constrained records that creates a constrained factory fn allowing kwargs

--- src/fogus/me/trammel.clj
+++ src/fogus/me/trammel.clj
@@ -248,23 +248,37 @@
   "not yet working. do not attempt to use."
   [name slots & etc]
   (let [fields   (->> slots (partition 2) (map first) vec)
-        defaults (->> slots (partition 2) (map second))]
+        defaults (->> slots (partition 2) (map second))
+        fmap     (first (build-forms-map (list* '[] etc)))
+        body     (:body (fmap []))
+        reqs     (:requires (fmap []) '(()))
+        ens      (:ensures (fmap []) '(()))]
     `(do
-      (defrecord ~name
+       (defrecord ~name
          ~fields
-         )
+         ~@body)
        (defconstrainedfn ~(symbol (str "new-" name))
          [& {:keys ~fields :as kwargs#}]
+         :requires ~@reqs
+         :ensures  ~@ens
          :body
          (-> (~(symbol (str name \.)) ~@defaults)
-             (merge kwargs#))
-         ~@etc)
+             (merge kwargs#)))
        ~name)))

 (comment
-  (defconstrainedrecord Foo [a b]
+  (defconstrainedrecord Foo [a 1 b 2]
     :requires (every? number? [a b])
     :body
     Object
     (toString [this] (str "record Foo has " a " and " b)))
+
+  (str (Foo. 3 4))
+  (str (new-Foo :a 3 :b 5))
+
+  (macroexpand '(defconstrainedrecord Foo [a b]
+    :requires (every? number? [a b])
+    :body
+    Object
+    (toString [this] (str "record Foo has " a " and " b))))
 )


GM: Add inactive tab test

GM: Add inactive tab test

--- test/hatti/views/dataview_test.cljs
+++ test/hatti/views/dataview_test.cljs
@@ -48,5 +48,13 @@

 (deftest tabbed-dataview-tests
   (let [tabbed-view (tabbed-dataview-container shared/app-state)]
-    (testing "All tabs are rendered when none is disabled"
-      (is (re-find #"inactive" (dommy/html tabbed-view))))))
+    (testing "Map tab is not rendered when there is no geodata"
+      (is (= "map"
+             (-> tabbed-view (sel1 :div.tab-bar) (sel1 :.inactive) (dommy/html)))))
+    #_(testing "Map, Chart and Table tabs are disabled"
+      (let [_ (shared/transact-app-state! shared/app-state
+                                                [:views :disabled]
+                                                [:map :chart :table])
+            tabbed-view (tabbed-dataview-container shared/app-state)]
+        (is (= "map chart table"
+               (-> tabbed-view (sel1 :div.tab-bar) (sel1 :.inactive) (dommy/html))))))))


Strip out no-longer-used variant of short-circuiting-failure

--- src/midje/semi_sweet.clj
+++ src/midje/semi_sweet.clj
@@ -106,14 +106,10 @@
 )

-(defmacro #^{:private true} short-circuiting-failure
-  ([form expected]
-   `(short-circuiting-failure ~form ~expected nil))
-
-  ([form expected failure-message]
+(defmacro #^{:private true} short-circuiting-failure [form expected]
   `(with-handler (let [code-under-test-result# (eagerly ~form)]
-		   (is (= code-under-test-result# ~expected) ~failure-message))
-		 (handle *failure-during-computation* [])))
+		   (is (= code-under-test-result# ~expected)))
+		 (handle *failure-during-computation* []))
 )

 (defn arg-matcher-maker [expected]


Use peer group

Use peer group

--- test/onyx/peer/fn_grouping_test.clj
+++ test/onyx/peer/fn_grouping_test.clj
@@ -17,6 +17,8 @@
     :onyx.peer/job-scheduler :onyx.job-scheduler/round-robin))

 (def env (onyx.api/start-env env-config))
+
+(def peer-group (onyx.api/start-peer-group peer-config))

 (def output (atom []))

@@ -134,7 +136,7 @@
 (>!! in-chan :done)
 (close! in-chan)

-(def v-peers (onyx.api/start-peers 3 peer-config))
+(def v-peers (onyx.api/start-peers 3 peer-group))

 (onyx.api/submit-job
  peer-config
@@ -156,5 +158,7 @@
 (doseq [v-peer v-peers]
   (onyx.api/shutdown-peer v-peer))

+(onyx.api/shutdown-peer-group peer-group)
+
 (onyx.api/shutdown-env env)


Fixes test assertion.

Fixes test assertion.

--- test/onyx/peer/tail_params_test.clj
+++ test/onyx/peer/tail_params_test.clj
@@ -7,7 +7,6 @@
             [onyx.api]))

 (defn handle-exception [event lifecycle lf-kw exception]
-  (println "Handling exception" exception)
   :kill)

 (def exception-calls
@@ -90,4 +89,8 @@
           (is false)
           (catch Exception e
             (is (= "fail" (.getMessage e)))
-            (is (= {:x 50}) (ex-data e))))))))
+            (is (= {:x 50
+                    :original-exception :clojure.lang.ExceptionInfo
+                    :offending-task :out
+                    :offending-segment {:n 0}}
+                   (ex-data e)))))))))


fixes

fixes

--- src/node/game/cards.cljs
+++ src/node/game/cards.cljs
@@ -1531,7 +1531,7 @@

    "Atman"
    {:prompt "How many power counters?" :choices :credit :msg (msg "add " target " power counters")
-    :effect (effect (lose :credit target) (set-prop card :counter target))
+    :effect (effect (set-prop card :counter target))
     :abilities [{:cost [:credit 1] :msg "break 1 subroutine"}]}

    "Aurora"
@@ -1781,7 +1781,7 @@

    "Dracō"
    {:prompt "How many power counters?" :choices :credit :msg (msg "add " target " power counters")
-    :effect (effect (lose :credit target) (set-prop card :counter target))
+    :effect (effect (set-prop card :counter target))
     :abilities [{:label "Trace 2"
                  :trace {:base 2 :msg "give the Runner 1 tag and end the run"
                          :effect (effect (gain :runner :tag 1) (end-run))}}]}


Typo 2.

Typo 2.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -402,7 +402,7 @@
 {
   \"@context\": \"http://schema.org\",
   \"@type\": \"EmailMessage\",
-  \"description\": \"" (or (:digest-subject data) (digest-title org-name)) "\",
+  \"description\": \"" (or (:digest-subject data) (digest-title (:org-name data))) "\",
   \"potentialAction\": {
     \"@type\": \"ViewAction\",
     \"target\": \"" (get-digest-url data) "\",


Use origin header if present for building the location url

--- src/org/akvo/resumed.clj
+++ src/org/akvo/resumed.clj
@@ -114,14 +114,17 @@
 (defn get-location
   "Get Location string from request"
   [req]
-  (format "%s://%s%s%s"
-          (name (:scheme req))
-          (:server-name req)
-          (if (and (not= (:server-port req) 80)
-                   (not= (:server-port req) 443))
-            (str ":" (:server-port req))
-            "")
-          (:uri req)))
+  (let [origin (get-in req [:headers "origin"])]
+    (if (not (str/blank? origin))
+      (format "%s%s" origin (:uri req))
+      (format "%s://%s%s%s"
+              (name (:scheme req))
+              (:server-name req)
+              (if (and (not= (:server-port req) 80)
+                       (not= (:server-port req) 443))
+                (str ":" (:server-port req))
+                "")
+              (:uri req)))))

 (defn post
   [req opts]


Add fns to resolve a node id and map a node's control params to a control bus

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -24,6 +24,25 @@
   (if (bus? val)
     (:id val)
     val))
+
+(defn node-id
+  "Resolves the id of node. If it's an instrument, returns the group id, else
+  just returns the node unchanged. Throws an exception if the id isn't an
+  integer"
+  [node]
+  (let [id (if   (and (associative? node)
+                      (= ::instrument (:type node))) (:group node) node)]
+    (if-not (integer? id)
+      (throw (Exception. (str "The following node id is not an integer:" id)))
+      id)))
+
+(defn map-ctl
+  "Maps node's control param to the values in the control-bus"
+  [node control control-bus]
+  (let [n-id (node-id node)
+        ctl (to-str control)
+        bus (bus->id control-bus)]
+    (snd "/n_map" n-id ctl bus)))

 (defn- map-and-check-node-args
   [arg-map]


removed moved ns

removed moved ns

--- main/src/dda/pallet/dda_serverspec_crate/app/summary.clj
+++ main/src/dda/pallet/dda_serverspec_crate/app/summary.clj
@@ -1,65 +0,0 @@
-; Licensed to the Apache Software Foundation (ASF) under one
-; or more contributor license agreements. See the NOTICE file
-; distributed with this work for additional information
-; regarding copyright ownership. The ASF licenses this file
-; to you under the Apache License, Version 2.0 (the
-; "License"); you may not use this file except in compliance
-; with the License. You may obtain a copy of the License at
-;
-; http://www.apache.org/licenses/LICENSE-2.0
-;
-; Unless required by applicable law or agreed to in writing, software
-; distributed under the License is distributed on an "AS IS" BASIS,
-; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-; See the License for the specific language governing permissions and
-; limitations under the License.
-(ns dda.pallet.dda-serverspec-crate.app.summary
-  (:require
-   [schema.core :as s]
-   [dda.config.commons.styled-output :as styled]))
-
-(defn run-results [session]
-  (:runs (pallet.core.data-api/session-data session)))
-
-(defn node-results [session]
-  (filter some? (:action-results (second (run-results session)))))
-
-(defn summarize-tests [test-results indent verbose]
-  (doseq [test-result (clojure.string/split-lines test-results)]
-    (println (str "    " test-result))))
-
-(defn summarize-node-tests [action-results indent verbose]
-  (doseq [action-result action-results]
-    (let [{:keys [context summary-text out result]} action-result]
-      (println (str "  " context " - ")
-        (if (:test-passed result)
-          (styled/styled summary-text :green)
-          (styled/styled summary-text :red)))
-      (when (> verbose 0)
-        (summarize-tests out (+ 2 indent) verbose)))))
-
-(defn tests-passed? [action-result]
-  (get-in action-result [:result :test-passed]))
-
-(defn run-passed?
-  [run]
-  (let [action-results (filter some? (:action-results run))]
-    (every? tests-passed? action-results)))
-
-(defn summarize-test-session
-  [session & {:keys [verbose] :or {verbose 0}}]
-  (let [runs (run-results session)]
-    (doseq [run runs]
-      (let [action-results (filter some? (:action-results run))]
-        (println
-          (str
-            (get-in run [:node :primary-ip]) " - "
-            (if (run-passed? run)
-              (styled/styled "PASSED" :green)
-              (styled/styled "FAILED" :red))))
-        (summarize-node-tests action-results 2 verbose)))))
-
-(defn session-passed?
-  [session]
-  (let [runs (run-results session)]
-    (every? run-passed? runs)))


recreate 'format' fn for CLJS tests

recreate 'format' fn for CLJS tests

--- test/calfpath/core_test.cljc
+++ test/calfpath/core_test.cljc
@@ -9,10 +9,15 @@

 (ns calfpath.core-test
   (:require
+    #?(:cljs [goog.string :as gstring])
+    #?(:cljs [goog.string.format])
     #?(:cljs [cljs.test    :refer-macros [deftest is testing]]
         :clj [clojure.test :refer        [deftest is testing]])
     #?(:cljs [calfpath.core :as c :include-macros true]
         :clj [calfpath.core :as c])))
+
+
+#?(:cljs (defmacro format [& args] `(gstring/format ~@args)))

 (deftest test-->uri


formatting

formatting

--- test/cellophane/dom_test.clj
+++ test/cellophane/dom_test.clj
@@ -231,26 +231,27 @@
 (deftest test-render-simple-recursive-example
   (let [ctor (cellophane/factory SimpleTree)]
     (is (= (dom/render-to-str (ctor simple-tree-data))
-          (remove-whitespace "

-

-
Node value:1

-

-

-
Node value:2

-

-

-
Node value:3

-

-

-

-

-

-
Node value:4

-

-

-

-

-
")))))
+          (remove-whitespace
+            "

+

+
Node value:1

+

+

+
Node value:2

+

+

+
Node value:3

+

+

+

+

+

+
Node value:4

+

+

+

+

+
")))))

 (defn MultipleTextChildren []
   (dom/div nil
@@ -313,23 +314,25 @@
 (deftest test-render-links-tutorial
   (let [ctor (cellophane/factory LinksSomeList)]
     (is (= (dom/render-to-str (ctor links-init-data))
-          (remove-whitespace "

-
A List!

-

-

-
Foo

-
bob.smith@gmail.com

-

-

-
Bar

-
bob.smith@gmail.com

-

-

-
Baz

-
bob.smith@gmail.com

-

-

-
")))))
+          (remove-whitespace
+            "

+
A List!

+

+

+
Foo

+
bob.smith@gmail.com

+

+

+
Bar

+
bob.smith@gmail.com

+

+

+
Baz

+
bob.smith@gmail.com

+

+

+
")))))
+
 ;; ===================================================================
 ;; Checksums, react-ids


Remove test debugging output

Remove test debugging output

--- test/clojars/test_helper.clj
+++ test/clojars/test_helper.clj
@@ -210,5 +210,4 @@
   [params m]
   `(let [db# (:db (config/config))
          audit# (first (db/find-audit db# ~params))]
-     (prn (db/find-audit db# ~params))
      (is (~'match? ~m audit#))))


Two new tests: test-contains-1 and test-contains-2

--- test/clouseau/test_utils.clj
+++ test/clouseau/test_utils.clj
@@ -211,3 +211,21 @@
             "" (substring "Hello world!" 2 2)
             "" (substring "Hello world!" 10 10))))

+(deftest test-contains-1
+    "Check the function clouseau.utils/contains."
+    (testing "the function clouseau.utils/contains."
+        (are [x y] (= x y)
+            false (contains "Hello world!" "h")
+            true  (contains "Hello world!" "H")
+            true  (contains "Hello world!" " ")
+            true  (contains "Hello world!" "!"))))
+
+(deftest test-contains-2
+    "Check the function clouseau.utils/contains."
+    (testing "the function clouseau.utils/contains."
+        (are [x y] (= x y)
+            false (contains "Hello world!" "hello")
+            true  (contains "Hello world!" "Hello")
+            true  (contains "Hello world!" "o w")
+            true  (contains "Hello world!" "world!"))))
+


Turn off warning about loading source

Turn off warning about loading source

--- ClojureScript/replete/src/replete/repl.cljs
+++ ClojureScript/replete/src/replete/repl.cljs
@@ -231,7 +231,7 @@
 (defn- source-callback-data [path extension]
   (when-let [source (js/REPLETE_LOAD (str path extension))]
     ;; Emit a diagnostic if loading source
-    (when-not (= ".js" extension)
+    #_(when-not (= ".js" extension)
       (prn "Warning: loading non-AOT source" path extension))
     {:lang   (extension->lang extension)
      :source source}))


remove extra nilable-spec

remove extra nilable-spec

--- src/spec_tools/impl.cljc
+++ src/spec_tools/impl.cljc
@@ -86,15 +86,6 @@
     [(:spec x) (dissoc x :spec)]
     [x {}]))

-(defn nilable-spec? [spec]
-  (boolean
-    (some-> spec
-            s/form
-            seq
-            first
-            #{'clojure.spec.alpha/nilable
-              'cljs.spec.alpha/nilable})))
-
 (defn strip-fn-if-needed [form]
   (let [head (first form)]
     ;; Deal with the form (clojure.core/fn [%] (foo ... %))


Add test for sole Bcc: without To:.

Add test for sole Bcc: without To:.

--- test/postal/test/message.clj
+++ test/postal/test/message.clj
@@ -113,3 +113,12 @@
             :body "Reply me!"
             :reply-to "yermom@bar.dom"})]
     (is (.contains m "Reply-To: yermom"))))
+
+(deftest test-only-bcc
+  (let [m (message->str
+           {:from "foo@bar.dom"
+            :bcc "baz@bar.dom"
+            :subject "Test"
+            :body "Only Bcc!!"})]
+    (is (.contains m "Bcc: baz"))
+    (is (not (.contains m "To: ")))))


fix reflection warnings in either-test

fix reflection warnings in either-test

--- test/preflex/either_test.clj
+++ test/preflex/either_test.clj
@@ -27,8 +27,8 @@
         (-> (either/do-either (throw (IllegalStateException. "test error")))
           (either/bind #(throw %) identity))) "do-either throws exception")
   (is (= [210] (either/bind-deref 100
-                 (fn [x] (* 2 x))
-                 #(+ 10 %)
+                 (fn [^long x] (* 2 x))
+                 #(+ 10 ^long %)
                  (either/either vector))))
   (is (thrown? IllegalStateException
         (either/bind-deref (either/do-either (throw (IllegalStateException. "test error")))


Add some more pre/post maps

Add some more pre/post maps

--- src/superstring/core.clj
+++ src/superstring/core.clj
@@ -92,8 +92,12 @@
   Returns nil if index falls outside the string boundaries or if
   length is negative."
   ([^String s index]
+   {:pre [(string? s) (integer? index)]
+    :post [(or (string? %) (nil? %))]}
    (slice s index 1))
   ([^String s ^long index length]
+   {:pre [(string? s) (integer? index) (integer? length)]
+    :post [(or (string? %) (nil? %))]}
    (cond
      (neg? length) nil
      (neg? (+ (superstring.core/length s) index))
@@ -108,9 +112,13 @@
 (defn ^String ends-with?
   "Return s if s ends with suffix."
   ([^String s ^String suffix]
+   {:pre [(string? s) (string? suffix)]
+    :post [(or (string? %) (nil? %))]}
    (when (.endsWith s suffix)
      s))
   ([^String s ^String suffix ignore-case]
+   {:pre [(string? s) (string? suffix)]
+    :post [(or (string? %) (nil? %))]}
    (if-not ignore-case
      (ends-with? s suffix)
      (let [end (substring s (max 0 (- (length s) (length suffix))))]
@@ -122,9 +130,13 @@

   If a third argument is provided the string comparison is insensitive to case."
   ([^String s ^String prefix]
+   {:pre [(string? s) (string? prefix)]
+    :post [(or (string? %) (nil? %))]}
    (when (.startsWith s prefix)
      s))
   ([^String s ^String prefix ignore-case]
+   {:pre [(string? s) (string? prefix)]
+    :post [(or (string? %) (nil? %))]}
    (if-not ignore-case
      (starts-with? s prefix)
      (let [beg (substring s 0 (min (length s) (length prefix)))]
@@ -138,6 +150,8 @@

   Applying chop to an empty string is a no-op."
   [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
   (if (.endsWith s "\r\n")
     (substring s 0 (- (length s) 2))
     (substring s 0 (max 0 (dec (length s))))))
@@ -149,12 +163,16 @@
   If separator is not provided chomp will remove \\n, \\r or \\r\\n from
   the end of s."
   ([^String s]
+   {:pre [(string? s)]
+    :post [(string? %)]}
    (cond
      (.endsWith s "\r\n") (substring s 0 (- (length s) 2))
      (.endsWith s "\r") (substring s 0 (dec (length s)))
      (.endsWith s "\n") (substring s 0 (dec (length s)))
      :else s))
   ([^String s ^String separator]
+   {:pre [(string? s) (string? separator)]
+    :post [(string? %)]}
    (if (.endsWith s separator)
      (substring s 0 (- (length s) (length separator)))
      s)))
@@ -162,6 +180,8 @@
 (defn ^String swap-case
   "Change lower case characters to upper case and vice versa."
   [^String s]
+  {:pre [(string? s)]
+   :post [(string? %)]}
   (let [invert-case (fn [c]
                       (cond
                         (Character/isUpperCase c) (Character/toLowerCase c)
@@ -185,6 +205,8 @@
   "Pad the end of s with padding, or spaces, until the length of s matches
   width."
   ([^String s width]
+   {:pre [(string? s) (integer? width)]
+    :post [(string? %)]}
    (pad-right s width " "))
   ([^String s width ^String padding]
    {:pre [(not-empty padding)
@@ -198,6 +220,8 @@
   "Pad the beginning of s with padding, or spaces, until the length of
   s matches width."
   ([^String s width]
+   {:pre [(string? s) (integer? width)]
+    :post [(string? %)]}
    (pad-left s width " "))
   ([^String s width ^String padding]
    {:pre [(not-empty padding)
@@ -211,6 +235,8 @@
   "Pad both ends of s with padding, or spaces, until the length of s
   matches width."
   ([^String s width]
+   {:pre [(string? s) (integer? width)]
+    :post [(string? %)]}
    (center s width " "))
   ([^String s width ^String padding]
    {:pre [(not-empty padding)
@@ -231,11 +257,13 @@

   Otherwise return s."
   ([^String s ^String suffix]
+   {:pre [(string? s) (string? suffix)]
+    :post [(string? %)]}
    (chop-suffix s suffix false))
   ([^String s ^String suffix ignore-case]
-   {:pre [(not (nil? s))
-          (not (nil? suffix))]
-    :post [(not (nil? %))]}
+   {:pre [(string? s)
+          (string? suffix)]
+    :post [(string? %)]}
    (if (and (>= (length s) (length suffix))
             (ends-with? s suffix ignore-case))
      (substring s 0 (- (length s) (length suffix)))
@@ -246,11 +274,12 @@

   Otherwise return s."
   ([^String s ^String prefix]
+   {:pre [(string? s) (string? prefix)]
+    :post [(string? %)]}
    (chop-prefix s prefix false))
   ([^String s ^String prefix ignore-case]
-   {:pre [(not (nil? s))
-          (not (nil? prefix))]
-    :post [(not (nil? %))]}
+   {:pre [(string? s) (string? prefix)]
+    :post [(string? %)]}
    (if (and (>= (length s) (length prefix))
             (starts-with? s prefix ignore-case))
      (substring s (length prefix))
@@ -277,8 +306,12 @@
 (defn ^String contains?
   "Return s if s contains needle."
   ([^String s ^String needle]
+   {:pre [(string? s) (string? needle)]
+    :post [(or (string? %) (nil? %))]}
    (case-sensitive-contains s needle))
   ([^String s ^String needle ignore-case]
+   {:pre [(string? s) (string? needle)]
+    :post [(or (string? %) (nil? %))]}
    (if ignore-case
      (case-insensitive-contains s needle)
      (case-sensitive-contains s needle))))
@@ -286,9 +319,13 @@
 (defn ^String contains-all?
   "Return s if s contains all needles."
   ([^String s needles]
+   {:pre [(string? s) (every? string? needles)]
+    :post [(or (string? %) (nil? %))]}
    (when (every? (partial case-sensitive-contains s) needles)
      s))
   ([^String s needles ignore-case]
+   {:pre [(string? s) (every? string? needles)]
+    :post [(or (string? %) (nil? %))]}
    (if ignore-case
      (when (every? (partial case-insensitive-contains s) needles)
        s)
@@ -297,8 +334,12 @@
 (defn ^String contains-any?
   "Return s if s contains any of the needles."
   ([^String s needles]
+   {:pre [(string? s) (every? string? needles)]
+    :post [(or (string? %) (nil? %))]}
    (some (partial case-sensitive-contains s) needles))
   ([^String s needles ignore-case]
+   {:pre [(string? s) (every? string? needles)]
+    :post [(or (string? %) (nil? %))]}
    (if ignore-case
      (some (partial case-insensitive-contains s) needles)
      (contains-any? s needles))))
@@ -306,7 +347,8 @@
 (defn ^String truncate
   "If s is longer than len-3, cut it down to len-3 and append '...'."
   [^String s len]
-  {:pre [(not (nil? s)) (>= len 3)]}
+  {:pre [(string? s) (>= len 3)]
+   :post [(string? s)]}
   (if (> (length s) (max 3 (- len 3)))
     (str (substring s 0 (- len 3)) "...")
     s))
@@ -420,6 +462,8 @@
 (defn wrap-words
   "Insert newlines in s so the length of each line doesn't exceed width."
   [^String s width]
+  {:pre [(string? s) (integer? width)]
+   :post [(string? %)]}
   (->> (split s #"\n|\t|\n| ")
        (remove empty?)
        (reduce


Update util.clj

Update util.clj

--- src/swagger_gen/util.clj
+++ src/swagger_gen/util.clj
@@ -36,6 +36,11 @@
   [swagger-route]
   (params-of-type swagger-route "body"))

+(defn path-params
+  "Extract one or more path params from a swagger path"
+  [swagger-route]
+  (params-of-type swagger-route "path"))
+
 (defn query-params
   "Extract one or more query params from a swagger path"
   [swagger-route]


Add confidence and flagged reason to output

--- src/clj/org/openforis/ceo/db/projects.clj
+++ src/clj/org/openforis/ceo/db/projects.clj
@@ -930,16 +930,28 @@
                         :sample_points
                         :email
                         :flagged
+                        :flagged_reason
+                        :confidence
                         :collection_time
                         :analysis_duration
                         :common_securewatch_date
                         :total_securewatch_dates])

+(defn- remove-vector-items [vector & items]
+  (->> vector
+       (remove (set items))
+       (vec)))
+
 (defn dump-project-aggregate-data [{:keys [params]}]
   (let [project-id (tc/val->int (:projectId params))]
     (if-let [project-info (first (call-sql "select_project_by_id" project-id))]
       (let [survey-questions (tc/jsonb->clj (:survey_questions project-info))
-            text-headers     (concat plot-base-headers
+            confidence?      (-> project-info
+                                 (:options)
+                                 (tc/jsonb->clj)
+                                 (:collectConfidence))
+            text-headers     (concat (remove-vector-items plot-base-headers
+                                                          (when-not confidence? :confidence))
                                      (get-ext-plot-headers project-id))
             number-headers   (get-value-distribution-headers survey-questions)
             headers-out      (->> (concat text-headers number-headers)


Fix bug in css color updating

Fix bug in css color updating

--- src/cljs/koeeoadi/components/palette.cljs
+++ src/cljs/koeeoadi/components/palette.cljs
@@ -60,10 +60,10 @@
   (let [selectors (map #(face-to-selectors % color-type) faces)
         cnt (count selectors)]
     (cond
-      (= count 0)
+      (= cnt 0)
       [nil nil]

-      (= count 1 (count faces))
+      (= cnt 1)
       (first selectors)

       :else (reduce #(vector
@@ -135,11 +135,9 @@
             color-editable-selector (str ".color-" (:color/id active-color))
             [code-bg-selector face-bg-color-selector] (selectors-for-colorize bg-faces :face/color-bg)
             [code-fg-selector face-fg-color-selector] (selectors-for-colorize fg-faces :face/color-fg)
-            bg-selectors  (clojure.string/join "," (remove nil? [color-editable-selector code-bg-selector face-bg-color-selector face-fg-color-selector]))
-            fg-selectors   (clojure.string/join "," (remove nil? [code-fg-selector]))]
-
+            bg-selectors  (clojure.string/join "," (remove nil? [color-editable-selector code-bg-selector face-bg-color-selector face-fg-color-selector]))]
         (colorize-faces bg-selectors "background-color" hex-temp)
-        (colorize-faces fg-selectors "color" hex-temp)))))
+        (when code-fg-selector (colorize-faces code-fg-selector "color" hex-temp))))))

 (defui PaletteWidget
   static om/IQuery


Webserver should serve from dev-resources as well

--- dev-src/webserver/servefromjar.clj
+++ dev-src/webserver/servefromjar.clj
@@ -22,6 +22,6 @@

 (defroutes reactpixifromjar
   (resources "/react-pixi" {:root "react_pixi"})
-  (files "/" {:root "resources/public"}))
+  (files "/" {:root "(dev-resources/public|resources/public)"}))


Add stm snippets

Add stm snippets

--- clojure/basics/src/basics/core.clj
+++ clojure/basics/src/basics/core.clj
@@ -97,7 +97,6 @@

   ; null
   nil
-
   ; multimethods
   (defmulti encounter (fn [x y] [(:Species x) (:Species y)]))

@@ -114,6 +113,31 @@
   ; doseq is used for procedures returning nil
   (doseq [x (for [i (range 10)] (+ i 10))]
     (prn x))
+
+  ; metadata
+  (def v [1 2 3])
+  (def trusted (with-meta v {:source :trusted}))
+
+  ;;; STM - uses Multiversion Concurrency Control
+
+  ;; refs
+  ; - shared, synchronous, transactional, atomic
+  (def r (ref {:a 1 :b 2 :c 3}))
+  ; deref
+  @r
+  ; read and modify ref - next dereference will have new value
+  (dosync (commute r assoc :c 5))
+
+  ;; agents - shared, asynchronous, autonomoous
+  ; - can do side effects
+  ; dispatches made during an action are held until after the
+  ; state of the agent has changed
+  (def a (agent {:a 1 :b 2 :c 3}))
+  @a
+  ; update change asynchronously
+  (send a assoc :d 4)
+  ; wait for change
+  (await a)

   (let [a [1 2 3]
         b {:a 1 :b 2}
@@ -124,3 +148,7 @@
           (conj c 4)
           a b c])))

+
+
+
+