Added test-alts.

Added test-alts.

--- test/ago/test.cljs
+++ test/ago/test.cljs
@@ -176,10 +176,54 @@
         (recur)))
     @all-done))

+(defn test-alts []
+  (println "test-alts")
+  (let [agw (make-ago-world nil)
+        chx (ago-chan agw)
+        chy (ago-chan agw)
+        chz (ago-chan agw)
+        collector (ago agw
+                       (loop [chs #{chx chy chz}
+                              acc #{}]
+                         (if (seq chs)
+                           (let [[v ch] (alts! (vec chs))]
+                             (if v
+                               (recur chs (conj acc v))
+                               (recur (disj chs ch) acc)))
+                           acc)))
+        sender0 (ago agw
+                     (>! chx :hi)
+                     (>! chx :world)
+                     (close! chx)
+                     :sender0-done)
+        sender1 (ago agw
+                     (loop [msgs {chy :fee chz :fie}]
+                       (when (seq msgs)
+                         (let [[v ch] (alts! (vec msgs))]
+                           (recur (dissoc msgs ch)))))
+                     (close! chy)
+                     (close! chz)
+                     :sender1-done)
+        all-done (atom false)]
+    (go (let [msgs (<! collector)]
+          (assert (= msgs #{:hi :world :fee :fie}))
+          (assert (= (<! collector) nil))
+          (assert (= (<! sender0) :sender0-done))
+          (assert (= (<! sender0) nil))
+          (assert (= (<! sender1) :sender1-done))
+          (assert (= (<! sender1) nil))
+          (reset! all-done true)))
+    (loop []
+      (when (not @all-done)
+        (cljs.core.async.impl.dispatch/process-messages)
+        (recur)))
+    @all-done))
+
 (defn ^:export run []
   (println "ago test run started.")
   (test-constructors)
   (test-seqvs)
   (test-put-take)
+  (test-alts)
   (println "ago test run PASS.")
   success)


handle empty q param in serach function

handle empty q param in serach function

--- src/wb_es/web/core.clj
+++ src/wb_es/web/core.clj
@@ -11,12 +11,14 @@

 (defn search [q options]
-  (let [query {:query
-               {:bool
-                {:must [{:bool {:filter (get-filter options)}}
-                        {:bool {:should [{:term {:wbid q}}
-                                         {:match {:label q}}
-                                         {:match {:_all q}}]}}]}}}
+  (let [query (if (and q (not= (clojure.string/trim q) ""))
+                {:query
+                 {:bool
+                  {:must [{:bool {:filter (get-filter options)}}
+                          {:bool {:should [{:term {:wbid q}}
+                                           {:match {:label q}}
+                                           {:match {:_all q}}]}}]}}}
+                {:query {:bool {:filter (get-filter options)}}})

         response
         (http/get (format "%s/%s/_search?size=%s&from=%s"


tests for file function

tests for file function

--- test/test_core.clj
+++ test/test_core.clj
@@ -23,11 +23,8 @@

   (testing "file and string"
     (with-project [foo "foo", f (file foo), s "bar"]
-      (is (= (str (:root project) "/" foo "/" s "!")
+      (is (= (str (:root project) "/" foo "/" s)
              (.toString (file f s))))))
-
-  (is false)
-

   (testing "tilde expansion"
     (with-project [p "/foo/bar", tp "~/foo/bar"]


Add wiki page examples

Add wiki page examples

--- test/structural_typing/docs/f_wiki_what_can_be_in_a_path.clj
+++ test/structural_typing/docs/f_wiki_what_can_be_in_a_path.clj
@@ -30,6 +30,27 @@
   (let [result (with-out-str (checked :Nesty {:x [1]}))]
     result => #"\[:x ALL ALL :y\] is not a path"))

+(fact "RANGE"
+  (type! :ALL {[ALL] even?})
+  (let [result (with-out-str (checked :ALL [:wrong 4 2 :wrong]))]
+    result => #"\[0\] should be `even\?`; it is `:wrong`"
+    result => #"\[3\] should be `even\?`; it is `:wrong`")
+
+  (type! :R {[(RANGE 1 3)] even?})
+  (checked :R [:wrong 4 2 :wrong]) => [:wrong 4 2 :wrong]
+
+  (type! :R {[ALL :x (RANGE 1 3)] even?})
+  (let [result (with-out-str (checked :R [ {:x [:ignored 4 2]}
+                                           {:x [:ignored 1 2 :ignored]}]))]
+    result => #"\[1 :x 1\] should be `even\?`; it is `1`")
+
+  (type! :SECOND-AND-THIRD {[(RANGE 1 3)] pos?})
+  (checked :SECOND-AND-THIRD [:ignored 1 2]) => [:ignored 1 2]
+  (let [result (with-out-str (checked :SECOND-AND-THIRD [:ignored 1]))]
+    result => #"\[\(RANGE 1 3\)\] is not a path into `\[:ignored 1\]`"))
+
+
+
 (fact "predicates"
   (type! :Odder {[ALL even?] neg?, [ALL odd?] pos?})
   (let [result (with-out-str (checked :Odder [4 -3 2 -1]))]


add day 19

add day 19

--- src/advent/core.clj
+++ src/advent/core.clj
@@ -267,4 +267,9 @@
 ; as it probably went into swap

 ; Data was loaded via: (def day-7-data (build-circuit day-7-input))
-; For the solution to part B, I just ran (find-signal :a (assoc day-7-data :b (find-signal :a day-7-data)))+; For the solution to part B, I just ran (find-signal :a (assoc day-7-data :b (find-signal :a day-7-data)))
+
+
+; Day 19
+(def day-19-subs "/Users/alandgraf/code/advent/day19-substitutions.txt")
+(def day-19-molecule "/Users/alandgraf/code/advent/day19-molecule.txt")


Last node leakage out of nodes.clj

Last node leakage out of nodes.clj

--- src/asid/wallet.clj
+++ src/asid/wallet.clj
@@ -4,6 +4,7 @@

   (:require [clojure.data.json :as json]
             [asid.identity :as aid]
+            [asid.nodes :as an]
             [asid.render :as render])

   (:import [org.bouncycastle.jce.provider BouncyCastleProvider]
@@ -71,11 +72,11 @@
     (to-hex (.sign sig))))

 (defn add-data [wallet key value]
-  (assoc (Wallet. (:identity wallet)
-                  (assoc (:bag wallet) key value)
-                  (:signatures wallet)
-                  (:key wallet))
-    :node-id (:node-id wallet)))
+  (an/associate-node (Wallet. (:identity wallet)
+                              (assoc (:bag wallet) key value)
+                              (:signatures wallet)
+                              (:key wallet))
+                     wallet))

 (fact
   (let [orig (new-wallet "id")


solvability optimizations

solvability optimizations

--- src/cellf/core.cljs
+++ src/cellf/core.cljs
@@ -43,22 +43,30 @@
     {:cells cells :image img-data}))

 (defn order [grid]
-  (map first (sort-by second grid)))
-
-(defn inversions [grid size]
+  (->>
+    grid
+    (sort-by second)
+    (map first)))
+
+(defn inversions [grid]
   (let [cells (order grid)]
-    (reduce +
-      (map count
-        (map (fn [n] (filter #(< % (nth cells n)) (drop n cells)))
-             (range (count grid)))))))
+    (->>
+      (range (count grid))
+      (map (fn [n]
+        (->>
+          (drop n cells)
+          (filter #(< % (nth cells n)))
+          count)))
+      (reduce +))))

 (defn blank-at-row [grid size]
-  (Math.floor (/ (get grid :empty) size)))
+  (Math.floor (/ (:empty grid) size)))

 (defn solvable? [grid size]
-  (or
-    (and (odd? size) (even? (inversions grid size)))
-    (and (even? size) (= (even? (inversions grid size)) (odd? (blank-at-row grid size))))))
+  (let [even-inversions? (even? (inversions grid))]
+    (or
+      (and (odd? size) even-inversions?)
+      (and (even? size) (= even-inversions? (odd? (blank-at-row grid size)))))))

 (defn make-cell-list [size]
   (conj (vec (range (dec (sq size)))) :empty))


Convert Exceptions to ruby for the error email.

--- src/circle/ruby.clj
+++ src/circle/ruby.clj
@@ -87,6 +87,10 @@
   (.getException e))

 (defmethod ->ruby
+  java.lang.Exception [e]
+  e)
+
+(defmethod ->ruby
   clojure.lang.Sequential [v]
   (let [new-a (org.jruby.RubyArray/newArray (ruby) [])
         values (map ->ruby v)]


set-of supports | syntax

set-of supports | syntax

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/util.clj
+++ src/conexp/util.clj
@@ -297,11 +297,14 @@

 (defmacro set-of
   "Macro for writing sets as mathematicians do (at least similar to it.)"
-  [thing condition]
-  `(let [result# (atom (transient #{}))]
-     (doseq ~condition
-       (swap! result# conj! ~thing))
-     (persistent! @result#)))
+  [thing & condition]
+  (let [condition (if (= '| (first condition))
+                    (vec (rest condition))
+                    (vec (first condition)))]
+    `(let [result# (atom (transient #{}))]
+       (doseq ~condition
+         (swap! result# conj! ~thing))
+       (persistent! @result#))))

 (defn div
   "Integer division."


Add seqable? in quickref

Add seqable? in quickref

--- src/clj/clojuredocs/pages/quickref/static.clj
+++ src/clj/clojuredocs/pages/quickref/static.clj
@@ -269,7 +269,7 @@
          (contains?
            distinct? empty? every? not-every? some not-any?),
          :title "Content Tests"}
-        {:syms (sequential? associative? sorted? counted? reversible?),
+        {:syms (sequential? associative? sorted? counted? reversible? seqable?),
          :title "Capabilities"}
         {:syms (coll? seq? vector? list? map? set?),
          :title "Type Tests"})}


Assert that secretbox-pfx repeats keystream

--- test/caesium/magicnonce/secretbox_test.clj
+++ test/caesium/magicnonce/secretbox_test.clj
@@ -94,7 +94,8 @@
   (let [nonce (byte-array (range s/noncebytes))
         ctext (ms/secretbox-pfx st/ptext nonce st/secret-key)]
     (is (= (range s/noncebytes) (take s/noncebytes ctext)))
-    (is-valid-magicnonce-ctext? ctext)))
+    (is-valid-magicnonce-ctext? ctext)
+    (is (repeated-keystream? #(ms/secretbox-pfx % nonce st/secret-key)))))

 (def constant-nonce (constantly (byte-array (range s/noncebytes))))


finish tests for commodities

finish tests for commodities

--- test/clj_money/models/commodities_test.clj
+++ test/clj_money/models/commodities_test.clj
@@ -120,7 +120,18 @@
         "The second commodity can be retrieved after create")))

 (deftest name-can-be-duplicated-between-entities
-  (is false "need to write the test"))
+  (let [context (serialization/realize storage-spec commodity-context)
+        entity-1 (-> context :entities first)
+        entity-2 (-> context :entities second)
+        c1 (commodities/create storage-spec (assoc (attributes context) :entity-id (:id entity-1)))
+        c2 (commodities/create storage-spec (assoc (attributes context) :entity-id (:id entity-2)))]
+    (is (empty? (validation/error-messages c2)))))
+
+(deftest name-can-be-duplicated-between-exchanges
+  (let [context (serialization/realize storage-spec commodity-context)
+        c1 (commodities/create storage-spec (assoc (attributes context) :exchange :nasdaq))
+        c2 (commodities/create storage-spec (assoc (attributes context) :exchange :nyse))]
+    (is (empty? (validation/error-messages c2)))))

 (deftest symbol-is-required
   (let [context (serialization/realize storage-spec commodity-context)
@@ -136,13 +147,35 @@
         "The commodity is not retrieved after create")))

 (deftest symbol-is-unique-for-an-entity-and-exchange
-  (is false "need to write the test"))
+  (let [context (serialization/realize storage-spec commodity-context)
+        entity-id (-> context :entities first :id)
+        commodity (attributes context)
+        result-1 (commodities/create storage-spec commodity)
+        result-2 (commodities/create storage-spec commodity)
+        commodities (commodities/select-by-entity-id storage-spec entity-id)]
+    (is (empty? (validation/error-messages result-1))
+        "The first is created successfully")
+    (is (= ["Symbol must be unique for a given exchange"]
+           (validation/error-messages result-2 :symbol))
+        "The result has an error messages")
+    (is (= 1 (->> commodities
+                  (filter #(= "Apple" (:name %)))
+                  count))
+        "The commodity exists only once after both calls to create")))

 (deftest symbol-can-be-duplicated-between-exchanges
-  (is false "need to write the test"))
+  (let [context (serialization/realize storage-spec commodity-context)
+        c1 (commodities/create storage-spec (assoc (attributes context) :exchange :nasdaq))
+        c2 (commodities/create storage-spec (assoc (attributes context) :exchange :nyse))]
+    (is (empty? (validation/error-messages c2)))))

 (deftest symbol-can-be-duplicated-between-entities
-  (is false "need to write the test"))
+  (let [context (serialization/realize storage-spec commodity-context)
+        entity-1 (-> context :entities first)
+        entity-2 (-> context :entities second)
+        c1 (commodities/create storage-spec (assoc (attributes context) :entity-id (:id entity-1)))
+        c2 (commodities/create storage-spec (assoc (attributes context) :entity-id (:id entity-2)))]
+    (is (empty? (validation/error-messages c2)))))

 (deftest exchange-can-be-a-string
   (let [context (serialization/realize storage-spec commodity-context)


Fix test

Fix test

--- test/obb_api/handlers/deploy_game_test.clj
+++ test/obb_api/handlers/deploy_game_test.clj
@@ -20,7 +20,7 @@
         [response status] (service/put-json "Pyro"
                                             (str "/game/" (game :_id)  "/deploy")
                                             data)
-        data {:actions [[:deploy 2 :kamikaze [2 2]]]}
+        data {:actions [[:deploy 2 :kamikaze [2 7]]]}
         [response status] (service/put-json "donbonifacio"
                                             (str "/game/" (game :_id)  "/deploy")
                                             data)]
@@ -97,9 +97,9 @@
     (is (= status 200))))

 (deftest deploy-complete-success-test
-  (let [[response status] (create-deployed-game)]
-    (let [state (get-in response [:board :state])]
-      (is (or (= "p1" state) (= "p2" state))))
+  (let [[response status] (create-deployed-game)
+        state (get-in response [:board :state])]
+    (is (or (= "p1" state) (= "p2" state)))
     (is (empty? (get-in response [:board :stash :p1])))
     (is (empty? (get-in response [:board :stash :p2])))
     (is (= true (response :success)))


config editor partial new row

config editor partial new row

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@8978 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/config_editor.clj
+++ acqEngine/src/org/micromanager/config_editor.clj
@@ -42,6 +42,15 @@
 (defn scroll-pane [table]
    (let [sp (JScrollPane. table)]
     sp))
+
+;; events
+
+(defn attach-double-click-listener [component f]
+  (.addMouseListener component
+    (proxy [MouseAdapter] []
+      (mouseClicked [event]
+        (when (= 2 (.getClickCount event))
+          (f (.getX event) (.getY event)))))))

 ;; main stuff

@@ -141,6 +150,14 @@
 (defn link-table-row-selection [table1 table2]
   (attach-selection-listener table1 #(set-selected-row table2 %))
   (attach-selection-listener table2 #(set-selected-row table1 %)))
+
+(defn double-click-for-new-row [table f]
+  (attach-double-click-listener
+    (.getParent table)
+    (fn [x y]
+      (let [r (.getBounds table)]
+        (when (> y (+ (.y r) (.height r)))
+          (f))))))

 (defn show []
   (let [f (JFrame. "Micro-Manager Configuration Preset Editor")
@@ -164,6 +181,7 @@
       (.setModel preset-names-table (preset-names-table-model))
       (.setModel presets-table (presets-table-model))
       (link-table-row-selection presets-table preset-names-table)
+      (double-click-for-new-row groups-table #(println "new row!"))
       (.setAutoResizeMode presets-table JTable/AUTO_RESIZE_OFF)
       (doto cp
         (.setLayout (SpringLayout.))
@@ -189,7 +207,6 @@
          (.fireTableStructureChanged (.getModel (components :presets-table)))
          (set-preferred-column-width (components :presets-table)))))

-
 ;; test/run

 (defn start


ClojureScript 1.10.238

ClojureScript 1.10.238

--- ClojureScript/replete/project.clj
+++ ClojureScript/replete/project.clj
@@ -7,7 +7,7 @@
                  [tailrecursion/cljson "1.0.7"]
                  [malabarba/lazy-map "1.3"]
                  [org.clojure/clojure "1.9.0"]
-                 [org.clojure/clojurescript "1.10.217"]
+                 [org.clojure/clojurescript "1.10.238"]
                  [org.clojure/test.check "0.10.0-alpha2"]]
   :clean-targets ["out" "target"]
   :plugins [[lein-cljsbuild "1.1.7"]]


Make the regex more flexible.

Make the regex more flexible.

--- src/dragon/util.clj
+++ src/dragon/util.clj
@@ -4,7 +4,7 @@
             [taoensso.timbre :as log]))

 (def char-regex #"^a*")
-(def post-regex #"posts/(\d{4})-(\d{2})/(\d{2})-(\d{2})(\d{2})(\d{2})/.*")
+(def post-regex #"(\./)?posts/(\d{4})-(\d{2})/(\d{2})-(\d{2})(\d{2})(\d{2})/.*")
 (def timestamp-format ":year-:month-:day :hour::minute::second")
 (def datestamp-format ":year-:month-:day")

@@ -27,7 +27,7 @@
   (dissoc
     (->> dir
          (re-matches post-regex)
-         (zipmap [:all :year :month :day :hour :minute :second]))
+         (zipmap [:all :dir-prefix :year :month :day :hour :minute :second]))
     :all))

 (defn datetime-now


Fix env var port selection

Fix env var port selection

--- src/engulf/core.clj
+++ src/engulf/core.clj
@@ -10,7 +10,7 @@
   (nr-server/load-views "src/engulf/views")

   (let [mode (keyword (or (first args) :prod))
-          port (Integer. (get (System/getenv) "PORT" "3000"))
+          port (Integer. (or (System/getenv "PORT") "3000"))
           noir-handler (nr-server/gen-handler {:mode mode})]
       (start-http-server
         (wrap-ring-handler noir-handler)


Add func to fetch file’s commit history

Add func to fetch file’s commit history

--- src/extremo/db.cljs
+++ src/extremo/db.cljs
@@ -25,6 +25,29 @@
     (.then #(js/console.log (clj->js %)))
     (.catch #(js/console.error %)))

+(defn get-file-history
+  [filepath]
+  ;; TODO: At the momment this will only fetch 50 commits into the
+  ;;       file history. It may be that the max that fileHisotryWalk
+  ;;       can fetch is 500 at a time. The sample code for this kind
+  ;;       of walk in the nodegit repo, shows some code that seems to
+  ;;       compile the code 500 commits at a time.
+  (-> (open-repo)
+      (.then (fn [repo]
+               (-> (.getMasterCommit repo)
+                   (.then #(let [commit %
+                                 walker (.createRevWalk repo)]
+                             (.push walker (.sha commit))
+                             (.sorting walker nodegit.Revwalk.SORT.Time)
+                             (.fileHistoryWalk walker filepath 50)))
+                   (.then (fn [commits]
+                            (mapv #(assoc
+                                     {}
+                                     :sha (.sha (.-commit %))
+                                     :date (.date (.-commit %))
+                                     :commit (.-commit %)) commits)))
+                   (.catch #(js/console.error %)))))))
+
 ;; (-> (open-repo)
 ;;     (.then #(.getMasterCommit %))
 ;;     (.then #(.getTree %))


grouping chans, go-ified.

grouping chans, go-ified.

--- src/fowles/util.clj
+++ src/fowles/util.clj
@@ -2,7 +2,8 @@
   (:require [clojure.java.io :as io]
             [clojure.string :as str]
             [zeromq.zmq :as zmq]
-            [clojure.core.async :refer [>!! alt!! timeout close!]]
+            [clojure.core.async :refer [chan close!
+                                        go-loop <! >! alt! timeout]]
             [clj-time
              [core :as t]
              [coerce :as c]
@@ -11,52 +12,34 @@
 ;;-------------------------------
 ;; async

-(defn- maybe-send-acc
-  [out-ch acc]
-  (if (> (count acc) 0)  ;; any?
-    (>!! out-ch acc)))
-
 (defn- get-n-in-ms
-  "Grab and send along up n items from in-ch within max-ms.
-   Return bool: whether to continue."
-  [in-ch n max-ms out-ch]
-  (let [t (timeout max-ms)]
-    (loop [i 0, acc []]
-      (if (= i n)
-        (do
-          (maybe-send-acc out-ch acc)
-          true)
-        (alt!!
-         t     ([_]
-                  (maybe-send-acc out-ch acc)
-                  true)
-         in-ch ([v]
-                  (if (nil? v)
-                    (do
-                      (maybe-send-acc out-ch acc)
-                      (close! out-ch)
-                      false)
-                    (recur (inc i) (conj acc v)))))))))
-
-(defn pipe-groups-of-up-to-n
-  "grab up to num items from from in-ch and return as one msg on out-ch"
-  [in-ch out-ch num max-wait-ms]
-  (loop [continue true]
-    (if continue
-      (let [c (get-n-in-ms in-ch num max-wait-ms out-ch)]
-        (recur c)))))
+  "Grab up to n items from in-ch within max-wait-ms.
+   Return [acc, bool]  (whether to continue)"
+  [in-ch n max-wait-ms]
+  (let [t (timeout max-wait-ms)]
+    (go-loop [i 0, acc []]
+             (if (= i n)
+               ;; Got enough.
+               [acc, true]
+               ;; Maybe get more...
+               (alt!
+                t     ([_] [acc, true])
+                in-ch ([v]
+                         (if (nil? v)
+                           [acc, false]
+                           (recur (inc i) (conj acc v)))))))))

 (defn mk-grouped-ch
-  [in-ch size max-wait-ms]
-  ;; Instead of starting a thread here, use `go`.
+  "grab up to num items from from in-ch and return as one msg on out-ch"
+  [in-ch num max-wait-ms]
   (let [out-ch (chan)]
-    (.start
-     (Thread.
-      #(pipe-groups-of-up-to-n in-ch out-ch size max-wait-ms)))
+    (go-loop []
+             (let [[acc c] (<! (get-n-in-ms in-ch num max-wait-ms))]
+               (if (seq acc) (>! out-ch acc))
+               (if c
+                 (recur)
+                 (close! out-ch))))
     out-ch))
-  ;; (let [out-ch (chan)]
-  ;;   (go (pipe-groups-of-up-to-n in-ch out-ch size wait-ms))
-  ;;   out-ch))

 ;;-------------------------------
 ;; ZMQ


Print at end, too

Print at end, too

--- src/korhal/core.clj
+++ src/korhal/core.clj
@@ -69,7 +69,9 @@
         (println "collecting minerals")
         (let [mineral? (fn [unit] (= (.getTypeID unit) (.getID jnibwapi.types.UnitType$UnitTypes/Resource_Mineral_Field)))
               mineral (first (filter mineral? (.getNeutralUnits (:api @this))))]
-        (.rightClick (.getID unit) (.getID mineral)))))))
+        (.rightClick (.getID unit) (.getID mineral))))))
+
+  (println "end of update"))


Added a delete function in the dao.

Added a delete function in the dao.

--- src/hateoasql/dao.clj
+++ src/hateoasql/dao.clj
@@ -142,6 +142,11 @@
   (jdbc/update! db resource instance [(str (get primary-keys resource)" = ?") (get-pk-value resource instance)]))

 (defn create!
-  "Crate a new resource."
+  "Create a new resource."
   [resource instance]
   (jdbc/insert! db resource instance))
+
+(defn delete!
+  "Delete a resource by id."
+  [resource id]
+  (jdbc/delete! db resource [(str (get primary-keys resource)" = ?") id]))


[#82] Drop responses for which the question is missing

--- api/src/clojure/org/akvo/flow_api/datastore/form_instance.clj
+++ api/src/clojure/org/akvo/flow_api/datastore/form_instance.clj
@@ -145,24 +145,29 @@
   [_ response-str opts]
   (json/parse-string response-str))

+(defn update-form-instances-fn [question-types opts]
+  (fn [form-instances ^Entity answer]
+    (let [form-instance-id (str (.getProperty answer "surveyInstanceId"))
+          question-id (.getProperty answer "questionID")]
+      (if-let [question-type (get question-types question-id)]
+        (let [response-str (or (.getProperty answer "value")
+                               (.getValue ^Text (.getProperty answer "valueText")))
+              iteration (or (.getProperty answer "iteration") 0)
+              response (when response-str
+                         (parse-response question-type
+                                         response-str
+                                         opts))]
+          (assoc-in form-instances
+                    [form-instance-id
+                     question-id
+                     iteration]
+                    response))
+        form-instances))))
+
 (defn fetch-answers [ds form-definition form-instances opts]
   (let [question-types (question-type-map form-definition)]
     (reduce (fn [form-instance-answers form-instance-batch]
-              (reduce (fn [fia ^Entity answer]
-                        (let [form-instance-id (str (.getProperty answer "surveyInstanceId"))
-                              question-id (.getProperty answer "questionID")
-                              response-str (or (.getProperty answer "value")
-                                               (.getValue ^Text (.getProperty answer "valueText")))
-                              iteration (or (.getProperty answer "iteration") 0)
-                              response (when response-str
-                                         (parse-response (get question-types question-id)
-                                                         response-str
-                                                         opts))]
-                          (assoc-in fia
-                                    [form-instance-id
-                                     question-id
-                                     iteration]
-                                    response)))
+              (reduce (update-form-instances-fn question-types opts)
                       form-instance-answers
                       (q/result ds
                                 {:kind "QuestionAnswerStore"


[#4588] Workaround ellipsis issue on public key in the login screen.

In the latest RN update it seems like `ellipsizeMode: middle` doesn't
play well with negative letter spacing anymore. This workaround remove negative letter spacing.

Signed-off-by: Igor Mandrigin <042dc4512fa3d391c5170cf3aa61e6a638f84342@mandrigin.ru>

--- src/status_im/ui/screens/accounts/styles.cljs
+++ src/status_im/ui/screens/accounts/styles.cljs
@@ -48,9 +48,9 @@
    :letter-spacing -0.2
    :color          common/color-black})

-(def account-badge-pub-key-text
+(defstyle account-badge-pub-key-text
   {:font-size      14
-   :letter-spacing -0.2
+   :ios            {:letter-spacing -0.2}
    :color          colors/gray
    :margin-top     4})


Capitalize dir name

Capitalize dir name

--- doclet/src/clojure/play_clj_doclet/core.clj
+++ doclet/src/clojure/play_clj_doclet/core.clj
@@ -157,7 +157,7 @@
 (defn generate!
   [java-docs]
   (let [play-clj-files (file-seq (io/file "../src/"))
-        nightmod-file (io/file "../../nightmod/src/clojure/nightmod/game.clj")
+        nightmod-file (io/file "../../Nightmod/src/clojure/nightmod/game.clj")
         net-file (io/file "../../play-clj.net/src/play_clj/net.clj")]
     (->> play-clj-files
          (parse-clj java-docs)


FIX: Coercing strings should force to native color representation

--- src/inkspot/color.clj
+++ src/inkspot/color.clj
@@ -100,7 +100,7 @@
   (green  [s] (green (string->color s)))
   (blue   [s] (blue (string->color s)))
   (alpha  [s] (alpha (string->color s)))
-  (coerce [s] (string->color s)))
+  (coerce [s] (to-color (string->color s))))

 (extend-type clojure.lang.Keyword
   IColor


use new cli during initialization

use new cli during initialization

--- src/jepsen/voltdb.clj
+++ src/jepsen/voltdb.clj
@@ -32,6 +32,7 @@

 (def username "voltdb")
 (def base-dir "/opt/voltdb")
+(def voltroot (str base-dir "/voltdbroot"))

 (defn os
   "Given OS, plus python & jdk8"
@@ -54,6 +55,7 @@
   (c/su
     (cu/install-tarball! node url base-dir force?)
     (c/exec :mkdir (str base-dir "/log"))
+    (c/exec :mkdir :-p (str voltroot "/log"))
     (cu/ensure-user! username)
     (c/exec :chown :-R (str username ":" username) base-dir)

@@ -113,7 +115,7 @@
 (defn await-initialization
   "Blocks until the logfile reports 'Server completed initialization'."
   [node]
-  (info "Waiting for" node "to initialize")
+  (info "Waiting for" node "to initialize at voltroot:" voltroot)
   (timeout 120000
            (throw (RuntimeException.
                     (str node " failed to initialize in time; STDOUT:\n\n"
@@ -121,23 +123,47 @@
                                       (str base-dir "/log/stdout.log")))
                          "\n\nLOG:\n\n"
                          (meh (c/exec :tail :-n 10
-                                      (str base-dir "/log/volt.log")))
+                                      (str voltroot "/log/volt.log")))
                          "\n\n")))
            (c/sudo username
-                   (c/cd base-dir
+                   (c/cd voltroot
                          ; hack hack hack
+                         (Thread/sleep 3000)
+                         (c/exec :tail :-n 1 :-f "log/volt.log"
+                                 | :grep :-m 1 "Initialized VoltDB root directory"
+                                 | :xargs (c/lit "echo \"\" >> log/volt.log \\;")))
+                   (info node "initialized"))))
+
+(defn await-start
+    "Blocks until the logfile reports 'Server completed initialization'."
+  [node]
+  (info "Waiting for" node "to start at voltroot:" voltroot )
+  (timeout 120000
+           (throw (RuntimeException.
+                    (str node " failed to start in time; STDOUT:\n\n"
+                        (meh (c/exec :tail :-n 10
+                                      (str base-dir "/log/stdout.log")))
+                         "\n\nLOG:\n\n"
+                         (meh (c/exec :tail :-n 10
+                                      (str voltroot "/log/volt.log")))
+                         "\n\n")))
+
+           (c/sudo username
+                   (c/cd voltroot
+                         ; hack hack hack
+
                          (Thread/sleep 7000)
                          (c/exec :tail :-n 1 :-f "log/volt.log"
                                  | :grep :-m 1 "completed initialization"
                                  | :xargs (c/lit "echo \"\" >> log/volt.log \\;")))
-                   (info node "initialized"))))
-
+
+                   (info node "started"))))
 (defn await-rejoin
   "Blocks until the logfile reports 'Node rejoin completed'"
   [node]
   (info "Waiting for" node "to rejoin")
   (c/sudo username
-          (c/cd base-dir
+          (c/cd voltroot
                 ; hack hack hack
                 (Thread/sleep 5000)
                 (c/exec :tail :-n 1 :-f "log/volt.log"
@@ -145,6 +171,19 @@
                         | :xargs (c/lit "echo \"\" >> log/volt.log \\;")))
           (info node "rejoined")))

+(defn init-daemon!
+  "Starts the daemon with the given command."
+  [test cmd host]
+  (c/sudo username
+          (c/cd voltroot
+                (cu/start-daemon! {:logfile (str base-dir "/log/stdout.log")
+                                   :pidfile (str base-dir "/pidfile")
+                                   :chdir   base-dir}
+                                  (str base-dir "/bin/voltdb")
+                                  (str "init")
+                                  :--config (str base-dir "/deployment.xml")
+                                  :--force
+                                  :--dir (str base-dir) ))))
 (defn start-daemon!
   "Starts the daemon with the given command."
   [test cmd host]
@@ -154,15 +193,18 @@
                                    :pidfile (str base-dir "/pidfile")
                                    :chdir   base-dir}
                                   (str base-dir "/bin/voltdb")
-                                  cmd
-                                  :--deployment (str base-dir "/deployment.xml")
+                                  (str "start")
+                                  :--dir (str base-dir)
+                                  :--count (count (:nodes test))
                                   :--host host))))

 (defn start!
   "Starts voltdb, creating a fresh DB"
   [test node]
-  (start-daemon! test :create (jepsen/primary test))
-  (await-initialization node))
+  (init-daemon! test :init (jepsen/primary test))
+  (await-initialization node)
+  (start-daemon! test :start (jepsen/primary test))
+  (await-start node))

 (defn recover!
   "Recovers an entire cluster, or with a node, a single node."
@@ -286,7 +328,7 @@
     db/LogFiles
     (log-files [db test node]
       [(str base-dir "/log/stdout.log")
-       (str base-dir "/log/volt.log")])))
+       (str voltroot "/log/volt.log")])))

 (defn connect


Simpler source-paths logic implementation

--- src/less4clj/core.clj
+++ src/less4clj/core.clj
@@ -24,7 +24,7 @@
             ; FIXME: regexing url
             [_ parent _] (re-find #"(.*)/([^/]*)$" (.getEntryName jar-url))]
         (util/dbug "Found %s from resources\n" url)
-        [(.toURI url) parent]))))
+        [(.toURI url) parent :resource]))))

 ; Source: https://github.com/cljsjs/boot-cljsjs/blob/master/src/cljsjs/impl/webjars.clj

@@ -67,11 +67,11 @@
     (relativeSource ^LessSource [^String import-filename]
       (util/dbug "importing %s at %s\n" import-filename parent)
       (if-let [[uri parent type]
-               (or (some-> (or (find-local-file import-filename parent)
-                               ; Don't search from other source-paths if looking for import from resource
-                               (and (= type :file) (some #(find-local-file import-filename %) source-paths))) (conj :file))
-                   (some-> (or (find-resource import-filename parent)
-                               (find-webjars import-filename)) (conj :resource)))]
+               (or (find-local-file import-filename parent)
+                   ; Don't search from other source-paths if looking for import from resource
+                   (and (= type :file) (some #(find-local-file import-filename %) source-paths))
+                   (find-resource import-filename parent)
+                   (find-webjars import-filename))]
         (custom-less-source source-paths type uri parent)
         (not-found!)))
     (getContent ^String []


Close tab with middle / cmd + click

Close tab with middle / cmd + click

--- src/lt/objs/tabs.cljs
+++ src/lt/objs/tabs.cljs
@@ -114,8 +114,10 @@
         :obj-id (object/->id e)
         :pos pos}
    (->name e)]
-  :click (fn []
-           (active! e))
+  :click (fn [ev]
+           (if (or (= 1 (.-button ev)) (.-metaKey ev))
+             (object/raise e :close)
+             (active! e)))
   :contextmenu (fn [ev]
                  (menu! e ev)
                  (dom/prevent ev)


log error objects alongside error messages in promise/err

--- src/meta/promise.cljs
+++ src/meta/promise.cljs
@@ -22,7 +22,7 @@
   (resolve [promise value]    (.resolve promise (clj->js value)))
   (reject  [promise value]    (.reject  promise (clj->js value)))
   (log     [promise]          (.then    promise #(.log js/console %)))
-  (err     [promise]          (.catch   promise #(.error js/console (obj/get % "message"))))
+  (err     [promise]          (.catch   promise #(.error js/console (obj/get % "message") %)))
   (map     [promise func]     (.then    promise #(map func %))))

 (defn promise


Add new tests for Om Next query generation

--- src/test/workflo/macros/specs/query_test.cljc
+++ src/test/workflo/macros/specs/query_test.cljc
@@ -1,9 +1,19 @@
 (ns workflo.macros.specs.query-test
   (:require [clojure.test :refer [are deftest is]]
             [clojure.spec :as s]
+            #?(:cljs [om.next])
             [workflo.macros.query :as q]
             [workflo.macros.query.om-next :as om]
             [workflo.macros.specs.query]))
+
+;;;; Preparations for Om Next query generation in ClojureScript
+
+#?(:cljs (om.next/defui User
+           static om.next/IQuery
+           (query [this]
+             [:user/name :user/email])))
+
+;;;; Conforming, parsing, Om Next query generation

 (deftest conforming-regular-properties
   (are [out in] (= out (q/conform in))
@@ -33,6 +43,12 @@
       {:name c :type :property}]
     '[a b c]))

+(deftest om-next-query-for-regular-properties
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[:a] '[a]
+    '[:a :b] '[a b]
+    '[:a :b :c] '[a b c]))
+
 (deftest conforming-link-properties
   (are [out in] (= out (q/conform in))
     '[[:property [:link [a _]]]]
@@ -60,6 +76,12 @@
       {:name b :type :link :link-id 1}
       {:name c :type :link :link-id :x}]
     '[[a _] [b 1] [c :x]]))
+
+(deftest om-next-query-for-link-properties
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[[:a _]] '[[a _]]
+    '[[:a _] [:b 1]] '[[a _] [b 1]]
+    '[[:a _] [:b 1] [:c :x]] '[[a _] [b 1] [c :x]]))

 (deftest conforming-joins-with-a-simple-property-source
   (are [out in] (= out (q/conform in))
@@ -143,6 +165,17 @@
        :join-target User}]
     '[{a User}]))

+(deftest om-next-query-for-joins-with-a-simple-property-source
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[{:a [:b]}] '[{a [b]}]
+    '[{:a [:b :c]}] '[{a [b c]}]
+    '[{:a [:b :c]} :d] '[{a [b c]} d]
+    '[{:a [:b :c]} {:d [:e :f]}] '[{a [b c]} {d [e f]}]
+    '[{:a '...}] '[{a ...}]
+    '[{:a 5}] '[{a 5}]
+    #?(:cljs '[{:a [:user/name :user/email]}]
+       :clj  '[{:a (om.next/get-query User)}]) '[{a User}]))
+
 (deftest conforming-joins-with-a-link-source
   (are [out in] (= out (q/conform in))
     '[[:property [:join [:properties {[:link [a _]]
@@ -179,6 +212,12 @@
                      {:name c :type :property}
                      {:name d :type :property}]}]
     '[{[a :x] [b c d]}]))
+
+(deftest om-next-query-for-joins-with-a-link-source
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[{[:a _] [:b]}] '[{[a _] [b]}]
+    '[{[:a 1] [:b :c]}] '[{[a 1] [b c]}]
+    '[{[:a :x] [:b :c :d]}] '[{[a :x] [b c d]}]))

 (deftest conforming-prefixed-properties
   (are [out in] (= out (q/conform in))
@@ -225,6 +264,12 @@
      {:name d/f :type :property}]
    '[a [b c] d [e f]]))

+(deftest om-next-query-for-prefixed-properties
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[:a/b] '[a [b]]
+    '[:a/b :a/c] '[a [b c]]
+    '[:a/b :a/c :d/e :d/f] '[a [b c] d [e f]]))
+
 (deftest conforming-aliased-regular-properties
   (are [out in] (= out (q/conform in))
     '[[:aliased-property {:property [:simple a] :as :as :alias b}]]
@@ -243,6 +288,11 @@
       {:name c :type :property :alias d}]
     '[a :as b c :as d]))

+(deftest om-next-query-for-aliased-regular-properties
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[:a] '[a :as b]
+    '[:a :c] '[a :as b c :as d]))
+
 (deftest conforming-aliased-links
   (are [out in] (= out (q/conform in))
     '[[:aliased-property {:property [:link [a _]] :as :as :alias b}]]
@@ -272,6 +322,13 @@
     '[{:name a :type :link :link-id _ :alias b}
       {:name c :type :link :link-id _ :alias d}]
     '[[a _] :as b [c _] :as d]))
+
+(deftest om-next-query-for-aliased-links
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[[:a _]] '[[a _] :as b]
+    '[[:a 1]] '[[a 1] :as b]
+    '[[:a :x]] '[[a :x] :as b]
+    '[[:a _] [:c _]] '[[a _] :as b [c _] :as d]))

 (deftest conforming-aliased-joins
   (are [out in] (= out (q/conform in))
@@ -313,6 +370,11 @@
        :alias h}]
     '[{a [b c]} :as d {e [f g]} :as h]))

+(deftest om-next-query-for-aliased-joins
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[{:a [:b]}] '[{a [b]} :as c]
+    '[{:a [:b :c]} {:e [:f :g]}] '[{a [b c]} :as d {e [f g]} :as h]))
+
 (deftest conforming-aliased-prefixed-properties
   (are [out in] (= out (q/conform in))
     '[[:prefixed-properties {:base a
@@ -339,6 +401,11 @@
       {:name a/d :type :property :alias e}]
     '[a [b :as c d :as e]]))

+(deftest om-next-query-for-aliased-prefixed-properties
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[:a/b] '[a [b :as c]]
+    '[:a/b :a/d] '[a [b :as c d :as e]]))
+
 (deftest conforming-parameterization
   (are [out in] (= out (q/conform in))
     '[[:parameterization {:query [:property [:simple a]]
@@ -394,6 +461,23 @@
                      {:name c :type :property}]
        :alias d
        :parameters {e f g h}}]
+    '[({a [b c]} :as d {e f g h})]))
+
+(deftest om-next-query-for-parameterizations
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[(clojure.core/list :a '{:b c})]
+    '[(a {b c})]
+
+    '[(clojure.core/list :a '{:b c :d e})]
+    '[(a {b c d e})]
+
+    '[(clojure.core/list {:a [:b :c]} '{:d e :f g})]
+    '[({a [b c]} {d e f g})]
+
+    '[(clojure.core/list :a '{:c d :e f})]
+    '[(a :as b {c d e f})]
+
+    '[(clojure.core/list {:a [:b :c]} '{:e f :g h})]
     '[({a [b c]} :as d {e f g h})]))

 (deftest conforming-joins-with-sub-joins
@@ -460,6 +544,17 @@
                                      :join-target [{:name db/id :type :property}]}]}]}]
     '[{users [{friends [{friends [db [id]]}]}]}]))

+(deftest om-next-query-for-joins-with-sub-joins
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[{:users [:db/id :user/name {:friends [:db/id :user/name]}]}]
+    '[{users [db [id]
+              user [name]
+              {friends [db [id]
+                        user [name]]}]}]
+
+    '[{:users [{:friends [{:friends [:db/id]}]}]}]
+    '[{users [{friends [{friends [db [id]]}]}]}]))
+
 (deftest conforming-joins-with-sub-links
   (are [out in] (= out (q/conform in))
     '[[:property
@@ -469,8 +564,7 @@
           [[:prefixed-properties {:base db
                                   :children [[:property [:simple id]]]}]
            [:property [:link [current-user _]]]]}]]]]
-    '[{users [db [id]
-              [current-user _]]}]
+    '[{users [db [id] [current-user _]]}]

     '[[:property
        [:join
@@ -486,8 +580,7 @@
                [[:prefixed-properties
                  {:base user
                   :children [[:property [:simple name]]]}]]}]]]]}]]]]
-    '[{users [user [name]
-              {[current-user _] [user [name]]}]}]))
+    '[{users [user [name] {[current-user _] [user [name]]}]}]))

 (deftest parsing-joins-with-sub-links
   (are [out in] (= out (q/conform-and-parse in))
@@ -495,8 +588,7 @@
        :join-source {:name users :type :property}
        :join-target [{:name db/id :type :property}
                      {:name current-user :type :link :link-id _}]}]
-    '[{users [db [id]
-              [current-user _]]}]
+    '[{users [db [id] [current-user _]]}]

     '[{:name users :type :join
        :join-source {:name users :type :property}
@@ -504,8 +596,15 @@
                      {:name current-user :type :join
                       :join-source {:name current-user :type :link :link-id _}
                       :join-target [{:name user/name :type :property}]}]}]
-    '[{users [user [name]
-              {[current-user _] [user [name]]}]}]))
+    '[{users [user [name] {[current-user _] [user [name]]}]}]))
+
+(deftest om-next-query-for-joins-with-sub-links
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[{:users [:db/id [:current-user _]]}]
+    '[{users [db [id] [current-user _]]}]
+
+    '[{:users [:user/name {[:current-user _] [:user/name]}]}]
+    '[{users [user [name] {[current-user _] [user [name]]}]}]))

 (deftest conforming-joins-with-sub-aliases
   (are [out in] (= out (q/conform in))
@@ -519,8 +618,7 @@
                                                :as :as :alias db-id}]]}]
            [:aliased-property {:property [:simple name]
                                :as :as :alias nm}]]}]]]]
-    '[{[user 1] [db [id :as db-id]
-                 name :as nm]}]))
+    '[{[user 1] [db [id :as db-id] name :as nm]}]))

 (deftest parsing-joins-with-sub-aliases
   (are [out in] (= out (q/conform-and-parse in))
@@ -528,5 +626,9 @@
        :join-source {:name user :type :link :link-id 1}
        :join-target [{:name db/id :type :property :alias db-id}
                      {:name name :type :property :alias nm}]}]
-    '[{[user 1] [db [id :as db-id]
-                 name :as nm]}]))
+    '[{[user 1] [db [id :as db-id] name :as nm]}]))
+
+(deftest om-next-query-for-joins-with-sub-aliases
+  (are [out in] (= out (-> in q/conform-and-parse om/query))
+    '[{[:user 1] [:db/id :name]}]
+    '[{[user 1] [db [id :as db-id] name :as nm]}]))


Fix key for process latencies

Fix key for process latencies

--- storm-core/src/clj/backtype/storm/ui/core.clj
+++ storm-core/src/clj/backtype/storm/ui/core.clj
@@ -837,7 +837,7 @@
        "encodedComponent" (url-encode (.get_componentId s))
        "stream" (.get_streamId s)
        "executeLatency" (float-str (:execute-latencies stats))
-       "processLatency" (float-str (:execute-latencies stats))
+       "processLatency" (float-str (:process-latencies stats))
        "executed" (nil-to-zero (:executed stats))
        "acked" (nil-to-zero (:acked stats))
        "failed" (nil-to-zero (:failed stats))})))


Add support for nested options to `with-options`.

--- src/om_forms/core.clj
+++ src/om_forms/core.clj
@@ -2,5 +2,12 @@

 (defmacro with-options
   [options & body]
-  `(binding [om-forms.core/*options* (cljs.core/merge om-forms.core/*options* ~options)]
+  `(binding [om-forms.core/*options*
+             (cljs.core/merge-with
+               (cljs.core/fn [old# new#]
+                 (cljs.core/cond
+                   (cljs.core/map? old#) (cljs.core/merge old# new#)
+                   :else new#))
+               om-forms.core/*options*
+               ~options)]
      ~@body))


(fix) compare thread

(fix) compare thread

--- src/papaline/core.clj
+++ src/papaline/core.clj
@@ -228,10 +228,14 @@
                args [args])]
     (try
       (let [next-args (apply task args)]
-        [next-args ctx])
+        [(if (instance? CompletableFuture next-args)
+           next-args
+           (CompletableFuture/completedFuture next-args))
+         ctx])
       (catch Exception e
         (let [new-ctx (process-exception ctx args e (:name current-stage) error-handler)]
-          [(:args new-ctx) new-ctx])))))
+          [(CompletableFuture/completedFuture (:args new-ctx))
+           new-ctx])))))

 (defrecord+ AsyncDedicatedThreadPoolPipeline [executor stages error-handler]
   clojure.lang.IFn
@@ -244,11 +248,13 @@
                              (into-array []))]
             (letfn [(clos [stgs ctx]
                       (if-let [^RealizedStage s (first stgs)]
-                        (let [[next-args new-ctx] (run-task2 s ctx error-handler)]
-                          (if (instance? CompletableFuture next-args)
-                            (.handle ^CompletableFuture next-args
-                                     (reify BiFunction
-                                       (apply [_ next-args ex]
+                        (let [[^CompletableFuture next-args-future new-ctx] (run-task2 s ctx error-handler)
+                              processor (Thread/currentThread)]
+                          (.handle ^CompletableFuture next-args-future
+                                   (reify BiFunction
+                                     (apply [_ next-args ex]
+                                       (if (= processor (Thread/currentThread))
+                                         (process-result (assoc new-ctx :args next-args) stgs)
                                          (.submit ^ExecutorService executor
                                                   (wrap-with-arguments-aware-callable
                                                     (fn []
@@ -256,8 +262,7 @@
                                                                   (process-exception new-ctx (:args new-ctx) ex (:name s) error-handler)
                                                                   (assoc new-ctx :args next-args))]
                                                         (process-result ctx stgs)))
-                                                    args-array)))))
-                            (process-result (assoc new-ctx :args next-args) stgs)))
+                                                    args-array)))))))
                         (do
                           (when post-hook (post-hook ctx))
                           (.complete result ctx))))


Improve ability to modify entities via the REPL

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -44,11 +44,12 @@
   (let [screen (atom {})
         entities (atom '())
         execute-fn! (fn [func screen-map]
-                      (some->> (func screen-map @entities)
-                               list
-                               flatten
-                               (remove nil?)
-                               (reset! entities)))
+                      (let [entities-list @entities]
+                        (some->> (func screen-map entities-list)
+                                 list
+                                 flatten
+                                 (remove nil?)
+                                 (compare-and-set! entities entities-list))))
         create-renderer-fn! #(swap! screen assoc :renderer (renderer %))
         update-fn! #(swap! screen merge %)]
     {:screen screen


faster?

faster?

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -118,7 +118,7 @@
                (swap! screen (fn [s]
                                (-> s
                                    (assoc :delta-time d)
-                                   (update-in [:total-time] #(+ (or %1 0) d)))))
+                                   (update-in [:total-time] #(unchecked-add (or ^double %1 0) ^double d)))))
                (execute-fn! on-render @screen))
      :hide #(execute-fn! on-hide)
      :pause #(execute-fn! on-pause)


Pass width/height in the resize function's screen map

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -66,7 +66,7 @@
                (execute-fn! on-render :delta-time d))
      :hide #(execute-fn! on-hide)
      :pause #(execute-fn! on-pause)
-     :resize #(execute-fn! on-resize)
+     :resize #(execute-fn! on-resize :width %1 :height %2)
      :resume #(execute-fn! on-resume)
      :input-processor (input-processor options execute-fn!)
      :gesture-detector (gesture-detector options execute-fn!)}))
@@ -101,10 +101,10 @@
                     (apply (get screen k) args)))]
     (.setScreen game (reify Screen
                        (show [this] (add-inputs!) (run-fn! :show))
-                       (render [this delta-time] (run-fn! :render delta-time))
+                       (render [this d] (run-fn! :render d))
                        (hide [this] (run-fn! :hide))
                        (pause [this] (run-fn! :pause))
-                       (resize [this w h] (run-fn! :resize))
+                       (resize [this w h] (run-fn! :resize w h))
                        (resume [this] (run-fn! :resume))
                        (dispose [this])))))


Init instrument :scroll-touch-id to correct name

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -114,7 +114,7 @@
      :w 0 :h 0
      :sound-ready false
      :px-per-ms 0.1
-     :scrolling-touch-id nil
+     :scroll-touch-id nil
      :start start
      :playhead start}))


Remove unused functions render and create-viewport

--- src/gol/client/bl.cljs
+++ src/gol/client/bl.cljs
@@ -18,18 +18,9 @@

 (def step (stepper neighbours #{3} #{2 3}))

-(defn create-viewport [w h] (vec (repeat w (vec (repeat h nil)))))
-
 (defn filter-on-viewport
   [bw bh coll]
   (filter (fn [[x y]] (and (< -1 x bw) (< -1 y bh))) coll))
-
-(defn render
-  [viewport living-cells]
-  (reduce
-    (fn [viewport coordinates] (assoc-in viewport coordinates :on))
-    viewport
-    living-cells))

 (defn rand-2d
   [width height]


implement basic breadth-first search; disallow wall moves that box opponent in

--- src/quoridor/core.clj
+++ src/quoridor/core.clj
@@ -1,7 +1,8 @@
 (ns quoridor.core
   (:gen-class)
   (:require [quoridor.board :as board]
-            [clojure.string :as s]))
+            [clojure.string :as s]
+            [clojure.set]))

 (def ^{:private true} black-white (cycle ["black" "white"]))

@@ -76,37 +77,76 @@
       (right? move current-position) (board/in-walls? v-walls current-position)
       (left? move current-position) (board/in-walls? v-walls move))))

+(defn- neighbours
+  [current-position state]
+  (let [walls (state :walls)]
+    (set (filter (fn [m] (and (valid-move? m)
+                              (not (wall-between? current-position m walls))))
+                 [(up current-position)
+                  (down current-position)
+                  (left current-position)
+                  (right current-position)
+                  (jump state)]))))
+
+(defn- filter-seen
+  [came-from current state]
+  (filter #(not (contains? (set (keys came-from)) %))
+          (neighbours current state)))
+
+(defn- breadcrumbs
+  [player state]
+  (loop [frontier (list (state player))
+         came-from { (first frontier) nil }]
+    (if (empty? frontier)
+      came-from
+      (let [current (last frontier)
+            remaining-frontier (butlast frontier)
+            unseen-neighbours (filter-seen came-from current state)]
+        (recur (concat unseen-neighbours remaining-frontier)
+               (if (empty? unseen-neighbours)
+                 came-from
+                 (apply assoc came-from (flatten (map #(list % current) unseen-neighbours)))))))))
+
 (defn- allowed-pawn-move?
   [state move]
   (let [current-position (state (keyword (state :current)))
         other-position (if (= (state :current) "black")
                          (state :white)
                          (state :black))]
-    (and (contains? (set (filter valid-move? [(up current-position)
-                                              (down current-position)
-                                              (left current-position)
-                                              (right current-position)
-                                              (jump state)]))
-                    move)
-         (not (contains? (set [current-position other-position]) move))
-         (not (wall-between? current-position move (state :walls))))))
+    (and (contains? (neighbours current-position state) move)
+         (not (contains? (set [current-position other-position]) move)))))

 (defn- normalise-wall-move
   [move]
   (apply str (sort [(subs move 0 2) (subs move 2 4)])))

-(defn- allowed-wall-move?
-  [state move]
-  (if (and (= (count move) 4)
-           (not (contains? (state :walls) move)))
-    (let [normalised-move (normalise-wall-move move)
+(defn- valid-wall-move?
+  [move]
+  (let [normalised-move (normalise-wall-move move)
           first-pos (subs normalised-move 0 2)
           second-pos (subs normalised-move 2 4)]
       (and (contains? (board/char-range \a \g) (first first-pos))
            (contains? (board/char-range \1 \7) (second first-pos))
            (or (= (right first-pos) second-pos)
-               (= (up first-pos) second-pos))))
-    false))
+               (= (up first-pos) second-pos)))))
+
+(defn neither-player-boxed-in?
+  [potential-state]
+  (let [black-paths (breadcrumbs :black potential-state)
+        white-paths (breadcrumbs :white potential-state)
+        black-goals #{"a8" "b8" "c8" "d8" "e8" "f8" "g8" "h8"}
+        white-goals #{"a1" "b1" "c1" "d1" "e1" "f1" "g1" "h1"}]
+    (and (not-empty (clojure.set/intersection (set (keys black-paths)) black-goals))
+         (not-empty (clojure.set/intersection (set (keys white-paths)) white-goals)))))
+
+(defn- allowed-wall-move?
+  [state move]
+  (and (= (count move) 4)
+       (not (contains? (state :walls) move))
+       (valid-wall-move? move)
+       (let [walls (state :walls)
+             potential-state (assoc-in state [:walls] (conj walls move))]
+         (neither-player-boxed-in? potential-state))))

 (defn- black-won?
   [state]


Fix Tour

Fix Tour

--- src/re_demo/tour.cljs
+++ src/re_demo/tour.cljs
@@ -2,9 +2,15 @@
   (:require-macros [cljs.core.async.macros :refer [go]])
   (:require [re-com.util   :as     util]
             [re-com.core   :refer  [button]]
+
+            [re-demo.util      :refer [title]]
             [re-com.box    :refer  [h-box v-box box gap line]]
             [reagent.core  :as     reagent]))

+
+(defn simple-demo
+  []
+  [title "Tour"])

 (defn panel
   []


formatting

formatting

--- src-cljs/lein_ui/app.cljs
+++ src-cljs/lein_ui/app.cljs
@@ -156,8 +156,9 @@
                                     {:state :no-response}
                                     result)]
             (om/transact! project
-                          (fn [p]
-                            (update-in p [:repl :history :entries index] merge final-state))))))))
+                         (fn [p]
+                            (update-in p [:repl :history :entries index]
+                                       merge final-state))))))))

 (defn ensure-project-controller-process [project]
   (if-let [controller (@project :controller)]
@@ -167,10 +168,12 @@
        :process (go
                   (get-edn-url in (@project :url))
                   (let [summary (<! in)]
-                    (om/transact! project (fn [p]
-                                            (-> p
-                                                (merge summary)
-                                                (assoc-in [:repl :history] {:index 0 :entries (sorted-map-by >)})))))
+                    (om/transact! project
+                                  (fn [p]
+                                    (-> p
+                                        (merge summary)
+                                        (assoc-in [:repl :history]
+                                                  {:index 0 :entries (sorted-map-by >)})))))

                   (get-edn-url in (@project :raw-map-url))
                   (let [raw-map (<! in)]
@@ -188,7 +191,8 @@
         (swap! app-state (fn [state]
                            (-> state
                                (assoc-in [:projects :active] (@project :name))
-                               (assoc-in [:projects :map (:name @project) :controller] (ensure-project-controller-process project))))))
+                               (assoc-in [:projects :map (:name @project) :controller]
+                                         (ensure-project-controller-process project))))))
       (recur))))


closes #89

closes #89

--- src-cljs/rmfu_ui/nav.cljs
+++ src-cljs/rmfu_ui/nav.cljs
@@ -2,6 +2,7 @@
   (:require [secretary.core :as secretary :include-macros true]
             [reagent.core :as reagent]
             [ajax.core :refer [GET]]
+            [rmfu-ui.alert :refer [alert]]
             [reagent.session :as session]))

 (defn logout
@@ -14,6 +15,17 @@
 (defn identity-token []
   (.getItem (.-localStorage js/window) "rmfu-feed-identity-token"))

+(def app-state (reagent/atom
+          {:alert                    {:display false
+                                      :message nil
+                                      :title   nil}}))
+
+(defn alert-update-display-fn [title msg]
+          (swap! app-state assoc
+          :alert {:title   title
+                  :message msg
+                  :display true}))
+
 (defn nav
   "Renders basic nav with an .active link"
   [active]
@@ -24,13 +36,17 @@
          (if (identity-token)
            (GET "/api/user"
                 {:headers         {:identity (identity-token)}
-                 :error-handler   #(secretary/dispatch! "/")
+                 :error-handler   (fn []
+                                    (logout)
+                                    (alert-update-display-fn "Session Expired" "Your session has expired, redirecting to the sign-in sreen")
+                                    #(secretary/dispatch! "/"))
                  :response-format :json
                  :keywords?       true
                  :handler         (fn [res]
                                     (session/put! :profile res))})))
        :reagent-render
        (fn []
+         [:div
          [:nav {:className "navbar navbar-light bg-faded"}
           [:img.navbar-brand.feed-logo {:href "/#/feed" :src "/images/rmfu-logo.png"}]
           (if-let [profile (session/get :profile)]
@@ -47,4 +63,6 @@
                  [:a.nav-link.active {:href "/#/admin"} "Admin"]])]
              [:form.form-inline.navbar-form.pull-right
               [:button.btn.btn-success-outline {:type "button" :on-click #(logout)} "logout"]]]
-            [:a.navbar-brand.feed-title {:href "/"} "FEED"])])})))
+            [:a.navbar-brand.feed-title {:href "/"} "FEED"])]
+         [:div [alert :error app-state 5000]]]
+         )})))


Fixes #44 - Have test for k-means on n < k giving n clusters

--- test/cluster_tests.clj
+++ test/cluster_tests.clj
@@ -14,20 +14,24 @@
    [-1  1  0  1]]))

+(defn size-correct [clusters n]
+  (is (= n (count clusters))))
+
+
 ; Initialization test
-(deftest init-clusters-test
+(deftest init-test
   (let [n-clusts 2
         ic       (init-clusters real-nmat n-clusts)]
     (testing "gives right number of clusters"
-      (is (= 2 (count ic))))
+      (size-correct ic 2))
     (testing "doesn't give duplicate clusters"
       (is (not (= (:center (first ic)) (:center (second ic))))))))

-(deftest k-means-test
+(deftest basic-test
   (let [n-clusts 2
         clusts   (kmeans real-nmat n-clusts)]
     (testing "gives right number of clusters"
-      (is (= 2 (count clusts))))
+      (size-correct clusts 2))
     (testing "doesn't give duplicate clusters"
       (is (not (= (:center (first clusts)) (:center (second clusts))))))
     (testing "coordinate transforms should be handled gracefully"
@@ -41,5 +45,12 @@
         ; basically just testing here that things don't break
         (is (= 2 (count (kmeans real-nmat 2 :last-clusters clusts))))))))

-; Need to test having to add new clusters when the number isn't right; this is going to be intersting
+(deftest edge-cases
+  (testing "k-means on n < k items gives n clusters"
+    (let [data (named-matrix
+                 ["p1" "p2"]
+                 ["c1" "c2" "c3"]
+                 [[ 0  1  0 ]
+                  [-1  1  0 ]])]
+      (size-correct (kmeans data 3) 2))))


Add selection tests

Add selection tests

--- test/eq/core_test.cljs
+++ test/eq/core_test.cljs
@@ -1,7 +1,16 @@
 (ns eq.core-test
   (:require [eq.core :as eq]
-            [cljs.test :refer-macros [deftest is testing]]
+            [cljs.test :refer-macros [deftest is are testing]]
             [cljs.nodejs :as node]))

 (deftest build-selector
-  (is (nil? (eq/build-selector "foo"))))
+  (is (nil? (eq/->selector "foo"))))
+
+(deftest select-empty-selector
+  (let [sel (eq/->selector "")]
+    (is (some? sel))
+    (are [data] (= [data] (eq/select sel [data]))
+       {}
+       {:a 1 :b 2}
+       {"" 42}
+       )))


param -> env (for envelope)

param -> env (for envelope)

--- src/semitone/core.clj
+++ src/semitone/core.clj
@@ -31,7 +31,7 @@
            [java.nio ByteBuffer]
            [com.sun.media.sound SF2Soundbank]))

-(defn param [num-points values & args]
+(defn env [num-points values & args]
   (let [args (if (empty? args) '(:cubic) args)
         interp (apply interpolate-parametric values args)
         fix-type (cond


Add Test for Retracting Subjects

Add Test for Retracting Subjects

--- test/lens/api_test.clj
+++ test/lens/api_test.clj
@@ -16,6 +16,8 @@

 (use-fixtures :each database-fixture)

+;; ---- Subject ---------------------------------------------------------------
+
 (deftest subject-test
   (let [conn (connect)]
     @(d/transact conn [[:add-subject "id-142055"]])
@@ -23,6 +25,17 @@
       (is (:db/id (subject (d/db conn) "id-142055"))))
     (testing "is not found"
       (is (nil? (subject (d/db conn) "other-id-142447"))))))
+
+(deftest retract-subject-test
+  (let [conn (connect)]
+    @(d/transact conn [[:add-subject "id-142055"]])
+    (testing "is retracted"
+      (is (retract-subject conn "id-142055"))
+      (is (nil? (subject (d/db conn) "id-142055"))))
+    (testing "is not found"
+      (is (false? (retract-subject conn "other-id-142447"))))))
+
+;; ---- Item Group ------------------------------------------------------------

 (deftest item-group-test
   (let [conn (connect)]


improve logging and throw exceptions more often

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -22,7 +22,7 @@

 (defn exception [error-string]
   #?(:clj
-     (throw (Exception. error-string)))
+     (throw (Exception. (str ": " error-string))))
   #?(:cljs
      (throw (js/Error. error-string))))

@@ -31,6 +31,10 @@
   #?(:cljs (.getTime (js/Date.))))

 (defn generate [spec grammar lexicon index morph]
+  (if (empty? grammar)
+    (do
+      (log/error (str "grammar is empty."))
+      (exception (str "grammar is empty."))))
   (first (take 1 (generate-all spec grammar lexicon index morph))))

 (defn generate-all-with-model [spec {grammar :grammar
@@ -49,6 +53,11 @@
                 morph))))

 (defn generate-all [spec grammar lexicon index morph]
+  (if (empty? grammar)
+    (do
+      (log/error (str "grammar is empty."))
+      (exception (str "grammar is empty."))))
+
   (filter #(not (fail? %))
           (cond (and (or (seq? spec)
                          (vector? spec))
@@ -57,10 +66,10 @@
                           (generate-all (rest spec) grammar lexicon index morph))
                 true
                 (do
-                  (log/trace (str "generate-all with semantics: " (show-spec (remove-false (get-in spec [:synsem :sem])))))
-                  (log/trace (str "generate-all with spec: " (strip-refs spec)))
-                  (log/trace (str "generate-all with pred: " (show-spec (remove-false (get-in spec [:synsem :sem :pred])))))
-                  (log/trace (str "generate-all(details): " (show-spec spec)))
+                  (log/debug (str "generate-all with semantics: " (show-spec (remove-false (get-in spec [:synsem :sem])))))
+                  (log/debug (str "generate-all with spec: " (strip-refs spec)))
+                  (log/debug (str "generate-all with pred: " (show-spec (remove-false (get-in spec [:synsem :sem :pred])))))
+                  (log/debug (str "generate-all(details): " (show-spec spec)))
                   (let [lb (lightning-bolt (lazy-shuffle grammar)
                                            lexicon
                                            spec 0 index nil morph)]
@@ -84,30 +93,39 @@
 head of its parent. generate (above) 'decorates' each returned lightning bolt
 of this function with complements."

+  (if (empty? grammar)
+    (do
+      (log/error (str "grammar is empty."))
+      (exception (str "grammar is empty."))))
+
   (if (and (not (= :fail spec))
            (not (empty? (strip-refs spec))))
-    (log/trace (str "lighting-bolt@" depth " spec: " (strip-refs spec) "; parent: " (if parent
+    (log/debug (str "lighting-bolt@" depth " spec: " (strip-refs spec) "; parent: " (if parent
                                                                                (:rule parent)))))
   (if (not parent)
-    (log/trace (str "no parent for lightning-bolt@" depth " with spec: " (strip-refs spec))))
+    (log/debug (str "no parent for lightning-bolt@" depth " with spec: " (strip-refs spec))))
   (let [maxdepth 3 ;; maximum depth of a lightning bolt: H1 -> H2 -> H3 where H3 must be a lexeme, not a phrase.
-        debug (log/trace (str "lightning-bolt@" depth " grammar:" (string/join ", " (map #(get-in % [:rule]) grammar))))
+        debug (log/debug (str "lightning-bolt@" depth " grammar:" (string/join ", " (map #(get-in % [:rule]) grammar))))

         depth (if depth depth 0)
         ;; TODO: unifyc is expensive: factor out into a let.
-        debug (log/trace (str "looking for candidate parents.."))
+        debug (log/debug (str "looking for candidate parents with parent: " (:rule parent) " and spec: " (strip-refs spec)))
         candidate-parents (filter #(not (fail? %))
                                   (map (fn [rule]
-                                         (unifyc spec rule))
+                                         (do (log/debug (str "testing rule: " (:rule rule)))
+                                             (unifyc spec rule)))
                                        (if parent (get-head-phrases-of parent index)
                                            grammar)))

-        debug (log/trace (str "done looking for candidate parents:" candidate-parents))
+        debug (log/debug (str "done looking for candidate parents: "
+                              (if (empty? candidate-parents)
+                                "no candidate parents found."
+                                (str "one or more candidate parents found; first: " (:rule (first candidate-parents))))))

         debug (if (not (empty? candidate-parents))
-                (log/trace (str "candidate-parents: " (string/join "," (map #(get-in % [:rule])
+                (log/debug (str "candidate-parents: " (string/join "," (map #(get-in % [:rule])
                                                                             candidate-parents))))
-                (log/trace (str "no candidate-parents for spec: " (strip-refs spec))))]
+                (log/debug (str "no candidate-parents for spec: " (strip-refs spec))))]
     ;; TODO: remove or parameterize this hard-coded value.
     (if (> depth 5)
       (throw (exception (str "DEPTH IS GREATER THAN 5; HOW DID YOU END UP IN THIS TERRIBLE SITUATION? LOOK AT THE STACK. I'M OUTTA HERE."))))
@@ -116,27 +134,24 @@
       (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
             (mapcat (fn [parent]
                       (let [candidate-lexemes (get-lex parent :head index spec)]
-                        (log/trace
+                        (log/debug
                          (str "candidate head lexeme for parent: "
                               (get-in parent [:rule]) ": "
                               (string/join ","
                                            (map (fn [lexeme]
                                                   (morph lexeme))
                                                 candidate-lexemes))))
-                        (let [result (over/overh parent (lazy-shuffle (get-lex parent :head index spec)) morph)]
-                          (log/trace
-                           (str "parent: " (get-in parent [:rule]) " with head lexemes: "
-                                (string/join ","
-                                             (map #(morph %1)
-                                                  result))))
-                          (if (not (empty? (get-lex parent :head index spec)))
-                            (if (empty? result)
-                              (log/trace (str "failed to attach any head lexemes to: " (get-in parent [:rule])))
-
-                              (log/trace (str "successful results of attaching head lexemes to: " (get-in parent [:rule]) ":"
-                                              (string/join ","
-                                                           (map #(morph %1)
-                                                                result))))))
+                        (let [result
+                              (if (empty? (get-lex parent :head index spec))
+                                (do (log/warn (str "no head lexemes found for parent: " (:rule parent) " and spec: "
+                                                   (strip-refs spec)))
+                                    nil)
+                                (over/overh parent (lazy-shuffle (get-lex parent :head index spec)) morph))]
+                          (if (not (empty? result))
+                            (log/debug (str "successful results of attaching head lexemes to: " (get-in parent [:rule]) ":"
+                                            (string/join ","
+                                                         (map #(morph %1)
+                                                              result)))))
                           result)))
                     candidate-parents)

@@ -145,29 +160,20 @@
             ;; recursively call lightning-bolt with (+ 1 depth).
             (if (< depth maxdepth)
               (mapcat (fn [parent]
-                        (log/trace (str "calling over/overh with parent: " (get-in parent [:rule])))
+                        (log/debug (str "calling over/overh with parent: " (get-in parent [:rule])))
                         (let [phrasal-children
                               (lightning-bolt grammar lexicon
                                               (get-in parent [:head])
                                               (+ 1 depth)
                                               index parent morph)]
-                          (log/trace (str "calling overh with parent: [" (get-in parent [:rule]) "]" "'" (morph parent) "'"
-                                          " and children: "
-                                          (if phrasal-children
-                                            (str "(" (count phrasal-children) ")")
-                                            "(nil)")
-                                          (string/join ","
-                                           (map (fn [child]
-                                                  (str "[" (get-in child [:rule]) "]"
-                                                       "'" (morph child) "'"
-                                                       ))
-                                                phrasal-children))))
                           (if (empty? phrasal-children)
                             (let [message (str "no phrasal children for parent: " (morph parent) "(rule=" (get-in parent [:rule]) ")" )]
-                              (log/trace message))
+                              (log/debug message))
                             ;; else; there are phrasal-children, so attach them below parent:
                             (do
-                              (log/trace (str "phrasal-children:" (map morph phrasal-children)))
+                              (log/debug (str "phrasal-children:" (string/join "," (map morph phrasal-children))))
+                              (log/debug (str "calling overh with parent: [" (get-in parent [:rule]) "]" "'" (morph parent) "'"
+                                              " and " (count phrasal-children) " phrasal children."))
                               (over/overh parent phrasal-children morph)))
                           )
                         )
@@ -181,11 +187,11 @@
         from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
         bolt-spec (get-in bolt path :no-path)
         spec (unifyc spec bolt-spec)]
-    (log/trace (str "add-complement at path: " path " to bolt with bolt:["
+    (log/debug (str "add-complement at path: " path " to bolt with bolt:["
                     (if (map? bolt) (get-in bolt [:rule]))
                     " '" (morph bolt) "'"
                     "]"))
-    (log/trace (str "add-complement to bolt with path:" path))
+    (log/debug (str "add-complement to bolt with path:" path))

     (if (not (= bolt-spec :no-path)) ;; check if this bolt has this path in it.
       (let [immediate-parent (get-in bolt (butlast path))
@@ -194,18 +200,18 @@
                      (do
                        (let [result (get-lex immediate-parent :comp cache spec)]
                          (if (not (nil? result))
-                           (log/trace (str " cached lexical subset ratio: "
+                           (log/debug (str " cached lexical subset ratio: "
                                            (string/replace (str (/ (* 1.0 (/ (count lexicon) (count result)))))
                                                            #"\.(..).*"
                                                            (fn [[_ two-digits]] (str "." two-digits))))))
                          result))
-                     (do (log/trace (str "no cache: will go through entire lexicon."))
+                     (do (log/debug (str "no cache: will go through entire lexicon."))
                          nil))
             complement-candidate-lexemes (if cached cached (flatten (vals lexicon)))]
         (let [semantics (get-in spec [:synsem :sem])]
           (if (not (nil? semantics))
-            (if (not (nil? semantics)) (log/trace (str "  with semantics:" (strip-refs semantics))))))
-        (log/trace (str " immediate parent:" (get-in immediate-parent [:rule])))
+            (if (not (nil? semantics)) (log/debug (str "  with semantics:" (strip-refs semantics))))))
+        (log/debug (str " immediate parent:" (get-in immediate-parent [:rule])))
         (let [complement-pre-check (fn [child parent path-to-child]
                                      (let [child-in-bolt (get-in bolt path-to-child)]
                                        (and (not (fail?
@@ -214,8 +220,8 @@
               filtered-lexical-complements (filter (fn [lexeme]
                                                      (complement-pre-check lexeme bolt path))
                                                    complement-candidate-lexemes)
-              debug (log/trace (str "pre-filtered size: " (count complement-candidate-lexemes)))
-              debug (log/trace (str "filtered size: " (count filtered-lexical-complements)))
+              debug (log/debug (str "pre-filtered size: " (count complement-candidate-lexemes)))
+              debug (log/debug (str "filtered size: " (count filtered-lexical-complements)))
               shuffled-candidate-lexical-complements (lazy-shuffle filtered-lexical-complements)

               return-val
@@ -225,6 +231,8 @@
                              (let [debug (log/debug (str "adding complement to: ["
                                                          (get-in bolt [:rule]) " "
                                                          (morph bolt) "]: trying lexical complement:" (morph complement)))
+                                   debug (if (= "" (morph complement))
+                                           (log/error (str "WHY IS IT EMPTY: " complement)))
                                    result
                                    (unify (copy bolt)
                                           (path-to-map path
@@ -266,7 +274,7 @@
                 (log/error message)
 ;                (throw (exception message)))
 )
-              (do (log/trace (str "add-complement after adding complement: "
+              (do (log/debug (str "add-complement after adding complement: "
                                   (string/join ","
                                                (map (fn [each]
                                                       (morph each))


stupid naming mistake

stupid naming mistake

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -125,17 +125,14 @@
 (defn game-handler [[ch-in ch-out :as chs]]
   (go-loop []
     (when-let [msg (<! ch-in)]
-      (>! ch-out msg)
-      (recur))
-    #_(when-let [msg (<! ch-in)]
-        (let [{:keys [type id]} msg]
-          (if (and (= type "start") id)
-            (let [latch (chan)]
-              (>! @matcher {:id id :chs chs :latch latch})
-              ;; Waits here until game ends
-              (<! latch))
-            (do (>! ch-out {:type "ignored" :msg msg})
-                (recur)))))))
+      (let [{:keys [type id]} msg]
+        (if (and (= type "start") id)
+          (let [latch (chan)]
+            (>! @matcher {:id id :chs chs :latch latch})
+            ;; Waits here until game ends
+            (<! latch))
+          (do (>! ch-out {:type "ignored" :msg msg})
+              (recur)))))))

 ;;; Game loop
 (defn game-init [s]
@@ -152,7 +149,7 @@
       (st/close! s))))

 ;;; Websocket connection for the game protocol
-(defn game-handler [req]
+(defn game-websocket [req]
   (let [s @(http/websocket-connection req)]
     (game-init s)))

@@ -165,7 +162,7 @@

 (defroutes app
   ;; (GET "/firehose" [] #'firehose-handler)
-  (GET "/" [] #'game-handler))
+  (GET "/" [] #'game-websocket))

 (defn -main [& args]
   (matcher-init)


Only assign :schwarzschrift if product-number starts with "SS"

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -325,8 +325,10 @@
       :e-book item
       :musiknoten (-> item
                       (assoc-some
-                        ;; if we cannot find a matching braille grade assume the item is in schwarzschrift
-                       :braille-grade (braille-music-grade-raw-to-braille-grade braille-music-grade :schwarzschrift)
+                        ;; first try to decode the braille-music-grade. Next check if the product-number
+                        ;; starts with "SS". Otherwise set the braille-grade to nil.
+                       :braille-grade (or (braille-music-grade-raw-to-braille-grade braille-music-grade)
+                                          (when (re-find #"^SS\d{5,}" product-number) :schwarzschrift))
                        :volumes (parse-int volumes)
                        :accompanying-material accompanying-material))
       :taktilesbuch (-> item


Don't need to print smodel anymore.

Don't need to print smodel anymore.

--- src/cbfg/zgo/core.clj
+++ src/cbfg/zgo/core.clj
@@ -117,12 +117,8 @@
         (recur sline-end
                (rest pmodel))))))

-(defn -main
-  "some docstring"
-  []
-  (println "hello world from zgo")
+(defn -main []
   (let [smodel (read-model-file "src/cbfg/fence.cljs")
         pmodel (process-top-level-forms smodel)]
-    (pprint smodel)
     (emit (:lines smodel) pmodel)))


wrap json kw params

wrap json kw params

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -14,6 +14,7 @@
   (:require
     [celestial.roles :refer (admin su)]
     [ring.middleware.format :refer (wrap-restful-format)]
+    [ ring.middleware.format-params :refer (wrap-json-kw-params)]
     [ring.middleware.session-timeout :refer (wrap-idle-session-timeout)]
     [ring.middleware.x-headers :refer (wrap-frame-options)]
     [swag.model :refer (wrap-swag)]
@@ -84,6 +85,7 @@
       (wrap-swag)
       (wrap-idle-session-timeout {:timeout (or (get* :celestial :session-timeout) 600) :timeout-response (ring.util.response/redirect (<< "/login"))})
       (wrap-session {:cookie-name "celestial" :store (cookie-store) :cookie-attrs {:secure true :max-age 3600}})
+      (wrap-json-kw-params)
       (wrap-restful-format :formats [:json-kw :edn :yaml-kw :yaml-in-html])
       (handler/api)
       (wrap-frame-options :deny)


CLJS-284: do not emit flags on the prototype for fast path protocols

With this patch, no flags are emitted for fast path protocols
implemented inline (this includes the implicit impls provided by
defrecord).

Additionally, protocols implicitly implemented by records now receive
fast path treatment on record instances. (The appropriate bits were
not being set previously.)

extend-type now checks the type symbol's metadata for a
:skip-protocol-flag key. If present, it should hold a set of fully
resolved protocol names for which extend-type should emit no
flags (presumably because the appropriate bit is set in the protocol
mask).

deftype and defrecord now attach appropriate :skip-protocol-flag
metadata to symbols passed on to extend-type.

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -343,7 +343,8 @@
                                       (cljs.compiler/warning &env
                                         (core/str "WARNING: Symbol " % " is not a protocol")))
                                     (cljs.compiler/warning &env
-                                      (core/str "WARNING: Can't resolve protocol symbol " %)))))]
+                                      (core/str "WARNING: Can't resolve protocol symbol " %)))))
+        skip-flag (set (-> tsym meta :skip-protocol-flag))]
     (if (base-type tsym)
       (let [t (base-type tsym)
             assign-impls (fn [[p sigs]]
@@ -369,31 +370,32 @@
                                  (map (fn [[f & meths]]
                                         `(set! ~(symbol (core/str prototype-prefix f)) (fn ~@(map adapt-params meths))))
                                       sigs))
-                               (cons `(set! ~(symbol (core/str prototype-prefix pprefix)) true)
-                                     (mapcat (fn [[f & meths]]
-                                               (if (= psym 'cljs.core.IFn)
-                                                 (let [adapt-params (fn [[[targ & args :as sig] & body]]
-                                                                      (let [tsym (gensym "tsym")]
-                                                                        `(~(with-meta (vec (cons tsym args)) (meta sig))
-                                                                          (this-as ~tsym
-                                                                                (let [~targ ~tsym]
-                                                                                ~@body)))))
-                                                       meths (map adapt-params meths)
-                                                       tsym (gensym "tsym")
-                                                       argsym (gensym "args")]
-                                                    [`(set! ~(symbol (core/str prototype-prefix 'call)) (fn ~@meths))
-                                                     `(set! ~(symbol (core/str prototype-prefix 'apply))
-                                                            (fn ~(with-meta [tsym argsym] (meta (first meths)))
-                                                              (.apply (.-call ~tsym) ~tsym
-                                                                      (.concat (array ~tsym) (aclone ~argsym)))))])
-                                                 (let [pf (core/str prototype-prefix pprefix f)]
-                                                   (if (vector? (first meths))
-                                                     [`(set! ~(symbol (core/str pf "$arity$" (count (first meths)))) (fn ~@meths))]
-                                                     (map (fn [[sig & body :as meth]]
-                                                            `(set! ~(symbol (core/str pf "$arity$" (count sig)))
-                                                                   (fn ~meth)))
-                                                          meths)))))
-                                             sigs)))))]
+                               (concat (when-not (skip-flag psym)
+                                         [`(set! ~(symbol (core/str prototype-prefix pprefix)) true)])
+                                       (mapcat (fn [[f & meths]]
+                                                 (if (= psym 'cljs.core.IFn)
+                                                   (let [adapt-params (fn [[[targ & args :as sig] & body]]
+                                                                        (let [tsym (gensym "tsym")]
+                                                                          `(~(with-meta (vec (cons tsym args)) (meta sig))
+                                                                            (this-as ~tsym
+                                                                              (let [~targ ~tsym]
+                                                                                ~@body)))))
+                                                         meths (map adapt-params meths)
+                                                         tsym (gensym "tsym")
+                                                         argsym (gensym "args")]
+                                                     [`(set! ~(symbol (core/str prototype-prefix 'call)) (fn ~@meths))
+                                                      `(set! ~(symbol (core/str prototype-prefix 'apply))
+                                                             (fn ~(with-meta [tsym argsym] (meta (first meths)))
+                                                               (.apply (.-call ~tsym) ~tsym
+                                                                       (.concat (array ~tsym) (aclone ~argsym)))))])
+                                                   (let [pf (core/str prototype-prefix pprefix f)]
+                                                     (if (vector? (first meths))
+                                                       [`(set! ~(symbol (core/str pf "$arity$" (count (first meths)))) (fn ~@meths))]
+                                                       (map (fn [[sig & body :as meth]]
+                                                              `(set! ~(symbol (core/str pf "$arity$" (count sig)))
+                                                                     (fn ~meth)))
+                                                            meths)))))
+                                               sigs)))))]
         `(do ~@(mapcat assign-impls impl-map))))))

 (defn- prepare-protocol-masks [env t impls]
@@ -408,15 +410,19 @@
     (if-let [fpp-pbs (seq (keep fast-path-protocols
                                 (map resolve
                                      (keys impl-map))))]
-      (let [fpp-partitions (group-by first fpp-pbs)
+      (let [fpps (into #{} (filter (partial contains? fast-path-protocols)
+                                   (map resolve
+                                        (keys impl-map))))
+            fpp-partitions (group-by first fpp-pbs)
             fpp-partitions (into {} (map (juxt key (comp (partial map peek) val))
                                          fpp-partitions))
             fpp-partitions (into {} (map (juxt key (comp (partial reduce core/bit-or) val))
                                          fpp-partitions))]
-        (reduce (fn [ps p]
-                  (update-in ps [p] (fnil identity 0)))
-                fpp-partitions
-                (range fast-path-protocol-partitions-count))))))
+        [fpps
+         (reduce (fn [ps p]
+                   (update-in ps [p] (fnil identity 0)))
+                 fpp-partitions
+                 (range fast-path-protocol-partitions-count))]))))

 (defmacro deftype [t fields & impls]
   (let [adorn-params (fn [sig]
@@ -436,13 +442,13 @@
                             (drop-while seq? (next s)))
                      ret)))
         r (:name (cljs.compiler/resolve-var (dissoc &env :locals) t))
-        pmasks (prepare-protocol-masks &env t impls)]
+        [fpps pmasks] (prepare-protocol-masks &env t impls)]
     (if (seq impls)
       `(do
          (deftype* ~t ~fields ~pmasks)
          (set! (.-cljs$lang$type ~t) true)
          (set! (.-cljs$lang$ctorPrSeq ~t) (fn [this#] (list ~(core/str r))))
-         (extend-type ~t ~@(dt->et impls))
+         (extend-type ~(with-meta t {:skip-protocol-flag fpps}) ~@(dt->et impls))
          ~t)
       `(do
          (deftype* ~t ~fields ~pmasks)
@@ -457,7 +463,6 @@
         fields (vec (map #(with-meta % nil) fields))
         base-fields fields
 	fields (conj fields '__meta '__extmap (with-meta '__hash {:mutable true}))
-        pmasks (prepare-protocol-masks env tagname impls)
 	adorn-params (fn [sig]
                        (cons (vary-meta (second sig) assoc :cljs.compiler/fields fields)
                              (nnext sig)))
@@ -531,10 +536,11 @@
 				 pr-pair# (core/str "#" ~(name rname) "{") ", " "}" opts#
 				 (concat [~@(map #(list `vector (keyword %) %) base-fields)]
 					 ~'__extmap))))
-		  ])]
+		  ])
+          [fpps pmasks] (prepare-protocol-masks env tagname impls)]
       `(do
 	 (~'defrecord* ~tagname ~hinted-fields ~pmasks)
-	 (extend-type ~tagname ~@(dt->et impls))))))
+	 (extend-type ~(with-meta tagname {:skip-protocol-flag fpps}) ~@(dt->et impls))))))

 (defn- build-positional-factory
   [rsym rname fields]


Expand install-cost-bonus system to more than just credits.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -514,12 +514,13 @@
         (max 0))))

 (defn install-cost-bonus [state side n]
-  (swap! state update-in [:bonus :install-cost] (fnil #(+ % n) 0)))
-
-(defn install-cost [state side {:keys [cost] :as card}]
-  (-> cost
-      (+ (or (get-in @state [:bonus :install-cost]) 0))
-      (max 0)))
+  (swap! state update-in [:bonus :install-cost] #(merge-costs (concat % n))))
+
+(defn install-cost [state side {:keys [cost] :as card} extra-cost]
+  (vec (map #(if (keyword? %) % (max % 0))
+            (-> (concat [:credit cost] (get-in @state [:bonus :install-cost]) extra-cost
+                        (when-let [instfun (:install-cost-bonus (card-def card))] (instfun state side card nil)))
+            merge-costs flatten))))

 (defn damage-count [state side dtype n {:keys [unpreventable unboostable] :as args}]
   (-> n
@@ -1228,11 +1229,14 @@
                        :effect (effect (runner-install card (assoc params :host-card target)))} card nil)
      (do
        (trigger-event state side :pre-install card)
-       (let [cost (if (or no-cost facedown) 0 (install-cost state side card))]
+       (let [cost (if (or no-cost facedown)
+                    [:credit 0]
+                    (install-cost state side card
+                                  (concat extra-cost (when memoryunits [:memory memoryunits]))))]
          (when (and (or (not uniqueness) (not (in-play? state card)) facedown)
                     (if-let [req (:req (card-def card))]
                       (req state side card nil) true)
-                    (pay state side card :credit cost (when (and (not facedown) memoryunits) [:memory memoryunits]) extra-cost))
+                    (pay state side card cost))
            (let [c (if host-card
                      (host state side host-card card)
                      (move state side card [:rig (if facedown :facedown (to-keyword type))]))


Path#toRealPath doesn't work on Windows

Path#toRealPath doesn't work on Windows

--- src/clj/runbld/io.clj
+++ src/clj/runbld/io.clj
@@ -145,8 +145,9 @@
     (-> path
         file
         .toPath
-        (.toRealPath
-         (into-array java.nio.file.LinkOption []))
+        (cond-> (not (windows?))
+          (.toRealPath
+           (into-array java.nio.file.LinkOption [])))
         str)))

 (s/defn resolve-binary :- s/Str


add trace for _time-travel

add trace for _time-travel

--- src/clj/tictag/db.clj
+++ src/clj/tictag/db.clj
@@ -24,6 +24,7 @@
 (defn at-time
   "This is SUPER hacky and only works for the `db/latest-pings` fn."
   [db t]
+  (timbre/trace "setting _time-travel to" t)
   (assoc db :_time-travel t))

 (defn beeminder-id [user-id]


frisbeegolf

frisbeegolf

--- src/ontrail/nlp.clj
+++ src/ontrail/nlp.clj
@@ -13,6 +13,7 @@
                "Crossfit"           "crossfittasi"
                "Cyclocross"         "cyclocrossaili"
                "Crosstrainer"       "tyllerövispilöi"
+               "Frisbeegolf"        "frisbeegolffasi"
                "Golf"               "golffasi"
                "Hieronta"           "oli hierottavana"
                "Hiihto"             "hiihti"
@@ -168,4 +169,4 @@
     "ettei"
     "kai"
     "jopa"}
-  )+  )


typo fix

typo fix

--- src/ontrail/nlp.clj
+++ src/ontrail/nlp.clj
@@ -1,6 +1,6 @@
 (ns ontrail.nlp)

-(def verb-map {"Crossfit" "crosfittaili"
+(def verb-map {"Crossfit" "crossfittasi"
                "Cyclocross" "cyclocrossaili"
                "Golf" "golffasi"
                "Hieronta" "oli hierottavana"


Remove vary-meta test from persistent-map-test

  Vary-meta is composed of functions from the meta interface. This
  composition is already tested by meta-test.

--- test/clj/clojure/lang/persistent_map_test.clj
+++ test/clj/clojure/lang/persistent_map_test.clj
@@ -285,14 +285,7 @@
     (let [mta {:so :meta}
           m1 (constructor)
           m2 (with-meta m1 mta)]
-      (is (= mta (meta m2)))))
-
-  (testing "vary-meta will return the same object with a function applied to meta"
-    (let [vary-fn #(select-keys %1 %2)
-          m1 (constructor)
-          m2 (with-meta m1 {:a 1 :b 2 :c 3})
-          m3 (vary-meta m2 vary-fn '(:b))]
-      (is (= {:b 2} (meta m3))))))
+      (is (= mta (meta m2))))))

 (deftype Thing [t]
   IHash


Add tests for create-partial-proc-fn.

Add tests for create-partial-proc-fn.

--- test/dsbdp/test/data_processing_dsl_tests.clj
+++ test/dsbdp/test/data_processing_dsl_tests.clj
@@ -217,6 +217,40 @@
 ;;;
 ;;; Tests for generating vectors of functions that can be used in the data processing pipeline.
 ;;;
+(deftest create-partial-proc-fn-test-1
+  (let [input-ba (byte-array (map byte [0 1 2 3 4 5 6 7 8 9]))
+        expected {"a" 0, "b" 1, "c" 2, "d" 3}
+        dsl-expression {:output-type :clj-map
+                        :rules [['a '(int8 0)]
+                                ['b '(int8 1)]
+                                ['c '(int8 2)]
+                                ['d '(int8 3)]
+                                ['e '(int8 4)]
+                                ['f '(int8 5)]
+                                ['g '(int8 6)]
+                                ['h '(int8 7)]
+                                ['i '(int8 8)]
+                                ['j '(int8 9)]]}
+        proc-fn (create-partial-proc-fn dsl-expression 0 4)]
+    (is (= expected (proc-fn input-ba)))))
+
+(deftest create-partial-proc-fn-test-2
+  (let [input-ba (byte-array (map byte [0 1 2 3 4 5 6 7 8 9]))
+        expected {"e" 4, "f" 5, "g" 6}
+        dsl-expression {:output-type :clj-map
+                        :rules [['a '(int8 0)]
+                                ['b '(int8 1)]
+                                ['c '(int8 2)]
+                                ['d '(int8 3)]
+                                ['e '(int8 4)]
+                                ['f '(int8 5)]
+                                ['g '(int8 6)]
+                                ['h '(int8 7)]
+                                ['i '(int8 8)]
+                                ['j '(int8 9)]]}
+        proc-fn (create-partial-proc-fn dsl-expression 4 7)]
+    (is (= expected (proc-fn input-ba {})))))
+
 (deftest dsl-expression-to-function-vector-test-1
   (let [input-ba (byte-array (map byte [0 1 2 3 4 5 6 7 8 9]))
         expected-0 {"a" 0, "b" 1, "c" 2, "d" 3}


Check whether we should log HoneySQL form before doing so :honey_pot:

--- src/metabase/driver/generic_sql/query_processor.clj
+++ src/metabase/driver/generic_sql/query_processor.clj
@@ -270,7 +270,8 @@
   [driverr {inner-query :query}]
   {:pre [(map? inner-query)]}
   (u/prog1 (apply-clauses driverr {} inner-query)
-    (log/debug "HoneySQL Form: 🍯\n" (u/pprint-to-str 'cyan <>))))
+    (when-not qp/*disable-qp-logging*
+      (log/debug "HoneySQL Form: 🍯\n" (u/pprint-to-str 'cyan <>)))))

 (defn mbql->native
   "Transpile MBQL query into a native SQL statement."