Extracts functions

Extracts functions

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -286,92 +286,122 @@
    (header-label "Missing spec")
    (expected-str _type spec-name val path problems opts)))

+(defmethod expected-str :problem/insufficient-input [_type spec-name val path problems opts]
+  (s/assert ::singleton problems)
+  (let [problem (first problems)]
+    (insufficient-input spec-name val path problem)))
+
 (defmethod problem-group-str :problem/insufficient-input [_type spec-name val path problems opts]
+  (printer/format
+   "%s
+
+%s
+
+%s"
+   (header-label "Syntax error")
+   (show-spec-name spec-name (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path))))
+   (expected-str _type spec-name val path problems opts)
+   ))
+
+(defmethod expected-str :problem/extra-input [_type spec-name val path problems opts]
+  (s/assert ::singleton problems)
+  (let [problem (first problems)]
+    (extra-input spec-name val path)
+    ))
+
+(defmethod problem-group-str :problem/extra-input [_type spec-name val path problems opts]
+  (printer/format
+   "%s
+
+%s
+
+%s"
+   (header-label "Syntax error")
+   (show-spec-name spec-name (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path))))
+   (expected-str _type spec-name val path problems opts)
+   ))
+
+(defmethod expected-str :problem/fspec-exception-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
-     "%s
-
-%s
-
-%s"
-     (header-label "Syntax error")
-     (show-spec-name spec-name (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path))))
-     (insufficient-input spec-name val path problem))))
-
-(defmethod problem-group-str :problem/extra-input [_type spec-name val path problems opts]
+     "threw exception
+
+%s
+
+with args:
+
+%s"
+     (printer/indent (pr-str (:reason problem)))
+     (printer/indent (string/join ", " (:val problem))))))
+
+(defmethod problem-group-str :problem/fspec-exception-failure [_type spec-name val path problems opts]
+  (printer/format
+   "%s
+
+%s
+
+%s"
+   (header-label "Exception")
+   (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path)))
+   (expected-str _type spec-name val path problems opts)))
+
+(defmethod expected-str :problem/fspec-ret-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
-     "%s
-
-%s
-
-%s"
-     (header-label "Syntax error")
-     (show-spec-name spec-name (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path))))
-     (extra-input spec-name val path))))
-
-
-(defmethod problem-group-str :problem/fspec-exception-failure [_type spec-name val path problems opts]
+     "returned an invalid value
+
+%s
+
+should satisfy
+
+%s"
+     (printer/indent (pr-str (:val problem)))
+     (printer/indent (pr-pred (:pred problem) (:spec problem)))
+     ))
+  )
+
+(defmethod problem-group-str :problem/fspec-ret-failure [_type spec-name val path problems opts]
+  (printer/format
+   "%s
+
+%s
+
+%s"
+   (header-label "Function spec failed")
+   (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path)))
+   (expected-str _type spec-name val path problems opts)))
+
+(defmethod expected-str :problem/fspec-fn-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
-     "%s
-
-%s
-
-threw exception
-
-%s
-
-with args:
-
-%s"
-     (header-label "Exception")
-     (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path)))
-     (printer/indent (pr-str (:reason problem)))
-     (printer/indent (string/join ", " (:val problem))))))
-
-(defmethod problem-group-str :problem/fspec-ret-failure [_type spec-name val path problems opts]
-  (s/assert ::singleton problems)
-  (let [problem (first problems)]
-    (printer/format
-     "%s
-
-%s
-
-returned an invalid value
+     "failed spec. Function arguments and return value

 %s

 should satisfy

 %s"
-     (header-label "Function spec failed")
-     (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path)))
      (printer/indent (pr-str (:val problem)))
-     (printer/indent (pr-pred (:pred problem) (:spec problem))))))
+     (printer/indent (pr-pred (:pred problem) (:spec problem)))
+     )
+    )
+  )

 (defmethod problem-group-str :problem/fspec-fn-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
-  (let [problem (first problems)]
-    (printer/format
-     "%s
-
-%s
-
-failed spec. Function arguments and return value
-
-%s
-
-should satisfy
-
-%s"
-     (header-label "Function spec failed")
-     (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path)))
-     (printer/indent (pr-str (:val problem)))
-     (printer/indent (pr-pred (:pred problem) (:spec problem))))))
+  (printer/format
+   "%s
+
+%s
+
+%s"
+   (header-label "Function spec failed")
+   (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path)))
+   (expected-str _type spec-name val path problems opts)
+   ))

 (defmethod problem-group-str :problem/unknown [_type spec-name val path problems opts]
   (assert (apply = (map :val problems)) (str "All values should be the same, but they are " problems))


Clean up namespace requires

Clean up namespace requires

--- src/braid/server/db.clj
+++ src/braid/server/db.clj
@@ -1,10 +1,9 @@
 (ns braid.server.db
   (:require
+    [braid.server.conf :refer [config]]
+    [braid.server.schema :refer [schema]]
     [datomic.api :as d]
-    [mount.core :refer [defstate]]
-    [braid.common.util :refer [extract]]
-    [braid.server.conf :refer [config]]
-    [braid.server.schema :refer [schema]]))
+    [mount.core :refer [defstate]]))

 (defn install-schema! [db-url]
  (d/transact (d/connect db-url)


Remove cell as separate component

Remove cell as separate component

--- src/gol/client/ui.cljs
+++ src/gol/client/ui.cljs
@@ -3,12 +3,6 @@
   (:require [reagent.core :as r :refer [atom]]
             [cljs.core.async :as async :refer [chan timeout <! put!]]
             [gol.client.bl :refer [filter-on-viewport step]]))
-
-(defn cell
-  [c x y cell]
-  [:b.cell
-   {:on-click (fn [] (put! c {:msg :toggle :loc [x y]}))}
-   (when cell [:i])])

 (defn main-component
   [state channels]
@@ -22,15 +16,21 @@
             (let [ns (swap! state update-in [:universe :population] (if (= t :limited) (comp set (partial filter-on-viewport w h) step) step))]
               (when (empty? (get-in ns [:universe :population]))
                 (put! (:actions channels) {:msg :status :status :stasis})))))))
-  (fn [state channels] (into [:ul.cell-area] (let [s @state
-                                            w (get-in s [:viewport :width])
-                                            h (get-in s [:viewport :height])
-                                            p (get-in s [:universe :population])]
-                                        (for [x (range w)]
-                                          (into
-                                            [:li]
-                                            (for [y (range h)]
-                                              [cell (:actions channels) x y (p [x y])])))))))
+  (fn [state channels]
+    (let [s @state
+          w (get-in s [:viewport :width])
+          h (get-in s [:viewport :height])
+          p (get-in s [:universe :population])
+          c (:actions channels)]
+      (into
+        [:ul.cell-area]
+        (for [x (range w)]
+          (into
+            [:li]
+            (for [y (range h)]
+              [:b.cell
+               {:on-click (fn [] (put! c {:msg :toggle :loc [x y]}))}
+               (when (p [x y]) [:i])])))))))

 (defn control-component
   [state channels]
@@ -45,7 +45,7 @@
      [:div
       [:button {:on-click (fn []
                             (case
-                              (get-in @state [:evolution :status])
+                                (get-in @state [:evolution :status])
                               :stasis (put! (:actions channels) {:msg :status :status :progress})
                               :progress (put! (:actions channels) {:msg :status :status :stasis})))}
        (if (= (get-in @state [:evolution :status]) :stasis) "Play" "Pause")]


Put title of selected note on detail button

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -79,16 +79,8 @@
     (add-background! svg)
     svg))

-(defn center-detail-button! [detail-button]
-  (let [width (-> detail-button .node .-offsetWidth)]
-    (.style detail-button "margin-left" (str (/ width -2) "px"))))
-
 (defn prevent-focus-on-detail-button! [detail-button]
   (.on detail-button "mouseup" #(-> detail-button .node .blur)))
-
-(defn setup-detail-button! [detail-button]
-  (center-detail-button! detail-button)
-  (prevent-focus-on-detail-button! detail-button))

 ;; Geometry

@@ -169,12 +161,20 @@
 (defn projectors-for-state [state]
   (if (= (:projection state) :fisheye) fisheye-projectors zoom-out-projectors))

+;; Button syncing
+
+(defn center-detail-button! [detail-button]
+  (let [width (-> detail-button .node .-offsetWidth)]
+    (.style detail-button "margin-left" (str (/ width -2) "px"))))
+
+(defn sync-detail-button! [state]
+  (let [{:keys [detail-button selected-node]} state]
+    (.classed detail-button "hidden" (nil? selected-node))
+    (when-not (nil? selected-node)
+      (.text detail-button (str "View \"" (:title selected-node) "\""))
+      (center-detail-button! detail-button))))
+
 ;; D3 magic
-
-(defn add-tap-listener [elem callback]
-  (let [manager (js/Hammer.Manager. elem)]
-    (.add manager (js/Hammer.Tap.))
-    (.on manager "tap" callback)))

 (defn sync-graph! [state & {:keys [animate?]}]
   (let [{:keys [svg
@@ -269,8 +269,6 @@
           (.attr "font-weight" (fn [node]
                                  (if (identical? node selected-node) "bold" "normal")))
           (.text #(:title %))))
-    (.classed detail-button "invisible" (or (nil? selected-node)
-                                            (= projection :zoom-out)))
     (when animate?
       (.onNext animation-subject :animation-start)
       (js/setTimeout
@@ -305,12 +303,14 @@
 (defn swap-state! [current-state f & args]
   (apply swap! current-state f args)
   (enforce-state-invariants! current-state)
-  (sync-graph! @current-state))
+  (sync-graph! @current-state)
+  (sync-detail-button! @current-state))

 (defn swap-state-animated! [current-state f & args]
   (apply swap! current-state f args)
   (enforce-state-invariants! current-state)
-  (sync-graph! @current-state :animate? true))
+  (sync-graph! @current-state :animate? true)
+  (sync-detail-button! @current-state))

 (defn move-camera! [current-state d]
   (swap-state! current-state update :camera-pos v/add
@@ -660,7 +660,7 @@
         current-state (atom (initial-state svg
                                            detail-button
                                            animation-subject))]
-    (setup-detail-button! detail-button)
+    (prevent-focus-on-detail-button! detail-button)
     (sync-on-window-size! current-state)
     (load-graph "miserables.json"
                 (fn [graph]


Don't check for error if results are empty

--- src/clj/cglossa/search/cwb/shared.clj
+++ src/clj/cglossa/search/cwb/shared.clj
@@ -57,6 +57,7 @@
                      (sh/stream-to-string cqp :out :encoding encoding))
           ;; Split into lines and throw away the first line, which contains the CQP version
           results  (rest (str/split-lines out))]
-      (if (re-find #"PARSE ERROR|CQP Error" (first results))
+      (if (and (pos? (count results))
+               (re-find #"PARSE ERROR|CQP Error" (first results)))
         (throw (str "CQP error: " results))
         results))))


bumped month.

bumped month.

--- src/clj/forma/hadoop/jobs/scatter.clj
+++ src/clj/forma/hadoop/jobs/scatter.clj
@@ -55,7 +55,7 @@
 ;; ## Forma
 (def forma-run-parameters
   {"1000-32" {:est-start "2005-12-01"
-              :est-end "2011-07-01"
+              :est-end "2011-08-01"
               :s-res "1000"
               :t-res "32"
               :neighbors 1
@@ -64,7 +64,7 @@
               :long-block 15
               :window 5}
    "1000-16" {:est-start "2005-12-01"
-              :est-end "2011-07-01"
+              :est-end "2011-08-01"
               :s-res "1000"
               :t-res "16"
               :neighbors 1
@@ -129,20 +129,21 @@
   bucket "
   [unbucketed-path bucketed-path country-code-seq]
   (let [keep-countries (into [] (map vector country-code-seq))
-        template-fields ["?s-res" "?country" "?datestring"]
-        data-fields     ["?mod-h" "?mod-v" "?sample" "?line" "?text"]
+        template-fields ["?s-res" "?country"]
+        data-fields     ["?datestring" "?mod-h" "?mod-v" "?sample" "?line" "?text"]
         forma-fields    (concat template-fields data-fields)
         src (hfs-seqfile unbucketed-path)]
     (?- (hfs-textline bucketed-path
                       :sinkmode :replace
-                      :sink-template "%s/%s/%s/"
+                      :sink-template "%s/%s/"
                       :outfields data-fields
                       :templatefields template-fields
                       :sinkparts 3)
         (if country-code-seq
           (<- forma-fields
               (src :>> forma-fields)
-              (keep-countries ?country :> true))
+              (keep-countries ?country :> true)
+              (:distinct false))
           (name-vars src forma-fields)))))

 (defmain RunForma
@@ -151,7 +152,7 @@
                        (map read-string))
         temp-path "s3n://formares/unbucketed"]
     (process-forma pail-path ts-pail-path temp-path run-key countries)
-    (bucket-forma temp-path results-path)))
+    (bucket-forma temp-path results-path (map name countries))))

 (defmain BucketForma
   [source-path results-path & codes]


docstring about root subscription

docstring about root subscription

--- src/cljc/commos/delta/compscribe.cljc
+++ src/cljc/commos/delta/compscribe.cljc
@@ -275,6 +275,9 @@

   spec-map is a map {(key (spec-map | spec))+}

+  A spec may only be used directly in a spec if endpoint streams a
+  set.
+
   Deltas are transformed according to the following rules:

   1. If the value at key is not a set, deltas are subscribed at the


docstring: subs-ch is never closed elsewhere

--- src/cljc/commos/delta/compscribe.cljc
+++ src/cljc/commos/delta/compscribe.cljc
@@ -293,8 +293,7 @@
   return a unique core.async channel from which deltas can be taken.

   unsubs-fn may be invoked with the channel returned from subs-fn. It
-  must close the channel and is not invoked if the channel is closed
-  elsewhere.
+  must close the channel.

   id is used to make an initial subscription at the root endpoint.


Do not refresh the list of productions on repair

We typically do not repair a (paged) list of productions, so the
corner case where you are showing only one production and once that is
repaired we need to fetch the next possible productions is not really
relevant here.

--- src/cljs/mdr2/productions/repair.cljs
+++ src/cljs/mdr2/productions/repair.cljs
@@ -59,17 +59,13 @@
                                 :on-success      [::ack-repair uuid]
                                 :on-failure      [::ack-failure uuid :repair]})})))

-(rf/reg-event-fx
+(rf/reg-event-db
   ::ack-repair
-  (fn [{:keys [db]} [_ uuid]]
-    (let [db (-> db
-                 ;; drop the production that is going to be repaired from the list
-                 (update-in [:productions :repair] dissoc uuid)
-                 (notifications/clear-button-state uuid :repair))
-          empty? (-> db (get-in [:productions :repair]) count (< 1))]
-      (if empty?
-        {:db db :dispatch [::fetch-productions]}
-        {:db db}))))
+  (fn [db [_ uuid]]
+    (-> db
+        ;; drop the production that is going to be repaired from the list
+        (update-in [:productions :repair] dissoc uuid)
+        (notifications/clear-button-state uuid :repair))))

 (rf/reg-event-db
  ::ack-failure


game-of-life:: structuring cells with alive neighbours

--- src/clojure_learning/game_of_life.clj
+++ src/clojure_learning/game_of_life.clj
@@ -22,13 +22,14 @@
   (map #(str/split % #"") table))

 (def matrix (table->matrix r))
+matrix

-[row col]
-[0 0]:: [0 1] [1 0] [1 1]
-
-[1 1]:: [0 0] [0 1] [0 2]
-        [1 0]       [1 2]
-        [2 0] [2 1] [2 2]
+;[row col]
+;[0 0]:: [0 1] [1 0] [1 1]
+;
+;[1 1]:: [0 0] [0 1] [0 2]
+;        [1 0]       [1 2]
+;        [2 0] [2 1] [2 2]

 (defn gen-neighbours-by-row [[row col] row-func]
@@ -44,6 +45,7 @@
       (gen-raw-neighbours-by-row [row col] row-func))))

 (gen-neighbours-by-row [0 1] dec) ;; ()
+(gen-neighbours-by-row [0 1] inc) ;; ((1 0) (1 1) (1 2))
 (gen-neighbours-by-row [1 1] dec) ;; ((0 0) (0 1) (0 2))

 (defn gen-neighbours-for [[row col :as cell-coordinates]]
@@ -64,10 +66,10 @@
           (previous-row-func [coordinate] (dec coordinate))
           (next-row-func [coordinate] (inc coordinate))
           (current-row-func [coordinate] (identity coordinate))]
-    (concat
-      (gen-neighbours-by-row [row col] previous-row-func)
-      (remove #(= cell-coordinates %) (gen-neighbours-by-row [row col] current-row-func))
-      (gen-neighbours-by-row [row col] next-row-func)
+    ((comp vec concat)
+      (map vec (gen-neighbours-by-row [row col] previous-row-func))
+      (map vec (remove #(= cell-coordinates %) (gen-neighbours-by-row [row col] current-row-func)))
+      (map vec (gen-neighbours-by-row [row col] next-row-func))
     )))

 (gen-neighbours-for [0 1])
@@ -75,3 +77,97 @@
 ;;  (1 0) (1 1)  (1 2))

 matrix
+(defn transpose-table->positions
+  [[head-row-with-cols & tail-rows] row-counter transposed-table-acc]
+    (letfn [(generate-row-with-cols-tuple [row-counter cols-counter]
+              (map vec
+                   (partition 2
+                        (interleave
+                          (repeat cols-counter row-counter)
+                          (take cols-counter (iterate inc 0))))))
+
+            (structure-cells [head-row-with-cols row-counter]
+              (vec (map vec
+                        (partition 2
+                            (interleave
+                                head-row-with-cols
+                                (generate-row-with-cols-tuple row-counter (count head-row-with-cols))))))) ]
+      (if (nil? head-row-with-cols)
+        transposed-table-acc
+        (recur tail-rows
+               (inc row-counter)
+               (conj transposed-table-acc
+                     (structure-cells head-row-with-cols row-counter)
+)))))
+
+(take 3 (iterate inc 0))
+(transpose-table->positions [["0" "0" "0" "#" "0"] ["0" "0" "0" "0" "0"]] 0 [])
+
+(def transposed (transpose-table->positions [["0" "0" "0" "#" "0"] ["0" "0" "0" "0" "0"]] 1 []))
+transposed
+
+(get-in [[0 1 2 3] [4 5 6 7]] [0 2])
+(get-in [
+         [{:alive false :adj [[1 0] [1 1] [0 1]]}, {:alive false :adj [[0 0] [0 2] [1 0] [1 1] [1 2]]}]
+         [{:alive false :adj [[3 4] [5 6]]}, {:alive true :adj [[1 2] [1 4] [0 1]]}] ]
+        [1 0]) ;; this is the data-structure i expect!!!
+(if (:alive {:alive true}) (str "OK") (str "NOK")) ;; OK!
+
+(defn structure-cells-with-neighours
+  [[head-row-cols-with-positions & tail-rows] mapped-cells-with-neighbours]
+  (if (nil? head-row-cols-with-positions)
+    mapped-cells-with-neighbours
+    (recur tail-rows
+       (conj mapped-cells-with-neighbours
+             (vec (map (fn [cell-with-position]
+                                     {:alive (= "#" (first cell-with-position))
+                                      :neighbours-pos (gen-neighbours-for (second cell-with-position))})
+                             head-row-cols-with-positions))))
+))
+
+(defn map-cells-status-with-neighbours [matrix]
+  (let [starting-row 0
+        transposed-cells-with-positions (transpose-table->positions matrix starting-row [])]
+    (structure-cells-with-neighours transposed-cells-with-positions [])
+    ;; iterate
+))
+
+matrix
+(map-cells-status-with-neighbours matrix)
+
+;; once we mapped one cell "0" as::
+; { :alive false,
+;   :neighbours-pos ((3 3) (3 4) (3 5) (4 3) (4 5) (5 3) (5 4) (5 5))}
+
+;; next thing is to iterate each cell's neighbour and find in the
+;; transposed cells for each neighbour its liveness state
+
+(defn map-cells-with-alive-neighbours
+  [[head-mapped-cols-with-neighbours & tail-rows]
+   mapped-cells
+   cells-table-with-alive-neighbours]
+  (if (nil? head-mapped-cols-with-neighbours)
+    cells-table-with-alive-neighbours
+    (recur
+      tail-rows
+      mapped-cells
+      (conj cells-table-with-alive-neighbours
+            (map
+              (fn [cell-with-neighbours-positions]
+                (reduce
+                  (fn [alive-neighbours-acc neighbour-position]
+                    (let [neighbour (get-in mapped-cells neighbour-position)]
+                      (if (:alive neighbour)
+                        (conj alive-neighbours-acc neighbour-position)
+                        alive-neighbours-acc
+                        )))
+                  [] (:neighbours-pos cell-with-neighbours-positions))
+                )
+              head-mapped-cols-with-neighbours)
+      ))
+  ))
+
+(def neighs (map-cells-status-with-neighbours matrix))
+neighs
+(get-in neighs [4 4])
+(map-cells-with-alive-neighbours neighs neighs [])


allow index to be set by things other than relase id

--- src/wb_es/web/index.clj
+++ src/wb_es/web/index.clj
@@ -8,25 +8,27 @@
             [wb-es.web.core :as web-core]
             [wb-es.web.integration :as web-integration]))

+(def index-id release-id)
+
 (def search-route
   (GET "/search" [q & options]
-       (response (web-core/search es-base-url release-id q options))))
+       (response (web-core/search es-base-url index-id q options))))

 (def autocomplete-route
   (GET "/autocomplete" [q & options]
-       (response (web-core/autocomplete es-base-url release-id q options))))
+       (response (web-core/autocomplete es-base-url index-id q options))))

 (def search-exact-route
   (GET "/search-exact" [q & options]
-       (response (web-core/search-exact es-base-url release-id q options))))
+       (response (web-core/search-exact es-base-url index-id q options))))

 (def count-route
   (GET "/count" [q & options]
-       (response (web-core/count es-base-url release-id q options))))
+       (response (web-core/count es-base-url index-id q options))))

 (def random-route
   (GET "/random" [q & options]
-       (response (web-core/random es-base-url release-id options))))
+       (response (web-core/random es-base-url index-id options))))

 (def api-lite-routes
   (->


Don't attempt to redirect from the "/" URI Break out some of the rediret code into a private function

--- src/io/aviso/twixt.clj
+++ src/io/aviso/twixt.clj
@@ -286,6 +286,15 @@
                                  requested-checksum
                                  (asset-pipeline asset-path context')))))))

+(defn- handle-asset-redirect
+  [uri context]
+  ;; This may be too specific, may need to find a better way to differentiate between a "folder" and a file.
+  (if (not (= uri "/"))
+    (let [{:keys [asset-pipeline path-prefix]} context
+          asset-path (.substring uri 1)]
+      (if-let [asset (asset-pipeline asset-path context)]
+        (asset->redirect-response 302 path-prefix asset)))))
+
 (defn wrap-with-asset-redirector
   "In some cases, it is not possible for the client to know what the full asset URI will be, such as when the
   URL is composed on the client (in which case, the asset checksum will not be known). The redirector accepts
@@ -297,14 +306,12 @@

   This middleware is not applied by default."
   [handler]
-  (fn asset-redirector [{path    :uri
+  (fn asset-redirector [{uri     :uri
                          context :twixt
                          :as     request}]
-    (let [{:keys [asset-pipeline path-prefix]} context
-          asset-path (.substring path 1)]
-      (if-let [asset (asset-pipeline asset-path context)]
-        (asset->redirect-response 302 path-prefix asset)
-        (handler request)))))
+    (or
+      (handle-asset-redirect uri context)
+      (handler request))))

 (defn wrap-with-twixt
   "Invokes the twixt-handler and delegates to the provided handler if twixt-handler returns nil.


Define an inner edge as type

Define an inner edge as type

--- src/jungerer/graph.clj
+++ src/jungerer/graph.clj
@@ -8,16 +8,15 @@
                                    UndirectedSparseMultigraph]
            edu.uci.ics.jung.graph.util.Pair))

-;; FIXME
-(defn- edge->j-edge
+(deftype InnerEdge [src-node dst-node])
+
+(defn- inner-edge
   [edge]
-  (let [[a b] edge]
-    (str a b)))
+  (apply ->InnerEdge edge))

-(defn- j-edge->edge
-  [^Graph graph j-edge]
-  (let [pair ^Pair (.getEndpoints graph j-edge)]
-    [(.getFirst pair) (.getSecond pair)]))
+(defn- ->edge
+  [^InnerEdge inner-edge]
+  [(.src-node inner-edge) (.dst-node inner-edge)])

 ;; Constructor
 ;; -----------
@@ -32,7 +31,7 @@
        (doto graph
          (.addVertex a)
          (.addVertex b)
-         (.addEdge (edge->j-edge edge) a b)))
+         (.addEdge (inner-edge edge) a b)))
      graph)))

 (defn directed-multigraph
@@ -45,7 +44,7 @@
        (doto graph
          (.addVertex a)
          (.addVertex b)
-         (.addEdge (edge->j-edge edge) a b)))
+         (.addEdge (inner-edge edge) a b)))
      graph)))

 (defn undirected-graph
@@ -58,7 +57,7 @@
        (doto graph
          (.addVertex a)
          (.addVertex b)
-         (.addEdge (edge->j-edge edge) a b)))
+         (.addEdge (inner-edge edge) a b)))
      graph)))

 (defn undirected-multigraph
@@ -71,7 +70,7 @@
        (doto graph
          (.addVertex a)
          (.addVertex b)
-         (.addEdge (edge->j-edge edge) a b)))
+         (.addEdge (inner-edge edge) a b)))
      graph)))

 ;; Manipulation
@@ -101,18 +100,18 @@
   function is not immutable, changing the graph state."
   [^Graph graph edge]
   (let [[a b] edge]
-    (.addEdge graph (edge->j-edge edge) a b)))
+    (.addEdge graph (inner-edge edge) a b)))

 (defn remove-edge!
   "Removes edge from graph. Returns true if the removal suceeded. Note that this
   function is not immutable, changing the graph state."
   [^Graph graph edge]
-  (.removeEdge graph (edge->j-edge edge)))
+  (.removeEdge graph (inner-edge edge)))

 (defn contains-edge?
   "Returns true if graph's edge collection contains edge."
   [^Hypergraph graph edge]
-  (.containsEdge graph (edge->j-edge edge)))
+  (.containsEdge graph (inner-edge edge)))

 (defn nodes
   "Returns all nodes in graph as set."
@@ -122,12 +121,12 @@
 (defn edges
   "Returns all edges in graph."
   [^Graph graph]
-  (map (partial j-edge->edge graph) (.getEdges graph)))
+  (map ->edge (.getEdges graph)))

 (defn in-edges
   "Returns incoming edges incident to node in graph."
   [^Graph graph node]
-  (map (partial j-edge->edge graph) (.getInEdges graph node)))
+  (map ->edge (.getInEdges graph node)))

 (defn degree
   "Returns the number of edges incident to node."


Continue loading hooks if one happens to fail.

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -135,14 +135,13 @@
                  (namespaces-matching "leiningen.hooks")))))

 (defn- load-hooks [project]
-  (try (doseq [n (hook-namespaces project)]
-         (require n))
-       (catch Exception e
-         (when-not (empty? (.list (File. "lib")))
-           (println "Warning: problem requiring hooks:" (.getMessage e))
-           (when (System/getenv "DEBUG")
-             (.printStackTrace e))
-           (println "...continuing without hooks completely loaded.")))))
+  (doseq [n (hook-namespaces project)]
+    (try (require n)
+         (catch Exception e
+           (when-not (empty? (.list (File. "lib")))
+             (println "Warning: problem requiring" n "hook:" (.getMessage e))
+             (when (System/getenv "DEBUG")
+               (.printStackTrace e)))))))

 (defn user-init []
   (let [init-file (File. (home-dir) "init.clj")]


fix  ns conflict

fix  ns conflict

--- src/leiningen/sync.clj
+++ src/leiningen/sync.clj
@@ -1,4 +1,5 @@
 (ns leiningen.sync
+  (:refer-clojure :exclude [sync])
   (:require [leiningen.core.main :as main]
             [leiningen.constant :as c]
             [clojure.string :as str]


Add box new/init commands.

Add box new/init commands.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -737,6 +737,19 @@
         (print "Multiple projects / locations match" (str \" dep \"\:))
         (print-repo-infos repo-infos)))))

+(defn box-init
+  [proj target & args]
+  (sh "mkdir" "-p" (adj-path target task-dir))
+  (apply box-add proj args))
+
+(defn box-new
+  [proj target & args]
+  (let [p (adj-path *pwd* target)]
+    (sh "mkdir" "-p" p)
+    (fcmd (str "target_dir='" (.getAbsolutePath p) "'"))
+    (binding [*pwd* p]
+      (apply box-init proj args))))
+
 (defn box-remove
   [proj & args]
   (doseq [a args
@@ -798,6 +811,8 @@
      (:parse kargset) (prn (ver-parse (first more-args)))
      (:find-box kargset) (prn (find-box))
      (:box kargset) (apply box project more-args)
+     (:box-new kargset) (apply box-new project more-args)
+     (:box-init kargset) (apply box-init project more-args)
      (:box-add kargset) (apply box-add project (map edn/read-string more-args))
      (:box-remove kargset) (apply box-remove project more-args)
      (:retag-all-repos kargset) (time (p-repos (fn [p] (clear-voom-tags p) (tag-repo-projects p))))


Rewrite 'sha-ancestors and 'sha-successors to handle bogus commits.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1019,18 +1019,18 @@
       {:sha->idx sha->idx
        :bitmaps bitmaps})))

-(defn sha-ancestors [shabam child ancs]
-  (let [{:keys [sha->idx bitmaps]} shabam
-        cidx (sha->idx child)]
-    (filter #(bm-get (get bitmaps cidx)
-                     (sha->idx %))
+(defn sha-ancestors [{:keys [sha->idx bitmaps]} child ancs]
+  (if-let [cidx (sha->idx child)]
+    (filter #(when-let [sha (sha->idx %)]
+               (bm-get (get bitmaps cidx)
+                       sha))
             ancs)))

-(defn sha-successors [shabam parent succ]
-  (let [{:keys [sha->idx bitmaps]} shabam
-        pidx (sha->idx parent)]
-    (filter #(bm-get (get bitmaps (sha->idx %))
-                     pidx)
+(defn sha-successors [{:keys [sha->idx bitmaps]} parent succ]
+  (if-let [pidx (sha->idx parent)]
+    (filter #(when-let [sha (sha->idx %)]
+               (bm-get (get bitmaps sha)
+                       pidx))
             succ)))

 ;; ===== relation database tables =====


Simplify condition

Simplify condition

--- src/mdr2/encode.clj
+++ src/mdr2/encode.clj
@@ -113,8 +113,7 @@
   ([production bitrate sample-rate]
    (doseq [volume (range 1 (inc (:volumes production)))]
      (let [{exit :exit error :err} (encode-production production bitrate volume sample-rate)]
-       (if (or (not= 0 exit)
-               (not (s/blank? error)))
+       (if (not (and (= 0 exit) (s/blank? error)))
          (log/errorf "Encoding of %s (%s) failed with exit %s and message \"%s\""
                      (:id production) volume exit error)
          (do


Stop using legacy H2 storage engine :imp:

--- src/metabase/db.clj
+++ src/metabase/db.clj
@@ -35,7 +35,7 @@
            ;; File-based DB
            (let [db-file-name (config/config-str :mb-db-file)
                  db-file      (io/file db-file-name)
-                 options      ";AUTO_SERVER=TRUE;MV_STORE=FALSE;DB_CLOSE_DELAY=-1"]
+                 options      ";AUTO_SERVER=TRUE;DB_CLOSE_DELAY=-1"]
              (apply str "file:" (if (.isAbsolute db-file)
                                   ;; when an absolute path is given for the db file then don't mess with it
                                   [db-file-name options]


CMR-2038: Document types of data centers

--- indexer-app/src/cmr/indexer/data/index_set.clj
+++ indexer-app/src/cmr/indexer/data/index_set.clj
@@ -301,7 +301,9 @@
                                     :platforms platform-hierarchical-mapping
                                     :instruments instrument-hierarchical-mapping
                                     :archive-centers data-center-hierarchical-mapping
-                                    ;; Contains all four types of data centers combined
+                                    ;; Contains all four types of data centers combined - archive,
+                                    ;; centers, distribution centers, processing centers, and
+                                    ;; originating centers.
                                     :data-centers data-center-hierarchical-mapping

                                     ;; Facet fields


update repo if it's already present

update repo if it's already present

This is tricky b/c the clone could have been shallow and would be
lacking the necessary refs for switching branches.

--- src/clj/runbld/main.clj
+++ src/clj/runbld/main.clj
@@ -60,6 +60,22 @@
       (io/rmdir-contents workspace)))
   opts)

+(defn update-workspace
+  "Updates an existing workspace and gets it onto the correct
+  branch."
+  [local branch depth]
+  (let [repo (git/load-repo local)]
+    (io/log "repo already cloned" local)
+    (io/log "updating")
+    (git/git-remote repo ["set-branches" "origin" branch])
+    (let [fetch-args (concat (when depth
+                               ["--depth" (str depth)])
+                             ["origin" (str branch)])]
+      (git/git-fetch repo fetch-args))
+    (git/git-checkout repo branch)
+    (git/git-pull repo)
+    (io/log "done updating")))
+
 (s/defn bootstrap-workspace
   [opts :- {:process OptsProcess
             :build Build
@@ -73,16 +89,18 @@
                    (-> opts :build :branch))
         depth (-> opts :scm :depth)]
     (when clone?
-      (let [clone-args (->> [(when (and reference
-                                        (.exists (jio/as-file reference)))
-                               ["--reference" reference])
-                             (when branch ["--branch" (str branch)])
-                             (when depth ["--depth" (str depth)])]
-                            (filter identity)
-                            (apply concat))]
-        (io/log "cloning" remote)
-        (git/git-clone local remote clone-args)
-        (io/log "done cloning"))))
+      (if (.exists (jio/file local ".git"))
+        (update-workspace local branch depth)
+        (let [clone-args (->> [(when (and reference
+                                          (.exists (jio/as-file reference)))
+                                 ["--reference" reference])
+                               (when branch ["--branch" (str branch)])
+                               (when depth ["--depth" (str depth)])]
+                              (filter identity)
+                              (apply concat))]
+          (io/log "cloning" remote)
+          (git/git-clone local remote clone-args)
+          (io/log "done cloning")))))
   opts)

 (s/defn log-script-execution


Whitespace.

Whitespace.

--- src/clj/runbld/main.clj
+++ src/clj/runbld/main.clj
@@ -58,7 +58,7 @@
           (io/log "wiping workspace")
           (clojure.java.shell/sh "find" local "-mindepth" "1" "-delete"))
         (io/log "cloning" remote)
-        (git/git-clone local remote clone-args )
+        (git/git-clone local remote clone-args)
         (io/log "done cloning")))))

 (def make-opts


just golfing

just golfing

--- src/clj/runbld/opts.clj
+++ src/clj/runbld/opts.clj
@@ -73,7 +73,7 @@
     (apply deep-merge-with deep-merge
            (for [ms profiles]
              (let [[k v] (first ms)
-                   pat ((comp re-pattern name) k)]
+                   pat (re-pattern (name k))]
                (if (re-find pat job-name)
                  (do
                    (debug/log "Job" job-name


Close transit input stream after reading response (#565)

Connections are not closing immediately after coercing the body using transit.
This is a regression introduced in https://github.com/dakrone/clj-http/pull/475.
Previously, the response body always was also transferred into an intermediate
byte-array which will read bytes until the stream is empty, and automatically
close the connection.

Since we no longer have this implicit behavior, the body coercion middleware
must close the inputstream after reading a value.

Fixes #564

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -485,7 +485,8 @@
   {:pre [transit-enabled?]}
   (let [charset (or charset (response-charset resp))
         body (if (can-parse-body? request resp)
-               (parse-transit (util/force-stream body) type transit-opts)
+               (with-open [in (util/force-stream body)]
+                 (parse-transit in type transit-opts))
                (util/force-string body charset))]
     (assoc resp :body body)))


Rename `args` to `arglist` in `apply`; refs #11

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1048,47 +1048,47 @@
   ([f args]
      (let [fixed-arity (. f cljs$lang$maxFixedArity)]
        (if (. f applyTo)
-         (if (<= (bounded-count args fixed-arity)
+         (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
-           (. f apply f (to-array args))
-           (. f apply f (to-array args))) ;; applyTo
-         (. f apply f (to-array args)))))
+           (. f apply f (to-array arglist))
+           (. f apply f (to-array arglist))) ;; applyTo
+         (. f apply f (to-array arglist)))))
   ([f x args]
-     (let [args (list* x args)
+     (let [arglist (list* x args)
            fixed-arity (. f cljs$lang$maxFixedArity)]
        (if (. f applyTo)
-         (if (<= (bounded-count args fixed-arity)
+         (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
-           (. f apply f (to-array args))
-           (. f apply f (to-array args))) ;; applyTo
-         (. f apply f (to-array args)))))
+           (. f apply f (to-array arglist))
+           (. f apply f (to-array arglist))) ;; applyTo
+         (. f apply f (to-array arglist)))))
   ([f x y args]
-     (let [args (list* x y args)
+     (let [arglist (list* x y args)
            fixed-arity (. f cljs$lang$maxFixedArity)]
        (if (. f applyTo)
-         (if (<= (bounded-count args fixed-arity)
+         (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
-           (. f apply f (to-array args))
-           (. f apply f (to-array args))) ;; applyTo
-         (. f apply f (to-array args)))))
+           (. f apply f (to-array arglist))
+           (. f apply f (to-array arglist))) ;; applyTo
+         (. f apply f (to-array arglist)))))
   ([f x y z args]
-     (let [args (list* x y z args)
+     (let [arglist (list* x y z args)
            fixed-arity (. f cljs$lang$maxFixedArity)]
        (if (. f applyTo)
-         (if (<= (bounded-count args fixed-arity)
+         (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
-           (. f apply f (to-array args))
-           (. f apply f (to-array args))) ;; applyTo
-         (. f apply f (to-array args)))))
+           (. f apply f (to-array arglist))
+           (. f apply f (to-array arglist))) ;; applyTo
+         (. f apply f (to-array arglist)))))
   ([f a b c d & args]
-     (let [args (cons a (cons b (cons c (cons d (spread args)))))
+     (let [arglist (cons a (cons b (cons c (cons d (spread args)))))
            fixed-arity (. f cljs$lang$maxFixedArity)]
        (if (. f applyTo)
-         (if (<= (bounded-count args fixed-arity)
+         (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
-           (. f apply f (to-array args))
-           (. f apply f (to-array args))) ;; applyTo
-         (. f apply f (to-array args))))))
+           (. f apply f (to-array arglist))
+           (. f apply f (to-array arglist))) ;; applyTo
+         (. f apply f (to-array arglist))))))

 (defn not=
   "Same as (not (= obj1 obj2))"


added IHash implementation to ChunkedSeq and ChunkedCons, fixes CLJS-348

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1846,10 +1846,10 @@
   ([arr off end]
      (ArrayChunk. arr off end)))

-(deftype ChunkedCons [chunk more meta]
+(deftype ChunkedCons [chunk more meta ^:mutable __hash]
   IWithMeta
   (-with-meta [coll m]
-    (ChunkedCons. chunk more m))
+    (ChunkedCons. chunk more m __hash))

   IMeta
   (-meta [coll] meta)
@@ -1866,7 +1866,7 @@
   (-first [coll] (-nth chunk 0))
   (-rest [coll]
     (if (> (-count chunk) 1)
-      (ChunkedCons. (-drop-first chunk) more meta)
+      (ChunkedCons. (-drop-first chunk) more meta nil)
       (if (nil? more)
         ()
         more)))
@@ -1886,12 +1886,15 @@

   ICollection
   (-conj [this o]
-    (cons o this)))
+    (cons o this))
+
+  IHash
+  (-hash [coll] (caching-hash coll hash-coll __hash)))

 (defn chunk-cons [chunk rest]
   (if (zero? (-count chunk))
     rest
-    (ChunkedCons. chunk rest nil)))
+    (ChunkedCons. chunk rest nil nil)))

 (defn chunk-append [b x]
   (.add b x))
@@ -3044,7 +3047,7 @@

 (defn vector [& args] (vec args))

-(deftype ChunkedSeq [vec node i off meta]
+(deftype ChunkedSeq [vec node i off meta ^:mutable __hash]
   IWithMeta
   (-with-meta [coll m]
     (chunked-seq vec node i off m))
@@ -3104,13 +3107,15 @@
               (chunked-seq vec (+ i l) 0))]
       (if (nil? s)
         nil
-        s))))
+        s)))
+  IHash
+  (-hash [coll] (caching-hash coll hash-coll __hash)))

 (defn chunked-seq
   ([vec i off] (chunked-seq vec (array-for vec i) i off nil))
   ([vec node i off] (chunked-seq vec node i off nil))
   ([vec node i off meta]
-     (ChunkedSeq. vec node i off meta)))
+     (ChunkedSeq. vec node i off meta nil)))

 (deftype Subvec [meta v start end ^:mutable __hash]
   Object


CLJS-919 compare-and-set! relies on Atom record structure instead of protocols

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -3505,10 +3505,10 @@

 (defn compare-and-set!
   "Atomically sets the value of atom to newval if and only if the
-  current value of the atom is identical to oldval. Returns true if
+  current value of the atom is equal to oldval. Returns true if
   set happened, else false."
   [a oldval newval]
-  (if (= (.-state a) oldval)
+  (if (= (-deref a) oldval)
     (do (reset! a newval) true)
     false))


arities for swap!, refs #26

arities for swap!, refs #26

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -2011,8 +2011,14 @@
   the value that was swapped in."
   ([a f]
      (reset! a (f (.state a))))
-  ([a f & args]
-     (reset! a (apply f (.state a) args))))
+  ([a f x]
+     (reset! a (f (.state a) x)))
+  ([a f x y]
+     (reset! a (f (.state a) x y)))
+  ([a f x y z]
+     (reset! a (f (.state a) x y z)))
+  ([a f x y z & more]
+     (reset! a (apply f (.state a) x y z more))))

 (defn compare-and-set!
   "Atomically sets the value of atom to newval if and only if the
@@ -2181,6 +2187,11 @@
     (assert (= true (compare-and-set! a 1 7)))
     (assert (nil? (meta a)))
     (assert (nil? (get-validator a))))
+  (let [a (atom 0)]
+    (assert (= 1 (swap! a + 1)))
+    (assert (= 4 (swap! a + 1 2)))
+    (assert (= 10 (swap! a + 1 2 3)))
+    (assert (= 20 (swap! a + 1 2 3 4))))
   (let [a (atom [1] :validator coll? :meta {:a 1})]
     (assert (= coll? (get-validator a)))
     (assert (= {:a 1} (meta a)))
@@ -2229,4 +2240,4 @@
   :ok
   )

-#_(goog.global/print (assoc {} :a 1))+#_(goog.global/print (assoc {} :a 1))


Set proper type hint for socket.

Set proper type hint for socket.

--- src/clojure/nanomsg.clj
+++ src/clojure/nanomsg.clj
@@ -4,54 +4,57 @@
            (nanomsg.reqrep ReqSocket RepSocket)
            (nanomsg.pair PairSocket)
            (nanomsg.bus BusSocket)
-           (nanomsg Socket Constants)))
+           (nanomsg RWSocket Constants)))

 (def ^:static supported-sockets {:pub PubSocket :sub SubSocket
                                  :req ReqSocket :rep RepSocket
                                  :bus BusSocket :pair PairSocket})

 (defn bind
-  "Bind socket."
-  [^Socket sock, ^String dir]
+  "Given a socket and connection string,
+  add a local endpoint to the socket."
+  [^RWSocket sock, ^String dir]
   (.bind sock dir)
   sock)

 (defn connect
-  "Connect socket to dir."
-  [^Socket sock, ^String dir]
+  "Given a socket and connection string,
+  connect to remote socket."
+  [^RWSocket sock, ^String dir]
   (.connect sock dir)
   sock)

 (defn subscribe
-  "Subscribe to some string pattern."
+  "Subscribe a current subscriber socket
+  to specified string pattern."
   [^SubSocket sock, ^String pattern]
   {:pre [(instance? SubSocket sock)]}
   (.subscribe sock pattern))

 (defn send
   "Send string data"
-  [^Socket sock, ^String data & {:keys [blocking] :or {blocking true}}]
+  [^RWSocket sock, ^String data & {:keys [blocking] :or {blocking true}}]
   {:pre [(string? data)]}
   (.sendString sock data blocking))

 (defn recv
   "Recv data as string"
-  [^Socket sock & {:keys [blocking] :or {blocking true}}]
+  [^RWSocket sock & {:keys [blocking] :or {blocking true}}]
   (.recvString sock blocking))

 (defn send-bytes
   "Send bytes data"
-  [^Socket sock, data & {:keys [blocking] :or {blocking true}}]
+  [^RWSocket sock, data & {:keys [blocking] :or {blocking true}}]
   (.sendBytes sock data blocking))

 (defn recv-bytes
   "Recv data as bytes"
-  [^Socket sock & {:keys [blocking] :or {blocking true}}]
+  [^RWSocket sock & {:keys [blocking] :or {blocking true}}]
   (.recvBytes sock blocking))

 (defn close
   "Close socket."
-  [^Socket sock]
+  [^RWSocket sock]
   (.close sock))

 (defn- resolve-symbols


adjust hue control from external MIDI

adjust hue control from external MIDI

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -276,6 +276,10 @@
       (show/add-midi-control-to-var-mapping
         "Bus 1" 11 36 :front-1-note :max 255)
       )
+
+      (show/add-midi-control-to-var-mapping
+          "Bus 1" 11 37 :main-adjust-hue :max 60)
+        )
     )

   (if (= interface "uno-clock")
@@ -302,6 +306,7 @@
 (afterglow.show/set-variable! :use-hue-chase false)
 (afterglow.show/set-variable! :osc-beat-ratio 8)
 (afterglow.show/set-variable! :front-1-note 0)
+(afterglow.show/set-variable! :main-adjust-hue 0)

 (defn light-sawtooth-phase
   "Change light of fixtures with phase shift. WIP."
@@ -615,7 +620,11 @@
           :beyond :loop
           ))))))

-
+  (ct/set-cue! (:cue-grid *show*) 3 1
+    (cues/cue :color  (fn [_] (afterglow.effects/scene
+      "Solid with adjust"
+        (global-color-effect (params/build-color-param :h :main-hue :adjust-hue :main-adjust-hue :s 100 :l 50))
+    ))))

   (ct/set-cue! (:cue-grid *show*) 3 1
     (cues/cue :color  (fn [_] (afterglow.effects/scene


removed unneeded cues

removed unneeded cues

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -84,12 +84,12 @@
   [color & {:keys [include-color-wheels? lights] :or {lights (show/all-fixtures)}}]
   (try
     (let [[c desc] (cond (= (type color) :com.evocomputing.colors/color)
-                       [color (color-name color)]
-                       (and (satisfies? params/IParam color)
-                            (= (params/result-type color) :com.evocomputing.colors/color))
-                       [color "variable"]
-                       :else
-                       [(create-color color) color])]
+     [color (color-name color)]
+     (and (satisfies? params/IParam color)
+          (= (params/result-type color) :com.evocomputing.colors/color))
+     [color "variable"]
+     :else
+     [(create-color color) color])]
       (color-fx/color-effect (str "Color: " desc) c lights :include-color-wheels? include-color-wheels?))
     (catch Exception e
       (throw (Exception. (str "Can't figure out how to create color from " color) e)))))
@@ -342,73 +342,6 @@
     (ct/set-cue! (:cue-grid *show*) 7 7
                  (cues/function-cue :strobe-all :strobe (show/all-fixtures) :effect-name "Raw Strobe"))

-
-    ;; Dimmer cues to turn on and set brightness of groups of lights
-    (ct/set-cue! (:cue-grid *show*) 0 2
-                 (cues/cue :dimmers (fn [var-map] (global-dimmer-effect
-                                                   (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                   :effect-name "All Dimmers"))
-                           :variables [{:key "level" :min 0 :max 255 :start 255 :name "Level"}]
-                           :color :yellow :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers
-                                                     :puck-dimmers :hex-dimmers :snowball-dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 1 2
-                 (cues/cue :torrent-dimmers (fn [var-map] (dimmer-effect
-                                                           (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                           (show/fixtures-named "torrent")
-                                                           :effect-name "Torrent Dimmers"))
-                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
-                           :color :orange :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 2 2
-                 (cues/cue :blade-dimmers (fn [var-map] (dimmer-effect
-                                                         (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                         (show/fixtures-named "blade")
-                                                         :effect-name "Blade Dimmers"))
-                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
-                           :color :orange :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 3 2
-                 (cues/cue :ws-dimmers (fn [var-map] (dimmer-effect
-                                                      (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                      (show/fixtures-named "ws")
-                                                      :effect-name "Weather System Dimmers"))
-                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
-                           :color :orange :end-keys [:dimmers]))
-
-    (ct/set-cue! (:cue-grid *show*) 4 2
-                 (cues/cue :hex-dimmers (fn [var-map] (dimmer-effect
-                                                       (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                       (show/fixtures-named "hex")
-                                                       :effect-name "Hex Dimmers"))
-                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
-                           :color :orange :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 5 2
-                 (cues/cue :puck-dimmers (fn [var-map] (dimmer-effect
-                                                        (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                        (show/fixtures-named "puck")
-                                                        :effect-name "Puck Dimmers"))
-                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
-                           :color :orange :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 6 2
-                 (cues/cue :snowball-dimmers (fn [var-map] (dimmer-effect
-                                                            (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                            (show/fixtures-named "snowball")
-                                                            :effect-name "Snowball Dimmers"))
-                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
-                           :color :orange :end-keys [:dimmers]))
-    (ct/set-cue! (:cue-grid *show*) 7 2
-                 (cues/cue :torrent-1-dimmer (fn [var-map] (dimmer-effect
-                                                            (params/bind-keyword-param (:level var-map 255) Number 255)
-                                                            (show/fixtures-named "torrent-1")
-                                                            :effect-name "Torrent 1 Dimmer"))
-                           :variables [(merge {:key "level" :min 0 :max 255 :start 255 :name "Level"})]
-                           :color :orange :end-keys [:dimmers :torrent-dimmers]))
-
-    ;; Dimmer oscillator cues: Sawtooth down each beat
-    (ct/set-cue! (:cue-grid *show*) 0 3
-                 (cues/cue :dimmers (fn [_] (global-dimmer-effect
-                                             (params/build-oscillated-param (oscillators/sawtooth-beat :down? true))
-                                             :effect-name "All Saw Down Beat"))
-                           :color :yellow :end-keys [:torrent-dimmers :blade-dimmers :ws-dimmers
-                                                     :puck-dimmers :hex-dimmers :snowball-dimmers]))
     (ct/set-cue! (:cue-grid *show*) 1 3
                  (cues/cue :torrent-dimmers
                            (fn [_] (dimmer-effect


Better reports ns docstring

Better reports ns docstring

--- backend/src/akvo/lumen/admin/stats/report.clj
+++ backend/src/akvo/lumen/admin/stats/report.clj
@@ -1,4 +1,17 @@
 (ns akvo.lumen.admin.stats.report
+  "The following env vars are assumed to be present:
+  PG_HOST, PG_DATABASE, PG_USER, PG_PASSWORD
+  The PG_* env vars can be found in the ElephantSQL console for the appropriate
+  instance.
+  Use this as follow
+  $ env PG_HOST=***.db.elephantsql.com PG_DATABASE=*** \\
+        PG_USER=*** PG_PASSWORD=*** \\
+        lein run -m akvo.lumen.admin.stats.report
+  Script can be executed with optional arguments
+  lein run -m akvo.lumen.admin.stats.report \"2017-09-01\"
+  or
+  lein run -m akvo.lumen.admin.stats.report now \"t1,t2\""
+
   "Same env vars as the rest of admin scripts
   report
   report \"2017-04-01\"


[#1656] Ignore filter with null column values

--- backend/src/akvo/lumen/endpoint/dashboard.clj
+++ backend/src/akvo/lumen/endpoint/dashboard.clj
@@ -16,7 +16,8 @@
       (get "query")
       json/decode
       (get "filter")
-      w/keywordize-keys))
+      w/keywordize-keys
+      (update :columns #(filter (fn [c] (some? (:value c))) %))))

 (defn all-dashboards [auth-service tenant-conn]
   (let [dashboards      (dashboard/all tenant-conn)


cleaning up repl starting functions

cleaning up repl starting functions

--- sidecar/src/figwheel_sidecar/system.clj
+++ sidecar/src/figwheel_sidecar/system.clj
@@ -18,6 +18,9 @@
    [clojure.set :refer [difference union]]
    [clojure.string :as string]))

+;; exporting functionality inorder to make figwheel-sidecar.system
+;; the main require for scripting figwheel
+
 (def fetch-config config/fetch-config)

 (defn css-watcher [opts]
@@ -26,13 +29,6 @@
    {:figwheel-server :figwheel-system}))

 (def nrep-server-component nrepl-comp/nrepl-server-component)
-
-;; TODO
-(comment
-
-  ;; secondary
-
-  example html reload)

 (declare build-config->key)

@@ -100,7 +96,7 @@
                       [:figwheel-system])))

 ;; Being able to supply a mutable figwheel system that can be
-;; controled by a CLJS socket repl is very desirable.
+;; controlled by a CLJS socket repl is very desirable.
 ;;
 ;; That being said if one doesn't want the CLJS repl to be able to
 ;; control which builds are running etc then one can revert the method
@@ -507,6 +503,13 @@
                     (keep :id (filter config/optimizations-none? (vals builds))))]
           (recur chosen-build-id))))))

+(defn cljs-repl*
+  ([system] (cljs-repl* system nil))
+  ([system start-build-id]
+   (if (frepl/in-nrepl-env?)
+     (figwheel-cljs-repl* system start-build-id)
+     (build-switching-cljs-repl* system start-build-id))))
+
 ;; takes a FigwheelSystem
 (defn figwheel-cljs-repl
   ([figwheel-system]
@@ -520,12 +523,9 @@
   ([{:keys [system]} start-build-id]
    (build-switching-cljs-repl* system start-build-id)))

-(defn cljs-repl
-  ([figwheel-system] (cljs-repl figwheel-system nil))
-  ([{:keys [system]} start-build-id]
-   (if (frepl/in-nrepl-env?)
-     (figwheel-cljs-repl* system start-build-id)
-     (build-switching-cljs-repl* system start-build-id))))
+(defn cljs-repl
+  ([{:keys [system]}] (cljs-repl* system nil))
+  ([{:keys [system]} start-build-id] (cljs-repl* system start-build-id)))

 ;; figwheel starting and stopping helpers

@@ -534,10 +534,12 @@
   (let [system (create-figwheel-system options)]
     (component/start system)))

+(defn stop-figwheel! [system]
+  (component/stop system))
+
 ;; this is a blocking call
 (defn start-figwheel-and-cljs-repl! [autobuild-options]
   (let [system (start-figwheel! autobuild-options)]
-    (build-switching-cljs-repl (:figwheel-system system))))
-
-(defn stop-figwheel! [system]
-  (component/stop system))
+    (cljs-repl (:figwheel-system system))))
+
+


refactor into another namespace

refactor into another namespace

--- desafio4/clojure/src/huffman/io.clj
+++ desafio4/clojure/src/huffman/io.clj
@@ -1,48 +1,18 @@
 (ns huffman.io
   (:import (java.nio.file Paths Files OpenOption Path)))
+
+(use 'huffman.bits)
+

 (defn get-path [filename]
   (Paths/get filename (make-array String 0)))

-
 (defn read-bytes [filename]
   (Files/readAllBytes (get-path filename)))
-
-(defn- pad-bits-to-byte-size [bits pad-size]
-  (let [l (count bits)]
-    (if (< l pad-size)
-      (flatten (cons bits (repeat (- pad-size l) 0)))
-      bits)))
-
-(defn ^Byte bits-to-byte [b]
-    (loop [byte 0 bits  (pad-bits-to-byte-size b 8) ]
-            (if (empty? bits)
-              byte
-              (recur (bit-or (bit-shift-left byte 1) (first bits)) (rest bits)))))
-
-(defn byte-to-bits [b]
-  (loop [byt (short (bit-and b 0xFF)) bits []]
-    (if (zero? byt)
-      (vec (reverse (pad-bits-to-byte-size bits 8)) )
-      (recur (short (unsigned-bit-shift-right byt 1)) (conj bits (short (bit-and byt 0x01)))))))
-
-(defn int-to-bits [i]
-  (loop [byt (int i) bits []]
-    (if (zero? byt)
-      (vec (reverse (pad-bits-to-byte-size bits 32)) )
-      (recur (int (unsigned-bit-shift-right byt 1)) (conj bits (int (bit-and byt 0x01)))))))
-
-(defn encode-bits-to-bytes [bits]
-  (map bits-to-byte (partition 8 bits)))
-
-(defn encode-bytes-to-bits [bytes]
-  (map byte-to-bits bytes))

 (defn write-bytes [^String filename ^"[B" bytes]
   (Files/write ^Path (get-path filename) ^"[B" bytes ^"[Ljava.nio.file.OpenOption;" (make-array OpenOption 0)))

 (defn write-encoded [filename  bits]
   (let [bytes (encode-bits-to-bytes bits)]
-    (println (count bits))
-    (println (count bytes))
     (write-bytes filename (byte-array bytes))))


Refactor, code duplication

Refactor, code duplication

--- src/buildviz/handler.clj
+++ src/buildviz/handler.clj
@@ -171,17 +171,19 @@

 ;; failures

+(defn- test-runs [build-results job-name]
+  (map junit-xml/parse-testsuites
+       (results/chronological-tests build-results job-name)))
+
 (defn- failures-for [build-results job-name]
-  (when-some [test-results (results/chronological-tests build-results job-name)]
-    (when-some [failed-tests (seq (testsuites/accumulate-testsuite-failures
-                                   (map junit-xml/parse-testsuites test-results)))]
-      (let [build-data-entries (results/builds build-results job-name)]
-        {job-name (merge {:children failed-tests}
-                         (failed-count-for build-data-entries))}))))
+  (when-some [failed-tests (seq (testsuites/accumulate-testsuite-failures (test-runs build-results job-name)))]
+    (let [build-data-entries (results/builds build-results job-name)]
+      {job-name (merge {:children failed-tests}
+                       (failed-count-for build-data-entries))})))

 (defn- failures-as-list [build-results job-name]
-  (when-some [test-results (results/chronological-tests build-results job-name)]
-    (->> (map junit-xml/parse-testsuites test-results)
+  (when-some [test-results (seq (test-runs build-results job-name))]
+    (->> test-results
          (testsuites/accumulate-testsuite-failures-as-list)
          (map (fn [{testsuite :testsuite classname :classname name :name failed-count :failedCount}]
                 [failed-count
@@ -199,10 +201,6 @@
                                                (mapcat #(failures-as-list build-results %) job-names))))))

 ;; testsuites
-
-(defn- test-runs [build-results job-name]
-  (let [test-results (results/chronological-tests build-results job-name)]
-    (map junit-xml/parse-testsuites test-results)))

 (defn- names-of-jobs-with-tests [build-results]
   (filter #(results/has-tests? build-results %) (results/job-names build-results)))


extract method

extract method

--- src/otto/github.clj
+++ src/otto/github.clj
@@ -17,15 +17,19 @@
   (fn [url response-fn]
     (http/get url {:basic-auth [(:name user) (:token user)]} response-fn)))

+(defn- next-url
+  [headers]
+  (->> (:link headers)
+       str
+       (re-find #"<([^\s]+)>;\s?rel=\"next\"")
+       vec
+       last))
+
 (defn- make-response-fn
   [success-fn]
   (fn [{:keys [body error headers status]}]
     (if (and (nil? error) (= 200 status))
-      (let [next-url (->> (:link headers)
-                          str
-                          (re-find #"<([^\s]+)>;\s?rel=\"next\"")
-                          vec
-                          last)]
+      (let [next-url (next-url headers)]
         (success-fn body next-url))))) ;; TODO error

 (defn- make-json-response-fn


Resurrect env key to uppercase because it would break compatibility

--- src/cider_ci/ex/exec.clj
+++ src/cider_ci/ex/exec.clj
@@ -78,6 +78,7 @@
              (or (:environment_variables (:exec @conf)) {}))
        (filter (fn [[k v]] (not= nil v)))
        (map (fn [[k v]] [(name k) v]))
+       (map (fn [[k v]] [(string/upper-case k) v])) ; TODO,  remove this with Cider-CI version 3.0.0
        (into {})))

 ;### exec shell ###############################################################


Remove algorithm-lengths map.

Remove algorithm-lengths map.

--- src/multihash/core.clj
+++ src/multihash/core.clj
@@ -20,17 +20,6 @@
    :sha3     0x14
    :blake2b  0x40
    :blake2s  0x41})
-
-
-; TODO: questionably useful
-(def ^:const algorithm-lengths
-  "Map of algorithm names to the default digest length."
-  {:sha1     20
-   :sha2-256 32
-   :sha2-512 64
-   :sha3     64
-   :blake2b  64
-   :blake2s  32})

 (defn app-code?


whitespace

whitespace

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -1491,7 +1491,7 @@
                       FileVisitResult/CONTINUE)
                     (visitFileFailed [_ file exc]
                       FileVisitResult/CONTINUE))))]
-        (println "Building...")
+        (println "Building ...")
         (flush)
         (buildf)
         (println "Watching path:" source)
@@ -1505,7 +1505,7 @@
                                        (. fstr (endsWith "js")))
                                    (not (. fstr (startsWith ".#"))))))
                       (seq (.pollEvents key)))
-                (println "Change detected, recompiling...")
+                (println "Change detected, recompiling ...")
                 (flush)
                 (buildf))
               (recur key))))))))


use default configuration

use default configuration

--- src/clj/dbquery/conf.clj
+++ src/clj/dbquery/conf.clj
@@ -1,8 +1,28 @@
 (ns dbquery.conf
-  (:require [clojure.string :as str]
+  (:require [clojure.edn :as edn]
             [clojure.java.io :as io]
-            [clojure.tools.logging :as log]
-            [clojure.edn :as edn]))
+            [clojure.string :as str]
+            [clojure.tools.logging :as log])
+  (:import java.io.File))
+
+(defn- rand-str [len]
+  (->> (repeatedly len #(rand-int 61))
+       (map #(cond (< % 10) %
+                   (<= % 35) (char (+ % 55))
+                   :else (char (+ % 61))))
+       (str/join)))
+
+(defn default-conf []
+  (let [home-dir (str (System/getProperty "user.home") "/.dbexplorer")
+        conf-file (File. home-dir "conf.edn")]
+    (when-not (.exists conf-file)
+      (. (File. home-dir) mkdir)
+      (spit conf-file (pr-str {:app-env "prod"
+                               :db {:db (str home-dir "/app-db.db")
+                                    :user "admin"
+                                    :password (rand-str 20)}
+                               :secret-key (rand-str 40)})))
+    conf-file))

 (defn- load-conf
   ([file]
@@ -10,9 +30,9 @@
    (with-open [reader  (java.io.PushbackReader. (io/reader file))]
      (edn/read reader)))
   ([]
-   (if-let [conf-file (System/getProperty "conf")]
+   (if-let [conf-file (or (System/getProperty "conf"))]
      (load-conf (java.io.File. conf-file))
-     (load-conf (io/resource "sample-conf.edn")))))
+     (load-conf (default-conf)))))

 (def conf (load-conf))


Can fold these two lets together.

Can fold these two lets together.

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -695,28 +695,28 @@
       (swap! *go-defs* conj ast)
       (let [loop-locals (->> (concat (mapcat :params (filter #(and % @(:flag %)) recur-frames))
                                      (mapcat :params loop-lets))
-                             seq)]
-        (let [name (or name (gensym))
-              mname (munge name)]
-          (when (= :return (:context env))
-            (emits "return "))
-          (when-not protocol-impl
-            (emitln "func(" (comma-sep (cons (str mname " *" (go-core "AFn")) (typed-params loop-locals))) ") *" (go-core "AFn") " {")
-            (emits "return " (go-core "Fn") "(" mname ", "))
-          (loop [[meth & methods] methods]
-            (let [meth (assoc-in meth [:env :context] :expr)]
-              (cond
-               protocol-impl (emit-protocol-method protocol-impl name meth (:ret-tag name))
-               (:variadic meth) (emit-variadic-fn-method meth)
-               :else (emit-fn-method meth (:ret-tag name))))
-            (when methods
-              (emits ", ")
-              (recur methods)))
-          (if protocol-impl
-            (emitln)
-            (do
-              (emitln ")")
-              (emits "}(" (comma-sep (cons (str "&" (go-core "AFn") "{}") loop-locals)) ")"))))))))
+                             seq)
+            name (or name (gensym))
+            mname (munge name)]
+        (when (= :return (:context env))
+          (emits "return "))
+        (when-not protocol-impl
+          (emitln "func(" (comma-sep (cons (str mname " *" (go-core "AFn")) (typed-params loop-locals))) ") *" (go-core "AFn") " {")
+          (emits "return " (go-core "Fn") "(" mname ", "))
+        (loop [[meth & methods] methods]
+          (let [meth (assoc-in meth [:env :context] :expr)]
+            (cond
+             protocol-impl (emit-protocol-method protocol-impl name meth (:ret-tag name))
+             (:variadic meth) (emit-variadic-fn-method meth)
+             :else (emit-fn-method meth (:ret-tag name))))
+          (when methods
+            (emits ", ")
+            (recur methods)))
+        (if protocol-impl
+          (emitln)
+          (do
+            (emitln ")")
+            (emits "}(" (comma-sep (cons (str "&" (go-core "AFn") "{}") loop-locals)) ")")))))))

 (defmethod emit* :do
   [{:keys [statements ret env]}]


Add marker component

Add marker component

--- src/cljs/gtfve/maps.cljs
+++ src/cljs/gtfve/maps.cljs
@@ -19,10 +19,7 @@
                            :mapTypeId (:ROADMAP map-types)
                            :zoom 15})

-(defonce default-marker-opts {:center {:lat 14.653386
-                                       :lng 121.032520}
-                              :mapTypeId (:ROADMAP map-types)
-                              :zoom 15})
+(defonce default-marker-opts {:icon "http://www.google.com/intl/en_us/mapfiles/ms/micons/blue-dot.png"})

 (defn snap-to-road [path]
   (data/GET "https://roads.googleapis.com/v1/snapToRoads"
@@ -68,15 +65,35 @@
                                       :strokeOpacity 1.0
                                       :strokeWeight 2}))))

+(defn r-marker [opts gmap]
+  (let [marker (Maps.Marker. (clj->js @opts))]
+    (r/create-class
+     {:component-did-mount (fn [this]
+                             (let [[_ opts gmap] (r/argv this)
+                                   m-opts (merge @opts {:map gmap})]
+                               (.setOptions marker (clj->js m-opts))))
+      :component-did-update (fn [this]
+                              (let [[_ opts gmap] (r/argv this)
+                                    m-opts (merge @opts {:map gmap})]
+                                (.setOptions marker (clj->js m-opts))))
+      :component-function (fn [opts]
+                            [:noscript])})))
+
 (defn r-map [state]
   (let [gmap (atom nil)]
     (r/create-class
      {:component-did-mount (fn [this]
-                             (let [opts default-map-opts
+                             (let [opts (:opts @state)
                                    node (.getDOMNode this)]
                                (reset! gmap (Maps.Map. node (clj->js opts)))))
       :component-function (fn [state]
                             [:div {:id :map-canvas
                                    :style {:height "100%"
                                            :margin 0
-                                           :padding 0}}])})))
+                                           :padding 0}}
+                             (doall
+                              (for [[id marker-opts] (:markers @state)]
+                                ^{:key id}
+                                [r-marker
+                                 (r/wrap marker-opts swap! state assoc-in [:markers id])
+                                 @gmap]))])})))


Make difference-from-most-similar-parent meta-error high rather than low for new randoms

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -319,7 +319,7 @@
               (- 1.0 (if (and (:parent1-genome ind) (:parent2-genome ind))
                        (max (sequence-similarity (:genome ind) (:parent1-genome ind))
                             (sequence-similarity (:genome ind) (:parent2-genome ind)))
-                       1.0))
+                       0.0))
               ;
               (= cat :difference-from-mate)
               (- 1.0 (if (:parent2-genome ind)


Add case-family-variation and difference-from-mate meta-errors

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -207,10 +207,10 @@
                              0
                              (if
                                (some (fn [sib]
-                                       (or (zero? (-> (:history sib)
+                                       (or (zero? (-> (:history sib) ;; sib solved
                                                       (first)
                                                       (nth case-index)))
-                                           (not= (-> (:history sib)
+                                           (not= (-> (:history sib) ;; sib error different than mom's
                                                      (first)
                                                      (nth case-index))
                                                  (-> (:history sib)
@@ -219,6 +219,39 @@
                                      siblings)
                                0
                                1)))))))
+              ;
+              (= cat :case-family-variation)
+              (if (not (:print-history argmap))
+                (throw
+                  (Exception.
+                    ":print-history must be true for :case-family-variation"))
+                (if (or (empty? (:parent-uuids ind))
+                        (empty? (rest (:history ind))))
+                  (vec (repeat (count (:errors ind)) 1))
+                  (let [siblings (filter #(and (= (first (:parent-uuids ind))
+                                                  (first (:parent-uuids %)))
+                                               (not (empty? (rest (:history %))))) ; new random sibs don't count
+                                         evaluated-population)]
+                    (vec (for [case-index (range (count (:errors ind)))]
+                           (if (zero? (nth (:errors ind) case-index)) ;; solved
+                             0
+                             (if
+                               (some (fn [sib] ;; sibling solved
+                                       (zero? (-> (:history sib)
+                                                  (first)
+                                                  (nth case-index))))
+                                     siblings)
+                               0
+                               (if (some (fn [sib] ;; sib error different than mom's
+                                           (not= (-> (:history sib)
+                                                     (first)
+                                                     (nth case-index))
+                                                 (-> (:history sib)
+                                                     (second)
+                                                     (nth case-index))))
+                                         siblings)
+                                 1
+                                 0))))))))
               ;
               (= cat :washout-mother)
               (if (not (:print-history argmap))
@@ -287,6 +320,11 @@
                        (max (sequence-similarity (:genome ind) (:parent1-genome ind))
                             (sequence-similarity (:genome ind) (:parent2-genome ind)))
                        1.0))
+              ;
+              (= cat :difference-from-mate)
+              (- 1.0 (if (:parent2-genome ind)
+                       (sequence-similarity (:genome ind) (:parent2-genome ind))
+                       0.0))
               ;
               (= cat :reproductive-convergence)
               (if (and (:parent1-genome ind) (:parent2-genome ind))


Add repeated-errors meta-error

Add repeated-errors meta-error

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -259,6 +259,17 @@
                               siblings)
                       0
                       1))))
+              ;
+              (= cat :repeated-errors)
+              (if (not (:print-history argmap))
+                (throw
+                  (Exception.
+                    ":print-history must be true for :repeated-errors"))
+                (if (or (empty? (rest (:history ind)))
+                        (some #{(first (:history ind))}
+                              (set (rest (:history ind)))))
+                    1
+                    0))
               ;
               (= cat :case-family-variation)
               (if (not (:print-history argmap))


add comments about what can be parameterized

--- src/com/rpl/specter.cljc
+++ src/com/rpl/specter.cljc
@@ -106,15 +106,29 @@

 ;; Helpers for defining selectors and collectors with late-bound params

-(def bind-params* i/bind-params*)
-
-(defmacro paramspath [params & impls]
+(def ^{:doc "Takes a compiled selector that needs late-bound params and supplies it with
+             an array of params and a position in the array from which to begin reading
+             params. The return value is an executable selector."}
+  bind-params* i/bind-params*)
+
+(defmacro paramspath
+  "Defines a StructurePath with late bound parameters. This path can be precompiled
+  with other selectors without knowing the parameters. When precompiled with other
+  selectors, the resulting selector takes in parameters for all selectors in the path
+  that needed parameters (in the order in which they were declared)."
+  [params & impls]
   (let [num-params (count params)
         retrieve-params (i/make-param-retrievers params)]
     (i/paramspath* retrieve-params num-params impls)
     ))

-(defmacro paramscollector [params impl]
+(defmacro paramscollector
+  "Defines a Collector with late bound parameters. This collector can be precompiled
+  with other selectors without knowing the parameters. When precompiled with other
+  selectors, the resulting selector takes in parameters for all selectors in the path
+  that needed parameters (in the order in which they were declared).
+   "
+  [params impl]
   (let [num-params (count params)
         retrieve-params (i/make-param-retrievers params)]
     (i/paramscollector* retrieve-params num-params impl)
@@ -126,7 +140,12 @@
 (defmacro defparamscollector [name & body]
   `(def ~name (paramscollector ~@body)))

-(defmacro fixed-pathed-path [bindings & impls]
+(defmacro fixed-pathed-path
+  "This helper is used to define selectors that take in a fixed number of other selector
+   paths as input. Those selector paths may require late-bound params, so this helper
+   will create a parameterized selector if that is the case. If no late-bound params
+   are required, then the result is executable."
+  [bindings & impls]
   (let [bindings (partition 2 bindings)
         paths (mapv second bindings)
         names (mapv first bindings)
@@ -140,7 +159,12 @@
       (mapcat (fn [n l] [n `(~l ~i/PARAMS-SYM ~i/PARAMS-IDX-SYM)]) names latefn-syms)
       impls)))

-(defmacro variable-pathed-path [[latepaths-seq-sym paths-seq] & impls]
+(defmacro variable-pathed-path
+  "This helper is used to define selectors that take in a variable number of other selector
+   paths as input. Those selector paths may require late-bound params, so this helper
+   will create a parameterized selector if that is the case. If no late-bound params
+   are required, then the result is executable."
+  [[latepaths-seq-sym paths-seq] & impls]
   (let [latefns-sym (gensym "latefns")]
     (i/pathed-path*
       i/paramspath*
@@ -152,7 +176,12 @@
       impls
       )))

-(defmacro pathed-collector [[name path] impl]
+(defmacro pathed-collector
+  "This helper is used to define collectors that take in a single selector
+   paths as input. That path may require late-bound params, so this helper
+   will create a parameterized selector if that is the case. If no late-bound params
+   are required, then the result is executable."
+  [[name path] impl]
   (let [latefns-sym (gensym "latefns")
         latefn (gensym "latefn")]
     (i/pathed-path*
@@ -175,14 +204,22 @@

 (def FIRST (i/->PosStructurePath first i/set-first))

-(defparamspath srange-dynamic [start-fn end-fn]
+(defparamspath
+  ^{:doc "Uses start-fn and end-fn to determine the bounds of the subsequence
+          to select when navigating. Each function takes in the structure as input."}
+  srange-dynamic
+  [start-fn end-fn]
   (select* [this structure next-fn]
     (i/srange-select structure (start-fn structure) (end-fn structure) next-fn))
   (transform* [this structure next-fn]
     (i/srange-transform structure (start-fn structure) (end-fn structure) next-fn)
     ))

-(defparamspath srange [start end]
+(defparamspath
+  ^{:doc "Navigates to the subsequence bound by the indexes start (inclusive)
+          and end (exclusive)"}
+  srange
+  [start end]
   (select* [this structure next-fn]
     (i/srange-select structure start end next-fn))
   (transform* [this structure next-fn]
@@ -197,7 +234,15 @@

 (defn codewalker [afn] (i/->CodeWalkerStructurePath afn))

-(defn filterer [& path]
+(defn filterer
+  "Navigates to a view of the current sequence that only contains elements that
+  match the given selector path. An element matches the selector path if calling select
+  on that element with the selector path yields anything other than an empty sequence.
+
+   The input path may be parameterized, in which case the result of filterer
+   will be parameterized in the order of which the parameterized selectors
+   were declared."
+  [& path]
   (fixed-pathed-path [late path]
     (select* [this structure next-fn]
       (->> structure (filter #(i/selected?* late %)) doall next-fn))
@@ -225,7 +270,11 @@
 (defn selected?
   "Filters the current value based on whether a selector finds anything.
   e.g. (selected? :vals ALL even?) keeps the current element only if an
-  even number exists for the :vals key"
+  even number exists for the :vals key.
+
+  The input path may be parameterized, in which case the result of selected?
+  will be parameterized in the order of which the parameterized selectors
+  were declared."
   [& path]
   (fixed-pathed-path [late path]
     (select* [this structure next-fn]
@@ -254,7 +303,11 @@

 (defn transformed
   "Navigates to a view of the current value by transforming it with the
-   specified selector and update-fn."
+   specified selector and update-fn.
+
+   The input path may be parameterized, in which case the result of transformed
+   will be parameterized in the order of which the parameterized selectors
+   were declared."
   [path update-fn]
   (fixed-pathed-path [late path]
     (select* [this structure next-fn]
@@ -314,7 +367,11 @@
    Tests the structure if selecting with cond-path returns anything.
    If so, it uses the following selector for this portion of the navigation.
    Otherwise, it tries the next cond-path. If nothing matches, then the structure
-   is not selected."
+   is not selected.
+
+   The input paths may be parameterized, in which case the result of cond-path
+   will be parameterized in the order of which the parameterized selectors
+   were declared."
   [& conds]
   (variable-pathed-path [compiled-paths conds]
     (select* [this structure next-fn]


Fixed a problem that metrics were being read from the wrong index

--- kuona-api/src/kuona_api/handler.clj
+++ kuona-api/src/kuona_api/handler.clj
@@ -34,7 +34,7 @@
     (status (response (decorator value)) 200)
     (status (response {}) 404)))

-(def kuona-index (store/index :kuona-data "http://localhost:9200"))
+(def kuona-metrics-index (store/index :kuona-metrics "http://localhost:9200"))

 (def repositories (store/mapping :repositories (store/index :kuona-repositories "http://localhost:9200")))

@@ -64,8 +64,8 @@
   (GET "/api/snapshots/:id" [id] (response (:_source (store/get-document snapshots id))))
   (PUT "/api/snapshots/:id" request (response (store/put-document (get-in request [:body]) snapshots (get-in request [:params :id]))))

-  (GET "/api/metrics/:mapping" [mapping search page] (response (store/search (store/mapping mapping kuona-index) search 100 page #(page-link (str "/api/mapping/" mapping) %))))
-  (GET "/api/metrics/:mapping/count" [mapping] (response (store/get-count (store/mapping mapping kuona-index))))
+  (GET "/api/metrics/:mapping" [mapping search page] (response (store/search (store/mapping mapping kuona-metrics-index) search 100 page #(page-link (str "/api/mapping/" mapping) %))))
+  (GET "/api/metrics/:mapping/count" [mapping] (response (store/get-count (store/mapping mapping kuona-metrics-index))))
   (GET "/api/environments" [] (response { :environments (environment-link-decorate-environment-list (list-environments)) }))
   (GET "/api/environments/:id" [id] (decorate-response decorate-environment (get-environment id)))
   (POST "/api/environments/:id/comments" request (response


disallow getting everyones email

disallow getting everyones email

--- src/survey/core.clj
+++ src/survey/core.clj
@@ -115,9 +115,9 @@
                                  :handle-ok (slurp "resources/data/questionnaire.json")))
   (ANY "/answers" []
      (resource
-      :allowed-methods [:post :get]
+      :allowed-methods [:post]
       :available-media-types ["application/json"]
-      :handle-ok (read-answer)
+;;      :handle-ok (read-answer)
       :post! (fn [ctx]
                (if-let [body (body-as-string ctx)]
                  (try


remove comment

remove comment

--- src/dchristopher/components/form.cljs
+++ src/dchristopher/components/form.cljs
@@ -14,24 +14,3 @@
     [:label "Message:"]
     [:textarea {:name "message"}]]
    [:p [:button {:type "submit"} "Send"]]])
-
-; <form name="contact" method="POST" data-netlify="true">
-;

-;     Your Name: <input type="text" name="name" />
-;

-;

-;     Your Email: <input type="email" name="email" />
-;

-;

-;     Your Role: <select name="role[]" multiple>
-;       <option value="leader">Leader</option>
-;       <option value="follower">Follower</option>
-;     </select>
-;

-;

-;     Message: <textarea name="message"></textarea>
-;

-;

-;     <button type="submit">Send</button>
-;

-; </form>


simpler register email

simpler register email

--- src/ontrail/emails.clj
+++ src/ontrail/emails.clj
@@ -4,46 +4,28 @@

 (def #^{:private true} logger (org.slf4j.LoggerFactory/getLogger (str *ns*)))

-(def admin "jari.rosti@gmail.com")
-
-(defn import-message [user fres]
-  {:from "ontrail@ontrail.net"
-   :to [admin]
-   :subject (str "Lenkkivihko-harjoituspäiväkirjan tuonti käyttäjälle " user)
-   :body (str fres)})
-
-(defn send-import-msg [user fres]
-  (try
-    (future (.info logger (str (postal/send-message (import-message user fres)))))
-    (catch Exception exception
-       (.error logger (str exception))
-       (stacktrace/print-stack-trace exception 100)
-       nil)))
+(def ^:const admin "jari.rosti@gmail.com")

 (defn reg-body [user]
   (str "Hei " user "!\n\n"
-       "Tervetuloa käyttämään Ontrailia! Olemme vielä kehitysvaiheessa ja palvelun ominaisuuksia päivitetään pikkuhiljaa. "
-       "Tällä hetkellä työn alla ovat lenkkien parempi seurattavuus. \n\n"
-
-       "Lenkkisi varmuuskopioidaan kahdesti päivässä. Halutessasi kaikki sinuun liittyvä data poistetaan "
-       "palvelimelta tai siirretään haluamassasi muodossa sinulle takaisin.\n\n"
+       "Tervetuloa käyttämään Ontrailia!\n\n"

-       "Kehitystä voit myös seurata Facebook-ryhmässä: https://www.facebook.com/groups/ontrail/ Palvelun teknisiin "
-       "yksityiskohtiin voin tutustua osoitteessa http://www.github.com/jrosti/ontrail\n\n"
+       "Ontrailin ylläpidon tavoittaa Facebook-ryhmässä: https://www.facebook.com/groups/ontrail/ tai lähettämällä"
+       "sähköpostia osoitteeseen ontrail@ontrail.net\n\n"

-       "Jos palvelusta on jotain kysyttävää, niin voit lähettää sähköpostia suoraan meille tai liittyä facebook-ryhmään, "
-       "josta voit seurata palvelun toimintaa, ominaisuuksia ja kehitystyötä lähemmin.\n\n"
-
+       "Yleisimmin kysyttyihin kysymyksiin löydät vastauksia ylläpitäjän sivuilta ontrailista osoitteesta\n\n"
+       "http://ontrail.net/#user/admin"
+
        "Ystävällisin terveisin, Ontrail-tiimi"))

 (defn send-register-msg [user email]
-    (try
-      (future (.info logger (str (postal/send-message {:from "ontrail@ontrail.net"
-                                               :to [email]
-                                               :cc [admin]
-                                               :subject "Tervetuloa Ontrailiin!"
-                                               :body (reg-body user) }))))
-      (catch Exception exception
-        (.error logger (str exception))
-        (stacktrace/print-stack-trace exception 100)
-        nil)))+  (try
+    (future (.info logger (str (postal/send-message {:from    "ontrail@ontrail.net"
+                                                     :to      [email]
+                                                     :cc      [admin]
+                                                     :subject "Tervetuloa Ontrailiin!"
+                                                     :body    (reg-body user)}))))
+    (catch Exception exception
+           (.error logger (str exception))
+           (stacktrace/print-stack-trace exception 100)
+           nil)))


Getting patch-graph close

Getting patch-graph close

--- src/dependable/core.clj
+++ src/dependable/core.clj
@@ -10,7 +10,20 @@

 (defn patch-graph
-  [graph patch] nil)
+  [graph patch]
+  (reduce-kv
+    (fn [cmt k v]
+      (assoc cmt k
+             (assoc v
+                    :children
+                    (map
+                      (fn [x] (patch-graph x patch))
+                      (v :children)))))
+    {}
+    graph))
+
+
+

 (defn choose-candidate
   [pname


updated dependencies, removed lein-ring plugin

--- src/leiningen/new/reagent/project.clj
+++ src/leiningen/new/reagent/project.clj
@@ -8,21 +8,20 @@

   :dependencies [[org.clojure/clojure "1.7.0-RC1"]
                  [ring-server "0.4.0"]
-                 [cljsjs/react "0.13.1-0"]
+                 [cljsjs/react "0.13.3-0"]
                  [reagent "0.5.0"]
                  [reagent-forms "0.5.1"]
                  [reagent-utils "0.1.4"]
                  [ring "1.3.2"]
-                 [ring/ring-defaults "0.1.4"]
+                 [ring/ring-defaults "0.1.5"]
                  [prone "0.8.2"]
-                 [compojure "1.3.3"]
+                 [compojure "1.3.4"]
                  [hiccup "1.0.5"]
                  [environ "1.0.0"]
-                 [org.clojure/clojurescript "0.0-3291" :scope "provided"]
+                 [org.clojure/clojurescript "0.0-3308" :scope "provided"]
                  [secretary "1.2.3"]{{{app-dependencies}}}]

-  :plugins [[lein-ring "0.9.1"]
-            [lein-environ "1.0.0"]
+  :plugins [[lein-environ "1.0.0"]
             [lein-asset-minifier "0.2.2"]]

   :ring {:handler {{project-ns}}.handler/app


moved upload to index.html - seems inverted

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -230,7 +230,7 @@
   (let [pixels (get-pixels context canvas)
         greyscale (fn [r g b alpha]
                     (let [grey (+ (* r 0.3) (* g 0.59) (* b 0.11))]
-                      (if (> grey (/ 255 2)) 1 0)))
+                      (if (> grey (/ 255 2)) 0 1)))
         f (fn [[r g b a & rest-pixels] result]
             (if (nil? a)
               result


changed new-bullet form to contain the correct fields

--- src/noteServer/html.clj
+++ src/noteServer/html.clj
@@ -35,11 +35,18 @@
                            data)
                       ;; Possibly move the form to a template, both to save
                       ;; bytes, and to only show it when js is active
+                      ;; It's also needed when creating new lists
+                      ;; Note that that would require a bit more work,
+                      ;; since the note and module id need to be known
+                      ;; when submitting the form.
+                      ;; But with some creative selector going upwards
+                      ;; this might not be a problem
                       [:li.new-item
                        [:form {:name "new-bullet"}
                         (text-field {:class "seamless" :placeholder "New bullet"} "text")
                         (submit-button {:class "seamless"} "→")
-                        (hidden-field {:data-module-id module-id :data-note-id note-id} "list-id")]]]
+                        (hidden-field "module-id" module-id)
+                        (hidden-field "note-id" note-id)]]]
                      "image"
                      [:img {:src (:image_src data) :title (:title_text data)}]
                      "header"


Add missing dep.

Add missing dep.

--- src/oc/email/mailer.clj
+++ src/oc/email/mailer.clj
@@ -11,6 +11,7 @@
             [cheshire.core :as json]
             [jsoup.soup :as soup]
             [oc.email.config :as c]
+            [oc.lib.slack :as slack-lib]
             [oc.email.content :as content]
             [oc.lib.storage :as storage]))


reformat

reformat

--- src/ontrail/summary.clj
+++ src/ontrail/summary.clj
@@ -29,9 +29,11 @@
      key sport}))

 ;; Example of db.group -command in mongodb format.
-;; db.exercise.group({cond: {user: "username"}, reduce: function(obj, prev) { prev.csum += obj.distance }, initial: {csum: 0 }});
+;; db.exercise.group({cond: {user: "username"},
+;; reduce: function(obj, prev) { prev.csum += obj.distance }, initial: {csum: 0 }});
 (defn get-db-summary [condition]
-    ;; Pace computation uses exercises, where both distance and duration are known. Those sums are recorded to tdur and tdist
+  ;; Pace computation uses exercises, where both distance and duration are known.
+  ;; Those sums are recorded to tdur and tdist
   ;; while reducing, and dist and dur are plain sums over the db values.
   (let [js-reduce "function(exercise, prev) {
                      if (exercise.distance > 0 && exercise.duration > 0) {


Update content.cljs

Update content.cljs

Have updated in response to feedback from David & Tim

FAQ: Why are survival rates monitored, FAQ: how are survival rates monitored? & FAQ: width of the predicted range & unforseen -> unforeseeable

--- src/prais2/content.cljs
+++ src/prais2/content.cljs
@@ -402,13 +402,13 @@
    {:title "Survival rate"
     :body  "The percentage of operations where the child survived at least 30 days after their operation."}
    :unforeseen-factors
-   {:title "Unforeseen factors"
+   {:title "Unforeseeable factors"
     :body  "It is impossible to predict precisely what is going to happen in an individual operation. This is partly due
     to the inevitable inability to predict the future with certainty – all people are physically unique and will react
     slightly differently to medicines, anaesthetic, surgery and no heart problem is exactly the same as another. Our
     inability to predict precisely is also partly because there are factors that we suspect may influence the outcome
     but cannot be included in the statistical formula because no routine data on them is collected. Together, we call
-    these all “unforeseen factors”."}})
+    these all “unforeseeable factors”."}})

 (def title "Everything else")

@@ -447,8 +447,8 @@
                                [:a {:href   "http://webarchive.nationalarchives.gov.uk/20090811143745/http:/www.bristol-inquiry.org.uk/final_report/the_report.pdf"
                                     :target "_blank"} "The Bristol Inquiry 2001"] "), which led to a number of changes, including a new
              compulsory national reporting system so that the proportion of children surviving to 30 days after surgery
-             for all hospitals have been published every year since 2001. Results where there is some evidence that survival
-             rates are lower than expected are checked further by the hospital and the national audit body (NICOR)."]
+             for all hospitals have been published every year since 2001. When there is some evidence that survival
+             rates were lower than expected, the results are checked further by the hospital and the national audit body (NICOR)."]

                               [:p "The UK and Ireland now have one of the strongest monitoring programmes in the world. Since reporting started, "
                                [:a {:href "http://www.bbc.co.uk/news/health-32162803" :target "_blank"} "survival rates have been improving"] "
@@ -469,7 +469,7 @@
                                     :target "_blank"} "types of procedure"] " because there was no clear way to put overall survival rates for
              each hospital into context (see " [:a {:href "?#/intro"} "What, Why and How?"] "). But "
                                [:a {:href "https://www.ucl.ac.uk/operational-research/AnalysisTools/PRAiS" :target "_blank"} "researchers"]
-                               " have now made this possible by creating a statistical formula. Using this formula, NICOR has published overall
+                               " have now made this possible by creating a statistical formula that gives a predicted chance of a child’s 30-day survival, taking the complexity of their medical problems into account. Using this formula, NICOR has published overall
                                survival rates along with the predicted range and extended predicted range for survival over the previous 3
                                years for each hospital since 2013 (see " [:a {:href "?#/intro"} "What, Why and How?"] ").  The predicted range
         is the range in which we expect to see each hospital’s survival rate the majority of the time (19 times out of
@@ -527,8 +527,7 @@
                              [:div
                               [:p "The predicted range for each hospital shows the range where we expect to see the observed survival rate if
        the hospital is performing as predicted by the formula, regardless of how many operations it did or what children
-       it treated. When a hospital does fewer operations, unforeseen factors have a bigger influence on the overall
-       outcome, and so it has a wider predicted range than a hospital that does many operations."]]}
+       it treated. The predicted range varies with the number of operations a hospital has done, and has to do with the unforeseeable factors that occur. We know that sometimes unforeseeable factors will affect a child’s survival – though, of course, we cannot predict exactly what they will be and when they will occur. In a smaller hospital performing 100 operations per year, even one more or fewer child surviving due to unforeseeable factors could make a big difference to its overall survival rate, whereas it would have less impact on the overall survival rate of a larger hospital performing 1000 operations. This is why hospitals doing more operations have a narrower predicted range than hospitals doing fewer operations."]]}

               {:title        "When looking at just one hospital, what does it mean if its survival is outside its predicted range?"
                :short-answer "There are four possible reasons for being outside the predicted range: inaccurate data, a formula


src/riemann/streams.clj: fill-in-last: fixed my previous commit

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -722,7 +722,7 @@
   event arriving. Inserted events have current time. Stops inserting when
   expired. Uses local times."
   ([interval update & children]
-   (fill-in-last* interval (fn [e] (merge e update)) children)))
+   (apply fill-in-last* interval (fn [e] (merge e update))) children))

 (defn interpolate-constant
   "Emits a constant stream of events every interval seconds, starting when an