clean up `cljs.closure/add-dependencies`

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -531,25 +531,29 @@
   a new sequence of IJavaScript objects which includes the input list
   plus all dependencies in dependency order."
   [opts & inputs]
-  (let [requires (mapcat deps/-requires inputs)
+  (let [requires      (mapcat deps/-requires inputs)
         required-cljs (remove (set inputs) (cljs-dependencies opts requires))
-        required-js (js-dependencies opts (set (concat (mapcat deps/-requires required-cljs) requires)))
-        provided (mapcat deps/-provides (concat inputs required-cljs required-js))
-        unprovided (clojure.set/difference (set requires) (set provided) #{"constants-table"})]
+        required-js   (js-dependencies opts (set (concat (mapcat deps/-requires required-cljs) requires)))
+        provided      (mapcat deps/-provides (concat inputs required-cljs required-js))
+        unprovided    (clojure.set/difference (set requires) (set provided) #{"constants-table"})]
     (when (seq unprovided)
       (ana/warning :unprovided @env/*compiler* {:unprovided (sort unprovided)}))
-    (cons (javascript-file nil (deps/goog-resource "goog/base.js") ["goog"] nil)
-          (deps/dependency-order
-           (concat (map #(-> (javascript-file (:foreign %)
-                                              (or (:url %) (io/resource (:file %)))
-                                              (:provides %)
-                                              (:requires %))
-                             (assoc :group (:group %))) required-js)
-                   [(when (-> @env/*compiler* :opts :emit-constants)
-                      (let [url (deps/to-url (str (util/output-directory opts) "/constants_table.js"))]
-                        (javascript-file nil url url ["constants-table"] ["cljs.core"] nil nil)))]
-                   required-cljs
-                   inputs)))))
+    (cons
+      (javascript-file nil (deps/goog-resource "goog/base.js") ["goog"] nil)
+      (deps/dependency-order
+        (concat
+          (map
+            (fn [{:keys [foreign url file provides requires group]}]
+              (let [url (or url (io/resource file))]
+                (assoc
+                  (javascript-file foreign url provides requires)
+                  :group group)))
+            required-js)
+          [(when (-> @env/*compiler* :opts :emit-constants)
+             (let [url (deps/to-url (str (util/output-directory opts) "/constants_table.js"))]
+               (javascript-file nil url url ["constants-table"] ["cljs.core"] nil nil)))]
+          required-cljs
+          inputs)))))

 (defn preamble-from-paths [paths]
   (when-let [missing (seq (remove io/resource paths))]


CLJS-811: use the correct class loader in cljs.js-deps/goog-resource

--- src/clj/cljs/js_deps.clj
+++ src/clj/cljs/js_deps.clj
@@ -230,7 +230,7 @@
     (filter
       (fn [res]
         (re-find #"(\/google-closure-library-0.0*|\/google-closure-library\/)" (.getPath res)))
-      (enumeration-seq (.getResources (ClassLoader/getSystemClassLoader) path)))))
+      (enumeration-seq (.getResources (.getContextClassLoader (Thread/currentThread)) path)))))

 (defn goog-dependencies*
   "Create an index of Google dependencies by namespace and file name."


fix :invalid -> ::invalid

fix :invalid -> ::invalid

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -1092,7 +1092,7 @@
                                 (not (<= (c/or min-count 0)
                                          (bounded-count (if max-count (inc max-count) min-count) x)
                                          (c/or max-count Integer/MAX_VALUE)))))
-                   :invalid
+                   ::invalid

                    :else
                    (if (indexed? x)


add stream helper functions

add stream helper functions

--- src/clj_docker/utils.clj
+++ src/clj_docker/utils.clj
@@ -1,12 +1,16 @@
-(ns clj-docker.utils)
+(ns clj-docker.utils
+  (:require [cheshire.core :as json]
+            [clojure.java.io :as io]))

 (defn map-keys [f m]
   (into {} (map (fn [[a b]] [(f a) b]) m)))

-(defn ^bytes read-bytes [stream n]
-  (let [buf (byte-array n)]
-    (.read stream buf 0 n)
-    buf))
+(defn read-bytes [stream n]
+  (let [buf (byte-array n)
+        res (.read stream buf 0 n)]
+    (if (neg? res)
+      nil
+      buf)))

 (defn ^BigInteger bytes->int
   [^bytes bs & {:keys [little-endian]
@@ -17,9 +21,38 @@
 (defn bytes->string [bs]
   (apply str (map char bs)))

+(defn int->stream-type [n]
+  (case n
+    0 :stdin
+    1 :stdout
+    2 :stderr
+    :unrecognized))
+
 (defn raw-stream->map [stream]
   (let [[stream-type _ _ _] (vec (read-bytes stream 4))
         size (bytes->int (read-bytes stream 4))
         body (bytes->string (read-bytes stream size))]
-    {:stream-type stream-type
+    {:stream-type (int->stream-type stream-type)
      :body body}))
+
+(defn raw-stream-fetcher [stream stream-cb]
+  (loop [header (read-bytes stream 4)]
+    (when-not (nil? header)
+      (let [[stream-type _ _ _] (vec header)
+           size (bytes->int    (read-bytes stream 4))
+           body (bytes->string (read-bytes stream size))]
+       (do
+         (stream-cb {:stream-type (int->stream-type stream-type)
+                     :body body})
+         (recur (read-bytes stream 4)))))))
+
+(defn json-stream-fetcher [stream stream-cb & {:keys [as] :or [as :json]}]
+  (with-open [r (io/reader stream)]
+    (loop [line (.readLine r)]
+      (when-not (nil? line)
+        (do
+          (stream-cb (case as
+                      :string line
+                      :json (json/decode line)
+                      line))
+          (recur (.readLine r)))))))


Introduce api-request function to separate request creation from api call.

--- src/clj_spotify/core.clj
+++ src/clj_spotify/core.clj
@@ -80,32 +80,40 @@
       convert-values))

 (defn select-params-type
-  "Return either :query-params or :form-params key depending on value of verb"
-  [verb]
+  "Return either :query-params or :form-params key depending on value of method"
+  [method]
   (if
-    (or (= verb client/put) (= verb client/post))
+    (or (= method :put) (= method :post))
     :form-params
     :query-params))

+(defn api-request
+  "Returns a request map for a particular api call."
+  [method endpoint params-spec m t]
+  (let [query-params {(select-params-type method) (modify-form-params m)
+                      :oauth-token t
+                      :content-type :json}
+        url (replace-url-values m (str spotify-api-url endpoint))]
+    (-> (try
+          (client/check-url! url)
+          (merge query-params {:method method :url url})
+          (catch Exception e (ex-data e))))))
+
 (defn spotify-api-call
   "Returns a function that takes a map m and an optional oauth-token t as arguments."
-  [verb endpoint]
+  [method endpoint & {:keys [params-spec]}]
   (fn f
     ([m] (f m nil))
     ([m t]
-     (let [query-params {(select-params-type verb) (modify-form-params m)
-                         :oauth-token t
-                         :content-type :json}
-           url (str spotify-api-url endpoint)]
-       (-> (try
-             (verb (replace-url-values m url) query-params)
-             (catch Exception e (ex-data e)))
-           (response-to-map))))))
-
-(def api-get    (partial spotify-api-call client/get))
-(def api-post   (partial spotify-api-call client/post))
-(def api-put    (partial spotify-api-call client/put))
-(def api-delete (partial spotify-api-call client/delete))
+     (-> (try
+           (client/request (api-request method endpoint params-spec m t))
+           (catch Exception e (ex-data e)))
+         (response-to-map)))))
+
+(def api-get    (partial spotify-api-call :get))
+(def api-post   (partial spotify-api-call :post))
+(def api-put    (partial spotify-api-call :put))
+(def api-delete (partial spotify-api-call :delete))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Improve `cljam.bam.reader/read-alignment` using ByteBuffer

--- src/cljam/bam/reader.clj
+++ src/cljam/bam/reader.clj
@@ -136,34 +136,36 @@

 (defn- read-alignment [^BAMReader bam-reader refs]
   (let [rdr (.data-reader bam-reader)
-        ^Integer block-size (lsb/read-int rdr)]
-    (when (< block-size fixed-block-size)
-      (throw (Exception. (str "Invalid block size:" block-size))))
-    (let [ref-id      (lsb/read-int rdr)
-          rname       (if (= ref-id -1) "*" (:name (nth refs ref-id)))
-          pos         (inc (lsb/read-int rdr))
-          l-read-name (lsb/read-ubyte rdr)
-          mapq        (lsb/read-ubyte rdr)
-          bin         (lsb/read-ushort rdr)
-          n-cigar-op  (lsb/read-ushort rdr)
-          flag        (lsb/read-ushort rdr)
-          l-seq       (lsb/read-int rdr)
-          rnext       (decode-next-ref-id refs (lsb/read-int rdr) rname)
-          pnext       (inc (lsb/read-int rdr))
-          tlen        (lsb/read-int rdr)
-          qname       (lsb/read-string rdr (dec (int l-read-name)))
-          _           (lsb/read-bytes rdr 1)
-          cigar       (decode-cigar (lsb/read-bytes rdr (* n-cigar-op 4)))
-          seq         (decode-seq (lsb/read-bytes rdr (/ (inc l-seq) 2)) l-seq)
-          qual        (decode-qual (lsb/read-bytes rdr l-seq))
-          rest        (lsb/read-bytes rdr (options-size block-size
-                                                        (int l-read-name)
-                                                        n-cigar-op
-                                                        l-seq))
-          options     (parse-options rest)]
-      {:qname qname, :flag flag, :rname rname, :pos pos, :mapq  mapq,
-       :cigar cigar, :rnext rnext, :pnext pnext, :tlen tlen, :seq seq,
-       :qual qual, :options options})))
+        block-size (lsb/read-int rdr)]
+    (when (< block-size fixed-block-size)
+      (throw (Exception. (str "Invalid block size: " block-size))))
+    (let [buffer ^ByteBuffer (ByteBuffer/allocate block-size)]
+      (lsb/read-bytes rdr (.array buffer) 0 block-size)
+      (let [ref-id      (lsb/read-int buffer)
+            rname       (if (= ref-id -1) "*" (:name (nth refs ref-id)))
+            pos         (inc (lsb/read-int buffer))
+            l-read-name (int (lsb/read-ubyte buffer))
+            mapq        (lsb/read-ubyte buffer)
+            bin         (lsb/read-ushort buffer)
+            n-cigar-op  (lsb/read-ushort buffer)
+            flag        (lsb/read-ushort buffer)
+            l-seq       (lsb/read-int buffer)
+            rnext       (decode-next-ref-id refs (lsb/read-int buffer) rname)
+            pnext       (inc (lsb/read-int buffer))
+            tlen        (lsb/read-int buffer)
+            qname       (lsb/read-string buffer (dec l-read-name))
+            _           (lsb/skip buffer 1)
+            cigar       (decode-cigar (lsb/read-bytes buffer (* n-cigar-op 4)))
+            seq         (decode-seq (lsb/read-bytes buffer (/ (inc l-seq) 2)) l-seq)
+            qual        (decode-qual (lsb/read-bytes buffer l-seq))
+            rest        (lsb/read-bytes buffer (options-size block-size
+                                                             l-read-name
+                                                             n-cigar-op
+                                                             l-seq))
+            options     (parse-options rest)]
+        {:qname qname, :flag flag, :rname rname, :pos pos, :mapq  mapq,
+         :cigar cigar, :rnext rnext, :pnext pnext, :tlen tlen, :seq seq,
+         :qual qual, :options options}))))

 (defn- light-read-alignment [^BAMReader bam-reader refs]
   (let [rdr (.data-reader bam-reader)


separate out request handling from multipart-params middleware

--- ring-core/src/ring/middleware/multipart_params.clj
+++ ring-core/src/ring/middleware/multipart_params.clj
@@ -70,6 +70,20 @@
         func  (load-var store)]
     (func)))

+(defn multipart-params-request
+  "Adds :multipart-params and :params keys to request."
+  [request & [opts]]
+  (let [store    (or (:store opts) (default-store))
+        encoding (or (:encoding opts)
+                     (:character-encoding request)
+                     "UTF-8")
+        params   (if (multipart-form? request)
+                   (parse-multipart-params request encoding store)
+                   {})]
+    (merge-with merge request
+                {:multipart-params params}
+                {:params params})))
+
 (defn wrap-multipart-params
   "Middleware to parse multipart parameters from a request. Adds the
   following keys to the request map:
@@ -88,16 +102,7 @@
                 parameter in the multipart parameter map. The default storage
                 function is the temp-file-store."
   [handler & [opts]]
-  (let [store (or (:store opts)
-                  (default-store))]
-    (fn [request]
-      (let [encoding (or (:encoding opts)
-                         (:character-encoding request)
-                         "UTF-8")
-            params   (if (multipart-form? request)
-                       (parse-multipart-params request encoding store)
-                       {})
-            request  (merge-with merge request
-                                 {:multipart-params params}
-                                 {:params params})]
-        (handler request)))))
+  (fn [request]
+    (-> request
+        (multipart-params-request opts)
+        handler)))


Init data on core init

Init data on core init

--- src/cljs/gtfve/core.cljs
+++ src/cljs/gtfve/core.cljs
@@ -74,5 +74,6 @@
 ;; -------------------------
 ;; Initialize app
 (defn init! []
+  (data/init!)
   (hook-browser-navigation!)
   (reagent/render [current-page] (.getElementById js/document "app")))


stop and play

stop and play

--- src/cljs/mpd/player.cljs
+++ src/cljs/mpd/player.cljs
@@ -70,7 +70,7 @@
     (reset! fire_timer (:delay bullet))
     (js/setTimeout #(reset! fire_timer nil) (:delay bullet))
     (bullets/fire bullet)
-    (js/console.log fire_sound)
+    (.stop fire_sound)
     (.play fire_sound)))

 ; SETUP


Hide "What do others think" in Enterprise.

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -163,14 +163,15 @@
       {:href "/docs/parallel-manual-setup"}
       "control the parallelism directly"]
      "."]]
-   [:div.mini-faq-item
-    [:h3 "What do others think?"]
-    [:blockquote
-     [:i
-      "The thing that sold us on Circle was the speed. Their tests run really really fast. We've never seen that before. One of our developers just pushes to branches so that Circle will run his tests, instead of testing on his laptop. The parallelization just works - we didn't have to tweak anything. Amazing service."]]
-    [:ul
-     [:li [:a {:href "http://zencoder.com/company/"} "Brandon Arbini"]]
-     [:li [:a {:href "http://zencoder.com/"} "Zencoder.com"]]]]])
+   (when-not (config/enterprise?)
+     [:div.mini-faq-item
+      [:h3 "What do others think?"]
+      [:blockquote
+       [:i
+        "The thing that sold us on Circle was the speed. Their tests run really really fast. We've never seen that before. One of our developers just pushes to branches so that Circle will run his tests, instead of testing on his laptop. The parallelization just works - we didn't have to tweak anything. Amazing service."]]
+      [:ul
+       [:li [:a {:href "http://zencoder.com/company/"} "Brandon Arbini"]]
+       [:li [:a {:href "http://zencoder.com/"} "Zencoder.com"]]]])])

 (defn parallel-label-classes [{:keys [plan project] :as project-data} parallelism]
   (concat


change failed text copy (#1938)

change failed text copy (#1938)

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -713,7 +713,7 @@
                                                       (close-fn))
                                        :kind :flat}
                                       "Cancel")
-                       (button/managed-button {:failed-text "Failed"
+                       (button/managed-button {:failed-text "Permission Denied"
                                                :success-text "Imported"
                                                :loading-text "Importing..."
                                                :kind :primary


clear the dashboard between rounds

clear the dashboard between rounds

--- src/client/dashboard.cljs
+++ src/client/dashboard.cljs
@@ -389,7 +389,13 @@
         s (mod total-seconds 60)
         s-str (if (< s 10) (str "0" s) s)
         time-str (str m ":" s-str)]
-    (dom/set-html! "timeLeft" time-str)))
+    (dom/set-html! "timeLeft" time-str))
+
+  ;; clear the ids atom when the round is over
+  ;; NOTE: this is a hack, but it should do the trick to reset ids every round
+  (if (= total-seconds 0)
+    (reset! ids {}))
+  )

 (defn- shuffle-page-state []
   (reset! page-state (shuffle test-state)))


ssh path taken into account

ssh path taken into account

--- src/celestial/launch.clj
+++ src/celestial/launch.clj
@@ -18,6 +18,7 @@
     [clojure.java.io :only (file resource)]
     [celestial.api :only (app)]
     [gelfino.timbre :only (gelf-appender)]
+    [supernal.core :only [ssh-config]]
     [ring.adapter.jetty :only (run-jetty)]
     [celestial.common :only (get* import-logging)]
     [celestial.redis :only (clear-locks)]
@@ -64,6 +65,7 @@
   (add-shutdown)
   (info (slurp (resource "main/resources/celestial.txt")))
   (info "version 0.0.1 see http://celestial-ops.com")
+  (ssh-config {:key (get* :ssh :private-key-path) :user "root"} )
   (jobs/initialize-workers)
   (default-key)
   (run-jetty (app true)


tagged returns from or/alt are now map entries, support 'key' and 'val'

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -385,9 +385,10 @@

   (s/or :even even? :small #(< % 42))

-  Returns a destructuring spec that
-  returns a vector containing the key of the first matching pred and the
-  corresponding value."
+  Returns a destructuring spec that returns a map entry containing the
+  key of the first matching pred and the corresponding value. Thus the
+  'key' and 'val' functions can be used to refer generically to the
+  components of the tagged return."
   [& key-pred-forms]
   (let [pairs (partition 2 key-pred-forms)
         keys (mapv first pairs)
@@ -429,8 +430,10 @@

   (s/alt :even even? :small #(< % 42))

-  Returns a regex op that returns a vector containing the key of the
-  first matching pred and the corresponding value."
+  Returns a regex op that returns a map entry containing the key of the
+  first matching pred and the corresponding value. Thus the
+  'key' and 'val' functions can be used to refer generically to the
+  components of the tagged return"
   [& key-pred-forms]
   (let [pairs (partition 2 key-pred-forms)
         keys (mapv first pairs)
@@ -966,6 +969,8 @@
       (with-gen* [_ gfn] (tuple-impl forms preds gfn))
       (describe* [_] `(tuple ~@forms)))))

+(defn- tagged-ret [tag ret]
+  (clojure.lang.MapEntry. tag ret))

 (defn ^:skip-wiki or-spec-impl
   "Do not call this directly, use 'or'"
@@ -979,7 +984,7 @@
                       (let [ret (dt pred x (nth forms i))]
                         (if (= ::invalid ret)
                           (recur (inc i))
-                          [(keys i) ret])))
+                          (tagged-ret (keys i) ret))))
                     ::invalid)))]
     (reify
      clojure.lang.IFn
@@ -1110,7 +1115,7 @@
         (if (nil? pr)
           (if k1
             (if (accept? p1)
-              (accept [k1 (:ret p1)])
+              (accept (tagged-ret k1 (:ret p1)))
               ret)
             p1)
           ret)))))
@@ -1162,7 +1167,7 @@
           ::pcat (add-ret p0 ret k)
           ::alt (let [[[p0] [k0]] (filter-alt ps ks forms accept-nil?)
                       r (if (nil? p0) ::nil (preturn p0))]
-                  (if k0 [k0 r] r)))))
+                  (if k0 (tagged-ret k0 r) r)))))

 (defn- op-unform [p x]
   ;;(prn {:p p :x x})


perf tweaks

perf tweaks

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -72,7 +72,8 @@
 (defn spec?
   "returns x if x is a spec object, else logical false"
   [x]
-  (c/and (extends? Spec (class x)) x))
+  (when (instance? clojure.spec.Spec x)
+    x))

 (defn regex?
   "returns x if x is a (clojure.spec) regex op, else logical false"
@@ -129,17 +130,13 @@
   (specize* ([s] (specize* (reg-resolve! s)))
             ([s _] (specize* (reg-resolve! s))))

-  clojure.spec.Spec
-  (specize* ([s] s)
-            ([s _] s))
-
   Object
   (specize* ([o] (spec-impl ::unknown o nil nil))
             ([o form] (spec-impl form o nil nil))))

 (defn- specize
-  ([s] (specize* s))
-  ([s form] (specize* s form)))
+  ([s] (c/or (spec? s) (specize* s)))
+  ([s form] (c/or (spec? s) (specize* s form))))

 (defn invalid?
   "tests the validity of a conform return value"
@@ -525,8 +522,19 @@
   See also - coll-of, every-kv
 "
   [pred & {:keys [into kind count max-count min-count distinct gen-max gen] :as opts}]
-  (let [nopts (-> opts (dissoc :gen) (assoc ::kind-form `'~(res (:kind opts))))]
-    `(every-impl '~pred ~pred ~nopts ~gen)))
+  (let [nopts (-> opts (dissoc :gen) (assoc ::kind-form `'~(res (:kind opts))))
+        gx (gensym)
+        cpreds (cond-> [(list (c/or kind `coll?) gx)]
+                       count (conj `(= ~count (bounded-count ~count ~gx)))
+
+                       (c/or min-count max-count)
+                       (conj `(<= (c/or ~min-count 0)
+                                   (bounded-count (if ~max-count (inc ~max-count) ~min-count) ~gx)
+                                   (c/or ~max-count Integer/MAX_VALUE)))
+
+                       distinct
+                       (conj `(c/or (empty? ~gx) (apply distinct? ~gx))))]
+    `(every-impl '~pred ~pred ~(assoc nopts ::cpred `(fn* [~gx] (c/and ~@cpreds))) ~gen)))

 (defmacro every-kv
   "like 'every' but takes separate key and val preds and works on associative collections.
@@ -760,6 +768,10 @@
         keys->specnames #(c/or (k->s %) %)
         id (java.util.UUID/randomUUID)]
     (reify
+     Specize
+     (specize* [s] s)
+     (specize* [s _] s)
+
      Spec
      (conform* [_ m]
                (if (keys-pred m)
@@ -844,6 +856,10 @@
       (ident? pred) (cond-> (the-spec pred) gfn (with-gen gfn))
       :else
       (reify
+       Specize
+       (specize* [s] s)
+       (specize* [s _] s)
+
        Spec
        (conform* [_ x] (let [ret (pred x)]
                          (if cpred?
@@ -877,6 +893,10 @@
                  #(assoc %1 retag %2)
                  retag)]
        (reify
+        Specize
+        (specize* [s] s)
+        (specize* [s _] s)
+
         Spec
         (conform* [_ x] (if-let [pred (predx x)]
                           (dt pred x form)
@@ -914,9 +934,13 @@
   "Do not call this directly, use 'tuple'"
   ([forms preds] (tuple-impl forms preds nil))
   ([forms preds gfn]
-     (let [specs (delay (mapv specize* preds forms))
+     (let [specs (delay (mapv specize preds forms))
            cnt (count preds)]
        (reify
+        Specize
+        (specize* [s] s)
+        (specize* [s _] s)
+
         Spec
         (conform* [_ x]
                   (let [specs @specs]
@@ -1010,6 +1034,10 @@
                                   (tagged-ret (keys i) ret))))
                             ::invalid)))))]
     (reify
+     Specize
+     (specize* [s] s)
+     (specize* [s _] s)
+
      Spec
      (conform* [_ x] (cform x))
      (unform* [_ [k x]] (unform (kps k) x))
@@ -1089,6 +1117,10 @@
                           (recur nret (inc i))))
                       ret)))))]
     (reify
+     Specize
+     (specize* [s] s)
+     (specize* [s _] s)
+
      Spec
      (conform* [_ x] (cform x))
      (unform* [_ x] (reduce #(unform %2 %1) x (reverse preds)))
@@ -1101,6 +1133,10 @@
   "Do not call this directly, use 'merge'"
   [forms preds gfn]
   (reify
+   Specize
+   (specize* [s] s)
+   (specize* [s _] s)
+
    Spec
    (conform* [_ x] (let [ms (map #(dt %1 x %2) preds forms)]
                      (if (some invalid? ms)
@@ -1129,9 +1165,6 @@
      (not (pvalid? pred x))
      (explain-1 kform pred path via in x)

-     (c/and distinct (not (empty? x)) (not (apply distinct? x)))
-     [{:path path :pred 'distinct? :val x :via via :in in}]
-
      (c/and count (not= count (bounded-count count x)))
      [{:path path :pred `(= ~count (c/count ~'%)) :val x :via via :in in}]

@@ -1139,19 +1172,23 @@
             (not (<= (c/or min-count 0)
                      (bounded-count (if max-count (inc max-count) min-count) x)
                      (c/or max-count Integer/MAX_VALUE))))
-     [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}])))
+     [{:path path :pred `(<= ~(c/or min-count 0) (c/count ~'%) ~(c/or max-count 'Integer/MAX_VALUE)) :val x :via via :in in}]
+
+     (c/and distinct (not (empty? x)) (not (apply distinct? x)))
+     [{:path path :pred 'distinct? :val x :via via :in in}])))

 (defn ^:skip-wiki every-impl
   "Do not call this directly, use 'every', 'every-kv', 'coll-of' or 'map-of'"
   ([form pred opts] (every-impl form pred opts nil))
   ([form pred {gen-into :into
-               :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn
+               :keys [kind ::kind-form count max-count min-count distinct gen-max ::kfn ::cpred
                       conform-keys ::conform-all]
                :or {gen-max 20}
                :as opts}
     gfn]
      (let [conform-into gen-into
-           check? #(pvalid? pred %)
+           spec (delay (specize pred))
+           check? #(valid? @spec %)
            kfn (c/or kfn (fn [i v] i))
            addcv (fn [ret i v cv] (conj ret cv))
            cfns (fn [x]
@@ -1178,35 +1215,42 @@

                    :else [#(empty (c/or conform-into %)) addcv identity]))]
        (reify
+        Specize
+        (specize* [s] s)
+        (specize* [s _] s)
+
         Spec
         (conform* [_ x]
-                  (cond
-                   (coll-prob x kind kind-form distinct count min-count max-count
-                              nil nil nil)
-                   ::invalid
-
-                   conform-all
-                   (let [[init add complete] (cfns x)]
-                     (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)]
-                       (if vseq
-                         (let [cv (dt pred v nil)]
-                           (if (invalid? cv)
-                             ::invalid
-                             (recur (add ret i v cv) (inc i) vs)))
-                         (complete ret))))
-
-
-                   :else
-                   (if (indexed? x)
-                     (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))]
-                       (loop [i 0]
-                         (if (>= i (c/count x))
-                           x
-                           (if (check? (nth x i))
-                             (recur (c/+ i step))
-                             ::invalid))))
-                     (c/or (c/and (every? check? (take *coll-check-limit* x)) x)
-                           ::invalid))))
+                  (let [spec @spec]
+                    (cond
+                     (not (cpred x)) ::invalid
+
+                     conform-all
+                     (let [[init add complete] (cfns x)]
+                       (loop [ret (init x), i 0, [v & vs :as vseq] (seq x)]
+                         (if vseq
+                           (let [cv (conform* spec v)]
+                             (if (invalid? cv)
+                               ::invalid
+                               (recur (add ret i v cv) (inc i) vs)))
+                           (complete ret))))
+
+
+                     :else
+                     (if (indexed? x)
+                       (let [step (max 1 (long (/ (c/count x) *coll-check-limit*)))]
+                         (loop [i 0]
+                           (if (>= i (c/count x))
+                             x
+                             (if (valid? spec (nth x i))
+                               (recur (c/+ i step))
+                               ::invalid))))
+                       (let [limit *coll-check-limit*]
+                         (loop [i 0 [v & vs :as vseq] (seq x)]
+                           (cond
+                            (c/or (nil? vseq) (= i limit)) x
+                            (valid? spec v) (recur (inc i) vs)
+                            :else ::invalid)))))))
         (unform* [_ x] x)
         (explain* [_ path via in x]
                   (c/or (coll-prob x kind kind-form distinct count min-count max-count
@@ -1581,6 +1625,10 @@
   "Do not call this directly, use 'spec' with a regex op argument"
   [re gfn]
   (reify
+   Specize
+   (specize* [s] s)
+   (specize* [s _] s)
+
    Spec
    (conform* [_ x]
              (if (c/or (nil? x) (coll? x))
@@ -1630,6 +1678,10 @@
      (valAt [this k] (get specs k))
      (valAt [_ k not-found] (get specs k not-found))

+     Specize
+     (specize* [s] s)
+     (specize* [s _] s)
+
      Spec
      (conform* [_ f] (if (ifn? f)
                        (if (identical? f (validate-fn f specs *fspec-iterations*)) f ::invalid)
@@ -1689,6 +1741,10 @@
   [spec]
   (let [spec (specize spec)]
     (reify
+     Specize
+     (specize* [s] s)
+     (specize* [s _] s)
+
      Spec
      (conform* [_ x] (let [ret (conform* spec x)]
                        (if (invalid? ret)


Added examples to schema.clj to help Aaron's defrecord-ification

--- src/clj/forma/schema.clj
+++ src/clj/forma/schema.clj
@@ -34,6 +34,13 @@
 ;; ## Time Series

 (defn timeseries-value
+  "Takes a period index > 0 `start-idx` and a time series `series`, outputs same plus `end-idx` calculated by counting the number of elements in `series`.
+
+   Example: (timeseries-value 0 [1 2 3])
+
+   {:start-idx 0
+     :end-idx 2
+     :series [1 2 3]}"
   ([start-idx series]
      (let [elems (count series)]
        (timeseries-value start-idx
@@ -47,7 +54,19 @@

 (defn adjust-timeseries
   "Takes in any number of timeseries objects, and returns a new
-  sequence of appropriately truncated TimeSeries objects."
+  sequence of appropriately truncated TimeSeries objects generated from the temporal overlap of the input timeseries objects.
+
+  Example:
+  (schema/adjust-timeseries
+     (schema/timeseries-value 0 [1 2 3])
+     (schema/timeseries-value 1 [1 2 3 4]))
+
+ ({:start-idx 1,
+   :end-idx 2,
+   :series [2 3]}
+  {:start-idx 1,
+   :end-idx 2,
+   :series [1 2]})"
   [& tseries]
   (let [[start & ts-seq] (->> tseries
                               (mapcat (juxt :start-idx :series))
@@ -64,6 +83,14 @@
    :count      "number of fires on the given day."})

 (defn fire-value
+  "Creates a `fire-value` object with counts of fires meeting certain criteria:
+    temp >= 330
+    confidence >= 50
+    both temp and confidence
+    total fires
+
+   Example: (schema/fire-value 1 0 3 4)
+    {:temp-330 1, :conf-50 0, :both-preds 3, :count 4}"
   [t-above-330 c-above-50 both-preds count]
   {:temp-330 t-above-330
    :conf-50 c-above-50
@@ -72,25 +99,49 @@

 (defn extract-fields
   "Returns a vector containing the value of the `temp-330`, `conf-50`,
-  `both-preds` and `count` fields of the supplied fire tuple."
+  `both-preds` and `count` fields of the supplied fire tuple.
+
+   Example: (extract-fields {:temp-330 1, :conf-50 0, :both-preds 3, :count 4})
+    [1 0 3 4]"
+
   [tuple]
   (map tuple [:temp-330 :conf-50 :both-preds :count]))

 (defn add-fires
-  "Returns a new `FireTuple` object generated by summing up the fields
-  of each of the supplied `FireTuple` objects."
+  "Returns a new `fire-value` object generated by summing up the fields
+  of each of the supplied `fire-value` objects.
+
+   Example:
+    (schema/add-fires
+      {:temp-330 1, :conf-50 0, :both-preds 3, :count 4}
+      {:temp-330 1, :conf-50 0, :both-preds 3, :count 4})
+
+    {:count 8, :conf-50 0, :temp-330 2, :both-preds 6}"
   [& f-tuples]
   (apply merge-with + f-tuples))

 (defn adjust-fires
   "Returns the section of fires data found appropriate based on the
-  information in the estimation parameter map."
+  information in the estimation parameter map.
+
+  (let [est-map {:est-start \"2005-12-01\"
+                 :est-end \"2011-04-01\"
+                 :t-res \"32\"
+                 :neighbors 1
+                 :window-dims [600 600]
+                 :vcf-limit 25
+                 :long-block 15
+                 :window 5}
+        f-series []]
+    (adjust-fires est-map f-series)"
+  ;; TODO: add a sample f-series
   [{:keys [est-start est-end t-res]} f-series]
   (let [[start end] (for [pd [est-start est-end]]
                       (date/datetime->period "32" pd))]
     [(->> (:series f-series)
           (u/trim-seq start (inc end) (:start-idx f-series))
           (timeseries-value start))]))
+

 ;; # Compound Objects

@@ -101,6 +152,19 @@
    :t-stat     "t-statistic for the relevant month."})

 (defn forma-value
+  "FORMA object containing various characteristics of pixel timeseries
+
+   Example:
+  (forma-value {:temp-330 1, :conf-50 0, :both-preds 3, :count 4}
+               -2.7
+               -1.2
+               1.725)
+
+  {:fire-value
+    {:count 4, :conf-50 0, :temp-330 1, :both-preds 3},
+   :short-drop -2.7,
+   :long-drop -1.2,
+   :t-stat 1.725}"
   [fire short long t-stat]
   {:fire-value (or fire (fire-value 0 0 0 0))
    :short-drop short
@@ -109,7 +173,16 @@

 (defn unpack-forma-val
   "Returns a vector containing the fire value, short drop,
-  long drop and t-stat fields of the supplied `FormaValue`."
+  long drop and t-stat fields of the supplied `FormaValue`.
+
+  Example:
+  (unpack-forma-val {:fire-value
+                       {:count 4, :conf-50 0, :temp-330 1, :both-preds 3},
+                     :short-drop -2.7,
+                     :long-drop -1.2,
+                     :t-stat 1.725})
+
+  ({:count 4, :conf-50 0, :temp-330 1, :both-preds 3} -2.7 -1.2 1.725)"
   [forma-val]
   (map forma-val [:fire-value :short-drop :long-drop :t-stat]))

@@ -127,6 +200,7 @@

 (defn neighbor-value
   "Accepts either a forma value or a sequence of sub-values."
+  ;; TODO: come up with an example
   ([{:keys [fire-value short-drop long-drop t-stat]}]
      (neighbor-value fire-value 1
                      short-drop short-drop
@@ -143,6 +217,7 @@
       :min-t-stat     min-stat}))

 (defn unpack-neighbor-val
+  ;; TODO: come up with an example
   [neighbor-val]
   (map neighbor-val
        [:fire-value
@@ -159,6 +234,7 @@
   aggregate collection of `FormaValue`s represented by
   `neighbor-val`. (`neighbors` must be an instance of
   neighbor-value)"
+  ;; TODO: come up with an example
   [neighbors forma-val]
   (let [n-count  (:neighbor-count neighbors)
         [fire short long t-stat] (unpack-forma-val forma-val)]
@@ -175,6 +251,7 @@
 (defn combine-neighbors
   "Returns a new forma neighbor value generated by merging together
    each entry in the supplied sequence of forma values."
+  ;; TODO: come up with an example
   [[x & more]]
   (if x
     (reduce merge-neighbors (neighbor-value x) more)
@@ -207,6 +284,9 @@
    :size  "Number of pixels in the chunk."})

 (defn chunk-location
+
+  "Example: (chunk-location \"1000\" 28 9 59 24000)
+    {:spatial-res \"1000\", :mod-h 28, :mod-v 9, :index 59, :size 24000}"
   [spatial-res mod-h mod-v idx size]
   {:spatial-res spatial-res
    :mod-h       mod-h
@@ -222,6 +302,10 @@
    :line  "Line (row) within modis tile."})

 (defn pixel-location
+  "Example:
+    (pixel-location \"1000\" 28 9 1199 10)
+
+    {:spatial-res \"1000\", :mod-h 28, :mod-v 9, :sample 1199, :line 10}"
   [spatial-res mod-h mod-v sample line]
   {:spatial-res spatial-res
    :mod-h       mod-h
@@ -229,12 +313,30 @@
    :sample      sample
    :line        line})

-(defn unpack-pixel-location [loc]
+(defn unpack-pixel-location
+  "Unpacks pixel-location object into a tuple.
+
+
+   Example:
+    (unpack-pixel-location
+     {:spatial-res \"1000\", :mod-h 28, :mod-v 9, :sample 1199, :line 10})
+
+    [\"1000\" 28 9 1199 10]"
+  [loc]
   (map loc [:spatial-res :mod-h :mod-v :sample :line]))

 (defn chunkloc->pixloc
   "Accepts a chunk location and a pixel index within that location and
-  returns a pixel location."
+   returns a pixel location.
+
+  Example:
+   (chunkloc->pixloc
+    {:spatial-res "1000", :mod-h 28, :mod-v 9, :index 59, :size 24000}
+     23999)
+
+   {:spatial-res "1000", :mod-h 28, :mod-v 9, :sample 1199, :line 1199}
+   "
+
   [{:keys [spatial-res size index mod-h mod-v]} pix-idx]
   (apply pixel-location spatial-res mod-h mod-v
          (r/tile-position spatial-res size index pix-idx)))
@@ -242,7 +344,17 @@
 ;; ## Data Chunks

 (defn chunk-value
-  [dataset t-res date location data-value]
+  "Example:
+    (let [size 24000
+          location (chunk-location \"1000\" 8 6 0 24000)
+          data (range size)]
+     (chunk-value \"ndvi\" \"32\" \"2006-01-01\" location (take 10 data))
+
+    {:date \"2006-01-01\"
+     :temporal-res \"32\"
+     :location {:spatial-res \"1000\", :mod-h 8, :mod-v 6, :index 0, :size 24000}     :dataset \"ndvi\"
+     :value [0 1 2 3 4 5 6 7 8 9]}"
+    [dataset t-res date location data-value]
   (let [chunk {:temporal-res t-res
                :location     location
                :dataset      dataset
@@ -252,8 +364,17 @@
       (assoc chunk :date date))))

 (defn unpack-chunk-val
-  "Used by timeseries. Returns `[dataset-name t-res date collection]`,
-   where collection is a vector."
+  "Used by timeseries. Returns `[dataset-name t-res date location collection]`,
+   where collection is a vector and location is a `chunk-location`.
+
+   Example:
+
+  (schema/unpack-chunk-val {:date \"2006-01-01\"
+                            :temporal-res \"32\"
+                            :location {:spatial-res \"1000\", :mod-h 8, :mod-v 6, :index 0, :size 24000}     :dataset \"ndvi\"
+                            :value [0 1 2 3 4 5 6 7 8 9]})
+
+    [\"ndvi\" \"32\" \"2006-01-01\" {:mod-h 8, :size 24000, :mod-v 6, :spatial-res \"1000\", :index 0} [0 1 2 3 4 5 6 7 8 9]"
   [chunk]
   (map chunk [:dataset :temporal-res :date :location :value]))


Improve alerting message.

Improve alerting message.

--- src/clj/medusa/alert.clj
+++ src/clj/medusa/alert.clj
@@ -11,7 +11,7 @@
       (ses/send-email :destination {:to-addresses destinations}
                       :source "telemetry-alerts@mozilla.com"
                       :message {:subject subject
-                                :body {:text body}}))))
+                                :body {:html (str "" body "")}}))))

 (defn notify-subscribers [{:keys [metric_id date emails]}]
   (let [{:keys [hostname port]} @config/state
@@ -21,7 +21,7 @@
          metric_id :id} (db/get-metric metric_id)
         {detector_name :name} (db/get-detector detector_id)
         subscribers (db/get-subscribers-for-metric metric_id)]
-    (send-email (str "Alert for " metric_name " (" detector_name ")")
-                (str hostname ":" port "/index.html#/detectors/" detector_id "/"
+    (send-email (str "Alert for " metric_name " (" detector_name ") on the " date)
+                (str "http://" hostname ":" port "/index.html#/detectors/" detector_id "/"
                      "metrics/" metric_id "/alerts/?from=" date "&to=" date)
                 (concat subscribers foreign_subscribers ["dev-telemetry-alerts@lists.mozilla.org"]))))


add missing logic to import transfers

add missing logic to import transfers

--- src/clj_money/import.clj
+++ src/clj_money/import.clj
@@ -140,7 +140,7 @@
     (trading/buy (:storage context) purchase))
   context)

-; This is maybe to specific to GnuCash. It would be better if the
+; This is maybe too specific to GnuCash. It would be better if the
 ; gnucash namespace did these lookups
 (defn- ensure-split-ids
   [{:keys [commodity-account-id commodity-id account-id] :as transaction}
@@ -152,6 +152,20 @@
                                (accounts commodity-account-id))]
       (assoc transaction :commodity-id (:commodity-id commodity-account)
                          :account-id (:parent-id commodity-account)))))
+
+(defmethod ^:private import-transaction :transfer
+  [{:keys [storage accounts] :as context}
+   {:keys [from-account-id to-account-id] :as transaction}]
+  (let [from-commodity-account (accounts/find-by-id storage (accounts from-account-id))
+        from-account (accounts/find-by-id storage (:parent-id from-commodity-account))
+        to-commodity-account (accounts/find-by-id storage (accounts to-account-id))]
+    (trading/transfer (:storage context)
+                      (assoc transaction
+                             :transfer-date (:transaction-date transaction)
+                             :commodity-id (:commodity-id from-commodity-account)
+                             :from-account-id (:id from-account)
+                             :to-account-id (:parent-id to-commodity-account))))
+  context)

 (defmethod ^:private import-transaction :split
   [context transaction]


Hack around

Hack around

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -199,6 +199,28 @@
                                            (- 1.0 sum))
                                          ))))))
                           ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;HACK
+                          #_(if (not (:print-history argmap))
+                            (throw
+                              (Exception.
+                                ":print-history must be true for :case-stagnation"))
+                            (if (empty? (rest (:history ind)))
+                              (vec (repeat (count (:errors ind)) 1000000))
+                              (vec (for [case-history (map (partial take 20) (apply map list (:history ind)))] ;;;; NOTE WINDOW
+                                     (if (zero? (first case-history))
+                                       ;; note only zero is solved
+                                       ;; error-threshold applies to total so can't be used here
+                                       0 ;; solved, improvement doesn't matter
+                                       (let [improvements (mapv (fn [[newer-error older-error]]
+                                                                  (let [imp (- older-error newer-error)]
+                                                                    (if (> imp 0)
+                                                                      1.0
+                                                                      (if (< imp 0)
+                                                                        0.0 ;-1.0  ;;;;;; HACK
+                                                                        0.0))))
+                                                                (partition 2 1 case-history))]
+                                         (- 1.0 (/ (reduce + improvements)
+                                                   (count improvements))))))))) ;;;;;;;;;;;;;; HACK
+                          ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;HACK
                           (if (not (:print-history argmap))
                             (throw
                               (Exception.
@@ -215,10 +237,10 @@
                                                                     (if (> imp 0)
                                                                       1.0
                                                                       (if (< imp 0)
-                                                                        -1.0
+                                                                        -1.0  ;;;;;; HACK
                                                                         0.0))))
                                                                 (partition 2 1 case-history))]
-                                         (- 1.0 (/ (reduce + improvements)
+                                         (- 1.0 (/ (max 0 (reduce + improvements))
                                                    (count improvements))))))))) ;;;;;;;;;;;;;; HACK
                           (= cat :reproductive-infidelity)
                           (let [g (:genome ind)]


Third stab

Third stab

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -162,7 +162,7 @@
                                              weights (iterate (partial * 0.5) 0.5)
                                              sum (reduce + (mapv * improvements weights))]
                                          (if (<= sum 0)
-                                           (+ 1.0 (Math/abs sum))
+                                           1.0E100
                                            (/ 1.0 sum))))))))
                           ;
                           (= cat :reproductive-fidelity)


remove exception log

remove exception log

--- src/leiningen/utils.clj
+++ src/leiningen/utils.clj
@@ -24,7 +24,7 @@
 (defn run! [action & args]
   (try
     (apply action args)
-    (catch Exception e (m/info "Error " (.getMessage e) e))))
+    (catch Exception e (m/info "Error " (.getMessage e)))))

 (defn format-str [input max-length]
   (let [diff (- max-length (count input))]


use proper name

use proper name

--- src/main/shadow/cljs/repl.clj
+++ src/main/shadow/cljs/repl.clj
@@ -149,13 +149,13 @@
 (defn prepare
   [build-state]
   {:pre [(build-api/build-state? build-state)]}
-  (let [{:keys [repl-state] :as state}
+  (let [{:keys [repl-state] :as build-state}
         (setup build-state)

         {:keys [repl-sources]}
         repl-state]

-    (-> state
+    (-> build-state
         (build-api/compile-sources repl-sources)
         ;; make sure sources exist on disk so the REPL can actually load them
         (output/flush-sources repl-sources)


Move add / remove methods after helpers

Move add / remove methods after helpers

--- src/lt/objs/editor.cljs
+++ src/lt/objs/editor.cljs
@@ -371,17 +371,6 @@
 (defn fold-code [e]
   (.foldCode (->cm-ed e) (cursor e)))

-(defn add-gutter [e class-name width]
-  (let [gutter-classes (set (conj (js->clj (option e "gutters")) class-name))
-        current-widths (gutter-widths e)
-        new-gutter-widths (assoc current-widths class-name width)]
-    (update-gutters e gutter-classes new-gutter-widths)))
-
-(defn remove-gutter [e class-name]
-  (let [gutter-classes (remove #{class-name} (js->clj (option e "gutters")))
-        current-widths (gutter-widths e)]
-    (update-gutters e gutter-classes current-widths)))
-
 (defn gutter-widths [e]
   (let [gutter-div (dom/$ :div.CodeMirror-gutters (object/->content e))
         gutter-divs (dom/$$ :div.CodeMirror-gutter gutter-div)
@@ -398,6 +387,17 @@
                    (doseq [[k v] class-widths]
                      (if-let [gutter (dom/$ (str "div." k) gutter-div)]
                        (dom/set-css gutter {"width" (str v "px")})))))))
+
+(defn add-gutter [e class-name width]
+  (let [gutter-classes (set (conj (js->clj (option e "gutters")) class-name))
+        current-widths (gutter-widths e)
+        new-gutter-widths (assoc current-widths class-name width)]
+    (update-gutters e gutter-classes new-gutter-widths)))
+
+(defn remove-gutter [e class-name]
+  (let [gutter-classes (remove #{class-name} (js->clj (option e "gutters")))
+        current-widths (gutter-widths e)]
+    (update-gutters e gutter-classes current-widths)))

 ;;*********************************************************
 ;; Object


We call the action "Remove", not "Delete"

--- src-cljs/frontend/components/project_settings.cljs
+++ src-cljs/frontend/components/project_settings.cljs
@@ -432,7 +432,7 @@
                                            (button/button {:primary? true
                                                            :on-click #(raise! owner [:deleted-env-var {:project-id project-id
                                                                                :env-var-name (:name env-var)}])}
-                                                          "Delete")]
+                                                          "Remove")]
                                  :close-fn close-fn})))]))))

 (defn env-vars [project-data owner]
@@ -1653,7 +1653,7 @@
                                                            :on-click #(raise! owner
                                                                               [:delete-p12
                                                                                (select-keys row [:project-name :vcs-type :id])])}
-                                                          "Delete")]
+                                                          "Remove")]
                                  :close-fn close-fn})))]))))

 (defn p12-key-table [{:keys [rows]} owner]


actually compile scss

actually compile scss

--- dev/user.clj
+++ dev/user.clj
@@ -60,7 +60,7 @@
 (set! *unchecked-math* :warn-on-boxed)

 (defn server-system []
-  (utils/system-map (assoc server/system :scss-compiler scss-compiler :figwheel figwheel-component)))
+  (utils/system-map (assoc server/system :scss-compiler (scss-compiler) :figwheel figwheel-component)))

 (defn client-system []
   (utils/system-map (client/system (client-config/remote-url))))


deploy to mainnet

deploy to mainnet

--- src/name_bazaar/shared/smart_contracts.cljs
+++ src/name_bazaar/shared/smart_contracts.cljs
@@ -3,13 +3,13 @@
 (def smart-contracts
 {:auction-offering-factory
  {:name "AuctionOfferingFactory",
-  :address "0x068a60caef545e4a30fa3e53f383540a951abe18"},
+  :address "0x7a5b55cfda09c90f91c415e18296a7dd8ffffcce"},
  :buy-now-offering-library
  {:name "BuyNowOfferingLibrary",
-  :address "0x624f2bcf51b57bf1bb37ba3e64eaa333aa0cf852"},
+  :address "0xfebb05b53ff330016803445c4e6f90fb38dcb0a7"},
  :buy-now-offering-factory
  {:name "BuyNowOfferingFactory",
-  :address "0x89051acf0b75d8a4cbfb3f9dd1c6ea65acbcf7c1"},
+  :address "0x3b3eef4c6d736036dd32f6ee10cb0c6bea7021bd"},
  :registrar
  {:name "Registrar",
   :address "0x542d337975c2f9b436621024df371244bd53a0af"},
@@ -18,26 +18,26 @@
   :address "0x0000000000000000000000000000000000000000"},
  :auction-offering-library
  {:name "AuctionOfferingLibrary",
-  :address "0xf4220e40a00e55ea1cbc33550fc1805a7e545480"},
+  :address "0xf52ec19f4072b1954d742243ab75696f232d7dc3"},
  :deed
  {:name "Deed", :address "0x0000000000000000000000000000000000000000"},
  :ens
- {:name "ENS", :address "0xdf2ad8f81394f96372e821ffe86070dcdfe943b5"},
+ {:name "ENS", :address "0xc43e6fa04c774c46ef78c6644bdbe4a0ef69857c"},
  :mock-registrar
  {:name "MockRegistrar",
-  :address "0x9b5e67a9d562258ac038d9da17d41f8d72c63b4f"},
+  :address "0xc2002d7ba143e5fdcfca9d6783a6e02b4b664faa"},
  :offering-registry
  {:name "OfferingRegistry",
-  :address "0x00cf608127541d69506e4814d2b73adbb8a87636"},
+  :address "0xf218058af8ae63bebd62da05d179f371c73cb007"},
  :district0x-emails
  {:name "District0xEmails",
-  :address "0x0000000000000000000000000000000000000000"},
+  :address "0x999b6bcce0ccfdd689834959f02cd30177260187"},
  :offering-requests
  {:name "OfferingRequests",
-  :address "0x99953ea688e7817db908b160638c3d8032c2fd83"},
+  :address "0x05ec0e9ca082c28e14f9e1413efe735a908e4d47"},
  :offering-library
  {:name "OfferingLibrary",
-  :address "0xed7035ec3d0225fdc00317e658df91570f68a8cc"},
+  :address "0x7aabe7b26f2800c0192a183d6678d6c963a83e77"},
  :auction-offering
  {:name "AuctionOffering",
   :address "0x0000000000000000000000000000000000000000"}})


Removed debugging crud

Removed debugging crud

--- src/net/dishevelled/mailindex/fieldpool.clj
+++ src/net/dishevelled/mailindex/fieldpool.clj
@@ -6,7 +6,7 @@
 (defn- new-pool [name store tokenize]
   "Create a new pool of Field objects for a given field type."
   (ref {:next-available 0
-	:fields (repeatedly #(Field. name "" store tokenize))}))
+        :fields (repeatedly #(Field. name "" store tokenize))}))

 (defn- next-field [pool]
@@ -29,8 +29,6 @@
 (defn reset []
   "Mark all Field objects as available for re-use."
   (doseq [pool (vals @*field-pools*)]
-    (when (> (:next-available @pool) 100)
-      (println "Pool size got to:" (:next-available @pool)))
     (dosync
      (doseq [field (take (:next-available @pool) (:fields @pool))]
        (.setValue field nil))


Find all productions of given state

Find all productions of given state

not just the first one

--- src/mdr2/production.clj
+++ src/mdr2/production.clj
@@ -97,7 +97,7 @@
 (defn find-by-state
   "Find all productions with the given `state`"
   [state]
-  (first (db/find-by-state {:state state})))
+  (db/find-by-state {:state state}))

 (defn volumes
   "Find all volumes for a given `production`"


revert last change

revert last change

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -24,7 +24,7 @@
            get-msp MultiStagePosition-to-map ChannelSpec-to-map
            get-pixel-type get-current-time-str rekey
            data-object-to-map str-vector double-vector
-           get-property-value]]
+           get-property-value edt]]
         [org.micromanager.sequence-generator :only [generate-acq-sequence
                                                     make-property-sequences]])
   (:require [clojure.set])
@@ -276,6 +276,13 @@
         tags (parse-core-metadata md)]
     {:pix pix :tags (dissoc tags "StartTime-ms")}))

+(defn make-multicamera-events [event]
+  (let [num-camera-channels (long (core getNumberOfCameraChannels))]
+    (for [camera-channel (range num-camera-channels)]
+      (let [super-channel-index (+ camera-channel (* num-camera-channels (event :channel-index)))]
+        (assoc event :channel-index super-channel-index
+                     :camera-channel-index camera-channel)))))
+
 (defn collect-burst-images [event out-queue]
   (when (first-trigger-missing?) (pop-burst-image)) ; drop first image if first trigger doesn't happen
   (swap! state assoc :burst-time-offset nil)
@@ -292,26 +299,25 @@
                 (swap! state assoc
                        :burst-time-offset (- (elapsed-time @state)
                                              (core-time-from-tags (image :tags)))))
-             ; (println (image+ :tags))
+              ;(println (image+ :tags))
               (.put out-queue (make-TaggedImage (annotate-image image+ evt @state
                                                                 (burst-time (:tags image) @state)))))
             (when (core isBufferOverflowed)
               (swap! state assoc :stop true)
               (ReportingUtils/showError "Circular buffer overflowed."))))
-        (flatten (map make-multicamera-events) (event :burst-data)))))
+        (flatten (map make-multicamera-events (event :burst-data))))))
   (while (and (not (@state :stop)) (. mmc isSequenceRunning))
     (Thread/sleep 5)))

 (defn collect-snap-image [event out-queue]
   (let [image
-         {:pix (core getImage)
-          :tags nil}]
-    (do (log "collect-snap-image: "
-               (select-keys event [:position-index :frame-index
-                                   :slice-index :channel-index]))
-      (when out-queue
-          (.put out-queue
-                (make-TaggedImage (annotate-image image event @state (elapsed-time @state))))))
+        {:pix (core getImage)
+         :tags nil}]
+    (select-keys event [:position-index :frame-index
+                        :slice-index :channel-index])
+    (when out-queue
+      (.put out-queue
+            (make-TaggedImage (annotate-image image event @state (elapsed-time @state)))))
     image))

 (defn return-config []
@@ -366,17 +372,9 @@
                          (:relative-z event))
       nil)))

-(defn make-multicamera-events [event]
-  (let [num-camera-channels (core getNumberOfCameraChannels)]
-    (for [camera-channel (range num-camera-channels)]
-      (let [super-channel-index (+ camera-channel (* num-camera-channels (event :channel-index)))]
-        (assoc event :channel-index super-channel-index
-                     :camera-channel-index camera-channel)))))
-
 (defn collect [event out-queue]
   (condp = (:task event)
-                :snap (doseq [sub-event (make-multicamera-events event)]
-                        (collect-snap-image sub-event out-queue))
+                :snap (collect-snap-image event out-queue)
                 :burst (collect-burst-images event out-queue)))

 (defn z-in-msp [msp z-drive]
@@ -393,12 +391,21 @@
               0))
          z-ref))))

-(defn store-new-z-reference [msp]
+(defn recall-z-reference [current-position]
   (let [z-drive (@state :default-z-drive)]
     (when (and (or (not (core isContinuousFocusEnabled))
-                   (core isContinuousFocusDrive z-drive))
-               (not (z-in-msp msp z-drive)))
-      (state-assoc! :reference-z (get-z-stage-position z-drive)))))
+                   (core isContinuousFocusDrive z-drive)))
+      (set-z-stage-position z-drive
+        (or (get-msp-z-position current-position z-drive)
+            (@state :reference-z))))))
+
+(defn store-z-reference [current-position]
+  (let [z-drive (@state :default-z-drive)]
+    (when (and (or (not (core isContinuousFocusEnabled))
+                   (core isContinuousFocusDrive z-drive)))
+      (let [z (get-z-stage-position z-drive)]
+        (set-msp-z-position current-position z-drive z)
+        (state-assoc! :reference-z z)))))

 ;; startup and shutdown

@@ -434,7 +441,6 @@
       )))

 (defn cleanup []
-  (try
   (log "cleanup")
  ; (do-when #(.update %) (:display @state))
   (state-assoc! :finished true :display nil)
@@ -447,8 +453,7 @@
   (when (and (@state :init-continuous-focus)
              (not (core isContinuousFocusEnabled)))
     (core enableContinuousFocus true))
-  (return-config)
-    (catch Throwable t (ReportingUtils/showError t "Acquisition cleanup failed."))))
+  (return-config))

 ;; running events

@@ -456,7 +461,6 @@
   (let [current-position (:position event)
         z-drive (@state :default-z-drive)
         check-z-ref (and z-drive
-                         (-> current-position get-msp (z-in-msp z-drive) not)
                          (or (:autofocus event)
                              (:wait-time-ms event)))]
     (filter identity
@@ -472,13 +476,13 @@
                        camera (core getCameraDevice)]
              (device-best-effort camera (core setExposure exposure)))
           #(when check-z-ref
-             (set-stage-position z-drive (@state :reference-z)))
+             (recall-z-reference current-position))
           #(when-let [wait-time-ms (:wait-time-ms event)]
              (acq-sleep wait-time-ms))
-          #(when (:autofocus event)
+          #(when (get event :autofocus)
              (run-autofocus))
           #(when check-z-ref
-             (store-new-z-reference (get-msp current-position)))
+             (store-z-reference current-position))
           #(when z-drive
              (let [z (compute-z-position event)]
                (set-stage-position z-drive z)))
@@ -495,7 +499,6 @@

 (defn run-acquisition [this settings out-queue]
   (try
-    (log "Multi-Dimensional Acquisition started.")
     (def acq-settings settings)
     (prepare-state this)
     (binding [state (.state this)]
@@ -512,6 +515,7 @@
 ;; generic metadata

 (defn convert-settings [^SequenceSettings settings]
+  (def seqSettings settings)
   (-> settings
     (data-object-to-map)
     (rekey
@@ -549,16 +553,15 @@
                 (:properties channel)))
             default-cam)]
     (set-property chan-cam)
-    (let [n (core getNumberOfComponents)]
+    (let [n (long (core getNumberOfComponents))]
       (set-property default-cam)
       (get {1 1 , 4 3} n))))

 (defn make-summary-metadata [settings]
-  (let [depth (int (core getBytesPerPixel))
+  (let [depth (core getBytesPerPixel)
         channels (settings :channels)
-        num-camera-channels (core getNumberOfCameraChannels)
-        simple-channels (if-not (empty? channels) channels [{:name "Default" :color java.awt.Color/WHITE}])
-        super-channels (flatten (for [channel simple-channels] (repeat num-camera-channels channel)))]
+        num-camera-channels (long (core getNumberOfCameraChannels))
+        super-channels (flatten (for [channel channels] (repeat num-camera-channels channel)))]
      (JSONObject. {
       "BitDepth" (core getImageBitDepth)
       "Channels" (count super-channels)
@@ -613,6 +616,11 @@
     image-tags
     ["Width" "Height" "PixelType"]))

+(defn initialize-display-ranges [window]
+  (do (.setChannelDisplayRange window 0 0 256)
+      (.setChannelDisplayRange window 1 0 256)
+      (.setChannelDisplayRange window 2 0 256)))
+
 (defn create-image-window [first-image]
   (let [summary {:interval-ms 0.0, :custom-intervals-ms [] :use-autofocus false, :autofocus-skip 0,
                  :relative-slices true, :keep-shutter-open-slices false, :comment "",
@@ -622,8 +630,10 @@
                  :zReference 0.0, :frames (), :save false}
 		summary-metadata (make-summary-metadata summary)
 		cache (doto (MMImageCache. (TaggedImageStorageRam. summary-metadata))
-						(.setSummaryMetadata summary-metadata))]
-    (doto (VirtualAcquisitionDisplay. cache nil))))
+						(.setSummaryMetadata summary-metadata))]
+		(doto (VirtualAcquisitionDisplay. cache nil)
+                           (.promptToSave false)
+                           (initialize-display-ranges))))

 (defn create-basic-event []
   {:position-index 0, :position nil,
@@ -648,7 +658,7 @@
   (let [myTaggedImage (make-TaggedImage tagged-img)
         cache (.getImageCache display)]
     (.putImage cache myTaggedImage)
-    (.showImage display myTaggedImage)
+    (.showImage display (. myTaggedImage tags) true false)
     (when focus
       (.show display))))

@@ -672,25 +682,31 @@
 (def live-mode-running (ref false))

 (defn enable-live-mode [^Boolean on]
-      (if on
-        (let [event (create-basic-event)
-              state (create-basic-state)
-              first-image (atom true)
-              start-time (jvm-time-ms)]
-          (dosync (ref-set live-mode-running true))
-          (core startContinuousSequenceAcquisition 0)
-          (log "started sequence acquisition")
-          (.start (Thread.
-                    #(do (while @live-mode-running
-                           (let [raw-image {:pix (core getLastImage) :tags nil}
-                                 elapsed-time-ms (- (jvm-time-ms) start-time)
-                                 img (annotate-image raw-image event state elapsed-time-ms)]
-                              (reset-snap-window img)
-                              (show-image @snap-window img @first-image)
-                              (reset! first-image false)))
-                         (core stopSequenceAcquisition))
-                    "Live mode (clojure)")))
-        (dosync (ref-set live-mode-running false))))
+  (if on
+    (let [event (create-basic-event)
+          state (create-basic-state)
+          start-time (jvm-time-ms)]
+      (dosync (ref-set live-mode-running true))
+      (core startContinuousSequenceAcquisition 0)
+      (log "started sequence acquisition")
+      (.start (Thread.
+                #(dorun (loop [last-time 0
+                               first-image true]
+                          (when @live-mode-running
+                            (let [raw-image {:pix (core getLastImage) :tags nil}
+                                  elapsed-time-ms (- (jvm-time-ms) start-time)
+                                  img (annotate-image raw-image event state elapsed-time-ms)
+                                  this-time (System/currentTimeMillis)
+                                  dt (- 33 (- this-time last-time))]
+                              (if first-image (reset-snap-window img)  )
+                              (Thread/sleep (max 0 dt))
+                              (if (.windowClosed @snap-window)
+                                (edt (.enableLiveMode gui false))
+                                (show-image @snap-window img first-image)  )
+                              (recur this-time false))))
+                        (core stopSequenceAcquisition))
+                "Live mode (clojure)")))
+    (dosync (ref-set live-mode-running false))))

 ;; java interop


Remove old site tests

Remove old site tests

--- test/comic_reader/sites_test.clj
+++ test/comic_reader/sites_test.clj
@@ -36,52 +36,3 @@
      root-url
      manga-url
      manga-list-url))
-
-(deftest extract-comics-list-test
-  (binding [options (read-site-options "manga-fox")]
-    (test-data-functions-not-nil)
-    (test-url-format-strings)
-
-    (let [html (html/html [:div {}])
-          comics (extract-comics-list html)]
-      (is (= (seq comics)
-             nil)))
-
-    (let [html (html/html-resource "test/manga_fox/comic_list.html")]
-      (let [url-list (scrape/extract-list html
-                                          (comic-list-selector)
-                                          identity)]
-        (is (= (count url-list)
-               15))
-
-        (is (= (first url-list)
-               '{:tag :a,
-                 :attrs
-                 {:href "http://mangafox.me/manga/6mm_no_taboo/",
-                  :rel "4558",
-                  :class "series_preview manga_open"},
-                 :content ("-6mm no Taboo")})))
-
-      (let [link-6mm '{:tag :a,
-                       :attrs
-                       {:href "http://mangafox.me/manga/6mm_no_taboo/",
-                        :rel "4558",
-                        :class "series_preview manga_open"},
-                       :content ("-6mm no Taboo")}]
-
-        (is (= (link->map link-6mm)
-               '{:name "-6mm no Taboo"
-                 :url  "http://mangafox.me/manga/6mm_no_taboo/"}))
-
-        (is (= (comic-link-normalize link-6mm)
-               '{:name "-6mm no Taboo",
-                 :url "http://mangafox.me/manga/6mm_no_taboo/",
-                 :id "6mm_no_taboo"})))
-
-      (let [comics (extract-comics-list html)]
-        (is (= (count comics)
-               15))
-        (is (= (first comics)
-               {:name "-6mm no Taboo",
-                :url "http://mangafox.me/manga/6mm_no_taboo/",
-                :id "6mm_no_taboo"}))))))


Minor cleanup

Minor cleanup

--- src/angelic/search/implicit/fah_astar_eval2.clj
+++ src/angelic/search/implicit/fah_astar_eval2.clj
@@ -73,35 +73,26 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;       Watchers      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defprotocol OutputWatched
-  (add-watcher!   [s w] "Add a watcher to be notified of all outputs to this.
-                         A watcher is just a fn of [watched-sp/stub new-subproblem]."))
-
-(defprotocol SimpleWatched
-  (add-output! [sw o])
-  (add-forward! [sw child-sw]))
-
-;; TODO: remove the ;doall seq pairs --
-;; these work around a concurrent modification exception, which is indicative of a bug ?!
+(defprotocol Watched
+  (add-watcher! [s w] "Add a watcher to be notified of all outputs to this.
+                         A watcher is just a fn of [watched-sp/stub new-subproblem].")
+  (add-output!  [sw o]    "O is a subproblem")
+  (add-forward! [sw child-sw] "child-sw is a simple-watched"))

 (traits/deftrait simple-watched
-  [] [^ArrayList watchers (ArrayList.)
-      ^ArrayList outputs (ArrayList.)
-      ^ArrayList forwards (ArrayList.)] []
-  OutputWatched
+  []
+  [^ArrayList watchers (ArrayList.)
+   ^ArrayList outputs (ArrayList.)
+   ^ArrayList forwards (ArrayList.)]
+  []
+  Watched
   (add-watcher! [sw w]
     (.add watchers w)
     (doseq [o outputs] (w sw o))
     (doseq [f forwards] (add-watcher! f w)))
-
-  SimpleWatched
   (add-output! [sw o]
-;   (assert (satisfies? Subproblem o))
     (.add outputs o)
-    (doseq [w watchers] (w sw o))
-    #_           (let [i (rand-int 10000)]     (println i sw o)
-
-                    (println "DONE!" i sw)))
+    (doseq [w watchers] (w sw o)))
   (add-forward! [sw child-sw]
     (.add forwards child-sw)
     (doseq [w watchers] (add-watcher! child-sw w))))
@@ -226,7 +217,6 @@
     ret))

 ;; Children should be lazy, are not touched if subsuming criteria are met?
-;; TODO: computaiton of summary fn here seems to be crux of the issue.xz
 (defn make-nonterminal-subproblem [name subsuming-sp inp-set out-set summary-fn ri-fn
                                    use-sub-children? inner-children copy-children child-transform]
   (let [sub-children? (and subsuming-sp use-sub-children? (not (terminal? subsuming-sp)))
@@ -282,10 +272,8 @@
   (when subsuming-sp (summaries/connect! child (tree-summarizer subsuming-sp) true)))

-;; TODO: subsumption links should be to tree su, not stub ?
 ;; Note: this is double-stage to lazily generate children.  Could be simpler single-stage.
 (defn- make-atomic-stub [subsuming-sp inp-set function-set]
-;  (println "Making atomic stub" inp-set (fs/fs-name function-set))
   (let [state (atom :ready) ;; set to [out-set reward] after first eval, then :go after second.
         ret
         (traits/reify-traits
@@ -359,7 +347,7 @@
   (let [ret (traits/reify-traits [simple-watched cache-trait summaries/simple-node]
               summaries/Summarizable
               (summarize [s]
-                 (summary/max ;; Mxa here prevents infinite loop from s in s
+                 (summary/max ;; Max here prevents infinite loop from s in s
                   (summary/+ (summaries/summary left-sp) (summaries/summary right-stub) s)
                   (summary/or-combine
                    (map summaries/summary (summaries/node-ordinary-children s))
@@ -381,8 +369,6 @@
     ret))

 ;; TODO: figure out if transient increases can be solved (is there better semantics for inner)?
-;; TODO: figure out how to do subsumption connections properly.
-
 ;; Stub to wait for left to be evaluated
 ;; Left-stub will always be atomic stub, which always has a single output.
 ;; TODO: this seems to not always be true -- someitmes get multiple outputs for left-stub !
@@ -484,56 +470,3 @@
        (apply make-simple-atomic-subproblem nil)
        subproblem/pseudo-solve)))

-
-
-
-(comment
-
-
-(defprotocol FancyNode
-  (remove-child! [s child])
-  (remove-parent! [s parent]))
-
-(defn disconnect! [parent child]
-  (remove-child! parent child)
-  (remove-parent! child parent))
-
-
-(traits/deftrait fancy-node [] [children (atom nil) parents  (atom nil)] []
-  summaries/Node
-  (node-ordinary-children [n] (map second (remove first @children)))
-  (node-subsuming-children [n] (map second (filter first @children)))
-  (node-ordinary-parents [n] (map second (remove first @parents)))
-  (node-subsumed-parents [n] (map second (filter first @parents)))
-  (add-child!    [n child subsuming?] (swap! children conj [subsuming? child]))
-  (add-parent!   [n parent subsuming?] (swap! parents conj [subsuming? parent]))
-
-  FancyNode
-  (remove-child! [s child]
-    (let [new-children (remove #(identical? (second %) child) @children)]
-      (assert (= (count new-children) (dec (count @children))))
-      (reset! children new-children)))
-  (remove-parent! [s parent]
-    (let [new-parents (remove #(identical? (second %) parent) @parents)]
-      (assert (= (count new-parents) (dec (count @parents))))
-      (reset! parents new-parents))))
-)
-
-
-(comment
-  (defn- make-atomic-subproblem [stub subsuming-sp inp-set function-set out-set reward status]
-  (let [children (when (= status :live)
-                   (or #_ (refined-children subsuming-as inp-set) ;; TODO!!
-                       (map #(make-fs-seq-stub inp-set %)
-                            (fs/child-seqs function-set inp-set))))]
-    (make-simple-subproblem
-     [::Atomic (fs/fs-name function-set) inp-set]
-     inp-set out-set
-     (if (= status :live)
-       (fn [s]
-         (assert (empty? (summaries/node-subsuming-children s)))
-         (assert (= (count children) (count (summaries/node-ordinary-children s))))
-         (summary/or-combine (map summaries/summary children) s reward))
-       (fn [s] (summary/make-simple-summary reward status s)))
-     children children identity
-     (fn [s ref-inp-set] (make-atomic-stub s ref-inp-set function-set))))))


calculate angles & points

calculate angles & points

--- src/minkowski/core.cljs
+++ src/minkowski/core.cljs
@@ -9,17 +9,30 @@
 (def canvas (aget (.getElementsByTagName js/document "canvas") 0))
 (def slider (aget (.getElementsByTagName js/document "input") 0))
 (def drawing (.getContext canvas "2d"))
+(def width 200)
+(def height 200)
+(defn canvas-point [[x y]] [(+ x (/ width 2)) (+ y (/ height 2))])

 (def radius 30)
+(def draw-points '())
+
+(defn angles [n] (range 0 doublepi (/ doublepi n)))
+
+(defn points [n radius] (map (fn [angle] [(* radius (Math/sin angle)) (* radius (Math/cos angle))]) (angles n)))

 (.addEventListener slider "input" (fn []
-  (set! radius (aget slider "value"))))
+  (let [value (aget slider "value")]
+    (set! radius value)
+    (set! draw-points (points 360 radius))
+  )))

 (defn draw-scene []
-  (.clearRect drawing 0 0 (aget canvas "width") (aget canvas "height"))
-  (.beginPath drawing)
-  (.arc drawing 100 100 radius 0 doublepi false)
-  (.stroke drawing))
+  (do
+    (.clearRect drawing 0 0 (aget canvas "width") (aget canvas "height"))
+    (.beginPath drawing)
+    (doall (for [point draw-points] (let [[x y] (canvas-point point)] (.lineTo drawing x y))))
+    (.closePath drawing)
+    (.stroke drawing)))

 (defn request-frame []
   (.requestAnimationFrame js/window


Fix failing test

Fix failing test

--- test/hatti/views/table_test.cljs
+++ test/hatti/views/table_test.cljs
@@ -46,7 +46,7 @@
                     :headerCssClass :maxWidth :cssClass}
                   (set (keys first-col)))

-          (is (= (:name first-col) (:toolTip first-col)))))
+          (is (= (:name first-col) tv/select-unselect-all-records-element))))
     (testing "compfn works on submission-time"
       (let [submission-col (->> slickgrid-cols
                                 (filter #(= (:id %) "_submission_time"))


Add rates to buffer metrics and nested publish

Had to switch to our own impl of a FixedBuffer so that we can wrap round
rates meters of how many items are going in and out of the buffer.

--- src/clj/com/beardandcode/twitter_news/stats.clj
+++ src/clj/com/beardandcode/twitter_news/stats.clj
@@ -3,22 +3,29 @@
   (:require [clojure.core.async :as async]
             [clojure.core.async.impl.protocols :as async-protocols]
             [metrics.gauges :refer [gauge-fn value]]
-            [metrics.meters :refer [rates]]))
+            [metrics.meters :refer [mark! meter rates]]
+            [metrics.timers :refer [percentiles]]))

 (defprotocol StatsProvider
   (stats [_]))

-(defrecord StatsBuffer [queue capacity]
+(deftype StatsBuffer [queue capacity in-meter out-meter]
   async-protocols/Buffer
-  (full? [_] (println "full?") (>= (.size queue) capacity))
-  (remove! [_] (println "remove!") (.remove queue))
-  (add!* [_ value] (println "add!*") (.add value))
-  (close-buf! [_] (println "close-buf!")))
+  (full? [_] (>= (.size queue) capacity))
+  (remove! [_] (mark! out-meter) (.removeLast queue))
+  (add!* [this value] (.addFirst queue value) (mark! in-meter) this)
+  (close-buf! [_])
+
+  clojure.lang.Counted
+  (count [_] (.size queue)))

 (defn buffer [name capacity metrics-registry]
-  (let [buf (async/buffer capacity)]
-    (gauge-fn metrics-registry (format "%s-size" name) #(count buf))
-    (gauge-fn metrics-registry (format "%s-remaining" name) #(- capacity (count buf)))
+  (let [queue (LinkedList.)
+        buf (StatsBuffer. queue capacity
+                          (meter metrics-registry (format "%s.in" name))
+                          (meter metrics-registry (format "%s.out" name)))]
+    (gauge-fn metrics-registry (format "%s.size" name) #(.size queue))
+    (gauge-fn metrics-registry (format "%s.remaining" name) #(- capacity (.size queue)))
     buf))

 (defn- metrics-from [get-fn parse-fn]
@@ -27,5 +34,9 @@
                           (-> entry .getValue parse-fn)}))))

 (defn from-registry [registry]
-  (apply merge (concat (metrics-from #(.getMeters registry) rates)
-                       (metrics-from #(.getGauges registry) value))))
+  (reduce (fn [out [key val]]
+            (assoc-in out (clojure.string/split key (re-pattern "\\.")) val))
+          {}
+          (apply merge (concat (metrics-from #(.getMeters registry) rates)
+                               (metrics-from #(.getGauges registry) value)
+                               (metrics-from #(.getTimers registry) percentiles)))))


Convert core exception to ex-info.

Convert core exception to ex-info.

--- src/multihash/core.cljc
+++ src/multihash/core.cljc
@@ -170,23 +170,28 @@

 (defn decode-array
-  "Decodes a byte array directly into multihash. Throws `IOException` on
-  malformed input, and `IllegalArgumentException` if the multihash is invalid."
+  "Decodes a byte array directly into multihash. Throws `ex-info` with a `:type`
+  of `:multihash/bad-input` if the data is malformed or invalid."
   [^bytes encoded]
-  (when (< (alength encoded) 3)
-    (throw (IOException.
-             (str "Cannot read multihash from byte array: " (alength encoded)
-                  " is less than the minimum of 3"))))
+  (let [encoded-size (alength encoded)
+        min-size 3]
+    (when (< encoded-size min-size)
+      (throw (ex-info
+               (str "Cannot read multihash from byte array: " encoded-size
+                    " is less than the minimum of " min-size)
+               {:type :multihash/bad-input}))))
   (let [code (aget encoded 0)
         length (aget encoded 1)
         payload (- (alength encoded) 2)]
     (when-not (pos? length)
-      (throw (IOException.
-               (str "Encoded length " length " is invalid"))))
+      (throw (ex-info
+               (str "Encoded length " length " is invalid")
+               {:type :multihash/bad-input})))
     (when (< payload length)
-      (throw (IOException.
+      (throw (ex-info
                (str "Encoded digest length " length " exceeds actual "
-                    "remaining payload of " payload " bytes"))))
+                    "remaining payload of " payload " bytes")
+               {:type :multihash/bad-input})))
     (let [digest (byte-array length)]
       (System/arraycopy encoded 2 digest 0 length)
       (create code digest))))
@@ -200,9 +205,9 @@
   [^InputStream input]
   (let [length (.read input)]
     (when-not (pos? length)
-      (throw (IOException.
-               (format "Byte %02x is not a valid digest length."
-                       length))))
+      (throw (ex-info
+               (format "Byte %02x is not a valid digest length." length)
+               {:type :multihash/bad-input})))
     (let [digest (byte-array length)]
       (loop [offset 0
              remaining length]


Allow client code to pass actual AWS credentials

This supports more complex use cases in which the BasicAwsCredentials are not
enough. Here is one example:

http://aws.typepad.com/aws/2012/11/delegating-api-access-to-aws-services-using-iam-roles.html

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -78,11 +78,12 @@
 (def ^:private db-client*
   "Returns a new AmazonDynamoDBClient instance for the supplied IAM credentials."
   (memoize
-   (fn [{:keys [access-key secret-key endpoint proxy-host proxy-port
+   (fn [{:keys [credentials access-key secret-key endpoint proxy-host proxy-port
                conn-timeout max-conns max-error-retry socket-timeout] :as creds}]
      (if (empty? creds)
        (AmazonDynamoDBClient.) ; Use credentials provider chain
-       (let [aws-creds     (BasicAWSCredentials. access-key secret-key)
+       (let [aws-creds     (or credentials
+                               (BasicAWSCredentials. access-key secret-key))
              client-config (doto-cond [g (ClientConfiguration.)]
                              proxy-host      (.setProxyHost         g)
                              proxy-port      (.setProxyPort         g)


fixed last day of month problem

fixed last day of month problem

--- src/ontrail/summary.clj
+++ src/ontrail/summary.clj
@@ -61,7 +61,7 @@
   (.debug logger (str "Getting summary: " user " condition " condition))
   (let [cond-with-user (assoc condition :user user)
         all-distinct-sports (mc/distinct EXERCISE "sport" cond-with-user)]
-    {:user user :sports (sort-by :numericalDuration > (map #(get-summary (assoc condition :user user :sport %) %) all-distinct-sports))}))
+    {:user user :sports (sort-by :numericalDuration > (map #(get-summary (assoc cond-with-user :sport %) %) all-distinct-sports))}))

 (defn get-year-summary-sport [user year]
   (let [first-day (time/date-time year 1 1)
@@ -71,9 +71,9 @@

 (defn get-month-summary-sport [user year month]
   (let [first-day (time/date-time year month 1)
-        last-day (time/date-time year month 28)
-        year-cond {:creationDate {:$gte first-day :$lte last-day}}]
-    (get-overall-summary-cond user year-cond)))
+        last-day (-> first-day (.dayOfMonth) (.withMaximumValue))
+        year-month-cond {:creationDate {:$gte first-day :$lte last-day}}]
+    (assoc (get-overall-summary-cond user year-month-cond) :year year :month month)))

 (defn get-overall-summary [user]


added handling of absent AndExplorer; did some minor cleanup;

--- src/clojure/org/turtle/geometry/TurtleGraphics.clj
+++ src/clojure/org/turtle/geometry/TurtleGraphics.clj
@@ -23,8 +23,8 @@
               :constructors {[] []})
   (:import [android.support.v4.app DialogFragment]
            [android.app Activity AlertDialog AlertDialog$Builder Dialog]
-           [android.content Context DialogInterface$OnClickListener
-            Intent SharedPreferences]
+           [android.content ActivityNotFoundException Context
+            DialogInterface$OnClickListener Intent SharedPreferences]
            [android.graphics Bitmap Bitmap$Config BitmapFactory Canvas
             Color Matrix Paint Paint$Cap Paint$Style Rect]
            [android.net Uri]
@@ -58,9 +58,6 @@
             ThreadPoolExecutor
             TimeUnit]

-           ;; [org.antlr.runtime ANTLRStringStream
-           ;;  CommonTokenStream]
-           ;; [org.turtle TurtleLexer TurtleParser]
            [jscheme JScheme SchemePair]
            [jsint E Evaluator$InterruptedException InputPort Pair Procedure Symbol])
   ;; (:require [neko.init]
@@ -69,30 +66,14 @@
   (:use [clojure.math.numeric-tower :only (sqrt)]
         [org.turtle.geometry.utils]
         ;; [neko.init]
+        [android.clojure.graphic :only (color->paint
+                                        with-saved-matrix)]
         [android.clojure.util :only (android-resource
                                      defrecord*
                                      extract-stacktrace
                                      make-double-tap-handler
                                      make-ui-dimmer)]))

-;;;; tooked from android-util's graphic.clj
-
-(defn ^Paint color->paint
-  ([argb]
-     (let [p (Paint.)]
-       (.setColor p argb)
-       p))
-  ([alpha red green blue]
-     (color->paint (Color/argb alpha red green blue))))
-
-(defmacro with-saved-matrix [canvas-var & body]
-  `(try
-     (.save ^Canvas ~canvas-var Canvas/MATRIX_SAVE_FLAG)
-     ~@body
-     (finally
-       (.restore ^Canvas ~canvas-var))))
-
-;;;;

 ;; do nothing in release
 ;; (defn log-func
@@ -254,6 +235,10 @@
                             (.getString activity
                                         (resource :string
                                                   :errors_tab_label))))))
+
+(defn toast-notify [^Activity activity ^String msg]
+  (.show (Toast/makeText activity msg Toast/LENGTH_SHORT)))
+

 (defn get-animation-duration [^org.turtle.geometry.TurtleGraphics activity]
   (text-input->int (duration-entry @activity) 0))
@@ -685,18 +670,14 @@
      button-stop
      (reify android.view.View$OnClickListener
        (onClick [this unused-button]
-         (.show (Toast/makeText activity
-                                "Stopping turtle"
-                                Toast/LENGTH_SHORT))
+         (toast-notify activity "Stopping turtle")
          (stop-turtle-thread activity))))

     (.setOnClickListener
      button-clear
      (reify android.view.View$OnClickListener
        (onClick [this unused-button]
-         (.show (Toast/makeText activity
-                                "Clearing"
-                                Toast/LENGTH_SHORT))
+         (toast-notify activity "Clearing")
          (clear-error-output)
          (swap! (.state activity) assoc-in
                 [:turtle-state]
@@ -715,9 +696,12 @@
              (.putExtra "explorer_title" "Save As...")
              (.putExtra "browser_line" "enabled")
              (.putExtra "browser_line_textfield" "file.tg"))
-           (.startActivityForResult activity
-                                    get-file-intent
-                                    intent-save-file)))))
+           (try
+             (.startActivityForResult activity
+                                      get-file-intent
+                                      intent-save-file)
+             (catch ActivityNotFoundException e
+               (toast-notify activity "Error while saving: AndExplorer not installed")))))))

     (.setOnClickListener
      button-load
@@ -730,9 +714,12 @@
            (.putExtra get-file-intent
                       "browser_filter_extension_whitelist"
                       "*.tg")
-           (.startActivityForResult activity
-                                    get-file-intent
-                                    intent-load-file)))))
+           (try
+             (.startActivityForResult activity
+                                      get-file-intent
+                                      intent-load-file)
+             (catch ActivityNotFoundException e
+               (toast-notify activity "Error while loading: AndExplorer not installed")))))))

     (.setError (.getEvaluator (jscheme @this))
                (error-writer @this))
@@ -752,12 +739,6 @@

   (let [preferences (global-preferences @this)]
     (.setText (program-source-editor @this)
-              ;; "(let ((a 100)
-      ;; (b (/ a 2)))
-  ;; (forward a)
-  ;; (left 120)
-  ;; (forward b))"
-
               (.getString preferences
                           preferences-last-program-tag
                           "(use-color magenta)\n(forward 100)\n(left 90)\n(forward 100)\n")))
@@ -831,6 +812,8 @@

 (defn -onDestroy [^org.turtle.geometry.TurtleGraphics this]
   (.superOnDestroy this)
+  ;; These two require customized neko library but for releases
+  ;; without nrepl server these may be omitted as well.
   ;; (neko.init/deinit)
   ;; (neko.compilation/clear-cache)
   (stop-turtle-thread this))
@@ -860,9 +843,7 @@
            save
            (fn []
              (spit filename (.getText (program-source-editor @this)))
-             (.show (Toast/makeText this
-                                    (format "Saved as %s" filename)
-                                    Toast/LENGTH_SHORT)))]
+             (toast-notify this (format "Saved as %s" filename)))]
        (if (.exists (File. filename))
          (let [activity this
                frag-dialog-manager
@@ -892,9 +873,7 @@
            filename (.getPath uri)]
        (.setText (program-source-editor @this)
                  ^String (slurp filename))
-       (.show (Toast/makeText this
-                              (format "Loaded %s" filename)
-                              Toast/LENGTH_SHORT)))
+       (toast-notify this (format "Loaded %s" filename)))
      :else
      ;; ignore it
      nil)))


Remove empty char sets.

Remove empty char sets.

--- test/smallex/test/generators.clj
+++ test/smallex/test/generators.clj
@@ -11,7 +11,9 @@
     {:result :char}))

 (def char-set
-  (gen/fmap (comp set->char-set set) (gen/vector gen/char)))
+  (->> (gen/vector gen/char)
+       (gen/not-empty)
+       (gen/fmap (comp set->char-set set))))

 (defn- string->item-string [s]
   (with-meta


use new Om state setting capabilities

use new Om state setting capabilities

--- labs/architecture-examples/om/src/todomvc/item.cljs
+++ labs/architecture-examples/om/src/todomvc/item.cljs
@@ -12,11 +12,11 @@
 ;; =============================================================================
 ;; Todo Item

-(defn handle-submit [e {:keys [edit-text] :as todo} {:keys [ comm]}]
-  (when edit-text
+(defn handle-submit [e todo {:keys [owner comm]}]
+  (when-let [edit-text (om/get-state owner [:edit-text])]
     (if-not (string/blank? (.trim edit-text))
       (do
-        (om/update! todo #(-> % (assoc :title edit-text) (dissoc :edit-text)))
+        (om/update! todo #(assoc % :title edit-text))
         (put! comm [:save todo]))
       (put! comm [:destroy todo])))
   false)
@@ -30,23 +30,25 @@
       (<! (timeout 100))
       (.focus node)
       (.setSelectionRange node 0 (.. node -value -length)))
-    (om/update! todo #(assoc % :edit-text title))))
+    (om/set-state! owner [:edit-text] title)))

 (defn handle-key-down [e {:keys [title] :as todo} {:keys [owner] :as opts}]
   (let [kc (.-keyCode e)]
     (if (identical? kc ESCAPE_KEY)
       (do
-        (om/update! todo #(assoc % :edit-text title))
+        (om/set-state! owner [:edit-text] title)
         (put! (:comm opts) [:cancel todo]))
       (if (identical? kc ENTER_KEY)
         (handle-submit e todo opts)))))

 (defn handle-change [e todo owner]
-  (om/update! todo
-    #(assoc % :edit-text (.. e -target -value))))
+  (om/set-state! owner [:edit-text] (.. e -target -value)))

 (defn todo-item [{:keys [id title editing completed] :as todo} {:keys [comm]}]
   (reify
+    om/IInitState
+    (init-state [_ owner]
+      {:edit-text title})
     om/IRender
     (render [_ owner]
       (let [m {:owner owner :comm comm}
@@ -65,7 +67,7 @@
             (dom/button #js {:className "destroy"
                              :onClick (fn [_] (put! comm [:destroy todo]))}))
           (dom/input #js {:ref "editField" :className "edit"
-                          :value (or (:edit-text todo) title)
+                          :value (om/get-state owner [:edit-text])
                           :onBlur #(handle-submit % todo m)
                           :onChange #(handle-change % todo owner)
                           :onKeyDown #(handle-key-down % todo m)}))))))


Extract compile-function function

Extract compile-function function

--- src/icfp2014/compiler.clj
+++ src/icfp2014/compiler.clj
@@ -97,6 +97,15 @@
          (map #(code->str fn-addrs %))
          (string/join "\n"))))

+(defn compile-function
+  [[name args & body :as code] fns]
+  {:pre [(list? code)]}
+  (let [fns (assoc fns name {})
+        [stmt & stmts] (mapcat #(compile-form args fns %) body)]
+    (concat [(conj stmt (format "; define %s" name))]
+            stmts
+            [[:rtn]])))
+
 (defn compile-ai
   [file]
   {:pre [(string? file)]
@@ -105,12 +114,6 @@
     (loop [form (read prog false nil)
            fns {}]
       (if form
-        (let [fn-name (first form)
-              args (second form)
-              forms (drop 2 form)
-              vars args
-              fns (assoc fns fn-name {})
-              code (mapcat #(compile-form vars fns %) forms)
-              code (concat code [[:rtn "; return from" fn-name]])]
-          (recur (read prog false nil) (assoc fns fn-name {:name fn-name :code code})))
+        (let [code (compile-function form fns)]
+          (recur (read prog false nil) (assoc fns (first form) {:name (first form) :code code})))
         (emit-code (assign-addresses fns))))))


moved the ]) back to where it was

moved the ]) back to where it was

--- umm-spec-lib/src/cmr/umm_spec/models/umm_common_models.clj
+++ umm-spec-lib/src/cmr/umm_spec/models/umm_common_models.clj
@@ -667,7 +667,7 @@

     ;; The function of the online resource.
     Function
-   ])
+  ])
 (record-pretty-printer/enable-record-pretty-printing OnlineResourceType)

 ;; Represents Internet sites that contain information related to the data, as well as related


CMR-1885 Cleaning up some mappings for readability

--- umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/serf.clj
+++ umm-spec-lib/src/cmr/umm_spec/umm_to_xml_mappings/serf.clj
@@ -128,6 +128,43 @@
        [:URL url])
      [:Description (:Description related-url)]]))

+(defn- create-service-citations
+  "Creates a SERF Service Citation element from a UMM-S Service Citation"
+  [s]
+  (for [service-citation (:ServiceCitation s)]
+    [:Service_Citation
+     [:Originators (:Creator service-citation)]
+     [:Title (:Title service-citation)]
+     [:Provider (:Publisher service-citation)]
+     [:Edition (:Version service-citation)]
+     [:URL (:RelatedURL service-citation)]]))
+
+(defn- create-sensors
+  "Creates SERF Sensor Elements from a UMM-S Instruments mapping"
+  [s]
+  (for [platform (:Platforms s)
+        instrument (:Instruments platform)]
+    [:Sensor_Name
+     [:Short_Name (:ShortName instrument)]
+     [:Long_Name (:LongName instrument)]]))
+
+(defn- create-source-names
+  "Creates SERF Source Name elements from a UMM-S Platforms mapping"
+  [s]
+  (for [platform (:Platforms s)
+           :when (not= (:ShortName platform) "Not provided")]
+       [:Source_Name
+        [:Short_Name (:ShortName platform)]
+        [:Long_Name (:LongName platform)]]))
+
+(defn- create-projects
+  "Creates SERF Project elements from a UMM-S Projects mapping"
+  [s]
+  (for [service-project (:Projects s)]
+    [:Project
+     [:Short_Name (:ShortName service-project)]
+     [:Long_Name (:LongName service-project)]]))
+
 (def inserted-metadata
   "Inserted Metadata by CMR to account for missing fields"
   #{"Metadata_Name" "Metadata_Version" "IDN_Node_Short_Name"})
@@ -140,13 +177,7 @@
      serf-xml-namespaces
      [:Entry_ID (:EntryId s)]
      [:Entry_Title (:EntryTitle s)]
-     (for [service-citation (:ServiceCitation s)]
-       [:Service_Citation
-        [:Originators (:Creator service-citation)]
-        [:Title (:Title service-citation)]
-        [:Provider (:Publisher service-citation)]
-        [:Edition (:Version service-citation)]
-        [:URL (:RelatedURL service-citation)]])
+     (create-service-citations s)
      ;;TODO: CMR-2298 needs to be resolved before we can properly implement this
      (create-root-personnel (:Responsibilities s))
      (create-service-parameters s)
@@ -155,20 +186,9 @@
        [:ISO_Topic_Category topic-category])
      (for [ak (:AncillaryKeywords s)]
        [:Keyword ak])
-     (for [platform (:Platforms s)
-           instrument (:Instruments platform)]
-       [:Sensor_Name
-        [:Short_Name (:ShortName instrument)]
-        [:Long_Name (:LongName instrument)]])
-     (for [platform (:Platforms s)
-           :when (not= (:ShortName platform) "Not provided")]
-       [:Source_Name
-        [:Short_Name (:ShortName platform)]
-        [:Long_Name (:LongName platform)]])
-     (for [service-project (:Projects s)]
-       [:Project
-        [:Short_Name (:ShortName service-project)]
-        [:Long_Name (:LongName service-project)]])
+     (create-sensors s)
+     (create-source-names s)
+     (create-projects s)
      [:Quality (:Quality s)]
      [:AccessConstraints (:AccessContstraints s)]
      [:UseConstraints (:UseConstraints s)]


Add tests for reading from stream & value converters

--- src/test/clojure/clojure/data/json_test.clj
+++ src/test/clojure/clojure/data/json_test.clj
@@ -1,13 +1,13 @@
 (ns clojure.data.json-test
   (:use clojure.test clojure.data.json))

-#_(deftest can-read-from-pushback-reader
+(deftest can-read-from-pushback-reader
   (let [s (java.io.PushbackReader. (java.io.StringReader. "42"))]
-    (is (= 42 (read-json s)))))
-
-#_(deftest can-read-from-reader
+    (is (= 42 (parse s)))))
+
+(deftest can-read-from-reader
   (let [s (java.io.StringReader. "42")]
-    (is (= 42 (read-json s)))))
+    (is (= 42 (parse s)))))

 (deftest can-read-numbers
   (is (= 42 (parse-str "42")))
@@ -15,6 +15,9 @@
   (is (= 3.14159 (parse-str "3.14159")))
   (is (= 6.022e23 (parse-str "6.022e23"))))

+(deftest can-read-bigdec
+  (is (= 3.14159M (parse-str "3.14159" :bigdec true))))
+
 (deftest can-read-null
   (is (= nil (parse-str "null"))))

@@ -73,6 +76,29 @@
 (deftest can-get-string-keys
   (is (= {"a" [1 2 {"b" [3 "four"]} 5.5]}
          (parse-str "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}"))))
+
+(deftest can-keywordize-keys
+  (is (= {:a [1 2 {:b [3 "four"]} 5.5]}
+         (parse-str "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}"
+                    :key-fn keyword))))
+
+(deftest can-convert-values
+  (is (= {:number 42 :date (java.sql.Date. 55 6 12)}
+         (parse-str "{\"number\": 42, \"date\": \"1955-07-12\"}"
+                    :key-fn keyword
+                    :value-fn (fn [k v]
+                                (if (= :date k)
+                                  (java.sql.Date/valueOf v)
+                                  v))))))
+
+(deftest can-omit-values
+  (is (= {:number 42}
+         (parse-str "{\"number\": 42, \"date\": \"1955-07-12\"}"
+                    :key-fn keyword
+                    :value-fn (fn thisfn [k v]
+                                (if (= :date k)
+                                  thisfn
+                                  v))))))

 (declare pass1-string)