Three new tests: test-override-runtime-params-[123]

--- test/emender_jenkins/config_test.clj
+++ test/emender_jenkins/config_test.clj
@@ -496,3 +496,45 @@
             (-> cfg :jenkins :jenkins-job-list-url)    "api/json?tree=jobs[name,url,color,scm[userRemoteConfigs[url]],buildable,lastSuccessfulBuild[description]]"
             (-> cfg :jenkins :jenkins-auth)            ""))))

+(deftest test-override-runtime-params-1
+    "Check the behaviour of function emender-jenkins.config/override-runtime-params."
+    (testing "the behaviour of function emender-jenkins.config/override-runtime-params."
+    (let [cfg (-> (load-configuration-from-ini "test/test1.ini")
+                  (override-runtime-params nil nil))]
+        (are [x y] (= x y)
+            (-> cfg :info  :version)                   "0.1.0"
+            (-> cfg :jenkins :jenkins-url)             "http://10.20.30.40:8080/"
+            (-> cfg :jenkins :jenkins-job-prefix-url)  "job/"
+            (-> cfg :jenkins :jenkins-job-list-url)    "api/json?tree=jobs[name,url,color,scm[userRemoteConfigs[url]],buildable,lastSuccessfulBuild[description]]"
+            (-> cfg :jenkins :jenkins-auth)            ""
+            (-> cfg :started-on)                       nil
+            (-> cfg :started-ms)                       nil))))
+
+(deftest test-override-runtime-params-2
+    "Check the behaviour of function emender-jenkins.config/override-runtime-params."
+    (testing "the behaviour of function emender-jenkins.config/override-runtime-params."
+    (let [cfg (-> (load-configuration-from-ini "test/test1.ini")
+                  (override-runtime-params "10:20:30" nil))]
+        (are [x y] (= x y)
+            (-> cfg :info  :version)                   "0.1.0"
+            (-> cfg :jenkins :jenkins-url)             "http://10.20.30.40:8080/"
+            (-> cfg :jenkins :jenkins-job-prefix-url)  "job/"
+            (-> cfg :jenkins :jenkins-job-list-url)    "api/json?tree=jobs[name,url,color,scm[userRemoteConfigs[url]],buildable,lastSuccessfulBuild[description]]"
+            (-> cfg :jenkins :jenkins-auth)            ""
+            (-> cfg :started-on)                       "10:20:30"
+            (-> cfg :started-ms)                       nil))))
+
+(deftest test-override-runtime-params-3
+    "Check the behaviour of function emender-jenkins.config/override-runtime-params."
+    (testing "the behaviour of function emender-jenkins.config/override-runtime-params."
+    (let [cfg (-> (load-configuration-from-ini "test/test1.ini")
+                  (override-runtime-params nil 123456))]
+        (are [x y] (= x y)
+            (-> cfg :info  :version)                   "0.1.0"
+            (-> cfg :jenkins :jenkins-url)             "http://10.20.30.40:8080/"
+            (-> cfg :jenkins :jenkins-job-prefix-url)  "job/"
+            (-> cfg :jenkins :jenkins-job-list-url)    "api/json?tree=jobs[name,url,color,scm[userRemoteConfigs[url]],buildable,lastSuccessfulBuild[description]]"
+            (-> cfg :jenkins :jenkins-auth)            ""
+            (-> cfg :started-on)                       nil
+            (-> cfg :started-ms)                       123456))))
+


Clean up ns

Clean up ns

--- src/aero/core.clj
+++ src/aero/core.clj
@@ -1,13 +1,12 @@
-;; Copyright © 2015, JUXT LTD.
+;; Copyright © 2015-2016, JUXT LTD.

 (ns aero.core
-  (:require [clojure
-             [edn :as edn]
-             [string :refer [trim]]
-             [walk :refer [walk postwalk]]]
-            [clojure.java
-             [io :as io]
-             [shell :as sh]]))
+  (:require
+   [clojure.edn :as edn]
+   [clojure.string :refer [trim]]
+   [clojure.walk :refer [walk postwalk]]
+   [clojure.java.io :as io]
+   [clojure.java.shell :as sh]))

 (declare read-config)


s/merge/unifyc/

s/merge/unifyc/

--- src/babel/ug.cljc
+++ src/babel/ug.cljc
@@ -1,7 +1,7 @@
 (ns babel.ug
-  (:refer-clojure :exclude [get-in merge resolve])
+  (:refer-clojure :exclude [get-in resolve])
   (:require [clojure.string :as string]
-            [dag_unify.core :refer (fail? get-in merge unifyc)]))
+            [dag_unify.core :refer (fail? get-in unifyc)]))

 (def phrasal {:phrasal true})

@@ -218,7 +218,7 @@
                                   {:synsem {:infl :present}})))))]
        (let [merged
              (if (= input :fail) :fail
-                 (merge input finitize))]
+                 (unifyc input finitize))]
          (do
            merged)))))) ;; for now, no recursive call.


file tasks should always run when they have no dependencies

--- src/cake/core.clj
+++ src/cake/core.clj
@@ -97,12 +97,13 @@
   (let [[deps body] (if (set? (first body))
                       [(first body) (rest body)]
                       [#{} body])
-        [sources deps] (for [pred [string? symbol?]]
-                         (set (filter pred deps)))]
-    `(deftask ~name ~deps
+        [files tasks] (for [pred [string? symbol?]]
+                        (set (filter pred deps)))]
+    `(deftask ~name ~files
        (let [f# (file ~name)]
          (when (or (not (.exists f#))
-                   (seq (filter #(< (.lastModified f#) (.lastModified (file %))) ~sources)))
+                   (seq (filter #(< (.lastModified f#) (.lastModified (file %))) ~files))
+                   (nil? (seq ~deps)))
            ~@body)))))

 (defmacro undeftask [& names]


Restore --no-serve option.

Restore --no-serve option.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -389,6 +389,7 @@
         logfile (:logfile options)
         always (:force options)
         gui (:gui options)
+        serve (:serve options)
         certfile (:certfile options)
         keyfile (:keyfile options)
         userauth (:userauth options)
@@ -433,17 +434,18 @@
                       ; and db, so we defer the .join on jetty until the end.
                       (let [ws-config (events/jetty-config load-queue)
                             server
-                            (try
-                              (serv (get-app docroot db loader load-queue port userauth allow-hosts) host port keystore ws-config)
-                              (catch org.eclipse.jetty.util.MultiException ex
-                                (let [ex0 (.getThrowable ex 0)]
-                                  (if (instance? java.net.BindException ex0)
-                                    (do
-                                      (binding [*out* *err*]
-                                        (println "Port already bound. Notifying other process."))
-                                      (System/exit 1))
-                                    (throw ex)))))]
-                        (when gui (try
+                            (when serve
+                              (try
+                                (serv (get-app docroot db loader load-queue port userauth allow-hosts) host port keystore ws-config)
+                                (catch org.eclipse.jetty.util.MultiException ex
+                                  (let [ex0 (.getThrowable ex 0)]
+                                    (if (instance? java.net.BindException ex0)
+                                      (do
+                                        (binding [*out* *err*]
+                                          (println "Port already bound. Notifying other process."))
+                                        (System/exit 1))
+                                      (throw ex))))))]
+                        (when (and gui serve) (try
                                     (reset! xena-import (XenaImport/start))
                                     (catch Exception ex
                                       (binding [*out* *err*]
@@ -452,7 +454,8 @@
                                         nil))))
                         (Splash/close)
                         (reset! db (h2/create-xenadb database))
-                        (.join server))))))
+                        (when server
+                          (.join server)))))))
         (catch Exception ex
           ; XXX maybe should enable ERROR logging to console, instead of this.
           (binding [*out* *err*]


Set *print-length* to 100

Set *print-length* to 100

--- roles/clojure/files/profiles.clj
+++ roles/clojure/files/profiles.clj
@@ -25,7 +25,8 @@
                   [lein-typed "0.3.5"]
                   [refactor-nrepl "1.2.0-SNAPSHOT"]]

-        :global-vars {*warn-on-reflection* true}
+        :global-vars {*print-length* 100
+                      *warn-on-reflection* true}

         :shorthand {. [^:lazy alembic.still/distill
                        ^:lazy alembic.still/load-project


use testing macro to improve the tests

use testing macro to improve the tests

--- test/cljs/tictactoe/game_test.cljs
+++ test/cljs/tictactoe/game_test.cljs
@@ -44,34 +44,39 @@

 (deftest test-init-game
   (let [init-game (logic/new-game)]
-    (is (not (logic/game-over? init-game)))
-    (is (= cst/cell-count (count-empty-cells init-game)))
+    (testing "New game is not over yet"
+      (is (not (logic/game-over? init-game))))
+    (testing "All cells are empty"
+      (is (= cst/cell-count (count-empty-cells init-game))))
     ))

 (deftest test-game-over
   (let [init-game (logic/new-game)
         end-game (play-moves init-game cst/coordinates)]
-    (is (logic/game-over? end-game))
-    (is (> cst/cell-count (count-empty-cells end-game)))
+    (testing "Playing all coordinates results in game over"
+      (is (logic/game-over? end-game)))
+    (testing "To be game over, some cells have to be taken"
+      (is (> cst/cell-count (count-empty-cells end-game))))
     ))

 (deftest test-undo-all
   (let [init-game (logic/new-game)
         end-game (play-moves init-game cst/coordinates)
         undo-game (reduce #(logic/on-undo %1) end-game cst/coordinates)]
-    (is (logic/game-over? end-game))
-    (is (= init-game undo-game))
+    (testing "Rollbacking all moves should yield the initial game"
+      (is (= init-game undo-game)))
     ))

 (deftest test-winning-line
   (doseq [i (range (dec cst/board-size))]
-    (let [hor-moves (interleave (nth cst/rows i) (nth cst/rows (inc i)))
-          ver-moves (interleave (nth cst/cols i) (nth cst/cols (inc i)))
-          game-1 (play-moves (logic/new-game) hor-moves)
-          game-2 (play-moves (logic/new-game) ver-moves)]
-      (is (logic/game-over? game-1))
-      (is (logic/game-over? game-2))
-      )))
+    (testing "If each player plays one row, the first player will win"
+      (let [hor-moves (interleave (nth cst/rows i) (nth cst/rows (inc i)))
+            end-game (play-moves (logic/new-game) hor-moves)]
+        (is (logic/game-over? end-game))))
+    (testing "If each player plays one column, the first player will win"
+      (let [ver-moves (interleave (nth cst/cols i) (nth cst/cols (inc i)))
+            game-2 (play-moves (logic/new-game) ver-moves)]
+        (is (logic/game-over? game-2))))))

 ;; ----------------------------------------------------------------------------


Back to use FulcroRemoteI for pathom network, now that inspect works with it


add table header

add table header

--- src/otto/html.clj
+++ src/otto/html.clj
@@ -30,14 +30,20 @@
   [repositories]
   (if (empty? repositories)
     [:p "Listing currently unavailable."]
-    [:table (for [[_ repository] repositories]
-              [:tr (if (= true (:private repository))
+    [:table
+     [:thead [:tr [:th "Name"]
+                  [:th "Description"]
+                  [:th "Language"]
+                  [:th "Date"]]]
+     [:tbody (for [[_ repository] repositories]
+               [:tr (if (= true (:private repository))
                      {:class "private"})
-               [:td (:name repository)
+               [:td [:a {:href (:html_url repository)} (:name repository)]]
+               [:td (format-string (:description repository))
                     (if (= true (:fork repository))
                       [:span {:class "fork"} "fork"])]
                [:td (format-string (:language repository))]
-               [:td (format-date (:pushed_at repository))]])]))
+               [:td (format-date (:pushed_at repository))]])]]))

 (defn organization-view
   [organizations organization repositories]


Lein profiles changes

Lein profiles changes

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,4 +1,6 @@
 {:user {:plugins [[lein-exec "0.3.0"]
                   [jonase/eastwood "0.1.2"]]
         :dependencies [[org.clojure/tools.namespace "0.2.4"]
-                       [criterium "0.4.2"]]}}
+                       [criterium "0.4.2"]
+                       [slamhound "1.5.5"]]
+        :aliases {"slamhound" ["run" "-m" "slam.hound"]}}}


Fix polygon

Fix polygon

--- web/src/web/routes/services.clj
+++ web/src/web/routes/services.clj
@@ -33,12 +33,12 @@

 (defn gen-small-polygon [point]
   (let [[lat lon] point
-        sz 0.01]
-    [[(- lon sz) (- lat sz)]
-     [(- lon sz) (+ lat sz)]
-     [(+ lon sz) (+ lat sz)]
-     [(+ lon sz) (- lat sz)]
-     [(- lon sz) (- lat sz)]]))
+        sz 0.5]
+    [[[(- lon sz) (- lat sz)]
+       [(- lon sz) (+ lat sz)]
+       [(+ lon sz) (+ lat sz)]
+       [(+ lon sz) (- lat sz)]
+       [(- lon sz) (- lat sz)]]]))

 (defn bucket->feature [name unit bucket]
   (let [point (read-string (:key bucket))


Remove some debug.

Remove some debug.

--- src/sqls/util.clj
+++ src/sqls/util.clj
@@ -151,19 +151,15 @@
    :post [(sequential? %)
           (every? string? %)]}
   (let [column-count (apply max 0 (map (fn [row] (count row)) rows))
-        _ (debugf "column-count: %s" column-count)
         column-widths (for [i (range column-count)]
                         (->> rows
                              (map (fn [row] (get row i)))
                              (map (fn [v] (or v "")))
                              (map count)
                              (apply max)))]
-    (debugf "column-widths: %s" (with-out-str (fipp.edn/pprint column-widths)))
     (map (fn [row]
-           (debugf "formatting row: %s" (with-out-str (fipp.edn/pprint row)))
            (string/join "  "
                         (map (fn [w v]
-                               (debugf "formatting value %s in column width %s" v w)
                                (assert (number? w))
                                (assert (string? v))
                                (let [sv (or v "")


lein: update all the things

lein: update all the things

--- lein_profiles.clj
+++ lein_profiles.clj
@@ -1,8 +1,8 @@
 {:user {:plugins [
-                  [lein-ring "0.9.6"]
-                  [lein-ancient "0.6.7"]
-                  [jonase/eastwood "0.2.1"]
-                  [cider/cider-nrepl "0.9.1"]
+                  [lein-ring "0.9.7"]
+                  [lein-ancient "0.6.8"]
+                  [jonase/eastwood "0.2.3"]
+                  [cider/cider-nrepl "0.10.0"]
                   ]}}
 {:dev {:dependencies
        [[com.cemerick/pomegranate "0.3.0"]]


update leiningen profiles

update leiningen profiles

--- lein_profiles.clj
+++ lein_profiles.clj
@@ -1,3 +1,4 @@
 {:user {:plugins [
-                  [lein-simpleton "1.0.1"]
+                  [lein-ring "0.8.10"]
+                  [lein-ancient "0.5.4"]
                   ]}}


cider-nrepl 0.7.0 is final

cider-nrepl 0.7.0 is final

--- lein_profiles.clj
+++ lein_profiles.clj
@@ -2,7 +2,7 @@
                   [lein-ring "0.8.11"]
                   [lein-ancient "0.5.5"]
                   [jonase/eastwood "0.1.4"]
-                  [cider/cider-nrepl "0.7.0-SNAPSHOT"]
+                  [cider/cider-nrepl "0.7.0"]
                   ]}}
 {:dev {:dependencies
        [[com.cemerick/pomegranate "0.3.0"]]


Documented new transform functions

Documented new transform functions

--- src/logic/transform.clj
+++ src/logic/transform.clj
@@ -23,12 +23,17 @@
   (insta/transform transform-map ast))

 (defn- flat-filter
+  "Private function to filter if the sub sub ast is flattable.
+   Returns true if the operator of the sub [o] ast the same like the sub sub ast.
+   False otherwise."
   [o l]
   (if (coll? l)
     (= o (first l))
     false))

 (defn- flat
+  "Private functin to flat a flattenable sub ast with a depth of one level.
+   This function does not check if the operator is n-ary!"
   [ast]
   (let [o (first ast) a (rest ast) ; operators and arguments
         flat (map #(rest %) (filter (partial flat-filter o) a))
@@ -36,6 +41,10 @@
       (apply concat  `((~o) ~@flat ~not-flat))))

 (defn- flat-ast
+  "Private function to flat the deepest sub ast that is not flatted now if it is possible,
+   else it returns the original sub ast.
+   It should be used to flat a complete ast bottum up.
+   e.g. (postwalk flat-ast ast)"
   [ast]
   (if (and
         (coll? ast)
@@ -44,5 +53,8 @@
     ast))

 (defn flatten-ast
+  "Flats the transformed ast.
+   Nested binary functions will be transformed to one n-ary function when it is possible.
+   (and (and a b) c) => (and a b c)"
   [ast]
   (postwalk flat-ast ast))


Add key optimization note.

Add key optimization note.

--- src/merkle_db/index.clj
+++ src/merkle_db/index.clj
@@ -92,6 +92,7 @@
   "Aggregates index node values from a sequence of child data. Returns the
   persisted node data map for the constructed index."
   [store height children]
+  ; OPTIMIZE: truncate separator keys to the shortest value that correctly splits the adjacent children
   (let [ckeys (into [] (map ::record/first-key) (rest children))
         links (numbered-child-links children)
         record-count (reduce + 0 (map ::record/count children))]


src/riemann/streams.clj: fill-in-last* function

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -682,6 +682,39 @@

       ; And forward
       (call-rescue event children)))))
+
+(defn fill-in-last*
+  "Passes on all events. Fills in gaps in event stream with copies of
+  the last event updated with the given updater function, wherever
+  interval seconds pass without an event arriving. Inserted events
+  have current time. Stops inserting when expired. Uses local times."
+  ([interval updater & children]
+   (let [last-event (atom nil)
+         fill (bound-fn fill []
+                (call-rescue (merge (updater @last-event) {:time (unix-time)}) children))
+         new-deferrable (fn new-deferrable []
+                          (every! interval interval fill))
+         deferrable (atom nil)]
+     (fn stream [event]
+       ; Record last event
+       (reset! last-event event)
+
+       (let [d (deref deferrable)]
+         (if d
+           ; We have an active deferrable
+           (if (expired? event)
+             (do
+               (cancel d)
+               (reset! deferrable nil))
+             (defer d interval))
+           ; Create a deferrable
+           (when-not (expired? event)
+             (locking deferrable
+               (when-not (deref deferrable)
+                 (reset! deferrable (new-deferrable)))))))
+
+       ; And forward
+       (call-rescue event children)))))

 (defn fill-in-last
   "Passes on all events. Fills in gaps in event stream with copies of the last


fix typo in test name

fix typo in test name

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -77,7 +77,7 @@
     (is (not (nil? result)))
     (is (= "io mi sono alzata" (fo result)))))

-(deftest passato-prossimo-ditransitive
+(deftest present-ditransitive
   (let [result (generate {:synsem {:subcat '()
                                    :infl :present
                                    :sem {:pred :be-called


Group selected items in svg:g.

Group selected items in svg:g.

--- frontend/uxbox/ui/workspace/canvas.cljs
+++ frontend/uxbox/ui/workspace/canvas.cljs
@@ -127,6 +127,9 @@
   []
   (let [page (rum/react wb/page-state)
         shapes (rum/react wb/shapes-state)
+        selected-ids (rum/react wb/selected-state)
+        selected (filter (comp selected-ids :id) shapes)
+        nonselected (filter (comp not selected-ids :id) shapes)
         page-width (:width page)
         page-height (:height page)]
     (letfn [(on-mouse-down [event]
@@ -146,8 +149,12 @@
         (background)
         (grid 1)
         [:svg.page-layout {}
-         (for [item shapes]
-           (rum/with-key (shape item) (str (:id item))))]]))))
+         (for [item nonselected]
+           (rum/with-key (shape item) (str (:id item))))
+         (if (seq selected)
+           [:g.selected
+            (for [item selected]
+              (rum/with-key (shape item) (str (:id item))))])]]))))

 (def canvas
   (util/component


add missing conditionalization of macro-ns-name, bootstrapped ClojureScript can now load macro namespaces and compile them and use them.


Remove dedd code

Remove dedd code


Fix type hinting and some trailing spaces

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -91,9 +91,10 @@
                 (let [fetched (kc/messages consumer "onyx" topic kpartition head-offset fetch-size)]
                   (Thread/sleep empty-read-back-off)
                   (recur fetched head-offset))
-                (let [next-offset (.offset ^int (first ms))]
+                (let [message ^KafkaMessage (first ms)
+                      next-offset ^int (.offset message)]
                   (>!! ch (assoc (t/input (java.util.UUID/randomUUID)
-                                          (deserializer-fn (.value ^KafkaMessage (first ms))))
+                                          (deserializer-fn (.value message)))
                                  :offset next-offset))
                   (recur (rest ms) (inc next-offset)))))
             (finally
@@ -113,7 +114,7 @@
         client-id "onyx"
         m {"zookeeper.connect" (:kafka/zookeeper task-map)}
         partitions (kzk/partitions m topic)
-        ch (:read-ch pipeline)
+        ch (:read-ch pipeline)
         pending-messages (:pending-messages pipeline)
         pending-commits (:pending-commits pipeline)
         reader-fut (future (reader-loop m client-id group-id topic partitions kpartition task-map ch pending-commits))]
@@ -122,10 +123,10 @@
      :kafka/pending-messages pending-messages
      :kafka/pending-commits pending-commits}))

-(defrecord KafkaReadMessages [max-pending batch-size batch-timeout pending-messages
+(defrecord KafkaReadMessages [max-pending batch-size batch-timeout pending-messages
                               pending-commits drained? read-ch]
   p-ext/Pipeline
-  (write-batch
+  (write-batch
     [this event]
     (function/write-batch event))

@@ -155,7 +156,7 @@
       (swap! pending-commits conj offset))
     (swap! pending-messages dissoc segment-id))

-  (retry-segment
+  (retry-segment
     [_ _ segment-id]
     (when-let [msg (get @pending-messages segment-id)]
       (swap! pending-messages dissoc segment-id)
@@ -166,7 +167,7 @@
     [_ _ segment-id]
     (get @pending-messages segment-id))

-  (drained?
+  (drained?
     [_ _]
     @drained?))

@@ -180,7 +181,7 @@
         pending-messages (atom {})
         pending-commits (atom (sorted-set))
         drained? (atom false)]
-    (->KafkaReadMessages max-pending batch-size batch-timeout
+    (->KafkaReadMessages max-pending batch-size batch-timeout
                          pending-messages pending-commits drained? ch)))

 (defn close-read-messages
@@ -198,18 +199,18 @@

 (defrecord KafkaWriteMessages [config topic producer serializer-fn]
   p-ext/Pipeline
-  (read-batch
+  (read-batch
     [_ event]
     (function/read-batch event))

-  (write-batch
+  (write-batch
     [_ {:keys [onyx.core/results]}]
     (let [messages (mapcat :leaves (:tree results))]
       (doseq [m (map :message messages)]
         (kp/send-message producer (kp/message topic (serializer-fn m)))))
     {})

-  (seal-resource
+  (seal-resource
     [_ {:keys [onyx.core/results]}]
     (kp/send-message producer (kp/message topic (serializer-fn :done)))))


Rename server-clock-tick-b to server-clock-b

--- src/overtone/sc/clock.clj
+++ src/overtone/sc/clock.clj
@@ -11,7 +11,7 @@

 ;; should only be modified by a 'singleton' wall-clock synth
 ;; global shared state FTW!
-(defonce server-clock-tick-b (control-bus 2 "Server Clock Buses"))
+(defonce server-clock-b (control-bus 2 "Server Clock Buses"))

 ;; Only one of these should ever be created...
 (defonce __SERVER-CLOCK-SYNTH__
@@ -26,7 +26,7 @@

 (defn- server-clock-reset-tick-b
   []
-  (control-bus-set-range! server-clock-tick-b [0 0]))
+  (control-bus-set-range! server-clock-b [0 0]))

 (defn- server-clock-start
   []
@@ -36,7 +36,7 @@
   (server-clock-reset-tick-b)
   (let [start-t (+ (System/currentTimeMillis) 500)]
     (reset! server-clock-start-time start-t)
-    (at start-t (__internal-wall-clock__ [:head (foundation-timing-group)] server-clock-tick-b))))
+    (at start-t (__internal-wall-clock__ [:head (foundation-timing-group)] server-clock-b))))

 (defn server-clock-n-ticks
   "Returns the number of internal ticks since the server clock was
@@ -47,7 +47,7 @@
    See server-clock-uptime and server-clock-time for functions that
    return time in milliseconds."
   []
-  (let [[b-t s-t] (control-bus-get-range server-clock-tick-b 2)]
+  (let [[b-t s-t] (control-bus-get-range server-clock-b 2)]
     (+ (* b-t defaults/SC-MAX-FLOAT-VAL)
        s-t)))


use lein-haml-sass instead of lein-sass

use lein-haml-sass instead of lein-sass

--- src/palindrome_q/repl.clj
+++ src/palindrome_q/repl.clj
@@ -9,7 +9,7 @@

 (defn get-handler []
   (-> #'app
-      (wrap-reload "resources")
+      (wrap-reload)
       (wrap-file "resources")
       (wrap-file-info)))


generate data-reactid

generate data-reactid

--- src/rum/server_render.clj
+++ src/rum/server_render.clj
@@ -1,6 +1,7 @@
 (ns rum.server-render
   (:require [clojure.string :as str])
-  (:import [clojure.lang IPersistentVector ISeq Named]))
+  (:import [clojure.lang IPersistentVector ISeq Named]
+           [java.util.zip Adler32]))

 ;; From Weavejester's Hiccup
 ;; https://github.com/weavejester/hiccup/blob/master/src/hiccup/compiler.clj#L32
@@ -13,6 +14,13 @@
   void-tags
   #{"area" "base" "br" "col" "command" "embed" "hr" "img" "input" "keygen" "link"
     "meta" "param" "source" "track" "wbr"})
+
+;;; adler32
+
+(defn adler32 [value]
+  (-> (doto (Adler32.)
+        (.update (.getBytes ^String value)))
+    .getValue))

 ;;; to-str

@@ -54,7 +62,7 @@
   [tag-attrs attrs]
   (let [attrs (for [[k v] attrs
                     :let [k (react-attr->html k)]
-                    :when (not (.startsWith k "on"))]
+                    :when (not (.startsWith ^String k "on"))]
                 [k v])
         class (if (:class tag-attrs)
                 (str (:class tag-attrs) " " (:class attrs))
@@ -69,8 +77,8 @@
   (when (not (or (keyword? tag) (symbol? tag) (string? tag)))
     (throw (IllegalArgumentException. (str tag " is not a valid element name."))))
   (let [[_ tag id class] (re-matches re-tag (name tag))
-        tag-attrs        {:id id
-                          :class (if class (.replace ^String class "." " "))}
+        tag-attrs        {"id"    id
+                          "class" (if class (.replace ^String class "." " "))}
         map-attrs        (first content)]
     (if (map? map-attrs)
       [tag (merge-attrs tag-attrs map-attrs) (next content)]
@@ -103,35 +111,54 @@
 ;;; render html

 (defprotocol HtmlRenderer
-  (render-html [this]
-    "Turn a Clojure data type into a string of HTML."))
+  (-render-html [this parent path]
+    "Turn a Clojure data type into a string of HTML with react ids."))

-(defn- render-element
+(defn -render-element
   "Render an element vector as a HTML element."
-  [element]
-  (let [[tag attrs content] (normalize-element element)]
+  [element path]
+  (let [[tag attrs content] (normalize-element element)
+        path                (if (attrs "key")
+                              (conj (subvec path 0 (dec (count path)))
+                                "$" (attrs "key"))
+                              path)
+        attrs               (assoc attrs "key" nil
+                              "data-reactid" (str/join "" path))]
     (if (container-tag? tag content)
       (str "<" tag (render-attr-map attrs) ">"
-           (render-html content)
+           (-render-html content element path)
            "</" tag ">")
       (str "<" tag (render-attr-map attrs) "/>"))))

 (extend-protocol HtmlRenderer
   IPersistentVector
-  (render-html [this]
-    (render-element this))
+  (-render-html [this parent path]
+    (-render-element this path))
   ISeq
-  (render-html [this]
-    (apply str (map render-html this)))
+  (-render-html [this parent path]
+    (if (= 1 (count this))
+      (-render-html (first this) this path)
+      (let [separator (if (and (not (vector? parent))
+                               (not= this (first parent)))
+                        ":" ".")]
+        (->> this
+          (map-indexed #(-render-html %2 this (conj path separator %1)))
+          (apply str)))))
   Named
-  (render-html [this]
+  (-render-html [this parent path]
     (name this))
   String
-  (render-html [this]
+  (-render-html [this parent path]
     this)
   Object
-  (render-html [this]
+  (-render-html [this parent path]
     (str this))
   nil
-  (render-html [this]
+  (-render-html [this parent path]
     ""))
+
+(defn render-html [src]
+  (let [result   (-render-html src nil ["." 0])
+        checksum (adler32 result)]
+    (str/replace-first result ">"
+      (str " data-react-checksum=\"" checksum "\">"))))


Update ClojureScript version

Update ClojureScript version

--- ClojureScript/planck/project.clj
+++ ClojureScript/planck/project.clj
@@ -1,5 +1,5 @@
 (defproject planck "0.1.0"
   :dependencies [[org.clojure/clojure "1.7.0"]
-                 [org.clojure/clojurescript "1.7.2"]
+                 [org.clojure/clojurescript "1.7.10"]
                  [org.omcljs/ambly "0.6.0"]]
   :clean-targets ["out" "target"])


avoid managed AWS policies until bug resolved

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -109,7 +109,15 @@
                      "autoscaling:DescribeScalingActivities",
                      "elasticloadbalancing:DescribeLoadBalancers"]}))

-
+(def full-amazon-s3-access
+  (policy {"Action" "s3:*"}))
+
+(def cloudwatch-metrics-policy
+  (policy {"Action" ["cloudwatch:GetMetricStatistics"
+                     "cloudwatch:ListMetrics"
+                     "cloudwatch:PutMetricData"
+                     "EC2:DescribeTags"]
+           "Condition" {"Bool" {"aws:SecureTransport" "true"}}}))

 (defn elb-listener [{:keys [port lb_port protocol lb_protocol]}]
   {:instance_port port
@@ -209,7 +217,6 @@

              (cluster-resource "aws_s3_bucket" "exhibitor-s3-bucket" {:bucket (cluster-unique "exhibitor-s3-bucket")})

-
              (cluster-resource "aws_iam_user" "mesos-user" {:name "mesos-user"})

              (cluster-resource "aws_iam_user_policy" "mesos-user-policy-s3"
@@ -230,9 +237,9 @@
              (iam-role "slave-role"
                        cluster-unique
                        {:name "amazon-s3-policy"
-                        :policy_arn "arn:aws:iam::aws:policy/AmazonS3FullAccess"}
+                        :policy full-amazon-s3-access}
                        {:name "cloudwatch-policy"
-                        :policy_arn  "arn:aws:iam::aws:policy/CloudWatchLogsFullAccess"}
+                        :policy cloudwatch-metrics-policy}
                        {:name "slave-eip-policy"
                         :policy (policy {"Action" ["ec2:AssociateAddress"]})}
                        {:name "slave-cloudwatch-policy"


add mesh-common fn, simplify ply-mesh & stl-mesh

--- src/thi/ng/luxor/core.clj
+++ src/thi/ng/luxor/core.clj
@@ -466,30 +466,28 @@
     :innerradius [:float inner-radius]
     :phimax [:float phi]}))

-(defn ply-mesh
-  [scene id {:keys [mesh path export-path tx material smooth]}]
+(defn- mesh-common
+  [scene id ext base {:keys [mesh path export-path tx material]}]
   (append
    scene :geometry id
-   {:__transform tx
-    :__type :plymesh
-    :__material material
-    :__mesh mesh
-    :__export-path (or export-path path)
-    :name [:string (name id)]
-    :filename [:string (or path (str (name id) ".ply"))]
-    :smooth [:bool smooth]}))
+   (merge
+    base
+    {:__transform tx
+     :__type :plymesh
+     :__material material
+     :__mesh mesh
+     :__export-path (or export-path path)
+     :name [:string (name id)]
+     :filename [:string (or path (str (name id) ext))]})))
+
+(defn ply-mesh
+  [scene id {:keys [smooth] :as opts}]
+  (mesh-common
+   scene id ".ply" {:__type :plymesh :smooth [:bool smooth]} opts))

 (defn stl-mesh
-  [scene id {:keys [mesh path export-path tx material]}]
-  (append
-   scene :geometry id
-   {:__transform tx
-    :__type :stlmesh
-    :__material material
-    :__mesh mesh
-    :__export-path (or export-path path)
-    :name [:string (name id)]
-    :filename [:string (or path (str (name id) ".stl"))]}))
+  [scene id opts]
+  (mesh-common scene id ".stl" {:__type :stlmesh} opts))

 (defn configure-mesh-streamer
   [scene f]


Added list-concat

Added list-concat

--- standard-library/list.clj
+++ standard-library/list.clj
@@ -32,3 +32,7 @@
                     Empty
                     list)))

+(def list-concat (a b)
+     (match a
+            Empty       b
+            (Cons x xs) (Cons x (list-concat xs b))))


CMR-2250: Add test to document odd elasticsearch highlighting behavior with reserved characters.

--- system-int-test/test/cmr/system_int_test/search/collection_highlights_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_highlights_search_test.clj
@@ -8,7 +8,8 @@
             [cmr.system-int-test.data2.core :as d]
             [cmr.common.util :as util]
             [cmr.common.mime-types :as mt]
-            [clojure.string :as str]))
+            [clojure.string :as str]
+            [clojure.set :as set]))

 (use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1"}))

@@ -219,14 +220,45 @@
                                          {:include-highlights true}
                                          {:keyword "MODIS/Terra"})))))

-
-; (deftest reserved-characters-test
-;   (let [reserved-strings ["+" "-" "=" "&&" "||" ">" "<" "!" "(" ")" "{" "}" "[" "]" "^" "\"" "~" "*"
-;                           "?" ":" "\\" "/"]]
-;     (make-coll 1 {:summary (format "Special chars are: %s." (str/join " " reserved-strings))})
-;     (index/wait-until-indexed)
-;     (is (= "abc" (get-search-results-summaries (search/find-concepts-in-json-with-json-query
-;                                                  :collection
-;                                                  {:include-highlights true}
-;                                                  {:keyword (str/join " " reserved-strings)}))))))
-
+;; TODO Switch atom to map-indexed
+
+(deftest reserved-characters-test
+  ;; This test documents the current elasticsearch highlighting behavior with respect to reserved
+  ;; characters. The behavior is inconsistent for the : ? and * characters
+  (let [reserved-strings #{"+" "-" "=" "&&" "||" ">" "<" "!" "(" ")" "{" "}" "[" "]" "^" "\"" "~" "*"
+                           "?" ":" "\\" "/"}
+        reserved-strings-with-different-behavior #{":" "?" "*"}
+        counter (atom 0)]
+    (doseq [reserved-string reserved-strings]
+      (swap! counter inc)
+      (make-coll @counter {:summary (format "MODIS%sTERRA dataset." reserved-string)}))
+    (index/wait-until-indexed)
+
+    (testing "Most reserved characters are not highlighted when they are searched against."
+      (doseq [reserved-string (set/difference reserved-strings
+                                              reserved-strings-with-different-behavior)]
+        (is (= [[(format "MODIS%sTERRA dataset." reserved-string)]]
+               (get-search-results-summaries (search/find-concepts-in-json-with-json-query
+                                               :collection
+                                               {:include-highlights true}
+                                               {:keyword (format "MODIS%sTERRA"
+                                                                 reserved-string)}))))))
+
+    (testing "Colons are highlighted along with the search string."
+      (is (= [["MODIS:TERRA dataset."]]
+             (get-search-results-summaries (search/find-concepts-in-json-with-json-query
+                                             :collection
+                                             {:include-highlights true}
+                                             {:keyword "MODIS:TERRA"})))))
+
+    (testing "Wildcard searches do not highlight any strings with reserved characters except for
+             colon."
+      (doseq [reserved-string #{"*" "?"}]
+        (is (= (set [nil nil nil ["MODIS:TERRA dataset."] nil nil nil nil nil nil])
+               (set (get-search-results-summaries (search/find-concepts-in-json-with-json-query
+                                                    :collection
+                                                    {:include-highlights true}
+                                                    {:keyword (format "MODIS%sTERRA"
+                                                                      reserved-string)})))))))))
+
+


Send errors for nil event dispatch and unhandled events to Sentry

--- src/cljs/zetawar/router.cljs
+++ src/cljs/zetawar/router.cljs
@@ -12,13 +12,20 @@

 (defmethod handle-event :default
   [_ msg]
-  (log/debugf "Unhandled event: %s" (pr-str msg))
+  (let [log-msg (str "Unhandled event: " (pr-str msg))]
+    (js/Raven.captureMessage log-msg)
+    (log/warn log-msg))
   nil)

 ;; TODO: add spec for dispatch
 (defn dispatch [ch msg]
-  (log/debugf "Dispatching event: %s" (pr-str msg))
-  (put! ch msg))
+  (if msg
+    (do
+      (log/debugf "Dispatching event: %s" (pr-str msg))
+      (put! ch msg))
+    (let [log-msg "Unable to dispatch 'nil' event message"]
+      (js/Raven.captureMessage log-msg)
+      (log/error log-msg))))

 ;; TODO: add pause for rendering after fixed interval
 (defn handle-event* [{:as router-ctx :keys [conn ev-chan notify-chan]} msg]


turn off annoying TODO print

turn off annoying TODO print

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -228,7 +228,7 @@
            errors-tap ([v] (errors-handler v state container))
            ;; Capture the current history for playback in the absence
            ;; of a server to store it
-           (async/timeout 10000) (do (print "TODO: print out history: ")))))))
+           (async/timeout 10000) (do #_(print "TODO: print out history: ")))))))

 (defn subscribe-to-user-channel [user ws-ch]
   (put! ws-ch [:subscribe {:channel-name (pusher/user-channel user)


fix dumb typo

fix dumb typo

--- src-cljs/frontend/utils.clj
+++ src-cljs/frontend/utils.clj
@@ -36,7 +36,7 @@
            (js/Rollbar.error e#)
            (merror e#)))
        (catch :default e2#
-         (js/Rollbar.error e#)
+         (js/Rollbar.error e2#)
          (merror e2#)))
      (catch :default e3#
        (merror e3#))))


api tests disabled

api tests disabled

--- test/NoteHub/test/api.clj
+++ test/NoteHub/test/api.clj
@@ -5,7 +5,6 @@
 (def note2 "Another test note")
 (def pid "somePlugin")
 (def pid2 "somePlugin2")
-(def ver api-version)

 (defmacro isnt [arg] `(is (not ~arg)))

@@ -14,6 +13,7 @@
   (f)
   (revoke-publisher pid))

+#_
 (deftest api
   (testing "API"
     (testing "publisher registration"
@@ -25,28 +25,28 @@
         (isnt (valid-publisher? "any_PID"))
         (isnt (valid-publisher? pid2))))
     (testing "note publishing & retrieval"
-      (let [post-response (post-note note pid (get-signature pid psk note) ver)
-            get-response (get-note ver (:noteID post-response))]
+      (let [post-response (post-note note pid (get-signature pid psk note))
+            get-response (get-note (:noteID post-response))]
         (is (:success (:status post-response)))
         (is (:success (:status get-response)))
         (is (= note (:note get-response)))
         (is (= (:longURL post-response) (:longURL get-response)))
         (is (= (:shortURL post-response) (:shortURL get-response))))
-      (isnt (:success (:status (post-note note pid (get-signature pid psk note) ver))))
-      (isnt (:success (:status (post-note note pid (get-signature pid "random_psk" note) ver))))
-      (is (:success (:status (post-note note pid (get-signature pid psk note) ver))))
+      (isnt (:success (:status (post-note note pid (get-signature pid psk note)))))
+      (isnt (:success (:status (post-note note pid (get-signature pid "random_psk" note)))))
+      (is (:success (:status (post-note note pid (get-signature pid psk note)))))
       (let [psk2 (register-publisher "randomPID")]
-        (is (:success (:status (post-note note "randomPID" (get-signature pid psk2 note) ver))))
+        (is (:success (:status (post-note note "randomPID" (get-signature pid psk2 note)))))
         (is (revoke-publisher pid2))
-        (isnt (:success (:status (post-note note "randomPID" (get-signature pid psk2 note) ver))))))
+        (isnt (:success (:status (post-note note "randomPID" (get-signature pid psk2 note)))))))
     (testing "note update"
-      (let [post-response (post-note note pid (get-signature pid psk note) ver "passwd")
+      (let [post-response (post-note note pid (get-signature pid psk note) "passwd")
             note-id (:noteID post-response)
-            get-response (get-note ver note-id)
+            get-response (get-note note-id)
             new-note "a new note!"
-            update-response (update-note note-id new-note pid (get-signature pid psk new-note) ver "passwd")
-            get-response-new (get-note ver note-id)
-            update-response-false (update-note note-id new-note pid (get-signature pid psk new-note) ver "pass")
+            update-response (update-note note-id new-note pid (get-signature pid psk new-note) "passwd")
+            get-response-new (get-note note-id)
+            update-response-false (update-note note-id new-note pid (get-signature pid psk new-note) "pass")
             ]
         (is (:success (:status post-response)))
         (is (:success (:status get-response)))


Add test for invalid token with and without fallback.

--- test/cli4clj/test/cli.clj
+++ test/cli4clj/test/cli.clj
@@ -248,6 +248,21 @@

+(deftest print-cmd-invalid-token-to-string-fallback-test
+  (let [cli-opts {:cmds {:print {:fn #(println %)}}}
+        test-cmd-input ["print /foo/bar"]
+        out-string (test-cli-stdout #(start-cli cli-opts) test-cmd-input)]
+    (is (= (expected-string ["/foo/bar"]) out-string))))
+
+(deftest print-cmd-invalid-token-exception-test
+  (let [cli-opts {:cmds {:print {:fn #(println %)}}
+                  :invalid-token-to-string false}
+        test-cmd-input ["print /foo/bar"]
+        out-string (test-cli-stderr #(start-cli cli-opts) test-cmd-input)]
+    (is (.startsWith out-string "java.lang.RuntimeException: Invalid token: /foo/bar"))))
+
+
+
 (deftest simple-jline-input-stream-mock-test
   (let [in-string (str "a 1" *cli4clj-line-sep* "b 2 3" *cli4clj-line-sep* "q" *cli4clj-line-sep*)
         out (binding [*jline-input-stream* (ByteArrayInputStream. (.getBytes in-string))]


Workaround to Clojure 1.2 reader bug

Workaround to Clojure 1.2 reader bug

The clojure 1.2 reader will allow invalid forms like {:key} to be read in, and only throw an exception on printing.
Currently clojure.tools.namespace calls (read rdr) within a try form; the bug means that this particular type of error
is never caught. This patch forces the reader to try and resolve with str, allowing clojure.tools.namespace to catch
and bury the error.

Technomancy had to do something similar in leiningen: https://github.com/technomancy/leiningen/commit/7dc1b034ee

Signed-off-by: Stuart Sierra <1d6e1cf70ec6f9ab28d3ea4b27a49a77654d370e@stuartsierra.com>

--- src/main/clojure/clojure/tools/namespace.clj
+++ src/main/clojure/clojure/tools/namespace.clj
@@ -55,7 +55,7 @@
   in the file, except for (comment ...)  forms."
   [^PushbackReader rdr]
   (try
-   (loop [] (let [form (read rdr)]
+   (loop [] (let [form (doto (read rdr) str)]
               (cond
                (ns-decl? form) form
                (comment? form) (recur)


set literals can not be duplicate, use the set

function to build out of a seq instead.


[lein] bump lein-cloverage to 1.0.6

[lein] bump lein-cloverage to 1.0.6

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,4 +1,4 @@
-{:user {:plugins [[lein-cloverage                    "1.0.2"]
+{:user {:plugins [[lein-cloverage                    "1.0.6"]
                   [lein-fore-prob                    "0.1.2"]
                   [lein-ancient                      "0.6.10"]
                   [jonase/eastwood                   "0.2.3"]


closes #89

closes #89

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

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

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


The snapshot list now adds the latest file as soon as it is downloaded.

--- src-cljs/server/main.cljs
+++ src-cljs/server/main.cljs
@@ -57,11 +57,16 @@
         seconds (subs date-str 15)]
     (.getTime (js/Date. (str date-and-hour ":" min ":" seconds)))))

+(defn make-snapshot-entry [fname]
+  (hash-map :image fname, :time (filename-to-time fname)))
+
 (defn on-get-snapshot [response]
-  (let [file-path (.join path (:archive-dir @config) (generate-file-name (js/Date.)))
+  (let [fname (generate-file-name (js/Date.))
+        file-path (.join path (:archive-dir @config) fname)
         file (.createWriteStream fs file-path)]
     (.pipe response file)
-    (.on file "finish" #(.close file))))
+    (.on file "finish" #(.close file))
+    (swap! snapshot-list conj (make-snapshot-entry fname))))

 (defn on-get-snapshot-error [e]
   (log-error (str "Error downloading snapshot: " (.-message e))))
@@ -76,7 +81,7 @@
     (if err (throw (js/Error. "Error reading snapshot directory!")))
     (->> files
       (filter #(= (.extname path %) ".jpg"))
-      (map #(hash-map :image %, :time (filename-to-time %)))
+      (map make-snapshot-entry)
       (sort-by :time >)
       (reset! snapshot-list)))))


Use case instead of nested ifs

Use case instead of nested ifs

--- backend/src/akvo/lumen/lib/aggregation/pivot.clj
+++ backend/src/akvo/lumen/lib/aggregation/pivot.clj
@@ -16,13 +16,10 @@
    `NULL = NULL` is `NULL`. To work around this, we must use another value to represent the
    empty value. For dates, we use 1001-01-01 01:00:00"
   [column]
-  (format "COALESCE(%s, %s)"
-          (:columnName column)
-          (if (= "text" (:type column))
-            "''"
-            (if (= "date" (:type column))
-              "'1001-01-01 01:00:00'::timestamptz"
-              "'NaN'::double precision"))))
+  (format "COALESCE(%s, %s)" (:columnName column) (case (:type column)
+                                                    "text" "''"
+                                                    "date" "'1001-01-01 01:00:00'::timestamptz"
+                                                    "'NaN'::double precision")))

 (defn- apply-pivot [conn table-name {:keys [category-column row-column aggregation value-column]} filter-str]
   (let [source-sql        (let [select (format "SELECT %s, %s, %s(%s)"


Add comments.

Add comments.


Pass complete config from `braid.uploads.core` to `braid.lib.s3`

--- src/braid/uploads/core.cljc
+++ src/braid/uploads/core.cljc
@@ -32,12 +32,6 @@
        :rel "noopener noreferrer"}
       [:img {:src url}]]))

-(defn ->s3config [config]
-  {:api-secret (config :aws-secret-key)
-   :api-key (config :aws-access-key)
-   :region  (config :aws-region)
-   :bucket (config :aws-bucket)})
-
 (def Upload
   {:id uuid?
    :thread-id uuid?
@@ -202,8 +196,7 @@
               (when (or (= user-id (:user-id upload))
                         (group/user-is-group-admin? user-id (:group-id upload)))
                 (when-let [path (s3/upload-url-path (:url upload))]
-                  (s3/delete-file! (->s3config config)
-                                   path))
+                  (s3/delete-file! config path))
                 (db/run-txns!
                   (db.uploads/retract-upload-txn (:id upload))))))

@@ -224,19 +217,14 @@
                   asset-key (URLDecoder/decode (second (re-matches #"^/upload/(.*)" (request :uri))))]
               {:status 302
                :headers {"Cache-Control" (str "private, max-age=" expires-seconds)
-                         "Location" (s3/readable-s3-url
-                                      (->s3config config)
-                                      expires-seconds
-                                      asset-key)}}))])
+                         "Location" (s3/readable-s3-url config expires-seconds asset-key)}}))])

        (base/register-private-http-route!
          [:get "/s3-policy"
           (fn [req]
             ;; TODO check if user is allowed to upload to this group
             (if (user/user-id-exists? (get-in req [:session :user-id]))
-              (if-let [policy (s3/generate-s3-upload-policy
-                                (->s3config config)
-                                {:starts-with ""})]
+              (if-let [policy (s3/generate-s3-upload-policy config {:starts-with ""})]
                 {:status 200
                  :headers {"Content-Type" "application/edn"}
                  :body (pr-str policy)}


Increasing precision for sake of genomic coords

--- src/cavm/views/datasets.clj
+++ src/cavm/views/datasets.clj
@@ -47,7 +47,7 @@
   (.print out
           (if (Double/isNaN x)
             "\"NaN\""
-            (format "%.6g" x))))
+            (format "%.9g" x))))

 (extend mikera.arrayz.INDArray json/JSONWriter {:-write write-array})
 (extend java.lang.Float json/JSONWriter {:-write write-floating-point})


spacing

spacing

--- src/celestial/workflows.clj
+++ src/celestial/workflows.clj
@@ -27,6 +27,7 @@
     [proxmox.provider Container]))

 (import-logging)
+
 (defn resolve- [fqn-fn]
   ;(resolve- (first (keys (get-in config [:hooks :post-create]))))
   (let [[n f] (.split (str fqn-fn) "/")]


Remove unused function arg dataset-id in a.l.l.v.maps/do-create

--- backend/src/akvo/lumen/lib/visualisation/maps.clj
+++ backend/src/akvo/lumen/lib/visualisation/maps.clj
@@ -83,7 +83,7 @@

       :else [(if (not dataset-id) raster-id dataset-id)])))

-(defn do-create [tenant-conn windshaft-url dataset-id layers]
+(defn do-create [tenant-conn windshaft-url layers]
   (let [metadata-array (map (fn [current-layer]
                               (let [current-layer-type (:layerType current-layer)
                                     current-dataset-id (if (= current-layer-type "raster")
@@ -121,8 +121,8 @@
 (defn create
   [tenant-conn windshaft-url layers]
   (try
-    (let [[dataset-id] (conform-create-args layers)]
-      (do-create tenant-conn windshaft-url dataset-id layers))
+    (conform-create-args layers)
+    (do-create tenant-conn windshaft-url layers)
     (catch Exception e
       (println e)
       (lib/bad-request (ex-data e)))))


fix names->idx atom access. we now have the full list of names appearing in the source map.

--- src/clj/cljs/source_map.clj
+++ src/clj/cljs/source_map.clj
@@ -82,7 +82,7 @@
       (let [v (first vs)
             seg [(:gcol v) source-idx line col]
             seg (if-let [name (:name v)]
-                  (let [idx (if-let [idx (get names->idx name)]
+                  (let [idx (if-let [idx (get @names->idx name)]
                               idx
                               (let [cidx @name-idx]
                                 (swap! names->idx assoc name cidx)


disable pipeline debug logging

disable pipeline debug logging

--- src/clj/runbld/pipeline.clj
+++ src/clj/runbld/pipeline.clj
@@ -3,7 +3,7 @@

 (def debug-middleware?
   "Set to true to enable debug logging during before/after/around"
-  true)
+  false)

 (defn symbol-name [fn-sym]
   (try


Hurr durr.  Hurr.

Hurr durr.  Hurr.

--- src/clojurecraft/events.clj
+++ src/clojurecraft/events.clj
@@ -23,19 +23,3 @@
 (defn clear-handlers [bot event-type]
   (dosync (alter (:event-handlers bot) dissoc event-type)))

-
-; Loops ----------------------------------------------------------------------------
-(defn- run-loop [bot function sleep-ms loop-id]
-  (while (and (nil? (:exit @(:connection bot)))
-              (@(:loops bot) loop-id))
-    (handle-action-group bot ((deref function) bot))
-    (Thread/sleep sleep-ms))
-  (dosync (alter (:loops bot) dissoc loop-id)))
-
-
-(defn remove-loop [bot loop-id]
-  (dosync (alter (:loops bot) assoc loop-id nil)))
-
-(defn add-loop [bot function sleep-ms loop-id]
-  (dosync (alter (:loops bot) assoc loop-id :running))
-  (.start (Thread. #(run-loop bot function sleep-ms loop-id))))


don't dispatch on routes from a different host

--- frontend/history.cljs
+++ frontend/history.cljs
@@ -37,9 +37,12 @@
                           target (if (= (.-tagName -target) "A")
                                    -target
                                    (.getAncestorByTagNameAndClass dom-helper -target "A"))
+                          _ (aset js/window "target" target)
                           path (when target (str (.-pathname target) (.-search target) (.-hash target)))]
                       (when (and (seq path)
-                                 (not= "_blank" (.-target target)))
+                                 (not= "_blank" (.-target target))
+                                 (= (.. js/window -location -hostname)
+                                    (.-hostname target)))
                         (utils/mlog "navigating to" path)
                         (.setToken history-imp (subs path 1))
                         (.stopPropagation %)


instructions

instructions

--- statspop/src/statspop/detection.cljs
+++ statspop/src/statspop/detection.cljs
@@ -1,7 +1,13 @@
 (ns statspop.detection
   "attempt to detect tabular data in non-table formats by finding continuous sets of rows of at least size x with at least some y proportion of numbers.  data coming in from chrome extension as documentElement.innerText

- INCOMPLETE"
+ USAGE:
+
+  the only function that should actually be used here is gather-runs.  It takes a string of innerText from a webpage, splits it up into lines,
+  and then finds consecutive runs (of user-specified size) of lines where the ratio of digits to total non-space characters is greater than some user-specified proportion.
+
+  for actual use in the UI, the user will have to be asked to choose heuristic detection and then operate a pair of sliders to do this.
+  "
   (:require [clojure.string :as str]))


Refactored parsing of function definitions

--- parser/parser.clj
+++ parser/parser.clj
@@ -10,7 +10,7 @@
 (typ constructor   (SimpleConstructor   (list int32) range)
                    (ComplexConstructor  (list int32) (list type) range))
 (typ definition    (TypeDefinition      type (list constructor) range)
-                   (FunctionDefinition  (list int32) sexp range)
+                   (FunctionDefinition  (list int32) (list (list int32)) sexp range)
                    (OptOut              sexp))

 (typ error         (MalformedDefinitionError range)
@@ -87,12 +87,17 @@
             (sexp-to-constructors constructors)))
             (sexp-to-type name)))

-(def sexp-to-function-definition (name-symbol rest range)
+(def sexp-to-function-name (name-symbol)
      (match name-symbol
             (Symbol name _)
-                (Result (FunctionDefinition name rest range))
+                (Result name))
             (List _ range)
-                (Error (MalformedFunctionNameError range))))
+                (Error (MalformedFunctionNameError range)))
+
+(def sexp-to-function-definition (name-symbol rest range)
+     (result-map (fn (name)
+                     (FunctionDefinition name Empty rest range))
+                 (sexp-to-function-name name-symbol)))

 (def sexp-to-definition' (kind name rest range)
      (match (type-definition? (symbol-name kind))
@@ -164,7 +169,7 @@
      (match definition
             (Result (TypeDefinition type constructors range))
                 (type-definition-to-sexp type constructors range)
-            (Result (FunctionDefinition name rest range))
+            (Result (FunctionDefinition name _ rest range))
                 (function-definition-to-sexp name rest range)
             (Result (OptOut sexp range))
                 (List sexp range)


used wrong comparison type for strings

used wrong comparison type for strings

--- server/feed/src/feed/messaging_kafka.clj
+++ server/feed/src/feed/messaging_kafka.clj
@@ -10,7 +10,7 @@
 (defn log
   "log a message to topic via kafka"
   [topic entity operation duration]
-  (if (== (System/getenv "MESSAGING_ENABLED") "true")
+  (if (= (System/getenv "MESSAGING_ENABLED") "true")
     (let [now (java.util.Calendar/getInstance)
           msg (str (.get now java.util.Calendar/YEAR)
                    "|"


adding setup for web tests

adding setup for web tests

--- resources/leiningen/new/closp/integtest/clj/web/setup.clj
+++ resources/leiningen/new/closp/integtest/clj/web/setup.clj
@@ -22,7 +22,6 @@
    :smtp-data               {}                                ; passed directly to postmap like {:host "postfix"}
    :jdbc-url                "jdbc:sqlite:./db/closp1.sqlite"
    :env                     :dev
-   ; set this to true to enable self registration
    :registration-allowed?   true
    :captcha-public-key      "your public captcha key"
    :private-recaptcha-key   "your private captcha key"


stray inspect

stray inspect

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -294,7 +294,7 @@
                  (dom/g
                   #js {:transform (cameras/->svg-transform camera)}
                   (om/build cursors (select-keys payload [:subscribers :client-uuid]))
-                  (om/build svg-layers (assoc (select-keys payload [:selected-eid]) :select-tool? (utils/inspect (= :select (get-in payload state/current-tool-path)))))
+                  (om/build svg-layers (assoc (select-keys payload [:selected-eid]) :select-tool? (= :select (get-in payload state/current-tool-path))))
                   (om/build subscriber-layers {:layers (reduce (fn [acc [id subscriber]]
                                                                  (if-let [layer (:layer subscriber)]
                                                                    (conj acc (assoc layer


Replace Header button

Replace Header button

--- src-cljs/frontend/components/header.cljs
+++ src-cljs/frontend/components/header.cljs
@@ -3,6 +3,7 @@
             [frontend.components.common :as common]
             [frontend.components.forms :as forms]
             [frontend.components.license :as license]
+            [frontend.components.pieces.button :as button]
             [frontend.components.pieces.page-header :as page-header]
             [frontend.components.pieces.top-banner :as top-banner]
             [frontend.components.svg :as svg]
@@ -33,18 +34,19 @@
     om/IRender
     (render [_]
       (let [project-id (project-model/id project)
-            vcs-url (:vcs_url project)]
-        (forms/managed-button
-         [:button#follow-project-button.btn.btn-primary
-          {:on-click #(do
-                        (raise! owner [:followed-project {:vcs-url vcs-url :project-id project-id}])
-                        ((om/get-shared owner :track-event) {:event-type :follow-project-clicked
-                                                             :properties {:vcs-url vcs-url
-                                                                          :component "header"}}))
-           :data-loading-text "Following..."
-           :data-failed-text (str "Failed to Follow " (vcs-url/repo-name vcs-url))
-           :data-success-text "Followed"}
-          "Follow " (vcs-url/repo-name vcs-url)])))))
+            vcs-url (:vcs_url project)
+            repo-name (vcs-url/repo-name vcs-url)]
+        (button/managed-button
+         {:on-click #(do
+                      (raise! owner [:followed-project {:vcs-url vcs-url :project-id project-id}])
+                      ((om/get-shared owner :track-event) {:event-type :follow-project-clicked
+                                                           :properties {:vcs-url vcs-url
+                                                                        :component "header"}}))
+          :loading-text "Following..."
+          :failed-text (str "Failed to Follow " repo-name)
+          :success-text "Followed"
+          :primary? true}
+         (str "Follow " repo-name))))))

 (defn show-settings-link? [app]
   (and


add greedier firing for asplan.

add greedier firing for asplan.

--- src/angelic/search/action_set/asplan.clj
+++ src/angelic/search/action_set/asplan.clj
@@ -125,6 +125,32 @@
                        (for [v unfree-pv] [(free-var v)              true])
                        (for [v unfree-pv] [(parent-var v effect-var) false])))
          0))))
+
+
+
+
+(comment ;; Version of above that allows "stealing"
+ (defn make-greedy-fire-action [s effect-var]
+   (let [{:keys [name precond-map effect-map reward] :as factored-primitive}
+         (->> effect-var action-var (state/get-var s))
+         precond-vars (keys (dissoc precond-map effect-var))
+         [free-pv unfree-pv] (util/separate #(state/get-var s (free-var %)) precond-vars)
+         [reserved-pv external-pv] (util/separate #(state/get-var s (parent-var % effect-var))
+                                                  unfree-pv)]
+     (when (state/state-matches-map? s precond-map)
+       (env-util/make-factored-primitive
+        [::GreedyFire name]
+        (into precond-map
+              (concat [[(action-var effect-var) factored-primitive]]
+                      (for [v free-pv]   [(free-var v)              true])
+                      (for [v reserved-pv] [(parent-var v effect-var) true])
+                      (for [v external-pv] [(free-var v) false])
+                      (for [v external-pv] [(parent-var v effect-var) false])))
+        (into effect-map
+              (concat [[(action-var effect-var) nil]]
+                      (for [v reserved-pv] [(free-var v)              true])
+                      (for [v reserved-pv] [(parent-var v effect-var) false])))
+        0)))))


DBDA Ch17 example - added regression with 300 people.

--- test/clojure/uncomplicate/bayadera/examples/dbda/ch17/robust_linear_regression_test.clj
+++ test/clojure/uncomplicate/bayadera/examples/dbda/ch17/robust_linear_regression_test.clj
@@ -28,16 +28,18 @@
 (def all-data (atom {}))
 (def state (atom nil))

-(let [in-file (slurp (io/resource "uncomplicate/bayadera/examples/dbda/ch17/ht-wt-data-30.csv"))]
-  (let [data (loop [c 0 data (drop 1 (csv/read-csv in-file)) hw (transient [])]
-               (if data
-                 (let [[_ h w] (first data)]
-                   (recur (inc c) (next data)
-                          (-> hw
-                              (conj! (double (read-string h)))
-                              (conj! (double (read-string w))))))
-                 (op [c] (persistent! hw))))]
-    (def params (sv data))))
+(defn read-data [in-file]
+  (loop [c 0 data (drop 1 (csv/read-csv in-file)) hw (transient [])]
+    (if data
+      (let [[_ h w] (first data)]
+        (recur (inc c) (next data)
+               (-> hw
+                   (conj! (double (read-string h)))
+                   (conj! (double (read-string w))))))
+      (op [c] (persistent! hw)))))
+
+(def params-30 (sv (read-data (slurp (io/resource "uncomplicate/bayadera/examples/dbda/ch17/ht-wt-data-30.csv")))))
+(def params-300 (sv (read-data (slurp (io/resource "uncomplicate/bayadera/examples/dbda/ch17/ht-wt-data-300.csv")))))

 (def rlr-prior
   (cl-distribution-model [(slurp (io/resource "uncomplicate/bayadera/opencl/distributions/gaussian.h"))
@@ -54,31 +56,43 @@
 (defn analysis []
   (with-default-bayadera
     (with-release [prior (distribution rlr-prior)
-                   prior-dist (prior (sv 5 -200 100 2 4 0.001 1000))
-                   prior-sampler (sampler prior-dist {:limits (sge 2 4 [1 10 -400 100 -10 10 0.001 1000])})
-                   post (posterior "rlr_30" (rlr-likelihood (dim params)) prior-dist)
-                   post-dist (post params)
-                   post-sampler (sampler post-dist {:limits (sge 2 4 [1 10 -400 100 -10 10 0.001 1000])})]
-      (println (time (mix! prior-sampler {:step 256})))
-      (println (time (mix! post-sampler {:step 256})))
-      (histogram! post-sampler 100))))
+                   prior-dist (prior (sv 10 -100 100 0 10 0.001 1000))
+                   prior-sampler (sampler prior-dist {:limits (sge 2 4 [1 20 -400 100 -20 20 0.001 1000])})
+                   post-30 (posterior "rlr_30" (rlr-likelihood (dim params-30)) prior-dist)
+                   post-30-dist (post-30 params-30)
+                   post-30-sampler (sampler post-30-dist {:limits (sge 2 4 [1 20 -400 100 -20 20 0.001 1000])})
+                   post-300 (posterior "rlr_300" (rlr-likelihood (dim params-300)) prior-dist)
+                   post-300-dist (post-300 params-300)
+                   post-300-sampler (sampler post-300-dist {:limits (sge 2 4 [1 20 -400 100 -20 20 0.001 1000])})]
+      (println (time (mix! post-30-sampler {:step 256 :refining 20})))
+      (println (time (mix! post-300-sampler {:step 256 :refining 20})))
+      [(histogram! post-30-sampler 100)
+       (histogram! post-300-sampler 100)])))

 (defn setup []
   (reset! state
           {:data @all-data
-           :nu (plot2d (qa/current-applet) {:width 500 :height 500})
-           :b0 (plot2d (qa/current-applet) {:width 500 :height 500})
-           :b1 (plot2d (qa/current-applet) {:width 500 :height 500})
-           :sigma (plot2d (qa/current-applet) {:width 500 :height 500})}))
+           :nu-30 (plot2d (qa/current-applet) {:width 350 :height 350})
+           :b0-30 (plot2d (qa/current-applet) {:width 350 :height 350})
+           :b1-30 (plot2d (qa/current-applet) {:width 350 :height 350})
+           :sigma-30 (plot2d (qa/current-applet) {:width 350 :height 350})
+           :nu-300 (plot2d (qa/current-applet) {:width 350 :height 350})
+           :b0-300 (plot2d (qa/current-applet) {:width 350 :height 350})
+           :b1-300 (plot2d (qa/current-applet) {:width 350 :height 350})
+           :sigma-300 (plot2d (qa/current-applet) {:width 350 :height 350})}))

 (defn draw []
   (when-not (= @all-data (:data @state))
     (swap! state assoc :data @all-data)
     (q/background 0)
-    (q/image (show (render-histogram (:nu @state) @all-data 0)) 0 0)
-    (q/image (show (render-histogram (:b0 @state) @all-data 1)) 0 520)
-    (q/image (show (render-histogram (:b1 @state) @all-data 2)) 0 1040)
-    (q/image (show (render-histogram (:sigma @state) @all-data 3)) 520 0)))
+    (q/image (show (render-histogram (:nu-30 @state) (@all-data 0) 0)) 0 0)
+    (q/image (show (render-histogram (:b0-30 @state) (@all-data 0) 1)) 0 370)
+    (q/image (show (render-histogram (:b1-30 @state) (@all-data 0) 2)) 0 740)
+    (q/image (show (render-histogram (:sigma-30 @state) (@all-data 0) 3)) 0 1110)
+    (q/image (show (render-histogram (:nu-300 @state) (@all-data 1) 0)) 370 0)
+    (q/image (show (render-histogram (:b0-300 @state) (@all-data 1) 1)) 370 370)
+    (q/image (show (render-histogram (:b1-300 @state) (@all-data 1) 2)) 370 740)
+    (q/image (show (render-histogram (:sigma-300 @state) (@all-data 1) 3)) 370 1110)))

 (defn display-sketch []
   (q/defsketch diagrams


s/(def /(defonce /

s/(def /(defonce /

--- src/babel/italiano/morphology/verbs.cljc
+++ src/babel/italiano/morphology/verbs.cljc
@@ -3,14 +3,14 @@
    [dag_unify.core :refer [unify]]
    [babel.morphology :refer [expand-replace-patterns group-by-two]]))

-(def replace-patterns-gerund
+(defonce replace-patterns-gerund
  (expand-replace-patterns
   {:synsem {:infl :participle}}
   [{:agr :top
     :p [#"(.*)ando$" "$1are"
         #"(.*)ando$" "$1arsi"]}]))

-(def replace-patterns-imperfect-past-tense
+(defonce replace-patterns-imperfect-past-tense
   (expand-replace-patterns
    {:synsem {:infl :imperfect}}
    [
@@ -95,7 +95,7 @@

     ]))

-(def replace-patterns-future-tense
+(defonce replace-patterns-future-tense
   (expand-replace-patterns
    {:synsem {:infl :future}}
    [{:agr {:synsem {:subcat {:1 {:agr {:number :sing
@@ -245,7 +245,7 @@

          ]}]))

-(def replace-patterns-past-tense
+(defonce replace-patterns-past-tense
   (concat
    (expand-replace-patterns
     {:synsem {:infl :past}}
@@ -334,7 +334,7 @@

      ])))

-(def replace-patterns-present-tense
+(defonce replace-patterns-present-tense
   (expand-replace-patterns
    {:synsem {:infl :present}}
    [{:agr {:synsem {:subcat {:1 {:agr {:number :sing
@@ -413,7 +413,7 @@
          #"(.*)ono$"       "$1irsi" ;; vestono -> vestirsi
          ]}]))

-(def replace-patterns-conditional-tense
+(defonce replace-patterns-conditional-tense
   (expand-replace-patterns
    {:synsem {:infl :conditional}}
    [{:agr {:synsem {:subcat {:1 {:agr {:number :sing
@@ -562,27 +562,7 @@
          #"(.*)rrebbero"     "$1lere"  ;; vorrebbero -> volere

          ]}]))
-
-(def replace-patterns
-  (map (fn [each]   ;; unify with {:synsem {:cat :verb}} for all rules.
-         {:p (:p each)
-          :u (unify (:u each)
-                    {:synsem {:cat :verb}})
-          :g (:g each)})
-
-       (concat
-        ;; if more are added in the future, please
-        ;; preserve alphabetical ordering.
-        replace-patterns-conditional-tense
-        replace-patterns-future-tense
-        replace-patterns-gerund
-        replace-patterns-imperfect-past-tense
-        replace-patterns-past-tense
-        replace-patterns-present-tense)))
-
-;; here is my attempt to do present subjunctive - Franco
-
-(def replace-patterns-present-subjunctive
+(defonce replace-patterns-present-subjunctive
   (expand-replace-patterns
    {:synsem {:infl :present}}
    [{:agr {:synsem {:subcat {:1 {:agr {:number :sing
@@ -683,7 +663,7 @@
         replace-patterns-present-subjunctive
         replace-patterns-present-tense)))

-(def exceptions-rules
+(defonce exceptions-rules
   [;; 1. past-tense exceptions
    {:path [:italiano :passato]
     :label "past-tense exception"


~(defn regular-conditional) -non-standard exception thrown

--- src/babel/italiano/morphology/verbs.cljc
+++ src/babel/italiano/morphology/verbs.cljc
@@ -51,17 +51,7 @@
         ;; is expected to be the infinitive for verbs.
         infinitive (get-in word [:future-stem]
                            (get-in word [:italiano]))]
-    (let [conjugations (do-replace-on infinitive unifying-patterns)]
-      (if (empty? conjugations)
-        (throw (Exception. (str "no conjugation found for infinitive: " infinitive " with unifying patterns: "
-                                (string/join "," unifying-patterns)))))
-      (if (not (empty? (rest conjugations)))
-        (throw (Exception. (str "more than one conjugation found for infinitive:'" infinitive "': "
-                                (string/join "," (vec (set conjugations)))
-                                "; word: " (dag_unify.core/strip-refs word)
-                                "; unifying-patterns: " (string/join "," (map dag_unify.core/strip-refs
-                                                                              unifying-patterns))))))
-      (first conjugations))))
+    (first (do-replace-on infinitive unifying-patterns))))

 ;; </conditional>


fix bug where the human ortholog was returning as an ontology branch values instead.

--- src/cljs/gointermod/search/handlers.cljs
+++ src/cljs/gointermod/search/handlers.cljs
@@ -59,12 +59,12 @@
       {} search-results)
 )

-(defn lookup-original-input-identifier [identifier result]
+(defn lookup-original-input-identifier [identifier result result-type]
   (let [id-map (re-frame/subscribe [:mapped-resolved-ids])
   input-identifier (utils/get-id (get @id-map identifier)) ]
   (if input-identifier
     input-identifier
-    (utils/get-id result :original)
+    (utils/get-id result result-type)
 )))

 (defn nonhuman-ortholog-to-input-gene
@@ -85,7 +85,7 @@
   (map (fn [result]
     (let [original-primary-id (get result 7)
           ortho-primary-id (get result 3)
-          human-ortholog (re-frame/subscribe [:input-gene-friendly-id (lookup-original-input-identifier original-primary-id result)])]
+          human-ortholog (re-frame/subscribe [:input-gene-friendly-id (lookup-original-input-identifier original-primary-id result :original)])]

     { :human-ortholog @human-ortholog
       :original-input-gene (nonhuman-ortholog-to-input-gene original-primary-id)
@@ -105,7 +105,7 @@
       :data-set-name (get result 12)
       :data-set-url (get result 13)
       :display-ortholog-id (utils/get-id result :ortholog)
-      :display-original-id (lookup-original-input-identifier original-primary-id result)
+      :display-original-id (lookup-original-input-identifier original-primary-id result :original)
      }
   )) results))

@@ -117,7 +117,7 @@
     (map (fn [result]
       (let [original-primary-id (get result 3)
             input (:input (get @input-map original-primary-id))
-            human-ortholog @(re-frame/subscribe [:input-gene-friendly-id (lookup-original-input-identifier original-primary-id result)])]
+            human-ortholog @(re-frame/subscribe [:input-gene-friendly-id (lookup-original-input-identifier original-primary-id result :original-gene-set)])]
         {:human-ortholog human-ortholog
         :original-input-gene input
         :ortho-db-id na
@@ -135,8 +135,8 @@
         :ontology-branch (get result 9)
         :data-set-name (:dataset (get @original-datasource original-primary-id (str na " - original input gene")))
         :data-set-url na
-        :display-ortholog-id (utils/get-id result :original-gene-set)
-        :display-original-id (lookup-original-input-identifier original-primary-id result)
+  ;      :display-ortholog-id (utils/get-id result :original-gene-set)
+  ;      :display-original-id (lookup-original-input-identifier original-primary-id result)
        }
     )) results)))


Use new orchestration status endpoint to display subsystem statuses (#847)

Use orchestration /status endpoint

--- src/cljs/main/broadfcui/page/status.cljs
+++ src/cljs/main/broadfcui/page/status.cljs
@@ -3,6 +3,7 @@
     [dmohs.react :as react]
     [broadfcui.common.components :as comps]
     [broadfcui.common.style :as style]
+    [broadfcui.config :as config]
     [broadfcui.nav :as nav]
     [broadfcui.utils :as utils]
     ))
@@ -10,49 +11,48 @@

 (react/defc StatusLine
   {:render
-   (fn [{:keys [props state]}]
+   (fn [{:keys [props]}]
      [:div {:style {:marginTop "0.5em"}}
       [:div {}
        (:label props) ": "
        (cond
-         (nil? (:response @state))
+         (nil? (:success? props))
          [comps/Spinner]
-         (not (:success? (:response @state)))
+         (not (:success? props))
          [:span {} [:span {:style {:color "red"}} "Error"]
-          (when-not (:show-error-details? @state)
-            [:span {}
-             " ("
-             (style/create-link
-              {:onClick #(swap! state assoc :show-error-details? true)
-               :text "show details"})
-             ")"])]
+          (when (:errors props)
+            [:div {:style {:backgroundColor "#eee" :padding 6 :fontSize "smaller"}}
+              [:ul {} (map (fn [e] [:li {} e]) (:errors props))]])]
          :else
-         [:span {:style {:color "green"}} "Okay"])]
-      (when (:show-error-details? @state)
-        (let [response (:response @state)]
-          [:div {:style {:backgroundColor "#eee" :padding 6 :fontSize "smaller"}}
-           [:div {} "Status code: " (:status-code response)]
-           [:div {} "Status text: " (:status-text response)]
-           [:div {} "Response text:" [:br] (-> (:xhr response) .-responseText)]]))])
-   :component-did-mount
-   (fn [{:keys [props state]}]
-     (if (= (:path (:request props)) "/profile")
-       (utils/ajax-orch (:path (:request props))
-                        {:on-done #(swap! state assoc :response %)}
-                        :service-prefix "/register")
-       (utils/ajax-orch (:path (:request props))
-                        {:on-done #(swap! state assoc :response %)})))})
+         [:span {:style {:color "green"}} "Okay"])]])})

 (react/defc Page
   {:render
-   (fn [_]
-     [:div {:style {:padding "1em"}}
-      [:h2 {} "Service Status"]
-      [:div {}
-       [StatusLine {:label "Orchestration" :request {:path "/status/ping"}}]
-       [StatusLine {:label "Rawls" :request {:path "/workspaces"}}]
-       [StatusLine {:label "Agora" :request {:path "/methods"}}]
-       [StatusLine {:label "Thurloe" :request {:path "/profile"}}]]])})
+   (fn [{:keys [props state]}]
+     (let [{:keys [status-code status-text response-text parsed-response]} @state
+           orch-ok? (:ok parsed-response)
+           orch-errors [(str "Status Code: " status-code)
+                        (str "Status Text: " status-text)
+                        (str "Response Text: " response-text)]]
+       [:div {:style {:padding "1em"}}
+        [:h2 {} "Service Status"]
+        [:div {}
+         [StatusLine {:label "Orchestration" :success? orch-ok? :errors orch-errors}]
+         (map (fn [system]
+                (let [current (first system)
+                      {:keys [messages ok]} (get-in parsed-response [:systems current])]
+                  [StatusLine {:label (name current) :success? ok :errors messages}]))
+              (:systems parsed-response))]]))
+   :component-did-mount
+   (fn [{:keys [props state]}]
+     (utils/ajax {:url (str (config/api-url-root) "/status")
+                  :method "GET"
+                  :on-done (fn [{:keys [status-code status-text raw-response get-parsed-response]}]
+                             (swap! state assoc
+                                    :status-code status-code
+                                    :status-text status-text
+                                    :response-text raw-response
+                                    :parsed-response (get-parsed-response)))}))})

 (defn add-nav-paths []
   (nav/defpath


Add more example

Add more example

--- src/clojure_walkthrough/cjia/ch05_xx.clj
+++ src/clojure_walkthrough/cjia/ch05_xx.clj
@@ -39,6 +39,8 @@
 (Calendar/JANUARY) ;; 0

 (Calendar/FEBRUARY) ;; 1
+
+(Calendar/MARCH) ;; 2

 ;; 5.1.4 Macros and the dot special form


Adjust deletion rate in uniform-addition-and-deletion.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -370,18 +370,19 @@
   uniform-addition-and-deletion-rate."
   [ind {:keys [uniform-addition-and-deletion-rate maintain-ancestors atom-generators]
         :as argmap}]
-  (let [rate (if (number? uniform-addition-and-deletion-rate)
-               uniform-addition-and-deletion-rate
-               (lrand-nth uniform-addition-and-deletion-rate))
+  (let [addition-rate (if (number? uniform-addition-and-deletion-rate)
+                        uniform-addition-and-deletion-rate
+                        (lrand-nth uniform-addition-and-deletion-rate))
+        deletion-rate (/ 1 (+ (/ 1 addition-rate) 1))
         after-addition (vec (apply concat
-                                   (map #(if (< (lrand) rate)
+                                   (map #(if (< (lrand) addition-rate)
                                            (lshuffle [%
                                                       (random-plush-instruction-map
                                                         atom-generators argmap)])
                                            [%])
                                         (:genome ind))))
         new-genome (vec (filter identity
-                                (map #(if (< (lrand) rate) nil %)
+                                (map #(if (< (lrand) deletion-rate) nil %)
                                      after-addition)))]
     (make-individual :genome new-genome
                      :history (:history ind)
@@ -804,3 +805,4 @@

+


Add not-empty diversification test

Add not-empty diversification test

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -1003,6 +1003,13 @@
       (and (not= pgm parent1-pgm)
            (not= pgm parent2-pgm)))))

+(defn not-empty-diversifying?
+  [ind argmap]
+  (assoc ind :diversifying
+         (not (empty? (translate-plush-genome-to-push-program
+                       {:genome (:genome ind)}
+                       argmap)))))
+
 (defn minimum-genetic-difference-diversifying?
   [ind {:keys [parent1-genome parent2-genome]}]
   (let [g (:genome ind)]
@@ -1759,6 +1766,7 @@
                 :doesnt-clone-genetically doesnt-clone-genetically-diversifying?
                 :child-doesnt-clone child-doesnt-clone-diversifying?
                 :not-a-clone not-a-clone-diversifying?
+                :not-empty :not-empty-diversifying?
                 :minimum-genetic-difference minimum-genetic-difference-diversifying?
                 :different-errors different-errors-diversifying?
                 :new-instruction new-instruction-diversifying?


Added one of many possible alternative definitions of diversifying? in a comment.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -314,6 +314,24 @@
     (and (> (reduce min diffs) 0) ;; diversification threshold set here
          (> (count (distinct diffs)) 1))))

+;; One of many possible alternative definitions of diversifying?
+;(defn diversifying?
+;  "Returns true iff genome g passes the diversification test."
+;  [g argmap]
+;  (let [make-child #(produce-child-genome-by-autoconstruction % % false argmap)
+;        diff #(expressed-difference %1 %2 argmap)
+;        c1 (make-child g)
+;        c2 (make-child g)
+;        gc1 (make-child c1)
+;        gc2 (make-child c2)
+;        c1-diff (diff g c1)
+;        c2-diff (diff g c2)
+;        gc1-diff (diff c1 gc1)
+;        gc2-diff (diff c2 gc1)
+;        diffs [c1-diff c2-diff gc1-diff gc2-diff]]
+;    (and (> (reduce min diffs) 0)
+;         (apply distinct? diffs))))
+
 (defn autoconstruction
   "Returns a genome for a child produced either by autoconstruction (executing parent1
 with both parents on top of the genome stack and also available via input instructions)


Handle mux problem input vars correctly in process-genome-for-autoconstruction.

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -247,7 +247,9 @@
   (let [input-instruction? (fn [instruction]
                              (and (symbol? instruction)
                                   (or (re-seq #"in\d+" (name instruction)) ;; from input-output
-                                      (re-seq #"in_dm" (name instruction)))))] ;; from digital-multiplier
+                                      (re-seq #"in_dm" (name instruction)) ;; from digital-multiplier
+                                      (some #{instruction}
+                                            '(a0 a1 a2 d0 d1 d2 d3 d4 d5 d6 d7)))))] ;; from mux problems
     (map (fn [instruction-map]
            (if (input-instruction? (:instruction instruction-map))
              (assoc instruction-map :instruction 'code_noop)


Changed acceptance tests to use service.url property

--- src/leiningen/new/cljskel/acceptance.clj
+++ src/leiningen/new/cljskel/acceptance.clj
@@ -10,7 +10,7 @@

 (def host (get (System/getenv) "HOST" "localhost"))
 (def port (Integer. (get (System/getenv) "JETTY_PORT" 8080)))
-(def base-url (str "http://" host ":" port "/1.x/"))
+(def base-url (System/getProperty "service.url" (str "http://localhost:" port "/1.x/")))

 (defn url+ [& suffix] (apply str base-url suffix))


Aggregate reactions before rendering the entry.

--- src/oc/storage/representations/board.clj
+++ src/oc/storage/representations/board.clj
@@ -7,7 +7,8 @@
             [oc.storage.representations.org :as org-rep]
             [oc.storage.resources.board :as board-res]
             [oc.storage.urls.board :as board-url]
-            [oc.storage.representations.entry :as entry-rep]))
+            [oc.storage.representations.entry :as entry-rep]
+            [oc.storage.resources.reaction :as reaction-res]))

 (def public-representation-props [:uuid :slug :name :access :promoted :entries :created-at :updated-at :links])
 (def representation-props (concat public-representation-props [:slack-mirror :author :authors :viewers :draft]))
@@ -110,7 +111,7 @@
 (defn render-entry-for-collection
   "Create a map of the activity for use in a collection in the API"
   [org board entry access-level user-id]
-  (entry-rep/render-entry-for-collection org board entry (entry-rep/comments entry) (entry-rep/reactions entry) access-level user-id))
+  (entry-rep/render-entry-for-collection org board entry (entry-rep/comments entry) (reaction-res/aggregate-reactions (entry-rep/reactions entry)) access-level user-id))

 (defn render-board-for-collection
   "Create a map of the board for use in a collection in the REST API"


Using goog.object in map_views

Using goog.object in map_views

--- src/pasmo_gigi/geo/ui/map/map_views.cljs
+++ src/pasmo_gigi/geo/ui/map/map_views.cljs
@@ -1,17 +1,18 @@
 (ns pasmo-gigi.geo.ui.map.map-views
   (:require [re-frame.core :refer [subscribe dispatch]]
             [reagent.core :as r]
+            [goog.object :as gob]
             [pasmo-gigi.geo.ui.db :refer [settings]]))

 (def FEATURE-LAYER (r/atom nil))

 (defn render-map
   []
-  (let [mapbox-api (:mapbox-api @settings)
-        map-el (.map (-> mapbox-api .-mapbox) "map" "uris77.nd0o07dd")
-        feature-layer (.addTo (-> mapbox-api
-                                  .-mapbox
-                                  .featureLayer) map-el)]
+  (let [mapbox-api       (:mapbox-api @settings)
+        mapbox-prop      (gob/get mapbox-api "mapbox")
+        map-el           (.map mapbox-prop  "map" "uris77.nd0o07dd")
+        feature-layer-fn (.featureLayer mapbox-prop)
+        feature-layer    (.addTo feature-layer-fn map-el)]
     (reset! FEATURE-LAYER feature-layer)))

 (defn map-coords


Channels are now top level (not in :channels :channels)

--- src/strange_coop/components/channels.clj
+++ src/strange_coop/components/channels.clj
@@ -6,7 +6,7 @@
             [strange-coop.util :refer [log log-tr]]))

-(defrecord Channels [config channels]
+(defrecord Channels [config]
   component/Lifecycle
   (start [component]
     (log "Initializing channels")
@@ -20,18 +20,18 @@
       (doseq [c [log-chan sat-notif-chan status-led-chan]]
         (async/tap notif-mult c))
       (assoc component
-             :channels
-             {:notify            notif-chan
-              :log               log-chan
-              :satellite-notify  sat-notif-chan
-              :status-led-notify status-led-chan
-              :door              door-chan})))
+             :notify            notif-chan
+             :log               log-chan
+             :satellite-notify  sat-notif-chan
+             :status-led-notify status-led-chan
+             :door              door-chan)))

   (stop [component]
     (log "Dropping channels")
-    (doseq [[k c] (:channels component)]
-      (async/close! c))
-    (assoc component :channels nil)))
+    ;; Config is the only attribute that isn't a channel
+    (doseq [k (remove #{:config} (keys component))]
+      (async/close! (get component k))
+      (assoc component k nil))))

 (defn new-channels


updated ext protocol

updated ext protocol

--- src/duffel/ext_protocol.clj
+++ src/duffel/ext_protocol.clj
@@ -3,36 +3,10 @@
 (defprotocol duffel-extension
     "Protocol which defines an extension which can be used by duffel"

-    (preprocess-dir [x dir-tree]
-        "Called on a dir-tree for doing transformations before the metadata
-        templates get applied. Should return the transformed dir-tree. Shouldn't
-        have side-effects")
+    (process-dir [x app dtree]
+        "Called on a dtree with this extension. Should return the new dtree that
+        you want processing to continue on (the parent is processed before any
+        children. Side-effects should also go here")

-    (preprocess-file [x file-struct]
-        "Called on a file-struct for doing transformations before the metadata
-        templates get applied. Should return the transformed file-struct.
-        Shouldn't have side-effects")
-
-    (dir-meta-tpl [x]
-        "Returns the massage template which will be applied to the metadata for
-        dirs")
-
-    (file-meta-tpl [x]
-        "Returns the massage template which will be applied to the metadata for
-        files")
-
-    (postprocess-dir [x dir-struct]
-        "Called on a dir-struct (NOT dir-tree) after the massage templates are
-        applied, before actual processing happens")
-
-    (postprocess-file [x file-struct]
-        "Called on a file-struct after the massage templates are applied, before
-        actual processing happens")
-
-    (process-dir [x app meta-struct abs local]
-        "Called for dir to do actual processing. This is where all the
-        side-effects go")
-
-    (process-file [x app meta-struct abs local]
-        "Called for a file to do actual processing. This is where all the
-        side-effects go"))
+    (process-file [x app file-map]
+        "called on a file-map with this extension"))


Refactor

Refactor

--- backend/src/akvo/lumen/lib/auth.clj
+++ backend/src/akvo/lumen/lib/auth.clj
@@ -27,25 +27,30 @@
 (defrecord AuthServiceImpl [auth-datasets-set auth-visualisations-set auth-dashboards-set auth-collections-set]
   p/AuthService2080
   (optimistic-allow? [this ids]
-    (set/subset? (set/union (:dataset-ids ids) (:visualisation-ids ids) (:dashboard-ids ids) (:collection-ids ids))
-                 (set/union auth-datasets-set auth-visualisations-set auth-dashboards-set auth-collections-set)))
+    (set/subset? (set/union (:dataset-ids ids) (:visualisation-ids ids)
+                            (:dashboard-ids ids) (:collection-ids ids))
+                 (set/union auth-datasets-set auth-visualisations-set
+                            auth-dashboards-set auth-collections-set)))
   p/AuthService
   (allow? [this ids]
     (and (set/subset? (:visualisation-ids ids) auth-visualisations-set)
          (set/subset? (:dataset-ids ids) auth-datasets-set)
          (set/subset? (:dashboard-ids ids) auth-dashboards-set)
          (set/subset? (:collection-ids ids) auth-collections-set)))
+
   (auth [this {:keys [dataset-ids visualisation-ids dashboard-ids collections-ids]}]
-    {:auth-datasets (set/intersection auth-datasets-set (set dataset-ids))
+    {:auth-datasets       (set/intersection auth-datasets-set (set dataset-ids))
      :auth-visualisations (set/intersection auth-visualisations-set (set visualisation-ids))
-     :auth-dashboards (set/intersection auth-dashboards-set (set dashboard-ids))
-     :auth-collections (set/intersection auth-collections-set (set collections-ids))})
+     :auth-dashboards     (set/intersection auth-dashboards-set (set dashboard-ids))
+     :auth-collections    (set/intersection auth-collections-set (set collections-ids))})
+
   (auth [this type* uuid]
-    (condp = type*
-      :dataset (when (contains? auth-datasets-set uuid) uuid)
-      :visualisation (when (contains? auth-visualisations-set uuid) uuid)
-      :dashboard (when (contains? auth-dashboards-set uuid) uuid)
-      :collection (when (contains? auth-collections-set uuid) uuid))))
+    (let [f* (fn [s u] (when (contains? s u) u))]
+      (condp = type*
+        :dataset       (f* auth-datasets-set uuid)
+        :visualisation (f* auth-visualisations-set uuid)
+        :dashboard     (f* auth-dashboards-set uuid)
+        :collection    (f* auth-collections-set uuid)))))

 (defn new-auth-service [{:keys [auth-datasets auth-visualisations auth-dashboards auth-collections] :as auth-uuid-tree}]
   (AuthServiceImpl. (set auth-datasets) (set auth-visualisations) (set auth-dashboards) (set auth-collections)))
@@ -113,6 +118,7 @@
                                  {:dataset-ids auth-datasets
                                   :visualisation-ids auth-visualisations
                                   :dashboard-ids auth-dashboards})))
+
 (defn wrap-auth-datasets
   "Add to the request an auth-service protocol impl using flow-api check_permissions"
   [tenant-manager flow-api]
@@ -153,38 +159,38 @@
                    ::flow-api]))

 (defn ids [spec data]
-  (let [ids (atom {:dataset-ids #{}
-                   :dashboard-ids #{}
-                   :visualisation-ids #{}
-                   :collection-ids #{}})
-        original-vis-id? visualisation.s/*id?*
-        original-ds-id? dataset.s/*id?*
+  (let [ids               (atom {:dataset-ids       #{}
+                                 :dashboard-ids     #{}
+                                 :visualisation-ids #{}
+                                 :collection-ids    #{}})
+        original-vis-id?  visualisation.s/*id?*
+        original-ds-id?   dataset.s/*id?*
         original-dash-id? dashboard.s/*id?*
-        original-col-id? collection.s/*id?*
-        ds-fun (fn [id]
-                 (swap! ids update :dataset-ids conj id)
-                 (try
-                   (original-vis-id? id)
-                   (catch Exception e false)))
-        vis-fun (fn [id]
-                  (swap! ids update :visualisation-ids conj id)
-                  (try
-                    (original-ds-id? id)
-                    (catch Exception e false)))
-        dash-fun (fn [id]
-                  (swap! ids update :dashboard-ids conj id)
-                  (try
-                    (original-dash-id? id)
-                    (catch Exception e false)))
-        col-fun (fn [id]
-                  (swap! ids update :collection-ids conj id)
-                  (try
-                    (original-col-id? id)
-                    (catch Exception e false)))]
+        original-col-id?  collection.s/*id?*
+        ds-fun            (fn [id]
+                            (swap! ids update :dataset-ids conj id)
+                            (try
+                              (original-vis-id? id)
+                              (catch Exception e false)))
+        vis-fun           (fn [id]
+                            (swap! ids update :visualisation-ids conj id)
+                            (try
+                              (original-ds-id? id)
+                              (catch Exception e false)))
+        dash-fun          (fn [id]
+                            (swap! ids update :dashboard-ids conj id)
+                            (try
+                              (original-dash-id? id)
+                              (catch Exception e false)))
+        col-fun           (fn [id]
+                            (swap! ids update :collection-ids conj id)
+                            (try
+                              (original-col-id? id)
+                              (catch Exception e false)))]
     (binding [visualisation.s/*id?* vis-fun
-              dataset.s/*id?* ds-fun
-              dashboard.s/*id?* dash-fun
-              collection.s/*id?* col-fun]
+              dataset.s/*id?*       ds-fun
+              dashboard.s/*id?*     dash-fun
+              collection.s/*id?*    col-fun]
       (let [explain (s/explain-str spec data)]
         (swap! ids assoc :spec-valid? (s/valid? spec data))
         (deref ids)))))


clarify cljs.test/run-tests docstring

clarify cljs.test/run-tests docstring

--- src/main/cljs/cljs/test.clj
+++ src/main/cljs/cljs/test.clj
@@ -281,7 +281,10 @@

 (defmacro run-tests
   "Runs all tests in the given namespaces; prints results.
-  Defaults to current namespace if none given."
+  Defaults to current namespace if none given. Does not return a meaningful
+  value due to the possiblity of asynchronous execution. To detect test
+  completion add a :end-run-tests method case to the cljs.test/report
+  multimethod."
   ([] `(run-tests (cljs.test/empty-env) '~ana/*cljs-ns*))
   ([env-or-ns]
    (if (ns? env-or-ns)