Fix serious bug in parsing of CLP output where var values are zero.

--- src/edu/berkeley/ai/util/lp.clj
+++ src/edu/berkeley/ai/util/lp.clj
@@ -176,6 +176,7 @@
     (util/spit in-file mps-file-data)
     (cheap-sh "glpsol" "--max" "-w" out-file "--mps" in-file)
     (let [[[rows cols] [stat1 stat2 rew] & body] (map #(read-string (str "[" % "]")) (util/read-lines out-file))]
+      (assert (is (= (count (drop rows body)) (count var-order))))
       (cond (= stat1 stat2 1) nil ;infeasible
 	    (= stat1 stat2 2) ; solved
 	      [(merge (into {} dummies)
@@ -194,15 +195,21 @@
   (let [[mps-file-data namer var-order dummies] (lp->mps* lp)
 	in-file (util/fresh-random-filename "/tmp/lp")
 	out-file (str in-file ".out")]
-;    (println in-file)
+    (println in-file "\n"  var-order "\n\n")
     (util/spit in-file mps-file-data)
     (cheap-sh "clp" "-max" "-import" in-file "-solve" "-solution" out-file)
     (let [[[status] [obj val rew] & body] (map #(read-string (str "[" % "]")) (util/read-lines out-file))]
       (assert (is (= [obj val] '[Objective value])))
+;      (assert (is (= (count body) (count var-order))))
       (cond (= status 'infeasible) nil
 	    (= status 'optimal)
-	      [(merge (into {} dummies)
-		      (into {} (map (fn [[_ _ val _] var] [var val]) body var-order)))
+	      [(loop [result (transient (into {} dummies)) i 0 body body vars (seq var-order)]
+                 (if-let [[[var _ val _] & more] body]
+                     (do (assert (>= var i))
+                       (if (= var i)
+                           (recur (assoc! result (first vars) val) (inc i) more (next vars))
+                         (recur (assoc! result (first vars) 0.0) (inc i) body (next vars))))
+                   (persistent! result)))
 	       (- rew)]
 	      ;; NOTE negation of reward due to apparent bug in CLP's handling of max.
 	    :else ;huh?


Fix KB initialization.

Fix KB initialization.

This addresses a bug introduced in the previous commit that refactored
the KB initialization.  To perform the initialization a KB *instance* is
required, as returned by `edu.ucdenver.kr.kb/kb`.

--- kabob-build/src/main/clojure/edu/ucdenver/ccp/kabob/build/input_kb.clj
+++ kabob-build/src/main/clojure/edu/ucdenver/ccp/kabob/build/input_kb.clj
@@ -1,7 +1,7 @@

 (ns edu.ucdenver.ccp.kabob.build.input-kb
   (:require [edu.ucdenver.ccp.kr.kb
-             :refer [connection]]
+             :refer [connection kb]]
             [edu.ucdenver.ccp.kr.rdf
              :refer [register-namespaces synch-ns-mappings]]
             [edu.ucdenver.ccp.kr.sesame.kb
@@ -20,6 +20,6 @@
             *repository-name* (:repo-name args)
             *username* (:username args)
             *password* (:password args)]
-    (initialize-kb HTTPRepository)))
+    (initialize-kb (kb HTTPRepository))))

 (def source-kb open-kb)


Uses keyspace upon connecting

Uses keyspace upon connecting

--- joplin.cassandra/src/joplin/cassandra/database.clj
+++ joplin.cassandra/src/joplin/cassandra/database.clj
@@ -19,8 +19,7 @@
     (catch AlreadyExistsException e)))

 (defn get-connection [hosts keyspace]
-  (when-let [conn (cc/connect hosts)]
-    (cql/use-keyspace conn keyspace)
+  (when-let [conn (cc/connect hosts keyspace)]
     conn))

 ;; ============================================================================


Memoize and simplify parts of insertion.

--- src/datomish/db.cljc
+++ src/datomish/db.cljc
@@ -236,6 +236,9 @@
     (go-pair
       (let [schema         (.-schema db)
             many?          (memoize (fn [a] (ds/multival? schema a)))
+            indexing?      (memoize (fn [a] (ds/indexing? schema a)))
+            ref?           (memoize (fn [a] (ds/ref? schema a)))
+            unique?        (memoize (fn [a] (ds/unique? schema a)))
             <exec          (partial s/execute! (:sqlite-connection db))]
         (p :delete-tx-lookup-before
            (<? (<exec ["DROP INDEX IF EXISTS id_tx_lookup_added"]))
@@ -255,43 +258,43 @@
                      (if (many? a)
                        ;; :db.cardinality/many
                        (<? (<exec [(str "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, index_avet0, index_vaet0, index_fulltext0, unique_value0, sv, svalue_type_tag) VALUES ("
-                                        "?, ?, ?, ?, 1, ?, " ;; e0, a0, v0, tx0, added0, value_type_tag0
-                                        "?, ?, ?, ?, " ;; flags0
-                                        "?, ?" ;; sv, svalue_type_tag
+                                        "?, ?, ?, ?, 1, ?, " ; e0, a0, v0, tx0, added0, value_type_tag0
+                                        "?, ?, ?, ?, "       ; flags0
+                                        "?, ?"               ; sv, svalue_type_tag
                                         ")")
                                    e a v tx tag
-                                   (ds/indexing? schema a) ;; index_avet
-                                   (ds/ref? schema a) ;; index_vaet
-                                   fulltext? ;; index_fulltext
-                                   (ds/unique? schema a) ;; unique_value
+                                   (indexing? a)      ; index_avet
+                                   (ref? a)           ; index_vaet
+                                   fulltext?          ; index_fulltext
+                                   (unique? a)        ; unique_value
                                    v tag
                                    ]))
                        ;; :db.cardinality/one
                        (do
                          (<? (<exec [(str "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, index_avet0, index_vaet0, index_fulltext0, unique_value0, sv, svalue_type_tag) VALUES ("
-                                          "?, ?, ?, ?, ?, ?, " ;; TODO: order value and tag closer together.
-                                          "?, ?, ?, ?, " ;; flags0
-                                          "?, ?" ;; sv, svalue_type_tag
+                                          "?, ?, ?, ?, ?, ?, " ; TODO: order value and tag closer together.
+                                          "?, ?, ?, ?, "       ; flags0
+                                          "?, ?"               ; sv, svalue_type_tag
                                           ")")
                                      e a v tx 1 tag
-                                     (ds/indexing? schema a) ;; index_avet
-                                     (ds/ref? schema a) ;; index_vaet
-                                     fulltext? ;; index_fulltext
-                                     (ds/unique? schema a) ;; unique_value
+                                     (indexing? a)   ; index_avet
+                                     (ref? a)        ; index_vaet
+                                     fulltext?       ; index_fulltext
+                                     (unique? a)     ; unique_value
                                      v tag
                                      ]))
                          (<? (<exec [(str "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag) VALUES ("
                                           "?, ?, ?, ?, ?, ?, "
-                                          "?, ?" ;; sv, svalue_type_tag
+                                          "?, ?" ; sv, svalue_type_tag
                                           ")")
                                      e a v tx 0 tag
-                                     nil nil ;; Search values.
+                                     nil nil ; Search values.
                                      ])))))

                    (= op :db/retract)
                    (<? (<exec [(str "INSERT INTO tx_lookup (e0, a0, v0, tx0, added0, value_type_tag0, sv, svalue_type_tag) VALUES ("
                                     "?, ?, ?, ?, ?, ?, "
-                                    "?, ?" ;; sv, svalue_type_tag
+                                    "?, ?" ; sv, svalue_type_tag
                                     ")")
                                e a v tx 0 tag
                                v tag
@@ -335,33 +338,34 @@
         (p :insert-transaction
            (p :insert-transaction-added
               ;; Add datoms that aren't already present.
-              (<? (<exec [(str "INSERT INTO transactions (e, a, v, tx, added, value_type_tag) "
-                               "SELECT e0, a0, v0, ?, 1, value_type_tag0 "
-                               "FROM tx_lookup "
-                               "WHERE added0 IS 3 AND e IS NULL") tx]))) ;; TODO: get rid of magic value 3.
+              (<? (<exec ["INSERT INTO transactions (e, a, v, tx, added, value_type_tag)
+                          SELECT e0, a0, v0, ?, 1, value_type_tag0
+                          FROM tx_lookup
+                          WHERE added0 IS 3 AND e IS NULL" tx]))) ;; TODO: get rid of magic value 3.

            (p :insert-transaction-retracted
               ;; Retract datoms carefully, either when they're matched exactly or when the existing value doesn't match the new value.
-              (<? (<exec [(str "INSERT INTO transactions (e, a, v, tx, added, value_type_tag) "
-                               "SELECT e, a, v, ?, 0, value_type_tag "
-                               "FROM tx_lookup "
-                               "WHERE added0 IS 2 AND ((sv IS NOT NULL) OR (sv IS NULL AND v0 IS NOT v)) AND v IS NOT NULL") tx])))) ;; TODO: get rid of magic value 2.
+              (<? (<exec ["INSERT INTO transactions (e, a, v, tx, added, value_type_tag)
+                          SELECT e, a, v, ?, 0, value_type_tag
+                          FROM tx_lookup
+                          WHERE added0 IS 2 AND ((sv IS NOT NULL) OR (sv IS NULL AND v0 IS NOT v)) AND v IS NOT NULL" tx])))) ;; TODO: get rid of magic value 2.

         (try
           (p :update-datoms-materialized-view
              (p :insert-datoms-added
                 ;; Add datoms that aren't already present.
-                (<? (<exec [(str "INSERT INTO datoms (e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value) "
-                                 "SELECT e0, a0, v0, ?, value_type_tag0, "
-                                 "index_avet0, index_vaet0, index_fulltext0, unique_value0 "
-                                 "FROM tx_lookup "
-                                 "WHERE added0 IS 3 AND e IS NULL") tx])) ;; TODO: get rid of magic value 3.)
+                (<? (<exec ["INSERT INTO datoms (e, a, v, tx, value_type_tag, index_avet, index_vaet, index_fulltext, unique_value)
+                            SELECT e0, a0, v0, ?, value_type_tag0,
+                            index_avet0, index_vaet0, index_fulltext0, unique_value0
+                            FROM tx_lookup
+                            WHERE added0 IS 3 AND e IS NULL" tx])) ;; TODO: get rid of magic value 3.)

                 ;; TODO: retract fulltext datoms correctly.
                 (p :delete-datoms-retracted
-                   (<? (<exec [(str "WITH ids AS (SELECT l.rid FROM tx_lookup AS l WHERE l.added0 IS 2 AND ((l.sv IS NOT NULL) OR (l.sv IS NULL AND l.v0 IS NOT l.v))) " ;; TODO: get rid of magic value 2.
-                                    "DELETE FROM datoms WHERE rowid IN ids"
-                                    )])))))
+                   (<? (<exec
+                         ["WITH ids AS (SELECT l.rid FROM tx_lookup AS l WHERE l.added0 IS 2 AND ((l.sv IS NOT NULL) OR (l.sv IS NULL AND l.v0 IS NOT l.v)))
+                          DELETE FROM datoms WHERE rowid IN ids" ;; TODO: get rid of magic value 2.
+                          ])))))

           (catch java.sql.SQLException e
             (throw (ex-info "Transaction violates unique constraint" {} e)))) ;; TODO: say more about the conflicting datoms.


Generoi bracket WERin pöytänumeroiden perusteella

--- mtg-pairings-server/src/clj/mtg_pairings_server/service/tournament.clj
+++ mtg-pairings-server/src/clj/mtg_pairings_server/service/tournament.clj
@@ -547,11 +547,6 @@
     (sql/insert db/seating
       (sql/values seatings))))

-(defn ^:private match-with-team [team-id matches]
-  (util/some-value #(or (= team-id (:team1 %))
-                        (= team-id (:team2 %)))
-                   matches))
-
 (defn ^:private add-ranks [team->rank round]
   (for [match round]
     (assoc match :team1_rank (team->rank (:team1 match))
@@ -569,20 +564,14 @@
                                    (sql/fields :id :num)
                                    (sql/where {:tournament tournament-id
                                                :playoff    true})
-                                   (sql/order :num :DESC)))]
-    (let [final-standings (standings tournament-id (dec (:num (last playoff-rounds))) false)
+                                   (sql/order :num :ASC)))]
+    (let [final-standings (standings tournament-id (dec (:num (first playoff-rounds))) false)
           team->rank (into {} (map (juxt :team :rank)) final-standings)
           playoff-matches (map (comp (partial add-ranks team->rank)
                                      results-of-round
                                      :id)
                                playoff-rounds)]
-      (loop [acc (take 1 playoff-matches)
-             [current-matches & rounds] (rest playoff-matches)]
-        (if current-matches
-          (let [team-ids (mapcat (juxt :team1 :team2) (first acc))
-                round (map #(match-with-team % current-matches) team-ids)]
-            (recur (cons round acc) rounds))
-          (add-empty-rounds acc))))))
+      (add-empty-rounds playoff-matches))))

 (defn ^:private count-full-pods [n]
   (- (int (Math/ceil (/ n 8))) (mod (- n) 8)))


Simplify stringify-elements json helper fn (#466)

--- waiter/src/waiter/util/utils.clj
+++ waiter/src/waiter/util/utils.clj
@@ -116,17 +116,15 @@
 (defn stringify-elements
   [k v]
   (cond
-    (vector? v) (mapv (partial stringify-elements k) v)
+    (sequential? v) (mapv (partial stringify-elements k) v)
     (keyword? v) (keyword->str v)
     (instance? DateTime v) (du/date-to-str v)
     (instance? UUID v) (str v)
     (instance? Pattern v) (str v)
-    (instance? PersistentQueue v) (vec v)
     (instance? ManyToManyChannel v) (str v)
     (instance? Process v) (str v)
     (instance? ValidationError v) (str v)
-    (= k :time) (str v)
-    (symbol? v) (str/join "/" ((juxt namespace name) v))
+    (symbol? v) (str v)
     :else v))

 (defn clj->json


removed wrong comment

removed wrong comment

--- test/unit/utils.clj
+++ test/unit/utils.clj
@@ -1,6 +1,5 @@
 (ns unit.utils)

-;;;;;;;;;;;;;;;;;;;;;;;; Macros - utils for unit tests; not extracted into separate ns for convenience
 (defn -cljs-env?
   "Take the &env from a macro, and tell whether we are expanding into cljs.
    Source: https://groups.google.com/d/msg/clojurescript/iBY5HaQda4A/w1lAQi9_AwsJ"


First stab at creating compound box2d object for the idol

--- totem-destroyer/desktop/src-common/totem_destroyer/core.clj
+++ totem-destroyer/desktop/src-common/totem_destroyer/core.clj
@@ -18,10 +18,38 @@

 (defn create-idol-body!
   [screen x y]
-  (let [body (add-body! screen (body-def :dynamic))]
+  (let [body (add-body! screen (body-def :dynamic))
+        center-x (/ x world-scale)
+        center-y (/ y world-scale)]
+    (->> (polygon-shape :set-as-box (/ 5 world-scale) (/ 20 world-scale) (vector-2 center-x center-y) 0)
+         (fixture-def :density 1 :restitution 0.4 :friction 0.5 :shape)
+         (body! body :create-fixture))
     (->> (polygon-shape :set-as-box (/ 5 world-scale) (/ 20 world-scale)
+                        (vector-2 center-x (+ center-y (/ 10 world-scale)))
+                        (/ Math/PI -4))
+         (fixture-def :density 1 :restitution 0.4 :friction 0.5 :shape)
+         (body! body :create-fixture))
+    (->> (polygon-shape :set-as-box (/ 5 world-scale) (/ 20 world-scale)
+                        (vector-2 center-x (+ center-y (/ 10 world-scale)))
+                        (/ Math/PI 4))
+         (fixture-def :density 1 :restitution 0.4 :friction 0.5 :shape)
+         (body! body :create-fixture))
+    (->> [(+ center-x (/ -15 world-scale)) (+ center-y (/ -25 world-scale))
+          (+ center-x 0) (+ center-y (/ -40 world-scale))
+          (+ center-x (/ 15 world-scale)) (+ center-y (/ -25 world-scale))
+          (+ center-x 0) (+ center-y (/ -10 world-scale))]
+         float-array
+         (polygon-shape :set)
+         (fixture-def :density 1 :restitution 0.4 :friction 0.5 :shape)
+         (body! body :create-fixture))
+    body))
+
+(defn create-floor-body!
+  [screen x y width height]
+  (let [body (add-body! screen (body-def :static))]
+    (->> (polygon-shape :set-as-box (/ (/ width 2) world-scale) (/ (/ height 2) world-scale)
                         (vector-2 (/ x world-scale) (/ y world-scale)) 0)
-         (fixture-def :density 1 :restitution 0.4 :friction 0.5 :shape)
+         (fixture-def :density 2 :restitution 0.4 :friction 0.5 :shape)
          (body! body :create-fixture))
     body))

@@ -33,7 +61,7 @@
           screen (update! screen
                           :renderer (stage)
                           :camera (orthographic :set-to-ortho true game-w game-h)
-                          :world (box-2d 0 0)
+                          :world (box-2d 0 5)
                           :debug-renderer (Box2DDebugRenderer.))
           brick-1 (doto {:body (create-brick-body! screen 275 435 30 30)})
           brick-2 (doto {:body (create-brick-body! screen 365 435 30 30)})
@@ -41,7 +69,8 @@
           brick-4 (doto {:body (create-brick-body! screen 320 375 60 30)})
           brick-5 (doto {:body (create-brick-body! screen 305 345 90 30)})
           brick-6 (doto {:body (create-brick-body! screen 320 300 120 60)})
-          idol (doto {:body (create-idol-body! screen 320 242)})]
+          idol (doto {:body (create-idol-body! screen 320 242)})
+          floor (doto {:body (create-floor-body! screen 320 470 640 20)})]
       (width! screen game-w)))

   :on-render


remove dead code

remove dead code

--- src/fat_jar/core.clj
+++ src/fat_jar/core.clj
@@ -60,15 +60,6 @@
                      BufferedReader.
                      json/parsed-seq
                      first)]
-;        (->> mappings
-;          println)
-;
-;        (->> user-data
-;          println)
-;
-;        (->> selections
-;          println)
-

        (->>  (map #(select- % user-data) mappings)
           (map #(str (:output %) "|" (:v %)))


Use a second arity for ys instead of defining shift-ys in YPlottable

--- src/fatlip/plot.cljs
+++ src/fatlip/plot.cljs
@@ -8,9 +8,9 @@

 (defprotocol YPlottable
-  (ys [graph node-sep char-sep] "Returns y-coordinates to nodes, given
-                                 minimum separations between nodes and
-                                 characters")
+  (ys [graph node-sep char-sep] [graph node-sep char-sep delta]
+    "Returns y-coordinates to nodes, given minimum separations between nodes
+     and characters")
   (min-y [graph node-sep char-sep] "Minimum y-coordinate in the graph")
   (max-y [graph node-sep char-sep] "Maximum y-coordinate in the graph")
   (mid-y [graph node-sep char-sep] "Midpoint of y-coordinates in the graph")
@@ -106,6 +106,12 @@
   (ys [this node-sep char-sep]
     (memo-ys this node-sep char-sep))

+  (ys [this node-sep char-sep delta]
+    (->> (ys this node-sep char-sep)
+         (map (fn [[node y]]
+                [node (+ y delta)]))
+         (into {})))
+
   (min-y [this node-sep char-sep]
     (apply min (map #(get (ys this node-sep char-sep) (ffirst %)) classes)))

@@ -117,13 +123,7 @@
          (apply max)))

   (width [this node-sep char-sep]
-    (- (max-y this node-sep char-sep) (min-y this node-sep char-sep)))
-
-  (shift-ys [this node-sep char-sep delta]
-    (->> (ys this node-sep char-sep)
-         (map (fn [[node y]]
-                [node (+ y delta)]))
-         (into {}))))
+    (- (max-y this node-sep char-sep) (min-y this node-sep char-sep))))

 (defn square [x]
@@ -411,7 +411,7 @@
          (map #(let [delta (if (:aligned-down (meta %))
                              (- narrow-max-y (max-y % node-sep char-sep))
                              (- narrow-min-y (min-y % node-sep char-sep)))]
-                 (shift-ys % node-sep char-sep delta)))
+                 (ys % node-sep char-sep delta)))
          (apply merge-with #(if (vector? %1) (conj %1 %2) [%1 %2]))
          (map (fn [[node ys]]
                 (let [sort-ys (sort ys)]


test suite

test suite

--- src/flatgui/test.clj
+++ src/flatgui/test.clj
@@ -13,10 +13,30 @@
             [flatgui.base :as fg]
             [clojure.test :as test])
   (:import (flatgui.core.engine ClojureContainerParser IResultCollector Container)
-           (java.awt.event MouseEvent)
+           (java.awt.event MouseEvent KeyEvent)
            (flatgui.core.engine.ui FGMouseEventParser FGTestAppContainer FGTestMouseEventParser)))

 (def dummy-source (java.awt.Container.))
+
+(def wait-attempts 10)
+
+(def wait-interval-millis 1000)
+
+(defn enable-traces-for-failed-tests []
+  (defmethod clojure.test/report :fail [m]
+    (clojure.test/with-test-out
+      (clojure.test/inc-report-counter :fail)
+      (println "\nFAIL in" (clojure.test/testing-vars-str m))
+      (when (seq clojure.test/*testing-contexts*) (println (clojure.test/testing-contexts-str)))
+      (when-let [message (:message m)] (println message))
+      (println "expected:" (pr-str (:expected m)))
+      (println "  actual:" (pr-str (:actual m)))
+      (let [trace (.getStackTrace (Thread/currentThread))]
+        (loop [i 0]
+          (if (< i (alength trace))
+            (do
+              (println (.toString (aget trace i)))
+              (recur (inc i)))))))))

 (defn evolve
   ([container property reason target]
@@ -36,6 +56,38 @@
          _ (.evolve container-engine target reason)]
      @results))
   ([container property reason] (evolve container property reason [:main])))
+
+(defn event-> [container target event] (.evolve container target event))
+
+(defn create-container-from-file [c-path c-ns c-name]
+  (FGTestAppContainer/loadSourceCreateAndInit c-path c-ns c-name))
+
+(defn create-container [c-var]
+  (FGTestAppContainer/createAndInit c-var))
+
+(defn check-property [container target property expected-value]
+  (let [result (test/is (= expected-value (.getProperty container target property)))]
+    (if (map? result) result)))
+
+(defn get-property [container target property] (.getProperty container target property))
+
+(defn wait-for-property-pred [container target property pred]
+  (let [actual-value (loop [a 0
+                            v (.getProperty container target property)]
+                       (if (and (not (pred v)) (< a wait-attempts))
+                         (do
+                           (fg/log-debug (str "Waiting " wait-interval-millis " mills, attempt " (inc a) " of " wait-attempts))
+                           (Thread/sleep wait-interval-millis)
+                           (recur
+                             (inc a)
+                             (.getProperty container target property)))
+                         v))]
+    (let [result (test/is (pred actual-value))]
+      (if (map? result) result))))
+
+;;
+;; Mouse
+;;

 (defn mouse-event
   ([id modifiers click-count button]
@@ -67,100 +119,35 @@
   ([container target] (.evolve container target left-click-events))
   ([container x y] (.evolve container (create-left-click-events x y))))

-(defn check-property [container target property expected-value]
-  (test/is (= expected-value (.getProperty container target property))))
+;;
+;; Keyboard
+;;

-(defn create-container-from-file [c-path c-ns c-name]
-  (FGTestAppContainer/loadSourceCreateAndInit c-path c-ns c-name))
+(defn key-event [id key-code char-code]
+  (KeyEvent. dummy-source id 0 0 (if (= id KeyEvent/KEY_TYPED) KeyEvent/VK_UNDEFINED key-code) char-code))

-(defn create-container [c-var]
-  (FGTestAppContainer/createAndInit c-var))
+(defn create-key-type-events [key-code char-code]
+  [(key-event KeyEvent/KEY_PRESSED key-code char-code)
+   (key-event KeyEvent/KEY_TYPED key-code char-code)
+   (key-event KeyEvent/KEY_RELEASED key-code char-code)])

-; TODO #44
-;(def dummy-source (Container.))
-;
-;(defn resolve-feed-fn [container]
-;  (if-let [fg-contanier (:_fg-container container)]
-;    (fn [_container target reason]
-;      (do
-;        (.feedTargetedEvent fg-contanier target (FGEvolveInputData. reason false))
-;        container))
-;    flatgui.widgets._old_componentbase/evolve-container))
-;
-;(defn access-container [fg-container-accessor] {:_fg-container fg-container-accessor})
-;
-;(defn get-container [fg-container-accessor] (.getContainer (.getFGModule fg-container-accessor)))
-;
-;;;;
-;;;; Helpers for hi-level simulators
-;;;;
-;
-;(defn create-mouse-event [container id modifiers click-count button target]
-;  (let [abs-pos-mx (get-in container (conj (fgc/get-access-key target) :abs-position-matrix))
-;        x (* (+ (m/mx-x abs-pos-mx) (awt/px)) (awt/unitsizepx))
-;        y (* (+ (m/mx-y abs-pos-mx) (awt/px)) (awt/unitsizepx))]
-;    (MouseEvent. dummy-source id 0 modifiers x y x y click-count false button)))
-;
-;(defn move-mouse-to [container target]
-;  ((resolve-feed-fn container)
-;    container
-;    target
-;    (create-mouse-event container MouseEvent/MOUSE_MOVED 0 0 0 target)))
-;
-;(defn simulate-mouse-left [container id target]
-;  ((resolve-feed-fn container)
-;    container
-;    target
-;    (create-mouse-event container id MouseEvent/BUTTON1_DOWN_MASK 1 MouseEvent/BUTTON1 target)))
-;
-;;;;
-;;;; Hi-level event simulators
-;;;;
-;
-;(defn simulate-mouse-click [container target]
-;  (-> (move-mouse-to container target)
-;      (simulate-mouse-left MouseEvent/MOUSE_PRESSED target)
-;      (simulate-mouse-left MouseEvent/MOUSE_RELEASED target)
-;      (simulate-mouse-left MouseEvent/MOUSE_CLICKED target)))
-;
-;(defn simulate-key-event [container id key-code char-code target]
-;  ((resolve-feed-fn container)
-;    container
-;    target
-;    (KeyEvent. dummy-source id 0 0 (if (= id KeyEvent/KEY_TYPED) KeyEvent/VK_UNDEFINED key-code) char-code)))
-;
-;(defn simulate-key-type [container key-code char-code target]
-;  (-> (simulate-key-event container KeyEvent/KEY_PRESSED key-code char-code target)
-;      (simulate-key-event KeyEvent/KEY_TYPED key-code char-code target)
-;      (simulate-key-event KeyEvent/KEY_RELEASED key-code char-code target)))
-;
-;(defn simulate-string-type [container str target]
-;  (let [len (.length str)]
-;    (loop [c container
-;           i 0]
-;      (if (< i len)
-;        (recur
-;          (simulate-key-type
-;            c
-;            (int (.charAt (clojure.string/upper-case (String/valueOf (.charAt str i))) 0))
-;            (.charAt str i)
-;            target)
-;          (inc i))
-;        c))))
-;
-;;;;
-;;;; Utilities to find components
-;;;;
-;
-;;;; Table
-;
-;(defn table-cell [container table-path pred]
-;  (let [cells-path (conj (fgc/get-access-key (conj table-path :content-pane)) :children)
-;        children (get-in container cells-path)
-;        matching (filter (fn [[_id c]] (pred c)) children)]
-;    (if-not (empty? matching)
-;      (vec (concat table-path [:content-pane (first (first matching))]))
-;      (throw (IllegalArgumentException. (str "No cell matching predicate " pred))))))
-;
-;(defn click-cell-with-text [container table-path text]
-;  (simulate-mouse-click container (table-cell container table-path (fn [cell] (= text (:text cell))))))
+(defn create-string-type-events [str]
+  (let [len (.length str)]
+    (loop [i 0
+           events nil]
+      (if (< i len)
+        (recur
+          (inc i)
+          (concat events (create-key-type-events (int (.charAt str i)) (.charAt str i))))
+        events))))
+
+(defn type-string
+  ([container target str] (.evolve container target (create-string-type-events str)))
+  ([container str] (.evolve container (create-string-type-events str))))
+
+
+;;
+;; Utilities for working with components
+;;
+
+


reorderd repos

reorderd repos

--- main/src/dda/pallet/dda_managed_ide/domain/git.clj
+++ main/src/dda/pallet/dda_managed_ide/domain/git.clj
@@ -29,13 +29,13 @@
 (def GitCredentials git-domain/GitCredentials)
 (def GitCredentialsResolved git-domain/GitCredentialsResolved)

-(def dda-pallet-repo-names
-  ["dda-config-commons", "dda-pallet-commons" ,"dda-pallet","dda-user-crate", "dda-backup-crate" ,"dda-git-crate",
-   "dda-hardening-crate", "httpd-crate", "dda-httpd-crate", "dda-liferay-crate", "dda-managed-vm", "dda-managed-ide",
-   "dda-mariadb-crate", "dda-serverspec-crate", "dda-tomcat-crate", "dda-k8s-crate", "dda-smeagol-crate"])

 (def dda-repo-names
-  ["smeagol", "data-test", "dda-devops-build"])
+  ["dda-config-commons", "dda-provision" ,"dda-devops-build", "data-test"])
+
+(def dda-pallet-repo-names
+  ["dda-pallet-commons" ,"dda-pallet","dda-user-crate", "dda-backup-crate" ,"dda-git-crate",
+   "dda-managed-vm", "dda-managed-ide", "dda-serverspec-crate", "dda-k8s-crate", "dda-smeagol-crate"])

 (s/defn ide-git-config
  [name :- s/Str


exit with exit code 1 if there are outdated dependencies (closes #55).

--- src/leiningen/ancient/check.clj
+++ src/leiningen/ancient/check.clj
@@ -6,7 +6,8 @@
              [collect :refer :all]
              [console :as console]
              [utils :as utils]
-             [verbose :refer :all]]))
+             [verbose :refer :all]]
+            [leiningen.core.main :as main]))

 ;; ## Logic

@@ -17,7 +18,13 @@
       (if (seq outdated)
         (doseq [artifact outdated]
           (console/print-outdated-message artifact))
-        (verbosef "all artifacts are up-to-date.")))))
+        (verbosef "all artifacts are up-to-date."))
+      {:outdated? (seq outdated)})))
+
+(defn- exit-with-status
+  [results]
+  (when (some (comp :outdated? second) results)
+    (main/exit 1)))

 ;; ## Tasks

@@ -25,11 +32,13 @@
   {:docstring "Check projects for outdated artifacts. (default)"
    :exclude [:interactive :print :no-tests]}
   [opts]
-  (utils/call-on-project-files check-file! opts))
+  (exit-with-status
+    (utils/call-on-project-files check-file! opts)))

 (utils/deftask profiles
   {:docstring "Check profiles for outdated artifacts."
    :exclude [:no-profiles :interactive :print :no-tests :recursive]
    :fixed {:plugins? true}}
   [opts]
-  (utils/call-on-profiles-files check-file! opts))
+  (exit-with-status
+    (utils/call-on-profiles-files check-file! opts)))


Fix: broken ring-malli-swagger example

Fix: broken ring-malli-swagger example

Change example to use recently changed `m/accept` -> `m/walk` and
`m/schema-visitor` -> `m/schema-walker`

--- examples/ring-malli-swagger/src/example/server.clj
+++ examples/ring-malli-swagger/src/example/server.clj
@@ -22,9 +22,9 @@
   [:map {:registry {::age [:and int? [:> 18]]}}
    [:age ::age]])

-(malli.core/accept
+(malli.core/walk
   (malli.core/schema sample-request)
-  (malli.core/schema-visitor identity))
+  (malli.core/schema-walker identity))

 (defn handle [request]
   (prn (:parameters request))


add new store api

add new store api

--- src/ceres_collector/migrator.clj
+++ src/ceres_collector/migrator.clj
@@ -31,45 +31,63 @@

 (defn store-hashtag [text db]
-  (mc/insert-and-return
-   db
-   "hashtags-2"
-   {:text text
-    :ts (t/now)}))
+  (-> (mc/insert-and-return
+       db
+       "hashtags"
+       {:text text
+        :ts (t/now)})
+      from-db-object
+      :_id))

 (defn store-author [{:keys [screen_name id created_at]} db]
   (let [date (f/parse custom-formatter created_at)]
-    (mc/insert-and-return
-     db
-     "authors"
-     {:id id
-      :name screen_name
-      :created_at date
-      :ts (t/now)})))
+    (-> (mc/insert-and-return
+         db
+         "authors"
+         {:id id
+          :name screen_name
+          :created_at date
+          :ts (t/now)})
+        from-db-object
+        :_id)))

 (defn store-url [url db]
-  (mc/insert-and-return
-   db
-   "urls-2"
-   {:path url
-    :ts (t/now)}))
+  (-> (mc/insert-and-return
+       db
+       "urls"
+       {:path url
+        :ts (t/now)})
+      from-db-object
+      :_id))

-(defn store-message
-  [text source tid db]
-  (mc/insert-and-return
-   db
-   "messages"
-   {:text text
-    :source source
-    :ts (t/now) :tweet tid}))
+(defn store-message [text source tid db]
+  (-> (mc/insert-and-return
+       db
+       "messages"
+       {:text text
+        :source source
+        :ts (t/now)
+        :tweet tid})
+      from-db-object
+      :_id))

-
+(defn store-html
+  "Fetch html document and store raw binary in database"
+  [{:keys [url content-type] :as expanded-url} url-id db]
+  (let [raw-html (if (= url :not-available)
+                   nil
+                   (slurp url))]
+    (mc/insert-and-return
+     db
+     "htmls"
+     {:raw raw-html
+      :ts (t/now)
+      :url url-id})))

 (comment
-
   (set-db "athena")

   ;; migration db
@@ -87,12 +105,21 @@
                              :_id)]
                  (map #(store-reference mid % "tag" db2) hashtags)
                  (store-reference mid user "pub" db2)
-                 (when url
-                   (store-reference mid url "url" db2)))
-                 ))))
+                 (when url (store-reference mid url ))))))

-  (->> (mc/find-maps @db "publications")
-       (take 100)
-       (map :type)
-       (into #{}))
+  (->> (mc/find-maps @db "reactions")
+       (pmap
+        (fn [{:keys [source publication]}]
+          (let [{stid :tweet} (mc/find-map-by-id @db "publications" source)
+                {tid :tweet t :type} (mc/find-map-by-id @db "publications" publication)
+                smid (mc/find-one-as-map db2 "messages" {:tweet stid})
+                mid (mc/find-one-as-map db2 "messages" {:tweet tid})]
+            (store-reference mid smid t db2)))))
+
+
+
+
+
+
+
   )


fix Order of Sol to work w/ 0 credits at start of turn

--- src/clj/game/cards-resources.clj
+++ src/clj/game/cards-resources.clj
@@ -319,6 +319,9 @@
                                          (zero? (get-in new [:runner :credit])))
                                 (resolve-ability ref side {:msg "gain 1 [Credits]" :once :per-turn
                                                            :effect (effect (gain :credit 1))} card nil)))))
+    :events {:runner-turn-begins {:req (req (= (:credit runner) 0)) :msg "gain 1 [Credits]"
+                                  :effect (req (gain state :runner :credit 1)
+                                               (swap! state assoc-in [:per-turn (:cid card)] true))}}
     :leave-play (req (remove-watch state :order-of-sol))}

    "Paige Piper"


Creating a new production should be a post

according to https://restfulapi.net/rest-put-vs-post/

--- src/clj/mdr2/routes/services.clj
+++ src/clj/mdr2/routes/services.clj
@@ -94,16 +94,16 @@
                          (->> (db/get-productions params)
                               (map prod/remove-null-values)
                               ok)))}
-      :put {:summary "Update or create a production"
-            ;;:middleware [wrap-restricted wrap-authorized]
-            ;;:swagger {:security [{:apiAuth []}]}
-            :parameters {:body prod.spec/production}
-            :handler (fn [{{p :body} :parameters}]
-                       (let [p (prod/create! p)]
-                         (if-not (nom/anomaly? p)
-                           (no-content)
-                           (bad-request {:status-text
-                                         (ex-message (:exception (nom/payload p)))}))))}}]
+      :post {:summary "Create a production"
+             ;;:middleware [wrap-restricted wrap-authorized]
+             ;;:swagger {:security [{:apiAuth []}]}
+             :parameters {:body prod.spec/production}
+             :handler (fn [{{p :body} :parameters}]
+                        (let [p (prod/create! p)]
+                          (if-not (nom/anomaly? p)
+                            (no-content)
+                            (bad-request {:status-text
+                                          (ex-message (:exception (nom/payload p)))}))))}}]

     ["/:id"
      {:get {:summary "Get a production by ID"


Add unformatted event creation form

Add unformatted event creation form

--- src/cljs/event_planner/core.cljs
+++ src/cljs/event_planner/core.cljs
@@ -24,9 +24,10 @@
           :error-handler #(dispatch [:event-response %1])
           :format :json
           :params {:recurring true
-                 :days-of-week ["Monday"]
-                 :start-time 9
-                 :end-time 17}})
+                   :title "Some Time in the Future"
+                   :days-of-week ["Monday"]
+                   :start-time 9
+                   :end-time 17}})
    (update-in db [:clicks] inc)))

 (register-handler
@@ -49,6 +50,46 @@
    [db _]
    (reaction (:data @db))))

+(def days ["Sunday"
+           "Monday"
+           "Tuesday"
+           "Wednesday"
+           "Thursday"
+           "Friday"
+           "Saturday"])
+
+(defn checkbox
+  [val name]
+  [:input {:type "checkbox" :value val} name])
+
+(defn drop-down
+  [vals]
+  [:select
+   (for [[key name] vals]
+     [:option {:value key} name])])
+
+(defn military->12h [hour]
+  (if (> hour 12)
+    (str (- hour 12) " pm")
+    (str hour " am")))
+
+;; FIXME time is hard
+(defn time-drop-down
+  []
+  (let [hours (map inc (range 24))]
+    [drop-down (map vector
+                    hours
+                    (map military->12h hours))]))
+
+(defn recurring-event-form
+  []
+  [:form
+   "Title:" [:input {:type "text"}]
+   "Days of Week:" (for [day days] [checkbox "help" day])
+   "Start Time:" [time-drop-down]
+   "End Time:" [time-drop-down]])
+
+
 (defn simple-component []
   (let [clicks (subscribe [:clicks])
         data (subscribe [:data])]
@@ -60,7 +101,10 @@
       "I have " [:em "bold"]
       [:span {:style {:color "red"}} " and red "] "text."]
      [:button {:type "button"
-               :on-click #(dispatch [:clicked])} "Click Me!"]]))
+               :on-click #(dispatch [:clicked])} "Click Me!"]
+     [recurring-event-form]]))
+
+

 (defn render-simple []
   (r/render-component [simple-component]


Dsiable add button if word is already in db

--- src/cljs/hyphen_keeper/core.cljs
+++ src/cljs/hyphen_keeper/core.cljs
@@ -191,6 +191,7 @@
                   (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling}))
      :disabled (when (or (string/blank? @word)
                          (not (hyphenation-valid? @hyphenation @word))
+                         (contains? @hyphenations @word)
                          (= @hyphenation @suggested-hyphenation))
                  "disabled")}
     "Add"]])


sections only need to be declared once

sections only need to be declared once

--- src/cljs/just_married/views.cljs
+++ src/cljs/just_married/views.cljs
@@ -6,12 +6,20 @@
    [just-married.countdown :as countdown]
    [just-married.settings :as settings]))

-(def SECTIONS-SIMPLE
-  [:story
-   :find-us
-   :rvsp
-   :accomodation
-   :contacts])
+(declare find-us)
+(declare rvsp)
+(declare accommodation)
+(declare contacts)
+(declare story)
+(declare gifts)
+
+(def SECTIONS
+  {:story story
+   :find-us find-us
+   :rvsp rvsp
+   :gifts gifts
+   :accomodation accommodation
+   :contacts contacts})

 (defn get-browser-language
   "Return the language set in the browser, assuming that
@@ -38,7 +46,7 @@

         (into
          [:ul {:class "nav navbar-nav"}]
-         (for [sec SECTIONS-SIMPLE]
+         (for [sec (keys SECTIONS)]
            [:li {:key (name sec)}
             [:a {:href (str "#" (name sec))} (tr sec)]]))

@@ -118,9 +126,5 @@
   []
   (fn []
     [:g
-     [navbar]
-     ;; lang selection could be moved into the header potentially?
-     [story]
-     [find-us]
-     [gifts]
-     #_[rvsp]]))
+     (into [navbar]
+           (vals SECTIONS))]))


Handle year data for anthers defn

Handle year data for anthers defn

--- src/cljs/whatishistory/core.cljs
+++ src/cljs/whatishistory/core.cljs
@@ -126,11 +126,13 @@
                               nil "Anonymous"
                               ""  "Anonymous"
                               (get @app-atom :author))
-                    :year (if (= frm-mode "default")
-                            (.getFullYear (js/Date.))
-                            (get @app-atom :year))
+                    :defnDate (if (= frm-mode "default")
+                                (js/Date.)
+                                (js/Date. (get @app-atom :year)))
                     :definitionSubject "history"
                     :mehuman "1"})
+    (if (= frm-mode "anothers")
+      (def defn_data (assoc defn-data :year (get @app-atom :year))))
     (if (and (email-confirmed app-atom true) (data-valid defn-data frm-mode))
       (do
          (def new-defn-promise (.save new-defn (clj->js defn-data)))


Report error when save defn fails

Report error when save defn fails

--- src/cljs/whatishistory/core.cljs
+++ src/cljs/whatishistory/core.cljs
@@ -103,7 +103,9 @@
          (.then new-defn-promise (fn [defn]
                               (js/console.log "definition saved: " defn)
                               (swap! app-atom assoc :defn-obj defn)))
-         (.fail new-defn-promise #(js/alert "Something went wrong :/. Please try again."))))))
+         (.fail new-defn-promise (fn [err]
+                                   (js/console.error err.message)
+                                   (js/alert "Something went wrong :/. Please try again.")))))))

 (defn save-xtra-info [app-atom]


fix format

fix format

--- src/cljs_api_gen/clojure_api.clj
+++ src/cljs_api_gen/clojure_api.clj
@@ -88,8 +88,8 @@
                           (map :name)
                           set)
           symbols (->> (:vars data)
-                        (map #(str (:namespace %) "/" (:name %)))
-                        set)]
+                       (map #(str (:namespace %) "/" (:name %)))
+                       set)]
       (reset! spec-alpha-namespaces namespaces)
       (doseq [v versions-with-spec-alpha]
         (swap! api-symbols update v into symbols)


remove unused code

remove unused code

--- src/clojure_fabric/chaincode.clj
+++ src/clojure_fabric/chaincode.clj
@@ -186,34 +186,13 @@
       (crypto-suite/hash :algorithm algorithm)
       (Hex/toHexString)))

-#_
-(defn make-chaincode-proposal
-  [chaincode-key channel-name user {:keys [args channel-header-type header-version]
-                                    :or {header-version 1}}]
-  (let [{:keys [chaincode-id header-extension proposal-payload]}
-        (get-system-chaincode-request-parts chaincode-key :args args)
-        identity (proto/make-serialized-identity :mspid (:msp-id user) :id-bytes (:certificate user))
-        nonce (make-nonce)]
-    (proto/make-proposal :header
-                         (proto/make-header :channel-header
-                                            (proto/make-channel-header :type channel-header-type
-                                                                       :version header-version
-                                                                       :channel-id channel-name
-                                                                       :tx-id (identity-nonce->tx-id identity nonce (:crypto-suite user))
-                                                                       :epoch (get-epoch channel-name)
-                                                                       :extension
-                                                                       (proto/make-chaincode-header-extension :chaincode-id chaincode-id))
-                                            :signature-header (proto/make-signature-header :creator identity :nonce nonce))
-
-                         :payload proposal-payload)))
-
 (defn make-header
-  [chaincode-key channel-name user {:keys [header-type channel-header-type header-version
-                                           extension]
-                                    :or {header-version 1}}]
+  [channel-name user {:keys [channel-header-type header-version
+                             extension]
+                      :or {header-version 1}}]
   (let [identity (proto/make-serialized-identity :mspid (:msp-id user) :id-bytes (:certificate user))
         nonce (make-nonce)]
-   (proto/make-header header-type
+   (proto/make-header :channel-header
                       (proto/make-channel-header :type channel-header-type
                                                  :version header-version
                                                  :channel-id channel-name
@@ -222,14 +201,19 @@
                                                  :extension extension)
                       :signature-header (proto/make-signature-header :creator identity :nonce nonce))))

+(defn make-config-update-envelope
+  [channel-name user orderer config signatures]
+  (let [header (make-header channel-name user {:channel-header-type :config-update})
+        payload ]))
+
+
 (defn make-chaincode-proposal
   [chaincode-key channel-name user {:keys [args] :as opts}]
   (let [{:keys [chaincode-id header-extension proposal-payload]}
         (get-system-chaincode-request-parts chaincode-key :args args)]
     (proto/make-proposal :header
-                         (make-header chaincode-key channel-name user
+                         (make-header channel-name user
                                       (assoc opts
-                                             :header-type :channel-header
                                              :extension (proto/make-chaincode-header-extension :chaincode-id chaincode-id)))
                          :payload proposal-payload)))


read the files

read the files

--- src/k_means/core.clj
+++ src/k_means/core.clj
@@ -3,6 +3,7 @@
   (:require [taoensso.timbre.profiling :as profiling :refer (p profile)])
   (:require [k-means.cluster :as cluster]
             [k-means.vector  :as vector]
+            [clojure.edn     :as edn]
             [clojure.string  :as string]))

@@ -71,10 +72,10 @@
       (let [c (profile :info :Arithmetic (k-means-p (vector/make-list-rand (Integer/parseInt (nth args 2))) (Integer/parseInt (second args)) 100)) => "Done"]
         (spit "k-means.txt" (vec c)))
     (= (first args) "seq")
-      (let [c (profile :info :Arithmetic (k-means (read-string (nth args 2)) (Integer/parseInt (second args)) 100)) => "Done"]
+      (let [c (profile :info :Arithmetic (k-means (edn/read-string (slurp (nth args 2))) (Integer/parseInt (second args)) 100)) => "Done"]
         (spit "k-means.txt" (vec c)))
     (= (first args) "par")
-      (let [c (profile :info :Arithmetic (k-means-p (read-string (nth args 2)) (Integer/parseInt (second args)) 100)) => "Done"]
+      (let [c (profile :info :Arithmetic (k-means-p (edn/read-string (slurp (nth args 2))) (Integer/parseInt (second args)) 100)) => "Done"]
         (spit "k-means.txt" (vec c)))
     :else
       (println usage))


Add missing type hint to clojure example

Following GH623

--- src/examples/clojure/rx/lang/clojure/examples/rx_examples.clj
+++ src/examples/clojure/rx/lang/clojure/examples/rx_examples.clj
@@ -27,7 +27,9 @@

 (defn hello
   [& args]
-  (-> (Observable/from args)
+  (->
+    ; type hint required due to `Observable/from` overloading
+    (Observable/from ^java.lang.Iterable args)
     (.subscribe (rx/action [v] (println (str "Hello " v "!"))))))

 ; To see output


Add short-circuit for known stubs

Add short-circuit for known stubs

--- src/angelic/search/implicit/fah_astar_eval2.clj
+++ src/angelic/search/implicit/fah_astar_eval2.clj
@@ -19,7 +19,13 @@
 ;; Here we properly deal with weirdness of stubs/inner-sps decreaseing as they add
 ;; children, by makig sure to do the updates synchronously.

-;; TODO: don't bother with names?  Or make names primary...
+;; TODO: find cleaner overall architecture.  Right now, names
+;;   don't really do anything, and there's too much worrying about types, etc.
+;;   Solution may be to have Generator (takes place of name) --> Stub --> SP.
+;;   Generator knows how to take input set and produce stub., etc.
+;;   For now, seems like too much complexity for too little gain.
+
+;; TODO: tail caching?
 ;; TODO: cache refine-inputs and/or other SPs.
 ;; TODO: encapsulate stub/sp behaviors somehow.

@@ -115,7 +121,18 @@
   (summaries/summary-changed-local! stub)
   (add-output! stub sp))

-(comment (defn get-stub-output [s] (util/safe-singleton (get-outputs s))))
+
+(defn get-stub-output  [s] (first (get-outputs s)))
+(defn get-stub-output! [s] (util/safe-singleton (get-outputs s)))
+
+;; Just give output directly if subproblem is ready
+(defn connect-and-watch-stub! [p c f]
+  (assert (instance? angelic.search.implicit.fah_astar_eval2.Stub c))
+  (if-let [sp (get-stub-output c)]
+    (f sp)
+    (do (summaries/connect! p c false)
+        (add-watcher! c f))))
+

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -229,7 +246,7 @@
   (assert (not (= (first (stub-name inner-stub)) :SA)))
   (let [in-set (input-set inner-stub)
         ret (traits/reify-traits [summaries/or-summarizable (simple-stub [:OS (stub-name inner-stub) in-set] in-set)])]
-    (connect-and-watch! ret inner-stub #(set-stub-output! ret (make-output-collecting-subproblem ret %)))
+    (connect-and-watch-stub! ret inner-stub #(set-stub-output! ret (make-output-collecting-subproblem ret %)))
     ret))

@@ -250,7 +267,7 @@
               (summaries/summary-changed! ret))
           (do (if (#{:SA :OS} (first (stub-name (stub o))))
                 (add-sp-child! ret o)
-                (connect-and-watch! ret (make-output-collecting-stub (stub o)) #(add-sp-child! ret %)))))))
+                (connect-and-watch-stub! ret (make-output-collecting-stub (stub o)) #(add-sp-child! ret %)))))))
     ret))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;     State Abstraction     ;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -259,14 +276,14 @@
 (declare make-state-abstracted-subproblem)
 (defn make-eager-state-abstracted-stub [inner-stub in-set]
   (let [ret (traits/reify-traits [summaries/or-summarizable (simple-stub [:SA (stub-name inner-stub) in-set] in-set)])]
-    (connect-and-watch! ret inner-stub #(set-stub-output! ret (make-state-abstracted-subproblem ret %)))
+    (connect-and-watch-stub! ret inner-stub #(set-stub-output! ret (make-state-abstracted-subproblem ret %)))
     ret))

 ;; DOTO: reduce overhead with deliberate?
 ;; Only wait when inner-stub has no output -- prevent double-wait.
 (defn make-deliberate-state-abstracted-stub [inner-stub in-set]
-  (if-let [out (first (get-outputs inner-stub))]
+  (if-let [out (get-stub-output inner-stub)]
     (let [done? (atom false)
           ret
           (traits/reify-traits
@@ -300,7 +317,7 @@
         ret (traits/reify-traits
              [summaries/or-summarizable (simple-subproblem stb out ts (terminal? inner-sp) ri-fn)])]
     (connect-and-watch! ret inner-sp
-      (fn [o] (connect-and-watch! ret (make-state-abstracted-stub (stub o) in) #(add-sp-child! ret %))
+      (fn [o] (connect-and-watch-stub! ret (make-state-abstracted-stub (stub o) in) #(add-sp-child! ret %))
         (when (= :deliberate *state-abstraction*) (summaries/summary-changed! ret))))
     ret))

@@ -325,14 +342,14 @@
           (let [ret (make-simple-subproblem stub subsuming-sp out-set false summaries/or-summary ri-fn reward)]
             (connect-and-watch! ret subsuming-sp
               (fn [sub-out]
-                (connect-and-watch! ret (refine-input sub-out inp-set) #(add-sp-child! ret %))
+                (connect-and-watch-stub! ret (refine-input sub-out inp-set) #(add-sp-child! ret %))
                 (summaries/summary-changed! ret))) ;; TODO: needed?
             ret)

           :else
           (let [ret (make-simple-subproblem stub subsuming-sp out-set false summaries/or-summary ri-fn reward)]
             (doseq [child (map #(make-fs-seq-stub inp-set %) (fs/child-seqs function-set inp-set))]
-              (connect-and-watch! ret child #(add-sp-child! ret %)))
+              (connect-and-watch-stub! ret child #(add-sp-child! ret %)))
             ret))))

 ;; Note: this is double-stage to lazily generate children.  Could be simpler single-stage.
@@ -410,7 +427,7 @@
                        (add-watcher! left-sp (fn [o] (def *sum* [s left-sp o])
                                                (throw (RuntimeException. "Solved and children."))))
                        ;; TODO: do more efficiently?
-                       (connect-and-watch! s (make-pair-stub2 subsuming-sp left-sp (stub right-sp))
+                       (connect-and-watch-stub! s (make-pair-stub2 subsuming-sp left-sp (stub right-sp))
                                            (fn [os] (connect-and-watch! s os #(add-sp-child! s %))))
  ;                       (add-sp-child! s (make-pair-subproblem subsuming-sp pair-stub left-sp right-sp))
                        )
@@ -424,7 +441,7 @@
     (add-watcher! watch
       (fn [o]
         (summaries/summary-changed-local! ss)
-        (connect-and-watch! ret (stub-f o) #(add-sp-child! ret %))
+        (connect-and-watch-stub! ret (stub-f o) #(add-sp-child! ret %))
         (summaries/summary-changed! ret))) ;; TODO: efficiency?

     ret))
@@ -437,7 +454,7 @@
                            (input-set (stub left-sp)))])]
     (connect-subsuming! ret subsuming-sp)
     (summaries/connect! ret (tree-summarizer left-sp) false)
-    (connect-and-watch! ret right-stub
+    (connect-and-watch-stub! ret right-stub
       #(set-stub-output! ret (make-pair-subproblem subsuming-sp ret left-sp %)))
     ret))

@@ -446,9 +463,9 @@
                                   (simple-stub [:Pair1 (stub-name left-stub) right-name]
                                                (input-set left-stub))])]
     (connect-subsuming! ret subsuming-sp)
-    (connect-and-watch! ret left-stub
+    (connect-and-watch-stub! ret left-stub
       (fn [lo]
-        (connect-and-watch! ret
+        (connect-and-watch-stub! ret
           (make-pair-stub2 subsuming-sp lo (right-stub-fn (output-set lo)))
           #(set-stub-output! ret %))
         (summaries/summary-changed! ret))) ;; TODO: wasteful?
@@ -476,7 +493,7 @@
 (defn- get-root-subproblem [inp-set fs]
   (let [root-stub (make-atomic-stub nil nil inp-set fs)]
     (dotimes [_ 2] (evaluate! root-stub))
-    (util/safe-singleton (get-outputs root-stub))))
+    (get-stub-output! root-stub)))

 (defn implicit-fah-a*-eval2 [henv]
   (binding [summaries/*cache-method* :eager


Simplify

Simplify

--- test/caesium/crypto/box_test.clj
+++ test/caesium/crypto/box_test.clj
@@ -45,7 +45,6 @@
         alice-sk (box-vector "alice-secret-key")]
     (is (u/array-eq ctext (b/encrypt alice-pk bob-sk nonce ptext)))
     (is (u/array-eq ptext (b/decrypt bob-pk alice-sk nonce ctext)))
-    (let [hex-pk (u/hexify alice-pk)
-          hex-sk (u/hexify bob-sk)]
-      (is (thrown? java.lang.ClassCastException
-                   (b/encrypt hex-pk hex-sk nonce ptext))))))
+    (let [pk (u/hexify alice-pk)
+          sk (u/hexify bob-sk)]
+      (is (thrown? ClassCastException (b/encrypt pk sk nonce ptext))))))


convert-method

convert-method

--- src/client.clj
+++ src/client.clj
@@ -22,13 +22,15 @@
 (defn ignore-headers [id headers])

 (defn print-headers [id headers]
-  (doall (map #(println (str id "> " % ": " (get headers %))) (keys headers))))
+  (println (bean headers))
+  (doall (map #(println (str id "< " % ": " (get headers %))) (keys headers)))
+  (if (not (contains? headers "content-type")) :abort ))

 (defn accept-ok [id status]
   (if (not (= (:code status) 200)) :abort))

 (defn print-status [id st]
-  (println (str id "> "
+  (println (str id "< "
 		(:protocol st) "/" (:major st) "." (:minor st) " "
 		(:code st) " " (:text st))))

@@ -61,6 +63,14 @@
   {:tag Request}
   (prepare-request :get url))

+(defn convert-action
+  "Converts action (:abort, nil) to Async client STATE."
+  [action]
+  {:tag com.ning.http.client.AsyncHandler$STATE}
+  (if (= action :abort)
+    com.ning.http.client.AsyncHandler$STATE/ABORT
+    com.ning.http.client.AsyncHandler$STATE/CONTINUE))
+
 (defn execute-request
   "Executes provided reqeust with given callback functions."
   ([#^Request req]
@@ -70,7 +80,9 @@
   ([#^Request req body-fn completed-fn headers-fn]
      (execute-request req body-fn completed-fn headers-fn print-status))
   ([#^Request req body-fn completed-fn headers-fn status-fn]
-     (let [id (gensym "RequestId__")]
+     (println
+      (str req " " body-fn " " completed-fn " " headers-fn " " status-fn))
+     (let [id (gensym "req-id__")]
        (.executeRequest
 	ahc req
 	(proxy [AsyncHandler] []
@@ -80,18 +92,13 @@
 			:major (.getProtocolMajorVersion resp)
 			:minor (.getProtocolMinorVersion resp)
 			:code (.getStatusCode resp)
-			:text (.getStatusText resp))
-		  action (status-fn id stat)]
-	      (if (= action :abort)
-		com.ning.http.client.AsyncHandler$STATE/ABORT
-		com.ning.http.client.AsyncHandler$STATE/CONTINUE)))
+			:text (.getStatusText resp))]
+	      convert-method (status-fn id stat)))
 	  (onHeadersReceived [#^HttpResponseHeaders response]
-            (let [action (headers-fn id (.getHeadersMap response))]
-	      (if (= action :abort)
-		com.ning.http.client.AsyncHandler$STATE/ABORT
-		com.ning.http.client.AsyncHandler$STATE/CONTINUE)))
+	    (println "onHeadersReceived")
+	    convert-method (headers-fn id (.getHeadersMap response)))
 	  (onBodyPartReceived [#^HttpResponseBodyPart response]
- 	    (do
+	    (do
 	      (println response)
 	      com.ning.http.client.AsyncHandler$STATE/ABORT))
 	  (onCompleted []
@@ -99,4 +106,5 @@
 	      (println "Completed")
 	      200))
 	  (onThrowable [#^Throwable t]
-	    (println (.getMessage t))))))))+	    (println t)
+	    (.printStackTrace t)))))))


Refactor

Refactor

--- src/advent_2017/day_10.cljc
+++ src/advent_2017/day_10.cljc
@@ -6,9 +6,9 @@

 (defn round [lengths [xs current-pos skip-size]]
   (reduce (fn [[xs current-pos skip-size] length]
-            (let [reversed (reverse (take length (drop current-pos (cycle xs))))
-                  after    (take (- 256 length) (drop (+ current-pos length) (cycle xs)))]
-              [(take 256 (drop (- 256 current-pos) (cycle (concat reversed after))))
+            (let [[to-reverse all-after] (split-at length (->> xs cycle (drop current-pos)))
+                  reversed-and-after (concat (reverse to-reverse) (take (- 256 length) all-after))]
+              [(->> reversed-and-after cycle (drop (- 256 current-pos)) (take 256))
                (mod (+ current-pos length skip-size) 256)
                (mod (inc skip-size) 256)]))
     [xs current-pos skip-size]


Fix several bugs in the clojure tabs

Fix several bugs in the clojure tabs

--- nightweb-android/src/clojure/net/nightweb/tabs.clj
+++ nightweb-android/src/clojure/net/nightweb/tabs.clj
@@ -89,7 +89,7 @@
                             android.view.ViewGroup$LayoutParams/MATCH_PARENT))
         (.setPadding content-view tab-first-padding-left 0 0 0)
         (.addView this content-view)
-        (.scrollTo this (.getScrollX this) (.getScrollY this))
+        ;(.scrollTo this (.getScrollX this) (.getScrollY this))
         (set-state! this :content-view content-view)
         (set-state! this :animation-duration animation-duration)))
     ([this context attrs] (tab-scroll-view-post-init this context))
@@ -113,8 +113,8 @@
           tab-view (net.nightweb.tabs.TabView. (get-state this :context))]
       (.setTitle tab-view "New Tab")
       (.setOnClickListener tab-view (on-click (.setSelectedTab this view)))
-      (.setActivated tab-view true)
-      (.addView content-view tab-view)))
+      (.addView content-view tab-view)
+      (.setActivated tab-view true)))
   (defn tab-scroll-view-setSelectedTab
     [this view]
     (let [content-view (get-state this :content-view)
@@ -134,8 +134,8 @@
   (defn tab-scroll-view-animateScroll
     [this new-scroll]
     (let [animator (android.animation.ObjectAnimator/ofInt
-                     this "scroll" (.getScrollX this))]
-      (.setDuration animator (get-state this :animation-duration))
+                     this "scroll" (int-array [(.getScrollX this) new-scroll]))]
+      (.setDuration animator ^int (get-state this :animation-duration))
       (.start animator)))
   )

@@ -165,7 +165,7 @@
   (defn tab-layout-onLayout
     [this changed l t r b]
     (.superOnLayout this changed l t r b)
-    (if (> (.getChildCount this) 0)
+    (if (> (.getChildCount this) 1)
       (for [i (range 1 (.getChildCount this))
             :let [first-child (.getChildAt this 0)
                   tab-overlap (get-state this :tab-overlap)
@@ -242,7 +242,7 @@
       (.reset focus-path)
       (.moveTo focus-path local-l local-b)
       (.lineTo focus-path local-l local-t)
-      (.lineTo focus-path (- local-r (get-state this :tab-slice-width)) local-t)
+      (.lineTo focus-path (- local-r tab-slice-width) local-t)
       (.lineTo focus-path local-r local-b)))
   (defn tab-view-setActivated
     [this selected]
@@ -251,7 +251,9 @@
           title (get-state this :title)
           icon-view (get-state this :icon-view)
           close (get-state this :close)]
-      (.setTextAppearance title context (if selected (get-resource :style :TabTitleSelected) (get-resource :style :TabTitleUnselected)))
+      (.setTextAppearance title context (if selected
+                                          (get-resource :style :TabTitleSelected)
+                                          (get-resource :style :TabTitleUnselected)))
       (.setVisibility icon-view (if selected android.view.View/GONE android.view.View/VISIBLE))
       (.setVisibility close (if selected android.view.View/VISIBLE android.view.View/GONE))
       (.setHorizontalFadingEdgeEnabled this (not selected))
@@ -314,7 +316,10 @@
           w (- right left pl)
           tab-add-overlap (get-state this :tab-add-overlap)
           button-width (- (.getMeasuredWidth new-tab) tab-add-overlap)
-          sw (- w button-width)]
+          tabs-width (.getMeasuredWidth tabs)
+          sw (if (< (- w tabs-width) button-width)
+               (- w button-width)
+               tabs-width)]
       (.layout tabs pl pt (+ pl sw) (- bottom top))
       (.layout new-tab (- (+ pl sw) tab-add-overlap) pt
                (- (+ pl sw button-width) tab-add-overlap) (- bottom top))))


Converted filter -> take-while

Converted filter -> take-while

--- test/tst/tupelo/datomic_bond.clj
+++ test/tst/tupelo/datomic_bond.clj
@@ -222,7 +222,7 @@
     (let [eid-start     (d/entid-at (live-db) :people 0)              ; 1st possible eid
           datoms        (d/seek-datoms (live-db) :eavt eid-start)     ; all datoms >= eid-start
           eids-all      (distinct (map #(:e %) datoms))               ; pull out unique eids
-          eids-keep     (filter #(= :people (td/partition-name (live-db) %))
+          eids-keep     (take-while #(= :people (td/partition-name (live-db) %))
                                 eids-all)  ; keep only eids in :people partition
           entity-maps   (map #(td/entity-map (live-db) %) eids-keep)
     ]


more implications

more implications

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -15,6 +15,9 @@
                      :consumable false
                      :part-of-human-body false}

+   {:animate false} {:human false
+                     :pet false}
+
    {:animate true} {:activity false
                     :artifact false
                     :mass false
@@ -57,7 +60,9 @@
    {:drinkable true}   {:mass true}

    {:edible true}      {:consumable true}
-
+
+   {:event true}       {:physical-object false}
+
    {:furniture true}   {:artifact true
                         :animate false
                         :buyable true
@@ -89,6 +94,8 @@
                 :buyable true
                 :edible false
                 :human false}
+
+   {:physical-object false} {:animate false}

    {:place true} {:activity false
                   :consumable false


removing tenses from specs

removing tenses from specs

--- src/babel/italiano/lab.cljc
+++ src/babel/italiano/lab.cljc
@@ -44,8 +44,6 @@
          :synsem {:cat :verb
                   :subcat []
                   :sem {:pred :top
-                        :tense :present
-                        :aspect :simple
                         :subj {:pred :top}
                         :obj {:pred :top}}}
          :head {:comp {:synsem {:pronoun true}}}}]
@@ -60,10 +58,7 @@
          :synsem {:aux false
                   :cat :verb
                   :subcat []
-                  :sem {:pred :top
-                        :tense :present
-                        :aspect :simple
-                        :subj {:pred :top}
+                  :sem {:subj {:pred :top}
                         :obj {:pred :top}}}
          :comp {:phrasal false}
          :head {:phrasal true
@@ -103,10 +98,7 @@
          :synsem {:aux false
                   :cat :verb
                   :subcat []
-                  :sem {:pred :top
-                        :tense :present
-                        :aspect :simple
-                        :subj {:pred :top}
+                  :sem {:subj {:pred :top}
                         :obj {:pred :top}}}
          :comp {:phrasal false}
          :head {:comp {:phrasal false


added comment on additional ns metadata support for the future

--- src/dj/codeloading/namespace.clj
+++ src/dj/codeloading/namespace.clj
@@ -29,6 +29,8 @@
       dc/find-resource
       ctnf/read-file-ns-decl))

+;; Note: In the future, might want to provide support for declaring
+;; additional maven repository locations
 (defn analyze-ns [ns-name]
   (let [raw-ns-form (find-ns-form ns-name)]
     {:dependent-namespaces (ctnp/deps-from-ns-decl raw-ns-form)


[#192] Filter by submission_date is optional

Don't expect that a query parameter value for `submission_date`
is available.

--- api/src/clojure/org/akvo/flow_api/endpoint/form_instance.clj
+++ api/src/clojure/org/akvo/flow_api/endpoint/form_instance.clj
@@ -61,7 +61,7 @@
   (let [parsed (parse-filter s)]
     (boolean (and (:operator parsed) (:timestamp parsed)))))

-(s/def ::submission-date valid-filter?)
+(s/def ::submission-date (s/nilable valid-filter?))

 (def params-spec (s/keys :req-un [::spec/survey-id ::spec/form-id]
                          :opt-un [::spec/cursor ::spec/page-size
@@ -84,7 +84,8 @@
           user-id (user/id-by-email-or-throw-error remote-api instance-id email)
           survey (survey/by-id remote-api instance-id user-id survey-id)
           form (find-form (:forms survey) form-id)
-          parsed-date (parse-filter submission-date)]
+          parsed-date (when submission-date
+                        (parse-filter submission-date))]
       (if (some? form)
         (-> remote-api
             (form-instance/list instance-id user-id form {:page-size page-size


pushing timbre version to 4.10.0

pushing timbre version to 4.10.0

--- resources/leiningen/new/ow_app/project.clj
+++ resources/leiningen/new/ow_app/project.clj
@@ -47,7 +47,7 @@
                  [buddy "1.3.0"]

                  ;;; logging:
-                 [com.taoensso/timbre "4.4.0"]
+                 [com.taoensso/timbre "4.10.0"]
                  ]

   :plugins [[lein-cljsbuild "1.1.6"]


make it run with java -jar

make it run with java -jar

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -3,6 +3,7 @@
            [java.net InetSocketAddress]
            [java.nio.channels SocketChannel ServerSocketChannel
             Selector SelectionKey])
+  (:gen-class)
   (:require [merlion.etcd :as etcd]
             [clojure.string :as str]
             [clojure.test :as test :refer [deftest testing is]]
@@ -372,3 +373,7 @@
                 :else
                 (recur backends listener config)))))
     shutdown))
+
+(defn -main [prefix]
+  (run-server prefix)
+  (while true (Thread/sleep 5000)))


switch to simpler reg-sub for trivial subs

--- src/braid/client/state.cljs
+++ src/braid/client/state.cljs
@@ -42,44 +42,44 @@
   (fn [[groups group-order] _]
     (order-groups groups group-order)))

-(reg-sub-raw
+(reg-sub
   :group-bots
   (fn [state _ [group-id]]
-    (reaction (get-in @state [:groups group-id :bots]))))
-
-(reg-sub-raw
+    (get-in state [:groups group-id :bots])))
+
+(reg-sub
   :user
   (fn [state [_ q-user-id] [d-user-id]]
     (let [user-id (or d-user-id q-user-id)]
-      (reaction (if-let [u (get-in @state [:users user-id])]
-                  u
-                  (let [g-id (@state :open-group-id)
-                        group-bots (get-in @state [:groups g-id :bots])]
-                    (-> group-bots
-                        (->> (filter (fn [b] (= (b :user-id) user-id))))
-                        first
-                        (assoc :bot? true))))))))
-
-(reg-sub-raw
+      (if-let [u (get-in state [:users user-id])]
+        u
+        (let [g-id (state :open-group-id)
+              group-bots (get-in state [:groups g-id :bots])]
+          (-> group-bots
+              (->> (filter (fn [b] (= (b :user-id) user-id))))
+              first
+              (assoc :bot? true)))))))
+
+(reg-sub
   :users
   (fn [state _]
-    (reaction (@state :users))))
-
-(reg-sub-raw
+    (state :users)))
+
+(reg-sub
   :user-is-group-admin?
   (fn [state _ [user-id group-id]]
-    (reaction (contains? (get-in @state [:groups group-id :admins]) user-id))))
-
-(reg-sub-raw
+    (contains? (get-in state [:groups group-id :admins]) user-id)))
+
+(reg-sub
   :current-user-is-group-admin?
   (fn [state _ [group-id]]
-    (reaction (->> (get-in @state [:session :user-id])
-                   (contains? (set (get-in @state [:groups group-id :admins])))))))
-
-(reg-sub-raw
+    (->> (get-in state [:session :user-id])
+         (contains? (set (get-in state [:groups group-id :admins]))))))
+
+(reg-sub
   :open-thread-ids
   (fn [state _]
-    (reaction (get-in @state [:user :open-thread-ids]))))
+    (get-in state [:user :open-thread-ids])))

 (reg-sub-raw
   :group-unread-count
@@ -101,10 +101,10 @@
                              (filter thread-unseen?)))]
       (reaction (count @unseen-threads)))))

-(reg-sub-raw
+(reg-sub
   :page
   (fn [state _]
-    (reaction (@state :page))))
+    (state :page)))

 (reg-sub
   :page-path
@@ -114,20 +114,20 @@
     ; depend on page & group, so when the page changes this sub updates too
     (.getPath (.parse Uri js/window.location))))

-(reg-sub-raw
+(reg-sub
   :thread
   (fn [state _ [thread-id]]
-    (reaction (get-in @state [:threads thread-id]))))
-
-(reg-sub-raw
+    (get-in state [:threads thread-id])))
+
+(reg-sub
   :threads
   (fn [state _]
-    (reaction (@state :threads))))
-
-(reg-sub-raw
+    (state :threads)))
+
+(reg-sub
   :page-id
   (fn [state _]
-    (reaction (get-in @state [:page :id]))))
+    (get-in state [:page :id])))

 (reg-sub-raw
   :open-threads
@@ -150,14 +150,13 @@
                                       (not (contains? @open-thread-ids (thread :id)))))
                        (vals @threads)))))))

-(reg-sub-raw
+(reg-sub
   :users-in-group
   (fn [state [_ group-id]]
-    (reaction
-      (->> (@state :users)
-           vals
-           (filter (fn [u] (contains? (set (u :group-ids)) group-id)))
-           doall))))
+    (->> (state :users)
+         vals
+         (filter (fn [u] (contains? (set (u :group-ids)) group-id)))
+         doall)))

 (reg-sub-raw
   :users-in-open-group
@@ -166,21 +165,21 @@
                    (filter (fn [u] (= status (u :status))))
                    doall))))

-(reg-sub-raw
+(reg-sub
   :user-id
   (fn [state _]
-    (reaction (get-in @state [:session :user-id]))))
-
-(reg-sub-raw
+    (get-in state [:session :user-id])))
+
+(reg-sub
   :tags
   (fn [state _]
-    (reaction (vals (get-in @state [:tags])))))
-
-(reg-sub-raw
+    (vals (get-in state [:tags]))))
+
+(reg-sub
   :user-subscribed-to-tag?
   (fn [state [_ q-tag-id] [d-tag-id]]
     (let [tag-id (or d-tag-id q-tag-id)]
-      (reaction (contains? (set (get-in @state [:user :subscribed-tag-ids])) tag-id)))))
+      (contains? (set (get-in state [:user :subscribed-tag-ids])) tag-id))))

 (reg-sub-raw
   :group-subscribed-tags
@@ -192,20 +191,20 @@
               (filter (fn [tag] (= (get-in @state [:open-group-id]) (tag :group-id)))))
             (vals (get-in @state [:tags]))))))

-(reg-sub-raw
+(reg-sub
   :user-avatar-url
   (fn [state _ [user-id]]
-    (reaction (get-in @state [:users user-id :avatar]))))
-
-(reg-sub-raw
+    (get-in state [:users user-id :avatar])))
+
+(reg-sub
   :user-status
   (fn [state _ [user-id]]
-    (reaction (get-in @state [:users user-id :status]))))
-
-(reg-sub-raw
+    (get-in state [:users user-id :status])))
+
+(reg-sub
   :search-query
   (fn [state _]
-    (reaction (get-in @state [:page :search-query]))))
+    (get-in state [:page :search-query])))

 (reg-sub-raw
   :tags-for-thread
@@ -226,82 +225,82 @@
                                     @mention-ids)))]
       mentions)))

-(reg-sub-raw
+(reg-sub
   :messages-for-thread
   (fn [state [_ thread-id]]
-    (reaction (get-in @state [:threads thread-id :messages]))))
-
-(reg-sub-raw
+    (get-in state [:threads thread-id :messages])))
+
+(reg-sub
   :thread-open?
   (fn [state [_ thread-id]]
-    (reaction (contains? (set (get-in @state [:user :open-thread-ids])) thread-id))))
-
-(reg-sub-raw
+    (contains? (set (get-in state [:user :open-thread-ids])) thread-id)))
+
+(reg-sub
   :thread-focused?
   (fn [state [_ thread-id]]
-    (reaction (= thread-id (get-in @state [:focused-thread-id])))))
-
-(reg-sub-raw
+    (= thread-id (get-in state [:focused-thread-id]))))
+
+(reg-sub
   :thread-last-open-at
   (fn [state [_ thread-id]]
-    (reaction (get-in @state [:threads thread-id :last-open-at]))))
-
-(reg-sub-raw
+    (get-in state [:threads thread-id :last-open-at])))
+
+(reg-sub
   :thread-new-message
   (fn [state _ [thread-id]]
-    (reaction (if-let [th (get-in @state [:threads thread-id])]
-                (get th :new-message "")
-                (get-in @state [:new-thread-msg thread-id] "")))))
-
-(reg-sub-raw
+    (if-let [th (get-in state [:threads thread-id])]
+      (get th :new-message "")
+      (get-in state [:new-thread-msg thread-id] ""))))
+
+(reg-sub
   :errors
   (fn [state _]
-    (reaction (get-in @state [:errors]))))
-
-(reg-sub-raw
+    (get-in state [:errors])))
+
+(reg-sub
   :login-state
   (fn [state _]
-    (reaction (get-in @state [:login-state]))))
+    (get-in state [:login-state])))

 (reg-sub
   :tag
   (fn [state _ [tag-id]]
     (get-in state [:tags tag-id])))

-(reg-sub-raw
+(reg-sub
   :nickname
   (fn [state _ [user-id]]
-    (reaction (get-in @state [:users user-id :nickname]))))
-
-(reg-sub-raw
+    (get-in state [:users user-id :nickname])))
+
+(reg-sub
   :invitations
   (fn [state _]
-    (reaction (get-in @state [:invitations]))))
-
-(reg-sub-raw
+    (get-in state [:invitations])))
+
+(reg-sub
   :pagination-remaining
   (fn [state _]
-    (reaction (@state :pagination-remaining))))
-
-(reg-sub-raw
+    (state :pagination-remaining)))
+
+(reg-sub
   :user-subscribed-tag-ids
   (fn [state _]
-    (reaction (set (get-in @state [:user :subscribed-tag-ids])))))
-
-(reg-sub-raw
+    (set (get-in state [:user :subscribed-tag-ids]))))
+
+(reg-sub
   :connected?
   (fn [state _]
-    (reaction (not-any? (fn [[k _]] (= :disconnected k)) (@state :errors)))))
-
-(reg-sub-raw
+    (not-any? (fn [[k _]] (= :disconnected k)) (state :errors))))
+
+(reg-sub
   :new-thread-id
   (fn [state _]
-    (reaction (get @state :new-thread-id))))
-
-(reg-sub-raw
+    (get state :new-thread-id)))
+
+(reg-sub
   :user-preference
   (fn [state [_ pref]]
-    (reaction (get-in @state [:preferences pref]))))
+    (get-in state [:preferences pref])))

 (reg-sub
   :tags-in-group


Improve :flow/to doc.

Improve :flow/to doc.

--- src/onyx/information_model.cljc
+++ src/onyx/information_model.cljc
@@ -403,7 +403,7 @@
              :added "0.8.0"}

             :flow/to
-            {:doc "The destination task where segments will arrive. If set to `:all`, all downstream tasks will receive this segment. If set to `:none`, no downstream tasks will receive this segment. Otherwise it must name a vector of keywords indicating downstream tasks. The order of keywords is irrelevant."
+            {:doc "The destination task where segments will arrive. There must be an edge between all `:flow/from` tasks to the corresponding `:flow/to` task in the `:workflow` DAG. If set to `:all`, all downstream tasks will receive this segment. If set to `:none`, no downstream tasks will receive this segment. Otherwise it must name a vector of keywords indicating downstream tasks. The order of keywords is irrelevant."
              :type [:keyword [:keyword]]
              :choices [[:any] :all :none]
              :optional? false


remove reify usage from future scheduled task impl

--- src/promesa/impl/scheduler.cljc
+++ src/promesa/impl/scheduler.cljc
@@ -33,6 +33,30 @@
               java.util.concurrent.TimeUnit
               java.util.concurrent.TimeoutException)))

+#?(:clj
+   (deftype FutureScheduledTask [^Future fut]
+     clojure.lang.IDeref
+     (deref [_]
+       (.get fut))
+
+     clojure.lang.IBlockingDeref
+     (deref [_ ms default]
+       (try
+         (.get fut ms TimeUnit/MILLISECONDS)
+         (catch TimeoutException e
+           default)))
+
+     clojure.lang.IPending
+     (isRealized [_] (and (.isDone fut)
+                          (not (.isCancelled fut))))
+
+     pt/ICancellable
+     (-cancelled? [_]
+       (.isCancelled fut))
+     (-cancel [_]
+       (when-not (.isCancelled fut)
+         (.cancel fut true)))))
+
 #?(:cljs
    (defn- scheduled-task
      [cur done?]
@@ -51,28 +75,7 @@
    :clj
    (defn- scheduled-task
      [^Future fut]
-     (reify
-       clojure.lang.IDeref
-       (deref [_]
-         (.get fut))
-
-       clojure.lang.IBlockingDeref
-       (deref [_ ms default]
-         (try
-           (.get fut ms TimeUnit/MILLISECONDS)
-           (catch TimeoutException e
-             default)))
-
-       clojure.lang.IPending
-       (isRealized [_] (and (.isDone fut)
-                            (not (.isCancelled fut))))
-
-       pt/ICancellable
-       (-cancelled? [_]
-         (.isCancelled fut))
-       (-cancel [_]
-         (when-not (.isCancelled fut)
-           (.cancel fut true))))))
+     (FutureScheduledTask. fut)))

 #?(:clj
    (extend-type ScheduledExecutorService


remove old error-checking code

remove old error-checking code

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -200,9 +200,6 @@
           (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 (map? complement-candidate-lexemes)
-          (log/error (str "complement-candidate-lexemes is unexpectedly a map with keys:"
-                          ( keys complement-candidate-lexemes))))
         (let [shuffled-candidate-lexical-complements complement-candidate-lexemes
               complement-pre-check (fn [child parent path-to-child]
                                      (and (not (fail?


+_morph_ as a param to (show-bolt)

+_morph_ as a param to (show-bolt)

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -56,6 +56,8 @@
   (filter #(not (fail? %))
           (do
             (log/debug (str "generate-all: cat: " (get-in spec [:synsem :cat])))
+            (if (= :adjective (get-in spec [:synsem :cat]) )
+              (exception (str "got here; spec=" (strip-refs spec))))
             (let [add-complements-to-bolts
                   (fn [bolts path]
                     (mapcat #(if (not (= :none (get-in % path :none)))
@@ -63,8 +65,8 @@
                                [%])
                             bolts))]
               (-> (lightning-bolt (lazy-shuffle grammar)
-                                     lexicon
-                                     spec 0 index morph)
+                                  lexicon
+                                  spec 0 index morph)
                   ;; TODO: allow more than a fixed maximum depth of generation (here, 4 levels from top of tree).
                   (add-complements-to-bolts [:head :head :head :comp])
                   (add-complements-to-bolts [:head :head :comp])
@@ -76,7 +78,9 @@
 there is only one child for each parent, and that single child is the
 head of its parent. generate (above) 'decorates' each returned lightning bolt
 of this function with complements."
-  (log/debug (str "lightning-bolt(depth=" depth "):" (strip-refs spec)))
+  (log/debug (str "lightning-bolt(depth=" depth "): sem:" (strip-refs (get-in spec [:synsem :sem]))))
+  (if (not (= :none (get-in spec [:synsem :sem :synsem] :none)))
+    (exception (str "SHOULD NOT GET HERE.")))
   (let [maxdepth 3 ;; maximum depth of a lightning bolt: H1 -> H2 -> H3 where H3 must be a lexeme, not a phrase.
         morph (if morph morph (fn [input] (get-in input [:rule] :default-morph-no-rule)))
         depth (if depth depth 0)
@@ -131,14 +135,17 @@
                 (if (fail? complement)
                   true
                   (do
-                    (log/debug (str "add-complement(depth=" depth ",path=" path ",bolt=(" (show-bolt bolt path) ")=>"
+                    (log/debug (str "add-complement(depth=" depth ",path=" path ",bolt=(" (show-bolt bolt path morph) ")=>"
                                     "'" (morph complement) "'"))
                     false)))
               (map (fn [complement]
                      (unify (copy bolt)
                             (path-to-map path
                                          (copy complement))))
-                   (let [phrasal-complements (generate-all spec grammar lexicon cache morph)]
+                   (let [debug (log/debug (str "add-complement(depth=" depth ",path=" path ",bolt=(" (show-bolt bolt path morph)
+                                               "): calling generate-all(" (strip-refs spec) ");"
+                                               "input-spec: " input-spec))
+                         phrasal-complements (generate-all spec grammar lexicon cache morph)]
                      (if (lexemes-before-phrases depth)
                        (lazy-cat shuffled-candidate-lexical-complements phrasal-complements)
                        (lazy-cat phrasal-complements shuffled-candidate-lexical-complements))))))))
@@ -203,9 +210,10 @@
     (log/trace (str "lexemes-before-phrases: depth=" depth " => " result))
     result))

-(defn show-bolt [bolt path]
+(defn show-bolt [bolt path morph]
   (if (not (empty? path))
     (str (get-in bolt [:rule])
-         (let [rest-str (show-bolt (get-in bolt [:head]) (rest path))]
+         " '" (morph bolt) "' "
+         (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
            (if (not (nil? rest-str))
              (str " -> " rest-str))))))


lose unused import

lose unused import

--- dada-demo/src/main/clojure/org/dada/demo/server.clj
+++ dada-demo/src/main/clojure/org/dada/demo/server.clj
@@ -17,8 +17,6 @@
    SessionManagerImpl
    View
    ViewNameGetter]
-  [org.dada.core.jms
-   POJOInvoker]
   [org.dada.jms
    SimpleMethodMapper]
   [org.springframework.beans.factory


prevent play of run events after Excalibur or Uroboros subs fire

--- src/clj/game/core-rules.clj
+++ src/clj/game/core-rules.clj
@@ -21,6 +21,8 @@
                     (req state side card targets) true)
                   (not (and (has-subtype? card "Current")
                             (get-in @state [side :register :cannot-play-current])))
+                  (not (and (has-subtype? card "Run")
+                            (get-in @state [side :register :cannot-run])))
                   (not (and (has-subtype? card "Priority")
                             (get-in @state [side :register :spent-click]))))
          (when-let [cost-str (pay state side card :credit (:cost card) extra-cost


ignore deletion problems on archiving

ignore deletion problems on archiving

i.e. archive a production even if we couldn't delete the associated
directories

--- src/clj/mdr2/production.clj
+++ src/clj/mdr2/production.clj
@@ -254,7 +254,11 @@
       (throw (ex-info message {:error-id :invalid-obi-directory})))))

 (defn set-state-archived! [production]
-  (delete-all-dirs! production)
+  (try
+    (delete-all-dirs! production)
+    ;; ignore deletion problems, i.e. archive the production even if
+    ;; we couldn't delete the directories
+    (catch clojure.lang.ExceptionInfo _))
   (set-state! production "archived"))

 (defn repair!


Fixed to handle null created dates when rendering links.

--- src/cljs/bookmarx/home.cljs
+++ src/cljs/bookmarx/home.cljs
@@ -58,7 +58,7 @@
          (for [i (range 0 rating)]
            [:span.bookmark_link-icon-rating {:aria-hidden "true"
                                              :key (str id "-rating" i "-key")}]))
-       (when (> (.getTime (parse-datomic-date created)) week-ago-ticks)
+       (when (and created  (> (.getTime (parse-datomic-date created)) week-ago-ticks))
          [:span.label.label-success "New"])
        (when (and last-visited (> (.getTime (parse-datomic-date last-visited)) week-ago-ticks))
          [:span.label.label-info "Visited"])


Extend IComparable to sets as a convenience for local component state storage

--- src/cljs/dato/lib/core.cljs
+++ src/cljs/dato/lib/core.cljs
@@ -28,6 +28,11 @@
   IComparable
   (-compare [x y]
     (compare (.toString x) (.toString y))))
+
+(extend-type cljs.core/PersistentHashSet
+  IComparable
+  (-compare [x y]
+    (compare (hash x) (hash y))))

 (def transit-reader
   (transit/reader :json


Add missing navbar class to navbar

Add missing navbar class to navbar

--- src/cljs/my_money/core.cljs
+++ src/cljs/my_money/core.cljs
@@ -38,7 +38,7 @@
 (defn navbar []
   (let [collapsed? (r/atom true)]
     (fn []
-      [:nav.navbar-expand-lg.navbar-dark.bg-dark
+      [:nav.navbar.navbar-expand-lg.navbar-dark.bg-dark
        [:a.navbar-brand {:href "#"} "my-money"]
        [:button.navbar-toggler {:type "button"
                                 :on-click #(swap! collapsed? not)}


Added some debugging for receive loop. Data never gets to us.

--- src/cljs/om_sente/core.cljs
+++ src/cljs/om_sente/core.cljs
@@ -39,7 +39,10 @@
     om/IWillMount
     (will-mount [this]
       (go (loop []
-            (om/set-state! owner :text (<! ch-chsk))
+            (js/alert "waiting for data")
+            (let [[ev-id & payload] (<! ch-chsk)]
+              (js/alert "got " + ev-id)
+              (om/set-state! owner :text (first payload)))
             (recur))))
     om/IRenderState
     (render-state [this {:keys [text]}]


Less magic numbers

Less magic numbers

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -27,6 +27,7 @@
 (def players [:blue :red :green])
 (def directions [[-1 0] [1 0] [0 -1] [0 1] [-1 1] [1 1] [-1 -1] [1 -1]])
 (def max-score (- (* board-width board-height) init-block-count))
+(def ai-move-delay 1000)

 ;; -----------------------------------------
 ;; EXTRINSIC TYPES
@@ -305,9 +306,9 @@
        {:red (partial best-move (compute-cells-strength board))
         :green (partial best-move (compute-cells-strength board))}
        :scores
-       {:blue 12
-        :red 12
-        :green 12}})))
+       {:blue init-block-count
+        :red init-block-count
+        :green init-block-count}})))

 (defonce app-state (atom (new-game)))
 (def board (reagent/cursor app-state [:board]))
@@ -345,7 +346,7 @@
           player-events ([coord] (swap! app-state play-move coord))
           game-events ([msg] (when (= msg :new-game) (reset! app-state (new-game))))
           ai-events ([msg] (when (= msg :ai-play) (handle-ai)))
-          (async/timeout 1000) ([_] (put! ai-events :ai-play))
+          (async/timeout ai-move-delay) ([_] (put! ai-events :ai-play))
           )))

     {:game-events game-events


Fix typo in the doc string of Instrumented protocol. (#755)

--- src/riemann/instrumentation.clj
+++ src/riemann/instrumentation.clj
@@ -10,7 +10,7 @@
                                       uniform-reservoir]]))

 (defprotocol Instrumented
-  "These things can can be asked to report events about their performance and
+  "These things can be asked to report events about their performance and
   health."
   (events [this]
           "Returns a sequence of events describing the current state of the


don't pause between expose and collect

don't pause between expose and collect

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -268,8 +268,7 @@
         (acq-sleep wait-time-ms))
       #(when (:autofocus event)
           (store-z-correction (get-in event [:position :label]) (run-autofocus)))
-      #(expose event)
-      #(collect-image event out-queue)
+      #(do (expose event) (collect-image event out-queue))
     )))

 (defn execute [event-fns]


Can draw arrows

Can draw arrows

--- devcards/frontend/devcards/map.cljs
+++ devcards/frontend/devcards/map.cljs
@@ -228,3 +228,29 @@
      [:div
       (show-columns columns)
       (show-columns-svg columns (g/edges g))])))
+
+(defn move-to [x y]
+  (str "M" x "," y))
+
+(defn line-to [x y]
+  (str "L" x "," y))
+
+(defn arc-to [rx ry x-axis-rotate large-arc-flag sweep-flag x y]
+  (str "A" rx "," ry "," x-axis-rotate "," large-arc-flag "," sweep-flag "," x "," y))
+
+(defn arrow [start end strut-pos radius]
+  [:path {:stroke "black"
+          :fill "none"
+          :d (str
+              (apply move-to start)
+              (line-to (- strut-pos radius) (second start))
+              (arc-to radius radius 0 0 0 strut-pos (- (second start) radius))
+              (line-to strut-pos (+ (second end) radius))
+              (arc-to radius radius 0 0 1 (+ strut-pos radius) (second end))
+              (apply line-to end))}])
+
+(defcard arrow
+  (html
+   [:svg {:width "100%"
+          :height "500"}
+    (arrow [0 100] [200 10] 130 10)]))


add fn and trig namespaces to api

add fn and trig namespaces to api

--- src/overtone/api.clj
+++ src/overtone/api.clj
@@ -4,10 +4,10 @@
   (:require clojure.stacktrace
             [overtone.config store]
             [overtone version midi osc speech]
-            [overtone.algo chance scaling trig]
+            [overtone.algo chance scaling trig fn]
             [overtone.sc bindings buffer bus envelope example info
                          ugens defcgen node sample server synth
-                         foundation-groups dyn-vars]
+                         foundation-groups dyn-vars trig]
             [overtone.sc.cgens oscillators demand mix io buf-io env tap
                                line freq beq-suite berlach bhob info]
             [overtone.music rhythm pitch tuning time]
@@ -23,6 +23,7 @@
    'overtone.algo.chance
    'overtone.algo.scaling
    'overtone.algo.trig
+   'overtone.algo.fn
    'overtone.config.store
    'overtone.sc.bindings
    'overtone.sc.buffer
@@ -38,6 +39,7 @@
    'overtone.sc.defcgen
    'overtone.sc.foundation-groups
    'overtone.sc.dyn-vars
+   'overtone.sc.trig
    'overtone.sc.cgens.oscillators
    'overtone.sc.cgens.demand
    'overtone.sc.cgens.mix


Tundra: allow configurable message queue name

--- src/taoensso/carmine/tundra.clj
+++ src/taoensso/carmine/tundra.clj
@@ -103,6 +103,7 @@

 (comment (wcar {} (car/ping) (extend-exists nil ["k1" "invalid" "k3"])))

+(def ^:private k-evictable "carmine:tundra:evictable")
 (defn- extend-exists-missing-ks [ttl-ms ks & [only-evictable?]]
   (let [existance-replies (->> (extend-exists ttl-ms ks)
                                (car/with-replies) ; Single bulk reply
@@ -124,8 +125,6 @@
          (prep-ks [:a "a" :b :foo.bar/baz]))

 (defmacro ^:private catcht [& body] `(try (do ~@body) (catch Throwable t# t#)))
-(def ^:private tqname "carmine.tundra")
-(def ^:private k-evictable "carmine:tundra:evictable")

 (defrecord TundraStore [datastore freezer opts]
   ITundraStore
@@ -171,7 +170,7 @@
           nil))))

   (dirty* [tstore ks]
-    (let [{:keys [redis-ttl-ms]} opts
+    (let [{:keys [tqname redis-ttl-ms]} opts
           ks             (prep-ks ks)
           ks-missing     (extend-exists-missing-ks redis-ttl-ms ks)
           ks-not-missing (->> ks (filterv (complement (set ks-missing))))]
@@ -185,7 +184,7 @@
       nil))

   (worker [tstore conn wopts]
-    (let [{:keys [redis-ttl-ms]} opts
+    (let [{:keys [tqname redis-ttl-ms]} opts
           {:keys [nattempts retry-backoff-ms]
            :or   {nattempts 3
                   retry-backoff-ms mq/exp-backoff}} wopts]
@@ -227,6 +226,7 @@
     datastore     - Storage for frozen key data. Default datastores:
                     `taoensso.carmine.tundra.faraday/faraday-datastore`
                     `taoensso.carmine.tundra.s3/s3-datastore`.
+    :qname        - Optional. Worker message queue name.
     :freezer      - Optional. Preps key data to/from datastore. May provide
                     services like compression and encryption, etc. Defaults to
                     Nippy with default options (Snappy compression and no
@@ -238,12 +238,14 @@
                     Otherwise YOU WILL IRREVOCABLY **LOSE DATA**.

   See `ensure-ks`, `dirty`, `worker` for TundraStore API."
-  [datastore & [{:keys [freezer redis-ttl-ms ]
-                 :or   {freezer nippy-freezer}}]]
+  [datastore & [{:keys [qname freezer redis-ttl-ms]
+                 :or   {qname "default" freezer nippy-freezer}}]]

   (assert (or (nil? freezer) (satisfies? IFreezer freezer)))
   (assert (satisfies? IDataStore datastore))
   (assert (or (nil? redis-ttl-ms) (>= redis-ttl-ms (* 1000 60 60 10)))
           (str "Bad TTL (< 10 hours): " redis-ttl-ms))

-  (->TundraStore datastore freezer {:redis-ttl-ms redis-ttl-ms}))
+  (->TundraStore datastore freezer
+    {:tqname (format "carmine-tundra-%s" (name qname))
+     :redis-ttl-ms redis-ttl-ms}))


* src/clj/cljs/core.clj: CLJS-121: binding doesn't work with required vars

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -404,7 +404,7 @@
   [bindings & body]
   (let [names (take-nth 2 bindings)
         vals (take-nth 2 (drop 1 bindings))
-        tempnames (map gensym names)
+        tempnames (map (comp gensym name) names)
         binds (map vector names vals)
         resets (reverse (map vector names tempnames))]
     `(let [~@(interleave tempnames names)]


* src/clj/cljs/core.clj: add INext to fast path protocols. rest & next are now identical in perf. iterating through cached lazy seq on V8 now nearly w/in 2X of Clojure on JVM.

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -46,7 +46,7 @@
 (def fast-path-protocols
   "protocol fqn -> [partition number, bit]"
   (zipmap (map #(symbol (core/str "cljs.core." %))
-               '[IFn ICounted IEmptyableCollection ICollection IIndexed ASeq ISeq
+               '[IFn ICounted IEmptyableCollection ICollection IIndexed ASeq ISeq INext
                  ILookup IAssociative IMap IMapEntry ISet IStack IVector IDeref
                  IDerefWithTimeout IMeta IWithMeta IReduce IKVReduce IEquiv IHash
                  ISeqable ISequential IList IRecord IReversible ISorted IPrintable


add require-macros REPL special fn

add require-macros REPL special fn

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -221,6 +221,23 @@
                       specs)))
              {:merge true :line 1 :column 1})
            identity opts)))
+     'require-macros
+     (fn self
+       ([repl-env env form]
+         (self repl-env env form nil))
+       ([repl-env env [_ & specs :as form] opts]
+         (evaluate-form repl-env env "<cljs repl>"
+           (with-meta
+             `(~'ns ~ana/*cljs-ns*
+                (:require-macros
+                  ~@(map
+                      (fn [quoted-spec-or-kw]
+                        (if (keyword? quoted-spec-or-kw)
+                          quoted-spec-or-kw
+                          (second quoted-spec-or-kw)))
+                      specs)))
+             {:merge true :line 1 :column 1})
+           identity opts)))
      'load-file load-file-fn
      'clojure.core/load-file load-file-fn
      'load-namespace


Add event suppression mechanism.

Add event suppression mechanism.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -64,14 +64,25 @@
       (swap! state assoc-in [side (first r)] 0)
       (apply-loss state side r))))

+(defn register-suppress [state side events card]
+  (doseq [e events]
+    (swap! state update-in [:suppress (first e)] #(conj % {:ability (last e) :card card}))))
+
 (defn register-events [state side events card]
   (doseq [e events]
-    (swap! state update-in [:events (first e)] #(conj % {:ability (last e) :card card}))))
+    (swap! state update-in [:events (first e)] #(conj % {:ability (last e) :card card})))
+  (register-suppress state side (:suppress (card-def card)) card))
+
+(defn unregister-suppress [state side card]
+  (doseq [e (:suppress (card-def card))]
+    (swap! state update-in [:suppress (first e)]
+           #(remove (fn [effect] (= (get-in effect [:card :cid]) (:cid card))) %))))

 (defn unregister-events [state side card]
   (doseq [e (:events (card-def card))]
     (swap! state update-in [:events (first e)]
-           #(remove (fn [effect] (= (get-in effect [:card :cid]) (:cid card))) %))))
+           #(remove (fn [effect] (= (get-in effect [:card :cid]) (:cid card))) %)))
+  (unregister-suppress state side card))

 (defn desactivate
   ([state side card] (desactivate state side card nil))
@@ -399,10 +410,14 @@
           (when (= (count (:cards selected)) (or (:max selected) 1))
             (resolve-select state side)))))))

+(defn trigger-suppress [state side event & targets]
+  (reduce #(or %1 ((:req (:ability %2)) state side (:card %2) targets)) false (get-in @state [:suppress event])))
+
 (defn trigger-event [state side event & targets]
   (doseq [{:keys [ability] :as e} (get-in @state [:events event])]
     (when-let [card (get-card state (:card e))]
-      (when (or (not (:req ability)) ((:req ability) state side card targets))
+      (when (and (not (apply trigger-suppress state side event (cons card targets)))
+                 (or (not (:req ability)) ((:req ability) state side card targets)))
         (resolve-ability state side ability card targets))))
   (swap! state update-in [:turn-events] #(cons [event targets] %)))

@@ -835,6 +850,7 @@
   (swap! state update-in [:run :access-bonus] #(+ % n)))

 (defn do-access [state side server]
+  (trigger-event state side :pre-access (first server))
   (let [cards (access state side server)]
     (when-not (or (= (get-in @state [:run :max-access]) 0) (empty? cards))
       (if (= (first server) :rd)


Remove debug message.

Remove debug message.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -989,7 +989,6 @@
     (update-advancement-cost state side ag)))

 (defn update-advancement-cost [state side agenda]
-  (system-msg state side (str "update agenda " (:title agenda)))
   (swap! state update-in [:bonus] dissoc :advancement-cost)
   (trigger-event state side :pre-advancement-cost agenda)
   (update! state side (assoc agenda :current-cost (advancement-cost state side agenda))))