Fix sorting comparator

Fix sorting comparator

--- src/cljam/sorter.clj
+++ src/cljam/sorter.clj
@@ -1,20 +1,24 @@
 (ns cljam.sorter
   (:refer-clojure :exclude [sort sorted?])
-  (:require [cljam.sam :as sam]))
+  (:require [cljam.sam :as sam])
+  (:import java.util.List))

-(defn- rnames [sam]
-  (map :SN (:SQ (:header sam))))
+(defn- compkey-pos [hdr aln]
+  [(.indexOf ^List (map :name (sam/make-refs hdr)) (:rname aln))
+   (:pos aln)])

 (defn- sort-alignments-by-pos [sam]
-  (let [get-order #(.indexOf (vec (rnames sam)) %)]
-   (->> (sort-by #(vec [(get-order (:rname %)) (:pos %)]) (:alignments sam))
-        (assoc sam :alignments))))
+  (->> (sort-by (partial compkey-pos (:header sam)) (:alignments sam))
+       (assoc sam :alignments)))

-;;; FIXME: Invalid sorting algorithm
+(defn- compkey-qname [hdr aln]
+  [(.indexOf ^List (map :name (sam/make-refs hdr)) (:rname aln))
+   (:qname aln)
+   (bit-and (:flag aln) 0xc0)])
+
 (defn- sort-alignments-by-qname [sam]
-  (let [get-order #(.indexOf (vec (rnames sam)) %)]
-   (->> (sort-by #(vec [(get-order (:rname %)) (:qname %)]) (:alignments sam))
-        (assoc sam :alignments))))
+  (->> (sort-by (partial compkey-qname (:header sam)) (:alignments sam))
+       (assoc sam :alignments)))

 (defn- add-hd [sam vn so]
   (update-in sam [:header] conj {:HD {:VN vn, :SO so}}))


PLATFORM-28990: code cleanup

PLATFORM-28990: code cleanup

--- src/vignette/http/legacy/route_helpers.clj
+++ src/vignette/http/legacy/route_helpers.clj
@@ -27,15 +27,11 @@
   (if-let [vary-string (get-in request [:headers webp-accept-header-name])]
     (.contains vary-string mt/webp-mime-type)))

-(defn add-webp-format-option-if-supported
+(defn autodetect-request-format
   [request options]
   (if (browser-supports-webp? request)
     (merge options {:format mt/webp-format})
     options))
-
-(defn autodetect-request-format
-  [request options]
-  (add-webp-format-option-if-supported request options))

 (defn route->webp-request-format
   "In case format was not specified in query options, try to set it to webp based on the accept header."


Start porting C* driver tests

Start porting C* driver tests

--- test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
+++ test/clojure/clojurewerkz/cassaforte/new_query_api_test.clj
@@ -47,4 +47,77 @@
                   (limit 10)
                   (allow-filtering)
                   )))
+
+  (is (=  "SELECT * FROM foo WHERE k=4 AND c>'a' AND c<='z';";
+          (select :foo
+                  (all)
+                  (where [[= :k 4]
+                          [> :c "a"]
+                          [<= :c "z"]])
+                  )))
   )
+
+;;
+;; select().all().from("foo").where(eq("k", 4)).and(gt("c", "a")).and(lte("c", "z"));
+
+;; "SELECT a,b,\"C\" FROM foo WHERE a IN ('127.0.0.1','127.0.0.3') AND \"C\"='foo' ORDER BY a ASC,b DESC LIMIT 42;";
+;; select("a", "b", quote("C")).from("foo")
+;; .where(in("a", InetAddress.getByName("127.0.0.1"), InetAddress.getByName("127.0.0.3")))
+;; .and(eq(quote("C"), "foo"))
+;; .orderBy(asc("a"), desc("b"))
+;; .limit(42);
+
+
+;; "SELECT writetime(a),ttl(a) FROM foo ALLOW FILTERING;";
+;; select().writeTime("a").ttl("a").from("foo").allowFiltering();
+
+
+;; "SELECT DISTINCT longName AS a,ttl(longName) AS ttla FROM foo LIMIT :limit;";
+;; select().distinct().column("longName").as("a").ttl("longName").as("ttla").from("foo").limit(bindMarker("limit"));
+
+;; "SELECT DISTINCT longName AS a,ttl(longName) AS ttla FROM foo WHERE k IN () LIMIT :limit;";
+;; select().distinct().column("longName").as("a").ttl("longName").as("ttla").from("foo").where(in("k")).limit(bindMarker("limit"));
+
+;; "SELECT * FROM foo WHERE bar=:barmark AND baz=:bazmark LIMIT :limit;";
+;; select().all().from("foo").where().and(eq("bar", bindMarker("barmark"))).and(eq("baz", bindMarker("bazmark"))).limit(bindMarker("limit"));
+
+;; "SELECT a FROM foo WHERE k IN ();";
+;; select("a").from("foo").where(in("k"));
+
+;; "SELECT a FROM foo WHERE k IN ?;";
+;; select("a").from("foo").where(in("k", bindMarker()));
+
+;; "SELECT count(*) FROM foo;";
+;; select().countAll().from("foo");
+
+;; "SELECT intToBlob(b) FROM foo;";
+;; select().fcall("intToBlob", column("b")).from("foo");
+
+;; "SELECT * FROM foo WHERE k>42 LIMIT 42;";
+;; select().all().from("foo").where(gt("k", 42)).limit(42);
+
+;; "SELECT * FROM foo WHERE token(k)>token(42);";
+;; select().all().from("foo").where(gt(token("k"), fcall("token", 42)));
+
+;; "SELECT * FROM foo2 WHERE token(a,b)>token(42,101);";
+;; select().all().from("foo2").where(gt(token("a", "b"), fcall("token", 42, 101)));
+
+;; "SELECT * FROM words WHERE w='):,ydL ;O,D';";
+;; select().all().from("words").where(eq("w", "):,ydL ;O,D"));
+
+;; "SELECT * FROM words WHERE w='WA(!:gS)r(UfW';";
+;; select().all().from("words").where(eq("w", "WA(!:gS)r(UfW"));
+
+;; Date date = new Date();
+;; date.setTime(1234325);
+;; "SELECT * FROM foo where d=1234325";
+;; select().all().from("foo").where(eq("d", date));
+
+;; "SELECT * FROM foo where b=0xCAFEBABE";
+;; select().all().from("foo").where(eq("b", Bytes.fromHexString("0xCAFEBABE")));
+
+;; select().countAll().from("foo").orderBy(asc("a"), desc("b")).orderBy(asc("a"), desc("b"));
+;; select().column("a").all().from("foo");
+;; select().column("a").countAll().from("foo");
+;; select().all().from("foo").limit(-42);
+;; select().all().from("foo").limit(42).limit(42);


Added test for filter-in-range function

Added test for filter-in-range function

--- test/trumpet_server/domain/trumpeteer_trumpet_test.clj
+++ test/trumpet_server/domain/trumpeteer_trumpet_test.clj
@@ -1,6 +1,6 @@
 (ns trumpet-server.domain.trumpeteer-trumpet-test
   (:require [midje.sweet :refer :all]
-            [trumpet-server.domain.trumpeteer :refer :all]))
+            [trumpet-server.domain.trumpeteer :refer [->Trumpeteer]]))

 (fact "Send trumpet to all trumpeteers execept self and those that are out-of-range"
       ; Given
@@ -14,9 +14,9 @@
       (def messages-sent (atom {}))

       ; When
-      (trumpet! trumpeteer1 {:trumpetees   [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
-                             :broadcast-fn (fn [id message] (swap! messages-sent assoc id message))
-                             :trumpet      "Hello World!"})
+      (.trumpet! trumpeteer1 {:trumpetees   [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
+                              :broadcast-fn (fn [id message] (swap! messages-sent assoc id message))
+                              :trumpet      "Hello World!"})

       ; Then
       (keys (deref messages-sent)) => (just (list 2 3 4) :in-any-order))
@@ -33,9 +33,9 @@
       (def messages-sent (atom {}))

       ; When
-      (trumpet! trumpeteer1 {:trumpetees   [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
-                             :broadcast-fn (fn [id message] (swap! messages-sent assoc id message))
-                             :trumpet      "Hello World!"})
+      (.trumpet! trumpeteer1 {:trumpetees   [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
+                              :broadcast-fn (fn [id message] (swap! messages-sent assoc id message))
+                              :trumpet      "Hello World!"})

       ; Then
       (def messages (vals (deref messages-sent)))
@@ -54,10 +54,10 @@
       (def messages-sent (atom {}))

       ; When
-      (trumpet! trumpeteer1 {:trumpetees          [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
-                             :broadcast-fn        (fn [id message] (swap! messages-sent assoc id message))
-                             :trumpet             "Hello World!"
-                             :max-distance-meters 150})
+      (.trumpet! trumpeteer1 {:trumpetees          [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
+                              :broadcast-fn        (fn [id message] (swap! messages-sent assoc id message))
+                              :trumpet             "Hello World!"
+                              :max-distance-meters 150})
       ; Then
       (keys (deref messages-sent)) => (just (list 2 3) :in-any-order))

@@ -73,10 +73,10 @@
       (def messages-sent (atom {}))

       ; When
-      (trumpet! trumpeteer1 {:trumpetees          [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
-                             :broadcast-fn        (fn [id message] (swap! messages-sent assoc id message))
-                             :trumpet             "Hello World!"
-                             :max-distance-meters nil})
+      (.trumpet! trumpeteer1 {:trumpetees          [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
+                              :broadcast-fn        (fn [id message] (swap! messages-sent assoc id message))
+                              :trumpet             "Hello World!"
+                              :max-distance-meters nil})
       ; Then
       (keys (deref messages-sent)) => (just (list 2 3 4) :in-any-order))

@@ -93,10 +93,24 @@
       (def messages-sent (atom {}))

       ; When
-      (trumpet! trumpeteer1 {:trumpetees          [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
-                             :broadcast-fn        (fn [id message] (swap! messages-sent assoc id message))
-                             :trumpet             "Hello World!"
-                             :max-distance-meters 100000})
+      (.trumpet! trumpeteer1 {:trumpetees          [trumpeteer1 trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6]
+                              :broadcast-fn        (fn [id message] (swap! messages-sent assoc id message))
+                              :trumpet             "Hello World!"
+                              :max-distance-meters 100000})
       ; Then
       (keys (deref messages-sent)) => (just (list 2 3 4) :in-any-order))

+(fact "filter-in-range returns all trumpeteers that are in range"
+      ; Given
+      (def trumpeteer1 (->Trumpeteer 1, 55.583985, 12.957578)) ; self
+      (def trumpeteer2 (->Trumpeteer 2, 55.584126, 12.957406))
+      (def trumpeteer3 (->Trumpeteer 3, 55.58453, 12.957406))
+      (def trumpeteer4 (->Trumpeteer 4, 55.58533, 12.95864))
+      (def trumpeteer5 (->Trumpeteer 5, 55.59772, 12.97519)) ; out of range
+      (def trumpeteer6 (->Trumpeteer 6, 55.60519, 13.00334)) ; out of range
+
+      (let [in-range (.filter-in-range trumpeteer1 [trumpeteer2 trumpeteer3 trumpeteer4 trumpeteer5 trumpeteer6])
+            ids (map #(:id %) in-range)]
+        ids) => (just (list 2 3 4) :in-any-order))
+
+


Revert "Enable fspec tests"

Revert "Enable fspec tests"

This reverts commit 2033a4e2a29c3897183da84b0bda77778f8b231b.

--- test/expound/alpha_test.cljc
+++ test/expound/alpha_test.cljc
@@ -1380,7 +1380,13 @@
       50
       [spec spec-gen
        form gen/any-printable]
-      (is (string? (expound/expound-str spec form))))))
+      (when-not (some
+                 #{"clojure.spec.alpha/fspec"}
+                 (->> spec
+                      inline-specs
+                      (tree-seq coll? identity)
+                      (map str)))
+        (is (string? (expound/expound-str spec form)))))))

 (deftest test-mutate
   (checking
@@ -1404,15 +1410,21 @@
       50
       [spec spec-gen
        mutate-path (gen/vector gen/pos-int)]
-      (when (contains? (s/registry) spec)
-        (try
-          (let [valid-form (first (s/exercise spec 1))
-                invalid-form (mutate valid-form mutate-path)]
-            (is (string? (expound/expound-str spec invalid-form))))
-          (catch clojure.lang.ExceptionInfo e
-            (when (not= :no-gen (::s/failure (ex-data e)))
-              (when (not= "Couldn't satisfy such-that predicate after 100 tries." (.getMessage e))
-                (throw e)))))))))
+      (when-not (some
+                 #{"clojure.spec.alpha/fspec"}
+                 (->> spec
+                      inline-specs
+                      (tree-seq coll? identity)
+                      (map str)))
+        (when (contains? (s/registry) spec)
+          (try
+            (let [valid-form (first (s/exercise spec 1))
+                  invalid-form (mutate valid-form mutate-path)]
+              (is (string? (expound/expound-str spec invalid-form))))
+            (catch clojure.lang.ExceptionInfo e
+              (when (not= :no-gen (::s/failure (ex-data e)))
+                (when (not= "Couldn't satisfy such-that predicate after 100 tries." (.getMessage e))
+                  (throw e))))))))))

 ;; Using conformers for transformation should not crash by default, or at least give useful error message.
 (defn numberify [s]


Removed unused btn fn.

Removed unused btn fn.

--- test/freactive/dom_perf.cljs
+++ test/freactive/dom_perf.cljs
@@ -56,11 +56,6 @@
         n (inc n)
         x (/ i n)]
     (- 1 (.pow js/Math (- 1 x) 2))))
-
-(defn- btn [x y fill text f]
-  [:svg/g {:on-mousedown f}
-   [:svg/text {:x x :y (+ 4 y) :text-anchor "middle"} text]
-   [:svg/circle {:fill fill :r 8 :cx x :cy y}]])

 (defn view []
   [:div


fixing order

fixing order

--- src/proxmox/auth.clj
+++ src/proxmox/auth.clj
@@ -52,7 +52,7 @@
 (def auth-store (atom {}))

 (defn auth-expired? []
-  (> (- (:modified @auth-store) (curr-time)) (* 5 minute)))
+  (> (- (curr-time) (:modified @auth-store)) (* 5 minute)))

 (defn auth-headers []
   (when (or (not (contains? @auth-store :headers)) (auth-expired?))


fix specification

fix specification

--- test/s7p/slave/core_test.clj
+++ test/s7p/slave/core_test.clj
@@ -63,7 +63,7 @@
             ret (auction fp arg)]
        (is ret)
        (is (= dsp1 (:dsp ret)))
-       (is (= fp   (:second-price ret)))))
+       (is (= fp   (:win-price ret)))))

     (testing "one valid response without fp"
       (let [fp nil
@@ -72,7 +72,7 @@
             ret (auction fp arg)]
        (is ret)
        (is (= dsp1 (:dsp ret)))
-       (is (= bid-price (:second-price ret)))))
+       (is (= bid-price (:win-price ret)))))

     (testing "more than 1 valid response"
       (let [fp 4.0
@@ -83,4 +83,4 @@
             ret (auction fp arg)]
         (is ret)
         (is (= dsp2 (:dsp ret)))
-        (is (= bid-price1 (:second-price ret)))))))
+        (is (= (+ 1 bid-price1) (:win-price ret)))))))


Fix 404

Fix 404

Change-Id: I428673804f06a5acb926f1062596eeb66a81e445

--- src/qcast/server.clj
+++ src/qcast/server.clj
@@ -24,7 +24,9 @@
     (handler req)))

 (defn- respond [body]
-  (fn [_req] {:body body}))
+  (if body
+    (fn [_req] {:body body})
+    (route/not-found nil)))

 (defn- json-keyword [kw]
   (-> kw name (s/replace "-" "_")))


handle all the music braille grades

handle all the music braille grades

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -134,9 +134,11 @@

 (def braille-music-grade-raw-to-braille-grade
   "Mapping between braille-music-grade-raw and braille-grade"
-  {"ms" :kurzschrift
-   "vd" :vollschrift
-   "vs" :fixme})
+  {"vd" :vollschrift ; Vollschrift Deutsch
+   "vs" :vollschrift ; Vollschrift other language
+   "ms" :vollschrift}) ; Musikschrift, not valid really, but the
+                       ; MARC21 data isn't super clean for music, so
+                       ; swallow this as well

 (defn get-subfield
   "Get the subfield text for the given `path` in the given `record`.


Improve box demo

Improve box demo

--- src/re_demo/box.cljs
+++ src/re_demo/box.cljs
@@ -23,10 +23,12 @@

                                       [p "When we first put bootstrap buttons into re-com, they were streched.
                It turned out their block display didn't play well with flex containers like h-box."]
-                                      [p "We fixed that, but then there were other problem like they wouldn't justify correctly in a container."]
+                                      [p "We fixed that, but then there were other problems like they
+                                      wouldn't justify correctly in a container. All this issues arose because they
+                                      were never designed (styled) to be the children of flexbaox containers."]
                                       [p "So we created the " [:span.bold "[box ...]"] " component which allows you to wrap
-               non-flex \"leaf\" elements for use in flex containers."]
-                                      [p "You probably won't need to use it directly."]
+               a single non-flex \"leaf\" element for use in a flex container."]
+                                      [p "You won't often need to use it directly."]
                                       [args-table box-args-desc]]]
                           [v-box
                            :gap      "10px"


Fix non-valid docstring

Fix non-valid docstring

--- src/reagent/core.clj
+++ src/reagent/core.clj
@@ -1,9 +1,10 @@
 (ns reagent.core
   (:require [reagent.ratom :as ra]))

-(defmacro with-let [bindings & body]
+(defmacro with-let
   "Bind variables as with let, except that when used in a component
   the bindings are only evaluated once. Also takes an optional finally
   clause at the end, that is executed when the component is
   destroyed."
+  [bindings & body]
   `(ra/with-let ~bindings ~@body))


indenting

indenting

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -51,7 +51,7 @@
     (success
       {:msg msg :id id
        :job (jobs/enqueue action
-                  {:identity id :args [(assoc (p/get-system id) :system-id (Integer. id))]})})))
+              {:identity id :args [(assoc (p/get-system id) :system-id (Integer. id))]})})))

 (defroutes- jobs {:path "/job" :description "Operations on async job scheduling"}


use core/and in core.clj

use core/and in core.clj

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -585,7 +585,7 @@
         (when-not (:protocol-symbol var)
           (cljs.analyzer/warning env
             (core/str "WARNING: Symbol " p " is not a protocol")))
-        (when (and (:protocol-deprecated cljs.analyzer/*cljs-warnings*)
+        (when (core/and (:protocol-deprecated cljs.analyzer/*cljs-warnings*)
                 (-> var :deprecated)
                 (not (-> p meta :deprecation-nowarn)))
           (cljs.analyzer/warning env


wrong array-map threshold

wrong array-map threshold

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -1302,7 +1302,7 @@
 (defmacro array-map
   ([] `cljs.core.PersistentArrayMap.EMPTY)
   ([& kvs]
-    (if (core/> (count kvs) 8)
+    (if (core/> (count kvs) 16)
       `(hash-map ~@kvs)
       `(cljs.core.PersistentArrayMap.fromArray (array ~@kvs) true))))


bind *ns* to the current namespace before reading. Fixes #CLJS-74

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -112,7 +112,8 @@
              (prn nil))))))

 (defn- read-next-form []
-  (try {:status :success :form (read)}
+  (try {:status :success :form (binding [*ns* (create-ns comp/*cljs-ns*)]
+                                 (read))}
        (catch Exception e
          (println (.getMessage e))
          {:status :error})))


CLJS unify! :post-fn should run on next animation frame, not timeout 10ms.

--- src/cljs/c2/core.cljs
+++ src/cljs/c2/core.cljs
@@ -1,7 +1,7 @@
 (ns c2.core
-  (:use-macros [c2.util :only [p pp timeout]])
+  (:use-macros [c2.util :only [p pp]])
   (:use [cljs.reader :only [read-string]]
-        [c2.dom :only [select select-all node-type append! remove! children build-dom-elem merge-dom!]])
+        [c2.dom :only [select select-all node-type append! remove! children build-dom-elem merge-dom! request-animation-frame]])
   (:require [goog.dom :as gdom]
             [clojure.set :as set]
             [clojure.string :as string]))
@@ -122,7 +122,7 @@
               (append! container $new-node))))))

     ;;Run post-fn, if it was given
-    (if post-fn
+    (when post-fn
       ;;Give the browser 10 ms to get its shit together, if the post-fn involves advanced layout.
       ;;Without this delay, CSS3 animations sometimes don't happen.
-      (timeout 10 #(post-fn data)))))
+      (request-animation-frame #(post-fn data)))))


fixed storage handling

fixed storage handling

--- pigpen-cascading/src/main/clojure/pigpen/cascading.clj
+++ pigpen-cascading/src/main/clojure/pigpen/cascading.clj
@@ -15,14 +15,14 @@

 ;; TODO: there must be a better way to pass a Tap to a storage definition.
 (defn- get-tap-fn [name]
-  (let [tap ({"text" (fn [location] (Hfs. (TextLine.) location))}
+  (let [tap ({:string (fn [location] (Hfs. (TextLine.) location))}
              name)]
     (if (nil? tap)
       (throw (Exception. (str "Unrecognized tap type: " name)))
       tap)))

 (defn load-text [location]
-  (-> (raw/load$ location '[offset line] (raw/storage$ [] "text" {}) {})))
+  (-> (raw/load$ location '[offset line] :string {})))

 (defn load-tsv
   ([location] (load-tsv location "\t"))
@@ -44,7 +44,7 @@
   (-> relation
       (raw/bind$ `(rt/map->bind ~f)
                  {:args (:fields relation), :field-type-out :native})
-      (raw/store$ location (raw/storage$ [] "text" {}) {})))
+      (raw/store$ location :string {})))

 (defn store-tsv
   ([location relation] (store-tsv location "\t" relation))
@@ -87,14 +87,14 @@
 (defmethod command->flowdef :load
            [{:keys [id location storage fields opts]} flowdef]
   {:pre [id location storage fields]}
-  (update-in flowdef [:sources] (partial merge {id ((get-tap-fn (:func storage)) location)})))
+  (update-in flowdef [:sources] (partial merge {id ((get-tap-fn storage) location)})))

 (defmethod command->flowdef :store
            [{:keys [id ancestors location storage opts]} flowdef]
   {:pre [id ancestors location storage]}
   (-> flowdef
       (update-in [:pipe-to-sink] (partial merge {(first ancestors) id}))
-      (update-in [:sinks] (partial merge {id ((get-tap-fn (:func storage)) location)}))))
+      (update-in [:sinks] (partial merge {id ((get-tap-fn storage) location)}))))

 (defn- cascading-field [name-or-number]
   (if (number? name-or-number)


Extract function set-phase

Extract function set-phase


added these two facts back in - they were accidentally removed in an earlier commit

--- test/midje/midje_forms/t_dissecting.clj
+++ test/midje/midje_forms/t_dissecting.clj
@@ -85,6 +85,22 @@
        ?a | ?b | ?result
        1  | 2  | 3))

+(check-dissects-fact-table "ignores symbol - where"
+  '(tabular
+    (fact (+ ?a ?b) => ?result)
+
+      where
+       ?a  ?b  ?result
+       1   2   3))
+
+(check-dissects-fact-table "ignores keyword - :where"
+  '(tabular
+     (fact (+ ?a ?b) => ?result)
+
+      :where
+      ?a  ?b  ?result
+      1   2   3))
+
 (let [dissected (dissect-fact-table (rest '(tabular
                                          (fact (str ?a ?b) => ?result)
                                        ?a     | ?b     | ?result


flag for resetting cv-loss when starting training. (#81)

--- suite/src/cortex/suite/train.clj
+++ suite/src/cortex/suite/train.clj
@@ -128,17 +128,21 @@
    & {:keys [batch-size epoch-count
              network-filestem best-network-fn
              optimiser
+             reset-score
              force-gpu?]
       :or {batch-size 128
            network-filestem default-network-filestem
            optimiser (cortex-opt/adam)
+           reset-score false
            force-gpu? true}}]
   (resource/with-resource-context
     (let [network-filename (str network-filestem ".nippy")
           ;;Backup the trained network if we haven't already
           network (if-let [loaded-network (load-network network-filename
                                                         initial-description)]
-                    loaded-network
+                    (if reset-score
+                      (assoc loaded-network :cv-loss {})
+                      loaded-network)
                     (do
                       (backup-trained-network network-filestem)
                       (merge network


New tests: test-format-day1..test-format-day3

--- test/clj_calendar/format_datetime_test.clj
+++ test/clj_calendar/format_datetime_test.clj
@@ -126,3 +126,25 @@
               "2 months ago" (format-month 2 2)
               "2 months ago" (format-month 2 100))))

+(deftest test-format-day-1
+    "Check the function clj-calandar.format-datetime/format-day."
+    (testing "the function clj-calandar.format-datetime/format-day."
+        (are [x y] (= x y)
+              "one day ago"              (format-day 1 0))))
+
+(deftest test-format-day-2
+    "Check the function clj-calandar.format-datetime/format-day."
+    (testing "the function clj-calandar.format-datetime/format-day."
+        (are [x y] (= x y)
+              "one day and one hour ago"  (format-day 1 1)
+              "one day and 2 hours ago"   (format-day 1 2)
+              "one day and 100 hours ago" (format-day 1 100))))
+
+(deftest test-format-day-3
+    "Check the function clj-calandar.format-datetime/format-day."
+    (testing "the function clj-calandar.format-datetime/format-day."
+        (are [x y] (= x y)
+              "2 days and one hour ago"  (format-day 2 1)
+              "2 days and 2 hours ago"   (format-day 2 2)
+              "2 days and 100 hours ago" (format-day 2 100))))
+


Remove choropleth after test.

Remove choropleth after test.

--- test/integration/cljs/choropleth_test.cljs
+++ test/integration/cljs/choropleth_test.cljs
@@ -30,4 +30,6 @@
                      [:path.state {:d (geo->svg (get states state-name)
                                                 :projection proj)
                                    :stroke "black"
-                                   :fill (color-scale val)}]))))
+                                   :fill (color-scale val)}]))
+
+           (dom/remove! $svg)))


Test typo

Test typo

--- test/metabase/models/humanization_test.clj
+++ test/metabase/models/humanization_test.clj
@@ -19,7 +19,7 @@
 (expect "UUID"                        (name->human-readable-name:advanced "uuid"))
 (expect "GUID"                        (name->human-readable-name:advanced "guid"))
 (expect "IP"                          (name->human-readable-name:advanced "ip"))
-(expect "URL"                         (name->human-readable-name:advanced "URL"))
+(expect "URL"                         (name->human-readable-name:advanced "url"))
 (expect "Agent Invite Migration"      (name->human-readable-name:advanced "_agent_invite_migration"))
 (expect "Agent Invite Migration"      (name->human-readable-name:advanced "-agent-invite-migration"))
 (expect "Foo Bar"                     (name->human-readable-name:advanced "fooBar"))
@@ -46,7 +46,7 @@
 (expect "UUID"                      (name->human-readable-name:simple "uuid"))
 (expect "GUID"                      (name->human-readable-name:simple "guid"))
 (expect "IP"                        (name->human-readable-name:simple "ip"))
-(expect "URL"                       (name->human-readable-name:simple "URL"))
+(expect "URL"                       (name->human-readable-name:simple "url"))
 (expect "Agent Invite Migration"    (name->human-readable-name:simple "_agent_invite_migration"))
 (expect "Agent Invite Migration"    (name->human-readable-name:simple "-agent-invite-migration"))
 (expect "Foobar"                    (name->human-readable-name:simple "fooBar"))


DM & JC | Removed references to user-store atom in oauth controller tests

--- test/stonecutter/test/controller/oauth.clj
+++ test/stonecutter/test/controller/oauth.clj
@@ -12,7 +12,8 @@
             [stonecutter.controller.oauth :as oauth]
             [stonecutter.db.storage :as storage]
             [stonecutter.db.client :as client]
-            [stonecutter.db.user :as user])
+            [stonecutter.db.user :as user]
+            [stonecutter.db.mongo :as m])
   (:import (org.apache.commons.codec.binary Base64)))

 (background
@@ -24,19 +25,21 @@

 (facts "about authorisation end-point"
        (fact "request with client-id, response_type and redirect_uri returns redirect to login page if there is no user session"
-             (let [client-details (cl-client/register-client @storage/client-store "ClientTestApp" client-url) ;FORMAT => {:client-secret "XLFCQRKJXSV3T6YQJL5ZJJVGFUJNT6LD", :client-id "RXBX6ZXAER5KPDSZ3ZCZJDOBS27FLDE7", :name "ClientTestApp", :url "localhost:3001"}
+             (let [user-store (m/create-memory-store)
+                   client-details (cl-client/register-client @storage/client-store "ClientTestApp" client-url) ;FORMAT => {:client-secret "XLFCQRKJXSV3T6YQJL5ZJJVGFUJNT6LD", :client-id "RXBX6ZXAER5KPDSZ3ZCZJDOBS27FLDE7", :name "ClientTestApp", :url "localhost:3001"}
                    request (-> (th/create-request-with-query-string :get (routes/path :authorise)
                                                                     {:client_id     (:client-id client-details)
                                                                      :response_type "code"
                                                                      :redirect_uri  client-url})
                                (r/header "accept" "text/html"))
-                   response (oauth/authorise @storage/user-store request)]
+                   response (oauth/authorise (m/create-memory-store) request)]
                (:status response) => 302
                (-> response (get-in [:headers "Location"])) => "/sign-in"
                (-> response (get-in [:session :return-to])) => (format "/authorisation?client_id=%s&response_type=code&redirect_uri=%s" (:client-id client-details) (hiccup/url-encode client-url))))

        (fact "valid request goes to authorisation page with auth_code and email when there is an existing user session"
-             (let [user (user/store-user! @storage/user-store user-email "password")
+             (let [user-store (m/create-memory-store)
+                   user (user/store-user! user-store user-email "password")
                    client-details (cl-client/register-client @storage/client-store "MYAPP" client-url) ; NB this saves into the client store
                    access-token (cl-token/create-token @storage/token-store client-details user) ; NB this saves into the token store
                    request (-> (th/create-request-with-query-string :get (routes/path :authorise)
@@ -49,7 +52,7 @@
                                (assoc-in [:context :translator] {})
                                ;the csrf-token key in session will stop clauth from refreshing the csrf-token in request
                                (assoc-in [:session :csrf-token] "staleCSRFtoken"))
-                   response (oauth/authorise @storage/user-store request)]
+                   response (oauth/authorise user-store request)]
                (:status response) => 200
                (get-in response [:session :access_token]) => (:token access-token)
                (get response :body) => (contains "Share Profile Card")
@@ -57,7 +60,8 @@
                (get-in response [:session :csrf-token]) =not=> "staleCSRFtoken"))

        (fact "posting to authorisation endpoint redirects to callback with auth code and adds the client to the user's authorised clients"
-             (let [user (user/store-user! @storage/user-store user-email "password")
+             (let [user-store (m/create-memory-store)
+                   user (user/store-user! user-store user-email "password")
                    client-details (cl-client/register-client @storage/client-store "MYAPP" "myapp.com")
                    access-token (cl-token/create-token @storage/token-store client-details user)
                    csrf-token "CSRF-TOKEN"
@@ -68,39 +72,42 @@
                                (assoc-in [:session :csrf-token] csrf-token)
                                (assoc :content-type "application/x-www-form-urlencoded") ;To mock a form post
                                (assoc-in [:session :user-login] user-email))]
-               (oauth/authorise-client @storage/user-store request) => (contains {:status 302 :headers (contains {"Location" (contains "callback?code=")})})
+               (oauth/authorise-client user-store request) => (contains {:status 302 :headers (contains {"Location" (contains "callback?code=")})})
                (provided
-                 (user/add-authorised-client-for-user! @storage/user-store user-email anything) => ...user...)))
+                 (user/add-authorised-client-for-user! user-store user-email anything) => ...user...)))

        (fact "valid request redirects to callback with auth code when there is an existing user session and the user has previously authorised the app"
-             (let [user (user/store-user! @storage/user-store user-email "password")
+             (let [user-store (m/create-memory-store)
+                   user (user/store-user! user-store user-email "password")
                    client-details (cl-client/register-client @storage/client-store "MYAPP" "https://myapp.com")
-                   updated-user (user/add-authorised-client-for-user! @storage/user-store user-email (:client-id client-details))
+                   updated-user (user/add-authorised-client-for-user! user-store user-email (:client-id client-details))
                    access-token (cl-token/create-token @storage/token-store client-details user)
                    request (-> (th/create-request-with-query-string :get (routes/path :authorise)
                                                                     {:client_id    (:client-id client-details) :response_type "code"
                                                                      :redirect_uri "https://myapp.com/callback"})
                                (assoc-in [:session :access_token] (:token access-token))
                                (assoc-in [:session :user-login] (:login user)))
-                   response (oauth/authorise @storage/user-store request)]
+                   response (oauth/authorise user-store request)]
                (:status response) => 302
                (get-in response [:headers "Location"]) => (contains "callback?code=")))

        (fact "request to authorisation endpoint with an incorrect redirect url does not redirect to the invalid url"
-             (let [user (user/store-user! @storage/user-store user-email "password")
+             (let [user-store (m/create-memory-store)
+                   user (user/store-user! user-store user-email "password")
                    client-details (cl-client/register-client @storage/client-store "MYAPP" "https://myapp.com")
-                   updated-user (user/add-authorised-client-for-user! @storage/user-store user-email (:client-id client-details))
+                   updated-user (user/add-authorised-client-for-user! user-store user-email (:client-id client-details))
                    access-token (cl-token/create-token @storage/token-store client-details user)
                    request (-> (th/create-request-with-query-string :get (routes/path :authorise)
                                                                     {:client_id    (:client-id client-details) :response_type "code"
                                                                      :redirect_uri "https://invalidcallback.com"})
                                (assoc-in [:session :access_token] (:token access-token))
                                (assoc-in [:session :user-login] (:login user)))
-                   response (oauth/authorise @storage/user-store request)]
+                   response (oauth/authorise user-store request)]
                (:status response) =not=> 302))

        (fact "return-to session key is refreshed when accessing authorisation endpoint without being signed in"
-             (let [client-details (cl-client/register-client @storage/client-store "MYAPP" "https://myapp.com")
+             (let [user-store (m/create-memory-store)
+                   client-details (cl-client/register-client @storage/client-store "MYAPP" "https://myapp.com")
                    client-id (:client-id client-details)
                    redirect-uri "https://myapp.com/callback"
                    new-return-to-uri (->> {:uri          ...new-uri...
@@ -109,14 +116,15 @@
                                                           :response_type "code"
                                                           :redirect_uri  redirect-uri}
                                            :session      {:return-to ...old-return-to-uri...}}
-                                          (oauth/authorise @storage/user-store)
+                                          (oauth/authorise user-store)
                                           :session
                                           :return-to)]
                new-return-to-uri => (contains ...new-uri...)
                new-return-to-uri => (contains ...query-string...)))

        (fact "user-login and access_token in session stay in session if user is logged in"
-             (let [user (user/store-user! @storage/user-store user-email "password")
+             (let [user-store (m/create-memory-store)
+                   user (user/store-user! user-store user-email "password")
                    client-details (cl-client/register-client @storage/client-store "MYAPP" client-url)
                    access-token (cl-token/create-token @storage/token-store client-details user)
                    request (-> (th/create-request-with-query-string :post (routes/path :authorise) nil)
@@ -126,7 +134,7 @@
                                (assoc-in [:session :user-login] (:login user))
                                ;; stale csrf token can cause session to be lost
                                (assoc-in [:session :csrf-token] "staleCSRFtoken"))
-                   response (oauth/authorise @storage/user-store request)]
+                   response (oauth/authorise user-store request)]
                (:status response) => 302
                (get-in response [:headers "Location"]) => (contains (str client-url "?code="))
                (get-in response [:session :access_token]) => (:token access-token)
@@ -185,14 +193,15 @@
             (encode-client-info client)))

 (facts "about token endpoint"
-       (let [user (user/store-user! @storage/user-store user-email "password")
+       (let [user-store (m/create-memory-store)
+             user (user/store-user! user-store user-email "password")
              client-details (cl-client/register-client @storage/client-store "MYAPP" "http://myapp.com")
              auth-code (cl-auth-code/create-auth-code @storage/auth-code-store client-details user "http://myapp.com/callback")
              request (-> (th/create-request-with-query-string :get (routes/path :validate-token) {:grant_type   "authorization_code"
                                                                                :redirect_uri "http://myapp.com/callback"
                                                                                :code         (:code auth-code)})
                          (create-auth-header client-details))
-             response (oauth/validate-token @storage/user-store request)
+             response (oauth/validate-token user-store request)
              response-body (-> response :body (json/parse-string keyword))]

          (fact "request with grant type authorization_code and correct credentials returns access token"
@@ -214,16 +223,16 @@
        (fact "returns true if user has authorised the client"
              (->> (th/create-request-with-query-string :get (routes/path :authorise)
                                                        {:client_id ...client-id...} {:user-login ...email...})
-                  (oauth/auto-approver @storage/user-store)) => true
-             (provided
-               (user/is-authorised-client-for-user? @storage/user-store ...email... ...client-id...) => true))
+                  (oauth/auto-approver ...user-store...)) => true
+             (provided
+               (user/is-authorised-client-for-user? ...user-store... ...email... ...client-id...) => true))

        (fact "returns false if user has not authorised the client"
              (->> (th/create-request-with-query-string :get (routes/path :authorise)
                                                        {:client_id ...client-id...} {:user-login ...email...})
-                  (oauth/auto-approver @storage/user-store)) => false
-             (provided
-               (user/is-authorised-client-for-user? @storage/user-store ...email... ...client-id...) => false)))
+                  (oauth/auto-approver ...user-store...)) => false
+             (provided
+               (user/is-authorised-client-for-user? ...user-store... ...email... ...client-id...) => false)))

 (facts "about is-redirect-uri-valid?"


DM + CW | techtask | test that return-to uri is updated when signing in from app

--- test/stonecutter/test/controller/oauth.clj
+++ test/stonecutter/test/controller/oauth.clj
@@ -104,6 +104,22 @@
                    response (oauth/authorise request)]
                (:status response) =not=> 302))

+       (fact "return-to session key is refreshed when accessing authorisation endpoint without being signed in"
+             (let [client-details (cl-client/register-client "MYAPP" "https://myapp.com")
+                   client-id (:client-id client-details)
+                   redirect-uri "https://myapp.com/callback"
+                   new-return-to-uri (-> {:uri ...new-uri...
+                                          :query-string ...query-string...
+                                          :params {:client_id client-id
+                                                   :response_type "code"
+                                                   :redirect_uri redirect-uri}}
+                                         (assoc :session {:return-to ...old-return-to-uri...})
+                                         oauth/authorise
+                                         :session
+                                         :return-to)]
+               new-return-to-uri => (contains ...new-uri...)
+               new-return-to-uri => (contains ...query-string...)))
+
        (fact "user-login and access_token in session stay in session if user is logged in"
              (let [user (user/store-user! user-email "password")
                    client-details (cl-client/register-client "MYAPP" client-url)


Fix test requirements

Fix test requirements

--- common-lib/test/cmr/common/test/api/errors.clj
+++ common-lib/test/cmr/common/test/api/errors.clj
@@ -1,9 +1,6 @@
-(ns cmr.common.test.api.web-server
-  "This tests capabilities of the web server component."
+(ns cmr.common.test.api.errors
+  "This tests capabilities of the API error utilities."
   (:require
-   [clj-http.client :as h]
-   [clojure.java.io :as io]
-   [clojure.string :as str]
    [clojure.test :refer :all]
    [cmr.common.api.errors :as errors]))


[#2246] Log error when there is an email missmatch

--- backend/src/akvo/lumen/component/keycloak.clj
+++ backend/src/akvo/lumen/component/keycloak.clj
@@ -235,12 +235,20 @@
 (defn change-names
   [{:keys [api-root] :as keycloak} tenant claims user-id first-name last-name]
   (let [headers (request-headers keycloak)
-        keycloak-user (fetch-user-by-id headers api-root tenant user-id)]
-    (if (= (get keycloak-user "email") (get claims "email"))
+        keycloak-user (fetch-user-by-id headers api-root tenant user-id)
+        keycloak-user-email (get keycloak-user "email")
+        claims-user-email (get claims "email")]
+    (if (= keycloak-user-email claims-user-email)
       (if (= (patch-names headers api-root user-id first-name last-name) 204)
         (lib/ok (fetch-user-by-id headers api-root tenant user-id))
-        (lib/bad-request {:id user-id
-                          :error "Could not update name"}))
+        (let [log-data {:jwt-claims-email claims-user-email
+                        :keycloak-user-email keycloak-user-email
+                        :tenant tenant
+                        :user user-id}]
+          (log/error ::change-names-email-missmatch
+                     "Email from Keycloak and JWT claims did not match" log-data)
+          (lib/bad-request {:id user-id
+                            :error "Could not update name"})))
       (lib/not-authorized {:id user-id
                            :message "Email missmatch"}))))


getting the Pulse api unit tests going.

getting the Pulse api unit tests going.

--- test/metabase/api/pulse_test.clj
+++ test/metabase/api/pulse_test.clj
@@ -26,57 +26,17 @@
     :dataset_query          {}
     :visualization_settings {}))

-(defn new-pulse []
-  (let [cards    [(new-card), (new-card)]
+(defn new-pulse [& {:keys [name cards channels]
+                    :or   {name     (random-name)
+                           cards    nil
+                           channels nil}}]
+  (let [cards    (or cards [(new-card), (new-card)])
         card-ids (filter identity (map :id cards))]
-    (pulse/create-pulse (random-name) (user->id :crowberto) card-ids [])))
-
-;; ## GET /api/emailreport/form_input
-;; Test that we can get the form input options for the Test Org
-;(expect-let [_ @test-db ; force lazy loading of Test Data / Metabase DB
-;             _ (cascade-delete Database :name [not= "Test Database"])] ; Delete all Databases that aren't the Test DB
-;  {:users #{{:id (user->id :rasta),     :name "Rasta Toucan"}
-;            {:id (user->id :crowberto), :name "Crowberto Corv"}
-;            {:id (user->id :lucky),     :name "Lucky Pigeon"}
-;            {:id (user->id :trashbird), :name "Trash Bird"}}
-;   :databases [{:id (:id @test-db)
-;                :name "Test Database"}],
-;   :timezones ["GMT"
-;               "UTC"
-;               "US/Alaska"
-;               "US/Arizona"
-;               "US/Central"
-;               "US/Eastern"
-;               "US/Hawaii"
-;               "US/Mountain"
-;               "US/Pacific"
-;               "America/Costa_Rica"]
-;   :times_of_day [{:id "morning",   :realhour 8,  :name "Morning"}
-;                  {:id "midday",    :realhour 12, :name "Midday"}
-;                  {:id "afternoon", :realhour 16, :name "Afternoon"}
-;                  {:id "evening",   :realhour 20, :name "Evening"}
-;                  {:id "midnight",  :realhour 0,  :name "Midnight"}]
-;   :days_of_week [{:id "sun", :name "Sun"}
-;                  {:id "mon", :name "Mon"}
-;                  {:id "tue", :name "Tue"}
-;                  {:id "wed", :name "Wed"}
-;                  {:id "thu", :name "Thu"}
-;                  {:id "fri", :name "Fri"}
-;                  {:id "sat", :name "Sat"}]
-;   :modes [{:name "Active", :id 1}
-;           {:name "Disabled", :id 2}]
-;   :permissions [{:name "None",         :id 0}
-;                 {:name "Read Only",    :id 1}
-;                 {:name "Read & Write", :id 2}]}
-;  (-> ((user->client :rasta) :get 200 "emailreport/form_input" :org @org-id) ; convert to a set so test doesn't fail if order differs
-;        (update-in [:users] set)))
-
-;; ## /api/pulse/* AUTHENTICATION Tests
-;; We assume that all endpoints for a given context are enforced by the same middleware, so we don't run the same
-;; authentication test on every single individual endpoint
-
-(expect (get middleware/response-unauthentic :body) (http/client :get 401 "pulse"))
-(expect (get middleware/response-unauthentic :body) (http/client :put 401 "pulse/13"))
+    (pulse/create-pulse name (user->id :crowberto) card-ids [])))
+
+(defn delete-existing-pulses []
+  (->> (db/sel :many :field [Pulse :id])
+       (mapv #(db/cascade-delete Pulse :id %))))

 (defn user-details [user]
   (match-$ user
@@ -112,9 +72,9 @@
      :created_at   $
      :updated_at   $
      :creator_id   $
-     :creator      (user-details @(:creator pulse))
-     :cards        (mapv pulse-card-details @(:cards pulse))
-     :channels     (mapv pulse-channel-details @(:channels pulse))}))
+     :creator      (user-details (:creator pulse))
+     :cards        (mapv pulse-card-details (:cards pulse))
+     :channels     (mapv pulse-channel-details (:channels pulse))}))

 (defn pulse-response [{:keys [created_at updated_at] :as pulse}]
   (-> pulse
@@ -123,6 +83,14 @@
       (assoc :updated_at (not (nil? updated_at)))))

+;; ## /api/pulse/* AUTHENTICATION Tests
+;; We assume that all endpoints for a given context are enforced by the same middleware, so we don't run the same
+;; authentication test on every single individual endpoint
+
+(expect (get middleware/response-unauthentic :body) (http/client :get 401 "pulse"))
+(expect (get middleware/response-unauthentic :body) (http/client :put 401 "pulse/13"))
+
+
 ;; ## POST /api/pulse

 (expect {:errors {:name "field is a required param."}}
@@ -158,21 +126,41 @@
   {:name         "A Pulse"
    :public_perms common/perms-readwrite
    :creator_id   (user->id :rasta)
+   :creator      (user-details (fetch-user :rasta))
    :created_at   true
    :updated_at   true
-   :cards        (into [] (map pulse-card-details [card1 card2]))}
-  (pulse-response ((user->client :rasta) :post 200 "pulse" {:name     "A Pulse"
-                                                            :cards    [{:id (:id card1)} {:id (:id card2)}]
-                                                            :channels [{:channel_type  "email"
-                                                                        :schedule_type "daily"}]})))
+   :cards        (mapv pulse-card-details [card1 card2])
+   :channels     [{:channel_type  "email"
+                   :schedule_type "daily"
+                   :schedule_hour 12
+                   :schedule_day  nil
+                   :details       {}
+                   :recipients    []}]}
+  (-> (pulse-response ((user->client :rasta) :post 200 "pulse" {:name     "A Pulse"
+                                                                :cards    [{:id (:id card1)} {:id (:id card2)}]
+                                                                :channels [{:channel_type  "email"
+                                                                            :schedule_type "daily"
+                                                                            :schedule_hour 12
+                                                                            :schedule_day  nil
+                                                                            :recipients    []}]}))
+      (update :channels (fn [chans]
+                          (mapv #(dissoc % :id :pulse_id :created_at :updated_at) chans)))))

 ;; ## GET /api/pulse

-(expect-let [pulse1 (new-pulse)
-             ;pulse2 (new-pulse)
-             ]
-  [(pulse-details pulse1)]
+(expect-let [_      (delete-existing-pulses)
+             pulse1 (new-pulse :name "ABC")
+             pulse2 (new-pulse :name "DEF")]
+  [(pulse-details pulse1)
+   (pulse-details pulse2)]
   ((user->client :rasta) :get 200 "pulse"))
+
+
+;; ## GET /api/pulse/:id
+
+(expect-let [pulse1 (new-pulse)]
+  (pulse-details pulse1)
+  ((user->client :rasta) :get 200 (format "pulse/%d" (:id pulse1))))

 ;(expect-eval-actual-first
 ;    (match-$ (sel :one EmailReport (order :id :DESC))


Fixed up event component shutdown.

Fixed up event component shutdown.

--- src/dragon/components/event.clj
+++ src/dragon/components/event.clj
@@ -20,7 +20,8 @@

   (stop [component]
     (log/info "Stopping event component ...")
-    (event/delete (get-in component component-api/dataflow-keys))
+    (if-let [pubsub-dataflow (get-in component component-api/dataflow-keys)]
+      (event/delete pubsub-dataflow))
     (let [component (assoc-in component component-api/dataflow-keys nil)]
       (log/debug "Stopped event component.")
       component)))


Change view on click

Change view on click

--- src/discuss/find.cljs
+++ src/discuss/find.cljs
@@ -51,7 +51,7 @@
                (dom/span #js {:className "badge pull-right"}
                          (lib/str->int (:distance data)))
                (dom/div nil (dom/a #js {:href    "javascript:void(0)"
-                                        :onClick #(com/ajax-get (:url data))}
+                                        :onClick #(com/ajax-get-and-change-view (:url data) :default)}
                                    (vlib/safe-html (:text data))))))))

 (defn- issue-selector-view


Add some missing doc strings.

Add some missing doc strings.

--- src/fcms/resources/taxonomy.clj
+++ src/fcms/resources/taxonomy.clj
@@ -167,7 +167,9 @@
     (zip-ordered-map (map :slug categories) (map category-from-map categories)))

 (defn- new-categories [slugs category-name]
-  ""
+  "Create the new portion of a category path as an ordered-map (:name, :slug, :categories) of the slugs in
+  a vector with each subsequent slug being a child of the prior slug,
+  keyed by :categories, and the final slug getting the provided category-name."
   (let [slug (first slugs)
         tail (rest slugs)]
     (if (empty? tail)
@@ -177,7 +179,7 @@
 (declare vectorize-category-slugs)

 (defn- categories-vector-from-map [m]
-  ""
+  "Replace the hash map of categories at the :categories key with a vector of categories"
   (if-let [categories (:categories m)]
     (assoc m :categories (vectorize-category-slugs categories))
     m))
@@ -188,7 +190,9 @@
   (vec (map categories-vector-from-map (vec (vals categories)))))

 (defn- create-categories
-  ""
+  "Given a category name, a vector of the slugs of a desired category path,
+  and the categories that already exist in the taxonomy, add the portions of the
+  desired category path that don't already exist."
   ([category-name category-slugs categories]
     (vectorize-category-slugs (create-categories category-name [] category-slugs (hash-category-slugs categories))))


Fix bug where BNode's didn't handle equality on other types

--- src/grafter_2/rdf/protocols.clj
+++ src/grafter_2/rdf/protocols.clj
@@ -338,7 +338,9 @@
 (deftype BNode [id]
   Object
   (equals [this other]
-    (= (.id this) (.id other)))
+    (if (instance? BNode other)
+      (= (.id this) (.id other))
+      false))
   (hashCode [this]
     (hash (.id this)))


Focus management #38

Focus management #38

--- src/flatgui/focus.clj
+++ src/flatgui/focus.clj
@@ -17,14 +17,23 @@
            (java.util Comparator)))

-(defn accepts-focus? [component]
-  (or
-    ;; If the component is focusable itself
-    (:focusable component)
-    ;; If the component has any child to which it can pass focus
-    (some (fn [[_ c]] (accepts-focus? c)) (:children component))))
-
-(defn- get-accepting-children [child-map] (filter accepts-focus? (for [[_ v] child-map] v)))
+(fg/defevolverfn accepts-focus-evolver :accepts-focus?
+  (and
+    (get-property component [:this] :visible)
+    (get-property component [:this] :enabled)
+    (or
+      ;; If the component is focusable itself
+      (get-property component [:this] :focusable)
+      ;; If the component has any child to which it can pass focus
+      (some
+        (fn [[_ c]] (get-property component [:this (:id c)] :accepts-focus?))
+        (get-property component [:this] :children)))))
+
+(fg/defaccessorfn get-accepting-children [component]
+  (let [child-map (get-property component [:this] :children)]
+    (filter
+      (fn [c] (get-property component [:this (:id c)] :accepts-focus?))
+      (for [[_ v] child-map] v))))

 (def component-comparator
   (reify Comparator
@@ -36,7 +45,7 @@

 (defn- sort-lines [lines] (map (fn [l] (sort component-comparator l)) lines))

-(defn- group-by-lines [accepting-children]
+(fg/defaccessorfn group-by-lines [component accepting-children]
   (let [cnt (count accepting-children)]
     (loop [line-y1 []
            line-y2 []
@@ -44,7 +53,7 @@
            i 0]
       (if (< i cnt)
         (let [c (nth accepting-children i)
-              cy (m/mx-y (:position-matrix c))
+              cy (m/mx-y (get-property component [:this (:id c)] :position-matrix))
               line-index (if-let [matching (some
                                              #(if (<= (nth line-y1 %) cy (nth line-y2 %)) %)
                                              (range 0 (count lines)))]
@@ -52,7 +61,7 @@
                            (count lines))
               existing-line (< line-index (count lines))
               line (if existing-line (nth lines line-index) #{})
-              cy2 (+ cy (m/y (:clip-size c)))]
+              cy2 (+ cy (m/y (get-property component [:this (:id c)] :clip-size)))]
           (recur
             (if existing-line line-y1 (assoc line-y1 line-index cy))
             (assoc line-y2 line-index (if existing-line (max cy2 (nth line-y2 line-index)) cy2))
@@ -63,38 +72,37 @@
 ;;; Sorts focusable components so that they are traversed in left->right, up->down direction.
 ;;; To make such ad order, arranges components in a vector of horizontal "lines"
 (fg/defevolverfn :focus-traversal-order
-  (let [accepting-children (get-accepting-children (get-property [:this] :children))]
+  (let [accepting-children (get-accepting-children component)]
     (if (pos? (count accepting-children))
-      (let [lines (group-by-lines accepting-children)]
-        (mapcat (fn [i] (map :id (nth lines i))) (range 0 (count lines))))
+      (let [lines (group-by-lines component accepting-children)
+            result (mapcat (fn [i] (map :id (nth lines i))) (range 0 (count lines)))]
+        result)
       [])))

-(defn get-child-ids-in-traversal-order [component]
-  (if-let [focus-traversal-order (:focus-traversal-order component)]
+(fg/defaccessorfn get-child-ids-in-traversal-order [component]
+  (if-let [focus-traversal-order (get-property component [:this] :focus-traversal-order)]
     focus-traversal-order
-    (let [accepting-children (get-accepting-children (:children component))]
+    (let [accepting-children (get-accepting-children component)]
       (mapv :id accepting-children))))

-(defn get-in-cycle
-  ([component dir c-id]
-    (let [child-ids (get-child-ids-in-traversal-order component)
-          child-count (count child-ids)
-          closed (:closed-focus-root component)
-          cycle-keeper (fn [i]
-                         (cond
-                           (>= i child-count) (if closed 0)
-                           (< i 0) (if closed (dec child-count))
-                           :else i))
-          index-of-c (if c-id (.indexOf child-ids c-id))]
-      (cond
-        (= child-count 0) nil
-        (and (= child-count 1) closed) (nth child-ids 0)
-        :else (case dir
-                :next (if-let [new-index (cycle-keeper (inc index-of-c))] (nth child-ids new-index))
-                :prev (if-let [new-index (cycle-keeper (dec index-of-c))] (nth child-ids new-index))
-                :first (nth child-ids 0)
-                :last (nth child-ids (dec child-count))))))
-  ([component dir] (get-in-cycle component dir nil)))
+(fg/defaccessorfn get-in-cycle [component dir c-id]
+  (let [child-ids (get-child-ids-in-traversal-order component)
+        child-count (count child-ids)
+        closed (:closed-focus-root component)
+        cycle-keeper (fn [i]
+                       (cond
+                         (>= i child-count) (if closed 0)
+                         (< i 0) (if closed (dec child-count))
+                         :else i))
+        index-of-c (if c-id (.indexOf child-ids c-id))]
+    (cond
+      (= child-count 0) nil
+      (and (= child-count 1) closed) (nth child-ids 0)
+      :else (case dir
+              :next (if-let [new-index (cycle-keeper (inc index-of-c))] (nth child-ids new-index))
+              :prev (if-let [new-index (cycle-keeper (dec index-of-c))] (nth child-ids new-index))
+              :first (nth child-ids 0)
+              :last (nth child-ids (dec child-count))))))

 (def clean-state {:mode :none
                   :focused-child nil})
@@ -179,7 +187,8 @@
                                                        ;; in :throw-mode - use it to determine firt or last
                                                        (if (= :prev (:throw-mode parent-focus-state))
                                                          :last
-                                                         :first))))]
+                                                         :first)
+                                                       nil)))]
                                  (focus-child-by-direction child-id (:throw-mode parent-focus-state))
                                  having-focus-state)
                                ;; No change in state but track focus movent direction


Minor text edits to call queue

Minor text edits to call queue

--- src/hphelper/frontend/play.cljs
+++ src/hphelper/frontend/play.cljs
@@ -1480,18 +1480,19 @@
        (if @expand-atom
          [:div {:class ""}
           (shared/tutorial-text
-            "Text goes here"
+            "Here is a list of waiting calls. The top call is the latest call waiting.
+            Pressing the 'call' button on bought (or created) minions queue or replace your current call."
             )
           [admin-call-component]
           [:table {:class "table table-striped table-hover"}
-           [:tr [:td "owner"] [:td "sg"] [:td "Minion"]]
+           [:tr [:td "Owner"] [:td "SG"] [:td "Clearance"] [:td "Minion Name"]]
            (doall (map (fn [{:keys [owner sg_abbr minion_id]}]
                          (let [m (->> sg_abbr get-sg :minions (some #(if (= minion_id (:minion_id %)) % nil)))]
                            [:tr
                             [:td owner]
                             [:td sg_abbr]
+                            [:td (:minion_clearance m)]
                             [:td (:minion_name m)]
-                            [:td (:minion_clearance m)]
                             ]))
                        (-> @game-atom :calls)))
            ]


new: all-words, random-word, random-words

--- src/hangman/words.clj
+++ src/hangman/words.clj
@@ -31,7 +31,7 @@
 ;; Global State
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(def db (atom nil))
+(def word-db (atom nil))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -41,7 +41,7 @@
 ;; TODO: this is somewhat ugly.

 (defn word-triples [word]
-  (set (conj
+  (set (concat
          (map #(apply tuple %)
            (apply concat
              (for [c (map char (range (int \A) (inc (int \Z))))
@@ -49,7 +49,9 @@
                (if (empty? posns)
                  (list (list word c -1))
                  (map #(conj (list c %) word) posns)))))
-         (tuple word :length (count word)))))
+         [(tuple word :length (count word))
+          (tuple word :type   :WORD)]
+         )))

 ;; (word-triples "abccddd")

@@ -57,15 +59,13 @@
   (r/fold clojure.set/union clojure.set/union
     (mapv word-triples coll)))

-;; (corpus/with-corpus []
-;;   (count (word-collection-triples (:all-words corpus/*corpus*))))
-
+
 (defn file-triples [filename]
   (r/fold clojure.set/union clojure.set/union
-    (mapv word-triples (corpus/words-from-file filename))))
+    (mapv word-triples (words-from-file filename))))

 ;; (util/run-and-measure-timing
-;;   (count (file-triples corpus/+default-corpus-file+)))
+;;   (count (file-triples +default-corpus-file+)))
 ;;
 ;;  => {:response         4511728,
 ;;      :start-time 1401197847802,
@@ -76,24 +76,24 @@
 ;; Database Management
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn set-graph! [graph]
-  (swap! db (constantly graph)))
-
-(defn clear-db! []
+(defn set-word-db! [graph]
+  (swap! word-db (constantly graph)))
+
+(defn clear-word-db! []
   (set-graph! nil))

-(defn build-db!
+(defn build-word-db!
   ([]
-     (build-db! +default-corpus-file+))
+     (build-word-db! +default-corpus-file+))
   ([filename]
-     (set-graph! (make-graph (file-triples filename)))
-     @db))
+     (set-word-db! (make-graph (file-triples filename)))
+     @word-db))

 ;;;
 ;;  These are the actual "top-level" database API functions which are pleasantly
 ;; trivial to implement using the facilities we have created for parsing and
 ;; graph construction.  Primarily, these are responsible for atomic interaction
-;; with global state, which is limited to only the single var 'db'.
+;; with global state, which is limited to only the single atom 'word-db'.
 ;;

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -101,12 +101,12 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defn words-of-length [graph length]
-  (set (map s (query graph nil :length length))))
-
-
-;; (util/run-and-measure-timing
-;;   (words-of-length @db 2))
+(defn words-of-length [g length]
+  (set (map s (query g nil :length length))))
+
+
+;; (util/run-and-measure-timing
+;;   (words-of-length @word-db 2))
 ;;
 ;;   =>  {:response #{"PE" "EN" "UH" "SI" "IT" "PI" "FA" "MY" "AM" "BI" "YO"
 ;;     "MU" "LI" "NU" "AY" "AH" "IF" "HO" "AX" "OD" "NE" "ON" "OW" "EX" "ME"
@@ -120,27 +120,48 @@
 ;;        :end-time   1401743282516,
 ;;        :time-taken 0}

-(defn words-excluding-letter [graph letter]
-  (set (map s (query graph nil letter -1))))
-
-(defn words-excluding [graph & letters]
+(defn words-excluding-letter [g letter]
+  (set (map s (query g nil letter -1))))
+
+(defn words-excluding [g & letters]
   (apply clojure.set/intersection
     (filter identity
-      (map (partial words-excluding-letter graph) letters))))
-
-(defn words-with-letter-position [graph letter position]
-  (set (map s (query graph nil letter position))))
-
-
-;; (util/run-and-measure-timing
-;;   (words-excluding @db \A ))
-
-
+      (map (partial words-excluding-letter g) letters))))
+
+(defn words-with-letter-position [g letter position]
+  (set (map s (query g nil letter position))))
+
+(defn all-words [g]
+  (mapv s (query g nil :type :WORD)))
+
+(defn random-element [coll]
+  (nth coll (rand-int (count coll))))
+
+(defn random-word [g]
+  (random-element (all-words g)))
+
+(defn random-words [g n]
+  (loop [words #{} all (all-words g)]
+    (if (= (count words) n)
+      words
+      (recur (conj words (random-element all)) all))))
+
+
+
+
+;; (util/run-and-measure-timing
+;;   (random-word @word-db))
+
+;; (util/run-and-measure-timing
+;;   (random-words @word-db 10))
+
+;; (util/run-and-measure-timing
+;;   (words-excluding @word-db \A ))

 ;; (util/run-and-measure-timing
 ;;   (clojure.set/intersection
-;;     (words-of-length @db 3)
-;;     (words-excluding @db \A \E \I \O)
+;;     (words-of-length @word-db 3)
+;;     (words-excluding @word-db \A \E \I \O)
 ;;     ))
 ;;
 ;;   => {:response #{"GUY" "MUM" "URD" "JUG" "NTH" "HUP" "RUG" "PUR"
@@ -162,9 +183,9 @@

 ;; (util/run-and-measure-timing
 ;;   (clojure.set/intersection
-;;     (words-of-length @db 3)
-;;     (words-excluding @db \A \E \I \O)
-;;     (words-with-letter-position @db \F 0)
+;;     (words-of-length @word-db 3)
+;;     (words-excluding @word-db \A \E \I \O)
+;;     (words-with-letter-position @word-db \F 0)
 ;;     ))
 ;;
 ;;  => {:response #{"FRY" "FLY" "FUG" "FUD" "FLU" "FUN" "FUB" "FUR"},
@@ -175,10 +196,10 @@

 ;; (util/run-and-measure-timing
 ;;   (clojure.set/intersection
-;;     (words-of-length @db 3)
-;;     (words-excluding @db \A \E \I \O)
-;;     (words-with-letter-position @db \F 0)
-;;     (words-with-letter-position @db \U 1)
+;;     (words-of-length @word-db 3)
+;;     (words-excluding @word-db \A \E \I \O)
+;;     (words-with-letter-position @word-db \F 0)
+;;     (words-with-letter-position @word-db \U 1)
 ;;     ))
 ;;
 ;;  => {:response #{"FUG" "FUD" "FUN" "FUB" "FUR"},


during creation the provider assigns the ip

--- src/hooks/dnsmasq.clj
+++ src/hooks/dnsmasq.clj
@@ -12,6 +12,7 @@
 (ns hooks.dnsmasq
   "A basic dnsmasq registration api for static addresses using hosts file,
    expects an Ubuntu and dnsmasq on the other end "
+  (:require [celestial.persistency :as p])
   (:use
     [clojure.core.strint :only (<<)]
     [supernal.sshj :only (execute)]))
@@ -22,18 +23,24 @@
 (def restart
   "sudo service dnsmasq stop && sudo service dnsmasq start")

+
 (defn add-host
-  "Will add host to hosts file only if missing"
-  [{:keys [dnsmasq user domain machine]}]
-  (let [remote {:host dnsmasq :user user} {:keys [hostname ip]} machine
+  "Will add host to hosts file only if missing,
+   note that we p/get-system since the provider might updated the system during create."
+  [{:keys [dnsmasq user domain system-id]}]
+  (let [remote {:host dnsmasq :user user}
+        {:keys [hostname ip]} (:machine (p/get-system system-id))
         hostline (<< "'~{ip} ~{hostname} ~{hostname}.~{domain}'")]
     (execute
       (<< "grep -q ~{hostline} /etc/hosts || (echo ~{hostline} | sudo tee -a /etc/hosts >> /dev/null)") remote)
     (execute restart remote)))

-(defn remove-host [{:keys [dnsmasq user domain machine]}]
-  (let [remote {:host dnsmasq :user user} {:keys [hostname ip]} machine
+(defn remove-host
+  "Removes host,
+   here we use the original machine since the last step in destroy is clearing the system"
+  [{:keys [dnsmasq user domain machine]}]
+  (let [remote {:host dnsmasq :user user} {:keys [hostname ip]} machine
         hostline (<< "~{ip} ~{hostname} ~{hostname}.~{domain}")]
     (execute (<< "sudo sed -ie \"\\|^~{hostline}\\$|d\" /etc/hosts") remote)
     (execute restart remote)))


bump some dep versions

bump some dep versions


analyze-ns returns the ASTs

analyze-ns returns the ASTs

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -310,4 +310,5 @@
                       (swap! *env* update-in [::analyzed-cljs path]
                              (fnil conj [])
                              (analyze form (assoc env :ns *ns*)))
-                      (recur))))))))))))
+                      (recur))))))))
+        (get-in @*env* [::analyzed-cljs path])))))


[l.d.compile] Don't expect c.j.i to be required

--- src/leiningen/droid/compile.clj
+++ src/leiningen/droid/compile.clj
@@ -33,10 +33,11 @@
   (.mkdirs (io/file assets-gen-path))
   (eval-in-project
    project
-   `(spit (io/file ~assets-gen-path "data_readers.clj")
-          (into {} (map (fn [[k# v#]]
-                          [k# (symbol (subs (str v#) 2))])
-                        *data-readers*)))))
+   `(do (require 'clojure.java.io)
+        (spit (clojure.java.io/file ~assets-gen-path "data_readers.clj")
+              (into {} (map (fn [[k# v#]]
+                              [k# (symbol (subs (str v#) 2))])
+                            clojure.core/*data-readers*))))))

 ;; ### Compilation


Revert "Merge pull request #1080 from circleci/jcEventsFireOnSuccess"

This reverts commit e682f3cd3be2529db77257e04b4a5f2b5935e4dd, reversing
changes made to 2064f2a6fb3b883d2a965913352cdd46bd197a40.

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -73,18 +73,16 @@
 (defn button-ajax
   "An ajax/ajax wrapper that releases the current managed-button after the API
   request.  Exists to faciliate migration away from stateful-button."
-  [method url message channel & {:keys [context params events] :as opts}]
+  [method url message channel & opts]
   (let [uuid frontend.async/*uuid*
         c (chan)]
     (apply ajax/ajax method url message c opts)
     (go-loop []
-             (when-let [[_ status _ :as event] (<! c)]
-               (when-let [track-event (-> opts :events status)]
-                 (track-event))
-               (when (#{:success :failed} status)
-                 (release-button! uuid status))
-               (>! channel event)
-               (recur)))))
+      (when-let [[_ status _ :as event] (<! c)]
+        (when (#{:success :failed} status)
+          (release-button! uuid status))
+        (>! channel event)
+        (recur)))))

 ;; --- Navigation Multimethod Declarations ---

@@ -462,11 +460,11 @@
                  :follow-repo
                  api-ch
                  :params {:vcs-type (:vcs_type repo)}
-                 :context repo
-                 :events {:success #(analytics/track {:event-type :project-followed
-                                                      :current-state current-state
-                                                      :properties {:org org-name
-                                                                   :repo repo-name}})})))
+                 :context repo)
+    (analytics/track {:event-type :project-followed
+                      :current-state current-state
+                      :properties {:org org-name
+                                   :repo repo-name}})))

 (defmethod control-event :inaccessible-org-toggled
@@ -485,11 +483,11 @@
                  (gstring/format "/api/v1/project/%s/follow" project)
                  :follow-project
                  api-ch
-                 :context {:project-id project-id}
-                 :events {:success #(analytics/track {:event-type :project-followed
-                                                     :current-state current-state
-                                                     :properties {:org org-name
-                                                                  :repo repo-name}})})))
+                 :context {:project-id project-id})
+    (analytics/track {:event-type :project-followed
+                      :current-state current-state
+                      :properties {:org org-name
+                                   :repo repo-name}})))

 (defmethod post-control-event! :unfollowed-repo
@@ -505,11 +503,11 @@
                  :unfollow-repo
                  api-ch
                  :params {:vcs-type (:vcs_type repo)}
-                 :context repo
-                 :events {:success #(analytics/track {:event-type :project-unfollowed
-                                                      :current-state current-state
-                                                      :properties {:org org-name
-                                                                   :repo repo-name}})})))
+                 :context repo)
+    (analytics/track {:event-type :project-unfollowed
+                      :current-state current-state
+                      :properties {:org org-name
+                                   :repo repo-name}})))

 (defmethod post-control-event! :unfollowed-project
@@ -524,11 +522,11 @@
                  :unfollow-project
                  api-ch
                  :params {:vcs-type (:vcs_type repo)}
-                 :context {:project-id project-id}
-                 :events {:success #(analytics/track {:event-type :project-unfollowed
-                                                      :current-state current-state
-                                                      :properties {:org org-name
-                                                                   :repo repo-name}})})))
+                 :context {:project-id project-id})
+    (analytics/track {:event-type :project-unfollowed
+                      :current-state current-state
+                      :properties {:org org-name
+                                   :repo repo-name}})))

 (defmethod post-control-event! :stopped-building-project
   [target message {:keys [vcs-url project-id]} previous-state current-state]
@@ -541,11 +539,11 @@
                  (gstring/format "/api/v1/project/%s/enable" project)
                  :stop-building-project
                  api-ch
-                 :context {:project-id project-id}
-                 :events {:success #(analytics/track {:event-type :project-builds-stopped
-                                                      :current-state current-state
-                                                      :properties {:org org-name
-                                                                   :repo repo-name}})})))
+                 :context {:project-id project-id})
+    (analytics/track {:event-type :project-builds-stopped
+                      :current-state current-state
+                      :properties {:org org-name
+                                   :repo repo-name}})))

 ;; XXX: clean this up
 (defmethod post-control-event! :container-parent-scroll


delete ui-id and ui-target if they're empty

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -1453,11 +1453,25 @@
   [browser-state message _ state]
   (handle-layer-properties-submitted state))

-(defn handle-layer-properties-submitted-after [current-state]
-  (let [db (:db current-state)]
-    (d/transact! db [(utils/remove-map-nils
-                      (select-keys (get-in current-state [:layer-properties-menu :layer])
-                                   [:db/id :layer/ui-id :layer/ui-target]))])))
+(def sentinel (js-obj))
+
+(defn handle-layer-properties-submitted-after
+  "Saves ui-id and ui-target. Retracts old values if new values are nil. Retraction is racy."
+  [current-state]
+  (let [db (:db current-state)
+        layer (get-in current-state [:layer-properties-menu :layer])
+        new-id (:layer/ui-id layer sentinel)
+        new-target (:layer/ui-target layer sentinel)]
+    (d/transact! db (concat (when (not (identical? new-id sentinel))
+                              (if (nil? new-id)
+                                (when-let [old-id (:layer/ui-id (d/entity @db (:db/id layer)))]
+                                  [[:db/retract (:db/id layer) :layer/ui-id old-id]])
+                                [[:db/add (:db/id layer) :layer/ui-id new-id]]))
+                            (when (not (identical? new-target sentinel))
+                              (if (nil? new-target)
+                                (when-let [old-target (:layer/ui-target (d/entity @db (:db/id layer)))]
+                                  [[:db/retract (:db/id layer) :layer/ui-target old-target]])
+                                [[:db/add (:db/id layer) :layer/ui-target new-target]]))))))

 (defmethod post-control-event! :layer-properties-submitted
   [browser-state message _ previous-state current-state]


CMR-4549 addresses pr comments

CMR-4549 addresses pr comments

--- umm-lib/src/cmr/umm/related_url_helper.clj
+++ umm-lib/src/cmr/umm/related_url_helper.clj
@@ -32,9 +32,8 @@
 (defn documentation-url?
   "Returns true if the related-url is documentation url"
   [related-url]
-  (let [mime-type (:mime-type related-url)]
-    (when (seq mime-type)
-      (some #{(string/lower-case mime-type)} DOCUMENTATION_MIME_TYPES))))
+  (when-let [mime-type (:mime-type related-url)]
+    (some #{(string/lower-case mime-type)} DOCUMENTATION_MIME_TYPES)))

 (defn documentation-urls
   "Returns the related-urls that are documentation urls"


Always add board-slug and board-name properties when rendering an entry.

--- src/oc/storage/representations/entry.clj
+++ src/oc/storage/representations/entry.clj
@@ -105,9 +105,7 @@
         board-uuid (:uuid board)
         board-slug (:slug board)
         draft? (= :draft (keyword (:status entry)))
-        full-entry (if draft?
-                      (merge {:board-slug (:slug board) :board-name (:name board)} entry)
-                      entry)
+        full-entry (merge {:board-slug board-slug :board-name (:name board)} entry)
         reaction-list (if (= access-level :public)
                         []
                         (content/reactions-and-links org-uuid board-uuid entry-uuid reactions user-id))
@@ -155,8 +153,7 @@
           ;; "stand-alone", so include extra props
           (-> org
             (clojure.set/rename-keys org-prop-mapping)
-            (merge full-entry)
-            (assoc :board-slug board-slug))
+            (merge full-entry))
           full-entry)
       (select-keys representation-props)
       (include-secure-uuid secure-uuid access-level)


better code gen for protocol fns

better code gen for protocol fns

--- src/main/clojure/cljs/core.cljc
+++ src/main/clojure/cljs/core.cljc
@@ -1791,15 +1791,19 @@
                                   " defines method " mname " with arity 0"))))))
              expand-sig (core/fn [fname slot sig]
                           `(~sig
-                             (if (and ~(first sig) (. ~(first sig) ~(symbol (core/str "-" slot)))) ;; Property access needed here.
+                             (if (and (not (nil? ~(first sig)))
+                                      (not (nil? (. ~(first sig) ~(symbol (core/str "-" slot)))))) ;; Property access needed here.
                                (. ~(first sig) ~slot ~@sig)
-                               (let [x# (if (nil? ~(first sig)) nil ~(first sig))]
-                                 ((or
-                                    (aget ~(fqn fname) (goog/typeOf x#))
-                                    (aget ~(fqn fname) "_")
-                                    (throw (missing-protocol
-                                             ~(core/str psym "." fname) ~(first sig))))
-                                   ~@sig)))))
+                               (let [x# (if (nil? ~(first sig)) nil ~(first sig))
+                                     m# (aget ~(fqn fname) (goog/typeOf x#))]
+                                 (if-not (nil? m#)
+                                   (m# ~@sig)
+                                   (let [m# (aget ~(fqn fname) "_")]
+                                     (if-not (nil? m#)
+                                       (m# ~@sig)
+                                       (throw
+                                         (missing-protocol
+                                           ~(core/str psym "." fname) ~(first sig))))))))))
              psym   (vary-meta psym assoc-in [:protocol-info :methods]
                       (into {}
                         (map


don't publish pen-and-paper blog post yet

--- src/pc/views/blog.clj
+++ src/pc/views/blog.clj
@@ -29,7 +29,8 @@
    function returned by post-fn"
   [;"instrumenting-om-components"
    "interactive-layers"
-   "lets-replace-pen-and-paper"])
+   ;"lets-replace-pen-and-paper"
+   ])

 (defn post-exists? [slug]
   (not= -1 (.indexOf slugs slug)))


fix key pressure syntax parsing

fix key pressure syntax parsing

--- src/semitone/core.clj
+++ src/semitone/core.clj
@@ -183,11 +183,11 @@
                            {:message-type ShortMessage/PITCH_BEND
                             param value
                             :param param}
-                           (= "&" (get m 1))
+                           (= "*" (get m 1))
                            {:message-type ShortMessage/CHANNEL_PRESSURE
                             param value
                             :param param}
-                           (= "&k" (get m 1))
+                           (= "*k" (get m 1))
                            {:message-type ShortMessage/POLY_PRESSURE
                             :key value
                             :param param}


deleted muted tag

deleted muted tag

--- src/server/rooms.cljs
+++ src/server/rooms.cljs
@@ -91,7 +91,9 @@
       (if-not (nil? reply)
         (let [room (.toString reply)]
           (.hdel redis-client (redis-room-prefix room "users") id
-            #(.del redis-client (str "users:" id) callback)))))))
+            (fn []
+              (.del redis-client (str "users:" id ":muted?"))
+              (.del redis-client (str "users:" id) callback))))))))

 (defn disconnect [socket-id callback]
   (.get redis-client (str "users:" socket-id)


WIP - 1ère version du code pour le contest CG "Mean Max - Buggy Road" en "Wood League 1"

--- clojure/codingame/competition/mean-max/src/mean_max/core.clj
+++ clojure/codingame/competition/mean-max/src/mean_max/core.clj
@@ -9,8 +9,8 @@

 (require '[clojure.string :as string])

-;;unitType 0 (Reaper), 1 (Destroyer), 3 (Tanker), 4 (Wreck)
-(def unit-types [:reaper :destroyer :placeholder :tanker :wreck])
+;;unitType 0 (Reaper), 1 (Destroyer), 2 (Doof), 3 (Tanker), 4 (Wreck)
+(def unit-types [:reaper :destroyer :doof :tanker :wreck])

 (defrecord Unit
   [unit-id unit-type player-id mass radius x y vx vy extra extra2])
@@ -40,11 +40,19 @@
     (near my-reaper next-wreck) (str (:x next-wreck) " " (:y next-wreck) " 150")
     true (str (:x next-wreck) " " (:y next-wreck) " 300")))

-(defn compute-destroyer-action [my-destroyer next-tanker]
+(defn compute-destroyer-action [my-destroyer next-tanker my-rage tankers]
   (cond
     (nil? next-tanker) "WAIT"
     (in my-destroyer next-tanker) (str (:x next-tanker) " " (:y next-tanker) " 0")
+    (and (or (in my-destroyer next-tanker) (near my-destroyer next-tanker)) (> my-rage 200)) (str "SKILL " (:x (last tankers)) " " (:y (last tankers)))
+    (> my-rage 150) (str "SKILL " (:x next-tanker) " " (:y next-tanker))
     true (str (:x next-tanker) " " (:y next-tanker) " 300")))
+
+(defn compute-doof-action [my-doof enemy-reapers my-rage]
+  (let [nearest-enemy-reaper (first (sort-by #(distance (:x my-doof) (:y my-doof) (:x %) (:y %)) enemy-reapers))]
+    (cond
+      (>= my-rage 300) "WAIT"
+      true (str (:x nearest-enemy-reaper) " " (:y nearest-enemy-reaper) " 300"))))

 (defn -main [& args]
   (while true
@@ -65,17 +73,21 @@
                 unit (Unit. unit-id unit-type player-id mass radius x y vx vy extra extra2)]
             (swap! units conj unit)
             (recur (dec i)))))
-      (let [wrecks (filter #(= (:unit-type %) :wreck) @units)
+      (let [reapers (filter #(= (:unit-type %) :reaper) @units)
+            destroyers (filter #(= (:unit-type %) :destroyer) @units)
+            doofs (filter #(= (:unit-type %) :doof) @units)
+            tankers (filter #(= (:unit-type %) :tanker) @units)
+            wrecks (filter #(= (:unit-type %) :wreck) @units)
             wrecks-with-water (filter #(> (:extra %) 0) wrecks)
-            tankers (filter #(= (:unit-type %) :tanker) @units)
-            reapers (filter #(= (:unit-type %) :reaper) @units)
-            destroyers (filter #(= (:unit-type %) :destroyer) @units)
             enemy-reapers (filter #(not= (:player-id %) 0) reapers)
             enemy-destroyers (filter #(not= (:player-id %) 0) destroyers)
+            enemy-doofs (filter #(not= (:player-id %) 0) doofs)
             my-reaper (first (filter #(= (:player-id %) 0) reapers))
             my-destroyer (first (filter #(= (:player-id %) 0) destroyers))
+            my-doof (first (filter #(= (:player-id %) 0) doofs))
             next-wreck (first (sort-by #(distance (:x my-reaper) (:y my-reaper) (:x %) (:y %)) wrecks-with-water))
-            next-tanker (first (sort-by #(distance (:x my-destroyer) (:y my-destroyer) (:x %) (:y %)) tankers))]
+            tankers-sorted-by-distance (sort-by #(distance (:x my-destroyer) (:y my-destroyer) (:x %) (:y %)) tankers)
+            next-tanker (first tankers-sorted-by-distance)]
         (binding [*out* *err*] (println "wrecks : " (string/join " " (map #(into {} %) wrecks)))
                                (println "wrecks with water: " (string/join " " (map #(into {} %) wrecks-with-water)))
                                (println "tankers : " (string/join " " (map #(into {} %) tankers)))
@@ -84,12 +96,13 @@
                                (println "enemy reapers: " (string/join " " (map #(into {} %) enemy-reapers)))
                                (println "enemy destroyers: " (string/join " " (map #(into {} %) enemy-destroyers)))
                                (println "my reaper : " (string/join " " my-reaper))
-                               (println "my-destroyer : " (string/join " " my-destroyer))
-                               (println "next-wreck : " (string/join " " next-wreck))
-                               (println "next-tanker : " (string/join " " next-tanker)))
+                               (println "my destroyer : " (string/join " " my-destroyer))
+                               (println "my doof : " (string/join " " my-doof))
+                               (println "next wreck : " (string/join " " next-wreck))
+                               (println "next tanker : " (string/join " " next-tanker)))
         (println (compute-reaper-action my-reaper next-wreck))
-        (println (compute-destroyer-action my-destroyer next-tanker))
-        (println "WAIT")))))
+        (println (compute-destroyer-action my-destroyer next-tanker my-rage tankers-sorted-by-distance))
+        (println (compute-doof-action my-doof enemy-reapers my-rage))))))

       ; (binding [*out* *err*]
       ;   (println "Debug messages..."))


show alphabet

show alphabet

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -1446,8 +1446,8 @@
   (symb (:accepts dfa)))

 (defn states [current-state dfa]
-  (let [next-states (map second (get-next current-state dfa))]
+  (let [next-states (get-next current-state dfa)]
     (if (empty? next-states)
-      (vector current-state)
-      (mapcat #(cons current-state (states % dfa)) next-states))))
-
+      nil
+      (mapcat (fn [[c s]] (cons c (states s dfa))) next-states))))
+


Pin to a clojure version for smoketest.

Pin to a clojure version for smoketest.

lein 2.2.0 now injects nrepl as a userspace dependency, and without an
explicit clojure dep, it brings in 1.2.0, which we don't support (it
doesn't have IBlockingDeref).

--- support/smoketest/project.clj
+++ support/smoketest/project.clj
@@ -1,3 +1,4 @@
 (defproject smoketest "0.1.0-SNAPSHOT"
-  :dependencies [[org.immutant/immutant ~(System/getProperty "version")]]
+  :dependencies [[org.clojure/clojure "1.5.1"]
+                 [org.immutant/immutant ~(System/getProperty "version")]]
   :local-repo "target/.m2")


Fix wrong parentheses, rename key to object-key

There is a wrong closing parentheses after the let at line 27.
Unfortunately, the let was supposed to bind a variable named key
which also is a clojure function, so that compilation and
execution still worked, only with misleading results.

--- components/aws-s3/src/gorillalabs/tesla/component/aws_s3.clj
+++ components/aws-s3/src/gorillalabs/tesla/component/aws_s3.clj
@@ -22,14 +22,14 @@
     (atom {:credentials credentials})))

 (defn store-object!
-   "Stores the object in the object store and returns the generated/provided key. Object can either be an InputStream, a string or a file."
+  "Stores the object in the object store and returns the generated/provided key. Object can either be an InputStream, a string or a file."
   ([bucket-name store-object]
-   (let [key (.toString (java.util.UUID/randomUUID))])
-    (store-object! bucket-name key store-object))
-  ([bucket-name key store-object]
-   (let [e-tag (.getETag (s3/put-object (:credentials @store) bucket-name key store-object))]
-    (log/infof "Uploaded object with key %s and etag %s." key e-tag)
-    key)))
+   (let [object-key (.toString (java.util.UUID/randomUUID))]
+     (store-object! bucket-name object-key store-object)))
+  ([bucket-name object-key store-object]
+   (let [e-tag (.getETag (s3/put-object (:credentials @store) bucket-name object-key store-object))]
+     (log/infof "Uploaded object with key %s and etag %s." object-key e-tag)
+     object-key)))

 (defn object-exists? [bucket-name object-key]
   (s3/object-exists? (:credentials @store) bucket-name object-key))


Don't duplicate test data for singularize test

--- test/ai_zootson/util_test.clj
+++ test/ai_zootson/util_test.clj
@@ -4,7 +4,10 @@

 (fact singularize
   (tabular
-    (fact (singularize ?input) => ?output)
+    (fact
+      (singularize ?input) => ?output
+      (fact dont-change-singular
+        (singularize ?output) => ?output))
     ?input ?output

     "anteaters" "anteater"
@@ -114,122 +117,8 @@
     ;; Random
     "crises" "crisis"
     "businesses" "business"
-    "axes" "axis"
+    ;; "axes" "axis"

     "viruses" "virus"
     "cactus" "cacti"
     ))
-
-(fact singularize-singular
-  (tabular
-    (fact (singularize ?input) => ?input)
-    ?input
-
-    "anteater"
-
-    ;; Lets test all example animals...
-    "aardvark"
-    "antelope"
-    "bass"
-    "bear"
-    "boar"
-    "buffalo"
-    "calf"
-    "carp"
-    "catfish"
-    "cavy"
-    "cheetah"
-    "chicken"
-    "chub"
-    "clam"
-    "crab"
-    "crayfish"
-    "crow"
-    "deer"
-    "dogfish"
-    "dolphin"
-    "dove"
-    "duck"
-    "elephant"
-    "flamingo"
-    "flea"
-    "frog"
-    "fruitbat"
-    "giraffe"
-    "girl"
-    "gnat"
-    "goat"
-    "gorilla"
-    "gull"
-    "haddock"
-    "hamster"
-    "hare"
-    "hawk"
-    "herring"
-    "honeybee"
-    "housefly"
-    "kiwi"
-    "ladybird"
-    "lark"
-    "leopard"
-    "lion"
-    "lobster"
-    "lynx"
-    "mink"
-    "mole"
-    "mongoose"
-    "moth"
-    "newt"
-    "octopus"
-    "opossum"
-    "oryx"
-    "ostrich"
-    "parakeet"
-    "penguin"
-    "pheasant"
-    "pike"
-    "piranha"
-    "pitviper"
-    "platypus"
-    "polecat"
-    "pony"
-    "porpoise"
-    "puma"
-    "pussycat"
-    "raccoon"
-    "reindeer"
-    "rhea"
-    "scorpion"
-    "seahorse"
-    "seal"
-    "sealion"
-    "seasnake"
-    "seawasp"
-    "skimmer"
-    "skua"
-    "slowworm"
-    "slug"
-    "sole"
-    "sparrow"
-    "squirrel"
-    "starfish"
-    "stingray"
-    "swan"
-    "termite"
-    "toad"
-    "tortoise"
-    "tuatara"
-    "tuna"
-    "vampire"
-    "vole"
-    "vulture"
-    "wallaby"
-    "wasp"
-    "wolf"
-    "worm"
-    "wren"
-
-    ;; Random
-    "crisis"
-    "business"
-    ))


fix result order

fix result order

--- test/calfpath/route_test.cljc
+++ test/calfpath/route_test.cljc
@@ -255,13 +255,14 @@
   [{:uri "/album/:lid/artist/:rid/" :method :get}
    {:uri "/hello/1234/"                         }
    {:uri "/info/:token/"            :method :get}
-   {:uri "/user/:id*" :nested [{:uri "/profile/:type/" :nested [{:method :get   }
-                                                                {:method :patch }
-                                                                {:method :delete}]}
+   {:uri "/user/:id*" :nested [
+                               {:uri "/auth"    }
                                {:uri "/permissions/"   :nested [{:method :get   }
                                                                 {:method :post  }
                                                                 {:method :put   }]}
-                               {:uri "/auth"    }
+                               {:uri "/profile/:type/" :nested [{:method :get   }
+                                                                {:method :patch }
+                                                                {:method :delete}]}
                                {:uri ""         }]}])


Removed prop access warning from tests

Removed prop access warning from tests

--- test/cljs/cljs/core_test.cljs
+++ test/cljs/cljs/core_test.cljs
@@ -758,8 +758,8 @@
     (assert (= "bc" (.substring s 1 3)))
     (assert (= "ABC" (. s (toUpperCase))))
     (assert (= "ABC" (. "abc" (toUpperCase))))
-    (assert (= "BC" (. (.toUpperCase s) substring 1)))
-    (assert (= 2 (.-length (. (.toUpperCase s) substring 1)))))
+    (assert (= "BC" (. (. s (toUpperCase)) substring 1)))
+    (assert (= 2 (.-length (. (. s (toUpperCase)) substring 1)))))

   (assert (= (conj fred {:wife :ethel :friend :ricky})
              (map->Person {:firstname "Fred" :lastname "Mertz" :wife :ethel :friend :ricky})))


fix random index name clean (#1111)

fix random index name clean (#1111)

When using `fixture-ctia-with-app` we generate random indices to avoid collision between tests.
We always had trailing indices in our local clusters since, I thought that it was due to failing tests, but indeed the cleaning was not triggered at all.

--- test/ctia/test_helpers/es.clj
+++ test/ctia/test_helpers/es.clj
@@ -66,11 +66,11 @@
                                    :as services} :- ESConnServices]
   (let [{:keys [conn index]} (es-init/init-store-conn
                               (es-init/get-store-properties entity get-in-config)
-                              services)]
+                              services)
+        index-wildcard (str index "*")]
     (when conn
-      (doto (str index "*")
-        #(es-index/delete! conn %)
-        #(es-index/delete-template! conn %)))))
+        (es-index/delete! conn index-wildcard)
+        (es-index/delete-template! conn index-wildcard))))

 (defn fixture-purge-event-indices-and-templates
   "walk through all producers and delete their indices and templates"
@@ -207,7 +207,7 @@
            :_id _id)))

 (defn load-bulk
-  ([conn docs] (load-bulk conn docs "true"))
+  ([conn docs] (load-bulk conn docs "wait_for"))
   ([{:keys [version] :as conn} docs refresh?]
    (es-doc/bulk-create-doc conn
                            (cond->> docs