Partially revert r14500 "acqEngine: Remove rogue references to the gui's position list"

It turns out that removed functions were called from SlideExplorer2.
This kind of surprising interdependence should be eliminated, but
reverting for now.

After this commit, the acquisition engine itself continues to _not_ get
the gui's position list when passed an explicit null poistion list to
run(). Only reverting the functions that are not used within the
acquisition engine.

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

--- acqEngine/src/org/micromanager/mm.clj
+++ acqEngine/src/org/micromanager/mm.clj
@@ -259,6 +259,13 @@
   [dev prop]
   [[dev prop] (get-property-value dev prop)])

+(defn get-positions
+  "Get the position list as a vector of MultiStagePositions."
+  ([position-list]
+    (vec (.getPositions (or position-list (.getPositionList gui)))))
+  ([]
+    (get-positions nil)))
+
 (defn get-allowed-property-values
   "Returns a sequence of the allowed property values
    for a give device and property."
@@ -376,6 +383,25 @@
   ([idx]
     (get-msp nil idx)))

+
+(defn add-msp
+  "Add a MultiStagePosition object to the position list."
+  ([position-list label x y z]
+    (.addPosition position-list
+                  (doto
+                    (MultiStagePosition.
+                      (core getXYStageDevice) x y
+                      (core getFocusDevice) z)
+                    (.setLabel label))))
+  ([label x y z]
+    (add-msp (.getPositionList gui) label x y z)))
+
+(defn remove-msp
+  ([position-list idx]
+    (.removePosition position-list idx))
+  ([idx]
+    (remove-msp (.getPositionList gui) idx)))
+
 (defn get-msp-z-position
   "Get the z position for a given z-stage from the MultiStagePosition
    with the given index in the Position List."
@@ -396,6 +422,12 @@
   ([idx z-stage z]
     (set-msp-z-position nil idx z-stage z)))

+(defn positions-map [position-list]
+  (let [position (map MultiStagePosition-to-map (get-positions))]
+    (zipmap
+      (map :label position)
+      (map :axes position))))
+
 (defn swig-vector-contents
   "Returns a string containing all values in a swig vector
    with spaces in between."


bad throw

bad throw

--- src/bardo/interpolate.cljc
+++ src/bardo/interpolate.cljc
@@ -205,8 +205,8 @@
         (do
           (throw
             (#?(:cljs js/Error
-                 :clj  Exception.))
-            (str "Cannot interpolate between " start " and " end)))))))
+                :clj  Exception.)
+              (str "Cannot interpolate between " start " and " end))))))))

 (defn into-lazy-seq [intrpl vals]
   (if (seq (rest vals))


Korjailtu sisennyksiä

Korjailtu sisennyksiä

--- mtg-pairings-wer/src/mtg_pairings/db_reader.clj
+++ mtg-pairings-wer/src/mtg_pairings/db_reader.clj
@@ -42,24 +42,24 @@
       [pair (reverse pair)])
     [[(all-teams (first team-ids)) bye]]))

-
 (defn results-for-round
   [db round-id all-teams]
   (let [match-table (db/table db "Match")
         result-table (db/table db "TeamMatchResult")
         matches (db/rows match-table {:RoundId round-id})]
    (for [match matches
-     :let [[first-row second-row] (db/rows result-table {:MatchId (:MatchId match)})]]
-        (if (>= (:GameWins first-row) (:GameWins second-row))
-
-        {:GameWins (:GameWins first-row), :GameLosses (:GameLosses first-row),
-         :GameDraws (:GameDraws first-row), :WinnerTeamId (:TeamId first-row),
-         :LoserTeamId (:TeamId second-row)}
-
-        {:GameWins (:GameWins second-row), :GameLosses (:GameLosses second-row),
-          :GameDraws (:GameDraws second-row), :WinnerTeamId (:TeamId second-row),
-          :LoserTeamId (:TeamId first-row)}))))
-
+         :let [[first-row second-row] (db/rows result-table {:MatchId (:MatchId match)})]]
+     (if (>= (:GameWins first-row) (:GameWins second-row))
+       {:GameWins (:GameWins first-row)
+        :GameLosses (:GameLosses first-row)
+        :GameDraws (:GameDraws first-row)
+        :WinnerTeamId (:TeamId first-row)
+        :LoserTeamId (:TeamId second-row)}
+       {:GameWins (:GameWins second-row)
+        :GameLosses (:GameLosses second-row)
+        :GameDraws (:GameDraws second-row)
+        :WinnerTeamId (:TeamId second-row)
+        :LoserTeamId (:TeamId first-row)}))))

 (defn pairings-for-round
   [db round-id all-teams]
@@ -80,5 +80,4 @@

 (defn print-pairings [pairings]
   (doseq [pairing pairings]
-    (println (:name (first pairing)) "-" (:name (second pairing)))))
-  +    (println (:name (first pairing)) "-" (:name (second pairing)))))


avoid re-creating parser

avoid re-creating parser

--- synapse-core/src/synapse/parser.cljc
+++ synapse-core/src/synapse/parser.cljc
@@ -36,8 +36,8 @@

 ")

-(defn parser []
-  (insta/parser grammar))
+
+(defonce parser (insta/parser grammar))

 (def tree-walk-transform
@@ -91,22 +91,7 @@

 (defn parse [spec]
-  (let [result ((parser) spec)]
+  (let [result (parser spec)]
     (if (insta/failure? result)
       {:resolver :error :error :parsing :reason (insta/get-failure result)}
       (tree-walk-transform result))))
-
-
-(comment
-
-  (parse "%%>>zookeeper.*:2181%%")
-  (-> ((parser) "%%R23%%"))
-  (-> ((parser) "%%R23||/opt%%"))
-  (-> (parse "%%R23||/opt%%"))
-  (-> ((parser) "%%>>zookeeper.*:2181%%"))
-  (-> ((parser) "%%[addr,port]>>zookeeper.*:2181||some default value%%"))
-  (-> (parse "%%[addr,port,sep=;]>>zookeeper.*:2181||some default%%"))
-  (parse "%%env>>R23.*%%")
-
-  (parse ">>>somethsoidhfa>>>asodifaoiwher")
-  )


identify_nets.clj: used doseq at two places.

--- clojure/org/gavrog/clojure/identify_nets.clj
+++ clojure/org/gavrog/clojure/identify_nets.clj
@@ -10,7 +10,7 @@

 (defn make-archive [version & paths]
   (let [archive (new Archive version)]
-    (doall (map add-to-archive (repeat archive) paths))
+    (doseq [p paths] (add-to-archive archive p))
     archive))

 (defn find-net [archive net]
@@ -34,4 +34,4 @@
   (let [archive (make-archive "1.0"
                               "org/gavrog/apps/systre/rcsr.arc"
                               "org/gavrog/apps/systre/zeolites.arc")]
-    (println (identify-all-from-file archive path))))
+    (doseq [s (identify-all-from-file archive path)] (println s))))


Make it easier to change the ip the service is working on.

--- src/oc/storage/config.clj
+++ src/oc/storage/config.clj
@@ -43,13 +43,15 @@

 ;; ----- URLs -----

-(defonce auth-server-url (or (env :auth-server-url) "http://localhost:3003"))
-(defonce interaction-server-url (or (env :interaction-server-url) "http://localhost:3002"))
-(defonce interaction-server-ws-url (or (env :interaction-server-ws-url) "ws://localhost:3002"))
-(defonce change-server-url (or (env :change-server-url) "http://localhost:3006"))
-(defonce change-server-ws-url (or (env :change-server-ws-url) "ws://localhost:3006"))
-(defonce notify-server-ws-url (or (env :notify-server-ws-url) "ws://localhost:3010"))
-(defonce reminder-server-url (or (env :reminder-server-url) "http://localhost:3011"))
+(defonce ip-address "localhost")
+
+(defonce auth-server-url (or (env :auth-server-url) (str "http://" ip-address ":3003")))
+(defonce interaction-server-url (or (env :interaction-server-url) (str "http://" ip-address ":3002")))
+(defonce interaction-server-ws-url (or (env :interaction-server-ws-url) (str "ws://" ip-address ":3002")))
+(defonce change-server-url (or (env :change-server-url) (str "http://" ip-address ":3006")))
+(defonce change-server-ws-url (or (env :change-server-ws-url) (str "ws://" ip-address ":3006")))
+(defonce notify-server-ws-url (or (env :notify-server-ws-url) (str "ws://" ip-address ":3010")))
+(defonce reminder-server-url (or (env :reminder-server-url) (str "http://" ip-address ":3011")))

 ;; ----- Liberator -----


Respect new poll timeout.

Respect new poll timeout.

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -182,7 +182,7 @@
     drained)

   p/Input
-  (poll! [this _ _]
+  (poll! [this _ remaining-ms]
     (if (and iter (.hasNext ^java.util.Iterator iter))
       (let [rec ^ConsumerRecord (.next ^java.util.Iterator iter)
             deserialized (some-> rec segment-fn)]
@@ -198,7 +198,7 @@
       (do (set! iter
                 (.iterator ^ConsumerRecords
                            (.poll ^Consumer (.consumer ^FranzConsumer consumer)
-                                  batch-timeout)))
+                                  remaining-ms)))
           nil))))

 (defn read-messages [{:keys [onyx.core/task-map onyx.core/log-prefix onyx.core/monitoring] :as event}]


remove renew icon on header column (for now)

--- src/whatsoup/handler.clj
+++ src/whatsoup/handler.clj
@@ -73,7 +73,7 @@
    [:tr
     [:th ""]
     [:th "Zutaten"]
-    [:th [:a {:href "/"} [:i.fa.fa-refresh]]]]
+    [:th #_[:a {:href "/"} [:i.fa.fa-refresh]]]]
    (for [{:keys [role selected-foods] :as ingredient} ingredients]
      [:tr
       [:td role]


removing commas

removing commas

--- src/celestial/provider.clj
+++ src/celestial/provider.clj
@@ -26,7 +26,7 @@
   (if (set? k) (interleave k (repeat (count k) v)) [k v]))

 (defn mappings
-  {:test #(assert (= {:template :ubuntu, :flavor :ubuntu, :search "local"}
+  {:test #(assert (= {:template :ubuntu :flavor :ubuntu :search "local"}
                      (mappings {:os :ubuntu :domain "local"} {:os #{:template :flavor} :domain :search})))
    :doc "Maps raw model keys to specific model keys, single key can fan out to multiple keys using a set"}
   [res ms]


continued to work on whoopbang and seasonal dummy matrix

--- src/clj/forma/bangfunc.clj
+++ src/clj/forma/bangfunc.clj
@@ -1,25 +1,86 @@
 (ns forma.bangfunc
   (:require [incanter.core :as i]))
-

 ; test data to simulate a randome time-series (will be read in later)
 (def random-ints (repeatedly #(rand-int 100)))
 (def test-ts (take 131 random-ints))

+(def test-ts [5 3 7 6 7 8 9 8 7 4 3 1 1 2 2 5 6 7 5 4 3 4 5 8 10 10 18 19 6 5 4 9 3 2 0 1 1 2 4 9 10 15 19 22 18 9 2 1 1 0])
+
+(defn average [lst] (float (/ (reduce + lst) (count lst))))
+
+
+; De-seasonalize time-series
+;
+; mu = np.average(Y1)
+; fix = np.linalg.inv(Xdt * Xd) * Xdt * Y1                                #Regress original timeseries on 11 monthly dummies and ones-vector (for constant)
+; Y1 = ((Y1 - Xd[:,1:12] * fix[1:12]) - fix[0]) + mu                      #Adjust the NDVI values by monthly averages
+
+
+(defn variance-matrix
+  "construct a variance-covariance matrix from a given matrix X"
+  [X]
+  (i/solve (i/mmult (i/trans X) X)))
+
+(defn make-matrix
+  [width height]
+  "Create a matrix (list of lists)"
+  (repeat width (repeat height 0)))
+
+(defn matrix-map
+  [m func]
+  "Apply a function to every element in a matrix"
+  (map (fn [x] (map func x)) m))
+
+(def seasonal-vector (vec (conj (repeat 11 0) 1)))
+
+(defn seasonal-matrix
+  "create a matrix of [num-months]x11 of monthly dummies, where
+  [num-months] indicates the number of months in the time-series"
+  [num-months]
+  )
+
+(def monthly-dummies
+  (i/bind-rows (repeat 11 0) (i/identity-matrix 11)))
+
+(defn deseasonalize
+  "deseasonalize a time-series [ts] using monthly dummies."
+  [ts]
+  (let [avg (average ts)]
+  avg))

 ; WHOOPBANG

-(defn ols-coeff
-  "extract OLS coefficient from a time-series
-  as efficiently as possible."
+(defn whoop-cofactor
+  "construct a matrix of cofactors; first column is comprised
+  of ones, second column is a range from 1 to [num-months].  The
+  result is a [num-months]x2 incanter matrix."
+  [num-months]
+  (i/trans (i/bind-rows (repeat num-months 1) (range 1 (inc num-months)))))
+
+(defn whoop-ols
+  "extract OLS coefficient from a time-series as efficiently
+  as possible for the whoopbang function."
   [ts]
   (let [ycol (i/trans [ts])
-        pd (count ts)
-        X (i/trans (i/bind-rows (repeat pd 1) (range 1 (inc pd))))
-        ssX (i/solve (i/mmult (i/trans X) X))]
-  (i/sel (i/mmult ssX (i/trans X) ycol) 1 0)))
+        X (whoop-cofactor (count ts))
+        V (variance-matrix X)]
+  (i/sel (i/mmult V (i/trans X) ycol) 1 0)))

-(def whoopbang (reduce min (map ols-coeff (partition 15 1 test-ts))))
-(def whizbang (ols-coeff test-ts))
+(defn windowed-apply
+  "apply a function [f] to a window along a sequence [xs] of length [window]"
+  [f window xs]
+  (map f (partition window 1 xs)))

+(defn whoopbang
+  "whoopbang will find the greatest OLS drop over a timeseries [ts] given
+  sub-timeseries of length [long-block].  The drops are smoothed by a moving
+  average window of length [mov-avg]."
+  [ts long-block window]
+  (->> ts
+       (windowed-apply whoop-ols long-block)
+       (windowed-apply average window)
+       (reduce min)))
+
+; (def whizbang (ols-coeff test-ts))
 ; juxt function ((juxt a b) x) -> ((a x) (b x))


Remove unused import

Remove unused import

--- src/clj/nightcode/core.clj
+++ src/clj/nightcode/core.clj
@@ -7,7 +7,7 @@
             [nightcode.state :refer [pref-state runtime-state]])
   (:import [javafx.application Application]
            [javafx.fxml FXMLLoader]
-           [javafx.stage Stage StageBuilder]
+           [javafx.stage Stage]
            [javafx.scene Scene])
   (:gen-class :extends javafx.application.Application))


Minor fix

Minor fix

--- src/clj/salava/user/db.clj
+++ src/clj/salava/user/db.clj
@@ -74,7 +74,7 @@
             new-user            (insert-user<! {:first_name first-name :last_name last-name :email email :country country :language language :email_notifications email_notifications :pass (hash-password password)} (get-db ctx))
             user-id             (:generated_key new-user)]
         (insert-user-email! {:user_id user-id :email email :primary_address 1 :verification_key activation_code} (get-db ctx))
-        (u/publish ctx :new-user {:user-id user-id})
+        ;(u/publish ctx :new-user {:user-id user-id})
         {:status "success" :message ""}))))

 (defn set-password-and-activate


Partial cause class cast exception

Partial cause class cast exception

--- src/clj/sparqlab/store.clj
+++ src/clj/sparqlab/store.clj
@@ -3,13 +3,14 @@
             [mount.core :as mount]
             [clojure.tools.logging :as log]
             [clojure.java.io :as io])
-  (:import [org.apache.jena.rdf.model ModelFactory]
+  (:import [org.apache.jena.rdf.model Model ModelFactory]
            [org.apache.jena.query QueryFactory]))

 ; ----- Data pre-processing -----

 (defn enrich-exercises-with-extracted-constructs
-  [store]
+  "Enrich exercises in the `store` with extracted SPARQL language constructs."
+  [^Model store]
   (let [exercise-queries (->> "sparql/get_exercise_queries.rq"
                               io/resource
                               slurp
@@ -38,5 +39,7 @@
   :start (open-store)
   :stop (close-store store))

-(def select-query
-  (partial sparql/select-query store))
+(defn select-query
+  "Execute SELECT `query` on the store."
+  [query]
+  (sparql/select-query store query))


Update Mac OS name and file types

Update Mac OS name and file types

--- src/cljs/app/analysis.cljs
+++ src/cljs/app/analysis.cljs
@@ -8,7 +8,7 @@
   (cond
     (boolean (re-find #"windows" url)) "Windows"
     (boolean (re-find #"linux" url)) "Linux"
-    (boolean (re-find #"mac|.dmg" url)) "Mac OS X"
+    (boolean (re-find #"mac|.dmg" url)) "macOS"
     :else "Other"))

 (defn get-word-size
@@ -24,7 +24,7 @@
   (cond
     (boolean (re-find #".zip" url)) "Portable"
     (boolean (re-find #".tar.gz" url)) "Portable"
-    (boolean (re-find #".dmg" url)) "Disk Image"
+    (boolean (re-find #"mac|.dmg" url)) "Disk Image"
     :else "Installer"))

 (defn analyze-download-url


correctly display upload path

correctly display upload path

--- src/cljs/smgui/search.cljs
+++ src/cljs/smgui/search.cljs
@@ -26,7 +26,7 @@

 (def status-map { :init       (define-status "time"        (fn [] ["Iniciando a busca..."]))
                   :info       (define-status "time"        (fn [] ["Carregando informações do vídeo..."]))
-                  :upload     (define-status "upload"      (fn [status] ["Enviando " nil " ..."]))
+                  :upload     (define-status "upload"      (fn [status] ["Enviando " (:extra status) " ..."]))
                   :search     (define-status "search"      (fn [status] [(str "Buscando legendas nos idiomas: " (get-in status [:search-languages]))]))
                   :download   (define-status "download"    (fn [status] ["Baixando legenda do servidor: " (-> status :download :source-name) "..."]))
                   :downloaded (define-status "check"       (fn [status] ["Baixado do servidor " (-> status :download :source-name) " (" (status-website-link status) ")"]))
@@ -42,11 +42,12 @@
   (let [out (chan)]
     (go-loop [state {:status :init}]
              (>! out state)
-             (if-let [data (<! in)]
-               (let [[status info] data
-                     new-info (assoc info :status (if (contains? status-map status)
-                                                    status
-                                                    (:status state)))]
+             (if-let [[status info extra] (<! in)]
+               (let [new-info (-> info
+                                  (assoc :status (if (contains? status-map status)
+                                                   status
+                                                   (:status state)))
+                                  (assoc :extra extra))]
                  (if (trackable-states status) (track/search (name status)))
                  (recur new-info))
                (close! out)))


Give the enemy an airfield and seaport

Give the enemy an airfield and seaport

--- src/cljs/zetawar/data.cljs
+++ src/cljs/zetawar/data.cljs
@@ -768,7 +768,7 @@
       :terrain-type :plains}
      {:q 6
       :r 5
-      :terrain-type :plains}
+      :terrain-type :airfield #_:plains}
      {:q 7
       :r 5
       :terrain-type :plains}
@@ -845,7 +845,7 @@
       :terrain-type :deep-water}
      {:q 5
       :r 8
-      :terrain-type :mountains}
+      :terrain-type :seaport #_:mountains}
      {:q 6
       :r 8
       :terrain-type :plains}


Implement mmutable ops

Implement mmutable ops

--- src/clojure/gpu/matrix.clj
+++ src/clojure/gpu/matrix.clj
@@ -95,11 +95,23 @@
         (.set m row col v)
         (error "Invalid shape!"))
       m))
-  (set-nd [^NDArray m ^"[J" indexes ^double v]
+  (set-nd [^NDArray m indexes ^double v]
     (let [ndims (.dimensionality m)
           m (.clone m)
           ^"[J" indexes (long-array indexes)]
       (if (= ndims (count indexes))
         (.set m indexes v)
         (error "Invalid shape"))
-      m)))
+      m))
+  (is-mutable? [m] true))
+
+(extend-protocol mp/PIndexedSettingMutable
+  NDArray
+  (set-1d! [^NDArray m ^long i ^double v]
+    (.set m i v))
+  (set-2d! [^NDArray m ^long i ^long j ^double v]
+    (.set m i j v))
+  (set-nd! [^NDArray m indexes ^double v]
+    (let [^"[J" indexes (long-array indexes)]
+      (.set m indexes v))))
+


amp fix

amp fix

--- src/clojure/nossal/web.clj
+++ src/clojure/nossal/web.clj
@@ -35,15 +35,13 @@
            [48 96 144 192])
       [:link {:rel "canonical" :href (core/cannonical-url req)}]
       [:link {:rel "manifest" :href (s/join ["/" (options :manifest) ".json"])}]
-      [:script {:async "true" :scr "//pagead2.googlesyndication.com/pagead/js/adsbygoogle.js"}]
-      [:script "(adsbygoogle = window.adsbygoogle || []).push({google_ad_client: \"ca-pub-9207695243671092\",enable_page_level_ads: true});"]
-      [:script {:async "true" :src "https://cdn.ampproject.org/v0.js"}]
+      [:script {:async true :src "https://cdn.ampproject.org/v0.js"}]
       (if-not (contains? #{"localhost" "127.0.0.1", "192.168"} (:server-name req))
-        [:script {:async "true" :custom-element "amp-analytics" :src "https://cdn.ampproject.org/v0/amp-analytics-0.1.js"}])
-      [:style {:amp-custom "true"} (slurp (io/resource "public/css/screen.css")) css]
-      [:style {:amp-boilerplate "true"} (slurp (io/resource "amp-css.css"))]
+        [:script {:async true :custom-element "amp-analytics" :src "https://cdn.ampproject.org/v0/amp-analytics-0.1.js"}])
+      [:style {:amp-custom true} (slurp (io/resource "public/css/screen.css")) css]
+      [:style {:amp-boilerplate true} (slurp (io/resource "amp-css.css"))]
       [:noscript
-       [:style {:amp-boilerplate "true"} "body{-webkit-animation:none;-moz-animation:none;-ms-animation:none;animation:none} "]]]
+       [:style {:amp-boilerplate true} "body{-webkit-animation:none;-moz-animation:none;-ms-animation:none;animation:none} "]]]
      [:body
       [:script {:type "application/ld+json"} dat/data-website]
       [:amp-analytics {:type "googleanalytics"}
@@ -133,13 +131,13 @@
                   [:link {:rel "icon" :type "image/png" :href (s/join ["/" "gift-icon-" s ".png"]) :sizes (s/join [s "x" s])}])
                  [16 32 48 96 144])
             [:link {:rel "canonical" :href (core/cannonical-url req)}]
-            [:script {:async "true" :src "https://cdn.ampproject.org/v0.js"}]
+            [:script {:async true :src "https://cdn.ampproject.org/v0.js"}]
             (if-not (contains? #{"localhost" "127.0.0.1", "192.168"} (:server-name req))
-              [:script {:async "true" :custom-element "amp-analytics" :src "https://cdn.ampproject.org/v0/amp-analytics-0.1.js"}])
-            [:style {:amp-custom "true"} (slurp (io/resource "public/css/simple.css"))]
-            [:style {:amp-boilerplate "true"} (slurp (io/resource "amp-css.css"))]
+              [:script {:async true :custom-element "amp-analytics" :src "https://cdn.ampproject.org/v0/amp-analytics-0.1.js"}])
+            [:style {:amp-custom true} (slurp (io/resource "public/css/simple.css"))]
+            [:style {:amp-boilerplate true} (slurp (io/resource "amp-css.css"))]
             [:noscript
-              [:style {:amp-boilerplate "true"} "body{-webkit-animation:none;-moz-animation:none;-ms-animation:none;animation:none} "]]]
+              [:style {:amp-boilerplate true} "body{-webkit-animation:none;-moz-animation:none;-ms-animation:none;animation:none} "]]]
            [:body.coupom
             [:amp-analytics {:type "googleanalytics"}
              [:script {:type "application/json"} dat/data-analytics]]


Add some missing type hints.

Add some missing type hints.

--- src/clojure/parkour/fs.clj
+++ src/clojure/parkour/fs.clj
@@ -31,7 +31,7 @@
   "Coerce argument(s) to a Path, resolving successive arguments against base."
   {:tag `Path}
   ([x] (if (path? x) x (-path x)))
-  ([x y] (Path. (path x) (str y)))
+  ([x y] (Path. ^Path (path x) (str y)))
   ([x y & more] (apply path (path x y) more)))

 (defn path-array
@@ -51,7 +51,7 @@
   {:tag `URI}
   ([x] (if (uri? x) x (-uri x)))
   ([x y]
-     (let [x (uri x)]
+     (let [^URI x (uri x)]
        (-> x (.resolve (str (.getPath x) "/")) (.resolve (str y)))))
   ([x y & more] (apply uri (uri x y) more)))


Better threading output and no console output (all for CI)

--- integration-tests/apps/caching/counter/test/counter/test/locking.clj
+++ integration-tests/apps/caching/counter/test/counter/test/locking.clj
@@ -1,7 +1,8 @@
 (ns counter.test.locking
   (:use clojure.test)
   (:require [immutant.cache :as csh]
-            [immutant.messaging :as msg]))
+            [immutant.messaging :as msg]
+            [clojure.tools.logging :as log]))

 (msg/start "/queue/work")
 (msg/start "/queue/done")
@@ -13,16 +14,16 @@
 (defn work
   [{:keys [name key]}]
   (let [cache (get caches name)]
-    (println "JC: work start" name cache)
+    (log/info "JC: work start" name cache)
     (loop [v (get cache key)]
-      (println "JC: v=" name v)
+      (log/info "JC: v=" name v)
       (if (csh/put-if-replace cache key v (inc v))
         (msg/publish "/queue/done" name)
         (recur (get cache key))))))

 (use-fixtures :each (fn [f]
                       (let [listener (msg/listen "/queue/work" work :concurrency 10)]
-                        (println "JC: listener for /queue/work set")
+                        (log/info "JC: listener for /queue/work set")
                         (f)
                         (msg/unlisten listener))))

@@ -30,16 +31,16 @@
   (csh/put (:pessimistic caches) :count 0)
   (is (= 0 (:count (:pessimistic caches))))
   (dotimes [_ 10] (msg/publish "/queue/work" {:name :pessimistic :key :count}))
-  (println "JC: published 10 messages")
+  (log/info "JC: published 10 messages")
   (is (every? (partial = :pessimistic) (take 10 (msg/message-seq "/queue/done" :timeout 60000))))
-  (println "JC: pessimistic done" (:count (:pessimistic caches)))
+  (log/info "JC: pessimistic done" (:count (:pessimistic caches)))
   (is (= 10 (:count (:pessimistic caches)))))

 (deftest correct-counting-with-optimistic-locking
   (csh/put (:optimistic caches) :count 0)
   (is (= 0 (:count (:optimistic caches))))
   (dotimes [_ 3] (msg/publish "/queue/work" {:name :optimistic :key :count}))
-  (println "JC: published 3 messages")
+  (log/info "JC: published 3 messages")
   (is (every? (partial = :optimistic) (take 3 (msg/message-seq "/queue/done" :timeout 60000))))
-  (println "JC: optimistic done" (:count (:optimistic caches)))
+  (log/info "JC: optimistic done" (:count (:optimistic caches)))
   (is (= 3 (:count (:optimistic caches)))))


Whitespace

Whitespace

--- src/foreclojure/login.clj
+++ src/foreclojure/login.clj
@@ -74,7 +74,7 @@
       [:button {:type "submit"} "Submit"]])))

 (defn hide-settings-box [user-obj]
-  (list
+  (list
    [:p "When you solve a problem, we allow any user who has solved a problem to view your solutions to that problem. Check this box to keep your solutions private."]
    (form-to [:post "/users/set-hide-solutions"]
      (check-box :hide-solutions


Cascade deletes to the mapping table. This 1) allows deletes of heads at all (good!) and means that mappings cant point to null heads (also positive!)

--- src/doctopus/db/schema.clj
+++ src/doctopus/db/schema.clj
@@ -47,8 +47,8 @@
    [:updated :timestamp "NOT NULL"]])

 (def head-tentacle-schema
-  [[:head_name "varchar(50) references heads(name)"]
-   [:tentacle_name "varchar(50) references tentacles(name)"]])
+  [[:head_name "varchar(50) references heads(name) on delete cascade"]
+   [:tentacle_name "varchar(50) references tentacles(name) on delete cascade"]])

 (defn do-sql-with-logging!
   [sql-statement]


Send long IRC messages as multiple messages split up; fix devth/yetibot#352

--- src/yetibot/core/adapters/irc.clj
+++ src/yetibot/core/adapters/irc.clj
@@ -7,16 +7,21 @@
      [core :as irc]
      [connection :as irc-conn]]
     [yetibot.core.models.users :as users]
-    [clojure.string :refer [split-lines]]
+    [clojure.string :refer [split-lines join]]
     [yetibot.core.config :refer [get-config config-for-ns conf-valid?]]
     [yetibot.core.chat :refer [send-msg-for-each register-chat-adapter]]
     [yetibot.core.util.format :as fmt]
     [yetibot.core.handler :refer [handle-raw]]))

-(def conn (atom nil))
+(defonce conn (atom nil))
 (declare config channel connect start)
 (def chat-source (format "irc/%s" channel))
-(def wait-before-reconnect 25000)
+(def wait-before-reconnect 30000)
+
+(def irc-max-message-length 420)
+
+(defn split-msg-into-irc-max-length-chunks [msg]
+  (map join (partition-all irc-max-message-length msg)))

 (def send-msg
   "Rate-limited function for sending messages to IRC. It's rate limited in order
@@ -24,14 +29,16 @@
   (rate-limit
     (fn [msg]
       (try
-        (irc/message @conn channel msg)
+        (if (> (count msg) irc-max-message-length)
+          (doall (map send-msg (split-msg-into-irc-max-length-chunks msg)))
+          (irc/message @conn channel msg))
         (catch java.net.SocketException e
           ; it must have disconnect, try reconnecting again
           (info "SocketException, trying to reconnect in" wait-before-reconnect "ms")
           (Thread/sleep wait-before-reconnect)
           (connect)
           (start))))
-    3 600))
+    3 900))

 (defn- create-user [info]
   (let [username (:nick info)


Throw more useful errors about unresolvable symbols

--- src/icfp2014/compiler.clj
+++ src/icfp2014/compiler.clj
@@ -311,9 +311,13 @@
                     (apply concat)
                     (remove nil?)
                     (into {}))
-        resolve-label #(get labels (last %) (last %))
+        resolve-label #(if-let [label (get labels (last %) (last %))]
+                         label
+                         (throw (IllegalArgumentException. (format "Couldn't resolve label %s" (last %)))))
         functions (map #(str (:name %)) (rest fns))
-        resolve-global #(resolve-sym  (second %)  (concat functions @globals))]
+        resolve-global #(if-let [global (resolve-sym (second %) (concat functions @globals))]
+                          global
+                          (throw (IllegalArgumentException. (format "Couldn't resolve global %s" (second %)))))]
     (for [line lines]
       (let [labels_resolved (clojure.string/replace line #"@(\S+)" resolve-label)
             fns_resolved (clojure.string/replace labels_resolved #"\^(\S+)" resolve-global)]


hdfsreader calls with 3 args

hdfsreader calls with 3 args

--- src/images/hdfsreader.clj
+++ src/images/hdfsreader.clj
@@ -2,4 +2,4 @@
   (:import images.java.HdfsReader))

 (defn get-image [hdfspath filename]
-  (HdfsReader/getHdfsFileStream hdfspath filename))
+  (HdfsReader/getHdfsFileStream "hdfs://localhost:9000" hdfspath filename))


devtools: clicking on a signal now toggles all its actions

--- src/frontend/devtools.cljs
+++ src/frontend/devtools.cljs
@@ -18,7 +18,7 @@
     :signal-events  (list)
     :next-signal-id 0

-    ; list of {id source-signal-id enabled? action}
+    ; list of {id signal-id enabled? action}
     :action-events  (list)
     :next-action-id 0

@@ -69,6 +69,11 @@
                  (when-not (nil? s)
                    (control model [:component s] dispatch)))))

+           [:on-toggle-signal id]
+           (do
+             (dispatch [:toggle-signal id])
+             (dispatch :replay))
+
            [:on-toggle-action id]
            (do
              (dispatch [:toggle-action id])
@@ -110,6 +115,13 @@
            (-> model
                (update :signal-events concat [signal-event])
                (update :next-signal-id inc))
+
+           [:toggle-signal id]
+           (let [all-actions-enabled? (->> (:action-events model)
+                                           (filter #(= (:signal-id %) id))
+                                           (every? :enabled?))]
+             (-update-action-events* model #(= (:signal-id %) id)
+                                     assoc :enabled? (not all-actions-enabled?)))

            [:toggle-action id]
            (-update-action-event model id update :enabled? not)
@@ -173,7 +185,7 @@
                   :border-bottom-width 1
                   :border-bottom-style "solid"
                   :border-color        "#4F5A65"}}
-    [:input.toggle {:title     "Persist actions and signals?"
+    [:input.toggle {:title     "Persist debug session into local storage?"
                     :type      "checkbox"
                     :checked   (:persist? model)
                     :on-change #(dispatch :on-toggle-persist)}
@@ -202,10 +214,13 @@
       (for [[signal-id signal] (reverse (:signal-events model))]
         ^{:key signal-id}
         [:div {:title "Signal"}
-         "→ "
-         (if (coll? signal)
-           [:span [:strong (pr-str (first signal))] " " (clojure.string/join " " (rest signal))]
-           [:strong (pr-str signal)])
+         [:div {:style    {:cursor "pointer"}
+                :on-click #(dispatch [:on-toggle-signal signal-id])
+                :title    "Click to enable/disable all actions dispatched from this signal"}
+          "→ "
+          (if (coll? signal)
+            [:span [:strong (pr-str (first signal))] " " (clojure.string/join " " (rest signal))]
+            [:strong (pr-str signal)])]

          (for [{:keys [id enabled? action]} (filter #(= (:signal-id %) signal-id)
                                                     (:action-events model))]


Notes on slug change.

Notes on slug change.

--- REPL_notes.clj
+++ REPL_notes.clj
@@ -109,6 +109,18 @@
       (r/update {:update {:body "
It's time to learn. That's it, really. Put it in the hands of people we admire and trust, and LEARN FAST.

"}})
       (r/run c)))

+;; Provide a new slug for a company
+(with-open [c (apply r/connect conn2)]
+  (-> (r/table "companies")
+      (r/insert (assoc (company/get-company conn "old-slug") :slug "new-slug"))
+      (r/run c)))
+(with-open [c (apply r/connect conn2)]
+  (-> (r/table "sections")
+      (r/get-all ["old-slug"] {:index "company-slug"})
+      (r/update {:slug "new-slug"})
+      (r/run c)))
+(company/delete-company conn "old-slug")
+
 ;; for more RethinkDB help, see:
 ;; https://github.com/apa512/clj-rethinkdb
 ;; http://apa512.github.io/clj-rethinkdb/


Word choice change in scraper logging

Word choice change in scraper logging

--- src/mars_ogler/scrape.clj
+++ src/mars_ogler/scrape.clj
@@ -216,7 +216,7 @@
 (defn print-summary
   [new-images all-images]
   (if (empty? new-images)
-  (println "I couldn't find any new photos, so we still have"
+  (println "I didn't find any new photos, so we still have"
            (count all-images) "total")
   (println "I found" (count new-images) "new photos, so now we have"
              (count all-images) "total")))


fixed git syntax issue should have been --no-color instead of --color=never

--- src/leiningen/git_deps.clj
+++ src/leiningen/git_deps.clj
@@ -58,7 +58,7 @@
 (defn- detached-head?
   "Return true if the git repository in dir has HEAD detached."
   [dir]
-  (let [{out :out} (exec "git" "branch" "--color=never" :dir dir)
+  (let [{out :out} (exec "git" "branch" "--no-color" :dir dir)
         lines (string/split-lines out)
         current-branch (first (filter #(.startsWith % "*") lines))]
     (when-not current-branch


need to thread bound vars through

need to thread bound vars through

--- src/main/cljs/cljs/js.cljs
+++ src/main/cljs/cljs/js.cljs
@@ -87,20 +87,19 @@
 ;; -----------------------------------------------------------------------------
 ;; Emit

-(defn emit* [env ast cb]
+(defn emit* [env bound-vars ast cb]
   (cb (with-out-str (comp/emit ast))))

 (defn emit [env ast cb]
-  (env/with-compiler-env env
-    (emit* env ast cb)))
+  (emit* env {} ast cb))

 ;; -----------------------------------------------------------------------------
 ;; Eval

-(defn eval* [env form cb]
+(defn eval* [env bound-vars form cb]
   (let [ana-env (ana/empty-env)]
     (cb (ana/analyze ana-env form))))

 (defn eval [env form cb]
   (env/with-compiler-env env
-    (eval* env form cb)))+    (eval* env {} form cb)))


Make a ranked graph instead.

Make a ranked graph instead.

--- src/od117_walker/core.clj
+++ src/od117_walker/core.clj
@@ -106,20 +106,59 @@

 (defn graphify-one
   "Create graphviz dot language entries for given graph node (in internal map format)."
-  [[key {:keys [links author]}]]
-  (apply str
-         (apply str (map #(str \" key \" " -> " \" % \" ";\n") links))
-         (if-let [colour (get author-colours author)]
-           (str \" key \" " " "[color=" colour ",style=filled];\n")
-           "")))
+  [[key {:keys [links]}]]
+  (apply str (map #(str \" key \" " -> " \" % \" ";\n") links))
+  )

-(defn graphify
+(defn node-def
+  [[key {:keys [author]}]]
+  (str \" key \"
+       (if-let [colour (get author-colours author)]
+         (str " [color=" colour ",style=filled]")
+         "")
+       ";\n"))
+
+(def turns [#{\a \b \c}
+            #{\d \e \f}
+            #{\g \h \i}
+            #{\j \k \l}
+            #{\m \n \o}
+            #{\p \q}
+            #{\r \s}
+            #{\t \u \v}
+            #{\w \x \y \z}])
+
+(defn make-turn
+  [turn decls]
+  (let [turn-decls (filter #(turn (nth % 2)) decls)]
+    (str "{ rank=same;\n"
+         (str (apply str (sort turn)) ";\n")
+         (apply str turn-decls)
+         "}\n")))
+
+(defn make-order
+  []
+  (str (apply str (interpose "->" (map #(apply str (sort %)) turns))) ";\n"))
+
+(defn graphify-ranked
   "Convert a map representation of the graph into a string of graphviz dot language."
   [g]
-  (let [vals (map graphify-one (seq g))]
+  (let [decls (map #(make-turn % (map node-def (seq g))) turns)
+        vals (map graphify-one (seq g))]
     (str "digraph G {\n"
+         (make-order)
+         (apply str decls)
          (apply str vals)
-         "}")))
+         "}\n")))
+
+(defn graphify-unordered
+  [g]
+  (let [decls (map node-def (seq g))
+        vals (map graphify-one (seq g))]
+    (str "digraph G {\n"
+         (apply str decls)
+         (apply str vals)
+         "}\n")))

 ;; Start points that will ensure we hit the whole graph.
 ;; Manually entered, a little bit of a hack.
@@ -134,4 +173,4 @@
   "Calculate and print the graph of OD-117 to foo.dot."
   [& args]
   (with-open [wrtr (io/writer "foo.dot")]
-    (.write wrtr (graphify (walk start-points authors)))))
+    (.write wrtr (graphify-ranked (walk start-points authors)))))


Add docstring and minor formatting

Add docstring and minor formatting

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -577,6 +577,7 @@
        note#)))

 (defn active-synths
+  "Returns a list of maps each representing an active synth on the server."
   ([] (active-synths (node-tree)))
   ([root]
    (let [synths (if (= :synth (:type root))
@@ -584,5 +585,5 @@
                   #{})
          children (mapcat active-synths (:children root))]
      (into [] (if (empty? children)
-       synths
-       (set (concat synths children)))))))
+                synths
+                (set (concat synths children)))))))


add new layer attributes

add new layer attributes

--- src/pc/datomic/schema.clj
+++ src/pc/datomic/schema.clj
@@ -32,9 +32,26 @@
    (enum :layer.type/rect)
    (enum :layer.type/group)

+   (attribute :layer/start-x
+              :db.type/long)
+
+   (attribute :layer/start-y
+              :db.type/long)
+
+   (attribute :layer/end-x
+              :db.type/long)
+
+   (attribute :layer/end-y
+              :db.type/long)
+
    (attribute :layer/fill
-              :db.type/bytes
-              :db/doc "Fill, should be an array of ints, has to be converted to and from bytes")
+              :db.type/string)
+
+   (attribute :layer/stroke-width
+              :db.type/long)
+
+   (attribute :layer/stroke-color
+              :db.type/string)

    ;; Use the layer's uuid so that the frontend can track children
    ;; Wonder what happens if we make a layer a child of one of its children...


Empty console on repo switch

Empty console on repo switch

--- src/replme/cljs/repl.cljs
+++ src/replme/cljs/repl.cljs
@@ -1,7 +1,7 @@
 (ns replme.cljs.repl
   (:require [cljs.core.async :refer [<! >! sub chan]]
             [replme.cljs.websocket :as ws])
-  (:use [jayq.core :only [$]])
+  (:use [jayq.core :only [$ empty]])
   (:require-macros [cljs.core.async.macros :refer [go-loop]]))

 (enable-console-print!)
@@ -30,7 +30,7 @@
 (defn init [socket socket-out-pub]
   (let [socket socket
         socket-out-sub (sub socket-out-pub :repl (chan 1 (map :message)))
-        $repl-container ($ :#repl-container)
+        $repl-container (empty ($ :#repl-container))
         console (.console $repl-container (repl-config socket))]
     (go-loop [{:keys [namespace] :as msg} (<! socket-out-sub)]
       (println msg)


add rudimentary support for proceeding with shrinking even if the function being tested throws exceptions for some inputs

--- src/simple_check/core.clj
+++ src/simple_check/core.clj
@@ -13,7 +13,9 @@
 (defn- run-test
   [property args]
   (let [vars (map arbitrary args)
-        result (apply property vars)]
+        result (try
+                 (apply property vars)
+                 (catch Throwable t t))]
     [result vars]))

 (declare shrink-loop)
@@ -25,14 +27,20 @@
     (if (= so-far num-tests)
       {:result true :num-tests so-far}
       (let [[result vars] (run-test property-fun args)]
-        (if result
-          (recur (inc so-far))
-          {:result false
-           :num-tests so-far
-           :fail (vec vars)
-           :shrunk (shrink-loop property-fun
-                                (tuple args)
-                                (vec vars))})))))
+        (cond
+          (instance? Throwable result) {:result result
+                                        :num-tests so-far
+                                        :fail (vec vars)
+                                        :shrunk (shrink-loop property-fun
+                                                             (tuple args)
+                                                             (vec vars))}
+          result (recur (inc so-far))
+          :default {:result false
+                    :num-tests so-far
+                    :fail (vec vars)
+                    :shrunk (shrink-loop property-fun
+                                         (tuple args)
+                                         (vec vars))})))))

 (defmacro forall [bindings expr]
   `(let [~@bindings]
@@ -62,7 +70,12 @@
          :depth depth
          :smallest f}
         (let [[head & tail] nodes]
-          (if (apply prop head)
+          (if (try
+                (apply prop head)
+                (catch Throwable t
+                  ; assuming that this `t` is of the same type that was
+                  ; originally thrown in quick-check...
+                  false))
             ;; this node passed the test, so now try testing it's right-siblings
             (recur tail f (inc total-nodes-visited) depth can-set-new-best?)
             ;; this node failed the test, so check if it has children,


Add buttons, add log tab

Add buttons, add log tab

--- src/sqls/ui/worksheet.clj
+++ src/sqls/ui/worksheet.clj
@@ -29,7 +29,13 @@
                                                   :rows 25
                                                   :listen [:key-pressed on-query-text-area-key-press])
         results-panel (seesaw.core/vertical-panel :id :results-panel
-                                                  :preferred-size [600 :by 400])
+                                                  :preferred-size [800 :by 400])
+        log-text (seesaw.core/text :id :log :multi-line? true :editable? false)
+        log-panel (seesaw.core/vertical-panel :id :log-panel
+                                              :items [log-text])
+        tabs-panel (seesaw.core/tabbed-panel :id :tabs
+                                       :tabs [{:title "Results" :content results-panel}
+                                              {:title "Log" :content log-panel}])
         menu-panel (seesaw.core/horizontal-panel :id :menu-panel
                                                  :items [
                                                          (seesaw.core/button :id :new
@@ -38,9 +44,17 @@
                                                                              :icon (seesaw.icon/icon "floppy.png"))
                                                          (seesaw.core/button :id :open
                                                                              :icon (seesaw.icon/icon "open.png"))
+                                                         (seesaw.core/button :id :explain
+                                                                             :text "Explain plan")
+                                                         (seesaw.core/button :id :execute
+                                                                             :text "Execute")
+                                                         (seesaw.core/button :id :commit
+                                                                             :text "Commit")
+                                                         (seesaw.core/button :id :rollback
+                                                                             :text "Rollback")
                                                          ])
-        center-panel (seesaw.core/vertical-panel :items [query-text-area results-panel])
-        south-panel (seesaw.core/horizontal-panel :items ["Connecting..."])
+        center-panel (seesaw.core/vertical-panel :items [query-text-area tabs-panel])
+        south-panel (seesaw.core/horizontal-panel :items [""])
         border-panel (seesaw.core/border-panel :north menu-panel
                                                :center center-panel
                                                :south south-panel)
@@ -116,9 +130,6 @@
         [start end] (extend-nonempty-lines-range all-text-lines line-no line-no)
         block-lines (subvec all-text-lines start (inc end))
         block-text (join "\n" block-lines)]
-    (println "caret position:" caret-position)
-    (println "start line of block:" start)
-    (println "end line of block:" end)
     block-text))

@@ -137,13 +148,31 @@
   [frame columns rows]
   (let [
         [strict-rows lazy-rows] rows
-        results-table (seesaw.core/scrollable (seesaw.core/table :model [:columns columns
-                                                                         :rows strict-rows]))
+        ; _ (println "strict-rows:" strict-rows)
+        ; _ (println "lazy-rows:" lazy-rows)
+        results-table (seesaw.core/table :auto-resize :off
+                                         :model [:columns columns
+                                                 :rows strict-rows])
+        results-table-scrollable (seesaw.core/scrollable results-table)
         results-panel (seesaw.core/select frame [:#results-panel])
         to-remove (seesaw.core/select frame [:#results-panel :> :*])]
     ; (println "strict rows count:" (count strict-rows))
     ; (println "lazy rows count:" (count lazy-rows))  ; this obviously shouldn't happen
     (doall (map (partial seesaw.core/remove! results-panel) to-remove))
-    (seesaw.core/add! results-panel results-table)))
-
-
+    (seesaw.core/add! results-panel results-table-scrollable)
+    (let [table-column-model (.getColumnModel results-table)
+          column-count (count columns)
+          row-count (count strict-rows)
+          max-column-widths (vec (for [column-index (range column-count)]
+                                   (max 4
+                                        (let [
+                                              column-values (map str (map #(get % column-index) strict-rows))
+                                              column-value-lengths (map count column-values)
+                                              max-column-value-length (apply max column-value-lengths)]
+                                          max-column-value-length))))
+          ]
+      (doall (for [column-index (range column-count)]
+               (let [table-column (.getColumn table-column-model column-index)
+                     column-width (get max-column-widths column-index)]
+                 (.setPreferredWidth table-column (* column-width 10))
+                 ))))))


attempt to render data

attempt to render data

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -242,6 +242,19 @@
                                          "Condition" {"Bool" { "aws:SecureTransport" "true"}}
                                          })})

+             (resource "template_file" "master-server-group-user-data"
+                       {:template (mesos-master-user-data {:aws-region region
+                                                           :cluster-name cluster-name
+                                                           :cluster-id (str vpc-name "-" cluster-name)
+                                                           :server-group "MasterServerGroup"
+                                                           :master-role (id-of "aws_iam_role" "master-role")
+                                                           :slave-role (id-of "aws_iam_role" "slave-role")
+                                                           :aws-access-key (id-of "aws_iam_access_key" "host-key")
+                                                           :aws-secret-access-key (output-of "aws_iam_access_key" "host-key" "secret")
+                                                           :exhibitor-s3-bucket (exhibitor-bucket-name cluster-name)
+                                                           :internal-lb-dns (output-of "aws_elb" "InternalMasterLoadBalancer" "dns_name")
+                                                           :fallback-dns (vpc/fallback-dns vpc/vpc-cidr-block)})
+                        })

              (asg "MasterServerGroup"
                   {:image_id current-coreos-ami
@@ -252,17 +265,7 @@
                    :tags {:Key "role"
                           :PropagateAtLaunch "true"
                           :Value "mesos-master"}
-                   :user_data (mesos-master-user-data {:aws-region region
-                                                       :cluster-name cluster-name
-                                                       :cluster-id "some-unique-id"
-                                                       :server-group "MasterServerGroup"
-                                                       :master-role (id-of "aws_iam_role" "master-role")
-                                                       :slave-role (id-of "aws_iam_role" "slave-role")
-                                                       :aws-access-key (id-of "aws_iam_access_key" "host-key")
-                                                       :aws-secret-access-key (output-of "aws_iam_access_key" "host-key" "secret")
-                                                       :exhibitor-s3-bucket (exhibitor-bucket-name cluster-name)
-                                                       :internal-lb-dns (output-of "aws_elb" "InternalMasterLoadBalancer" "dns_name")
-                                                       :fallback-dns (vpc/fallback-dns vpc/vpc-cidr-block)})
+                   :user_data (output-of "template_file" "master-server-group-user-data" "rendered")
                    :max_size 2
                    :min_size 2
                    :health_check_type "EC2"


slave group

slave group

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -107,7 +107,8 @@

 (defn cluster-infra
   [vpc-name cluster-name]
-  (let [public-subnets (mapv #(id-of "aws_subnet" (stringify "public-" %)) azs)]
+  (let [public-subnets (mapv #(id-of "aws_subnet" (stringify "public-" %)) azs)
+        private-subnets (mapv #(id-of "aws_subnet" (stringify "private-" %)) azs) ]
     (merge-in
      (in-vpc vpc-name
              (security-group "admin-security-group" {}
@@ -303,7 +304,7 @@
                                                              :aws-access-key (id-of "aws_iam_access_key" "host-key")
                                                              :aws-secret-access-key (output-of "aws_iam_access_key" "host-key" "secret")
                                                              :exhibitor-s3-bucket (exhibitor-bucket-name cluster-name)
-                                                             :internal-lb-dns (id-of "aws_elb" "master-group")
+                                                             :internal-lb-dns (id-of "aws_elb" "master-group") ;; may need to change
                                                              :fallback-dns (vpc/fallback-dns vpc/vpc-cidr-block)})
                    :block-device {:ebs_block_device {:device_name "/dev/xvda" :volume_size 20}}
                    :max_size 3
@@ -318,4 +319,27 @@
                                         :interval 30}
                          :subnets public-subnets}})

+             (asg "slave-group"
+                  {:image_id current-coreos-ami
+                   :instance_type "m4.xlarge"
+                   :sgs ["slave-security-group"]
+                   :role "slave-role"
+                   :user_data (mesos-slave-user-data {:aws-region region
+                                                      :cluster-name cluster-name
+                                                      :cluster-id "some-unique-id"
+                                                      :server-group "SlaveServerGroup"
+                                                      :master-role (id-of "aws_iam_role" "master-role")
+                                                      :slave-role (id-of "aws_iam_role" "slave-role")
+                                                      :aws-access-key (id-of "aws_iam_access_key" "host-key")
+                                                      :aws-secret-access-key (output-of "aws_iam_access_key" "host-key" "secret")
+                                                      :exhibitor-s3-bucket (exhibitor-bucket-name cluster-name)
+                                                      :internal-lb-dns (id-of "aws_elb" "master-group") ;; may need to change
+                                                      :fallback-dns (vpc/fallback-dns vpc/vpc-cidr-block)})
+                   :block-device {:ebs_block_device {:device_name "/dev/xvda" :volume_size 20}}
+                   :max_size 3
+                   :min_size 3
+                   :health_check_type "EC2" ;; or "ELB"?
+                   :health_check_grace_period 20
+                   :subnets private-subnets
+                   })
              ))))


Add weighted icaps choice fn

Add weighted icaps choice fn

--- src/edu/berkeley/ai/angelic/hierarchies/abstract_lookahead_trees.clj
+++ src/edu/berkeley/ai/angelic/hierarchies/abstract_lookahead_trees.clj
@@ -144,24 +144,32 @@
 	        (recur prev cur max-level))))
         cur))))

+
+; Like ICAPS, but weights exponentially towards earlier actions.
+(defn make-weighted-icaps-choice-fn [weight]
+  (let [weight (double weight)]
+   (fn [node]
+    (loop [node (:plan node), cur nil, maxgap Double/NEGATIVE_INFINITY]
+      (if-let [prev (:previous node)]
+          (if (hla-primitive? (:hla node)) (recur prev cur (/ maxgap weight))
+            (let [opt      (- (get-valuation-upper-bound (optimistic-valuation node))
+			      (get-valuation-upper-bound (optimistic-valuation prev)))
+		  mypess   (get-valuation-lower-bound (pessimistic-valuation node))
+		  prevpess (get-valuation-lower-bound (pessimistic-valuation prev))
+		  pess     (if (> prevpess Double/NEGATIVE_INFINITY)
+			     (- mypess prevpess)
+			     Double/NEGATIVE_INFINITY)
+		  gap      (- opt pess)]
+;	  (println (hla-name (:hla node)) gap opt pess mypess prevpess)
+	      (if (>= gap maxgap)
+	          (recur prev node (/ (double gap) weight))
+		(recur prev cur (/ maxgap weight)))))
+	cur)))))
+
 ; Almost icaps, except tiebreaks towards earlier, not higher-level...
-(defn icaps-choice-fn [node]
-  (loop [node (:plan node), cur nil, maxgap Double/NEGATIVE_INFINITY]
-    (if-let [prev (:previous node)]
-        (if (hla-primitive? (:hla node)) (recur prev cur maxgap)
-        (let [opt      (- (get-valuation-upper-bound (optimistic-valuation node))
-			  (get-valuation-upper-bound (optimistic-valuation prev)))
-	      mypess   (get-valuation-lower-bound (pessimistic-valuation node))
-	      prevpess (get-valuation-lower-bound (pessimistic-valuation prev))
-	      pess     (if (> prevpess Double/NEGATIVE_INFINITY)
-			   (- mypess prevpess)
-			 Double/NEGATIVE_INFINITY)
-	      gap      (- opt pess)]
-;	  (println (hla-name (:hla node)) gap opt pess mypess prevpess)
-	  (if (>= gap maxgap)
-	      (recur prev node (double gap))
-	    (recur prev cur maxgap))))
-      cur)))
+(def icaps-choice-fn
+  (make-weighted-icaps-choice-fn 1))
+

 ; Sometimes this priority fn misguides us ... pessimistic desc. too pessimistic...


defsystem docs

defsystem docs

--- src/deferst.cljc
+++ src/deferst.cljc
@@ -86,11 +86,11 @@
   "macro which defs some vars around a system and provides
    easy tools-namespace reloading. you get

-   <name> - the Sys record
-   <name>-start! - start the system, with optional config
-   <name>-stop! - stop the system if running
-   <name>-reload! - stop!, tools.namespace refresh, start!"
+   <base-name>-sys - the Sys record
+   <base-name>-start! - start the system, with optional config
+   <base-name>-stop! - stop the system if running
+   <base-name>-reload! - stop!, tools.namespace refresh, start!"
   ([builder default-conf]
    (defsystem* nil builder default-conf))
-  ([name builder default-conf]
-   (defsystem* name builder default-conf)))
+  ([base-name builder default-conf]
+   (defsystem* base-name builder default-conf)))


added support for rotation to mastersign.drawing/draw-string-centered

--- src/mastersign/drawing.clj
+++ src/mastersign/drawing.clj
@@ -1,5 +1,6 @@
 (ns mastersign.drawing
   (:import [java.awt Color Font])
+  (:import [java.awt.geom AffineTransform])
   (:require [mastersign.geom :refer :all]))

 (def default-font-size 16)
@@ -102,14 +103,21 @@
      (.getOutline gv (- x (.x c)) (- y (.y c))))))

 (defn draw-string-centered
-  [g text p & {font :font,
-               color :color,
+  [g text p & {font :font
+               color :color
+               rotation :rotation
                :or {font default-font,
-                    color Color/BLACK}}]
-  (let [offset (string-centered-offset g font text)]
+                    color Color/BLACK
+                    rotation 0}}]
+  (let [offset (string-centered-offset g font text)
+        x (.x p)
+        y (.y p)
+        transform (AffineTransform/getRotateInstance (* rotation (/ Math/PI 180)) x y)]
     (doto g
         (.setColor color)
         (.setFont font)
+        (.setTransform transform)
         (.drawString text
                      (float (+ (.x p) (.x offset)))
-                     (float (+ (.y p) (.y offset)))))))
+                     (float (+ (.y p) (.y offset))))
+        (.setTransform (AffineTransform.)))))


Fixed command line processing

Fixed command line processing

--- src/video_server/main.clj
+++ src/video_server/main.clj
@@ -159,18 +159,19 @@
   "Processes the arguments looking for a settings file or folders to
   serve. The settings file may override options provided on the
   command line and provide folder-specific options."
-  [args options url]
-  (let [file (io/file (or (first args) "settings.edn"))
+  [options url]
+  (let [args (:arguments options)
+        file (io/file (or (first args) "settings.edn"))
         dirs (if (seq args) args (list (default-folder)))]
     (process-settings file dirs options url)))

 (defn start
   "Starts all of the components, returning the Jetty web server."
-  [args options]
+  [options]
   (let [fmt (-> options :format keyword)
         size (-> options :size str keyword)
         url (host-url (:port options))
-        [folders options] (process-args args options url)]
+        [folders options] (process-args options url)]
     (start-processing (:encode options) (:fetch options) fmt size)
     (start-watcher folders)
     (let [server (start-server url (:port options) (app url folders) folders)]
@@ -186,5 +187,5 @@
       (:help options) (exit 0 (usage summary))
       errors (exit 1 (str/join \newline errors)))
     (set-log-level (:log-level options))
-    (.join (start args options))))
+    (.join (start options))))


add filterer option to sitemap task

add filterer option to sitemap task

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -284,21 +284,22 @@

 (def ^:private +sitemap-defaults+
   {:filename "sitemap.xml"
+   :filterer :content
    :target "public"})

 (deftask sitemap
   "Generate sitemap"
   [f filename FILENAME str "generated sitemap filename"
+   f filterer FILTER   code "filter function"
    o target   OUTDIR   str "the output directory"
    u url      URL      str "base URL"]
   (let [pod     (create-pod sitemap-deps)
         tmp     (boot/tmp-dir!)
         options (merge +sitemap-defaults+ *opts*)]
     (boot/with-pre-wrap fileset
-      (let [files         (perun/get-meta fileset)
-            content-files (filter :content files)]
+      (let [files (filter (:filterer options) (perun/get-meta fileset))]
         (pod/with-call-in @pod
-          (io.perun.sitemap/generate-sitemap ~(.getPath tmp) ~content-files ~options))
+          (io.perun.sitemap/generate-sitemap ~(.getPath tmp) ~files ~options))
         (commit fileset tmp)))))

 (def ^:private rss-deps


~truncate? ~println?: use dynamically defined

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -14,9 +14,9 @@
 (def ^:const branch? #(let [result (= 0 (rand-int (+ % branching-factor)))]
                         (log/debug (str "branch at: " % "? => " result))
                         result))
-(def ^:const truncate? true)
-(def ^:const println? false)
-(def ^:const use-spec-cache? true)
+(def ^:dynamic truncate? false)
+(def ^:dynamic println? false)
+(def ^:dynamic use-spec-cache? true)
 (declare gen)
 (declare get-lexemes)
 (declare grow)
@@ -43,7 +43,9 @@
   ;;
   ;; A convenient wrapper around (defn gen) (below).

-  (log/debug (str "(generate) with model named: " (:name language-model)))
+  (log/info (str "(generate) with model named: " (:name language-model) "; "
+                 "truncate? " truncate? "; "
+                 "use-spec-cache? " use-spec-cache?))
   (first (gen spec language-model)))

 (defn gen


improve comment

improve comment

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -91,11 +91,11 @@
   ;;   And then all trees of head-depth=2 that satisfy the spec:
   ;;
   ;;
-  ;;       H            H
-  ;;      / \          / \
-  ;;  .. H   C  ..    H   H ..
-  ;;    /            / \
-  ;;   H            C   H
+  ;;       H           H
+  ;;      / \         / \
+  ;;  .. H   C  ..   C   H ..
+  ;;    /               / \
+  ;;   H               C   H
   ;;
   ;; And so on.
   ;;


~(defn add-comps-to-blt): s/assoc-in/assoc-in!/

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -199,7 +199,7 @@
        ;; add each member _each_comp_ of this set to _bolt_:
        (map (fn [each-comp]
               (let [result
-                    (dag_unify.core/assoc-in bolt path each-comp)]
+                    (dag_unify.core/assoc-in! bolt path each-comp)]
                 (->
                  result
                  ((fn [tree]


this makes the tests too slow, but you can use 'cake test -r' to achieve the same thing.

Revert "always run tests in a fresh classloader"

This reverts commit e68240045291aecffb9eb174b7851aecb4215202.

--- src/cake/tasks/test.clj
+++ src/cake/tasks/test.clj
@@ -1,6 +1,5 @@
 (ns cake.tasks.test
   (:use cake cake.core
-        [cake.project :only [with-classloader]]
         [bake.find-namespaces :only [find-namespaces-in-dir]])
   (:import [java.io File]))

@@ -14,13 +13,12 @@
                 (map read-string args)))))

 (defn run-project-tests [& opts]
-  (with-classloader []
-    (bake (:use bake.test
-                [bake.core :only [with-context]])
-      [namespaces (find-namespaces-in-dir (java.io.File. "test"))
-       opts       (merge (test-opts) (apply hash-map opts))]
-      (with-context :test
-        (run-project-tests namespaces opts)))))
+  (bake (:use bake.test
+              [bake.core :only [with-context]])
+    [namespaces (find-namespaces-in-dir (java.io.File. "test"))
+     opts       (merge (test-opts) (apply hash-map opts))]
+    (with-context :test
+      (run-project-tests namespaces opts))))

 (deftask test #{compile-java}
   "Run project tests."


Add JoinSemiLattice protocol.

Add JoinSemiLattice protocol.

--- src/cats/protocols.cljc
+++ src/cats/protocols.cljc
@@ -102,3 +102,9 @@
 (defprotocol MonadTrans
   "A monad transformer abstraction."
   (-lift [m mv] "Lift a value from the parameterized monad to the transformer."))
+
+;; More info: http://en.wikipedia.org/wiki/Semilattice
+
+(defprotocol JoinSemiLattice
+  "A algebraic structure with element joins."
+  (-join [_ other] "Converge two data structures."))


Parametrized server-conn-loop with optional make-lane-fn.

--- src/cbfg/world/net.cljs
+++ src/cbfg/world/net.cljs
@@ -9,11 +9,12 @@
             [cbfg.world.lane]
             [cbfg.world.base :refer [replay-cmd-ch world-cmd-loop start-test]]))

-(defn server-conn-loop [actx server-send-ch server-recv-ch close-server-recv-ch]
+(defn server-conn-loop [actx server-send-ch server-recv-ch close-server-recv-ch &
+                        {:keys [make-lane-fn]
+                         :or {make-lane-fn cbfg.world.lane/make-fenced-pump-lane}}]
   (let [lanes-in-ch (achan actx)
         lanes-out-ch (achan actx)]
-    (cbfg.lane/make-lane-pump actx lanes-in-ch lanes-out-ch
-                              cbfg.world.lane/make-fenced-pump-lane)
+    (cbfg.lane/make-lane-pump actx lanes-in-ch lanes-out-ch make-lane-fn)
     (act-loop lanes-in actx [num-ins 0]
               (let [msg (atake lanes-in server-recv-ch)]
                 (aput lanes-in lanes-in-ch msg)


log update intervals

log update intervals

--- src/otto/app.clj
+++ src/otto/app.clj
@@ -1,17 +1,18 @@
 (ns otto.app
-  (:require [otto.config        :as config]
-            [otto.github        :as github]
-            [otto.repositories  :as repos]
-            [otto.user          :as user]
-            [otto.web           :as web]
-            [clojure.core.async :as async :refer [<!! thread timeout]]
-            [ring.adapter.jetty :as jetty :refer :all])
+  (:require [clojure.tools.logging :as logger]
+            [otto.config           :as config]
+            [otto.github           :as github]
+            [otto.repositories     :as repos]
+            [otto.web              :as web]
+            [clojure.core.async    :as async :refer [<!! thread timeout]]
+            [ring.adapter.jetty    :as jetty :refer :all])
   (:gen-class :main true))

 (defn periodically-update
   [organizations user repositories interval]
   (doseq [o organizations]
     (thread (loop []
+              (logger/debug (format "Updating organization %s" (:name o)))
               (github/fetch-repositories o user #(.update repositories o %))
               (<!! (timeout interval))
               (recur)))))


duplicate ports on tag selection fixed #108

--- src/cljs/swarmpit/component/service/form_ports.cljs
+++ src/cljs/swarmpit/component/service/form_ports.cljs
@@ -9,6 +9,12 @@

 (def cursor [:page :service :wizard :ports])

+(defn- not-suggested?
+  [port]
+  (not
+    (some #(= (:containerPort port)
+              (:containerPort %)) (state/get-value cursor))))
+
 (defn- public-ports-handler
   [{:keys [name tag] :as repository}]
   (handler/get
@@ -17,7 +23,8 @@
                   :repositoryTag  tag}
      :on-success (fn [response]
                    (doseq [port response]
-                     (state/add-item port cursor)))}))
+                     (if (not-suggested? port)
+                       (state/add-item port cursor))))}))

 (defn- dockerhub-ports-handler
   [distribution-id {:keys [name tag] :as repository}]
@@ -27,7 +34,8 @@
                   :repositoryTag  tag}
      :on-success (fn [response]
                    (doseq [port response]
-                     (state/add-item port cursor)))}))
+                     (if (not-suggested? port)
+                       (state/add-item port cursor))))}))

 (defn- registry-ports-handler
   [distribution-id {:keys [name tag] :as repository}]
@@ -37,7 +45,8 @@
                   :repositoryTag  tag}
      :on-success (fn [response]
                    (doseq [port response]
-                     (state/add-item port cursor)))}))
+                     (if (not-suggested? port)
+                       (state/add-item port cursor))))}))

 (defn load-suggestable-ports
   [{:keys [id type] :as distribution} repository]


Remove minor comment.

Remove minor comment.

--- src/vault/data/crypto.clj
+++ src/vault/data/crypto.clj
@@ -39,8 +39,6 @@

 ;; UTILITY FUNCTIONS

-; Crypto functions generally need a blob store to load public keys:
-; load-pubkey :: BlobStore -> HashID -> PGPPublicKey
 (defn load-pubkey
   "Loads a PGP public key from a blob store."
   [store id]


Add test for an async operation with _sleep in the test case.

--- test/cli4clj/test/cli.clj
+++ test/cli4clj/test/cli.clj
@@ -206,19 +206,39 @@
     (is (= "Linking to foo hint test." (.get arr-lst 0)))
     (is (= "" (.get arr-lst 1)))))

+
+
 (deftest async-cmd-not-finished-test
   (let [cli-opts {:cmds {:async-foo {:fn (fn []
                                            (println "Starting...")
-                                           (doto
-                                             (Thread.
-                                               (fn []
-                                                 (sleep 60000)
-                                                 (println "Finished.")))
-                                             (.start))
+                                           (let [tmp-out *out*]
+                                             (doto
+                                               (Thread.
+                                                 (fn []
+                                                   (binding [*out* tmp-out]
+                                                     (sleep 500)
+                                                     (println "Finished."))))
+                                               (.start)))
                                            "Started.")}}}
         test-cmd-input ["async-foo"]
         out-string (test-cli-stdout #(start-cli cli-opts) test-cmd-input)]
     (is (= (expected-string ["Starting..." "\"Started.\""]) out-string))))
+
+(deftest async-cmd-sleep-finished-test
+  (let [cli-opts {:cmds {:async-foo {:fn (fn []
+                                           (println "Starting...")
+                                           (let [tmp-out *out*]
+                                             (doto
+                                               (Thread.
+                                                 (fn []
+                                                   (binding [*out* tmp-out]
+                                                     (sleep 500)
+                                                     (println "Finished."))))
+                                               (.start)))
+                                           "Started.")}}}
+        test-cmd-input ["async-foo" "_sleep 1000"]
+        out-string (test-cli-stdout #(start-cli cli-opts) test-cmd-input)]
+    (is (= (expected-string ["Starting..." "\"Started.\"" "Finished."]) out-string))))


The great thing about having all these tests is that sometimes you can run them

--- test/eulalie/sqs_test.clj
+++ test/eulalie/sqs_test.clj
@@ -33,10 +33,11 @@

 (deftest get-queue-attributes+
   (with-transient-queue
-    (fn [{q :q-url}]
+    (fn [{q :url}]
       (is (:maximum-message-size
-           (sqs!! :get-queue-attributes {:queue-url q
-                                         :attrs [:maximum-message-size]}))))))
+           (sqs!! :get-queue-attributes
+                  {:queue-url q
+                   :attrs [:maximum-message-size]}))))))

 (defn send-message* [queue & [attrs]]
   (sqs!! :send-message
@@ -87,11 +88,6 @@
                 :different   [:string "fourteen"]}
                (:attrs msg)))))))

-(deftest list-queues+
-  (let [url  (create-queue*)
-        urls (into #{} (sqs!! :list-queues {}))]
-    (is (urls url))))
-
 (defn receive-message* [q-url]
   (sqs!! :receive-message {:queue-url q-url :wait-time-seconds 2}))

@@ -107,12 +103,13 @@
         (is (succeeded "0"))))))

 (deftest delete-message-batch+error
-  (let [q-url (create-queue*)
-        {:keys [failed]}
-        (sqs!! :delete-message-batch
-               {:queue-url q-url
-                :messages [{:id "0" :receipt-handle "garbage"}]})]
-    (is (failed "0"))))
+  (with-transient-queue
+    (fn [{q-url :url}]
+      (let [{:keys [failed]}
+            (sqs!! :delete-message-batch
+                   {:queue-url q-url
+                    :messages [{:id "0" :receipt-handle "garbage"}]})]
+        (is (failed "0"))))))

 (deftest send-message-batch+
   (with-transient-queue


Fix for purging old data files

Fix for purging old data files

--- src/saa/core.clj
+++ src/saa/core.clj
@@ -60,21 +60,22 @@
 (defn cleanup
   "Delete datafiles older than 30 minutes"
   []
-  (let [dir (io/file ".")
+  (let [dir (io/file "/tmp/.")
         files (.listFiles dir)
-        datafiles (filter #(re-find #"^weatherdata-.+xml$" (.getName %)) files) ]
-    (map (fn [x]
-           (when
-               (olderthan x 1800000)
-             (.delete x)))
-         datafiles)))
+        datafiles (filter #(re-find #"^weatherdata-.+xml$" (.getName %)) files)]
+    (doall
+     (map (fn [x]
+            (when
+                (olderthan x 1800000)
+              (.delete x)))
+          datafiles))))

 (defn -main
   [& args]
   (let [climap (parse-opts args cli-options)
         cliopts (:options climap)
         measurement (str "mts-1-1-" (:measurement cliopts))
-        filename (str "weatherdata-" (:location cliopts) ".xml")
+        filename (str "/tmp/weatherdata-" (:location cliopts) ".xml")
         datauri (str "http://data.fmi.fi/fmi-apikey/"
                      (apikey (config))
                      "/wfs?request=getFeature&storedquery_id=fmi::forecast::hirlam::surface::point::timevaluepair&place="


Actually assert something about the error

--- test/icecap/rest_test.clj
+++ test/icecap/rest_test.clj
@@ -6,7 +6,8 @@
             [icecap.rest :as rest]
             [icecap.store.mem :refer [mem-store]]
             [ring.mock.request :as mock]
-            [clojure.tools.reader.edn :as edn]))
+            [clojure.tools.reader.edn :as edn]
+            [icecap.e2e.common :refer [get-body]]))

 (def handler
   (let [[seed-key salt] (map crypto/nul-byte-array
@@ -36,6 +37,9 @@
               (is (valid-headers? headers))))
   (testing "creating cap with bogus plan results in useful errors"
     (let-flow [req (create-cap-req {:type :bogus})
-               {status :status headers :headers} (handler req)]
+               {status :status headers :headers :as res} (handler req)
+               body (get-body res)]
               (is (= status 400))
-              (is (valid-headers? headers)))))
+              (is (valid-headers? headers))
+              (is (= body
+                     '{:error {:type (not (#{:http :succeed :delay} :bogus))}})))))


Use fancy destructuring

Use fancy destructuring

--- test/icecap/rest_test.clj
+++ test/icecap/rest_test.clj
@@ -34,12 +34,12 @@
     (is (some? (handler (mock/request :get "/")))))
   (testing "creating cap with valid plan succeeds"
     (let-flow [req (create-cap-req {:type :succeed})
-               {status :status headers :headers} (handler req)]
+               {:keys [status headers]} (handler req)]
               (is (= status 201))
               (is (valid-headers? headers))))
   (testing "creating cap with bogus plan results in useful errors"
     (let-flow [req (create-cap-req {:type :bogus})
-               {status :status headers :headers :as res} (handler req)
+               {:keys [status headers] :as res} (handler req)
                body (get-body res)]
               (is (= status 400))
               (is (valid-headers? headers))


Reflow

Reflow

--- test/icecap/test_data.clj
+++ test/icecap/test_data.clj
@@ -2,7 +2,8 @@

 (defn success-step
   [name]
-  {:type :succeed :name name})
+  {:type :succeed
+   :name name})

 (def simple-http-step
   {:type :http :url "http://example.test"})


Adding config update for mqtt (#174)

Adding config update for mqtt (#174)

--- spaconclj/spacon/src/spacon/components/form.clj
+++ spaconclj/spacon/src/spacon/components/form.clj
@@ -6,8 +6,11 @@
             [spacon.models.form :as formmodel]
             [spacon.components.mqtt :as mqttapi]
             [clojure.spec :as s]
-            [clojure.data.json :as json])
-  (:import java.net.URLDecoder))
+            [spacon.components.mqtt :as mqttapi]
+            [clojure.data.json :as json]
+            [spacon.entity.scmessage :as scm])
+  (:import java.net.URLDecoder
+           (com.boundlessgeo.spatialconnect.schema SCCommand)))

 (defn http-get-all-forms
   ;; todo: get all the forms for all the teams that the calling user belongs to
@@ -28,13 +31,15 @@

 (defn http-create-form
   "Creates a new form."
-  [request]
+  [mqtt request]
   (let [body    (get-in request [:json-params])
         team-id (:team_id body)
         form    (assoc  body :team_id team-id)]
       (if (s/valid? :spacon.models.form/spec form)
         (let [new-form (formmodel/add-form-with-fields! form)]
-             (response/ok (formmodel/sanitize new-form)))
+          (mqttapi/publish-scmessage mqtt "/config/update" (scm/map->SCMessage {:action (.value SCCommand/CONFIG_ADD_FORM)
+                                                                                :payload new-form}))
+          (response/ok (formmodel/sanitize new-form)))
         (response/bad-request (str "failed to create form:" (s/explain-str :spacon.models.form/spec form))))))

 (defn delete-form-by-id
@@ -43,10 +48,11 @@

 (defn http-delete-form-by-key
   "Deletes all forms matching the form-key"
-  [request]
+  [mqtt request]
   (let [form-key (URLDecoder/decode (get-in request [:path-params :form-key]))
         forms    (formmodel/find-by-form-key form-key)]
     (doall (map delete-form-by-id forms))
+    (mqttapi/publish-scmessage mqtt "/config/update" (scm/map->SCMessage {:action (.value SCCommand/CONFIG_REMOVE_FORM)}))
     (response/ok (str "Deleted form " form-key))))

 (defn http-submit-form-data
@@ -70,10 +76,10 @@
         device-identifier (:client (:metadata form-data))]
     (formmodel/add-form-data form-data form-id device-identifier)))

-(defn- routes []
+(defn- routes [mqtt]
   #{["/api/forms"                :get    (conj common-interceptors `http-get-all-forms)]
-    ["/api/forms"                :post   (conj common-interceptors check-auth `http-create-form)]
-    ["/api/forms/:form-key"      :delete (conj common-interceptors check-auth `http-delete-form-by-key)]
+    ["/api/forms"                :post   (conj common-interceptors check-auth (partial http-create-form mqtt)) :route-name :create-form]
+    ["/api/forms/:form-key"      :delete (conj common-interceptors check-auth (partial http-delete-form-by-key mqtt)) :route-name :delete-form]
     ["/api/forms/:form-key"      :get    (conj common-interceptors check-auth `http-get-form-by-form-key)]
     ;; todo: need to figure out why forms causes a route conflict
     ["/api/form/:form-id/submit"   :post   (conj common-interceptors check-auth `http-submit-form-data) :constraints {:form-id #"[0-9]+"}]
@@ -83,7 +89,7 @@
   component/Lifecycle
   (start [this]
     (mqttapi/subscribe mqtt "/store/form" mqtt->form-submit)
-    (assoc this :routes (routes)))
+    (assoc this :routes (routes mqtt)))
   (stop [this]
     this))


Highlighting the selected steps container number.

--- src-cljs/frontend/components/build_timings.cljs
+++ src-cljs/frontend/components/build_timings.cljs
@@ -1,6 +1,7 @@
 (ns frontend.components.build-timings
   (:require [om.core :as om :include-macros true]
             [goog.string :as gstring]
+            [frontend.datetime :as datetime]
             [frontend.models.build :as build])
   (:require-macros [frontend.utils :refer [html]]))

@@ -74,7 +75,7 @@
   (-> (.axis js/d3.svg)
         (.tickValues (clj->js (range 0 (inc build-duration) (/ build-duration 4))))
         (.scale axis-scale)
-        (.tickFormat time-axis-tick-formatter)
+        (.tickFormat #(str (datetime/as-duration %) "m"))
         (.orient "top"))))

 (defn build-duration [start-time stop-time]
@@ -91,23 +92,46 @@
   {:status  status
    :outcome status})

+
 ;;; Elements of the visualization
+(defn highlight-selected-container! [step-data]
+  (let [fade-value #(if (= (.-textContent %1) (str (aget %2 "index"))) 1 0.1)]
+    (-> (.select js/d3 ".y-axis")
+        (.selectAll ".tick")
+        (.selectAll "text")
+        (.transition)
+        (.duration 200)
+        (.attr "stroke-opacity" #(this-as element (fade-value element step-data)))
+        (.attr "fill-opacity"   #(this-as element (fade-value element step-data))))))
+
+(defn highlight-selected-step! [step selected]
+  (-> step
+      (.selectAll "rect")
+      (.transition)
+      (.duration 200)
+      (.attr "fill-opacity" #(this-as element (if (= element selected) 1 0.5)))))
+
+(defn reset-selected! [step]
+  ;reset all the steps
+  (-> step
+      (.selectAll "rect")
+      (.transition)
+      (.duration 500)
+      (.attr "fill-opacity" 1))
+
+  ;reset all container labels
+  (-> (.select js/d3 ".y-axis")
+      (.selectAll ".tick")
+      (.selectAll "text")
+      (.transition)
+      (.duration 200)
+      (.attr "stroke-opacity" 1)
+      (.attr "fill-opacity"   1)))
+
 (defn draw-containers! [x-scale step]
   (let [step-length         #(- (scaled-time x-scale % "end_time")
                                 (scaled-time x-scale % "start_time"))
-        step-start-pos      #(x-scale (js/Date. (aget % "start_time")))
-        highlight-selected! (fn [_] (this-as
-                                      selected
-                                      (-> step
-                                          (.selectAll "rect")
-                                          (.transition)
-                                          (.duration 200)
-                                          (.attr "fill-opacity" #(this-as element (if (= element selected) 1 0.5))))))
-        reset-selected!    #(-> step
-                                (.selectAll "rect")
-                                (.transition)
-                                (.duration 500)
-                                (.attr "fill-opacity" 1))]
+        step-start-pos      #(x-scale (js/Date. (aget % "start_time")))]
     (-> step
         (.selectAll "rect")
           (.data #(aget % "actions"))
@@ -118,8 +142,10 @@
             (.attr "height"    container-bar-height)
             (.attr "y"         container-position)
             (.attr "x"         step-start-pos)
-            (.on   "mouseover" highlight-selected!)
-            (.on   "mouseout"  reset-selected!)
+            (.on   "mouseover" #(this-as selected
+                                         (highlight-selected-step! step selected)
+                                         (highlight-selected-container! %)))
+            (.on   "mouseout"  #(reset-selected! step))
           (.append "title")
             (.text #(gstring/format "%s (%s)" (aget % "name") (aget % "index"))))))


Pass through data-external into link button

--- src-cljs/frontend/components/pieces/button.cljs
+++ src-cljs/frontend/components/pieces/button.cljs
@@ -28,7 +28,7 @@
   :on-click     - A function called when the link is clicked.
   :primary?     - If true, the link appears as a primary button. (default: false)
   :size         - The size of the button. One of #{:full :medium}. (default: :full)"
-  [{:keys [class href on-click primary? size] :or {size :full}} content]
+  [{:keys [class href on-click primary? size data-external] :or {size :full}} content]
   (component
     (html
      [:a.exception
@@ -37,6 +37,7 @@
                             (case size
                               :full nil
                               :medium "medium")])
+       :data-external data-external
        :href href
        :on-click on-click}
       content])))


Update component docs

Update component docs

--- src-cljs/frontend/components/pieces/button.cljs
+++ src-cljs/frontend/components/pieces/button.cljs
@@ -24,10 +24,12 @@
 (defn link
   "A link styled as a button.

-  :href         - The link target.
-  :on-click     - A function called when the link is clicked.
-  :primary?     - If true, the link appears as a primary button. (default: false)
-  :size         - The size of the button. One of #{:full :medium}. (default: :full)"
+  :class         - Additional CSS classes to be applied to the button.
+  :data-external - For links that shouldn't render in place. To be used with frontend.utils.html/open-ext.
+  :href          - The link target.
+  :on-click      - A function called when the link is clicked.
+  :primary?      - If true, the link appears as a primary button. (default: false)
+  :size          - The size of the button. One of #{:full :medium}. (default: :full)"
   [{:keys [class href on-click primary? size data-external] :or {size :full}} content]
   (component
     (html


core.async: Tidy ns form.

core.async: Tidy ns form.

--- test/com/nomistech/clojure_the_language/core_async_101_basics.clj
+++ test/com/nomistech/clojure_the_language/core_async_101_basics.clj
@@ -1,6 +1,7 @@
 (ns com.nomistech.clojure-the-language.core-async-101-basics
-  (:require ;; [com.nomistech.clojure-the-language.core-async-101-basics :refer :all]
-   [clojure.core.async :as async :refer :all
+  (:require
+   ;; [com.nomistech.clojure-the-language.core-async-101-basics :refer :all]
+   [clojure.core.async :as a :refer :all
     :exclude [map into reduce merge partition partition-by take]]
    [midje.sweet :refer :all]))


$BOOT can be directory or bootfile

$BOOT can be directory or bootfile

- if bootfile, set [:boot :system :cwd] to parent
- if directory, set [:boot :system :bootfile] to $BOOT/boot.clj

--- src/tailrecursion/boot.clj
+++ src/tailrecursion/boot.clj
@@ -12,7 +12,8 @@
           :directories #{}
           :repositories #{}
           :system {:jvm-opts (vec (.. ManagementFactory getRuntimeMXBean getInputArguments))
-                   :cwd (System/getProperty "user.dir")}
+                   :bootfile (io/file (System/getProperty "user.dir") "boot.clj")
+                   :cwd      (io/file (System/getProperty "user.dir"))}
           :pomegranate {:installed #{}}}})

 (def env (atom base-env))
@@ -58,11 +59,18 @@
 (defn dispatch-cli []
   (dispatch/dispatch-cli @env *command-line-args*))

+(defn chroot?! []
+  (when-let [boot (io/file (System/getenv "BOOT"))]
+    (let [bootfile (if (.isDirectory boot) (io/file boot "boot.clj") boot)
+          cwd (if (.isDirectory boot) boot (.getParentFile boot))]
+      (swap! env update-in [:boot :system] merge {:bootfile bootfile :cwd cwd}))))
+
 (defn -main [& args]
+  (chroot?!)
   (tmp/create-registry!)
   (binding [*command-line-args* args
             *ns* (create-ns 'user)
             *data-readers* {'boot/configuration #'configure}]
     (alias 'tmp 'tailrecursion.boot.tmpregistry)
     (alias 'boot 'tailrecursion.boot)
-    (load-file (or (System/getenv "BOOT") "boot.clj"))))
+    (-> @env (get-in [:boot :system :bootfile]) .getAbsolutePath load-file)))


least janky so far

least janky so far

--- spinning/src/app/core.cljs
+++ spinning/src/app/core.cljs
@@ -259,18 +259,21 @@

 (defn step-chan [cells]
   "Returns a channel containing a single map of the next generation of cells."
-  (console/time-start "Build Neighborhood")
-  (let [generation   (chan 1 (keep (partial cell-fate cells)))
-        neighborhood (mapcat neighbors (keys cells))]
-    (console/time-end "Build Neighborhood")
-    (go
+  (go
+    (console/time-start "neighborhood")
+    (let [generation (chan 1 (keep (partial cell-fate cells)))
+          neighborhood (mapcat neighbors (keys cells))]
+      (console/time-end "neighborhood")
       (console/time-start "cell-neighbor-freq")
       (let [cell-neighbor-freq (frequencies neighborhood)]
         (console/time-end "cell-neighbor-freq")
+        ;(<! (timeout 0))
         (<! (yield))
+        (console/time-start "onto-chan generation")
+        (onto-chan generation cell-neighbor-freq)
+        (console/time-end "onto-chan generation")
         ;(<! (timeout 0))
-        (onto-chan generation cell-neighbor-freq)
-        ;(<! (timeout 0))
+        (<! (yield))
         (<! (async/into {} generation))))))

 (defn setup-gol! []


Use doto idiom for populate formdata object.

--- src/uxbox/repo/images.cljs
+++ src/uxbox/repo/images.cljs
@@ -47,14 +47,12 @@

 (defmethod request :create/image
   [_ {:keys [coll id files] :as body}]
-  (let [build-body (fn []
-                     (let [data (js/FormData.)]
-                       (.append data "file" (aget files 0))
-                       (.append data "id" id)
-                       data))
+  (let [body (doto (js/FormData.)
+               (.append "file" (aget files 0))
+               (.append "id" id))
         params {:url (str url "/library/images/" coll)
                 :method :post
-                :body (build-body)}]
+                :body body}]
     (send! params)))

 (defmethod request :delete/image


use V1 routes for GH objects

use V1 routes for GH objects

--- src-cljs/frontend/api.cljs
+++ src-cljs/frontend/api.cljs
@@ -74,9 +74,15 @@
                                   limit builds-per-page}}]
   (let [url (cond admin "/api/v1/admin/recent-builds"
                   deployments "/api/v1/admin/deployments"
-                  branch (gstring/format "/api/dangerzone/project/%s/%s/%s/tree/%s" (routes/->lengthen-vcs vcs_type) org repo branch)
-                  repo (gstring/format "/api/dangerzone/project/%s/%s/%s" (routes/->lengthen-vcs vcs_type) org repo)
-                  org (gstring/format "/api/v1/organization/%s" org)
+                  branch (case vcs_type
+                           "github" (gstring/format "/api/v1/project/%s/%s/tree/%s" org repo branch)
+                           "bitbucket" (gstring/format "/api/dangerzone/project/%s/%s/%s/tree/%s" vcs_type org repo branch))
+                  repo (case vcs_type
+                         "github" (gstring/format "/api/v1/project/%s/%s" org repo)
+                         "bitbucket" (gstring/format "/api/dangerzone/project/%s/%s/%s" vcs_type org repo))
+                  org (case vcs_type
+                        "github" (gstring/format "/api/v1/organization/%s" org)
+                        "bitbucket" (gstring/format "/api/dangerzone/organization/%s/%s" vcs_type org))
                   :else "/api/v1/recent-builds")]
     (str url "?" (sec/encode-query-params (merge {:shallow true
                                                   :offset offset