presnap actions

presnap actions

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

--- clojure/acq_engine.clj
+++ clojure/acq_engine.clj
@@ -9,7 +9,7 @@
            [java.util.prefs Preferences]
            [org.micromanager.utils ChannelSpec]))

-;; java interop
+;; general utils
 (defn data-object-to-map [obj]
   (into {}
     (for [f (.getFields (type obj))
@@ -17,10 +17,9 @@
                          (.getModifiers f) java.lang.reflect.Modifier/STATIC))]
       [(keyword (.getName f)) (.get f obj)])))

-(defmacro apply-method [& args]
+(defmacro apply-member [& args]
   `(~@(drop-last args) ~@(eval (last args))))

-;; utils
 (defn rekey
   ([m kold knew]
     (-> m (dissoc kold) (assoc knew (get m kold))))
@@ -28,11 +27,7 @@
     (reduce #(apply rekey %1 %2)
       m (partition 2 (conj ks knew kold)))))

-; mmc utils
-(defn set-stage-position
-  ([stage-dev z] (. mmc setPosition z))
-  ([stage-dev x y] (. mmc setXYPosition x y)))
-
+;; mm utils
 (defn get-default-devices []
   {:camera          (. mmc getCameraDevice)
    :shutter         (. mmc getShutterDevice)
@@ -60,7 +55,9 @@
       :doZStack_               :use-z-stack
       :skipFactorFrame_        :skip-frames
       :useChannel_             :use-channel
+      :color_                  :color
     )
+    (dissoc :name_ :contrast16_ :contrast8_ :min_ :max_)
     (assoc :properties (get-config (. mmc getChannelGroup) (.config_ chan)))))

 (defn MultiStagePosition-to-map [^MultiStagePosition msp]
@@ -73,7 +70,32 @@
               1 [(.x stage-pos)]
               2 [(.x stage-pos) (.y stage-pos)])])))})

-; engine
+;; acq-engine
+
+(defn set-stage-position
+  ([stage-dev z] (. mmc setPosition stage-dev z))
+  ([stage-dev x y] (. mmc setXYPosition stage-dev x y)))
+
+(def device-agents
+  (let [devs (seq (. mmc getLoadedDevices))]
+    (zipmap devs (repeatedly (count devs) #(agent nil)))))
+
+(defn create-presnap-actions [event]
+  (into {} (concat
+    (for [[axis pos] (get-in event [:position :axes])]
+      [axis #(apply set-stage-position axis pos)])
+    (for [prop (get-in event [:channel :properties])]
+      [(prop 0) #(.setProperty mmc (prop 0) (prop 1) (prop 2))]))))
+
+(defn send-device-action [dev action]
+  (send-off (device-agents dev) (fn [_] (action))))
+
+(defn run-actions [action-map]
+  (doseq [[dev action] action-map]
+    (send-device-action dev action))
+  (doseq [dev (keys action-map)]
+    (send-device-action dev #(. mmc waitForDevice dev)))
+  (apply await-for 10000 (vals device-agents)))

 (defn snap-image [event auto-shutter]
   (if (and auto-shutter (. mmc getShutterOpen))
@@ -157,7 +179,7 @@
   (-> settings
     (data-object-to-map)
     (assoc :frames (range (.numFrames settings))
-           :channels (map ChannelSpec-to-map (.channels settings))
+           :channels (filter :use-channel (map ChannelSpec-to-map (.channels settings)))
            :positions (map MultiStagePosition-to-map (.positions settings)))
     (rekey
       :slicesFirst             :slices-first


Formatting change

Formatting change

--- spec/rook/rook_spec.clj
+++ spec/rook/rook_spec.clj
@@ -1,20 +1,18 @@
 (ns rook.rook-spec
-  (:use
-  io.aviso.rook
-  speclj.core
-  clojure.template)
-  (:require
-    [io.aviso.rook.dispatcher :as d]
-    rook-test
-    rook-test2
-    rook-test3
-    rook-test4
-    rook-test5
-    rook-test6
-    [ring.mock.request :as mock]
-    ring.middleware.params
-    ring.middleware.keyword-params
-    [io.aviso.rook :as rook]))
+  (:use io.aviso.rook
+        speclj.core
+        clojure.template)
+  (:require [io.aviso.rook.dispatcher :as d]
+            rook-test
+            rook-test2
+            rook-test3
+            rook-test4
+            rook-test5
+            rook-test6
+            [ring.mock.request :as mock]
+            ring.middleware.params
+            ring.middleware.keyword-params
+            [io.aviso.rook :as rook]))

 (defn param-handling [handler]


handle arg is a sequence: treat as the output of (toks)

--- src/babel/parse.cljc
+++ src/babel/parse.cljc
@@ -171,5 +171,11 @@
         ;; return the largest subparse(s).
         (get (create-xgram-map arg (count arg) 0 grammar)
              [0 (count arg)])
+
+        (seq? arg)
+        (mapcat #(parse (vec %) lookup grammar)
+                arg)
+
+        ;; TODO: throw exception here.
         true
         (str "unexpected input: type: " (type arg))))


fix read-ctor

fix read-ctor

--- src/blind/reader.clj
+++ src/blind/reader.clj
@@ -845,7 +845,7 @@
                 (if-not (instance? Keyword (first s))
                   (reader-error rdr "Unreadable ctor form: key must be of type clojure.lang.Keyword")
                   (recur (next s)))))
-            (Reflector/invokeStaticMethod class "create" (to-array vals)))))
+            (Reflector/invokeStaticMethod class "create" (object-array [vals])))))
       (reader-error rdr "Invalid reader constructor form"))))

 (defn read-tagged [rdr initch]


Formatting & whitespace

Formatting & whitespace

--- src/braid/lib/s3.clj
+++ src/braid/lib/s3.clj
@@ -66,18 +66,18 @@
           (string/join "/" [(.format utc-now aws/basic-date-format) region "s3"
                             "aws4_request"])
           (aws/canonical-request
-           {:method "GET"
-            :path (str "/" path)
-            :query-string query-str
-            :headers {"host" (str bucket ".s3." region ".amazonaws.com")}
-            :body nil})]
+            {:method "GET"
+             :path (str "/" path)
+             :query-string query-str
+             :headers {"host" (str bucket ".s3." region ".amazonaws.com")}
+             :body nil})]
          (string/join "\n")
          aws/str->bytes
          (aws/hmac-sha256
-          (aws/signing-key {:aws-api-secret api-secret
-                            :aws-region region
-                            :day (.format utc-now aws/basic-date-format)
-                            :service "s3"}))
+           (aws/signing-key {:aws-api-secret api-secret
+                             :aws-region region
+                             :day (.format utc-now aws/basic-date-format)
+                             :service "s3"}))
          aws/bytes->hex)))

 (defn readable-s3-url
@@ -93,12 +93,11 @@
                        (str "&X-Amz-Expires=" expires-seconds)
                        "&X-Amz-SignedHeaders=host"
                        (when ?security-token
-                         (str "&X-Amz-Security-Token=" (URLEncoder/encode ?security-token "UTF-8"))) )]
+                         (str "&X-Amz-Security-Token=" (URLEncoder/encode ?security-token "UTF-8"))))]
     (str "https://" (s3-host config)
          "/" path
          "?" query-str
-         "&X-Amz-Signature=" (get-signature config utc-now path query-str)
-         )))
+         "&X-Amz-Signature=" (get-signature config utc-now path query-str))))

 (defn- make-request
   [{:aws/keys [credentials-provider] region :aws-region bucket :aws-bucket :as config} {:keys [body method path] :as request}]


Fix Tech Trader message

Fix Tech Trader message

--- src/clj/game/cards-resources.clj
+++ src/clj/game/cards-resources.clj
@@ -761,7 +761,7 @@

    "Tech Trader"
    {:events {:runner-trash {:req (req (and (= side :runner) (= (second targets) :ability-cost)))
-                            :msg "Gain a credit"
+                            :msg "gain 1 [Credits]"
                             :effect (effect (gain :credit 1))}}}

    "Technical Writer"


Sign session token for aws requests

Sign session token for aws requests

--- src/braid/lib/s3.clj
+++ src/braid/lib/s3.clj
@@ -59,7 +59,7 @@

 (defn- get-signature
   [{:aws/keys [credentials-provider] region :aws-region bucket :aws-bucket :as config} utc-now path query-str]
-  (let [[_ api-secret] (credentials-provider)]
+  (let [[_ api-secret ?security-token] (credentials-provider)]
     (->> ["AWS4-HMAC-SHA256"
           (.format utc-now aws/basic-date-time-format)
           (string/join "/" [(.format utc-now aws/basic-date-format) region "s3"
@@ -68,7 +68,9 @@
            {:method "GET"
             :path (str "/" path)
             :query-string query-str
-            :headers {"host" (str bucket ".s3." region ".amazonaws.com")}
+            :headers (cond-> {"host" (str bucket ".s3." region ".amazonaws.com")}
+                       ?security-token
+                       (assoc "x-amz-security-token" ?security-token))
             :body nil})]
          (string/join "\n")
          aws/str->bytes
@@ -87,23 +89,27 @@
                        "&X-Amz-Credential=" api-key "/" (.format utc-now aws/basic-date-format) "/" region "/s3/aws4_request"
                        "&X-Amz-Date=" (.format utc-now aws/basic-date-time-format)
                        (str "&X-Amz-Expires=" expires-seconds)
-                       "&X-Amz-SignedHeaders=host")]
+                       "&X-Amz-SignedHeaders=host"
+                       (when ?security-token
+                         (str "&X-Amz-Security-Token=" (URLEncoder/encode ?security-token "UTF-8"))) )]
     (str "https://" (s3-host config)
          "/" path
          "?" query-str
          "&X-Amz-Signature=" (get-signature config utc-now path query-str)
-         (when ?security-token
-           (str "&X-Amz-Security-Token=" (URLEncoder/encode ?security-token "UTF-8"))))))
+         )))

 (defn- make-request
   [{:aws/keys [credentials-provider] region :aws-region bucket :aws-bucket :as config} {:keys [body method path] :as request}]
   (let [[api-key api-secret ?session-token] (credentials-provider)
         utc-now (aws/utc-now)
-        req (update request :headers
-                    assoc
-                    "x-amz-date" (.format utc-now aws/basic-date-time-format)
-                    "x-amz-content-sha256" (aws/hex-hash body)
-                    "Host" (str (s3-host config) ":443"))]
+        req (cond->
+                (update request :headers
+                        assoc
+                        "x-amz-date" (.format utc-now aws/basic-date-time-format)
+                        "x-amz-content-sha256" (aws/hex-hash body)
+                        "Host" (str (s3-host config) ":443"))
+              ?session-token (assoc-in [:headers "x-amz-security-token"]
+                                       ?session-token))]
     (-> req
         (dissoc :method :path :query-string)
         (assoc-in [:headers "Authorization"]
@@ -115,7 +121,7 @@
                                     :aws-region region}))
         (cond->
             ?session-token
-          (assoc-in [:headers "X-Amz-Security-Token"] ?session-token)))))
+          (assoc-in [:headers "x-amz-security-token"] ?session-token)))))


simplify logic

simplify logic


A bit more refactoring of components

A bit more refactoring of components


Fix a reflection warning on a static method argument type

eastwood said: "Reflection warning - call to static method
encodeHexString on org.apache.commons.codec.binary.Hex can't be
resolved (argument types: unknown)."

The `encodeHexString` method has several variants for different
argument types. Looking through the codebase it doesn't seem we
use the `hexify` method for anything but the bytes, so it's safe
to add a type hint here and get rid of the warning.

--- src/caesium/util.clj
+++ src/caesium/util.clj
@@ -11,7 +11,7 @@
   (.decode (Hex.) (.getBytes s)))

 (defn hexify
-  [b]
+  [^bytes b]
   (Hex/encodeHexString b))

 (defn n->bytes


[Fix] error delete

[Fix] error delete

when delete type notification

--- src/clj_elm/data.clj
+++ src/clj_elm/data.clj
@@ -18,13 +18,13 @@

 (defn data-set
   "Make DataSet from incanter-form or csv dataset. Cidx is column number of class."
-  ([cidx]
+  ([dataset cidx]
    {:pre [(c/dataset? dataset)]}
    (DataSet. (pmap int (c/to-vect (c/$ :all cidx dataset))) (c/to-vect (c/$ [:not cidx] dataset)))))

 (defn read-dataset
-  ([& {:keys [header] :or {header false}}]
-   {:pre [(string? path) (integer? cidx)]}
+  ([path cidx & {:keys [header] :or {header false}}]
+   {:pre [(string? path) (integer? cidx)]}
    (-> (io/read-dataset path :delim \, :header header)
        (data-set cidx))))

@@ -36,7 +36,7 @@
         (#(DataSet. (map first %) (map second %))))))

 (defn concat-dataset
-  ([dsb]
+  ([dsa dsb]
    {:pre [(instance? DataSet dsa) (instance? DataSet dsb)]}
    (DataSet. (concat (:classes dsa) (:classes dsb))
              (concat (:features dsa) (:features dsb)))))
@@ -48,47 +48,47 @@
        (shuffle)
        (#(DataSet. (pmap first %) (pmap second %))))))

-(defn num-of-feature
+(defn num-of-feature
   ([dataset]
    {:pre [(coll? dataset)]}
    (count (first (:features dataset)))))

-(defn ith-feature-list
-  ([i]
+(defn ith-feature-list
+  ([dataset i]
    {:pre [(coll? dataset) (integer? i)]}
    (c/$ i (c/to-dataset dataset))))

-(defn each-ith-f
+(defn each-ith-f
   ([f dataset]
    (->> (range 0 (count (first dataset)))
         (pmap #(f (ith-feature-list dataset %)))
         (vec))))

-(defn each-ith-mean
+(defn each-ith-mean
   ([dataset]
    {:pre [(coll? dataset)]}
    (each-ith-f st/mean dataset)))

-(defn each-ith-sd
+(defn each-ith-sd
   ([dataset]
    {:pre [(coll? dataset)]}
    (each-ith-f st/sd dataset)))

-(defn
+(defn normalize
   ([dataset]
    {:pre [(coll? dataset)]}
    (let [means (each-ith-mean dataset)
-         sds (each-ith-sd dataset)]
+         sds (each-ith-sd dataset)]
      (->> (c/to-vect dataset)
           (pmap #(map - % means))
           (pmap #(map / % sds))))))

 (defn remove-list
-  ([b]
+  ([lst a b]
    {:pre [(coll? lst) (integer? a) (integer? b) (> b a)]}
    (concat (take a lst) (drop (inc b) lst))))

 (defn extract-list
-  ([b]
+  ([lst a b]
    {:pre [(coll? lst) (integer? a) (integer? b) (> b a)]}
    (take (inc (- b a)) (drop a lst))))


Fixed error in remove-parens-at-point.

Fixed error in remove-parens-at-point.

--- src/clojush/util.clj
+++ src/clojush/util.clj
@@ -96,11 +96,7 @@
       (let [z-found (loop [z zipper i index]
                       (if (zero? i)
                         z
-                        (if (and (= i 1) ;; can't remove only item from list
-                                 (seq? (zip/node z))
-                                 (= 1 (count (zip/node z))))
-                          (zip/root z) ;(zip/remove z))
-                          (recur (zip/next z) (dec i)))))]
+                        (recur (zip/next z) (dec i))))]
         (if (not (seq? (zip/node z-found))) ;can't un-paren non-seq things
           (zip/root z-found)
           (if (empty? (zip/children z-found)) ;seq is empty, just remove it


Fix throttling of http requests

Fix throttling of http requests

--- src/attercop/spider.clj
+++ src/attercop/spider.clj
@@ -121,7 +121,8 @@
               (alts! [ch-throttle (timeout wait)]))
             (let [diff-ts (- (System/currentTimeMillis) begin-ts)]
               (if (< diff-ts interval)
-                (Thread/sleep (- interval diff-ts)))))))
+                (Thread/sleep (- interval diff-ts)))))
+          (recur)))
     ch-throttle))


cleanup

cleanup

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -51,17 +51,15 @@
      (map (fn [bolt]
             (let [comp-paths-to-complements
                   (comp-paths-to-complements bolt (find-comp-paths bolt) model depth max-depth)]
-              (if (not (some empty? comp-paths-to-complements))
-                (merge
-                 {[]
-                  (filter not-fail? [bolt])}
-                 comp-paths-to-complements)))))
-     (map (fn [each-bolt-and-comps]
-            (map (fn [each-path-through-trellis]
-                   (zipmap (keys each-bolt-and-comps)
-                           each-path-through-trellis))
-                 (apply combo/cartesian-product (vals each-bolt-and-comps)))))
-     flatten
+              (if (and (not-fail? bolt)
+                       (not (some empty? comp-paths-to-complements)))
+                (assoc comp-paths-to-complements
+                       [] [bolt])))))
+     (mapcat (fn [each-bolt-and-comps]
+               (map (fn [each-path-through-trellis]
+                      (zipmap (keys each-bolt-and-comps)
+                              each-path-through-trellis))
+                    (apply combo/cartesian-product (vals each-bolt-and-comps)))))
      (map (fn [bolt-and-comps]
             (log/debug (str "doing defaults on: " depth "/" max-depth ":" ((:morph-ps model) (get bolt-and-comps []))))
             (do-defaults


less verbose logging

less verbose logging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -192,7 +192,7 @@
     (if (empty? complements)
       (log/warn (str "(improve grammar): no complements found for: "
                      ((:morph-ps model) bolt)
-                     "; spec=" (dag_unify.core/strip-refs
+                     "; spec=" (show-spec
                                 (get-in bolt path))))
       (->>
        ;; set of all complements at _path_ for _bolt_:


File and URL primitives and coercions

File and URL primitives and coercions

--- planck-cljs/src/planck/io.cljs
+++ planck-cljs/src/planck/io.cljs
@@ -1,4 +1,42 @@
-(ns planck.io)
+(ns planck.io
+  (:import goog.Uri))
+
+(defrecord File [path])
+
+(defn build-uri
+  "Builds a URI"
+  [scheme server-name server-port uri query-string]
+  (doto (Uri.)
+    (.setScheme (name (or scheme "http")))
+    (.setDomain server-name)
+    (.setPort server-port)
+    (.setPath uri)
+    (.setQuery query-string true)))
+
+(defprotocol Coercions
+  "Coerce between various 'resource-namish' things."
+  (^File as-file [x] "Coerce argument to a File.")
+  (^js/goog.Uri as-url [x] "Coerce argument to a goog.Uri."))
+
+(extend-protocol Coercions
+  nil
+  (as-file [_] nil)
+  (as-url [_] nil)
+
+  string
+  (as-file [s] (File. s))
+  (as-url [s] (Uri. s))
+
+  File
+  (as-file [f] f)
+  (as-url [f] (build-uri :file nil nil (:path f) nil))
+
+  js/goog.Uri
+  (as-url [u] u)
+  (as-file [u] u
+    (if (= "file" (.getScheme u))
+      (as-file (.getPath u))
+      (throw (js/Error. (str "Not a file: " u))))))

 (defprotocol IReader
   (-read [this] "Returns available characters as a string or nil of EOF."))


length is already destructured

length is already destructured

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -269,7 +269,7 @@
        ;; A length of -1 instructs HttpClient to use chunked encoding.
        (instance? InputStream body)
        (client (-> req (assoc :body
-                         (InputStreamEntity. body (or (:length req) -1)))))
+                         (InputStreamEntity. body (or length -1)))))

        (instance? (Class/forName "[B") body)
        (client (-> req (assoc :body (ByteArrayEntity. body))))


* src/cljs/cljs/core.cljs: move some declares around

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -75,6 +75,8 @@
 @param {...*} var_args" ;;array is a special case, don't emulate this doc string
   [var-args]            ;; [& items]
   (js* "Array.prototype.slice.call(arguments)"))
+
+(declare apply)

 (defn aget
   "Returns the value at the index."
@@ -217,6 +219,8 @@
   [x y]
   (cljs.core/identical? x y))

+(declare first next)
+
 (defn ^boolean =
   "Equality. Returns true if x equals y, false if not. Compares
   numbers and collections in a type-independent manner.  Clojure's immutable data
@@ -1056,8 +1060,6 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;; basics ;;;;;;;;;;;;;;;;;;
-
-(declare apply)

 (defn- str*
   "Internal - do not use!"


`chunked-seq?` for now checks for concrete types `ChunkedCons` and `ChunkedSeq`. this is an optimization for `doseq` and `for`. calling `satisfies?` to check for chunked seqs is slow for the failing case - normal seqs.

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1029,8 +1029,12 @@
   "Return true if x satisfies IVector"
   [x] (satisfies? IVector x))

+(declare ChunkedCons ChunkedSeq)
+
 (defn ^boolean chunked-seq?
-  [x] (satisfies? IChunkedSeq x))
+  [x]
+  (or (instance? ChunkedCons x)
+      (instance? ChunkedSeq x)))

 ;;;;;;;;;;;;;;;;;;;; js primitives ;;;;;;;;;;;;
 (defn js-obj


optimize reset!

optimize reset!

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -6964,11 +6964,13 @@
   "Sets the value of atom to newval without regard for the
   current value. Returns newval."
   [a new-value]
-  (when-let [validate (.-validator a)]
-    (assert (validate new-value) "Validator rejected reference state"))
+  (let [validate (.-validator a)]
+    (when-not (nil? validate)
+      (assert (validate new-value) "Validator rejected reference state")))
   (let [old-value (.-state a)]
     (set! (.-state a) new-value)
-    (-notify-watches a old-value new-value))
+    (when-not (nil? (.-watches a))
+      (-notify-watches a old-value new-value)))
   new-value)

 (defn swap!


Proper date test (non-ideal)

Proper date test (non-ideal)

--- src/derive/core.cljs
+++ src/derive/core.cljs
@@ -241,8 +241,8 @@
       (vector? val)
       (list? val)
       (nil? val)
-      (date? val)
       (satisfies? IDependencySource val)
+      (= (type val) (type (js/Date.)))
       (and (not (undefined? js/moment))
            (= (type val) (type (js/moment))))))


Pull apart plotting a bit, for better composition

--- src/fatlip/plot.cljs
+++ src/fatlip/plot.cljs
@@ -796,38 +796,49 @@
                                 dest-start-x dest-end-x))))

-(defn plot
-  "Generates coordinates for all paths in a FlatGraph"
-  [flat-graph max-slope min-arc-radius layer-sep node-sep char-sep]
-  (let [{:keys [layers characters]} flat-graph
-        node-ys (plot-ys flat-graph node-sep char-sep)
-        paths-y (->> (nodes flat-graph)
-                     (mapcat (fn [node]
-                               (map-indexed (fn [i c]
-                                              {:node node
-                                               :character c
-                                               :order i})
-                                            (get characters node))))
-                     (map (fn [info]
-                            (let [node (:node info)
-                                  node-top-y (get node-ys node)]
-                              (assoc info
-                                     :node-y [node-top-y
-                                              (+ node-top-y
-                                                 (* char-sep
-                                                    (dec (:weight node))))]
-                                     :y (+ node-top-y (* (:order info)
-                                                         char-sep))))))
-                     (group-by :character)
-                     (map (fn [[character infos]]
-                            [character (pair-up infos)]))
-                     (map (fn [[character pair-maps]]
-                            [character (add-y-info pair-maps min-arc-radius
-                                                   char-sep)])))
-        layer-xs (absolute-layer-xs paths-y layers max-slope layer-sep)]
+(defn plot-xs
+  [paths-y layers max-slope layer-sep]
+  (let [layer-xs (absolute-layer-xs paths-y layers max-slope layer-sep)]
     (->> paths-y
          (map (fn [[character pair-maps]]
                 [character (add-x-info pair-maps layer-xs)]))
          (map (fn [[character pair-maps]]
                 {:character character
                  :plots (reduce char-plots [] pair-maps)})))))
+
+
+(defn pathify
+  [node-ys nodes characters min-arc-radius char-sep]
+  (->> nodes
+       (mapcat (fn [node]
+                 (map-indexed (fn [i c]
+                                {:node node
+                                 :character c
+                                 :order i})
+                              (get characters node))))
+       (map (fn [info]
+              (let [node (:node info)
+                    node-top-y (get node-ys node)]
+                (assoc info
+                       :node-y [node-top-y
+                                (+ node-top-y
+                                   (* char-sep
+                                      (dec (:weight node))))]
+                       :y (+ node-top-y (* (:order info)
+                                           char-sep))))))
+       (group-by :character)
+       (map (fn [[character infos]]
+              [character (pair-up infos)]))
+       (map (fn [[character pair-maps]]
+              [character (add-y-info pair-maps min-arc-radius
+                                     char-sep)]))))
+
+
+(defn plot
+  "Generates coordinates for all paths in a FlatGraph"
+  [flat-graph max-slope min-arc-radius layer-sep node-sep char-sep]
+  (let [{:keys [layers characters]} flat-graph]
+    (-> flat-graph
+        (plot-ys node-sep char-sep)
+        (pathify (nodes flat-graph) characters min-arc-radius char-sep)
+        (plot-xs layers max-slope layer-sep))))


key seq in state

key seq in state

--- src/fugue/space.cljs
+++ src/fugue/space.cljs
@@ -11,10 +11,8 @@
    :active 1
    :next-id 2
    :result nil
-   :files {1 "(+ 1 23)"}})
-
-(defn foo []
-  "nice")
+   :files {1 "(+ 1 23)"}
+   :key-seq nil})

 (defn current-buffer-text [state]
   (get-in state [:files (:active state)]))
@@ -26,12 +24,6 @@
            (if-let [source (get-in state [:files (str :name m)])]
              (cb {:lang :clj :source source})
              (cb nil)))})
-
-(defn on-eval [state result]
-  (-> state
-      (assoc-in [:files (:next-id state)] (:value result))
-      (update :boxes b/insert :after (:active state) (:next-id state))
-      (update :next-id inc)))

 (defn boxes [state {:keys [on-box-click on-text-change on-shortcut]}]
   [b/boxes-container
@@ -66,48 +58,65 @@

 (defn popup-content [key-seq]
   [:div.popup>ul
+   [:p (str key-seq)]
    (for [option (popup-options key-seq)]
      [:li option])])

+(defn show-popup [state]
+  (assoc state :key-seq []))
+
+(defn hide-popup [state]
+  (assoc state :key-seq nil))
+
+(defn activate [state id]
+  (-> state
+      (assoc :active id)
+      (hide-popup)))
+
+(defn on-eval [state result]
+  (-> state
+      (hide-popup)
+      (assoc-in [:files (:next-id state)] (:value result))
+      (update :boxes b/insert :after (:active state) (:next-id state))
+      (activate (:next-id state))
+      (update :next-id inc)))
+
+(defn on-key [state actions key]
+  (cond
+    (and (empty (:key-seq state)) (= " " key))
+    (show-popup state)
+    (and (not-empty (:key-seq state)) (= "Escape" key))
+    (hide-popup state)
+    :else
+    (let [new-seq (conj (:key-seq state) key)]
+      (if-let [action (get actions new-seq)]
+        (action (assoc state :key-seq nil))
+        (assoc state :key-seq new-seq)))))
+
 (defn app []
   (let [eval-state (cljs.js/empty-state)
-        state (r/atom init-state)
-        popup (r/atom nil)]
+        state (r/atom init-state)]
     (defn eval! []
       (let [[source settings] ((juxt current-buffer-text eval-settings) @state)
             cb (partial swap! state on-eval)]
-        (print "evaling")
-        (.log js/console source)
         (cljs.js/eval-str eval-state source nil settings cb)))
-    (defn show-popup! []
-      (reset! popup []))
-    (defn hide-popup! []
-      (reset! popup nil))
     (defn on-keydown [e]
-      (let [key (.-key e)]
-        (cond
-          (and (not @popup)
-               (= " " key)
-               (not= "textarea" (s/lower-case (.-tagName (.-activeElement js/document)))))
-          (do
-            (print (.-tagName (.-activeElement js/document)))
-            (show-popup!))
-          (not (nil? @popup))
-          (do
-            (.preventDefault e)
-            (case key
-              "Escape" (hide-popup!)
-              (swap! popup conj key))))))
-    (.defineAction js/CodeMirror.Vim "space!" show-popup!)
+      (let [in-popup (some? (:key-seq @state))
+            in-textbox (= "TEXTAREA" (.. js/document -activeElement -tagName))
+            key (.-key e)]
+        (when (or in-popup (not in-textbox))
+          (.preventDefault e)
+          (swap! state on-key {} key))))
+    (.defineAction js/CodeMirror.Vim "space!" #(swap! state show-popup))
     (.mapCommand js/CodeMirror.Vim "<Space>" "action" "space!" #js {} #js {"context" "normal"})
     (.addEventListener js/document "keydown" on-keydown)
     (fn []
       [:div.boxes
        [boxes
         @state
-        {:on-box-click (partial swap! state assoc :active)
-         :on-text-change (fn [id new-text] (swap! state assoc-in [:files id] new-text))
-         :on-shortcut show-popup!}]
-       (if-let [keys @popup]
-         [popup-content (drop 1 keys)])])))
-
+        {:on-box-click #(swap! state activate %)
+         :on-text-change (fn [id new-text]
+                           (swap! state assoc-in [:files id] new-text))
+         :on-shortcut #(swap! state show-popup)}]
+       (if-let [keys (:key-seq @state)]
+         [popup-content keys])])))


pull start-queue out of start-queues; pass db-conn to worker-fn

--- src/gangway/util.clj
+++ src/gangway/util.clj
@@ -11,19 +11,23 @@
                   ;; having a :worker-fn implies that galleon should start a listener
                   :worker-fn gw-worker/do-work}})

+(defn start-queue! [system [k q]]
+  (let [n (:name q)
+        worker-fn (:worker-fn q)]
+    (msg/start n)
+    (if worker-fn
+      (msg/listen n (partial worker-fn (:db-conn system))))))
+
+
 (defn start-queues!
 ;; TODO: handle exceptions
   ([system] (start-queues! system queues))
   ([system queues]
-     (dorun
-      (map (fn start-queues!- [[k q]]
-             (msg/start (:name q))
-             (if (:worker-fn q)
-               (msg/listen (:name q) (:worker-fn q))))
-           queues))
-     (assoc-in system [:gangway :queues]
-               (set (concat (get-in system [:gangway :queues])
-                            (keys queues))))))
+     (dorun (map (partial start-queue! system) queues))
+     (let [path [:gangway :queues]]
+       (assoc-in system path
+                 (set (concat (get-in system path)
+                              (keys queues)))))))

 (defn stop-queues!
 ;; TODO: handle exceptions


working on shrinking (lightning-bolt) to make it easier to understand and debug

--- src/babel/forest.cljc
+++ src/babel/forest.cljc
@@ -63,7 +63,7 @@
                           (generate-all (rest spec) grammar lexicon index morph))
                 true
                 (do
-                  (log/debug (str "generate-all: (cat= " (get-in spec [:synsem :cat])))
+                  (log/debug (str "generate-all: cat: " (get-in spec [:synsem :cat])))
                   (log/trace (str "generate-all with pred: " (show-spec (remove-false (get-in spec [:synsem :sem :pred])))))
                   (log/trace (str "generate-all(details): " (show-spec spec)))
                   (let [lb (lightning-bolt (lazy-shuffle grammar)
@@ -109,15 +109,15 @@
                                 "no candidate heads found."
                                 (str "one or more candidate heads found; first: " (:rule (first candidate-heads))))))
         debug (if (not (empty? candidate-heads))
-                (log/debug (str "candidate-heads: " (string/join "," (map #(get-in % [:rule])
-                                                                          candidate-heads))))
+                (log/debug (str "lightning-bolt: candidate-heads: " (string/join "," (map #(get-in % [:rule])
+                                                                                candidate-heads))))
                 (log/trace (str "no candidate head phrases for spec: " (strip-refs spec))))]
     (if (seq candidate-heads)
       (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
             (mapcat (fn [parent]
                       (if (= false (get-in parent [:head :phrasal] false))
                         (let [candidate-lexemes (get-lex parent :head index spec)]
-                          (log/debug (str "candidate lexemes for: " (get-in parent [:rule]) " empty?:" (empty? candidate-lexemes)))
+                          (log/debug (str "lightning-bolt: candidate lexemes for: " (get-in parent [:rule]) " empty?:" (empty? candidate-lexemes)))
                           (if (some fail? candidate-lexemes)
                             (throw (exception (str "some candidate lexeme was fail?=true!"))))
                           (log/trace
@@ -157,17 +157,10 @@
                                               (get-in parent [:head])
                                               (+ 1 depth)
                                               index morph)]
-                          (if (empty? phrasal-children)
-                            (let [message (str "no phrasal children for parent: '" (morph parent) "' with rule: " (get-in parent [:rule]) ") and cat: " (get-in spec [:synsem :cat]))]
-                              (log/debug message))
-                            ;; else; there are phrasal-children, so attach them below parent:
-                            (do
-                              (log/debug (str "phrasal-children:" (string/join "," (map morph phrasal-children))))
-                              (log/debug (str "calling overh with parent: [" (get-in parent [:rule]) "]:" "'" (morph parent) "'"
-                                              " and " (count phrasal-children) " phrasal children."))
-                              (over/overh parent phrasal-children morph)))
-                          )
-                        )
+                          (log/debug (str "phrasal-children:" (string/join "," (map morph phrasal-children))))
+                          (log/debug (str "calling overh with parent: " (get-in parent [:rule])
+                                          " and phrasal children."))
+                          (over/overh parent phrasal-children morph)))
                        (remove nil? candidate-heads)))]
         (if (lexemes-before-phrases)
           (lazy-cat lexical phrasal)


The :series-type can contain multiple entries

handle this case properly

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -345,7 +345,7 @@
          genre-code ""}}] ; an invalid genre-code
   (let [fmt (format-raw-to-format format)
         ;; print-and-braille books have a special series-type
-        print-and-braille? (when (= series-type "printundbraille") true)
+        print-and-braille? (when (some #{"printundbraille"} series-type) true)
         fmt (cond
               ;; tactile books aren't properly tagged in the format
               ;; field. They are tagged as :ludo and their library
@@ -777,7 +777,7 @@
     (for [record (xml-> root :record)]
       (->> (for [[key path] param-mapping
                  :let [val (cond
-                             (#{:narrators :subtitles} key) (get-multi-subfields record path)
+                             (#{:narrators :subtitles :series-type} key) (get-multi-subfields record path)
                              (#{:general-information} key) (get-controlfield record path)
                              :else (get-subfield record path))]
                  :when (some? val)]


Guard against StringIndexOutOfBoundsException

if genre is too short

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -218,7 +218,8 @@
                   :language (iso-639-2-to-iso-639-1 language)
                   :genre (or (genre-raw-to-genre (subs genre 0 1))
                              (genre-code-to-genre (subs genre-code 0 2)))
-                  :sub-genre (genre-raw-to-subgenre (subs genre 0 3))
+                  :sub-genre (and (>= (count genre) 3)
+                                  (genre-raw-to-subgenre (subs genre 0 3)))
                   :genre-text genre-text
                   :format fmt
                   :producer-brief (producer-raw-to-producer (parse-int producer))


nicer response

nicer response

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -87,7 +87,7 @@
          (if-let [actions (p/find-action-for (keyword action) (:type system))]
            (let [args {:identity id :args [actions {:action (keyword action) :target (machine :ip)}]}
                  job (jobs/enqueue "run-action" args)]
-             (success {:msg "submitted action" :action action :job job}))
+             (success {:msg "submitted action" :id id :action action :job job}))
            (bad-req {:msg (<< "No action ~{action} found for id ~{id}")})
            )))


Stream JSON in 1024-byte chunks

Stream JSON in 1024-byte chunks

--- src/cfpb/qu/views.clj
+++ src/cfpb/qu/views.clj
@@ -391,7 +391,7 @@
     (future
       (with-open [out (PipedOutputStream. in)]
         (json/generate-stream resource (io/writer out))))
-    (send-stream request response in 100)
+    (send-stream request response in 1024)
     (ring-response {})))

 (defmethod slice-query "text/javascript" [_ resource {:keys [callback]}]


Proxy channel to outputstream for easier streaming, faster speed

Based off this comment: https://github.com/http-kit/http-kit/issues/76#issuecomment-22427630

--- src/cfpb/qu/views.clj
+++ src/cfpb/qu/views.clj
@@ -347,65 +347,52 @@
   (> (->int (get-in resource [:properties :size]) 0)
      *min-records-to-stream*))

-(defn send-stream
-  [request response ^java.io.InputStream is len]
-  (let [buf (char-array len)]
-    (with-open [is (io/reader is)]
-      (with-channel request channel
-        (loop [n (.read is buf)]
-          (let [string (apply str (take n buf))]
-            (send! channel (assoc response :body string) false)
-            (when-not (= n -1)
-              (recur (.read is buf)))))
-        (close channel)))))
+(defn- ch->outputstream [ch]
+  (proxy [java.io.OutputStream] []
+    (close []
+       (close ch))
+    (write
+      ([^bytes bs] ;; bytes of byte
+         (send! ch (String. bs) false))
+      ([^bytes bs off len]
+         (send! ch (String. bs off len) false)))))
+
+(defn- ch->writer [ch]
+  (io/writer (ch->outputstream ch)))

 (defn- stream-slice-query-csv
-  [request response columns rows]
-  (let [size 100]
-    (with-channel request channel
-      (send! channel (assoc response :body (write-csv (vector columns))) false)
-      (loop [rows rows]
-        (if (empty? rows)
-          (close channel)
-          (do
-            (send! channel
-                   (assoc response :body (write-csv (take size rows)))
-                   false)
-            (recur (drop size rows))))))))
+  [request response data]
+  (with-channel request ch
+    (send! ch response false)
+    (csv/write-csv (ch->writer ch) data)
+    (close ch))
+  (ring-response response))

 (defn- stream-slice-query-json
   [request response resource]
-  (let [resource (hal/json-representation resource)
-        in (PipedInputStream. *stream-size*)
-        out (PipedOutputStream. in)]
-    (future
-      (with-open [out (io/writer out)]
-        (json/generate-stream resource out)))
-    (send-stream request response in *stream-size*)
+  (let [resource (hal/json-representation resource)]
+    (with-channel request ch
+      (send! ch response false)
+      (json/generate-stream resource (ch->writer ch))
+      (close ch))
     (ring-response response)))

 (defn- stream-slice-query-jsonp
-  [request response resource callback]
-  (let [resource (hal/json-representation resource)
-        in (PipedInputStream. *stream-size*)
-        out (PipedOutputStream. in)]
-    (future
-      (with-open [out (io/writer out)]
-        (.write out (str callback "("))
-        (json/generate-stream resource out)
-        (.write out ");")))
-    (send-stream request response in *stream-size*)
+  [request response resource callback]
+  (let [resource (hal/json-representation resource)]
+    (with-channel request ch
+      (send! ch (assoc response :body (str callback "(")) false)
+      (json/generate-stream resource (ch->writer ch))
+      (send! ch ");" true))
     (ring-response response)))

 (defn- stream-slice-query-xml
   [request response resource]
-  (let [in (PipedInputStream. *stream-size*)
-        out (PipedOutputStream. in)]
-      (future
-        (with-open [out (io/writer out)]
-          (xml/emit resource out :encoding "UTF-8")))
-      (send-stream request response in *stream-size*)
-      (ring-response response)))
+  (with-channel request ch
+    (send! ch response false)
+    (xml/emit resource (ch->writer ch))
+    (close ch))
+  (ring-response response))

 (defmethod slice-query "text/csv" [_ resource {:keys [request query slicedef]}]
   (let [table (:table slicedef)
@@ -416,11 +403,12 @@
                       [{:href (:href resource) :rel "self"}]
                       (:links resource))
         links (map #(str "<" (:href %) ">; rel=" (:rel %)) links)
-        response (->> {:body ""}
-                          (response/content-type "text/csv;charset=UTF-8")
-                          (response/set-headers {"Link" (str/join ", " links)}))]
+        response (->> {}
+                      (response/content-type "text/csv;charset=UTF-8")
+                      (response/set-headers {"Link" (str/join ", " links)}))
+        data (concat (vector columns) rows)]
     (if (should-stream? resource)
-      (stream-slice-query-csv request response columns rows)
+      (stream-slice-query-csv request response data)
       (->> (str (write-csv (vector columns)) (write-csv rows))
            (response/content-type "text/csv; charset=utf-8")
            (response/set-headers {"Link" (str/join ", " links)})


* src/clj/cljs/core.clj: we have property access, use it. less string manipulation in deftype.

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -326,6 +326,9 @@
   [name & body]
   `(let [~name (~'js* "this")]
      ~@body))
+
+(defn to-property [sym]
+  (symbol (core/str "-" sym)))

 (defmacro extend-type [tsym & impls]
   (let [resolve #(let [ret (:name (cljs.compiler/resolve-var (dissoc &env :locals) %))]
@@ -357,7 +360,8 @@
                                         sigs))))]
         `(do ~@(mapcat assign-impls impl-map)))
       (let [t (resolve tsym)
-            prototype-prefix (core/str t ".prototype.")
+            prototype-prefix (fn [sym]
+                               `(.. ~tsym -prototype ~(to-property sym)))
             assign-impls (fn [[p sigs]]
                            (warn-if-not-protocol p)
                            (let [psym (resolve p)
@@ -367,11 +371,11 @@
                                                     (let [[tname & args] sig]
                                                       (list (vec args) (list* 'this-as tname body))))]
                                  (map (fn [[f & meths :as form]]
-                                        `(set! ~(symbol (core/str prototype-prefix f))
+                                        `(set! ~(prototype-prefix f)
                                                ~(with-meta `(fn ~@(map adapt-params meths)) (meta form))))
                                       sigs))
                                (concat (when-not (skip-flag psym)
-                                         [`(set! ~(symbol (core/str prototype-prefix pprefix)) true)])
+                                         [`(set! ~(prototype-prefix pprefix) true)])
                                        (mapcat (fn [[f & meths :as form]]
                                                  (if (= psym 'cljs.core/IFn)
                                                    (let [adapt-params (fn [[[targ & args :as sig] & body]]
@@ -383,18 +387,18 @@
                                                          meths (map adapt-params meths)
                                                          tsym (gensym "tsym")
                                                          argsym (gensym "args")]
-                                                     [`(set! ~(symbol (core/str prototype-prefix 'call)) ~(with-meta `(fn ~@meths) (meta form)))
-                                                      `(set! ~(symbol (core/str prototype-prefix 'apply))
+                                                     [`(set! ~(prototype-prefix 'call) ~(with-meta `(fn ~@meths) (meta form)))
+                                                      `(set! ~(prototype-prefix 'apply)
                                                              ~(with-meta
                                                                 `(fn ~[tsym argsym]
                                                                    (.apply (.-call ~tsym) ~tsym
                                                                            (.concat (array ~tsym) (aclone ~argsym))))
                                                                 (meta form)))])
-                                                   (let [pf (core/str prototype-prefix pprefix f)]
+                                                   (let [pf (core/str pprefix f)]
                                                      (if (vector? (first meths))
-                                                       [`(set! ~(symbol (core/str pf "$arity$" (count (first meths)))) ~(with-meta `(fn ~@meths) (meta form)))]
+                                                       [`(set! ~(prototype-prefix (core/str pf "$arity$" (count (first meths)))) ~(with-meta `(fn ~@meths) (meta form)))]
                                                        (map (fn [[sig & body :as meth]]
-                                                              `(set! ~(symbol (core/str pf "$arity$" (count sig)))
+                                                              `(set! ~(prototype-prefix (core/str pf "$arity$" (count sig)))
                                                                      ~(with-meta `(fn ~meth) (meta form))))
                                                             meths)))))
                                                sigs)))))]


refactor extend-type and other related fns

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -605,105 +605,122 @@
 (defn prototype-prefix [tsym sym]
   `(.. ~tsym -prototype ~(to-property sym)))

-(defmacro extend-type [tsym & impls]
-  (let [env       &env
-        resolve   (partial resolve-var env)
-        impl-map  (->impl-map impls)
-        skip-flag (set (-> tsym meta :skip-protocol-flag))]
-    (if-let [type (base-type tsym)]
-      `(do ~@(mapcat #(base-assign-impls env resolve tsym type %) impl-map))
-      (let [t (resolve tsym)
-            assign-impls (fn [[p sigs]]
-                           (warn-and-update-protocol p t &env)
-                           (let [psym (resolve p)
-                                 pprefix (protocol-prefix psym)]
-                             (if (= p 'Object)
-                               (let [adapt-params (fn [[sig & body]]
-                                                    (let [[tname & args] sig]
-                                                      (list (vec args) (list* 'this-as (vary-meta tname assoc :tag t) body))))]
-                                 (map (fn [[f & meths :as form]]
-                                        `(set! ~(prototype-prefix tsym f)
-                                               ~(with-meta `(fn ~@(map adapt-params meths)) (meta form))))
-                                      sigs))
-                               (concat (when-not (skip-flag psym)
-                                         [`(set! ~(prototype-prefix tsym pprefix) true)])
-                                       (mapcat (fn [[f & meths :as form]]
-                                                 (if (= psym 'cljs.core/IFn)
-                                                   (let [adapt-params (fn [[[targ & args :as sig] & body]]
-                                                                        (let [this-sym (with-meta 'self__ {:tag t})]
-                                                                          `(~(vec (cons this-sym args))
-                                                                            (this-as ~this-sym
-                                                                                (let [~targ ~this-sym]
-                                                                                ~@body)))))
-                                                         meths (map adapt-params meths)
-                                                         this-sym (with-meta 'self__ {:tag t})
-                                                         argsym (gensym "args")]
-                                                     [`(set! ~(prototype-prefix tsym 'call) ~(with-meta `(fn ~@meths) (meta form)))
-                                                      `(set! ~(prototype-prefix tsym 'apply)
-                                                             ~(with-meta
-                                                                `(fn ~[this-sym argsym]
-                                                                   (this-as ~this-sym
-                                                                     (.apply (.-call ~this-sym) ~this-sym
-                                                                       (.concat (array ~this-sym) (aclone ~argsym)))))
-                                                                (meta form)))])
-                                                   (let [pf (core/str pprefix f)
-                                                         adapt-params (fn [[[targ & args :as sig] & body]]
-                                                                        `(~(vec (cons (vary-meta targ assoc :tag t) args))
-                                                                           (this-as ~targ
-                                                                             ~@body)))]
-                                                     (if (vector? (first meths))
-                                                       [`(set! ~(prototype-prefix tsym (core/str pf "$arity$" (count (first meths)))) ~(with-meta `(fn ~@(adapt-params meths)) (meta form)))]
-                                                       (map (fn [[sig & body :as meth]]
-                                                              `(set! ~(prototype-prefix tsym (core/str pf "$arity$" (count sig)))
-                                                                     ~(with-meta `(fn ~(adapt-params meth)) (meta form))))
-                                                            meths)))))
-                                               sigs)))))]
-        `(do ~@(mapcat assign-impls impl-map))))))
-
-(defn- prepare-protocol-masks [env t impls]
-  (let [resolve #(let [ret (:name (cljs.analyzer/resolve-var (dissoc env :locals) %))]
-                   (assert ret (core/str "Can't resolve: " %))
-                   ret)
-        impl-map (loop [ret {} s impls]
-                   (if (seq s)
-                     (recur (assoc ret (first s) (take-while seq? (next s)))
-                            (drop-while seq? (next s)))
-                     ret))]
-    (if-let [fpp-pbs (seq (keep fast-path-protocols
-                                (map resolve
-                                     (keys impl-map))))]
-      (let [fpps (into #{} (filter (partial contains? fast-path-protocols)
-                                   (map resolve
-                                        (keys impl-map))))
-            fpp-partitions (group-by first fpp-pbs)
-            fpp-partitions (into {} (map (juxt key (comp (partial map peek) val))
-                                         fpp-partitions))
-            fpp-partitions (into {} (map (juxt key (comp (partial reduce core/bit-or) val))
-                                         fpp-partitions))]
-        [fpps
-         (reduce (fn [ps p]
-                   (update-in ps [p] (fnil identity 0)))
-                 fpp-partitions
-                 (range fast-path-protocol-partitions-count))]))))
+(defn adapt-obj-params [type [[this & args :as sig] & body]]
+  (list (vec args)
+    (list* 'this-as (vary-meta this assoc :tag type) body)))
+
+(defn adapt-ifn-params [type [[this & args :as sig] & body]]
+  (let [self-sym (with-meta 'self__ {:tag type})]
+    `(~(vec (cons self-sym args))
+       (this-as ~self-sym
+         (let [~this ~self-sym]
+           ~@body)))))
+
+(defn adapt-proto-params [type [[this & args :as sig] & body]]
+  `(~(vec (cons (vary-meta this assoc :tag type) args))
+     (this-as ~this
+       ~@body)))
+
+(defn add-obj-methods [type type-sym sigs]
+  (map (fn [[f & meths :as form]]
+         `(set! ~(prototype-prefix type-sym f)
+            ~(with-meta `(fn ~@(map #(adapt-obj-params type %) meths)) (meta form))))
+    sigs))
+
+(defn add-ifn-methods [type type-sym [f & meths :as form]]
+  (let [meths    (map #(adapt-ifn-params type %) meths)
+        this-sym (with-meta 'self__ {:tag type})
+        argsym   (gensym "args")]
+    [`(set! ~(prototype-prefix type-sym 'call) ~(with-meta `(fn ~@meths) (meta form)))
+     `(set! ~(prototype-prefix type-sym 'apply)
+        ~(with-meta
+           `(fn ~[this-sym argsym]
+              (this-as ~this-sym
+                (.apply (.-call ~this-sym) ~this-sym
+                  (.concat (array ~this-sym) (aclone ~argsym)))))
+           (meta form)))]))
+
+(defn add-proto-methods* [pprefix type type-sym [f & meths :as form]]
+  (let [pf (core/str pprefix f)]
+    (if (vector? (first meths))
+      ;; single method case
+      (let [meth meths]
+        [`(set! ~(prototype-prefix type-sym (core/str pf "$arity$" (count (first meth))))
+            ~(with-meta `(fn ~@(adapt-proto-params type meth)) (meta form)))])
+      (map (fn [[sig & body :as meth]]
+             `(set! ~(prototype-prefix type-sym (core/str pf "$arity$" (count sig)))
+                ~(with-meta `(fn ~(adapt-proto-params type meth)) (meta form))))
+        meths))))
+
+(defn proto-assign-impls [env resolve type-sym type [p sigs]]
+  (warn-and-update-protocol p type env)
+  (let [psym      (resolve p)
+        pprefix   (protocol-prefix psym)
+        skip-flag (set (-> type-sym meta :skip-protocol-flag))]
+    (if (= p 'Object)
+      (add-obj-methods type type-sym sigs)
+      (concat
+        (when-not (skip-flag psym)
+          [`(set! ~(prototype-prefix type-sym pprefix) true)])
+        (mapcat
+          (fn [sig]
+            (if (= psym 'cljs.core/IFn)
+              (add-ifn-methods type type-sym sig)
+              (add-proto-methods* pprefix type type-sym sig)))
+          sigs)))))
+
+(defmacro extend-type [type-sym & impls]
+  (let [env &env
+        resolve (partial resolve-var env)
+        impl-map (->impl-map impls)
+        [type assign-impls] (if-let [type (base-type type-sym)]
+                              [type base-assign-impls]
+                              [(resolve type-sym) proto-assign-impls])]
+    `(do ~@(mapcat #(assign-impls env resolve type-sym type %) impl-map))))
+
+(defn- prepare-protocol-masks [env impls]
+  (let [resolve  (partial resolve-var env)
+        impl-map (->impl-map impls)
+        fpp-pbs  (seq
+                   (keep fast-path-protocols
+                     (map resolve
+                       (keys impl-map))))]
+    (if fpp-pbs
+      (let [fpps  (into #{}
+                    (filter (partial contains? fast-path-protocols)
+                      (map resolve (keys impl-map))))
+            parts (as-> (group-by first fpp-pbs) parts
+                    (into {}
+                      (map (juxt key (comp (partial map peek) val))
+                        parts))
+                    (into {}
+                      (map (juxt key (comp (partial reduce core/bit-or) val))
+                        parts)))]
+        [fpps (reduce (fn [ps p] (update-in ps [p] (fnil identity 0)))
+                parts
+                (range fast-path-protocol-partitions-count))]))))
+
+(defn annotate-specs [annots v [f sigs]]
+  (conj v
+    (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
+      merge annots)))

 (defn dt->et
-  ([t specs fields] (dt->et t specs fields false))
-  ([t specs fields inline]
-     (loop [ret [] s specs]
-       (if (seq s)
-         (recur (-> ret
-                    (conj (first s))
-                    (into
-                      (reduce (fn [v [f sigs]]
-                                (conj v (vary-meta (cons f (map #(cons (second %) (nnext %)) sigs))
-                                                   assoc :cljs.analyzer/type t
-                                                         :cljs.analyzer/fields fields
-                                                         :protocol-impl true
-                                                         :protocol-inline inline)))
-                              []
-                              (group-by first (take-while seq? (next s))))))
-                (drop-while seq? (next s)))
-         ret))))
+  ([type specs fields]
+    (dt->et type specs fields false))
+  ([type specs fields inline]
+    (let [annots {:cljs.analyzer/type type
+                  :cljs.analyzer/fields fields
+                  :protocol-impl true
+                  :protocol-inline inline}]
+      (loop [ret [] specs specs]
+        (if (seq specs)
+          (let [ret (-> (conj ret (first specs))
+                      (into (reduce (partial annotate-specs annots) []
+                              (group-by first (take-while seq? (next specs))))))
+                specs (drop-while seq? (next specs))]
+            (recur ret specs))
+          ret)))))

 (defn collect-protocols [impls env]
   (->> impls
@@ -720,7 +737,7 @@

 (defmacro deftype [t fields & impls]
   (let [r (:name (cljs.analyzer/resolve-var (dissoc &env :locals) t))
-        [fpps pmasks] (prepare-protocol-masks &env t impls)
+        [fpps pmasks] (prepare-protocol-masks &env impls)
         protocols (collect-protocols impls &env)
         t (vary-meta t assoc
             :protocols protocols
@@ -809,7 +826,7 @@
                                     (concat [~@(map #(list `vector (keyword %) %) base-fields)]
                                             ~'__extmap))))
                   ])
-          [fpps pmasks] (prepare-protocol-masks env tagname impls)
+          [fpps pmasks] (prepare-protocol-masks env impls)
           protocols (collect-protocols impls env)
           tagname (vary-meta tagname assoc
                     :protocols protocols


Trashing cards from damage should not show prevention options.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -480,7 +480,7 @@
              (swap! state update-in [:runner :brain-damage] #(+ % n))
              (swap! state update-in [:runner :max-hand-size] #(- % n)))
        (doseq [c (take n (shuffle hand))]
-              (trash state side c nil type))
+              (trash state side c {:unpreventable true} type))
        (trigger-event state side :damage type card)))

 (defn damage


Add another example alert.

Add another example alert.

--- src/clj/medusa/db.clj
+++ src/clj/medusa/db.clj
@@ -117,6 +117,9 @@
                            :metric_id 2}))
     (insert alert (values {:date "2014-07-05",
                            :description "{}",
+                           :metric_id 2}))
+    (insert alert (values {:date "2014-07-06",
+                           :description "{\"x_label\": \"Update: number of sequential update elevation request cancelations greater than 0 (timer initiated)\", \"type\": \"graph\", \"link\": \"http://telemetry.mozilla.org/#filter=nightly/nn/UPDATE_PREF_UPDATE_CANCELATIONS_NOTIFY\", \"reference_series\": [0.0, 0.35934799909591675, 0.153371199965477], \"y_label\": \"Normalized Frequency Count\", \"series_label\": \"2015-05-25\", \"series\": [0.0, 0.3749297261238098, 0.1498032659292221], \"buckets\": [0, 1, 2], \"title\": \"UPDATE_PREF_UPDATE_CANCELATIONS_NOTIFY\", \"reference_series_label\": \"Previous build-id\"}",
                            :metric_id 2})))
   (when (empty? (select user_metric))
     (insert user_metric (values {:user_id 1


Add defenum, re-cond

Add defenum, re-cond

--- src/detritus/macros.clj
+++ src/detritus/macros.clj
@@ -2,3 +2,73 @@

 (defmacro -<> [val & forms]
   `(as-> ~val ~'<> ~@forms))
+
+(defmacro re-cond
+  "cond specialized for dealing with regexes and binding the result of
+  a regex match. Takes a leading form expected to be a String and a
+  series of pattern/binding/form guards. If the input String matches a
+  pattern, that match is destructured with the given binding(s) and
+  the form is evaluated.
+
+  Handy for dealing with operations on one of several regex matches."
+
+  {:style/indent 1}
+  [text & forms]
+  (let [[pattern binding form & forms] forms]
+    (if (and pattern binding form)
+      `(if-let [~binding (re-find ~pattern ~text)]
+         ~form
+         (re-cond ~text ~@forms))
+      (if (= :else pattern)
+        binding
+        text))))
+
+(defn -? [named]
+  (str (name named) "?"))
+
+(defmacro defenum
+  "Defines a enum to be a set of keywords either already qualified or
+  qualified with the name of the enum.
+
+  Takes as arguments a name for the enum, and a sequence of
+  expressions either being sets of potentially qualified keywords or
+  individual keywords. Generates an unqualified alias def and
+  predicate for each keyword, and a predicate for the enum as a
+  whole.
+
+  Ex.
+  (defenum foo
+    :bar
+    :baz)
+
+  -> foo? bar, bar?, baz, baz?"
+
+  {:format/indent 1}
+  [ename & kws]
+  (let [kws (->> kws
+                 (mapcat (fn [o]
+                           (let [o (eval o)]
+                             (if-not (set? o)
+                               [o] o))))
+                 set)]
+    ;; Check inputs
+    ;;----------------------------------------
+    (assert (symbol? ename)
+            "defenum requires a symbol for the enum name!")
+
+    (doseq [kw kws]
+      (assert (keyword? kw)
+              "defenum only accepts keyword arguments!"))
+
+    ;; Generate code
+    ;;----------------------------------------
+    (let [kws (map (fn [kw]
+                     (keyword (or (namespace kw)
+                                  (name ename))
+                              (name kw)))
+                   kws)]
+      `(do ~@(for [kw kws]
+               `(do (def ~(symbol (name kw)) ~kw)
+                    (defn ~(symbol (-? kw)) [x#]
+                      (= x# ~kw))))
+           (def ~(symbol (-? ename)) ~(set kws))))))


added reduce-by from Clojure Programming by Emerick, Carper, Grand

--- src/distillery/data.clj
+++ src/distillery/data.clj
@@ -29,6 +29,14 @@
   [f m]
   (apply (if (sorted? m) sorted-map hash-map) (apply concat (map #(map-pair-value f %) m))))

+(defn reduce-by
+  "Groups a collection by a key, computed by key-fn, and reduces the values of each group with f."
+  [key-fn f init coll]
+  (reduce (fn [summaries x]
+            (let [k (key-fn x)]
+              (assoc summaries k (f (summaries k init) x))))
+          {} coll))
+
 (defn multi-filter
   "Applies a number of predicates to a value and returns true if all predicates are true."
   [predicates x]


Simplify success handlers

Simplify success handlers

--- src/discuss/find.cljs
+++ src/discuss/find.cljs
@@ -15,14 +15,8 @@
 (defn statement-handler
   "Called when received a response in the search."
   [response]
-  (let [res (lib/json->clj response)
-        error (:error res)]
-    (lib/loading? false)
-    (if (pos? (count error))
-      (lib/error-msg! error)
-      (do
-        (lib/no-error!)
-        (lib/update-state-item! :discussion :search (fn [_] res))))))
+  (let [res (com/success-handler response)]
+    (lib/update-state-item! :discussion :search (fn [_] res))))

 (defn find-statement
   "Find related statements to given keywords."


Make Eastwood happier.

Make Eastwood happier.

--- src/oc/lib/utils.clj
+++ src/oc/lib/utils.clj
@@ -66,8 +66,8 @@
 (defn remove-trailing
   ""
   [value]
-  {:pre (string? value)
-   :post (string? value)}
+  {:pre [(string? value)]
+   :post [(string? value)]}
   (if-not (or (and (s/ends-with? value "0") (.contains value "."))
               (s/ends-with? value "."))
     value
@@ -78,7 +78,7 @@
   leaving no trailing 0's to the right of the decimal."
   [value decimals]
   {:pre [(number? value) (pos? decimals) (integer? decimals)]
-   :post (string? %)}
+   :post [(string? %)]}
   (let [exp (Math/pow 10 decimals)]
     (remove-trailing (format (str "%." decimals "f") (float (/ (Math/round (* exp value)) exp))))))


Added better handling of bottoms.

Added better handling of bottoms.

--- src/paragon/core.clj
+++ src/paragon/core.clj
@@ -26,6 +26,13 @@
 (defn jgtype
   [jg stroke-or-node]
   (get-in jg [:types stroke-or-node]))
+
+(defn bottom?
+  [stroke-or-node]
+  (let [snstr (if (keyword? stroke-or-node) (name stroke-or-node) (str stroke-or-node))
+        prefix (subs snstr 0 (min 2 (count snstr)))]
+    (or (= "sb" prefix)
+        (= "nb" prefix))))

 (defn believed
   "Returns black nodes."
@@ -146,8 +153,8 @@
 (defn check-axiom-coloration-bottom
   "Extra axiom: Ensure :sbottom and :nbottom (stroke and node) are white."
   [jg]
-  (and (= :white (jgcolor jg :sbottom))
-       (= :white (jgcolor jg :nbottom))))
+  (every? (fn [sn] (= :white (jgcolor jg sn)))
+          (filter (fn [sn] (bottom? sn)) (concat (nodes jg) (strokes jg)))))

 (defn check-axioms
   [jg]
@@ -227,8 +234,8 @@
                                 (update-in [:graph] graph/add-edges [:sbottom :nbottom]))]
     (reduce (fn [jg2 node-set]
               (let [nodes-str (str/join "-" (map (fn [n] (if (keyword? n) (name n) (str n))) node-set))
-                    bottom-set-stroke (format ":sb-%s" nodes-str)
-                    bottom-set-node (format ":nb-%s" nodes-str)]
+                    bottom-set-stroke (format "sb-%s" nodes-str)
+                    bottom-set-node (format "nb-%s" nodes-str)]
                 (reduce (fn [jg3 node]
                           (-> jg3
                               (assoc-in [:types node] :node)
@@ -277,7 +284,7 @@
     jg
     ;; something to do (inconsistent), spread black
     ;; first case: a stroke is white but has all black incoming nodes; or, it points to a black node; turn it black
-    (if-let [bad-stroke (first (filter (fn [s] (and (not= :sbottom s)
+    (if-let [bad-stroke (first (filter (fn [s] (and (not (bottom? s))
                                                     (= :white (jgcolor jg s))
                                                     (or (and (not-empty (graph/incoming (:graph jg) s))
                                                              (every? (fn [n] (= :black (jgcolor jg n)))
@@ -286,7 +293,7 @@
                                        (strokes jg)))]
       (recur (assert-color jg bad-stroke :black))
       ;; second case: a node is white but has all black incoming strokes; or, one of its outgoing strokes is black; turn it black
-      (if-let [bad-node (first (filter (fn [n] (and (not= :nbottom n)
+      (if-let [bad-node (first (filter (fn [n] (and (not (bottom? n))
                                                     (= :white (jgcolor jg n))
                                                     (or (every? (fn [s] (= :black (jgcolor jg s)))
                                                                 (graph/incoming (:graph jg) n))


Utils to debug gui app using REPL

Utils to debug gui app using REPL

--- src/flatgui/debug.clj
+++ src/flatgui/debug.clj
@@ -1,3 +1,11 @@
+; Copyright (c) 2016 Denys Lebediev and contributors. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+; which can be found in the file LICENSE at the root of this distribution.
+; By using this software in any fashion, you are agreeing to be bound by
+; the terms of this license.
+; You must not remove this notice, or any other, from this software.
+
 (ns
   ^{:doc "Utilities for debugging and troubleshooting through REPL"
     :author "Denys Lebediev"}


cjl - Refactor unit movements

cjl - Refactor unit movements

--- src/icfp2015/unit.clj
+++ src/icfp2015/unit.clj
@@ -2,14 +2,14 @@
   (:require [clojure.set :refer [intersection union]]
             [icfp2015.cell :refer [translate-dir rotate-cell]]))

+(defn- move [unit f]
+  { :members (set (map f (:members unit)))
+    :pivot (f (:pivot unit)) })
+
 (defn translate [direction]
   (fn [unit]
-    (let [f (translate-dir direction)]
-      { :members (set (map f (:members unit)))
-        :pivot (f (:pivot unit)) })))
+    (move unit (translate-dir direction))))

 (defn rotate [direction]
   (fn [unit]
-    (let [f (rotate-cell (:pivot unit) direction)]
-      { :members (set (map f (:members unit)))
-        :pivot (f (:pivot unit)) })))
+    (move unit (rotate-cell (:pivot unit) direction))))


Jepsen add new cli (#5)

Jepsen add new cli (#5)

* initialize voltdb during deployment configuration synchronously, wait longer and be smarter when waiting for volt to start.

--- src/jepsen/voltdb.clj
+++ src/jepsen/voltdb.clj
@@ -80,12 +80,28 @@
        [:commandlog {:enabled true, :synchronous true, :logsize 128}
         [:frequency {:time 2}]]]))) ; milliseconds

+(defn init-voltdb!
+  "Starts the daemon with the given command."
+  [test host]
+  (info host "initializing voltdbroot")
+  (c/sudo username
+          (c/cd voltroot
+                (c/exec (str base-dir "/bin/voltdb") :init
+                    :--config (str base-dir "/deployment.xml")
+                    :--force
+                    :--dir (str base-dir)
+                    (c/lit ">> log/stdout.log")
+                ))))
+
 (defn configure!
   "Prepares config files and creates fresh DB."
   [test node]
   (c/sudo username
         (c/cd base-dir
-              (c/exec :echo (deployment-xml test) :> "deployment.xml"))))
+              (c/exec :echo (deployment-xml test) :> "deployment.xml")))
+
+  (init-voltdb! (jepsen/primary test))
+)

 (defn close!
   "Calls c.close"
@@ -112,34 +128,33 @@
   [test]
   (remove nil? (pmap up? (:nodes test))))

-(defn await-initialization
-  "Blocks until the logfile reports 'Server completed initialization'."
-  [node]
-  (info "Waiting for" node "to initialize at voltroot:" voltroot)
-  (timeout 120000
-           (throw (RuntimeException.
-                    (str node " failed to initialize in time; STDOUT:\n\n"
-                         (meh (c/exec :tail :-n 10
-                                      (str base-dir "/log/stdout.log")))
-                         "\n\nLOG:\n\n"
-                         (meh (c/exec :tail :-n 10
-                                      (str voltroot "/log/volt.log")))
-                         "\n\n")))
-           (c/sudo username
-                   (c/cd voltroot
-                         ; hack hack hack
-                         (Thread/sleep 3000)
-                         (c/exec :tail :-n 1 :-f "log/volt.log"
-                                 | :grep :-m 1 "Initialized VoltDB root directory"
-                                 | :xargs (c/lit "echo \"\" >> log/volt.log \\;")))
-                   (info node "initialized"))))
-
 (defn await-start
     "Blocks until the logfile reports 'Server completed initialization'."
   [node]
   (info "Waiting for" node "to start at voltroot:" voltroot )
-  (timeout 120000
-           (throw (RuntimeException.
+  (def done false)
+
+       (loop [x 50]
+       (try
+           (c/sudo username
+                   (c/cd voltroot
+
+                         (Thread/sleep 5000)
+                         (info node (c/exec :tail :-n 5 "log/volt.log"))
+                         (c/exec :tail :-n 5 "log/volt.log"
+                                 | :grep :-m 1 :-E "completed initialization|Node rejoin completed"
+                                 )))
+
+                   (info node "started")
+                   (def done true )
+	       (catch Exception e (info node "waiting for startup " x " retries left" ) )
+       )
+
+       (when (and (not done) (> x 0))
+            (recur (dec x)))
+       )
+       (when (not done)
+            (throw (RuntimeException.
                     (str node " failed to start in time; STDOUT:\n\n"
                         (meh (c/exec :tail :-n 10
                                       (str base-dir "/log/stdout.log")))
@@ -147,43 +162,50 @@
                          (meh (c/exec :tail :-n 10
                                       (str voltroot "/log/volt.log")))
                          "\n\n")))
-
-           (c/sudo username
-                   (c/cd voltroot
-                         ; hack hack hack
-
-                         (Thread/sleep 7000)
-                         (c/exec :tail :-n 1 :-f "log/volt.log"
-                                 | :grep :-m 1 "completed initialization"
-                                 | :xargs (c/lit "echo \"\" >> log/volt.log \\;")))
-
-                   (info node "started"))))
+        )
+   "done"
+)
+
 (defn await-rejoin
   "Blocks until the logfile reports 'Node rejoin completed'"
   [node]
   (info "Waiting for" node "to rejoin")
+  (def done 0)
+  (timeout 240000
+           (throw (RuntimeException.
+                    (str node " failed to rejoin in time; STDOUT:\n\n"
+                        (meh (c/exec :tail :-n 10
+                                      (str base-dir "/log/stdout.log")))
+                         "\n\nLOG:\n\n"
+                         (meh (c/exec :tail :-n 10
+                                      (str voltroot "/log/volt.log")))
+                         "\n\n")))
+
+
+  (loop [x 100]
+  (info node " NOT rejoined, " x "attempts left")
+  (try
   (c/sudo username
           (c/cd voltroot
                 ; hack hack hack
-                (Thread/sleep 12000)
+                (Thread/sleep 2000)
                 (c/exec :tail :-n 1 :-f "log/volt.log"
                         | :grep :-m 1 "Node rejoin completed"
                         | :xargs (c/lit "echo \"\" >> log/volt.log \\;")))
-          (info node "rejoined")))
-
-(defn init-daemon!
-  "Starts the daemon with the given command."
-  [test cmd host]
-  (c/sudo username
-          (c/cd voltroot
-                (cu/start-daemon! {:logfile (str base-dir "/log/stdout.log")
-                                   :pidfile (str base-dir "/pidfile")
-                                   :chdir   base-dir}
-                                  (str base-dir "/bin/voltdb")
-                                  (str "init")
-                                  :--config (str base-dir "/deployment.xml")
-                                  :--force
-                                  :--dir (str base-dir) ))))
+          (info node "rejoined"))
+          ( def done 1 )
+
+   (catch RuntimeException e (info node "waiting for rejoin" ) )
+   )
+
+   (when (and (> x 0 ) (= done 0))
+   	(recur (dec x)))
+   )
+   )
+)
+
+
+
 (defn start-daemon!
   "Starts the daemon with the given command."
   [test cmd host]
@@ -201,8 +223,6 @@
 (defn start!
   "Starts voltdb, creating a fresh DB"
   [test node]
-  (init-daemon! test :init (jepsen/primary test))
-  (await-initialization node)
   (start-daemon! test :start (jepsen/primary test))
   (await-start node))

@@ -213,7 +233,7 @@
   ([test node]
    (info "recovering" node)
    (start-daemon! test :recover (jepsen/primary test))
-   (await-initialization node)))
+   (await-start node)))

 (defn rejoin!
   "Rejoins a voltdb node. Serialized to work around a bug in voltdb where
@@ -509,7 +529,7 @@
            (future
              (try
                (dotimes [i 50000]
-;                 (call! conn "MENTIONS.insert" i (rand-int 1000)))
+;                 (call! conn "MENTIONS.insert" i (rand-int 1000))
                  ; If we go TOO fast we'll start forcing other ops to time
                  ; out. If we go too slow we won't get a long enough log.
                  (Thread/sleep 1)


remove dead code

remove dead code

--- ex2b/src/ex2b/impl.clj
+++ ex2b/src/ex2b/impl.clj
@@ -1,5 +1,4 @@
 (ns ex2b.impl
-;  (:require [ring.util.servlet :as ring])
   (:import (javax.servlet.http HttpServlet
                                HttpServletRequest
                                HttpServletResponse)


Removed unused import.

Removed unused import.

--- src/luhnybin/core.clj
+++ src/luhnybin/core.clj
@@ -3,8 +3,7 @@
 ;; [SQR]: http://squareup.com/

 (ns luhnybin.core
-  (:use [clojure.java.io :only [make-reader]]
-        [clojure.string  :only [join]])
+  (:use [clojure.java.io :only [make-reader]])
   (:gen-class))

 ;; First define a few small helpers…


Fixed byte[] support for cmd arguments.

Fixed byte[] support for cmd arguments.

--- src/labs/redis/core.clj
+++ src/labs/redis/core.clj
@@ -10,6 +10,8 @@

 (set! *warn-on-reflection* true)

+(def ^:private byte-array-class (Class/forName "[B"))
+
 (defn parse-url [url]
   (let [u (java.net.URI. url)
         ui (.getUserInfo u)
@@ -56,14 +58,14 @@
 (defn value [^Reply reply]
   (.getValue reply))

-(let [byte-array-class (Class/forName "[B")]
-  (defn ->str
-    "Coerces reply into a String."
-    [reply]
-    (condp instance? reply
-      byte-array-class (String. ^bytes reply)
-      BulkReply (String. (.bytes ^BulkReply reply))
-      java.lang.Object (.toString ^java.lang.Object reply))))
+
+(defn ->str
+  "Coerces reply into a String."
+  [reply]
+  (condp instance? reply
+    byte-array-class (String. ^bytes reply)
+    BulkReply (String. (.bytes ^BulkReply reply))
+    java.lang.Object (.toString ^java.lang.Object reply)))

 (defn ->strs [reply]
   (map ->str (value reply)))
@@ -85,8 +87,7 @@
    (keyword? v) (name v)
    (map? v) (map cmd-arg-convert v)
    (vector? v) (map cmd-arg-convert v)
-   ;; string
-   ;; byte[]
+   (instance? byte-array-class v) v
    :default (.toString ^Object v)))


Add on-enter callback for input-texts

Add on-enter callback for input-texts

--- src/re_com/misc.cljs
+++ src/re_com/misc.cljs
@@ -16,6 +16,7 @@
 (def input-text-args-desc
   [{:name :model            :required true                   :type "string | atom"    :validate-fn string-or-atom?    :description "text of the input (can be atom or value)"}
    {:name :on-change        :required true                   :type "string -> nil"    :validate-fn fn?                :description [:span [:code ":change-on-blur?"] " controls when it is called. Passed the current input string"] }
+   {:name :on-enter         :required false                  :type "string -> nil"    :validate-fn fn?                :description [:span "Called when enter is pressed. Passed the current input string"]}
    {:name :status           :required false                  :type "keyword"          :validate-fn input-status-type? :description [:span "validation status. " [:code "nil/omitted"] " for normal status or one of: " input-status-types-list]}
    {:name :status-icon?     :required false :default false   :type "boolean"                                          :description [:span "when true, display an icon to match " [:code ":status"] " (no icon for nil)"]}
    {:name :status-tooltip   :required false                  :type "string"           :validate-fn string?            :description "displayed in status icon's tooltip"}
@@ -43,10 +44,10 @@
   "Returns markup for a basic text input label"
   [& {:keys [model input-type] :as args}]
   {:pre [(validate-args-macro input-text-args-desc args "input-text")]}
-  (let [external-model (reagent/atom (deref-or-value model))  ;; Holds the last known external value of model, to detect external model changes
+  (let [external-model (reagent/atom (deref-or-value model)) ;; Holds the last known external value of model, to detect external model changes
         internal-model (reagent/atom (if (nil? @external-model) "" @external-model))] ;; Create a new atom from the model to be used internally (avoid nil)
     (fn
-      [& {:keys [model status status-icon? status-tooltip placeholder width height rows on-change change-on-blur? validation-regex validation-fn disabled? class style attr]
+      [& {:keys [model status status-icon? status-tooltip placeholder width height rows on-change on-enter change-on-blur? validation-regex validation-fn disabled? class style attr]
           :or   {change-on-blur? true}
           :as   args}]
       {:pre [(validate-args-macro input-text-args-desc args "input-text")]}
@@ -62,7 +63,7 @@
          :width    (if width width "250px")
          :class    "rc-input-text "
          :children [[:div
-                     {:class (str "rc-input-text-inner "          ;; form-group
+                     {:class (str "rc-input-text-inner " ;; form-group
                                   (case status
                                     :warning "has-warning "
                                     :error "has-error "
@@ -71,50 +72,54 @@
                       :style (flex-child-style "auto")}
                      [input-type
                       (merge
-                        {:class       (str "form-control " class)
-                         :type        (when (= input-type :input) "text")
-                         :rows        (when (= input-type :textarea) (if rows rows 3))
-                         :style       (merge
-                                        (flex-child-style "none")
-                                        {:height        height
-                                         :padding-right "12px"} ;; override for when icon exists
-                                        style)
-                         :placeholder placeholder
-                         :value       @internal-model
-                         :disabled    disabled?
-                         :on-change   (handler-fn
-                                        (let [new-val (-> event .-target .-value)]
-                                          (when (and
-                                                  on-change
-                                                  (not disabled?)
-                                                  (if validation-regex (re-find validation-regex new-val) true)
-                                                  (if validation-fn (validation-fn new-val) true))
-                                            (reset! internal-model new-val)
-                                            (when-not change-on-blur?
-                                              (on-change @internal-model)))))
-                         :on-blur     (handler-fn
+                       {:class       (str "form-control " class)
+                        :type        (when (= input-type :input) "text")
+                        :rows        (when (= input-type :textarea) (if rows rows 3))
+                        :style       (merge
+                                      (flex-child-style "none")
+                                      {:height        height
+                                       :padding-right "12px"} ;; override for when icon exists
+                                      style)
+                        :placeholder placeholder
+                        :value       @internal-model
+                        :disabled    disabled?
+                        :on-change   (handler-fn
+                                      (let [new-val (-> event .-target .-value)]
                                         (when (and
-                                                on-change
-                                                change-on-blur?
-                                                (not= @internal-model @external-model))
-                                          (on-change @internal-model)))
-                         :on-key-up   (handler-fn
-                                        (if disabled?
-                                          (.preventDefault event)
-                                          (case (.-which event)
-                                            13 (when on-change (on-change @internal-model))
-                                            27 (reset! internal-model @external-model)
-                                            true)))
-
-                         }
-                        attr)]]
+                                               on-change
+                                               (not disabled?)
+                                               (if validation-regex (re-find validation-regex new-val) true)
+                                               (if validation-fn (validation-fn new-val) true))
+                                          (reset! internal-model new-val)
+                                          (when-not change-on-blur?
+                                            (on-change @internal-model)))))
+                        :on-blur     (handler-fn
+                                      (when (and
+                                             on-change
+                                             change-on-blur?
+                                             (not= @internal-model @external-model))
+                                        (on-change @internal-model)))
+                        :on-key-up   (handler-fn
+                                      (if disabled?
+                                        (.preventDefault event)
+                                        (case (.-which event)
+                                          13 (do
+                                               (when on-change
+                                                 (on-change @internal-model))
+                                               (when on-enter
+                                                 (on-enter @internal-model)))
+                                          27 (reset! internal-model @external-model)
+                                          true)))
+
+                        }
+                       attr)]]
                     (when (and status-icon? status)
                       (if status-tooltip
                         [popover-tooltip
                          :label status-tooltip
                          :position :right-center
                          :status status
-                         ;:width    "200px"
+                         ;;:width    "200px"
                          :showing? showing?
                          :anchor [:i {:class         (str (if (= status :warning) "md-warning" "md-error") " form-control-feedback")
                                       :style         {:position "static"


update meta promise

update meta promise

--- src/meta/promise.cljs
+++ src/meta/promise.cljs
@@ -1,30 +1,28 @@
 (ns meta.promise
-  (:refer-clojure :exclude [catch map resolve])
+  (:refer-clojure :exclude [catch map resolve conj])
   (:require [goog.object :as obj])
   (:require-macros meta.promise))

 (defprotocol IPromise
-  "A CLJS wrapper around JavaScript promises."
-  (all     [_ promises]    "Return a promise which resolves/rejects concurrent promises.")
-  (then    [_ callback]    "Invokes callback with the result of the previous promise.")
-  (catch   [_ callback]    "Invokes callback with the result of the previous promise.")
-  (resolve [_ value]       "Resolves the promise and returns value.")
-  (reject  [_ value]       "Rejects the promise with value as the reason.")
-  (log     [_]             "Output the result of the previous promise to the console.")
-  (err     [_] [_ message] "Catch and output the error of a promise.")
-  (map     [_ f]           "Map a function to the result of the previous promise."))
+  "A simple protocol implementation for JavaScript Promises.

-(extend-protocol IPromise
-  js/Promise
-  (all     [promise promises] (.all     promise (clj->js promises)))
-  (then    [promise callback] (.then    promise callback))
-  (catch   [promise callback] (.catch   promise callback))
-  (resolve [promise value]    (.resolve promise (clj->js value)))
-  (reject  [promise value]    (.reject  promise (clj->js value)))
-  (log     [promise]          (.then    promise #(.log js/console %)))
-  (err     [promise]          (.catch   promise #(.error js/console (obj/get % "message"))))
-  (map     [promise func]     (.then    promise #(map func %))))
+  If you need advanced promise features see funcool/promesa."
+  (then    [_ callback] "Invokes callback with the result of the previous promise.")
+  (catch   [_ callback] "Invokes callback with the result of the previous promise.")
+  (log     [_]          "Output the result of the previous promise to the console.")
+  (err     [_]          "Catch and output the error of a promise.")
+  (map     [_ func]     "Map a function to the result of the previous promise.")
+  (conj    [_ data]     "Conj data onto the result of the previous promise."))

+;; Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defn- promise-serial [current next]
+  (.then current
+    (fn [data]
+      (.then (next)
+        (fn [result]
+          (cljs.core/conj data result))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (defn promise
   "Returns a new promise, optionally accepts a function as a promise constructor.

@@ -34,3 +32,36 @@
   "
   ([] js/Promise.)
   ([callback] (js/Promise. callback)))
+
+(defn resolve
+  "Resolves the promise and returns value."
+  ([value] (resolve (promise) value))
+  ([promise value] (.resolve promise value)))
+
+(defn reject
+  "Rejects the promise with value as the reason."
+  ([value] (reject (promise) (clj->js value)))
+  ([promise value] (.reject promise (clj->js value))))
+
+(defn all
+  "Return a promise which resolves/rejects concurrent promises."
+  ([promises]
+   (all (promise) promises))
+  ([promise promises]
+   (.all promise (into-array promises))))
+
+(defn serial
+  "Return a promise which resolves/rejects consecutive promises."
+  ([factories]
+   (serial (promise) factories))
+  ([promise factories]
+   (then (reduce promise-serial (resolve promise []) factories) into-array)))
+
+(extend-protocol IPromise
+  js/Promise
+  (then    [promise callback]   (.then    promise callback))
+  (catch   [promise callback]   (.catch   promise callback))
+  (log     [promise]            (.then    promise #(.log js/console %)))
+  (err     [promise]            (.catch   promise #(.error js/console %)))
+  (map     [promise func]       (.then    promise #(cljs.core/map func %)))
+  (conj    [promise data]       (.then    promise #(cljs.core/conj % data))))


Update linux load list

Update linux load list

Now tested to work on both Linux (x86 and x64)
and OS X.

--- src/naughtmq/core.clj
+++ src/naughtmq/core.clj
@@ -33,6 +33,7 @@
       "i386"   "x86"
       "i686"   "x86"
       "x86_64" "x86_64"
+      "amd64"  "x86_64"
       (throw (UnsupportedOperationException.
                (str "Unsupported platform: " os-name ", " os-arch))))))

@@ -94,7 +95,7 @@
   "Loads the native libraries."
   []
   (let [libs (get {"win"   ["msvcr100" "msvcp100" "libzmq" "jzmq"]
-                   "linux" ["libzmq" "libjzmq"]
+                   "linux" ["zmq" "jzmq"]
                    "mac"   ["zmq" "jzmq"]}
                   (os))]
     (doseq [l libs] (load-library l))))


present parallax as home page

present parallax as home page

--- src/ophion/server.clj
+++ src/ophion/server.clj
@@ -75,7 +75,7 @@
   [request]
   {:status 200
    :headers {"content-type" "text/html"}
-   :body (config/read-resource "public/index.html")})
+   :body (config/read-resource "public/parallax.html")})

 (defn ophion-routes
   [graph protograph]


in arg-count specifically filter out the "invoke" method as according to the JVM documentation "The elements in the array returned are not sorted and are not in any particular order."

Thanks to Ian Davies for his heroic Windows debugging efforts to find a solution for this issue.

--- src/overtone/util.clj
+++ src/overtone/util.clj
@@ -80,7 +80,7 @@
 (defn arg-count
   "Get the arity of a function."
   [f]
-  (let [m (first (.getDeclaredMethods (class f)))
+  (let [m (first (filter #(= "invoke" (.getName %)) (.getDeclaredMethods (class f))))
         p (.getParameterTypes m)]
     (alength p)))

@@ -88,7 +88,7 @@
   (try
     (apply handler (take (arg-count handler) args))
     (catch Exception e
-      (log/debug "Handler Exception - got args:" args"\n"
+      (log/debug "Handler Exception - got args:" args"\n"
                  (with-out-str (.printStackTrace e))))))

 (defn map-vals [f m]


don't show the instrumenting om components post

--- src/pc/views/blog.clj
+++ src/pc/views/blog.clj
@@ -27,7 +27,7 @@
 (def slugs
   "Sorted array of slugs, assumes the post content can be found in the
    function returned by post-fn"
-  ["instrumenting-om-components"
+  [;"instrumenting-om-components"
    "interactive-layers"])

 (defn post-exists? [slug]


Allow reading from the screen and entities atoms via a REPL

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -51,7 +51,9 @@
                                (reset! entities)))
         create-renderer-fn! #(swap! screen assoc :renderer (renderer %))
         update-fn! #(swap! screen merge %)]
-    {:show (fn []
+    {:screen screen
+     :entities entities
+     :show (fn []
              (->> (swap! screen assoc
                          :total-time 0
                          :delta-time 0
@@ -72,12 +74,11 @@

 (defmacro defscreen
   [n & {:keys [] :as options}]
-  `(->> (for [[k# v#] ~options]
-          [k# (intern *ns* (symbol (str '~n "-" (name k#))) v#)])
-        flatten
-        (apply hash-map)
-        defscreen*
-        (def ~n)))
+  `(let [fns# (->> (for [[k# v#] ~options]
+                     [k# (intern *ns* (symbol (str '~n "-" (name k#))) v#)])
+                   flatten
+                   (apply hash-map))]
+     (defonce ~n (defscreen* fns#))))

 (defn defgame*
   [{:keys [on-create] :or {on-create dummy}}]


removed more shit

removed more shit

--- src/server/core.cljs
+++ src/server/core.cljs
@@ -15,7 +15,7 @@
 (defonce redis-client (.createClient (nodejs/require "redis")))
 (defonce util (nodejs/require "util"))

-(client-interface/initialize! server #js {"heartbeat interval" 5
+#_(client-interface/initialize! server #js {"heartbeat interval" 5
                                           "heartbeat timeout"  15})

 (.set app "views" "src/frontend/views")
@@ -25,10 +25,10 @@
 (.get app "/" #(. %2 (sendFile "public/index.html")))

 (.get app "/rooms/:id" #(. %2 (render "room" #js {:roomid (.-id (.-params %1))
-                                                  :maxuploadslots (config/data "max-upload-slots")
-                                                  :defaultuploadslots (config/data "default-upload-slots")
-                                                  :lastfmkey (config/data "lastfm-api-key")
-                                                  :allowedfileextensions (reduce (fn [a b] (str a "," b))
+                                                  ;:maxuploadslots (config/data "max-upload-slots")
+                                                  ;:defaultuploadslots (config/data "default-upload-slots")
+                                                  ;:lastfmkey (config/data "lastfm-api-key")
+                                                  :allowedfileextensions nil #_(reduce (fn [a b] (str a "," b))
                                                                                (rooms/allowed-file-extensions (.-id (.-params %1))))})))

 (defn -main []


sends start-track signal when all users are ready

--- src/server/core.cljs
+++ src/server/core.cljs
@@ -55,7 +55,15 @@

   (.on socket "ready-to-start"
     (fn []
-      (println "Received ready-to-start signal from " (.-id socket))))
+      (println "Received ready-to-start signal from " (.-id socket))
+      (rooms/user-ready-to-start (.-id socket)
+        (fn [num-users-ready]
+          (rooms/get-room-from-user-id (.-id socket)
+            (fn [room]
+              (rooms/get-num-of-users room
+                (fn [num-users]
+                  (if (= num-users num-users-ready)
+                    (.emit (.to io room) "start-track"))))))))))

   (.on (new socketio-stream socket) "file-upload"
     (fn [stream original-filename file-size]


catch in correct order

catch in correct order

--- src/shuppet/core.clj
+++ src/shuppet/core.clj
@@ -149,14 +149,14 @@
                 (error (str app-name " config in " environment " cannot be loaded: " message))
                 {:app app-name
                  :error message})
-              (catch Object e
-                (error "unexpected error: " &throw-context)
-                {:app app-name
-                 :error (:object e)})
               (catch Exception e
                 (error (str app-name " in " environment " failed: " (util/str-stacktrace e)))
                 {:app app-name
-                 :error (util/str-stacktrace e)})))
+                 :error (util/str-stacktrace e)})
+              (catch Object e
+                (error (str app-name " in " environment " failed: " e))
+                {:app app-name
+                 :error e})))
            names))))

 (defn update-configs


comments cleanup

comments cleanup

--- src/selmer/parser.clj
+++ src/selmer/parser.clj
@@ -132,7 +132,7 @@
     (filter-tag tag)
     (expr-tag tag rdr)))

-;; Pretty fucking gnarly. Parses and detects tags which turn into
+;; Parses and detects tags which turn into
 ;; FunctionNode call-sites or TextNode content. open-tag? fn returns
 ;; true or false based on character lookahead to see if it's {{ or {%

@@ -233,4 +233,4 @@
             *block-pattern*        (pattern "\\" tag-open "\\" tag-second "\\s*block.*")
             *block-super-pattern*  (pattern "\\" tag-open "\\" filter-open "\\s*block.super\\s*\\" filter-close "\\" tag-close)
             *endblock-pattern*     (pattern "\\" tag-open "\\" tag-second "\\s*endblock.*")]
-    (parse-fn input params)))+    (parse-fn input params)))


Force a node refresh on server startup.

Force a node refresh on server startup.

--- src/shale/handler.clj
+++ src/shale/handler.clj
@@ -1,7 +1,9 @@
 (ns shale.handler
   (:require [ring.adapter.jetty :as jetty]
             [clj-json [core :as json]]
-            [shale.periodic :as periodic])
+            [shale.periodic :as periodic]
+            [shale.nodes :as nodes])
+
   (:use
     [shale.resources :only  [assemble-routes]]
     [ring.middleware.multipart-params :only  [wrap-multipart-params]]
@@ -44,7 +46,8 @@

 (defn init []
   ;; schedule periodic tasks
-  (periodic/schedule!))
+  (periodic/schedule!)
+  (nodes/refresh-nodes))

 (defn destroy []
   (periodic/stop!))


refactor subrosa.hooks to allow for binding over the current hooks

--- src/subrosa/hooks.clj
+++ src/subrosa/hooks.clj
@@ -1,18 +1,26 @@
 (ns subrosa.hooks)

-(defonce get-hook
-  (comp
-   (memoize
-    (fn [hook] (atom {})))
-   (memfn toLowerCase)
-   str))
+(defonce hooks (ref {}))
+
+(def format-hook
+  (comp (memfn toLowerCase) str))
+
+(defn get-hook [hook]
+  (let [hook (format-hook hook)]
+    (dosync
+     (if-let [hook-map (@hooks hook)]
+       hook-map
+       (do
+         (alter hooks assoc hook {})
+         {})))))

 (defn add-hook [tag hook fn]
-  (swap! (get-hook hook) assoc tag fn))
+  (dosync
+   (alter hooks update-in [(format-hook hook)] assoc tag fn)))

 (defn hooked? [hook]
-  (not (empty? @(get-hook hook))))
+  (not (empty? (get-hook hook))))

 (defn run-hook [hook & args]
-  (doseq [[tag listener] @(get-hook hook)]
+  (doseq [[tag listener] (get-hook hook)]
     (apply listener hook args)))