Function order fix

Function order fix

--- src/re_db/core.cljs
+++ src/re_db/core.cljs
@@ -49,6 +49,9 @@
 (defn unique? [db-snap a]
   (boolean (get-in* db-snap [:schema a :db/unique])))

+(defn has? [db-snap e]
+  (contains? (:data db-snap) (resolve-id db-snap e)))
+
 (defn create-id! [db]
   (:entity-count (swap! db update* :entity-count
                         (fn [c] (first (filter #(not (has? @db %))
@@ -76,9 +79,6 @@

 (defn upsert-attr? [id]
   (and (number? id) (neg? id)))
-
-(defn has? [db-snap e]
-  (contains? (:data db-snap) (resolve-id db-snap e)))

 (defn entity [db-snap id]
   (when-let [id (resolve-id db-snap id)]


ruby copy opts

ruby copy opts

--- src/remote/ruby.clj
+++ src/remote/ruby.clj
@@ -34,7 +34,7 @@
            (sh- "ruby" "-v" {:dir dst})
            (catch Throwable e
              (throw+ {:type ::ruby-sanity-fail} "Failed to run ruby sanity step")))
-         (copy src dst))
+         (copy src dst {}))
   (run [this]
        (info (dest-path src dst))
        (apply sh- "ruby" (conj args {:dir (dest-path src dst) :timeout timeout})))


Fix a typo in a type hint.

Fix a typo in a type hint.

--- src/stencil/ast.clj
+++ src/stencil/ast.clj
@@ -17,7 +17,7 @@
                               the existing children, make the new node."))

 (defprotocol ASTNode
-  (render [this ^StrinbBuilder sb context-stack]
+  (render [this ^StringBuilder sb context-stack]
     "Given a StringBuilder and the current context-stack, render this node to
      the result string in the StringBuilder."))


adjusted hive image URL

adjusted hive image URL

--- src/hivewing_core/hive_image.clj
+++ src/hivewing_core/hive_image.clj
@@ -172,7 +172,7 @@
 (defn hive-image-package-key
   "Gets the address that we'll put the image package on in S3."
   [hive-uuid ^org.eclipse.jgit.revwalk.RevCommit reference]
-    (str (digest/sha-256 (str hive-uuid (.name reference))) "?ref=" (.name reference)))
+    (str (digest/sha-256 (str hive-uuid (.name reference))) "/" (.name reference)))

 (defn hive-image-packaged?
   "Determine if this image package exists on S3 already"


Fixed issue with directives not showing to players

--- src/hphelper/server/live/api.clj
+++ src/hphelper/server/live/api.clj
@@ -246,7 +246,12 @@
   (let [g (get-game gUid)]
     (if-let [p (-> g :hps (get uUid))]
       (let
-        [sgids (set (map :sg_id (filter #(= (:name p) (:owner %)) (:serviceGroups g))))
+        [sgids (->> g
+                    :serviceGroups
+                    (map val)
+                    (filter (fn [m] (= (:name p) (:owner m))))
+                    (map :sg_id)
+                    set)
          ret (->> (:directives g)
                   (filter #(sgids (:sg_id %)))
                   )


Use threading macro for app setup.

Use threading macro for app setup.

--- src/webdev/core.clj
+++ src/webdev/core.clj
@@ -1,11 +1,11 @@
 (ns webdev.core
-  (:use [org.httpkit.server :only [run-server]])
   (:require [webdev.item.migration :as migration]
             [webdev.item.routes :refer [item-routes]]
             [webdev.common.routes :refer [common-routes]]
             [webdev.common.middleware :refer [wrap-db
                                               wrap-simulated-methods]])
-  (:require [ring.middleware.reload :refer [wrap-reload]]
+  (:require [org.httpkit.server :refer [run-server]]
+            [ring.middleware.reload :refer [wrap-reload]]
             [ring.middleware.params :refer [wrap-params]]
             [ring.middleware.resource :refer [wrap-resource]]
             [ring.middleware.file-info :refer [wrap-file-info]]
@@ -14,13 +14,18 @@

 (def db (env :database-url))

+(def app-routes
+  (routes
+    item-routes
+    common-routes))
+
 (def app
-  (wrap-file-info
-    (wrap-resource
-      (wrap-db
-        (wrap-params
-          (wrap-simulated-methods (routes item-routes common-routes))))
-      "static")))
+  (-> app-routes
+      (wrap-simulated-methods)
+      (wrap-params)
+      (wrap-db)
+      (wrap-resource "static")
+      (wrap-file-info)))

 (defn -main [port]
   (migration/create-table db)


(PE-2115) Improve exceptions when missing services

--- src/puppetlabs/trapperkeeper/core.clj
+++ src/puppetlabs/trapperkeeper/core.clj
@@ -148,6 +148,34 @@
   [^TrapperKeeperApp app]
   ((get-service-fn app :shutdown-service :do-shutdown)))

+(defn- compile-graph
+  "Given the merged map of services, compile it into a function suitable for instantiation.
+  Throws an exception if there is a dependency on a service that is not found in the map."
+  [graph-map]
+  {:pre  [(service-graph? graph-map)]
+   :post [(ifn? %)]}
+  (try
+    (graph/eager-compile graph-map)
+    (catch IllegalArgumentException e
+      (let [match (re-matches #"(?s)^Failed on keyseq: \[:(.*)\]\. Value is missing\. .*$" (.getMessage e))]
+        (if match
+          (throw (RuntimeException. (format "Service function '%s' not found" (second match))))
+          (throw e))))))
+
+(defn- instantiate
+  "Given the compiled graph function, instantiate the application. Throws an exception
+  if there is a dependency on a service function that is not found in the graph."
+  [graph-fn]
+  {:pre  [(ifn? graph-fn)]
+   :post [(service-graph? %)]}
+  (try
+    (graph-fn {})
+    (catch RuntimeException e
+      (let [match (re-matches #"^Key (:.*) not found in null$" (.getMessage e))]
+        (if match
+          (throw (RuntimeException. (format "Service '%s' not found" (second match))))
+          (throw e))))))
+
 (defn bootstrap*
   "Helper function for bootstrapping a trapperkeeper app."
   ([services] (bootstrap* services {}))
@@ -158,10 +186,9 @@
    :post [(instance? TrapperKeeperApp %)]}
   (let [graph-map       (-> (apply merge (cli-service cli-data) services)
                             (register-shutdown-hooks!))
-        graph-fn        (graph/eager-compile graph-map)
-        graph-instance  (graph-fn {})
-        app             (TrapperKeeperApp. graph-instance)]
-    app)))
+        graph-fn        (compile-graph graph-map)
+        graph-instance  (instantiate graph-fn)]
+    (TrapperKeeperApp. graph-instance))))

 (defn parse-cli-args!
   "Parses the command-line arguments using `puppetlabs.kitchensink.core/cli!`.


Adds greater-than

Adds greater-than

--- src/the_little_clojurian/chapter4.clj
+++ src/the_little_clojurian/chapter4.clj
@@ -101,3 +101,15 @@
   (is (= (tup+ '(2 3) '(4 6)) '(6 9)))
   (is (= (tup+ '(3 6 9 11 4) '(8 5 2 0 7)) '(11 11 11 11 11)))
   (is (= (tup+ '(3 7) '(4 6 8 1)) '(7 13 8 1))))
+
+(with-test
+  (def greater-than
+    (fn [n m] false
+      (cond (zero? n) false
+            (zero? m) true
+            :else (greater-than (sub1 n) (sub1 m)))))
+
+  (is (= (greater-than 0 0) false))
+  (is (= (greater-than 12 133) false))
+  (is (= (greater-than 120 11) true))
+  (is (= (greater-than 4 6) false)))


Attempting to centre icons at all scales. Works but really fragile.

--- src/unspun/screens/number_needed.cljs
+++ src/unspun/screens/number_needed.cljs
@@ -14,6 +14,7 @@
     :or   {size 100 draw? true key nil}}]
   (view {:key   key
          :style {:backgroundColor "orange"
+                 :paddingTop 1
                  :aspectRatio     1
                  :opacity         (if draw? 1 0)
                  :justifyContent  "space-around"
@@ -21,13 +22,20 @@
                  :width           size                      ;size
                  :borderRadius    (/ size 2)
                  }}
-        (ionicon {:name  "ios-wine"                         ;"ios-radio-button-on"
-                  :size  100
-                  :flex  1
-                  :style {:color           "white"
-                          :backgroundColor "rgba(0,0,0,0)"
-                          :transform       [{:scale (/ size 100)}]
-                          }})))
+        (view
+          {:style {:transform (clj->js [{:translateX 10}
+                                        {:translateY -99}
+                                        {:scale (/ size 100)}
+                                        {:translateX (/ (* -9 100) size)}
+                                        {:translateY (/ (* 100 100) size)}
+                                        ])}}
+          (ionicon {:name  "ios-wine"                      ;"ios-radio-button-on"
+                    :size  100
+                    :style {:width           100
+                            :textAlign       "center"
+                            :color           "white"
+                            :backgroundColor "rgba(0,0,0,0)"
+                            }}))))

 (defn draw-n-square
   [n]
@@ -53,20 +61,30 @@
                   (draw-square {:size 50}))))
         ))

+(def testn 40)
+
 (def row0 [0 0 0 0 0])
 (def row1 [0 0 1 0 0])
 (def row2 [0 1 0 1 0])
-(def row3 [0 1 1 1 0])
+(def row3 [1 0 1 0 1])
 (def row4 [1 1 0 1 1])
 (def row5 [1 1 1 1 1])
+(def row10 (vec (concat row5 [0] row5)))
 (def rown [row0 row1 row2 row3 row4 row5])
 (def block10 [row5 row5])
-(defn approw [b n] (if (< n 6)
-                     (conj b row0 (rown n))
-                     (conj (approw b 5) (rown (- n 5)))))
-(def block20 (approw block10 10))
-(def block30 (approw block20 10))
-(def block40 (approw block30 10))
+(defn append-block [b n] (if (< n 6)
+                           (conj b row0 (rown n))
+                           (conj (append-block b 5) (rown (- n 5)))))
+(def block20 (append-block block10 10))
+(def block30 (append-block block20 10))
+;(def block40 (append-block block30 10))
+
+(def block40 (into [] (-> nil
+                         (append-block 8)
+                         (append-block 10)
+                         (append-block 10)
+                         (append-block 10))))
+
 (def dice {1  [[1]]
            2  [[1 0]
                [0 1]]
@@ -90,44 +108,59 @@
                [1 1 1]
                [1 1 1]]
            10 block10
-           11 (approw block10 1)
-           12 (approw block10 2)
-           13 (approw block10 3)
-           14 (approw block10 4)
-           15 (approw block10 5)
-           16 (approw block10 6)
-           17 (approw block10 7)
-           18 (approw block10 8)
-           19 (approw block10 9)
+           11 (append-block block10 1)
+           12 (append-block block10 2)
+           13 (append-block block10 3)
+           14 (append-block block10 4)
+           15 (append-block block10 5)
+           16 (append-block block10 6)
+           17 (append-block block10 7)
+           18 (append-block block10 8)
+           19 (append-block block10 9)
            20 block20
-           21 (approw block20 1)
-           22 (approw block20 2)
-           23 (approw block20 3)
-           24 (approw block20 4)
-           25 (approw block20 5)
-           26 (approw block20 6)
-           27 (approw block20 7)
-           28 (approw block20 8)
-           29 (approw block20 9)
+           21 (append-block block20 1)
+           22 (append-block block20 2)
+           23 (append-block block20 3)
+           24 (append-block block20 4)
+           25 (append-block block20 5)
+           26 (append-block block20 6)
+           27 (append-block block20 7)
+           28 (append-block block20 8)
+           29 (append-block block20 9)
            30 block30
-           31 (approw block30 1)
-           32 (approw block30 2)
-           33 (approw block30 3)
-           34 (approw block30 4)
-           35 (approw block30 5)
-           36 (approw block30 6)
-           37 (approw block30 7)
-           38 (approw block30 8)
-           39 (approw block30 9)
+           31 (append-block block30 1)
+           32 (append-block block30 2)
+           33 (append-block block30 3)
+           34 (append-block block30 4)
+           35 (append-block block30 5)
+           36 (append-block block30 6)
+           37 (append-block block30 7)
+           38 (append-block block30 8)
+           39 (append-block block30 9)
            40 block40
            })
-(def dicen (partial get dice))
-
-(defn nested-n-square*
-  [w n]
-  (let [a (Math.ceil (Math.sqrt n))]
+
+(defn dicen
+  "layout n icons in an easy to count manner (dice-like for small n)"
+  [n]
+  (cond
+    (< n 10) (get dice n)
+    (< n 20) (append-block block10 n)
+    (< n 30) (append-block block20 n)
+    (< n 40) (append-block block30 n)
+    :else (append-block block40 0)
+    ))
+
+(rum/defc nested-n-square* < rum/static
+  [w h n]
+  (let [padding 20
+        cols (count ((dicen n) 0))
+        rows (count (dicen n))
+        a (/ (- w (* 2 padding)) cols)]
     (view {:style {:flexDirection     "column"
-                   :height            w
+                   :width             w
+                   :padding           padding
+                   ;:height
                    :justifyContent    "space-around"
                    :borderBottomWidth 1
                    :borderBottomColor "black"}}
@@ -136,7 +169,7 @@
                    :style {:flexDirection  "row"
                            :justifyContent "space-around"}}
                   (for [[j col] (zipmap (range) row)]
-                    (draw-square {:size  (/ (* 0.8 w) a)
+                    (draw-square {:size  (if (zero? col) (/ a 3) a)
                                   :draw? (not (zero? col))
                                   :key   (str "c" j)})))))))

@@ -246,7 +279,7 @@
                          (view {:style {:flex           1
                                         :flexDirection  "column"
                                         :justifyContent "flex-start"}}
-                               (nested-n-square* w 33)
+                               (nested-n-square* w h testn)
                                #_(view {:style {:flexDirection     "column"
                                                 :height            w
                                                 :justifyContent    "space-around"


beginning to add highlights to new icons and adjust colours to taste

--- src/unspun/screens/number_needed.cljs
+++ src/unspun/screens/number_needed.cljs
@@ -33,29 +33,7 @@
                             :backgroundColor "rgba(0,0,0,0)"
                             }}))))

-(defn draw-n-square
-  [n]
-  (view {:backgroundColor "blue"
-         :style           {:flex           1
-                           :flexDirection  "row"
-                           :alignItems     "center"
-                           :justifyContent "space-around"
-                           :aspectRatio    1
-                           :margin         2
-                           }
-         :aspectRatio     1
-         }
-        (for [k (range n)]
-          (view {:key   k
-                 :style {:flex           1
-                         :flexDirection  "column"
-                         :alignItems     "center"
-                         :justifyContent "space-around"}
-                 }
-
-                (for [sq (range n)]
-                  (draw-square {:size 50}))))
-        ))
+

 (def testn 3)

@@ -105,24 +83,9 @@
     (map flatten)
     (mapv vec)))

-(defn block-k-n
-  [n k]
-  (->>                                                      ;(row-n-m* n 20 20)
-    (range (* k (Math.ceil (/ n k))))
-    (map-indexed #(if (< %1 n) 1 0))
-    (partition-all k)
-    (partition-all 5)
-    (interpose (repeat k 0))
-    (flatten)
-    (partition-all k)
-    (map (partial partition-all 2))
-    (map (partial interpose [0]))
-    (map flatten)
-    (mapv vec)))
-
 (defn blocks
   [n cols w h]
-  (->>                                                      ;(row-n-m* n 20 20)
+  (->>
     (range (* cols (Math.ceil (/ n cols))))
     (map-indexed #(if (< %1 n) 1 0))
     (partition-all cols)
@@ -135,22 +98,46 @@
     (map flatten)
     (mapv vec)))

+(defn blocks*
+  "Create a layout for n icons, in cols columns, organised into blocks of w width and h height. Blocks are separated
+  by rows or columns of zeroes. Full cells are indicated by non-sero entries (mostly 1s)."
+  [n cols w h]
+  (let [blocks-per-row (Math.ceil (/ cols w))
+        block-size (* w h)
+        full-block-count (quot n block-size)
+        remainder (rem n block-size)
+        row-blocks-capacity (* cols h)
+        rows-of-full-blocks (quot n row-blocks-capacity)
+        partial-row-full-blocks (rem n row-blocks-capacity)
+        full-blocks-in-partial-row (quot partial-row-full-blocks block-size)
+        empty-row (->> (repeat cols 0)
+                       (partition w)
+                       (interpose 0)
+                       (flatten))
+        full-row-of-blocks (->> (repeat cols 1)
+                                (partition w)
+                                (interpose 0)
+                                (flatten)
+                                (repeat h)
+                                (repeat rows-of-full-blocks)
+                                (interpose empty-row))
+        last-block-count (- n (* rows-of-full-blocks row-blocks-capacity) (* full-blocks-in-partial-row block-size))]
+    [rows-of-full-blocks
+     full-row-of-blocks
+     "Unfinished"]
+
+    )
+  )
+
 (comment
   (blocks 500 20 5 5)
+  (blocks* 500 20 5 5)
   )

-#_(defn row-n-m
-    "Layout for row of length m with n icons showing"
-    [n m]
-    (let [row []]
-      (for [col (range m)]
-        (loop [row []
-               i 0]
-          (if (< i m)
-            (recur (conj row (if (and (pos? i) (mod i 6)) 1 0)) (inc i))
-            row)))))
-
 (comment
+  (blocks 33 10 5 2)
+  (blocks* 33 10 5 2)
+
   (row-n-m 3 5)
   ; => [1 1 1 0 0]
   (block-n-k 3 5)
@@ -193,7 +180,7 @@

 (defn dicen
   "layout n icons in an easy to count manner (dice-like for small n)"
-  [n]
+  [n highlight]
   (cond
     (< n 10) (get dice n)
     (<= n 20) (blocks n 5 5 2)
@@ -214,19 +201,67 @@
                  3 0)
                :else 0)))

+(defn ffloyd-sample
+  "Pick n random different integers from 0..nn"
+  [nn n]
+  (let [count (inc nn)]
+    (loop [i (- count n)
+           res #{}]
+      (if (< i count)
+        (let [j (inc i)
+              k (rand-int j)]
+          (if (res k)
+            (recur j (conj res i))
+            (recur j (conj res k))))
+        res))))
+(comment
+  (ffloyd-sample 10 3)
+  ; => #{7 1 8} for example
+  (ffloyd-sample 10 9)
+  ; => #{0 1 2 5 6 7 8 9 10} for example
+  )
+
+(rum/defc draw-icon
+  [{:keys [scenar size draw? key color back]
+    :or   {size 100 draw? true key nil color "white" back "black"}}]
+  "draw a icon selected by scenario."
+  (view {:key   key
+         :style {:backgroundColor back
+                 :paddingTop      1
+                 :aspectRatio     1
+                 :opacity         (if draw? 1 0)
+                 :flexDirection   "column"
+                 :justifyContent  "center"
+                 :alignItems      "center"
+                 :width           size                      ;size
+                 :borderRadius    (/ size 2)
+                 }}
+        (view
+          {:style {:transform (clj->js [{:scale (/ size 100)}])}}
+          (ionicon {:name  (:icon scenar)                   ;"ios-radio-button-on"
+                    :size  100
+                    :style {:width           100
+                            :textAlign       "center"
+                            :color           color
+                            :backgroundColor "rgba(0,0,0,0)"
+                            }})))
+  )
+
+
 (rum/defc nested-n-square** < rum/static
-  [w h n]
+  [scenar palette rr w h n highlight]
   (let [padding 10
-        cols (count ((dicen n) 0))
-        rows (count (dicen n))
-        a (/ (- w (* 2 padding)) cols)]
+        cols (count ((dicen n highlight) 0))
+        rows (count (dicen n highlight))
+        a (/ (- w (* 2 padding)) cols)
+        ]
+    (prn highlight)
     (view {:style {:flex    0
                    :width   w
-                   :height  (+ (* 2 padding) (icon-top (count (dicen n)) a n))
+                   :height  (+ (* 2 padding) (icon-top (count (dicen n highlight)) a n))
                    :padding padding
-
                    }}
-          (for [[i row] (zipmap (range) (dicen n))]
+          (for [[i row] (zipmap (range) (dicen n highlight))]
             (view {:key   (str "r" i)
                    :style {:flex     0
                            :position "relative"}}
@@ -236,8 +271,16 @@
                              :style {:position "absolute"
                                      :top      (icon-top i a n)
                                      :left     (* j a)}}
-                            (draw-square {:size  a
-                                          :draw? (not (zero? col))})))))))))
+                            (draw-icon {:scenar scenar
+                                        :size   a
+                                        :draw?  (not (zero? col))
+                                        :back   (if (and (zero? i) (zero? j))
+                                                  ((if (> rr 1) :accent :text-icons) palette)
+                                                  "rgb(0,0,0,0)")
+                                        :color  (if (and (zero? i) (zero? j))
+                                                  ((if (> rr 1) :text-icons :dark-primary) palette)
+                                                  "white")     ; (if (highlight (+ j (* i rows))) "black" "white")
+                                        })))))))))

 (defn draw-circle [scenar color size x y]
@@ -258,15 +301,6 @@
                                           {:scale 1}]}}))   ; the scale. higher = denser, but on same centres.

-#_(defn draw-icon [scenar color scale kk]
-    "draw a icon selected by scenario."
-    (n-icon {:name  (:icon scenar)
-             :style {:color           color
-                     :backgroundColor "rgba(0,0,0,0)"
-                     :width           30                    ;(* 30 scale kk)
-                     :transform       [{:translateX 0}      ;(* 15 scale kk)
-                                       {:scale (* scale kk)}]}}))
-

 (defn resize
   [event]
@@ -280,12 +314,15 @@
                                      state)})

-(rum/defc page < rum/reactive []
+
+
+(rum/defc page < rum/reactive (rum/local 0 ::icon-index) []
   (let [scenar ((rum/react stories) (rum/react story-index))
         palette (get-palette (rum/react palette-index))
         br (:baseline-risk scenar)
         rr (:relative-risk scenar)
         nn (number-needed rr br)
+        highlight (ffloyd-sample nn (max 0 ((if (> rr 1) identity dec) (anyway rr br))))
         [w h] (screen-w-h)
         w (- w 0)
         h (- h 168)                                         ; adjustment for existing header and footer
@@ -304,8 +341,8 @@
                                     }} content))

         padding 10
-        cols (count ((dicen nn) 0))
-        rows (count (dicen nn))
+        cols (count ((dicen nn highlight) 0))
+        rows (count (dicen nn highlight))
         a (/ (- w (* 2 padding)) cols)
         ]

@@ -350,15 +387,15 @@
                                  :left     0
                                  :right    0
                                  :zIndex   1
-                                 :height   1000}}
+                                 }}
                         (scroll-view {:onScroll            handle-scroll
                                       :scrollEventThrottle 16
                                       :key                 1
                                       :style               {:flex          1
                                                             :flexDirection "column"
-                                                            :opacity 0.8}}
-
-                                     (nested-n-square** w h nn)))
+                                                            :opacity       1}}
+
+                                     (nested-n-square** scenar palette rr w h nn highlight)))

                   (view {:key   2
                          :style {:position "absolute"
@@ -378,7 +415,7 @@
                                     (text {:style {:fontSize        (* (text-field-font-size) 10)
                                                    :color           (:light-primary palette)
                                                    :backgroundColor "rgba(0,0,0,0)"
-                                                   :opacity         1
+                                                   :opacity         0.7
                                                    }
                                            }
                                           (str nn)))))
@@ -550,6 +587,20 @@
                      :maxHeight      100
                      }}))

+  (defn ffloyd-sample
+    "Pick n random integers in 0..nn"
+    [nn n]
+    (let [count (inc nn)]
+      (loop [i (- count n)
+             res #{}]
+        (if (< i count)
+          (let [j (inc i)
+                k (rand-int j)]
+            (if (res k)
+              (recur j (conj res i))
+              (recur j (conj res k))))
+          res))))
+
   (comment
     ; testing for nn small
     (def br 0.269)


Update multipart-params to support progress listener

--- ring-core/src/ring/middleware/multipart_params.clj
+++ ring-core/src/ring/middleware/multipart_params.clj
@@ -13,7 +13,14 @@
            [org.apache.commons.fileupload UploadContext
                                           FileItemIterator
                                           FileItemStream
-                                          FileUpload]))
+                                          FileUpload
+                                          ProgressListener]))
+(defn- progress-listener
+  "Create a progress listener that calls the supplied function."
+  [request progress-fn]
+  (reify ProgressListener
+    (update [this bytes-read content-length item-count]
+      (progress-fn request bytes-read content-length item-count))))

 (defn- multipart-form?
   "Does a request have a multipart form?"
@@ -40,9 +47,13 @@

 (defn- file-item-seq
   "Create a seq of FileItem instances from a request context."
-  [context]
-  (file-item-iterator-seq
-    (.getItemIterator (FileUpload.) context)))
+  [request ^ProgressListener progress-fn context]
+  (let [upload (if progress-fn
+                 (doto (FileUpload.)
+                   (.setProgressListener (progress-listener request progress-fn)))
+                 (FileUpload.))]
+    (file-item-iterator-seq
+      (.getItemIterator ^FileUpload upload context))))

 (defn- parse-file-item
   "Parse a FileItemStream into a key-value pair. If the request is a file the
@@ -57,9 +68,9 @@

 (defn- parse-multipart-params
   "Parse a map of multipart parameters from the request."
-  [request encoding store]
+  [request encoding store progress-fn]
   (->> (request-context request encoding)
-       (file-item-seq)
+       (file-item-seq request progress-fn)
        (map #(parse-file-item % store encoding))
        (reduce (fn [m [k v]] (assoc-conj m k v)) {})))

@@ -86,8 +97,9 @@
         encoding (or (:encoding options)
                      (req/character-encoding request)
                      "UTF-8")
+        progress (:progress-fn options)
         params   (if (multipart-form? request)
-                   (parse-multipart-params request encoding store)
+                   (parse-multipart-params request encoding store progress)
                    {})]
     (merge-with merge request
                 {:multipart-params params}
@@ -102,15 +114,19 @@

   The following options are accepted

-  :encoding - character encoding to use for multipart parsing. If not
-              specified, uses the request character encoding, or \"UTF-8\"
-              if no request character encoding is set.
+  :encoding    - character encoding to use for multipart parsing. If not
+                 specified, uses the request character encoding, or \"UTF-8\"
+                 if no request character encoding is set.

-  :store    - a function that stores a file upload. The function should
-              expect a map with :filename, content-type and :stream keys,
-              and its return value will be used as the value for the
-              parameter in the multipart parameter map. The default storage
-              function is the temp-file-store."
+  :store       - a function that stores a file upload. The function should
+                 expect a map with :filename, content-type and :stream keys,
+                 and its return value will be used as the value for the
+                 parameter in the multipart parameter map. The default storage
+                 function is the temp-file-store.
+
+  :progress-fn - a function that gets called during uploads. The function
+                 should expect four parameters: request, bytes-read,
+                 content-length, and item-count."
   {:arglists '([handler] [handler options])}
   [handler & [options]]
   (fn [request]


Remove build-prs-only LD flag

Remove build-prs-only LD flag

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -603,12 +603,11 @@
                                      "If you have SSH keys, sensitive env vars or AWS credentials stored in your project settings and "
                                      "untrusted forks can make pull requests against your repo, then this option "
                                      "isn't for you!"])})
-            (when (feature/enabled? :build-prs-only)
-              (describe-flag {:flag :build-prs-only
-                              :title "Only build pull requests"
-                              :blurb [:p
-                                      "By default, we will build all the commits for this project. Once turned on, we will only build branches "
-                                      "that have associated pull requests open. Note: For your default branch, we will always build all commits."]}))
+            (describe-flag {:flag :build-prs-only
+                            :title "Only build pull requests"
+                            :blurb [:p
+                                    "By default, we will build all the commits for this project. Once turned on, we will only build branches "
+                                    "that have associated pull requests open. Note: For your default branch, we will always build all commits."]})
             ;; TODO remove the LD flag once shipped
             (when (feature/enabled? :autocancel-builds)
               (describe-flag {:flag :autocancel-builds


(PE-5433) Updated call to (request-handler)

--- src/clj/puppetlabs/services/master/master_core.clj
+++ src/clj/puppetlabs/services/master/master_core.clj
@@ -18,36 +18,36 @@
    - ie, any route without a version in its path (eg, /v2.0/whatever) - but
    excluding the CA-related endpoints, which are handled separately by the
    CA service."
-  [request-handler environment]
+  [request-handler]
   (compojure/routes
     ; TODO there are a bunch more that we'll need to add here
     ; https://tickets.puppetlabs.com/browse/PE-3977
     (compojure/GET "/node/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/GET "/facts/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/GET "/file_content/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/GET "/file_metadatas/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/GET "/file_metadata/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/GET "/file_bucket_file/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/PUT "/file_bucket_file/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/HEAD "/file_bucket_file/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/GET "/catalog/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/POST "/catalog/*" request
-                    (request-handler environment request))
+                    (request-handler request))
     (compojure/PUT "/report/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/GET "/resource_type/*" request
-                   (request-handler environment request))
+                   (request-handler request))
     (compojure/GET "/resource_types/*" request
-                   (request-handler environment request))))
+                   (request-handler request))))

 (defn root-routes
   "Creates all of the compojure routes for the master."
@@ -56,7 +56,7 @@
     (compojure/context "/v2.0" request
                        (v2_0-routes request-handler))
     (compojure/context "/:environment" [environment]
-                       (legacy-routes request-handler environment))))
+                       (legacy-routes request-handler))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public


Non-editable text field and combo box

Non-editable text field and combo box

--- flatguiwidgets/src/flatgui/widgets/textfield.clj
+++ flatguiwidgets/src/flatgui/widgets/textfield.clj
@@ -200,7 +200,7 @@
 (fg/defevolverfn text-model-evolver :model
   (cond

-    (not (get-property [:this] :editable))
+    (false? (get-property [:this] :editable))
     old-model

     (mouse/is-mouse-event? component)


Updating for a safer way to find which

Updating for a safer way to find which

--- config/software/gecode.clj
+++ config/software/gecode.clj
@@ -17,7 +17,7 @@
 ;;

 (let
-  [env (if (= 1 (get (sh "/bin/which" :args [ "g++44" ] :return-map true) :exit-status))
+  [env (if (= 1 (get (sh "/bin/sh" :args [ "-c" "which g++44" ] :return-map true) :exit-status))
          { "CC" "gcc44" "CXX" "g++44" }
          { })]


quick save

quick save

--- src/mccarthy_animation/core.cljc
+++ src/mccarthy_animation/core.cljc
@@ -110,7 +110,7 @@
   ;(quil/text (str "anim: " (get-in state [:hero :animation]) " count" ((get-in state [:hero :animation]) char/image-counts)) 10 300)
   )

-;; ensure additions are reflected in defsketch call
+;; ensure additions are reflected in sketch calls
 (defonce sketch-opts
   {:host "mccarthy-animation"
    :size [(:x screen-size) (:y screen-size)]
@@ -124,30 +124,13 @@
    ;; functional mode fun-mode.
    :middleware [m/fun-mode]})

-;; cljs entry point
+;; cljs start
 ;; TODO think about how to fix this without macros or a real eval
 #?(:cljs
-   (quil/defsketch mccarthy-animation
-     :host (:host sketch-opts)
-     :size (:size sketch-opts)
-     :setup (:setup sketch-opts)
-     :update (:update sketch-opts)
-     :no-start (:no-start sketch-opts)
-     :draw (:draw sketch-opts)
-     :title (:title sketch-opts)
-     :middleware (:middleware sketch-opts)
-     ))
+   (quil/defsketch mccarthy-animation :host (:host sketch-opts) :size (:size sketch-opts) :setup (:setup sketch-opts) :update (:update sketch-opts) :no-start (:no-start sketch-opts) :draw (:draw sketch-opts) :title (:title sketch-opts) :middleware (:middleware sketch-opts) ))

-;; clj application entry point
+;; clj application start
 #?(:clj
    (defn -main [& args]
      (println "App running, look up and enjoy.")
-     (quil/sketch
-      :host (:host sketch-opts)
-      :size (:size sketch-opts)
-      :setup (:setup sketch-opts)
-      :update (:update sketch-opts)
-      :no-start (:no-start sketch-opts)
-      :draw (:draw sketch-opts)
-      :title (:title sketch-opts)
-      :middleware (:middleware sketch-opts)) ))
+     (quil/sketch :host (:host sketch-opts) :size (:size sketch-opts) :setup (:setup sketch-opts) :update (:update sketch-opts) :no-start (:no-start sketch-opts) :draw (:draw sketch-opts) :title (:title sketch-opts) :middleware (:middleware sketch-opts)) ))


Optimized insert

Optimized insert

--- src/main/clojure/si/drola/jvmExercises/sorting.clj
+++ src/main/clojure/si/drola/jvmExercises/sorting.clj
@@ -5,7 +5,7 @@

 (defn insert [sorted x]
   (let [[smaller-than-x bigger-than-x] (split-with (partial > x) sorted)]
-    (concat smaller-than-x (list x) bigger-than-x)))
+    (concat smaller-than-x (cons x bigger-than-x))))

 (defn insertion-sort [numbers] (reduce insert '() numbers))


Fix bug when updating node

Fix bug when updating node

--- src/nbgraph/model/mongograph.clj
+++ src/nbgraph/model/mongograph.clj
@@ -111,10 +111,13 @@

   (set-fraudulent-status [this node status]
     (if (or (= status true) (= status false))
-      (mc/update (nodes-collection-ext-name graph-name)
-               {:id node}
-               {"$set" {:is-fraudulent? status}}
-               :upsert false)
+      (do
+        (mc/update (nodes-collection-ext-name graph-name)
+                   {:id node}
+                   {"$set" {:is-fraudulent? status}}
+                   :upsert false)
+        (set-scores-updated-status this false)
+        (set-distance-matrix-updated-status this false))
       (throw (IllegalArgumentException. (str "Invalid boolean value:" status))))))

 ;;; DB collection names ==============================================


Clean out package output logic

Clean out package output logic

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/subcommands/package.clj
+++ src/obcc/subcommands/package.clj
@@ -32,11 +32,13 @@
         compressiontype (:compress options)
         outputfile (getoutputfile options path)]

-    (println "Writing CCA to:" (.getAbsolutePath outputfile))
+    ;; generate the actual file
+    (dar/write path filespec compressiontype outputfile)
+
+    ;; emit header information after we know the file write was successful
+    (println "Wrote CCA to:" (.getAbsolutePath outputfile))
     (println "Using path" path (str filespec))
     (println "Using compression:" compressiontype )

-    (dar/write path filespec compressiontype outputfile)
-
     ;; re-use the ls function to display the contents
     (ls outputfile)))


truncate org slug

truncate org slug

--- src/oc/storage/resources/org.clj
+++ src/oc/storage/resources/org.clj
@@ -38,6 +38,12 @@
   [org]
   (apply dissoc org ignored-properties))

+(defn trunc
+  "
+  Truncate a string based on length
+  "
+  [s n]
+  (subs s 0 (min (count s) n)))
 ;; ----- Organization Slug -----

 ;; Excluded slugs due to existing and potential URL routing conflicts
@@ -83,7 +89,7 @@
     (-> org-props
         keywordize-keys
         clean
-        (assoc :slug slug)
+        (assoc :slug (trunc slug 126)) ;; primary key length is 127
         (assoc :uuid (db-common/unique-id))
         (assoc :authors [(:user-id user)])
         (update :promoted #(or % default-promoted))


Extract window-record only once.

Extract window-record only once.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -341,23 +341,26 @@

 (defn assign-window [segment window-state w]
   (let [window-id (:window/id w)
-        segment-coerced (we/uniform-units (:window/record w) segment)]
+        window-record (:window/record w)
+        segment-coerced (we/uniform-units window-record segment)]
     (swap! window-state
-           #(assoc % window-id
+           #(assoc %
+                   window-id
                    (we/speculate-update
-                    (:window/record w)
-                    (get % window-id)
-                    segment-coerced)))
+                     window-record
+                     (get % window-id)
+                     segment-coerced)))

     (swap! window-state
-           #(assoc % window-id
+           #(assoc %
+                   window-id
                    (we/merge-extents
-                    (:window/record w)
-                    (get % window-id)
-                    (:window/super-agg-fn w)
-                    segment-coerced)))
-
-    (let [extents (we/extents (:window/record w) (keys (get @window-state window-id)) segment-coerced)]
+                     window-record
+                     (get % window-id)
+                     (:window/super-agg-fn w)
+                     segment-coerced)))
+
+    (let [extents (we/extents window-record (keys (get @window-state window-id)) segment-coerced)]
       (doall
        (map (fn [e]
               (let [f (:window/agg-fn w)


Ports seal? to peer side.

Ports seal? to peer side.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -3,7 +3,7 @@
               [com.stuartsierra.component :as component]
               [dire.core :as dire]
               [taoensso.timbre :refer [info warn] :as timbre]
-              [onyx.coordinator.planning :refer [find-task]]
+              [onyx.log.commands.common :as common]
               [onyx.peer.task-lifecycle-extensions :as l-ext]
               [onyx.peer.pipeline-extensions :as p-ext]
               [onyx.queue.hornetq :refer [hornetq]]
@@ -12,6 +12,13 @@
               [onyx.peer.operation :as operation]
               [onyx.extensions :as extensions]
               [onyx.plugin.hornetq]))
+
+(defn seal-task? [replica job task id]
+  (let [n-peers (count (get-in replica [:allocations job task]))
+        status (common/task-status replica job task)]
+    (and (>= (:waiting status) (dec n))
+         (zero? (:sealing status))
+         (= (get-in replica [:peer-states id]) :active))))

 (defn munge-start-lifecycle [event]
   (l-ext/start-lifecycle?* event))


Some tweeks with fx

Some tweeks with fx

--- src/overtone_workspace/beats.clj
+++ src/overtone_workspace/beats.clj
@@ -16,8 +16,8 @@
         freq (midi->hz (+ (note :C3) -1))
         dur (/ 60.0 (metro :bpm))
         attack (* dur 4) ; 1bar
-        rel (* dur (* 4 15))
-        amp 0.2]  ; 15bars
+        rel (* dur (* 4 7)) ; 7bars
+        amp 0.2]
     (at (metro beat)
         (do
           (if (zero? (mod beat 8)) (grumble :freq freq :freq-mul 0.5 :attack attack :release rel :amp amp))
@@ -62,14 +62,16 @@
 ;; (stop)

 (comment
-  (inst-fx! latchbell fx-echo)
+  (inst-fx! latchbell fx-chorus)
   (inst-fx! latchbell fx-distortion2)
   (clear-fx latchbell)

-  (inst-fx! grumble fx-bitcrusher)
+  (inst-fx! grumble fx-chorus)
   (clear-fx grumble)

-  (inst-fx! laserbeam fx-freeverb)
+  (inst-fx! laserbeam fx-distortion2)
+  (inst-fx! laserbeam fx-distortion-tubescreamer)
+  (inst-fx! laserbeam fx-chorus)
   (clear-fx laserbeam))


Add string type hint for Exception constructor in deftask

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -894,7 +894,7 @@
            (let [msg# (delay (format "deftask %s/%s was overridden\n" *ns* '~sym))]
              (boot.util/warn (if (<= @util/*verbosity* 2)
                                @msg#
-                               (ex/format-exception (Exception. @msg#)))))))
+                               (ex/format-exception (Exception. ^String @msg#)))))))
        (cli2/defclifn ~(vary-meta sym assoc ::task true)
          ~@heads
          ~bindings


adjusted tests for logistic classifier, simplifying things a lot.

--- test/forma/classify/logistic_test.clj
+++ test/forma/classify/logistic_test.clj
@@ -1,72 +1,49 @@
 (ns forma.classify.logistic-test
+  "This namespace tests the numerical properties of the logistic
+  classifier."
   (:use [forma.classify.logistic] :reload)
-  (:use [midje sweet cascalog]
-        [clojure-csv.core]
-        [cascalog.api]
-        [midje.cascalog]
+  (:use [midje sweet]
         [clojure-csv.core])
   (:import [org.jblas FloatMatrix MatrixFunctions DoubleMatrix])
-  (:require [incanter.core :as i]
-            [forma.testing :as t]
-            [forma.date-time :as date]
-            [cascalog.ops :as c]))
+  (:require [forma.testing :as t]))

-(defn read-mys-csv
-  "returns a properly adjusted list of the malaysia test data."
-  [file-name]
+(defn- csv->seq
+  "Returns a lazy sequence of the rows in the CSV file located at the
+  supplied path."
+  [file-path]
   (map
    (partial map #(Float/parseFloat %))
    (butlast (parse-csv
-             (slurp file-name)))))
+             (slurp file-path)))))

-(def label-path (t/dev-path "/testdata/mys-label.csv"))
-(def feature-path (t/dev-path "/testdata/mys-feature.csv"))
+(defn- test-beta
+  "Returns the coefficient vector for the supplied data sets.  The
+  rows in each data set correspond to the labels and features to a
+  specific pixel, so that the first row in each data set indicates the
+  labels and features of the same pixel.  features in the first row of
+  the feature data set."
+  [label-path feature-path]
+  (let [y (to-double-rowmat
+           (apply concat (csv->seq label-path)))
+        X (to-double-matrix
+           (map (partial cons 1) (csv->seq feature-path)))]
+    (logistic-beta-vector y X 1e-8 1e-10 6)))

-(def y
-  "returns a list of binary labels for training."
-  (apply concat (read-mys-csv label-path)))
-
-(def X
-  "returns a clojure object of the feature vectors, with a constant
-  prepended."
-  (map (partial cons 1) (read-mys-csv feature-path)))
+(facts
+  "Test the numerical outcomes of running the logistic classifier on a
+  relatively small dataset extracted from Malaysia (features and
+  labels for 1,000 pixels)."
+  (let [label-path   (t/dev-path "/testdata/mys-label.csv")
+        feature-path (t/dev-path "/testdata/mys-feature.csv")
+        beta         (test-beta label-path feature-path)]
+    (vector? beta) => true
+    (last beta)    => (roughly -15.1054)
+    (first beta)   => (roughly -2.41557)))

 (fact
-  "a linear combination that results in zero will yield a probability of 0.5"
+  "Test a basic property of the logistic probability function, namely
+  that a linear combination that results in zero will yield a
+  probability of 0.5; and that the result is an instance of a double
+  row matrix"
   (logistic-prob (to-double-rowmat [1 2 3])
                  (to-double-rowmat [0 0 0])) => (to-double-rowmat [0.5]))
-
-(def y-mat (to-double-rowmat y))
-(def X-mat (to-double-matrix X))
-
-(facts
- (let [beta (logistic-beta-vector y-mat X-mat 1e-8 1e-10 6)]
-   (vector? beta) => true
-   (last beta)    => (roughly -15.1054)
-   (first beta)   => (roughly -2.4156)))
-
-;; USEFUL FOR BENCHMARK
-
-(defn multiplier
-  [n]
-  ((partial * 1000) n))
-
-(defn mk-x
-  [n]
-  (DoubleMatrix/rand (multiplier n) 20))
-
-(defn mk-y
-  [n]
-  (to-double-rowmat (repeatedly (multiplier n) #(rand-int 2))))
-
-(defn run-logistic-beta-vector
-  "Run logistic-beta-vector on dataset of size n * 1000, with up to specified iterations"
-  [n iterations]
-  (let [big-X (mk-x n)
-        big-y (mk-y n)]
-    (prn (.rows big-X) (.columns big-X))
-    (logistic-beta-vector big-y big-X 1e-8 1e-10 iterations)))
-
-;; TIME required to calculate logistic betas for 1 million obs, 10 iterations
-;; (time (run-logistic-beta-vector 1000 10))
-;; "Elapsed time: 5014.590245 msecs"


CMR-3701: One more test.

CMR-3701: One more test.

--- system-int-test/test/cmr/system_int_test/ingest/collection_revision_validation_test.clj
+++ system-int-test/test/cmr/system_int_test/ingest/collection_revision_validation_test.clj
@@ -2,9 +2,9 @@
   "CMR Ingest revision validation integration tests"
   (:require
     [clojure.test :refer :all]
-    [cmr.system-int-test.utils.ingest-util :as ingest]
-    [cmr.system-int-test.data2.collection :as dc]
-    [cmr.ingest.services.messages :as msg]))
+    [cmr.ingest.services.messages :as msg]
+    [cmr.system-int-test.data2.umm-spec-collection :as data-umm-c]
+    [cmr.system-int-test.utils.ingest-util :as ingest]))

 (defn- assert-revision-conflict
   [concept-id format-str response]
@@ -17,7 +17,7 @@
 (deftest revision-id-validations
   (testing "ingesting a concept with the same concept-id and revision-id fails"
     (let [concept-id "C1-PROV1"
-          existing-concept (dc/collection-concept {:revision-id 1 :concept-id concept-id})
+          existing-concept (data-umm-c/collection-concept {:EntryTitle "E1" :ShortName "S1" :revision-id 1 :concept-id concept-id})
           _ (ingest/ingest-concept existing-concept)
           response (ingest/ingest-concept existing-concept)]
       (is (= {:status 409
@@ -25,27 +25,27 @@
              response))))

   (testing "attempting to ingest using an non-integer revision id returns an error"
-    (let [response (ingest/ingest-concept (dc/collection-concept {:concept-id "C2-PROV1"
+    (let [response (ingest/ingest-concept (data-umm-c/collection-concept {:EntryTitle "E2" :ShortName "S2" :concept-id "C2-PROV1"
                                                                   :revision-id "NaN"}))]
       (is (= {:status 422
               :errors [(msg/invalid-revision-id "NaN")]}
              response))))

   (testing "attempting to ingest using a negative revision id returns an error"
-    (let [response (ingest/ingest-concept (dc/collection-concept {:concept-id "C2-PROV1"
+    (let [response (ingest/ingest-concept (data-umm-c/collection-concept {:EntryTitle "E3" :ShortName "S3" :concept-id "C2-PROV1"
                                                                   :revision-id "-1"}))]
       (is (= {:status 422
               :errors [(msg/invalid-revision-id "-1")]}
              response))))

   (testing "ingesting a concept with just the revision-id succeeds"
-    (let [response (ingest/ingest-concept (dc/collection-concept {:revision-id "2"}))]
+    (let [response (ingest/ingest-concept (data-umm-c/collection-concept {:EntryTitle "E4" :ShortName "S4" :revision-id "2"}))]
       (is (and (= 200 (:status response)) (= 2 (:revision-id response))))))

   (testing "ingesting a concept while skipping revision-ids succeeds,
             but fails if revision id is smaller than the maximum revision id"
     (let [concept-id "C3-PROV1"
-          coll (dc/collection-concept {:concept-id concept-id})
+          coll (data-umm-c/collection-concept {:EntryTitle "E5" :ShortName "S5" :concept-id concept-id})
           _ (ingest/ingest-concept (assoc coll :revision-id "2"))
           response1 (ingest/ingest-concept (assoc coll :revision-id "6"))
           response2 (ingest/ingest-concept (assoc coll :revision-id "4"))]
@@ -63,26 +63,26 @@
 (deftest revision-conflict-tests
   (testing "Update with lower revision id should be rejected
             if it comes after an concept with a higher revision id"
-    (let [concept (dc/collection-concept {:revision-id 4})
+    (let [concept (data-umm-c/collection-concept {:EntryTitle "E1" :ShortName "S1" :revision-id 4})
           concept-id (:concept-id (ingest/ingest-concept concept))
           response (ingest/ingest-concept (assoc concept :revision-id 2))]
       (assert-revision-conflict concept-id "Expected revision-id of [5] got [2] for [%s]" response)))

   (testing "Delete with lower revision id than latest concept should be rejected"
-    (let [concept (dc/collection-concept {:revision-id 4})
+    (let [concept (data-umm-c/collection-concept {:EntryTitle "E2" :ShortName "S2" :revision-id 4})
           concept-id (:concept-id (ingest/ingest-concept concept))
           response (ingest/delete-concept concept {:revision-id 2})]
       (assert-revision-conflict concept-id "Expected revision-id of [5] got [2] for [%s]" response)))

   (testing "Ingest with lower revision id than latest tombstone should be rejected"
-    (let [concept (dc/collection-concept {})
+    (let [concept (data-umm-c/collection-concept {:EntryTitle "E3" :ShortName "S3"})
           concept-id (:concept-id (ingest/ingest-concept concept))
           _ (ingest/delete-concept concept {:revision-id 5})
           response (ingest/ingest-concept (assoc concept :revision-id 3))]
       (assert-revision-conflict concept-id "Expected revision-id of [6] got [3] for [%s]" response)))

   (testing "Delete with lower revision id than latest tombstone results in a 404"
-    (let [concept (dc/collection-concept {})
+    (let [concept (data-umm-c/collection-concept {:EntryTitle "E4" :ShortName "S4"})
           concept-id (:concept-id (ingest/ingest-concept concept))
           _ (ingest/delete-concept concept {:revision-id 5})
           {:keys [status errors]} (ingest/delete-concept concept {:revision-id 3})]
@@ -91,7 +91,7 @@
                              (:native-id concept) concept-id)]))))

   (testing "Deleting non-existent collection should be rejected"
-    (let [concept (dc/collection-concept {})
+    (let [concept (data-umm-c/collection-concept {:EntryTitle "E5" :ShortName "S5"})
           response (ingest/delete-concept concept {:revision-id 2})
           {:keys [status errors]} response]
       (is (= status 404))


Modified class_consolidation_by_shared_label rule

Removed a * and replaced with a longer property path. Ideally the minus
blocks in the query would use rdf:type/rdfs:subClassOf*, but the *
appears to be quite detrimental to execution time

--- resources/rules/pre_identifier_merge/step_b_id_exact_match/shared_label/class_consolidation_by_shared_label.clj
+++ resources/rules/pre_identifier_merge/step_b_id_exact_match/shared_label/class_consolidation_by_shared_label.clj
@@ -4,41 +4,41 @@
 `{:name          "class-consolidation-by-shared_label"
   :title         "creates exactMatch mappings between Class identifiers whose classes share the same exact label"
   :head          ((?/id1 skos/exactMatch ?/id2))
-  :sparql-string "prefix franzOption_clauseReorderer: <franz:identity>
-                  prefix franzOption_chunkProcessingAllowed: <franz:yes>
+  :sparql-string "prefix franzOption_chunkProcessingAllowed: <franz:yes>
                   prefix rdf: <http://www.w3.org/1999/02/22-rdf-syntax-ns#>
                   prefix oboInOwl: <http://www.geneontology.org/formats/oboInOwl#>
-                  select ?c1 ?c2 ?label {
-                       ?c1 oboInOwl:hasOBONamespace ?ns1 .
-                       ?c1 rdf:type owl:Class .
-                       ?c1 rdfs:label ?label .
-                       ?c2 rdfs:label ?label .
-                       ?c2 oboInOwl:hasOBONamespace ?ns2 .
-                       ?c2 rdf:type owl:Class .
-                       # require that c1 and c2 are different and return in a reproducible order to avoid duplicate pairings
-                       # also exclude several ontologies:
-                       #   PR: so that we don't intentionally collapse genes with proteins
-                       #   NCBITaxon: matches appear to be spurious
-                       #   UBERON: so as not to incorrectly collapse species-specific anatomy
-                       #   PO: also so as not to incorrectly collapse plant anatomy with other things
-                       FILTER (?c1 != ?c2 && STR(IRI(?c1)) < STR(IRI(?c2))
-                                   && !contains(str(?c1), 'obo/PR_')
-                                   && !contains(str(?c2), 'obo/PR_')
-                                   && !contains(str(?c1), 'obo/UBERON_')
-                                   && !contains(str(?c2), 'obo/UBERON_')
-                                   && !contains(str(?c1), 'obo/NCBITaxon_')
-                                   && !contains(str(?c2), 'obo/NCBITaxon_')
-                                   && !contains(str(?c1), 'obo/PO_')
-                                   && !contains(str(?c2), 'obo/PO_')
-                                   # CHEBI:base and SO:base are not the same
-                                   && ?label != 'base'
-                                   && ?label != 'probe'
-                                   && ?label != 'direct'
-                                   )
-                       ?id1 obo:IAO_0000219 ?c1 .
-                       ?id2 obo:IAO_0000219 ?c2 .
-                       # exclude any links between different GGPV identifiers
-                       minus {?id1 rdf:type/rdfs:subClassOf* ccp:IAO_EXT_0000083}  # ccp:gene_or_gene_product_or_variant_identifier
-                       minus {?id2 rdf:type/rdfs:subClassOf* ccp:IAO_EXT_0000083}  # ccp:gene_or_gene_product_or_variant_identifier
-                       }"
+                  select ?id1 ?id2 {
+                  ?c1 oboInOwl:hasOBONamespace ?ns1 .
+                  ?c1 rdf:type owl:Class .
+                  ?c1 rdfs:label ?label .
+                  ?c2 rdfs:label ?label .
+                  ?c2 oboInOwl:hasOBONamespace ?ns2 .
+                  ?c2 rdf:type owl:Class .
+                  # require that c1 and c2 are different and return in a reproducible order to avoid duplicate pairings
+                  # also exclude several ontologies:
+                  #   PR: so that we don't intentionally collapse genes with proteins
+                  #   NCBITaxon: matches appear to be spurious
+                  #   UBERON: so as not to incorrectly collapse species-specific anatomy
+                  #   PO: also so as not to incorrectly collapse plant anatomy with other things
+                  FILTER (?c1 != ?c2 && STR(IRI(?c1)) < STR(IRI(?c2))
+                              && !contains(str(?c1), 'obo/PR_')
+                              && !contains(str(?c2), 'obo/PR_')
+                              && !contains(str(?c1), 'obo/UBERON_')
+                              && !contains(str(?c2), 'obo/UBERON_')
+                              && !contains(str(?c1), 'obo/NCBITaxon_')
+                              && !contains(str(?c2), 'obo/NCBITaxon_')
+                              && !contains(str(?c1), 'obo/PO_')
+                              && !contains(str(?c2), 'obo/PO_')
+                              # CHEBI:base and SO:base are not the same
+                              && ?label != 'base'
+                              && ?label != 'probe'
+                              && ?label != 'direct'
+                              )
+                  ?id1 obo:IAO_0000219 ?c1 .
+                  ?id2 obo:IAO_0000219 ?c2 .
+                  # exclude any links between different GGPV identifiers
+                  # ideally the lines below would use rdf:type/rdfs:subClassOf*, but the * appears to be quite detrimental to execution time
+                  minus {?id1 rdf:type/rdfs:subClassOf/rdfs:subClassOf ccp:IAO_EXT_0000083}  # ccp:gene_or_gene_product_or_variant_identifier
+                  minus {?id2 rdf:type/rdfs:subClassOf/rdfs:subClassOf ccp:IAO_EXT_0000083}  # ccp:gene_or_gene_product_or_variant_identifier
+                  }"
   }


Nicely format the relevant parts of exceptions

Fixes #2

--- src/radicalzephyr/boot_junit.clj
+++ src/radicalzephyr/boot_junit.clj
@@ -38,6 +38,30 @@
                     (inc i) (style (.getDisplayName ignored) :yellow))
             (println))))

+      (defn- skip-assert-traces [traces]
+        (filter #(not= (:class %) "org.junit.Assert") traces))
+
+      (defn- take-until-reflection [traces]
+        (take-while #(not (.contains (:class %) "reflect")) traces))
+
+      (defn- convert-to-message [trace]
+        (format "%s.%s  %s: %d "
+                (:class trace)
+                (:method trace)
+                (:file trace)
+                (:line trace)))
+
+      (defn- process-trace [throwable]
+        (let [ex-map (parse-exception throwable)
+              relevant-traces (->> (:trace-elems ex-map)
+                                   skip-assert-traces
+                                   take-until-reflection
+                                   (map convert-to-message))]
+          (format "%s\n       %s"
+                  (:message ex-map)
+                  (str/join "\n      " relevant-traces))))
+
+
       (defn- print-failed-tests [test-failures]
         (when (seq test-failures)
           (println "Failed:")
@@ -45,7 +69,7 @@
           (doseq [[i failure] (map-indexed vector test-failures)]
             (printf "  %d) %s\n"
                     (inc i) (.getTestHeader failure))
-            (printf "     %s\n" (style (.getTrace failure)
+            (printf "     %s\n" (style (process-trace (.getException failure))
                                        :red))
             (println))))


fixup! Add a basic build.boot

fixup! Add a basic build.boot

--- src/radicalzephyr/boot_junit.clj
+++ src/radicalzephyr/boot_junit.clj
@@ -1,6 +1,6 @@
 (ns radicalzephyr.boot-junit
   {:boot/export-tasks true}
-  (:require [boot.core :as core])
+  (:require '[[boot.core :as core]])
   (:import org.junit.runner.JUnitCore))

 (deftask junit


Make `artifacts-file` cross-OS

Make `artifacts-file` cross-OS

--- src/refactor_nrepl/artifacts.clj
+++ src/refactor_nrepl/artifacts.clj
@@ -8,8 +8,8 @@
             [version-clj.core :as versions])
   (:import java.util.zip.GZIPInputStream))

-(def artifacts-file (str (System/getProperty "java.io.tmpdir")
-                         "/refactor-nrepl-artifacts-cache"))
+(def artifacts-file (str (io/file (System/getProperty "java.io.tmpdir")
+                                  "refactor-nrepl-artifacts-cache")))

 (defn get-last-modified-from-file
   "Returns last modified time in milliseconds or nil if file does not exist."
@@ -18,11 +18,12 @@
     (if (zero? lm) nil lm)))

 ;;  structure here is {"prismatic/schem" ["0.1.1" "0.2.0" ...]}
-(defonce artifacts (atom (if (.exists (io/as-file artifacts-file))
+(defonce artifacts (atom (if (.exists (io/file artifacts-file))
                            (->> artifacts-file slurp edn/read-string (into {}))
                            {})
                          :meta {:last-modified
                                 (get-last-modified-from-file artifacts-file)}))
+
 (def millis-per-day (* 24 60 60 1000))

 (defn- get-proxy-opts


Добавил иконки в диалог выбора интервала времени

--- radiolamp-6P3S/src/r6p3s/cpt/select_datetime_interval.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/select_datetime_interval.cljs
@@ -140,7 +140,11 @@
                    (let [from-date (get-input-datetime-value @app-modal :from-date)
                          to-date   (get-input-datetime-value @app-modal :to-date)]
                      (om/build modal-yes-no/component app-modal
-                               {:opts {:label "Указать интервал времени"
+                               {:opts {:label (dom/span nil
+                                                        (glyphicon/render "chevron-left")
+                                                        (glyphicon/render "time")
+                                                        (glyphicon/render "chevron-right")
+                                                        " Указать интервал времени")

                                        :body
                                        (dom/div


Use Langohr 1.6.0-beta1

Use Langohr 1.6.0-beta1

--- clojure/project.clj
+++ clojure/project.clj
@@ -4,4 +4,4 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure     "1.5.1"]
-                 [com.novemberain/langohr "1.5.0"]])
+                 [com.novemberain/langohr "1.6.0-beta1"]])


Switched players to player-count (like it was)

--- src/wombats/sockets/messages.clj
+++ src/wombats/sockets/messages.clj
@@ -112,7 +112,7 @@
                {:game/round-start-time (get-start-time game-state)
                 :game/round-number (get-round-number game-state)
                 :game/max-players (:game/max-players game-config)
-                :game/players (:players game-state)
+                :game/player-count (count (:players game-state))
                 :game/name (:game/name game-config)
                 :game/status (:game/status game-config)
                 :game/winner (get-game-winner game-state)


Another cljs rule

Another cljs rule

--- dalap_rules.clj
+++ dalap_rules.clj
@@ -3,6 +3,7 @@
   ["src/wireframes/shape_primitives.clj" "target/generated/wireframes/shape_primitives.cljs"] []
   ["src/wireframes/shape_loader.clj" "target/generated/wireframes/shape_loader.cljs"] []
   ["src/wireframes/bezier_patch.clj" "target/generated/wireframes/bezier_patch.cljs"] []
+  ["src/wireframes/renderer.clj" "target/generated/wireframes/renderer.cljs"] []
   ["src/wireframes/renderer/vector.clj" "target/generated/wireframes/renderer/vector.cljs"] []
   ["src/wireframes/renderer/canvas.cljs" "target/generated/wireframes/renderer/canvas.cljs"] []
 }


Fix syntax error

Fix syntax error

--- src/clj/made_merits/service/github/boyscouting/scraper.clj
+++ src/clj/made_merits/service/github/boyscouting/scraper.clj
@@ -18,6 +18,5 @@
       (hash-map :project repo
                 :results (detector/detect
                            (:body
-                             (client/get
-                               (to-url repo {:oauth-token ~(get (System/getenv) "GITHUB_OAUTH_SECRET")}))))))
+                             (client/get (to-url repo) {:oauth-token ~(get (System/getenv) "GITHUB_OAUTH_SECRET")})))))
     repos))


make the measurements transfer resilient to stops

by recording the sensors that have been migrated already.

--- dev/migrate.clj
+++ dev/migrate.clj
@@ -27,14 +27,17 @@
   [{:keys [store]}]
   (log/info "Migrating reading metadata.")
   (db/with-session [session (:hecuba-session store)]
-    (let [sensors (db/execute session (hayt/select :sensors))]
+    (let [all-sensors (db/execute session (hayt/select :sensors))
+          processed-sensors (clojure.string/split-lines (slurp "/tmp/processed_sensors.txt"))
+          sensors (remove (set processed-sensors) all-sensors)]
       (doseq [s sensors]
         (let [measurements (measurements/all-measurements store s)
               measurements-with-metadata (map #(update-in % [:reading_metadata] convert-metadata %)
                                               measurements)]
           (when measurements-with-metadata
              (db/execute session
-                         (misc/prepare-batch measurements-with-metadata)))))))
+                         (misc/prepare-batch measurements-with-metadata))))
+        (spit "/tmp/processed_sensors.txt" s :append true))))
   (log/info "Finished migrating reading metadata."))

 (defn fill-sensor-bounds


Fixing test

Fixing test

--- test/celestial/test/jobs.clj
+++ test/celestial/test/jobs.clj
@@ -22,7 +22,7 @@
    (job-exec identity {:message {:identity "red1" :args {:machine {:hostname "red1"}}} :attempt 1}) => {:status :success}
    (provided
      (server-conn) => {}
-     (acquire-lock {} "red1" 300000 1800000) => nil :times 1))
+     (acquire-lock {} "red1" 1800000 300000) => nil :times 1))

 (fact "enqueue to workless queue should fail"


fix test

fix test

--- test/chat/test/server/db.clj
+++ test/chat/test/server/db.clj
@@ -409,7 +409,6 @@
           (db/user-set-preference! u1 :favourite-color "blue")
           (db/user-set-preference! u2 :email-frequency :weekly)
           (db/user-set-preference! u2 :favourite-color "blue")
-          (is (= [u2 (u :id)] (db/user-search-preferences :email-frequency :weekly)))
+          (is (= #{u2 (u :id)} (set (db/user-search-preferences :email-frequency :weekly))))
           (is (= [u1] (db/user-search-preferences :email-frequency :daily)))
-          (is (= [u1 u2] (db/user-search-preferences :favourite-color "blue")))
-          )))))
+          (is (= #{u1 u2} (set (db/user-search-preferences :favourite-color "blue")))))))))


Floating point numbers parsing: multiple zero values

--- test/clouseau/test_utils.clj
+++ test/clouseau/test_utils.clj
@@ -444,4 +444,14 @@
         (parse-int "xyzzy")))
        ; (parse-int "+1"))) ; removed, not compatible with all supported JDKs

-
+(deftest test-parse-float-zero
+    "Check the behaviour of function emender-jenkins.config/parse-float."
+    (are [x y] (== x y)
+        0.0 (parse-float "0")
+        0.0 (parse-float "00")
+        0.0 (parse-float "000")
+        0.0 (parse-float "-0")
+        0.0 (parse-float "-00")
+        0.0 (parse-float "-000")))
+
+


Adding tests for routes part 1

Adding tests for routes part 1

--- test/ts_layout/core_test.clj
+++ test/ts_layout/core_test.clj
@@ -2,4 +2,10 @@
   (:require [clojure.test :refer :all]
             [ts-layout.core :refer :all]))

+(defn request [resource web-app & params]
+   (web-app {:request-method :get :uri resource :params (first params)}))

+(deftest root
+  (let [response (request "/" app)]
+    (is (= 302 (:status response)))
+    (is (= {"Location" "/boxes"} (:headers response)))))


CMR-1582: Added handling of empty results to expectecd_conversion.clj

--- umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
+++ umm-spec-lib/src/cmr/umm_spec/test/expected_conversion.clj
@@ -127,9 +127,9 @@
                             {:Type nil
                              :Description nil
                              :EntryId "AssocEntryId3"
-                             :Version nil}]
-                            ; {:Type "INPUT"
-                            ;  :EntryId "AssocEntryId4"}]
+                             :Version nil}
+                            {:Type "INPUT"
+                             :EntryId "AssocEntryId4"}]
      :AdditionalAttributes [{:Group "Accuracy"
                              :Name "PercentGroundHit"
                              :DataType "FLOAT"
@@ -505,7 +505,7 @@
 (defn- group-metadata-assocations
   [mas]
   (let [{input-types true other-types false} (group-by (fn [ma] (= "INPUT" (:Type ma))) mas)]
-    (concat other-types input-types)))
+    (seq (concat other-types input-types))))

 (defmethod convert-internal :iso19115
   [umm-coll _]


CMR-1852: Missed an uncomitted change.

CMR-1852: Missed an uncomitted change.

--- umm-spec-lib/test/cmr/umm_spec/test/generate_and_parse.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/generate_and_parse.clj
@@ -81,7 +81,7 @@
   (def sample-record user/failing-value)

   ;; generated xml
-  (core/generate-metadata :collection metadata-format sample-record)
+  (println (core/generate-metadata :collection metadata-format sample-record))

   ;; round-trip
   (xml-round-trip sample-record metadata-format)


correct typo

correct typo

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -87,7 +87,7 @@
           [:p
            "Avoid queues by "
            [:a {:href "/"} "adding containers"]
-           ", skipping redundant builds (though "
+           ", skipping redundant builds (through "
            [:a {:href "/"} "project settings"]
            " or "
            [:a {:href "/"} "configuring your yml"]


core: update

core: update

--- core/data/core.clj
+++ core/data/core.clj
@@ -2680,12 +2680,6 @@
              coll (range (count coll)))
     (map #(if-let [e (find smap %)] (val e) %) coll)))

-(defn empty?
-  "Returns true if coll has no items - same as (not (seq coll)).
-  Please use the idiom (seq x) rather than (not (empty? x))"
-  {:added "1.0"}
-  [coll] (not (seq coll)))
-
 (defn get-in
   "Returns the value in a nested associative structure,
   where ks is a sequence of keys. Returns nil if the key
@@ -2726,6 +2720,29 @@
      (assoc m k (apply update-in (get m k) ks f args))
      (assoc m k (apply f (get m k) args)))))

+(defn update
+  "'Updates' a value in an associative structure, where k is a
+  key and f is a function that will take the old value
+  and any supplied args and return the new value, and returns a new
+  structure.  If the key does not exist, nil is passed as the old value."
+  {:added "1.0"}
+  ([m k f]
+   (assoc m k (f (get m k))))
+  ([m k f x]
+   (assoc m k (f (get m k) x)))
+  ([m k f x y]
+   (assoc m k (f (get m k) x y)))
+  ([m k f x y z]
+   (assoc m k (f (get m k) x y z)))
+  ([m k f x y z & more]
+   (assoc m k (apply f (get m k) x y z more))))
+
+(defn empty?
+  "Returns true if coll has no items - same as (not (seq coll)).
+  Please use the idiom (seq x) rather than (not (empty? x))"
+  {:added "1.0"}
+  [coll] (not (seq coll)))
+
 (defmacro cond->
   "Takes an expression and a set of test/form pairs. Threads expr (via ->)
   through each form for which the corresponding test


CMR-3693: Addressed more PR comments.

CMR-3693: Addressed more PR comments.

--- transmit-lib/src/cmr/transmit/kms.clj
+++ transmit-lib/src/cmr/transmit/kms.clj
@@ -135,10 +135,10 @@
    <conceptBrief id=\"296143\" uuid=\"03d77986-98aa-4ad4-9070-2b7a41eadb31\" prefLabel=\"SLOAN\" conceptSchemeId=\"599\" conceptScheme=\"idnnode\" isLeaf=\"true\" status=\"\"/>
    Returns a sequence of full hierarchy maps."
   [keyword-scheme xml-content]
-  (let [parsed-xml (xml/parse (java.io.StringReader. xml-content))
+  (let [parsed-xml (xml/parse-str xml-content)
         concept-brief-tags (select parsed-xml "conceptBrief")
         idnnode-attrs (filter (fn [x] (= "idnnode" (:conceptScheme x))) (map :attrs concept-brief-tags))
-        short-names (map vals (map #(select-keys % [:prefLabel]) idnnode-attrs))
+        short-names (map #(vector (:prefLabel %)) idnnode-attrs)
         keyword-entries (->> short-names
                              ;; Create a map for each short-name value using the subfield-names as keys
                              (map #(zipmap (keyword-scheme keyword-scheme->field-names) %))


[#2491] Fix lint problem

[#2491] Fix lint problem

--- backend/test/akvo/lumen/fixtures.clj
+++ backend/test/akvo/lumen/fixtures.clj
@@ -67,7 +67,7 @@
 (defn error-tracker-fixture
   "Returns a fixture that binds a local error tracker to *error-tracker*"
   [f]
-  (binding [*error-tracker* (local-error-tracker {})]
+  (binding [*error-tracker* (local-error-tracker)]
     (f)))

 (def ^:dynamic *caddisfly*)


removing policies from the default file

removing policies from the default file

--- shared/default.clj
+++ shared/default.clj
@@ -38,9 +38,6 @@
                 :HealthCheck elb-healthcheck-ping}
 ;IAM role doc http://docs.aws.amazon.com/IAM/latest/APIReference/Welcome.html
  :Role {:RoleName $app-name
-        :Policies  [{:PolicyName "ec2-describe"
-                     :PolicyDocument [{:Effect "Allow"
-                                       :Action "EC2:Describe*"
-                                       :Resource "*"}]
-; This tool http://awspolicygen.s3.amazonaws.com/policygen.html helps to create policy documents
-                     }]}
+        ; This tool http://awspolicygen.s3.amazonaws.com/policygen.html helps to create policy documents
+        }
+ }


Forward declarations of mockup-ed relations (to avoid errors when the file is loaded).

--- EkekoAspectJ/src/damp/ekeko/aspectj/assumptions.clj
+++ EkekoAspectJ/src/damp/ekeko/aspectj/assumptions.clj
@@ -86,6 +86,11 @@
     (pointcut-concretizedby ?abpointcut ?concpointcut1)
     (pointcut-concretizedby ?concpointcut1 ?concpointcut2)))

+
+(clojure.core/declare advice-writesto)
+(clojure.core/declare advice-readsfrom)
+(clojure.core/declare percflowaspect)
+(clojure.core/declare consecutiveexec-aspect-advice1-advice2)

 ;;Assumption this aspect implements a wormhole
 ;; -- the naive version
@@ -93,7 +98,7 @@
 (defn
   naivewormhole-aspect-entry-exit
   [?aspect ?entryadvice ?exitadvice]
-  (all
+  (fresh [?instvar]
     (aspect-advice ?aspect ?entryadvice)
     (aspect-field ?aspect ?instvar)
     (advice-writesto ?entryadvice ?instvar) ;NOT IMPLEMENTED YET


first testing commit - note this is not ready to tryout

--- clj-tcp/src/clj_tcp/client.clj
+++ clj-tcp/src/clj_tcp/client.clj
@@ -16,7 +16,10 @@
 (defrecord Client [group channel-f write-ch read-ch error-ch])

 (defn close-client [{:keys [group channel-f]}]
-  (-> channel-f .channel .closeFuture .sync)
+  (-> channel-f .channel .closeFuture .sync))
+
+(defn close-all [{:keys [group] :as conf}]
+  (close-client conf)
   (-> group .shutdownGracefully .sync))


add pro

add pro

--- spinning/build.boot
+++ spinning/build.boot
@@ -34,3 +34,10 @@
     cljs {:optimizations :none
           :source-map true})
   (comp (serve) (watch) (speak) (reload) (cljs-repl) (cljs)))
+
+(deftask pro []
+  (set-env! :source-paths #{"src"})
+  (task-options!
+    cljs {:optimizations :advanced
+          :source-map true})
+  (comp (speak) (cljs)))


Move computing build propertires to a function

--- src-cljs/frontend/analytics.cljs
+++ src-cljs/frontend/analytics.cljs
@@ -34,16 +34,19 @@
 (deftrack track-org-settings [org-name]
   (mixpanel/track "View Org" {:username org-name}))

+(defn build-properties [build]
+  (merge {:running (build-model/running? build)
+          :build-num (:build_num build)
+          :vcs-url (vcs-url/project-name (:vcs_url build))
+          :oss (boolean (:oss build))
+          :outcome (:outcome build)}
+         (when (:stop_time build)
+           {:elapsed_hours (/ (- (.getTime (js/Date.))
+                                 (.getTime (js/Date. (:stop_time build))))
+                              1000 60 60)})))
+
 (deftrack track-build [user build]
-  (mixpanel/track "View Build" (merge {:running (build-model/running? build)
-                                       :build-num (:build_num build)
-                                       :vcs-url (vcs-url/project-name (:vcs_url build))
-                                       :oss (boolean (:oss build))
-                                       :outcome (:outcome build)}
-                                      (when (:stop_time build)
-                                        {:elapsed_hours (/ (- (.getTime (js/Date.))
-                                                              (.getTime (js/Date. (:stop_time build))))
-                                                           1000 60 60)})))
+  (mixpanel/track "View Build" (build-properties build))
   (when (and (:oss build) (build-model/owner? build user))
     (intercom/track :viewed-self-triggered-oss-build
                     {:vcs-url (vcs-url/project-name (:vcs_url build))


Comment stuff

Comment stuff

--- src/atom_finder/questions/comment_counts.clj
+++ src/atom_finder/questions/comment_counts.clj
@@ -57,13 +57,13 @@
   "find all AST nodes near comments and
    categorize them by whether their in a function"
   [root]
-  (let [comment-proximity-lines 3 ; how far away from a comment is still "commented"
+  (let [comment-proximity-lines 1 ; how far away from a comment is still "commented"
         comments (all-comments root)
         function-offset-set (function-offset-range-set root)
         in-function-offset? #(and (not (function-node? %1))
                                   (offset %1)
                                   (function-offset-set (offset %1)))
-        all-nodes  (flatten-tree root)
+        all-nodes  (potential-atom-nodes root)
         all-node-lines (set (mapcat (juxt start-line end-line) all-nodes))
         inline-comment? #(all-node-lines (start-line %)) ; does a comment appear on the same line as an AST node
         [fn-comments global-comments] (separate in-function-offset? comments)
@@ -91,38 +91,64 @@
   "Classify every node by whether its an atom,
    inside a function, and described by a comment"
   [root]
-  (let [fn-cmnts (nodes-near-comments-by-function root)
+  (let [file (filename root)
+        fn-cmnts (nodes-near-comments-by-function root)
         all-atoms (->> root find-all-atoms (mapcat (fn [[atm nodes]] (map #(vector atm %) nodes))))
-        atom-cmnts     (map (fn [[atom-name node]] (merge {:node node :atom atom-name} (fn-cmnts node))) all-atoms)
-        non-atom-cmnts (map (fn [[node   fn-cmnt]] (merge {:node node :atom nil} fn-cmnt)) (apply dissoc fn-cmnts (map second all-atoms)))
+        atom-cmnts     (map (fn [[atom-name node]] (merge {:file file :node node :atom atom-name} (fn-cmnts node))) all-atoms)
+        non-atom-cmnts (map (fn [[node   fn-cmnt]] (merge {:file file :node node :atom nil} fn-cmnt)) (apply dissoc fn-cmnts (map second all-atoms)))
         ]

     (concat atom-cmnts non-atom-cmnts)
     ))

-;; 18 hours
+;; 33 hours
 '((->> "~/opt/src/atom-finder"
        expand-home
        list-dirs
        (map str)
        (mapcat (fn [dir]
-                 (let [proj (str/replace dir #".*\/" "")]
-                   (->> dir
+                 (->> dir
                     (pmap-dir-trees atoms-by-comments&function)
-                    flatten
-                    (map #(assoc % :proj proj))))))
-       (map (juxt :proj :in-function? :comment :atom))
-       frequencies
+                    (mapcat (fn [file-nodes]
+                           (->> file-nodes
+                                (map #(assoc %
+                                             ;:atom (or (:atom %) (->> % :node typename))
+                                             ;:proj (str/replace dir #".*\/" "")
+                                             :file (->> % :file atom-finder.questions.all-nodes/atom-finder-relative-path)
+                                             ;:line (->> % :node start-line)
+                                             ))
+                                     (map (partial-right dissoc :node))
+                                     frequencies
+                                     )))
+                    )))
+       ;(take 2)
+       ;frequencies
        (map prn)
        dorun
-       (log-to "tmp/comment-counts_2018-01-08_01_in-function.edn")
+       (log-to "tmp/comment-counts_2018-01-30_01_potential-atom-nodes_memory.edn")
        time-mins
    ))

-((->> "tmp/comment-counts_2018-01-08_01_in-function.edn"
+'((->> "tmp/comment-counts_2018-01-27_01_proximity-1-line.edn"
       read-lines
       (map (fn [[[proj in-function comment atom] count]]
              {:proj proj :in-function (boolean in-function)
               :comment (boolean comment) :atom (some-> atom name) :count count}))
-      (maps-to-csv "comment-counts_2018-01-08_01_in-function.csv")
+      (maps-to-csv "tmp/comment-counts_2018-01-27_01_proximity-1-line.csv")
  ))
+
+;; Find only literal-encoding in mongo
+'((->>"~/opt/src/atom-finder/"
+       expand-home
+       (pmap-dir-trees atoms-by-comments&function)
+       flatten
+       (filter #(and (:atom %) (true? (:comment %))))
+       (map (fn [h]
+              (let [[no-node {node :node}] (split-map-by-keys h [:node])]
+                (merge no-node {:line (start-line node) :file (filename node) :node (write-tree node)}))))
+       (map prn)
+       ;(take 20)
+       dorun
+       (log-to "tmp/comment-counts_2018-01-26_01_proximity-1-line.edn")
+       time-mins
+   ))


Only call rvm if we have ruby files.

Only call rvm if we have ruby files.

--- src/circle/backend/build/inference/rails.clj
+++ src/circle/backend/build/inference/rails.clj
@@ -202,9 +202,10 @@
         has-db-yml? (or (database-yml? repo) (find-database-yml repo))]
     (binding [use-bundler? (bundler? repo)]
       (->>
-       [(if (rvm? repo)
-          (rvm rvmrc trust ~repo)
-          (rvm use "1.9.2" --default))
+       [(when (dir-contains-ruby-files? repo)
+          (if (rvm? repo)
+            (rvm rvmrc trust ~repo)
+            (rvm use "1.9.2" --default)))
         (when use-bundler?
           (blacklist))
         (when use-bundler?


CMR-8316: Fixed Snyk vulnerability: Denial of Service (DoS): org.apache.commons:commons-compress 1.20.

--- elastic-utils-lib/project.clj
+++ elastic-utils-lib/project.clj
@@ -21,7 +21,7 @@
                  [org.apache.logging.log4j/log4j-api "2.15.0"]
                  [org.clojure/clojure "1.10.0"]
                  [org.elasticsearch/elasticsearch ~elastic-version]
-                 [org.testcontainers/testcontainers "1.15.2"]
+                 [org.testcontainers/testcontainers "1.17.2"]
                  [potemkin "0.4.5"]]
   :plugins [[lein-shell "0.5.0"]
             [test2junit "1.3.3"]]


get the correct set of path (one-direction)

--- src/adventofcode1/twentyfour.clj
+++ src/adventofcode1/twentyfour.clj
@@ -73,6 +73,13 @@
   #0.1.....2#
   #.#######.#
   #4.......3#
+  ###########")
+
+(def sample2
+  "###########
+  #0.1.....2#
+  #.###.###.#
+  #4....6..3#
   ###########")

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -260,8 +267,8 @@
         (map
          #(list (+
                  ;; break if many neighbors or if this cell contain a number
-                 (if (is-numbered-cell? board (second (:from path)) %) 99 0)
-                 (count-neighbors board (second (:from path)) %))
+                 (if (is-numbered-cell? board % (second (:from path))) 99 0)
+                 (count-neighbors board % (second (:from path))))
                 %
                 (second (:from path)))
          (range (first (:from path))(inc (first (:to path)))))))
@@ -335,13 +342,36 @@
        (recur acc2 new-path (rest split-ats))))))

-
+(defn assoc-duplicates
+  "The map `m` contains `k` to several `v`.
+   Add the new value `v` to `m`."
+  [m [k v]]
+  (assoc m k (conj (or (get m k) []) [v])))
+
+(defn into-assoc-duplicates
+  "The map `m` contains `k` to several `v`.
+   Add all value [k v] in `kvs` to `m`."
+  [m kvs]
+  (reduce assoc-duplicates m kvs))

 (defn horizontal-splitted-paths
-  [board]
-  nil)
-
+  [all board]
+  (let [paths (horizontal-paths board)
+        splitted-paths-one-direction
+        (mapcat #(split-horizontal-path % (split-horizontal-path-at board %)) paths)
+        kvs (map #(vec (list (:from %) %)) splitted-paths-one-direction)
+        all2 (into-assoc-duplicates all kvs)]
+    all2))
+
+(defn vertical-splitted-paths
+  [all board]
+  (let [paths (vertical-paths board)
+        splitted-paths-one-direction
+        (mapcat #(split-vertical-path % (split-vertical-path-at board %)) paths)
+        kvs (map #(vec (list (:from %) %)) splitted-paths-one-direction)
+        all2 (into-assoc-duplicates all kvs)]
+    all2))

 ;; Not checking :ret, why?
 ;;


Typos and check that the inputs are 1-dimensional vectors

--- src/clj/clojurewerkz/statistiker/metrics.clj
+++ src/clj/clojurewerkz/statistiker/metrics.clj
@@ -19,15 +19,17 @@

    This metric is independent of the absolute values of the labels: a permutation of the
    class or cluster label values won’t change the score value in any way."
-  [labels-u labels-v]
-  {:pre [(= (count labels-u) (count labels-v))
-         (not (empty? labels-u))
-         (not (empty? labels-v))]}
-  (let [freq-u        (frequencies labels-u)
-        freq-v        (frequencies labels-v)
-        freq-combined (->> (map vector labels-u labels-v)
+  [U V]
+  {:pre [(= (count U) (count V))
+         (not (empty? U))
+         (not (empty? V))
+         (not-any? coll? U)
+         (not-any? coll? V)]}
+  (let [freq-u        (frequencies U)
+        freq-v        (frequencies V)
+        freq-combined (->> (map vector U V)
                            frequencies)
-        labels-count  (count labels-u)
+        labels-count  (count U)
         norm-n        (zipmap (keys freq-combined)
                               (map #(/ % labels-count) (vals freq-combined)))]
     (->> norm-n
@@ -88,6 +90,8 @@
   [U V]
   {:pre [(= (count U) (count V))
          (not-any? coll? U)
+         (not-any? coll? V)
+         (not-any? coll? U)
          (not-any? coll? V)]}
   (if (or (empty? U)
           (= 1 (count (distinct U)) (count (distinct V)))          ;only one cluster


workarround for to fast selection in vis graph library

--- src/cljs/flow_editor/views/graph_viewer.cljs
+++ src/cljs/flow_editor/views/graph_viewer.cljs
@@ -200,6 +200,16 @@
                            :on-click (fn [] (dispatch [:graph-ui/close-context-menu])
                                             (dispatch [:ui/open-modal :modals/add-process]))]]]]])

+(defn set-active-node-selection
+  [node net]
+  (when net
+    (if-let [node @node]
+      (try
+        (.selectNodes net #js[(node-id node)])
+        (catch :default e
+          (.log js/console "vis selection too fast" e)))
+      (.unselectAll net))))
+

 (defn graph-inner []
   (let [network (atom nil)
@@ -212,9 +222,8 @@
                        vis-data (get-vis-graph graph @types)]
                    (.setSize net (aget dom-rect "width") (aget dom-rect "height"))
                    (.setData net (clj->js vis-data))
-                   (if-let [node @(:node (r/props comp))]
-                     (.selectNodes net #js[(node-id node)])
-                     (.unselectAll net))))]
+                   (when-let [node (:node (r/props comp))]
+                     (set-active-node-selection node net))))]

     (r/create-class
       {:reagent-render (fn []
@@ -232,11 +241,7 @@
                                 (render comp new-network)
                                 (.fit new-network)
                                 (reset! active-node-reaction
-                                        (run!
-                                         (let [node @active-node]
-                                           (if node
-                                             (.selectNodes new-network #js[(node-id node)])
-                                             (.unselectAll new-network)))))))
+                                        (run! (set-active-node-selection active-node new-network)))))

        :component-did-update (fn [comp]
                                (let [props (r/props comp)


Strip tasks and peers if no deployment pulse

is found. Information is probably misleading otherwise.

--- src/cljs/onyx_dashboard/components/main.cljs
+++ src/cljs/onyx_dashboard/components/main.cljs
@@ -66,7 +66,10 @@
                                  (g/col {:xs 12 :md 8}
                                         (dom/div
                                           (if job
-                                            (om/build job-info job {:react-key (str "job-info-" (:id job))}))
+                                            (om/build job-info
+                                                      (if (:up? deployment) job (dissoc job :tasks :peers))
+                                                      {:react-key (str "job-info-" (:id job))}))
+
                                           (om/build log-entries-pager
                                                     {:entries (:entries deployment)
                                                      :job-filter (:id job)}


Move header row into grid

Move header row into grid

--- src/cljs/onyx_dashboard/components/main.cljs
+++ src/cljs/onyx_dashboard/components/main.cljs
@@ -23,51 +23,51 @@
   (render-state [_ {:keys [api-chan]}]
                 (let [{:keys [selected-job jobs]} deployment
                       job (and selected-job jobs (jobs selected-job))]
-                  (dom/div
-                   (g/row {}
-                          (r/page-header {:class "page-header, main-header"}
-                                         (g/grid {}
-                                                 (g/col {:xs 4 :md 2}
-                                                        (dom/a {:href "https://github.com/MichaelDrogalis/onyx"}
-                                                               (dom/img {:class "logo"
-                                                                         :src "/img/high-res.png"
-                                                                         :height "50%"
-                                                                         :width "50%"})))
-                                                 (g/col {:xs 12 :md 8}
-                                                        (dom/div {:style {:font-size "50px" :margin-top "25px"
-                                                                          :margin-left "150px"}}
-                                                                 "Onyx Dashboard")))))
-                    (g/grid {}
-                            (g/row {}
-                                   (g/col {:xs 6 :md 4}
-                                          (dom/div {:class "left-nav-deployment"}
-                                                   (om/build select-deployment app {}))
+                  (g/grid {}
+                          (g/row {}
+                                 (r/page-header {:class "page-header, main-header"}
+                                                (g/grid {}
+                                                        (g/col {:xs 4 :md 2}
+                                                               (dom/a {:href "https://github.com/MichaelDrogalis/onyx"}
+                                                                      (dom/img {:class "logo"
+                                                                                :src "/img/high-res.png"
+                                                                                :height "50%"
+                                                                                :width "50%"})))
+                                                        (g/col {:xs 12 :md 8}
+                                                               (dom/div {:style {:font-size "50px"
+                                                                                :margin-top "25px"
+                                                                                :margin-left "150px"}}
+                                                                        "Onyx Dashboard")))))
+                          (g/row {}
+                                 (g/col {:xs 6 :md 4}
+                                        (dom/div {:class "left-nav-deployment"}
+                                                 (om/build select-deployment app {}))

-                                          (if (:id deployment)
-                                            (dom/div {}
-                                                     (om/build deployment-indicator
-                                                               {:deployment deployment
-                                                                :last-entry ((:entries deployment) (:message-id-max deployment))}
-                                                               {})))
+                                        (if (:id deployment)
+                                          (dom/div {}
+                                                   (om/build deployment-indicator
+                                                             {:deployment deployment
+                                                              :last-entry ((:entries deployment) (:message-id-max deployment))}
+                                                             {})))

-                                          (if (:id deployment)
-                                            (dom/div {}
-                                                     (om/build job-selector deployment {})))
-
-                                          (if (:id deployment)
-                                            (dom/div {}
-                                                     (om/build deployment-peers deployment {})))
+                                        (if (:id deployment)
+                                          (dom/div {}
+                                                   (om/build job-selector deployment {})))

-                                          (dom/div {}
-                                                   (if job
-                                                     (om/build job-management
-                                                               job
-                                                               {:react-key (str "management-" (:id job))}))))
-                                   (g/col {:xs 12 :md 8}
-                                          (dom/div
-                                            (if job
-                                              (om/build job-info job {:react-key (str "job-info-" (:id job))}))
-                                            (om/build log-entries-pager
-                                                      {:entries (:entries deployment)
-                                                       :job-filter (:id job)}
-                                                      {:react-key (str "log-" (:id deployment) "-filter-" (:id job))})))))))))
+                                        (if (:id deployment)
+                                          (dom/div {}
+                                                   (om/build deployment-peers deployment {})))
+
+                                        (dom/div {}
+                                                 (if job
+                                                   (om/build job-management
+                                                             job
+                                                             {:react-key (str "management-" (:id job))}))))
+                                 (g/col {:xs 12 :md 8}
+                                        (dom/div
+                                          (if job
+                                            (om/build job-info job {:react-key (str "job-info-" (:id job))}))
+                                          (om/build log-entries-pager
+                                                    {:entries (:entries deployment)
+                                                     :job-filter (:id job)}
+                                                    {:react-key (str "log-" (:id deployment) "-filter-" (:id job))}))))))))