Adding timing for JUnit tests

Adding timing for JUnit tests

--- jvm-runner/src/clojure/codewars/runner/java.clj
+++ jvm-runner/src/clojure/codewars/runner/java.clj
@@ -1,5 +1,6 @@
 (ns codewars.runner
   (:require [codewars.runner :refer [run]]
+            [codewars.clojure.test]
             [clojure.java.io :as io]
             [codewars.util :refer [write-code!]])
   (:import [codewars.java TempDir]
@@ -9,7 +10,9 @@
            [codewars.java CwRunListener]
            [java.io IOException]))

-(defn- compile! [& files]
+(defn- compile!
+  "Compile files using the java compiler"
+  [& files]
   (let [compilation-result
         (-> (ToolProvider/getSystemJavaCompiler)
             ;; TODO: write compilation errors somewhere?
@@ -18,19 +21,25 @@
       0
       (throw (IOException. "Java compilation error")))))

-(defn- load-class [dir class-name]
+(defn- load-class
   "Load a java class in a specified directory"
+  [dir class-name]
   (let [class-loader
         (URLClassLoader/newInstance
          (into-array [(-> dir .toURI .toURL)]))]
     (Class/forName (name class-name) true class-loader)))

-(defn- run-junit-tests [fixture-class]
+(defn- run-junit-tests
+  "Run a JUnit test using the Codewars Formatter for a given fixture-class"
+  [fixture-class]
   (let [runner (JUnitCore.)]
     (.addListener runner (CwRunListener.))
-    (.run runner (into-array [fixture-class]))))
+    (codewars.clojure.test/time
+     (.run runner (into-array [fixture-class])))))

-(defn- file-names [files]
+(defn- file-names
+  "Filter a sequence of files writen by write-code! and output their names"
+  [& files]
   (for [{:keys [:file-name]} files
         :when (not (nil? file-name))]
     file-name))
@@ -40,7 +49,7 @@
   (let [dir (TempDir/create "java")
         setup (when (not (empty? setup)) (write-code! "java" dir setup))
         solution (write-code! "java" dir solution)
-        files (file-names [setup solution])]
+        files (file-names setup solution)]
     (apply compile! files)
     (-> solution
         :class-name
@@ -54,6 +63,6 @@
         fixture (write-code! "java" dir fixture)
         setup (when (not (empty? setup)) (write-code! "java" dir setup))
         solution (write-code! "java" dir solution)
-        files (file-names [fixture setup solution])]
+        files (file-names fixture setup solution)]
     (apply compile! files)
     (->> fixture :class-name (load-class dir) run-junit-tests)))


Minor cleanups

Minor cleanups

--- src/riemann/prometheus.clj
+++ src/riemann/prometheus.clj
@@ -17,7 +17,9 @@
 (defn generate-metricname
   "Generates the metric name as per prometheus specification."
   [event]
-  (replace-disallowed (:service event)))
+  (-> event
+      :service
+      replace-disallowed))

 (defn generate-datapoint
   "Accepts riemann event and converts it into prometheus datapoint."
@@ -28,12 +30,16 @@
 (defn create-label
   "Creates a Prometheus label out of a Riemann event."
   [filtered-event]
-  (str/join "" (map #(if-not (nil? (second %)) (str "/" (name (first %)) "/" (second %))) filtered-event)))
+  (-> ""
+      (str/join (->> filtered-event
+                     (map #(if-not (nil? (second %)) (str "/" (name (first %)) "/" (second %))))))))

 (defn filter-event
   "Filter attributes from a Riemann event."
   [event]
-  (select-keys event (filter #(if-not (contains? special-fields %) %) (keys event))))
+  (-> event
+      (select-keys (->> (keys event)
+                        (filter #(if-not (contains? special-fields %) %))))))

 (defn generate-labels
   "Generates the Prometheus labels from Riemann event attributes."


Updated strat results

Updated strat results

--- src/angelic/search/action_set/stratified.clj
+++ src/angelic/search/action_set/stratified.clj
@@ -18,24 +18,41 @@

 (defn effect-var [a] (util/safe-singleton (keys (:effect-map a))))

+(defn dynamic-predecessors [state ap-map v]
+  (for [a (get ap-map [v (state/get-var state v)])
+        [pvar pval] (:precond-map a)
+        :when (not (= (state/get-var state pvar) pval))]
+    pvar))
+
+(defn dynamic-var-set [state av-map ap-map v]
+  (let [open   (ArrayList.)
+        ret    (HashSet.)
+        closed (HashSet.)]
+    (.add open v)
+    (while (not (.isEmpty open))
+      (let [v (.remove open (dec (count open)))]
+        (when-not (.contains closed v)
+          (.add closed v)
+          (doseq [x (dynamic-predecessors state ap-map v)]
+            (.addAll ret (av-map x))
+            (.addAll open (av-map x))))))
+    (set (seq ret))))
+
 ;; TODO: none of these work!
 (defn dynamic-inf-stratified-applicable-actions [last-a state tsi av-map ap-map actions]
   (if last-a
     (let [a-var   (effect-var last-a)
           a-level (util/safe-get tsi a-var)
-          e-p-set (set (for [b (get ap-map (util/safe-singleton (seq (:effect-map last-a))))
-                             [pvar pval] (:precond-map b)
-                             :when (not (= (state/get-var state pvar) pval))]
-                         pvar))
-          p-set   (apply clojure.set/union (map av-map e-p-set))]
-      (util/prln (filter
-        (fn [b]
-          (let [b-var (effect-var b)
-                b-level (util/safe-get tsi b-var)]
-            (or (and (<= b-level a-level) (contains? p-set b-var))
-                (contains? (util/keyset (:precond-map b)) (keys (:precond-map last-a)))
-                (contains? (:precond-map b) a-var))))
-        (actions state)) last-a))
+          p-set   (dynamic-var-set state av-map ap-map a-var)]
+   #_   (println last-a p-set state)
+      (filter
+       (fn [b]
+         (let [b-var (effect-var b)
+               b-level (util/safe-get tsi b-var)]
+           (or (and (<= b-level a-level) (contains? p-set b-var))
+;               (contains? (util/keyset (:precond-map b)) (keys (:precond-map last-a)))
+               (contains? (:precond-map b) a-var))))
+       (actions state)))
     (actions state)))

 (comment (some #(= ((:precond-map last-a) %) ((:precond-map b) %))
@@ -70,7 +87,7 @@
     (actions state)))

 (defn stratified-search [sas-problem type]
-  (assert (#{:simple} type))
+  (assert (#{:simple :dynamic} type))
   (let [q       (queues/make-tree-search-pq)
         closed  (HashSet.)
         actions (env/actions-fn sas-problem)
@@ -125,6 +142,21 @@
 ;; 6-2: 3286212
 ;; 5-0: 4053436

+;; Logistics results (# states) to match table. -- dynamic
+;; 5-2: 16086
+;; 6-1: 194870
+;; 4-2: 277791
+;; 5-1: 454016
+;; 4-1: 750217
+;; 4-0: 986574
+;; 6-3: 1908549
+;; 6-0: 1864844
+;; 6-2: 1947242
+;; 5-0: 2272572
+
+
+
+
 ;; Wrong ?
 ;; Logistics results (# states) to match table. -- structural
 ;; 5-2: 8585
@@ -137,15 +169,3 @@
 ;; 6-0: 3435578
 ;; 6-2: 3286212
 ;; 5-0: 3085333
-
-;; Logistics results (# states) to match table. -- dynamic
-;; 5-2: 2895
-;; 6-1: 34968
-;; 4-2: 74947
-;; 5-1:
-;; 4-1:
-;; 4-0:
-;; 6-3:
-;; 6-0:
-;; 6-2:
-;; 5-0:


add minimal test that edited result is not nested

--- ssclj/jar/src/test/clojure/com/sixsq/slipstream/ssclj/resources/usage_record_test.clj
+++ ssclj/jar/src/test/clojure/com/sixsq/slipstream/ssclj/resources/usage_record_test.clj
@@ -128,7 +128,8 @@
                  :request-method :put
                  :body (json/write-str closed-usage-record))
         ltu/body->json
-        (ltu/is-status 200)))
+        (ltu/is-status 200)
+        (ltu/is-key-value :end-timestamp "2015-05-04T15:40:15.432Z")))

   ; get modified usage-record
   (let [urs (-> (session (ring-app))


Fix bug I introduced earlier - don't use a socket if there's no database.yml

--- src/circle/backend/build/inference/rails.clj
+++ src/circle/backend/build/inference/rails.clj
@@ -129,7 +129,7 @@

 (defn need-mysql-socket? [repo]
   (let [db-config (parse-db-yml repo)]
-    (-> db-config :test :adapter (or (= "mysql2") (= "mysql")))))
+    (-> db-config :test :adapter #{"mysql2" "mysql"})))

 (defn mysql-socket-path [repo]
   (let [db-config (parse-db-yml repo)]


WIP on new DOM implementation.

WIP on new DOM implementation.

--- src-cljs/freactive/dom.cljs
+++ src-cljs/freactive/dom.cljs
@@ -906,17 +906,17 @@
   (-vdom-tail [this])
   (-vdom-replace [this new-vdom])
   (-vdom-node [this])
-  (-vdom-element [this]))
+  (-vdom-simple-element [this]))

 (defn vdom-node [this]
   (if (dom-node? this)
     this
     (-vdom-node this)))

-(defn vdom-element [this]
+(defn vdom-simple-element [this]
   (if (dom-node? this)
     this
-    (-vdom-element this)))
+    (-vdom-simple-element this)))

 (defn dom-insert [dom-node dom-parent dom-before]
   (if dom-before
@@ -990,7 +990,7 @@
       (.removeChild parent dom-node)
       (vdom-insert new-vdom parent next-sib))))

-(deftype DOMElement [ns-uri tag attrs events bindings children ^:mutable node]
+(deftype DOMElement [ns-uri tag attrs children ^:mutable node]
   Object
   (ensureNode [this]
     (when-not node
@@ -998,8 +998,9 @@
             (if xmlns
               (.createElementNS js/document ns-uri tag)
               (.createElement js/document tag)))
+      ;; TODO bind attrs
       (doseq [child children]
-        (-vdom-insert child node nil))))
+        (vdom-insert child node nil))))

   IVirtualDOM
   (-vdom-head [this] node)
@@ -1007,18 +1008,19 @@
   (-vdom-node [this]
     (.ensureNode this)
     node)
-  (-vdom-element [this] this)
+  (-vdom-simple-element [this] this)
   (-vdom-insert [this dom-parent dom-before]
     (.ensureNode this)
     (dom-insert dom-parent node dom-before))
-
   (vdom-remove [this]
     (dom-remove node))
   (-vdom-replace [this new-vdom]
-    (if-let [new-elem (vdom-element new-vdom)]
+    (if-let [new-elem (vdom-simple-element new-vdom)]
       (if (and (instance? DOMElement new-elem)
                (identical? (.-ns-uri new-elem) ns-uri)
-               (identical? (.-tag new-elem) tag))
+               (identical? (.-tag new-elem) tag)
+               false ;; disabled
+               )
         (do
           ;; TODO do diff replace
           this)
@@ -1038,14 +1040,14 @@
   (-vdom-node [this]
     (.ensureNode this)
     node)
-  (-vdom-element [this] this)
+  (-vdom-simple-element [this] this)
   (-vdom-insert [this dom-parent dom-before]
     (.ensureNode this)
     (dom-insert dom-parent node dom-before))
   (-vdom-remove [this]
     (dom-remove node))
   (-vdom-replace [this new-vdom]
-    (if-let [new-elem (vdom-element new-vdom)]
+    (if-let [new-elem (vdom-simple-element new-vdom)]
       (if (instance? DOMTextNode new-vdom)
         (do
           (.ensureNode this)
@@ -1057,7 +1059,9 @@
           new-vdom))
       (dom-remove-replace node new-vdom))))

-(deftype ReactiveElement [id ^:mutable parent the-ref binding-info ^:mutable cur-vdom ^:mutable dirty
+(deftype ReactiveElement2 [id the-ref binding-info
+                          ^:mutable parent
+                          ^:mutable cur-vdom ^:mutable dirty
                           ^:mutable updating ^:mutable disposed]
   Object
   (dispose [this]
@@ -1107,7 +1111,7 @@
   (-vdom-head [this] (vdom-head cur-elem))
   (-vdom-tail [this] (vdom-tail cur-elem))
   (-vdom-node [this] (vdom-node cur-elem))
-  (-vdom-element [this] (vdom-element cur-elem))
+  (-vdom-simple-element [this] (vdom-simple-element cur-elem))
   (-vdom-insert [this dom-parent dom-before]
     (set! (.-parent this) dom-parent)
     (.show-new-elem this (.get-new-elem this) dom-before)
@@ -1136,7 +1140,7 @@

   IVirtualDOM
   (-vdom-node [this])
-  (-vdom-element [this])
+  (-vdom-simple-element [this])
   (-vdom-head [this]
     (when (> (.-length elements) 0)
       (vdom-head (aget elements 0))))
@@ -1152,3 +1156,65 @@
     (set! (.-disposed this) true)
     (doseq [elem elements]
       (vdom-remove elem))))
+
+(defn dom-element [ns-uri tag tail]
+  (let [[_ tag-name id class] (re-matches re-tag tag-name)
+        attrs? (first tail)
+        have-attrs (map? attrs?)
+        attrs (if have-attrs attrs? {})
+        attrs (cond-> attrs
+
+                (and id (not (:id attrs)))
+                (assoc :id id)
+
+                class
+                (update :class
+                        (fn [cls]
+                          (let [class (.replace class re-dot " ")]
+                            (if cls (str class " " cls) class)))))
+
+        children (if have-attrs (rest tail) tail)]
+    (DOMElement. ns-uri tag attrs children nil)))
+
+(defn as-vdom [elem-spec]
+  (cond
+    (string? elem-spec)
+    (DOMTextNode. elem-spec nil)
+
+    (dom-node? elem-spec)
+    elem-spec
+
+    (vector? elem-spec)
+    (let [tag (first elem-spec)]
+      (cond
+        (keyword? tag)
+        (let [tag-ns (namespace tag)
+              tag-name (name tag)
+              tail (rest elem-spec)]
+          (if tag-ns
+            (if-let [tag-handler (aget node-ns-lookup tag-ns)]
+              (cond
+                (string? tag-handler)
+                (dom-element tag-handler tag tail)
+
+                (fn? tag-handler)
+                (as-vdom (tag-handler tag-name tail))
+
+                :default
+                (.warn js/console "Invalid ns node handler" tag-handler))
+              (.warn js/console "Undefined ns node prefix" tag-ns))
+            (dom-element nil tag tail)))
+
+        :default
+        (assert false "Only know how to handle keyword tags")))
+
+    (satisfies? IDeref elem-spec)
+    (ReactiveElement2. (r/new-reactive-id)
+                      elem-spec
+                      (r/get-binding-fns elem-spec)
+                      nil nil false false false)
+
+    (satisfies? IVirtualDOM elem-spec)
+    elem-spec
+
+    :default (as-vdom (-get-dom-image elem-spec))))


[layers] Add convolutional to serialization.

--- src/cortex/impl/layers.cljc
+++ src/cortex/impl/layers.cljc
@@ -737,6 +737,7 @@
 ;;

+#?(:cljs (register-module cortex.impl.layers.Convolutional))
 (defrecord Convolutional [weights bias weight-gradient bias-gradient
                           conv-layer-config]
     cp/PModule


Changing search application response to use entry-title instead of native id

--- src/cmr/search/data/elastic_search_index.clj
+++ src/cmr/search/data/elastic_search_index.clj
@@ -27,13 +27,13 @@
         refs (map (fn [match]
                     (let [{concept-id :_id
                            revision-id :_version
-                           {native-id :entry-title
+                           {entry-title :entry-title
                             provider-id :provider-id} :fields} match]
                       (results/map->Reference
                         {:concept-id concept-id
                          :revision-id revision-id
                          :provider-id provider-id
-                         :native-id native-id})))
+                         :entry-title entry-title})))
                   elastic-matches)]
     (results/map->Results {:hits hits :references refs})))


(PDB-601) Do not require query operator on reports endpoint

With this pull request, hitting the reports endpoint without a query argument
will return the full reports collection.  This behavior is consistent with
that of the nodes, facts, and resources endpoints.

--- src/com/puppetlabs/puppetdb/http/reports.clj
+++ src/com/puppetlabs/puppetdb/http/reports.clj
@@ -48,6 +48,6 @@
   [version]
   (-> (routes version)
     verify-accepts-json
-    (validate-query-params {:required ["query"]
-                            :optional paging/query-params})
+    (validate-query-params
+      {:optional (cons "query" paging/query-params)})
     wrap-with-paging-options))


Breaking down the big walk to smaller functions

--- src/datascript_dom/core.clj
+++ src/datascript_dom/core.clj
@@ -60,7 +60,7 @@
 (defn parse-html-file [filename]
   (html/parse (io/file filename)))

-(defn as-node [node]
+(defn- to-entity [node]
   (if-not (string? node)
     (merge
      {:dom/tag (html/tag node)}
@@ -71,29 +71,29 @@
     {:dom/tag :text-node
      :text    node}))

-(defn has-children? [node]
+(defn- has-children? [node]
   (not-empty (:child node)))

-(defn set-children [node children]
+(defn- set-children [node children]
   (assoc node :child children))

-(defn replace-node [zipper fun]
+(defn- replace-node [zipper fun]
   (zip/replace zipper (fun (zip/node zipper))))
+
+(defn- assoc-dom-index [zipper]
+  (let [new-index (some-> zipper zip/left zip/node :dom/index inc)]
+    (zip/replace
+     zipper
+     (-> zipper
+         zip/node
+         to-entity
+         (assoc :dom/index (or new-index 0))))))

 (defn dom->transaction [dom]
   (loop [zipper (zip/zipper has-children? :child set-children dom)]
     (if (zip/end? zipper)
       [(zip/root zipper)]
-      (let [left   (some-> zipper zip/left zip/node)
-            zipper (replace-node
-                    zipper
-                    #(assoc (as-node %) :dom/index
-                            (if (nil? left)
-                              ;;no-one on your left, you're the first sibling
-                              0
-                              ;;someone on your left, your index is their index +1
-                              (some-> left :dom/index inc))))]
-        (recur (zip/next zipper))))))
+      (recur (zip/next (assoc-dom-index zipper))))))

 (defn- dump [dom]
   (let [z (zip/zipper has-children? html/children set-children dom)]


Fix reference to touch-all

Fix reference to touch-all

--- src/dato/datomic/schema.clj
+++ src/dato/datomic/schema.clj
@@ -1,5 +1,6 @@
 (ns dato.datomic.schema
-  (:require [dato.datomic :as datod]
+  (:require [dato.datascript-utils :as dsu]
+            [dato.datomic :as datod]
             [datomic.api :refer [db q] :as d]))

 (defn attribute [ident type & {:as opts}]
@@ -57,7 +58,7 @@
        :db/ident))

 (defn get-schema-ents [db]
-  (datod/touch-all '{:find [?t]
+  (dsu/touch-all '{:find [?t]
                    :where [[?t :db/ident ?ident]]}
                  db))


Update tools-deps to 1.10.3.1020

Update tools-deps to 1.10.3.1020


many need to fix

many need to fix

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>

--- src/emulator_chip8/cpu.cljc
+++ src/emulator_chip8/cpu.cljc
@@ -80,11 +80,24 @@
         c (count memory)]
     (merge state {:memory (vec (take c (into fontset memory)))})))

+(defn load-rom
+  "Load ROM data to memory."
+  [state rom]
+  (let [memory (:memory state)
+        c (count memory)
+        rom1 (vec rom)
+        p (count rom1)]
+    (merge state
+           {:memory
+            (vec (take c (into (subvec memory 0 0x200) rom1)))})))
+
 (defn reset-cpu
   "Reset the full cpu state."
   []
   (-> (make-cpu)
-      load-fontset))
+      load-fontset)
+  ;; TODO: clear screen
+  )

 (defn step
   "Step through the cpu."


Add and update ClojureDocs for local_data_processing_pipeline.clj.

--- src/dsbdp/local_data_processing_pipeline.clj
+++ src/dsbdp/local_data_processing_pipeline.clj
@@ -153,6 +153,9 @@

 (defn create-local-processing-element
+  "Create a local processing element that is intended to be used in a local data processing pipeline.
+   Input data will be read from the input queue in-queue and processed with the given initial processing function initial-proc-fn.
+   Optionally, the name of the worker thread for the newly created processing element can be set to ProcessingElement_id for which id is replaced with the given id."
   ([^BlockingQueue in-queue initial-proc-fn]
     (create-local-processing-element in-queue initial-proc-fn nil))
   ([^BlockingQueue in-queue initial-proc-fn id]
@@ -194,30 +197,40 @@
        :thread-name thread-name})))

 (defn interrupt
+  "Interrupt the given processing element or pipeline."
   [obj]
   ((obj :interrupt)))

 (defn get-out-queue
+  "Get the output queue of the given processing element or pipeline."
   [obj]
   (obj :out-queue))

 (defn get-id
+  "Get the id of the given processing element."
   [obj]
   (obj :id))

 (defn get-thread-name
+  "Get the thread name of the given processing element."
   [obj]
   (obj :thread-name))

 (defn get-counts
+  "Get the statistic counts of the given processing element or pipeline."
   [obj]
   ((obj :get-counts-fn)))

 (defn set-proc-fn
+  "Set the processing function for the given processing element obj to proc-fn."
   [obj proc-fn]
   ((obj :set-proc-fn) proc-fn))

 (defn create-local-processing-pipeline
+  "Create a local data processing pipeline.
+   fns is expected to be a vector of functions with two arguments.
+   For each function in fns, one processing element will be created in which the respective function is executed.
+   The output function out-fn is called with the result as emitted by the last processing element."
   [fns out-fn]
   (let [running (atom true)
         in-queue (create-queue)
@@ -292,10 +305,12 @@
                              new-proc-fns-vec)))}))

 (defn get-in-fn
+  "Get the input function of the given processing pipeline."
   [obj]
   (obj :in-fn))

 (defn set-proc-fns-vec
+  "Set the processing function vector of the given pipeline obj to fns."
   [obj fns]
   ((obj :set-proc-fns-vec) fns))


Update mongowrapper.clj

Update mongowrapper.clj

--- src/extras/mongowrapper.clj
+++ src/extras/mongowrapper.clj
@@ -35,12 +35,3 @@
   (let [conn (mg/connect)
         db (mg/get-db conn dbname)]
     (mc/count db doc key)))
-
-; drop all
-;var dbs = db.getMongo().getDBNames()
-;for(var i in dbs) {
-; db              = db.getMongo () .getDB (dbs [i])          ;
-; print           ("dropping db " + db.getName ())           ;
-; db.dropDatabase ()                                         ;
-; }
-


Fix swank under Clojure 1.2.1.

Fix swank under Clojure 1.2.1.

--- modules/core/src/main/clojure/immutant/repl.clj
+++ modules/core/src/main/clojure/immutant/repl.clj
@@ -22,6 +22,19 @@
             [immutant.utilities         :as util]
             [clojure.tools.logging      :as log]))

+(defn ^{:private true} fix-port [port]
+  (if (= String (class port))
+    (Integer. port)
+    port))
+
+;; We have to bind the repl * vars under 1.2.1, otherwise swank fails to start
+(defmacro with-base-repl-bindings [& body]
+  `(binding [clojure.core/*e nil
+             clojure.core/*1 nil
+             clojure.core/*2 nil
+             clojure.core/*3 nil]
+     ~@body))
+
 (defn stop-swank
   "Shuts down the running swank server."
   []
@@ -35,7 +48,8 @@
 undeploy."
   ([interface-address port]
      (log/info "Starting swank for" (util/app-name) "at" (str interface-address ":" port))
-     (swank/start-server :host interface-address :port (Integer. port) :exit-on-quit false)
+     (with-base-repl-bindings
+       (swank/start-server :host interface-address :port (fix-port port) :exit-on-quit false))
      (util/at-exit stop-swank))
   ([port]
      (start-swank (util/management-interface-address) port)))
@@ -54,7 +68,7 @@
 stop-nrepl to shut it down manually."
   ([interface-address port]
      (log/info "Starting nrepl for" (util/app-name) "at" (str interface-address ":" port))
-     (when-let [server (nrepl/start-server :port (Integer. port) :host interface-address)]
+     (when-let [server (nrepl/start-server :port (fix-port port) :host interface-address)]
        (util/at-exit (partial stop-nrepl server))
        server))
   ([port]


Learning how to do recursion in clojure. #13 accomplished

--- hackerrank/functional_programming/clojure/clojure-koans/src/koans/13_recursion.clj
+++ hackerrank/functional_programming/clojure/clojure-koans/src/koans/13_recursion.clj
@@ -3,21 +3,35 @@

 (defn is-even? [n]
   (if (= n 0)
-    __
-    (___ (is-even? (dec n)))))
+    true
+    (not (is-even? (dec n)))))

 (defn is-even-bigint? [n]
-  (loop [n   n
+  (loop [n n
          acc true]
     (if (= n 0)
-      __
+      acc
       (recur (dec n) (not acc)))))

 (defn recursive-reverse [coll]
-  __)
+  (loop [collection coll reversed ()]
+    (if (= collection ())
+      reversed
+      (recur (rest collection) ( cons (first collection) reversed)))))

 (defn factorial [n]
-  __)
+  ; set result to be 1
+  ; set n to be n
+  (loop [result 1
+         n n]
+    (if (= n 0)
+      ; base case
+      ; return result
+      result
+      ; else dec n and multiple result by n
+      ; ** Position matters! result was created before n, result's modification comes first, then the changes to n
+      ; failure to do this will result in headaches and heartattacks
+      (recur (* n result) (dec n)))))

 (meditations
   "Recursion ends with a base case"


regex improvements for queries as links in markdown

--- iwaswhere-web/src/cljs/iwaswhere_web/helpers.cljs
+++ iwaswhere-web/src/cljs/iwaswhere_web/helpers.cljs
@@ -22,8 +22,8 @@
   The negative lookahead (?!`) makes sure that tags and mentions are not found and processed
   when they are quoted as code with backticks."
   [text]
-  (let [tags (set (re-seq (js/RegExp. (str "(?!^)#" tag-char-class "+(?!" tag-char-class ")(?!`)") "m") text))
-        mentions (set (re-seq (js/RegExp. (str "@" tag-char-class "+(?!" tag-char-class ")(?!`)") "m") text))]
+  (let [tags (set (re-seq (js/RegExp. (str "(?!^)#" tag-char-class "+(?!" tag-char-class ")(?![`)])") "m") text))
+        mentions (set (re-seq (js/RegExp. (str "@" tag-char-class "+(?!" tag-char-class ")(?![`)])") "m") text))]
     {:md        text
      :tags      tags
      :mentions  mentions}))


more cleanup

more cleanup

--- src/gui/core.clj
+++ src/gui/core.clj
@@ -85,8 +85,7 @@
                                :model [:columns ["Name" "Value"]
                                        :rows (get-rows selected-model)])))])
     :size wine-results-size
-    :border [2 "Results" 10]
-    ))
+    :border [2 "Results" 10]))

 (def container


Add write-checkpoints implementation to ZooKeeper

--- src/onyx/log/zookeeper.clj
+++ src/onyx/log/zookeeper.clj
@@ -71,6 +71,9 @@

 (defn exception-path [prefix]
   (str (prefix-path prefix) "/exception"))
+
+(defn checkpoint-path [prefix]
+  (str (prefix-path prefix) "/checkpoint"))

 (defn throw-subscriber-closed []
   (throw (ex-info "Log subscriber closed due to disconnection from ZooKeeper" {})))
@@ -122,6 +125,7 @@
       (zk/create conn (job-scheduler-path onyx-id) :persistent? true)
       (zk/create conn (messaging-path onyx-id) :persistent? true)
       (zk/create conn (exception-path onyx-id) :persistent? true)
+      (zk/create conn (checkpoint-path onyx-id) :persistent? true)

       (initialize-origin! conn config onyx-id)
       (assoc component :server server :conn conn :prefix onyx-id :kill-ch kill-ch)))
@@ -630,10 +634,17 @@
       (extensions/emit monitoring args))))

 (defmethod extensions/write-checkpoint ZooKeeper
-  [log job-id replica-version epoch task-id slot-id checkpoint]
-  (throw (Exception. "NotImplemented")))
+  [{:keys [conn opts prefix monitoring]} job-id replica-version epoch task-id slot-id checkpoint]
+  ;; TODO; add monitoring
+  (let [node (str (checkpoint-path prefix) "/" job-id "/" replica-version "-" epoch "/" task-id "-" slot-id)
+        bytes (zookeeper-compress checkpoint)
+        version (:version (zk/exists conn node))]
+    (if (nil? version)
+      (zk/create-all conn node :persistent? true :data bytes)
+      (zk/set-data conn node bytes version))))

 (defmethod extensions/read-checkpoints ZooKeeper
   [log job-id]
+  ;[]
   ;; Note: this implementation cannot be safe if more than one peer will use it to get state
   (throw (Exception. "NotImplemented")))


util/s3.clj: catch and wrap jets3t Exceptions

--- src/org/altlaw/util/s3.clj
+++ src/org/altlaw/util/s3.clj
@@ -10,6 +10,13 @@
            (org.apache.commons.codec.digest DigestUtils)
            (java.io ByteArrayInputStream)
            (java.util.zip GZIPInputStream)))
+
+(defmacro catch-s3-errors [& body]
+  `(try
+    ~@body
+    (catch org.jets3t.service.S3ServiceException e#
+      (throw (Exception. (str "S3 Error " (. e# getS3ErrorCode)
+                              " " (. e# getS3ErrorMessage)) e#)))))

 (def #^{:private true} get-s3
      (memoize (fn []
@@ -39,8 +46,9 @@
   "Returns a list of symbols.  Each symbol has a name matching a
   bucket name, and metadata matching that bucket's S3 metadata."
   []
-  (map make-bucket-symbol
-       (.listAllBuckets (get-s3))))
+  (catch-s3-errors
+   (map make-bucket-symbol
+        (.listAllBuckets (get-s3)))))

 (defn list-objects
   ([bucket-name]
@@ -49,59 +57,66 @@
      (.listObjects (get-s3) (get-bucket bucket-name) nil)))

 (defn delete-object [bucket-name object-key]
-  (.deleteObject (get-s3) bucket-name object-key))
+  (catch-s3-errors (.deleteObject (get-s3) bucket-name object-key)))

 (defn get-object [bucket-name object-key]
   (.getObject (get-s3) (get-bucket bucket-name) object-key))

 (defn get-object-meta [bucket-name object-key]
-  (into {} (.getMetadataMap
-            (.getObjectDetails (get-s3) (get-bucket bucket-name)
-                               object-key))))
+  (catch-s3-errors
+   (into {} (.getMetadataMap
+             (.getObjectDetails (get-s3) (get-bucket bucket-name)
+                                object-key)))))

 (defn get-object-stream [bucket-name object-key]
-  (let [object (get-object bucket-name object-key)
-        input (.getDataInputStream object)]
-    (if (= (.getContentEncoding object) "gzip")
-      (GZIPInputStream. input)
-      input)))
+  (catch-s3-errors
+   (let [object (get-object bucket-name object-key)
+         input (.getDataInputStream object)]
+     (if (= (.getContentEncoding object) "gzip")
+       (GZIPInputStream. input)
+       input))))

 (defn get-object-string [bucket-name object-key]
-  (IOUtils/toString (get-object-stream bucket-name object-key)
-                    "UTF-8"))
+  (catch-s3-errors
+   (IOUtils/toString (get-object-stream bucket-name object-key)
+                     "UTF-8")))

 (defn put-object-stream [bucket-name object-key stream metadata]
-  (let [bucket (get-bucket bucket-name)
-        object (S3Object. bucket object-key)]
-    (.addAllMetadata object metadata)
-    (.setDataInputStream object stream)
-    (.putObject (get-s3) bucket object)))
+  (catch-s3-errors
+   (let [bucket (get-bucket bucket-name)
+         object (S3Object. bucket object-key)]
+     (.addAllMetadata object metadata)
+     (.setDataInputStream object stream)
+     (.putObject (get-s3) bucket object))))

 (defn put-object-string [bucket-name object-key data-string metadata]
-  (let [bucket (get-bucket bucket-name)
-        object (S3Object. bucket object-key data-string)]
-    (.addAllMetadata object metadata)
-    (.putObject (get-s3) bucket object)))
+  (catch-s3-errors
+   (let [bucket (get-bucket bucket-name)
+         object (S3Object. bucket object-key data-string)]
+     (.addAllMetadata object metadata)
+     (.putObject (get-s3) bucket object))))

 (defn put-object-gzip-string
   [bucket-name object-key data-string metadata]
-  (let [bucket (get-bucket bucket-name)
-        object (S3Object. bucket object-key)
-        bytes (zip/gzip-utf8-string data-string)]
-    (.addAllMetadata object metadata)
-    (.setContentEncoding object "gzip")
-    (.setContentLength object (count bytes))
-    (.setDataInputStream object (ByteArrayInputStream. bytes))
-    (.putObject (get-s3) bucket object)))
+  (catch-s3-errors
+   (let [bucket (get-bucket bucket-name)
+         object (S3Object. bucket object-key)
+         bytes (zip/gzip-utf8-string data-string)]
+     (.addAllMetadata object metadata)
+     (.setContentEncoding object "gzip")
+     (.setContentLength object (count bytes))
+     (.setDataInputStream object (ByteArrayInputStream. bytes))
+     (.putObject (get-s3) bucket object))))

 (defn put-object-gzip-bytes
   [bucket-name object-key bytes metadata]
-  (let [bucket (get-bucket bucket-name)
-        object (S3Object. bucket object-key)
-        gzipped-bytes (zip/gzip-bytes bytes)]
-    (.addAllMetadata object metadata)
-    (.setContentEncoding object "gzip")
-    (.setContentLength object (count gzipped-bytes))
-    (.setMd5Hash object (DigestUtils/md5 gzipped-bytes))
-    (.setDataInputStream object (ByteArrayInputStream. gzipped-bytes))
-    (.putObject (get-s3) bucket object)))
+  (catch-s3-errors
+   (let [bucket (get-bucket bucket-name)
+         object (S3Object. bucket object-key)
+         gzipped-bytes (zip/gzip-bytes bytes)]
+     (.addAllMetadata object metadata)
+     (.setContentEncoding object "gzip")
+     (.setContentLength object (count gzipped-bytes))
+     (.setMd5Hash object (DigestUtils/md5 gzipped-bytes))
+     (.setDataInputStream object (ByteArrayInputStream. gzipped-bytes))
+     (.putObject (get-s3) bucket object))))


Automatically mapping buffers to their ID number in ugen functions.  Need to do a major refactor of ugen function code eventually...

--- src/overtone/core/ugen.clj
+++ src/overtone/core/ugen.clj
@@ -11,13 +11,13 @@
         clojure.contrib.pprint
         [clojure.contrib.fcase :only (case)]
         clojure.set)
-  (:require
+  (:require
      [clojure.contrib.generic.arithmetic :as ga]
      [clojure.contrib.generic.comparison :as gc]
      [clojure.contrib.generic.math-functions :as gm]))

 ;; Outputs have a specified calculation rate
-;;   0 = scalar rate - one sample is computed at initialization time only.
+;;   0 = scalar rate - one sample is computed at initialization time only.
 ;;   1 = control rate - one sample is computed each control period.
 ;;   2 = audio rate - one sample is computed for each sample of audio output.
 (def RATES {:ir 0
@@ -40,18 +40,18 @@
    :standard true
    })

-(defn normalize-ugen-name
+(defn normalize-ugen-name
   "Normalizes SuperCollider and overtone-style names to squeezed lower-case."
   [n]
   (.replaceAll (.toLowerCase (str n)) "[-|_]" ""))

-(defn overtone-ugen-name
-  "A basic camelCase to with-dash name converter tuned to convert SuperCollider names to Overtone names.
+(defn overtone-ugen-name
+  "A basic camelCase to with-dash name converter tuned to convert SuperCollider names to Overtone names.
   Most likely needs improvement."
   [n]
-  (let [n (.replaceAll n "([a-z])([A-Z])" "$1-$2")
-        n (.replaceAll n "([A-Z])([A-Z][a-z])" "$1-$2")
-        n (.replaceAll n "_" "-")
+  (let [n (.replaceAll n "([a-z])([A-Z])" "$1-$2")
+        n (.replaceAll n "([A-Z])([A-Z][a-z])" "$1-$2")
+        n (.replaceAll n "_" "-")
         n (.toLowerCase n)]
   n))

@@ -60,19 +60,19 @@

 (defn- derive-ugen-specs
   "Merge the ugen spec maps to give children their parent's attributes.
-
+
   Recursively reduces the specs to support arbitrary levels of derivation."
   ([specs] (derive-ugen-specs specs {} 0))
   ([children adults depth]
-   ; Make sure a bogus UGen doesn't spin us off into infinity... ;-)
+   ; Make sure a bogus UGen doesn't spin us off into infinity... ;-)
    {:pre [(< depth 8)]}

-   (let [[adults children]
+   (let [[adults children]
          (reduce (fn [[full-specs new-children] spec]
-                   (if (derived? spec)
+                   (if (derived? spec)
                      (if (contains? full-specs (:extends spec))
-                       [(assoc full-specs (:name spec)
-                               (merge (get full-specs (:extends spec)) spec))
+                       [(assoc full-specs (:name spec)
+                               (merge (get full-specs (:extends spec)) spec))
                         new-children]
                        [full-specs (conj new-children spec)])
                      [(assoc full-specs (:name spec) spec) new-children]))
@@ -93,18 +93,18 @@
   [spec]
   (assoc spec :categories (get UGEN-CATEGORY-MAP (:name spec) [])))

-(defn- with-expands
+(defn- with-expands
   "Sets the :expands? attribute for ugen-spec arguments, which will inform the
   automatic channel expansion system when to expand argument."
   [spec]
-  (assoc spec :args
-         (map (fn [arg]
-                (assoc arg :expands?
+  (assoc spec :args
+         (map (fn [arg]
+                (assoc arg :expands?
                        (get UGEN-SPEC-EXPANSION-MODES (get arg :mode :standard))))
               (:args spec))))

 (defn- with-fn-names
-  "Generates all the function names for this ugen and adds a :fn-names map
+  "Generates all the function names for this ugen and adds a :fn-names map
   that maps function names to rates, representing the output rate.

   All available rates get an explicit function name of the form <fn-name>:<rate>
@@ -115,7 +115,7 @@
   UGens will also have a base-name without a rate suffix that uses the default rate
   for that ugen:
     * (env-gen ...)   ;; Uses :kr, control rate for EnvGen
-
+
   The default rate is determined by the rate precedence:
     [:ir :dr :ar :kr]

@@ -138,7 +138,7 @@
   [args spec prop]
   (partition 2 (interleave args (map #(get % prop) (:args spec)))))

-(defn- map-ugen-args
+(defn- map-ugen-args
   "Perform any argument mappings that needs to be done."
   [spec args]
   (let [args-specs (args-with-specs args spec :map)]
@@ -166,8 +166,8 @@
   (let [defaults (map #(:default %) (:args spec))
         defaults (drop (count args) defaults)]
     (when (some #(nil? %) defaults)
-      (throw (IllegalArgumentException.
-        (str "\n- - -\nMissing arguments for: " (:name spec) " UGen => "
+      (throw (IllegalArgumentException.
+        (str "\n- - -\nMissing arguments for: " (:name spec) " UGen => "
              (doall (drop (count args) (map #(:name %) (:args spec))))))))
     (concat args defaults)))

@@ -185,14 +185,14 @@

 ; TODO: Refactor these init functions so everything just takes a ugen and a spec
    ; and outputs an updated ugen...  Should have done it like this initially...
-(defn- with-init-fn
+(defn- with-init-fn
   "Creates the final argument initialization function which is applied to arguments
-  at runtime to do things like re-ordering and automatic filling in of arguments.
-  Typically appending input arrays as the last argument and filling in the number of
+  at runtime to do things like re-ordering and automatic filling in of arguments.
+  Typically appending input arrays as the last argument and filling in the number of
   in or out channels for those ugens that need it.
-
+
   If an init function is already present it will get called after doing the mapping and
-  mode transformations."
+  mode transformations."
   [spec]
   (let [map-fn (partial map-ugen-args spec)
         append-fn (partial append-seq-args spec)
@@ -200,14 +200,14 @@
         arg-init-fn (if (contains? spec :init)
                   (comp (:init spec) map-fn default-fn)
                   (comp map-fn default-fn))]
-    (assoc spec :init
-           (fn [ugen]
+    (assoc spec :init
+           (fn [ugen]
              (let [ugen (assoc ugen :args (arg-init-fn (:args ugen)))
                    ugen (with-num-outs-mode spec ugen)
                    mod-args (assoc ugen :args (append-fn (:args ugen)))]
                mod-args)))))

-(defn- enrich-ugen-spec
+(defn- enrich-ugen-spec
   "Interpret a ugen-spec and add in additional, computed meta-data."
   [spec]
   (-> spec
@@ -225,30 +225,30 @@
           namespaces))

 (defn- load-ugen-specs [namespaces]
-  "Perform the derivations and setup defaults for rates, names,
+  "Perform the derivations and setup defaults for rates, names,
   argument initialization functions, and channel expansion flags."
   (let [specs (specs-from-namespaces namespaces)
         derived (derive-ugen-specs specs)]
     (map enrich-ugen-spec derived)))
-
-; TODO: currently not including pseudo because it causes problems and I
+
+; TODO: currently not including pseudo because it causes problems and I
 ; don't know what they are...
-(def UGEN-NAMESPACES
+(def UGEN-NAMESPACES
   '[basicops buf-io compander delay envgen fft2 fft-unpacking grain
     io machine-listening misc osc beq-suite chaos control demand
     ff-osc fft info noise pan trig line input filter])

 (def UGEN-SPECS (load-ugen-specs UGEN-NAMESPACES))
-(def UGEN-SPEC-MAP (zipmap
+(def UGEN-SPEC-MAP (zipmap
                      (map #(normalize-ugen-name (:name %)) UGEN-SPECS)
-                     UGEN-SPECS))
+                     UGEN-SPECS))

 (defn get-ugen [word]
   (get UGEN-SPEC-MAP (normalize-ugen-name word)))

 (defn find-ugen [regexp]
   (map #(second %)
-       (filter (fn [[k v]] (re-find (re-pattern (normalize-ugen-name regexp))
+       (filter (fn [[k v]] (re-find (re-pattern (normalize-ugen-name regexp))
                                     (str k)))
                UGEN-SPEC-MAP)))

@@ -261,7 +261,7 @@
   (doseq [cat cats]
     (println (apply str (interpose " -> " cat)))))

-(def UGEN-RATE-SORT-FN
+(def UGEN-RATE-SORT-FN
   (apply hash-map (flatten (map reverse (indexed UGEN-RATE-PRECEDENCE)))))

 (defn- print-ugen-rates [rates]
@@ -276,13 +276,13 @@
     (print "  Categories: ")
     (print-ugen-categories (:categories ugen))
     ;(print "  default args:\n    ")
-    (print "  Rates: ")
+    (print "  Rates: ")
     (print-ugen-rates (:rates ugen))))

 (defn inf!
   "users use this to tag infinite sequences for use as
    expanded arguments. needed or else multichannel
-   expansion will blow up"
+   expansion will blow up"
   [sq]
   (with-meta sq
     (merge (meta sq) {:infinite-sequence true})))
@@ -315,21 +315,21 @@
   (if (zero? (count args))
     [[]]
     (let [gc-seqs (fn [[gcount seqs] arg]
-                    (cond
+                    (cond
                       ; Infinite seqs can be used to generate values for expansion
-                      (inf? arg) [gcount
-                                  (conj seqs arg)
+                      (inf? arg) [gcount
+                                  (conj seqs arg)
                                   (next expand-flags)]

                       ; Regular, non-infinite and non-map collections get expanded
-                      (and (expandable? arg)
-                           (first expand-flags)) [(max gcount (count arg))
+                      (and (expandable? arg)
+                           (first expand-flags)) [(max gcount (count arg))
                                                   (conj seqs (cycle-vals arg))
                                                   (next expand-flags)]

                       :else ; Basic values get used for all expansions
-                      [gcount
-                       (conj seqs (repeat arg))
+                      [gcount
+                       (conj seqs (repeat arg))
                        (next expand-flags)]))
           [greatest-count seqs] (reduce gc-seqs [1 [] expand-flags] args)]
       (take greatest-count (apply parallel-seqs seqs)))))
@@ -343,7 +343,7 @@
         (first expanded)
         expanded))))

-; TODO: Finish me!
+; TODO: Finish me!
 ; Need to execute the check predicates to do things like verify argument rates, etc...
 (defn check-ugen-args [spec rate special args]
   (if (vector? (:check spec))
@@ -355,8 +355,8 @@
 (deftype ::ugen ugen
   (fn [spec rate special args]
     ;(check-ugen-args spec rate special args)
-    (let [ug (struct ugen-struct
-                     (next-id :ugen)
+    (let [ug (struct ugen-struct
+                     (next-id :ugen)
                      (:name spec)
                      (if (keyword? rate) (get RATES rate) rate)
                      special
@@ -373,11 +373,18 @@

 (defn ugen? [obj] (= ::ugen (type obj)))

+(defn- make-buffer-id
+  "Returns a function that converts any buffer arguments to their :id property value."
+  [fun]
+  (fn [& args]
+    (apply fun (map #(if (overtone.core.sc/buffer? %) (:id %) %) args))))
+
 (defn- make-ugen-fn
   "Returns a function representing the given ugen that will fill in default arguments, rates, etc."
   [spec rate special]
   (let [expand-flags (map #(:expands? %) (:args spec))]
-    (make-expanding (ugen-base-fn spec rate special) expand-flags)))
+    (make-buffer-id
+      (make-expanding (ugen-base-fn spec rate special) expand-flags))))

 ;; TODO: Figure out the complete list of control types
 ;; This is used to determine the controls we list in the synthdef, so we need
@@ -398,7 +405,7 @@

 (defn control? [obj]
   (isa? (type obj) ::control))
-
+
 ;; TODO:
 ;; * Need to write a function that takes a ugen-spec, and generates a set
 ;; of ugen functions for that spec.  Each of these functions will automatically
@@ -420,7 +427,7 @@
 (defn- def-ugen
   "Create and intern a set of functions for a given ugen-spec.
     * base name function using default rate and no suffix (e.g. env-gen )
-    * base-name plus rate suffix functions for each rate (e.g. env-gen:ar, env-gen:kr)
+    * base-name plus rate suffix functions for each rate (e.g. env-gen:ar, env-gen:kr)
   "
   [to-ns spec special]
   (let [metadata {:doc (ugen-docs spec)
@@ -466,7 +473,7 @@
 ; that is currently not yet implemented...
 (defn- mul-add [in mul add]
   (with-meta {:id (next-id :ugen)
-              :name "MulAdd"
+              :name "MulAdd"
               :rate (or (:rate in) 2)
               :special 0
               :args [in mul add]}
@@ -475,7 +482,7 @@
 (load "ops")

 (deftype ::control-proxy control-proxy
-  (fn [name]
+  (fn [name]
     {:name (str name)})
   (fn [u] (:name u)))

@@ -483,13 +490,13 @@

 (defn control-proxy? [obj] (= ::control-proxy (type obj)))

-(defn intern-ugens
+(defn intern-ugens
   "Iterate over all UGen meta-data, generate the corresponding functions and intern them
   in the current or otherwise specified namespace."
   [& [to-ns]]
   (let [to-ns (or to-ns *ns*)]
-    (doseq [ugen (filter #(not (or (= "UnaryOpUGen" (:name %))
-                                   (= "BinaryOpUGen" (:name %))))
+    (doseq [ugen (filter #(not (or (= "UnaryOpUGen" (:name %))
+                                   (= "BinaryOpUGen" (:name %))))
                          UGEN-SPECS)]
               (def-ugen to-ns ugen 0))
     (doseq [[op-name special] UNARY-OPS]
@@ -509,12 +516,12 @@
 ;; stick an Out ugen on synths that don't explicitly use one.
 (intern-ugens (create-ns 'overtone.ugens))

-(defn refer-ugens
+(defn refer-ugens
   "This is how you (use 'overtone.ugens)."
   []
   (let [local-map (ns-map *ns*)
         ugen-map (ns-map 'overtone.ugens)
-        collisions (intersection (set (keys local-map))
+        collisions (intersection (set (keys local-map))
                                  (set (keys ugen-map)))]
     (doseq [v collisions]
       (ns-unmap *ns* v))


Make error clearer by including valid file types.

--- src/overtone/sc/buffer.clj
+++ src/overtone/sc/buffer.clj
@@ -146,7 +146,7 @@
          (let [info                              (buffer-info id)
                {:keys [id size rate n-channels]} info]
            (when (every? zero? [size rate n-channels])
-             (throw (Exception. (str "Unable to read file - perhaps path is not a valid audio file: " path))))
+             (throw (Exception. (str "Unable to read file - perhaps path is not a valid audio file (only .wav or .aiff supported) : " path))))

            (map->BufferFile
             (assoc info


Don't send any longs to the server. Thanks to MHOOO for pointing this out - Clojure 1.3 uses longs by default for "integers".

--- src/overtone/sc/server.clj
+++ src/overtone/sc/server.clj
@@ -51,17 +51,28 @@
   (or
    (= :connected @server-status*)))

+(defn- massage-numerical-args
+  "Massage numerical args to the form SC would like them. Currently this just
+  casts all Longs to Integers."
+  [args]
+  (map (fn [arg]
+         (if (instance? Long arg)
+           (Integer. arg)
+           arg))
+       args))
+
 (defn snd
-  "Sends an OSC message. If the message path is a known scsynth path, then the
-   types of the arguments will be checked according to what scsynth is
-   expecting.
+  "Sends an OSC message to the server. If the message path is a known scsynth
+  path, then the types of the arguments will be checked according to what
+  scsynth is expecting. Automatically converts any args which are longs to ints.

   (snd \"/foo\" 1 2.0 \"eggs\")"
   [path & args]
-  (when @osc-debug*
-    (println "Sending: " path [args])
-    (log/debug (str "Sending: " path [args])))
-  (apply validated-snd @server* path args)
+  (let [args (massage-numerical-args args)]
+    (when @osc-debug*
+      (println "Sending: " path [args])
+      (log/debug (str "Sending: " path [args])))
+    (apply validated-snd @server* path args))

   (if (not (connected?))
     (log/debug "### trying to snd while disconnected! ###")))


Removed erroneous type declaration method function parameter.

--- src/pe_core_utils/core.clj
+++ src/pe_core_utils/core.clj
@@ -110,7 +110,7 @@
 (defn keyword->jsonkey
   "Returns keyword as a JSON string (basically just removes the beginning
   colon."
-  [^String keyword]
+  [keyword]
   (.substring (.toString keyword) 1))

 (defn ->jsonkeys


Removed println call

Removed println call

--- src/polismath/clusters.clj
+++ src/polismath/clusters.clj
@@ -355,28 +355,30 @@
     (count (filter filt-fn votes))))

-(let [initial-comment-stats-graphimpl
-        (gr/eager-compile
-          {:na (fnk [votes] (count-votes votes -1))
-           :nd (fnk [votes] (count-votes votes  1))
-           :ns (fnk [votes] (count-votes votes))
-           ; XXX - Change when we flip votes!!!
-           :pa (fnk [na ns] (/ (+ 1 na) (+ 2 ns)))
-           :pd (fnk [nd ns] (/ (+ 1 nd) (+ 2 ns)))
-           :pat (fnk [na ns] (prop-test na ns))
-           :pdt (fnk [nd ns] (prop-test nd ns))})]
+(def comment-stats-graphimpl
   ; The graph implementation is in a closure so that we don't reify classes every time function is called.
-  ; This can cause PermGen space crashes.
-  (defn- initial-comment-stats
-    "Vote count stats for a given vote column. This vote column should represent the votes for a specific
-    comment and group. Comparisons _between_ groups happen later. See `(doc conv-repness)` for key details."
-    [vote-col]
-    (initial-comment-stats-graphimpl {:votes vote-col})))
+  ; This can cause PermGen space crashes. This is used for both consensus and repness comments.
+  (gr/eager-compile
+    {:na (fnk [votes] (count-votes votes -1))
+     :nd (fnk [votes] (count-votes votes  1))
+     :ns (fnk [votes] (count-votes votes))
+     ; XXX - Change when we flip votes!!!
+     :pa (fnk [na ns] (/ (+ 1 na) (+ 2 ns)))
+     :pd (fnk [nd ns] (/ (+ 1 nd) (+ 2 ns)))
+     :pat (fnk [na ns] (prop-test na ns))
+     :pdt (fnk [nd ns] (prop-test nd ns))}))
+
+
+(defn- comment-stats
+  "Vote count stats for a given vote column. This vote column should represent the votes for a specific
+  comment and group. Comparisons _between_ groups happen later. See `(doc conv-repness)` for key details."
+  [vote-col]
+  (comment-stats-graphimpl {:votes vote-col}))

 (defn- add-comparitive-stats
-  "Builds on results of initial-comment-stats by doing comparisons _between_ groups. Args are
-  in group stats (as returned by initial-comment-stats), and list of stats for rest of groups.
+  "Builds on results of comment-stats by doing comparisons _between_ groups. Args are
+  in group stats (as returned by comment-stats), and list of stats for rest of groups.
   See `(doc conv-repness)` for key details."
   [in-stats rest-stats]
   (assoc in-stats
@@ -411,7 +413,7 @@
          map
          (fn [& vote-cols-for-groups]
            (->>
-             (mapv initial-comment-stats vote-cols-for-groups)
+             (mapv comment-stats vote-cols-for-groups)
              (mapv-rest add-comparitive-stats)))))})

@@ -503,7 +505,7 @@
     ; reduce with indices, so we have tids
     (with-indices stats)
     (reduce
-      (fn [result [tid comment-stats]]
+      (fn [result [tid stats]]
         ; Inner reduce folds data into result for each group in comment stats
         ; XXX - could this be an assoc-in?
         (reduce
@@ -532,7 +534,7 @@
                   (gr-assoc gr :best-agree (assoc comment-conv-stats :tid tid))
                   gr))))
           result
-          (zip ids comment-stats)))
+          (zip ids stats)))
       ; initialize result hash
       (into {} (map #(vector % {:best nil :best-agree nil :sufficient []}) ids)))
     ; If no sufficient, use best; otherwise sort sufficient and take 5
@@ -544,7 +546,6 @@
                           best-agree [best-agree]
                           best       [best]
                           :else      [])]
-          (println best-agree)
           ; If there weren't any matches of the criteria, just take the best match, and take the best agree if
           ; possible, and if not just the best general
           (if (empty? sufficient)
@@ -556,6 +557,31 @@
                  (concat (if best-agree [best-agree] [])) ; put best agree at front, if possible
                  (take 5) ; take the top 5
                  (agrees-before-disagrees))))))))
+
+
+(defn consensus-stats
+  [data]
+  (-> data
+      get-matrix
+      columns
+      (map (comp comment-stats))
+      (map #(assoc %2 :tid %1) (range))))
+
+
+(defn select-consensus-comments
+  [cons-stats]
+  (let [stats (map
+                (fn [stat]
+                  (assoc stat
+                         :dm (* (:pd stat) (:pdt stat))
+                         :am (* (:pa stat) (:pat stat)))))
+        top-5 (fn [metric]
+                (->> stats
+                     (filter #(> (metric %) 1.0))
+                     (sort-by (comp - metric))
+                     (take 5)))]
+    {:agree    (top-5 :am)
+     :disagree (top-5 :dm)}))

 (defn xy-clusters-to-nmat [clusters]


fix indentation.

fix indentation.

--- src/kixi/hecuba/data/measurements/upload.clj
+++ src/kixi/hecuba/data/measurements/upload.clj
@@ -71,11 +71,11 @@
   (let [{:keys [dir filename entity_id]} item
         blank-row? (fn [cells] (every? #(re-matches #"\s*" %) cells))
         header-rows   (with-open [in (io/reader (io/file dir filename))]
-                                     (->> in
-                                          (csv/read-csv)
-                                          (take-while (complement (comp tf/parse first)))
-                                          (remove blank-row?)
-                                          (doall)))]
+                        (->> in
+                             (csv/read-csv)
+                             (take-while (complement (comp tf/parse first)))
+                             (remove blank-row?)
+                             (doall)))]
     (db/with-session [session (:hecuba-session store)]
       (let [entity                   (entities/get-by-id session entity_id)
             devices                  (devices/get-devices session entity_id)


MMT-1775: update preview gem version from MMT updating to UMM-C v1.13 (#748)

--- collection-renderer-lib/project.clj
+++ collection-renderer-lib/project.clj
@@ -14,7 +14,7 @@
    the hardcoded commit id during dev integration with cmr_metadata_preview project.
    The hardcoded commit id should be updated when MMT releases a new version of the gem."
   (or (System/getenv "CMR_METADATA_PREVIEW_COMMIT")
-      "a15d2e041b3"))
+      "2bc14652410"))

 (def gem-install-path
   "The directory within this library where Ruby gems are installed."


Still WIP: AOC 10 part 1

Still WIP: AOC 10 part 1

--- clj/advent-of-code-2016/src/advent_of_code_2016/day10.clj
+++ clj/advent-of-code-2016/src/advent_of_code_2016/day10.clj
@@ -1,6 +1,9 @@
 (ns advent-of-code-2016.day10)

 (def input "value 5 goes to bot 2\nbot 2 gives low to bot 1 and high to bot 0\nvalue 3 goes to bot 1\nbot 1 gives low to output 1 and high to bot 0\nbot 0 gives low to output 2 and high to output 0\nvalue 2 goes to bot 2")
+
+
+(def initial-state {:output {} :bot {}})

 (defn parse-line
   [line]
@@ -10,15 +13,20 @@
       {:bot (Integer/parseInt bot) :low-type (keyword low-type) :low (Integer/parseInt low) :high-type (keyword high-type) :high (Integer/parseInt high)}
       (throw (Exception. (str "Invalid input: " line))))))

+(defn process-direct
+  [state {value :value bot :bot}]
+  (let [bots-state (merge-with clojure.set/union (:bot state) {bot #{value}})]
+    (assoc state :bot bots-state)))
+
 (defn process-instruction
   [state instruction]
-  (if-let [val (:value instruction)]
-    (merge-with clojure.set/union state {(:bot instruction) #{val}})
+  (if (:value instruction)
+    (process-direct state instruction)
     state))

 (defn process-instructions
   [instructions]
-  (reduce process-instruction {} instructions))
+  (reduce process-instruction initial-state instructions))

 (defn parse-input
   [input]


Fixes #2: mark library for logs

Fixes #2: mark library for logs

--- src/ardoq/analytics_clj.clj
+++ src/ardoq/analytics_clj.clj
@@ -26,6 +26,9 @@
                                 (.setMaxQueueSize max-queue-size)
                                 (.setTimeout timeout)))))

+(defn context []
+  (.put (Context.) "library" "analytics-clj"))
+
 (defn identify
   "Identifying a user ties all of their actions to an id, and associates user traits to that id.

@@ -43,7 +46,7 @@
   ([^AnalyticsClient client ^String user-id traits & [{:keys [timestamp options callback]}]]
      (let [the-callback (if callback (reify Callback (onResponse [this success message] (callback success message))))
            traits (reduce (fn [t [k v]] (.put t (name k) v)) (Traits.) traits)
-           options (reduce (fn [t [k v]] (.put t (name k) v)) (Context.) options)]
+           options (reduce (fn [t [k v]] (.put t (name k) v)) (context) options)]
        (.identify client user-id traits timestamp options the-callback))))

@@ -69,7 +72,7 @@
   ([^AnalyticsClient client ^String user-id ^String event properties & [{:keys [timestamp options callback]}]]
      (let [the-callback (if callback (reify Callback (onResponse [this success message] (callback success message))))
            properties (EventProperties. (into-array Object (apply concat (vec (map-keys name properties)))))
-           options (reduce (fn [t [k v]] (.put t (name k) v)) (Context.) options)]
+           options (reduce (fn [t [k v]] (.put t (name k) v)) (context.) options)]
        (.track client user-id event properties timestamp options the-callback))))

 (defn make-alias
@@ -88,7 +91,7 @@
   ([^AnalyticsClient client ^String from ^String to] (make-alias client from to {}))
   ([^AnalyticsClient client ^String from ^String to & [{:keys [timestamp options callback]}]]
      (let [the-callback (if callback (reify Callback (onResponse [this success message] (callback success message))))
-           options (reduce (fn [t [k v]] (.put t (name k) v)) (Context.) options)]
+           options (reduce (fn [t [k v]] (.put t (name k) v)) (context) options)]
        (.alias client from to timestamp options the-callback))))

 (defn flush-queue


added minify function to minify mixed assets

--- src/asset_minifier/core.clj
+++ src/asset_minifier/core.clj
@@ -43,8 +43,7 @@
             compressed-length   (.length target)]
         {:original-szie uncompressed-length
          :compressed-size compressed-length
-         :summary (str "Uncompressed size: "  " bytes\n"
-                       "Compressed size: "compressed-length " bytes minified (" (.length tmp) " bytes gzipped)")})))
+         :gzipped (.length tmp)})))

 (defn- minify-css-file [source target {:keys [linebreak] :or {linebreak -1}}]
   (with-open [rdr (reader source)
@@ -97,3 +96,18 @@
     (with-open [wrt (writer target)]
       (.append wrt (.toSource compiler)))
     (merge result (compression-details assets (file target)))))
+
+(defn minify
+  "assets are specified using a map where the key is the output file and the value is the asset paths, eg:
+   {\"site.min.css\" \"dev/resources/css\"
+    \"site.min.js\" \"dev/resources/js/site.js\"
+    \"vendor.min.js\" [\"dev/resources/vendor1/js\"
+                       \"dev/resources/vendor2/js\"]}"
+  [assets & [opts]]
+  (into {}
+   (for [[target path] assets]
+     [target
+      (cond
+        (.endsWith target ".js")  (minify-js path target opts)
+        (.endsWith target ".css") (minify-css path target opts)
+        :else (throw (ex-info "unrecognized target" target)))])))


get-json

get-json

--- src/airhead_cljs/core.cljs
+++ src/airhead_cljs/core.cljs
@@ -10,16 +10,20 @@
 (defn update-state! [k value]
   (swap! state assoc k value))

+(defn get-json [url handler params]
+  (GET url {:handler handler
+            :params params
+            :response-format :json}))
+
 (defn get-playlist []
-  (GET "/api/queue"
-       {:handler #(update-state! :playlist (% "items"))
-        :response-format :json}))
+  (get-json "/api/queue"
+            #(update-state! :playlist (% "items"))
+            {}))

 (defn get-tracks []
-  (GET "/api/tracks"
-       {:params {:q (@state :query)}
-        :handler #(update-state! :tracks (% "items"))
-        :response-format :json}))
+  (get-json "/api/tracks"
+            #(update-state! :tracks (% "items"))
+            {:q (@state :query)}))

 (defn enqueue-track [track]
   (let [uuid (track "uuid")]


move thread-unseen? from private defn- to let fn

--- src/braid/client/state.cljs
+++ src/braid/client/state.cljs
@@ -65,13 +65,6 @@
    (reaction (->> (get-in @state [:session :user-id])
                   (contains? (set (get-in @state [:groups group-id :admins])))))))

-(defn- thread-unseen?
-  [thread]
-  (> (->> (thread :messages)
-          (map :created-at)
-          (apply max))
-     (thread :last-open-at)))
-
 (defn get-open-thread-ids
   [state _]
   (reaction (get-in @state [:user :open-thread-ids])))
@@ -83,6 +76,10 @@
         tags (reaction (@state :tags))
         users (reaction (@state :users))
         thread-in-group? (fn [thread] (= group-id (thread :group-id)))
+        thread-unseen? (fn [thread] (> (->> (thread :messages)
+                                            (map :created-at)
+                                            (apply max))
+                                       (thread :last-open-at)))
         unseen-threads (reaction
                          (->>
                            (select-keys @threads @open-thread-ids)


Add :pre assertion to forma.reproject.latlon->modis that checks for valid modis-res (either 1000, 500, or 250).

--- src/clj/forma/reproject.clj
+++ src/clj/forma/reproject.clj
@@ -284,13 +284,15 @@

 (defn latlon->modis
   "Converts the supplied latitude and longitude into MODIS pixel
-  coordinates at the supplied resolution.
+  coordinates at the supplied resolution. The resolution is
+  expected to be either 1000, 500, or 250.

 Example usage:

     (latlon->modis \"1000\" 29.89583 -115.2290)
     ;=> [8 6 12 12]"
   [modis-res lat lon]
+  {:pre [(contains? pixels-at-res modis-res)]}
   (->> (latlon->sinu-xy lat lon)
        (apply sinu-xy->global-mags)
        (apply global-mags->modis modis-res)))


fix indentation

fix indentation

--- src/clj/game/core-rules.clj
+++ src/clj/game/core-rules.clj
@@ -147,8 +147,8 @@
                                      (trigger-event state side :prevented-damage type prevent))
                                  "will not prevent damage"))
                    (resolve-damage state side type (max 0 (- n (or prevent 0))) args)))
-                 {:priority 10}))
-           (resolve-damage state side type n args))))))
+               {:priority 10}))
+         (resolve-damage state side type n args))))))

 ;;; Tagging


Gallery plugin, update gallery table when new badges are added

--- src/clj/salava/badge/db.clj
+++ src/clj/salava/badge/db.clj
@@ -204,15 +204,35 @@
         (insert-badge! {:connection tx}))
     badge-id))

+
+(defn save-gallery! [tx badge]
+  (let [badge-content  (first (filter #(= (:language_code %) (:default_language_code badge)) (:content badge)))
+        issuer-content (first (filter #(= (:language_code %) (:default_language_code badge)) (:issuer  badge)))]
+
+    (jdbc/execute! tx ["INSERT IGNORE INTO gallery (badge_name, badge_image, issuer_name) VALUES (?,?,?)"
+                       (:name badge-content) (:image_file badge-content) (:name issuer-content)])
+    (some->
+      (jdbc/query tx ["SELECT id FROM gallery
+                      WHERE badge_name = ? AND badge_image = ? AND issuer_name = ?"
+                      (:name badge-content) (:image_file badge-content) (:name issuer-content)])
+      first :id)))
+
+
 (defn save-user-badge! [ctx user-badge]
   (jdbc/with-db-transaction  [tx (:connection (u/get-db ctx))]
     (let [now (u/now)
-          badge-id (->> (:badge user-badge) (save-images ctx) (save-badge! tx))
+          badge    (save-images ctx (:badge user-badge))
+          badge-id (save-badge! tx badge)
+          gallery-id (save-gallery! tx badge)
           user-badge-id (-> user-badge
                             (dissoc :badge)
                             (assoc :badge_id badge-id)
                             (insert-user-badge<! {:connection tx})
                             :generated_key)]
+
+      (when gallery-id
+        (jdbc/execute! tx ["UPDATE gallery SET badge_id = ? WHERE id = ?" badge-id gallery-id])
+        (jdbc/execute! tx ["UPDATE user_badge SET gallery_id = ? WHERE id = ?" gallery-id user-badge-id]))

       (when (seq (:evidence user-badge))
         (doseq [evidence (:evidence user-badge)]


added sum for cart, need doseq order submissions

--- src/clj/tsask/cart/crud.clj
+++ src/clj/tsask/cart/crud.clj
@@ -4,6 +4,7 @@
         tsask.pages.template-pg)
   (:require [clojure.java.jdbc :as j]
             [clojure.java.io :as io]
+            [tsask.order.crud :as order]
             [com.reasonr.scriptjure :as sj]
             [clojure.java.jdbc.sql :as sql]))

@@ -13,56 +14,36 @@
    :body ""})

 (defn index [session]
-  (let [orders (not-empty (:orders session))]
+  (let [orders (not-empty (:orders session))
+        sum (reduce + (for [order orders] (read-string (:payment_amt order))))]
     (binding [*js-css-files* orders-files
               *sub-nav* nil]
       (pages
         [:dl.txtcont
          [:dt [:div.ltit [:strong "Orders in Cart"]] [:div.clear]]
-         [:form {:method "post" :action "/cart/delete-selected"}
-          [:input {:value " Delete Selected " :type "submit" :onclick "updateCheckedIds()"}]
-          [:input {:value "0" :type "hidden" :id "selected_ids" :name "ids"}]
+         [:form {:method "post" :action "/cart/pay"}
           [:dd
            [:div.fc_con
             [:table.fcc_tab {:width "100%" :cellspacing "0" :cellpadding "0" :border "0"}
              [:tr
-              [:th#sf_admin_list_batch_actions [:input#sf_admin_list_batch_checkbox {:type "checkbox" :onclick "checkAll()"}]]
               [:th.sf_admin_text.sf_admin_list_th
                "Form Name"]
               [:th.sf_admin_list_th "pirce"]
               [:th.sf_admin_list_th "Actions"]]
              (for [order orders]
               [:tr
-               [:td [:input.sf_admin_batch_checkbox {:type "checkbox" :value (:id order) :name "ids[]"}]]
                [:td.sf_admin_text.sf_admin_list_td_form_name (:form_name order)]
                [:td.sf_admin_text.sf_admin_list_td_form_name (:payment_amt order)]
                [:td [:ul.sf_admin_td_actions
-                     [:li.sf_admin_action_view [:a "View"]]
-                     [:li.sf_admin_action_delete [:a "Delete"]]]]])
-             ]]]]
-         [:script {:type "text/javascript"}
-           (sj/js (fn checkAll []
-                 (var checkboxes (.getElementsByName document "ids[]"))
-                 (doseq [i checkboxes]
-                   (set! (.. (aget checkboxes i) checked)
-                         (.. (.getElementById document "sf_admin_list_batch_checkbox") checked))))
-               (fn updateCheckedIds []
-                 (var ids_ary [])
-                 (var j 0)
-                 (var checkboxes (.getElementsByName document "ids[]"))
-                 (var hidden (.getElementById document "selected_ids"))
-                 (doseq [i checkboxes]
-                   (if (.. (aget checkboxes i) checked)
-                     (.push ids_ary (.. (aget checkboxes i) value))))
-                 (var ids (.join ids_ary))
-                 (set! (.. hidden value) ids)))]]))))
+                     [:li.sf_admin_action_delete [:a "Remove"]]]]])
+             ]]]
+          [:span "total: "]
+          [:input {:value sum :type "text"}]
+          [:input {:value "Pay" :type "submit"}]]]))))

-(defn create [params]
-  (j/insert! SQLDB :sa_orders
-             {:order_content (:order_content params)
-              :form_name (:form_name params)
-              :created_at (java.util.Date.)
-              :updated_at (java.util.Date.)}))
+(defn create [params]
+  (let [order_record (order/create {:order_content (:order_content params)
+                                    :form_name (:form_name params)})]))

 (defn delete [id]
   (if (.exists (io/file (str "resources/public/files/Invoice-" id ".jpg")))
@@ -82,17 +63,3 @@
         [:div
           [:h2 (:form_name order)]
           [:div.requf_tit.form_control.form_head (:order_content order)]]))))
-
-(defn delete-selected [params]
-  (if (empty? (:ids params)) (redirect "/orders")
-    (let [ids_ary (clojure.string/split (:ids params) #",")]
-      (do
-        (doseq [id ids_ary]
-          (do
-            (if (.exists (io/file (str "resources/public/files/Invoice-" id ".jpg")))
-              (io/delete-file (str "resources/public/files/Invoice-" id ".jpg")))
-              (if (.exists (io/file (str "resources/public/files/Invoice-" id ".pdf")))
-                (io/delete-file (str "resources/public/files/Invoice-" id ".pdf")))
-            (j/delete! SQLDB :sa_orders (sql/where {:id id}))
-            (j/delete! SQLDB :CSV_report (sql/where {:o_id id}))))
-        (redirect "/orders")))))


Ignore undeclared keys

Ignore undeclared keys

--- src/cljam/io/bcf/writer.clj
+++ src/cljam/io/bcf/writer.clj
@@ -236,7 +236,7 @@
 (defn- parsed-variant->bcf-map
   "Converts a parsed variant map to BCF-style map."
   [[fmt-kw & indiv-kws :as kws] contigs filters formats info variant]
-  (let [fmts (map (juxt identity formats) (variant fmt-kw))
+  (let [fmts (keep (fn [f] (when-let [m (formats f)] [f m])) (variant fmt-kw))
         genotype (map
                   (fn [[k {:keys [idx type-kw]}]]
                     (->> indiv-kws
@@ -254,9 +254,9 @@
         (update :chr (comp :idx contigs))
         (update :filter (fn [f] (map (comp :idx filters) f)))
         (update :info (fn [i]
-                        (map (fn [[k v]]
-                               (let [{:keys [idx type-kw]} (info k)]
-                                 [idx type-kw v])) i))))))
+                        (keep (fn [[k v]]
+                                (when-let [{:keys [idx type-kw]} (info k)]
+                                  [idx type-kw v])) i))))))

 (defn- meta->map
   "Creates a map for searching meta-info with (f id)."


Make FILTER/INFO/FORMAT share their indices

--- src/cljam/io/bcf/writer.clj
+++ src/cljam/io/bcf/writer.clj
@@ -26,6 +26,8 @@
   [:fileformat :file-date :source :reference :contig :phasing :info :filter :format :alt :sample :pedigree])
 (def ^:private ^:const meta-info-prefix "##")
 (def ^:private ^:const header-prefix "#")
+(def ^:private ^:const default-pass-filter
+  {:id "PASS", :description "All filters passed"})

 (defn- stringify-meta
   "Converts meta-info rows to a sequence of strings."
@@ -55,6 +57,21 @@
     (lsb/write-int wtr hlen)
     (lsb/write-bytes wtr hdr-ba)))

+(defn- index-meta
+  [meta-info]
+  (let [m (update meta-info :filter
+                  (fn [xs]
+                    (let [{[p] true, f false} (group-by #(= "PASS" (:id %)) xs)]
+                      (cons (or p default-pass-filter) f))))
+        fif (->> [:filter :info :format]
+                 (map #(map vector (repeat %) (% m)))
+                 (apply concat)
+                 (map-indexed (fn [i [k v]] [k (assoc v :idx (str i))]))
+                 (reduce (fn [r [k v]] (update r k (fnil conj []) v)) {}))]
+    (-> meta-info
+        (update :contig #(map-indexed (fn [i c] (assoc c :idx (str i))) %))
+        (merge fif))))
+
 (defn ^BCFWriter writer
   "Returns an open cljam.bcf.BCFWriter of f.
    Meta-information lines and a header line will be written in this function.
@@ -66,19 +83,9 @@
        (WRITING-BCF))"
   [f meta-info header]
   (let [bos (bgzf/bgzf-output-stream f)
-        dos (DataOutputStream. bos)
-        indexed-meta (-> meta-info
-                         (update :contig (fn [xs] (map-indexed (fn [i m] (assoc m :idx (str i))) xs)))
-                         (update :filter (fn [xs]
-                                           (let [{pass true
-                                                  others false} (group-by #(= "PASS" (:id %)) (:filter meta-info))]
-                                             (concat (when pass (assoc (first pass) :idx "0"))
-                                                     (map-indexed (fn [i m] (assoc m :idx (str (inc i)))) others)))))
-                         (update :info (fn [xs] (map-indexed (fn [i m] (assoc m :idx (str i))) xs)))
-                         (update :format (fn [xs] (map-indexed (fn [i m] (assoc m :idx (str i))) xs))))
-        w (BCFWriter. (util/as-url f) indexed-meta header dos)]
-    (write-file-header w)
-    w))
+        dos (DataOutputStream. bos)]
+    (doto (BCFWriter. (util/as-url f) (index-meta meta-info) header dos)
+      (write-file-header))))

 (defn- value-type
   "Returns an integer indicating type of input value."


Trigger new UI events with :on-mouse-enter and :on-mouse-leave

--- src/cljs/zetawar/views.cljs
+++ src/cljs/zetawar/views.cljs
@@ -113,7 +113,9 @@
 (defn tile [{:as view-ctx :keys [dispatch]} terrain]
   (let [{:keys [terrain/q terrain/r]} terrain]
     ^{:key (str q "," r)}
-    [:g {:on-click #(dispatch [::events.ui/select-hex q r])}
+    [:g {:on-click #(dispatch [::events.ui/select-hex q r])
+         :on-mouse-enter #(dispatch [::events.ui/hover-hex-enter q r])
+         :on-mouse-leave #(dispatch [::events.ui/hover-hex-leave q r])}
      [terrain-tile view-ctx terrain q r]
      [tile-border view-ctx q r]
      [board-unit view-ctx q r]


syntax tweaks based on PR feedback

syntax tweaks based on PR feedback

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_configs/method_config_editor.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/method_configs/method_config_editor.cljs
@@ -115,11 +115,10 @@
                                 :onClick #(stop-editing state)}])]))])

 (defn- validation-status [invalid?]
-  (if invalid?
+  (when invalid?
     (icons/font-icon {:style {:paddingLeft "0.5em" :padding "1em 0.7em"
                               :color (:exception-red style/colors)}}
-      :x)
-    ))
+      :x)))

 (defn- input-output-list [config value-type invalid-values editing?]
   (create-section


Pedantic indentation fix

Pedantic indentation fix

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -678,7 +678,7 @@
           (u/fail "assortment task :sortby option value should implement IFn\n")
           :else
           (let [assortment-paths (partial grouped-paths "assortment")]
-              (render-pre-wrap assortment-paths options :io.perun/assortment)))))
+            (render-pre-wrap assortment-paths options :io.perun/assortment)))))

 (deftask inject-scripts
   "Inject JavaScript scripts into html files.


'asciidoctorj' works correctly only until version 1.5.8.1...

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -504,7 +504,7 @@

 (def ^:private ^:deps asciidoctor-deps
   '[[org.clojure/tools.namespace "0.3.0-alpha4"]
-    [org.asciidoctor/asciidoctorj "1.5.4"]])
+    [org.asciidoctor/asciidoctorj "1.5.8.1"]])

 (def ^:private +asciidoctor-defaults+
   {:out-dir    "public"


Pass task meta for `collection` through to `render-pre-wrap`

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -558,14 +558,17 @@
   (let [options (merge +collection-defaults+
                        (dissoc *opts* :page)
                        (if-let [p (:page *opts*)]
-                         {:grouper #(-> {p {:entries %}})}
+                         {:grouper #(-> {p {:entries %
+                                            :group-meta (:meta *opts*)}})}
                          (if-let [gb (:groupby *opts*)]
                            {:grouper #(->> %
                                            (group-by gb)
                                            (map (fn [[page entries]]
-                                                  [page {:entries entries}]))
+                                                  [page {:entries entries
+                                                         :group-meta (:meta *opts*)}]))
                                            (into {}))}
-                           {:grouper #(-> {"index.html" {:entries %}})})))]
+                           {:grouper #(-> {"index.html" {:entries %
+                                                         :group-meta (:meta *opts*)}})})))]
     (cond (not (fn? (:comparator options)))
           (u/fail "collection task :comparator option should implement Fn\n")
           (not (ifn? (:filterer options)))


Fix type.

Fix type.

--- src/onyx/scheduling/common_job_scheduler.clj
+++ src/onyx/scheduling/common_job_scheduler.clj
@@ -83,7 +83,7 @@
 (defn choose-acker-candidates [replica peers]
   (remove
    (fn [p]
-     (let [{:keys [job task]} (common/peer->allocated-job replica p)]
+     (let [{:keys [job task]} (common/peer->allocated-job (:allocations replica) p)]
        (exempt-from-acker? replica job task)))
    peers))

@@ -93,7 +93,7 @@
    (fn [result job]
      (let [peers (apply concat (vals (get-in result [:allocations job])))
            pct (get-in result [:acker-percentage job])
-           n (int (Math/ceil (* (* 0.01 pct) peers)))
+           n (int (Math/ceil (* (* 0.01 pct) (count peers))))
            candidates (choose-acker-candidates result peers)]
        (assoc-in result [:ackers job] (take n candidates))))
    replica


Re-write to-vhdl dispatch yet again

Re-write to-vhdl dispatch yet again

This time we just destroy all evidence of namespacing before dispatching.

--- src/computer_build/vhdl.clj
+++ src/computer_build/vhdl.clj
@@ -1,12 +1,6 @@
 (ns computer-build.vhdl
-  (:use clojure.contrib.str-utils)
-  (:require [clojure.core :as core]))
+  (:use clojure.contrib.str-utils))

-(def entity)
-(def process)
-(def port)
-(def case)
-(def assign)

 (defn indented-lines [strings] (map (partial str "  ") strings))

@@ -27,34 +21,35 @@

 (defn quoted-str [string] (str \" string \"))

-(defmulti to-vhdl first)
+(defmulti to-vhdl #(-> % first name keyword))
 (defmethod to-vhdl :default [arg] (str "###UNIMPLEMENTED: " (first arg) "###"))
-(defmethod to-vhdl 'computer-build.vhdl/entity [[type name ports & architecture]]
+(defmethod to-vhdl :entity [[type name ports defs & architecture]]
   (apply str (interpose "\n" (indent-lines
   (list
     (spaces "entity" name "is")
     "port("
-    (commaify (map to-vhdl (map (partial cons 'computer-build.vhdl/port) ports)))
+    (commaify (map to-vhdl (map (partial cons :port) ports)))
     ");"
     (str "end " name ";")

     (str "architecture arch_" name " of " name " is")
+    (map to-vhdl defs)
     "begin"
     (map to-vhdl architecture)
     (str "end arch_" name ";"))))))

 ; does not generate lines like block-level methods do
-(defmethod to-vhdl 'computer-build.vhdl/port [[type id direction type]]
+(defmethod to-vhdl :port [[type id direction type]]
   (str (keyword-to-str id) ": " (keyword-to-str direction) " " type))

-(defmethod to-vhdl 'computer-build.vhdl/process [[type ports & definition]]
+(defmethod to-vhdl :process [[type ports & definition]]
   (list
     (str "process(" (str-join "," (map keyword-to-str ports)) ")")
     "begin"
     (map to-vhdl definition)
     "end process;"))

-(defmethod to-vhdl 'computer-build.vhdl/case [[type target & cases]]
+(defmethod to-vhdl :case [[type target & cases]]
   (list
     (spaces "case" (keyword-to-str target) "is")
     (map #(str (spaces "when" (quoted-str (first %)) "=>" (to-vhdl (second %))) \;)
@@ -62,7 +57,7 @@
     "end case;"))

 ; does not generate lines like block-level methods do
-(defmethod to-vhdl 'computer-build.vhdl/assign [[type target expression]]
+(defmethod to-vhdl :<= [[type target expression]]
   (spaces (keyword-to-str target) "<=" (keyword-to-str expression)))

 (defn generate-vhdl [& entities]


add clean and compile commands

add clean and compile commands

--- src/tamaki_core/server.clj
+++ src/tamaki_core/server.clj
@@ -14,12 +14,16 @@
       (require plugin)
       ((-> (symbol (str plugin "/" 'load-plugin)) resolve var-get)))))

-(defn init []
+(defn tcompile []
   (tfile/clean-dest)
   (cpy/copy)
   (page/compile-mds)
   (page/gen-paginate-page (-> (read-config) :post-dir))
   (page/compile-postmds (-> (read-config) :post-dir)))
+
+(defn init [] (tcompile))
+
+

 (defroutes handler
            (GET ":prefix{.*}/" [prefix] (redirect (str prefix "/index.html")))


implementing hsb->rgb conversion

implementing hsb->rgb conversion

--- src/thi/ng/luxor/color.clj
+++ src/thi/ng/luxor/color.clj
@@ -1,8 +1,21 @@
-(ns thi.ng.luxor.color)
+(ns thi.ng.luxor.color
+  (:import
+   [java.awt Color]))

-;; TODO
+(defn rgbvec
+  [rgb]
+  (let [i8 (/ 1.0 255)]
+    [(* i8 (bit-and (bit-shift-right rgb 16) 0xff))
+     (* i8 (bit-and (bit-shift-right rgb 8) 0xff))
+     (* i8 (bit-and rgb 0xff))]))
+
 (defn hsb->rgb
-  [[h s b]] [h s b])
+  [[h s b]]
+  (let [rgb (bit-and (Color/HSBtoRGB (float h) (float s) (float b)) 0xffffff)
+        i8 (/ 1.0 255)]
+    [(* i8 (bit-and (bit-shift-right rgb 16) 0xff))
+     (* i8 (bit-and (bit-shift-right rgb 8) 0xff))
+     (* i8 (bit-and rgb 0xff))]))

 (defn scaled-absorption-at-depth
   [x scale d]


Fix layouts.core/Parse->string by calling conf/get.

--- src/incise/layouts/core.clj
+++ src/incise/layouts/core.clj
@@ -10,12 +10,12 @@
   [layout-with-name]
   (contains? @layouts (name layout-with-name)))

-(defn get [layout-name]
-  (@layouts (name layout-name)))
+(defn get [layout-name & more]
+  (apply @layouts (name layout-name) more))

 (defn Parse->string
   [^incise.parsers.core.Parse parse-data]
-  ((get (:layout parse-data)) conf/get parse-data))
+  ((get (:layout parse-data)) (conf/get) parse-data))

 (defn register
   "Register a layout function to a shortname"


Do not show the genre in the whole catalogs for ludo and hörfilm

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -15,6 +15,8 @@
            [org.apache.fop.apps FopFactory MimeConstants]))

 (def ^:private region-body-margin-top 15)
+
+(def ^:dynamic *show-genre* true)

 (defn- to-mm [n]
   (format "%smm" n))
@@ -240,7 +242,8 @@
            produced-commercially? library-signature product-number price] :as item}]
   (list-item
    (entry-heading-sexp item)
-   (block (wrap genre-text "Genre: "))
+   (when *show-genre*
+     (block (wrap genre-text "Genre: ")))
    (block (wrap description))
    (block (wrap duration "" " Min., " false) (narrators-sexp narrators))
    (block producer-brief (if produced-commercially? ", Hörbuch aus dem Handel" "") ".")
@@ -253,7 +256,8 @@
            library-signature product-number price] :as item}]
   (list-item
    (entry-heading-sexp item)
-   (block (wrap genre-text "Genre: "))
+   (when *show-genre*
+     (block (wrap genre-text "Genre: ")))
    (block (wrap description))
    (block (wrap producer-brief "" (if rucksackbuch?
                                     (str ", Rucksackbuch Nr. " rucksackbuch-number)
@@ -265,7 +269,8 @@
   [{:keys [genre-text description library-signature volumes product-number price] :as item}]
   (list-item
    (entry-heading-sexp item)
-   (block (wrap genre-text "Genre: "))
+   (when *show-genre*
+     (block (wrap genre-text "Genre: ")))
    (block (wrap description))
    (when library-signature
      (block {:keep-with-previous "always"}
@@ -277,7 +282,8 @@
   [{:keys [genre-text description library-signature] :as item}]
   (list-item
    (entry-heading-sexp item)
-   (block (wrap genre-text "Genre: "))
+   (when *show-genre*
+     (block (wrap genre-text "Genre: ")))
    (block (wrap description))
    (ausleihe library-signature)))

@@ -288,7 +294,8 @@
    (entry-heading-sexp item)
    (block (wrap directed-by "Regie: " "") (wrap actors " Schauspieler: " ""))
    (block (wrap movie_country))
-   (block (wrap genre-text))
+   (when *show-genre*
+     (block (wrap genre-text)))
    (block (wrap description))
    (block (wrap producer))
    (ausleihe library-signature)))
@@ -299,7 +306,8 @@
   (list-item
    (entry-heading-sexp item)
    (block (wrap source-publisher))
-   (block (wrap genre-text))
+   (when *show-genre*
+     (block (wrap genre-text)))
    (block (wrap description))
    (block (wrap game-description))
    (ausleihe library-signature)))
@@ -317,7 +325,8 @@
   [{:keys [genre-text description producer-brief library-signature product-number price] :as item}]
   (list-item
    (entry-heading-sexp item)
-   (block (wrap genre-text "Genre: "))
+   (when *show-genre*
+     (block (wrap genre-text "Genre: ")))
    (block (wrap description))
    (block (wrap producer-brief))
    (ausleihe-multi library-signature)
@@ -467,6 +476,20 @@
   [tree]
   (apply hash-map (tree-walk tree [] [])))

+(defn- realize-lazy-seqs
+  "Realize all lazy sequences within `tree` to make sure the
+  evaluation is done within a `binding` scope"
+  [tree]
+  ;; FIXME: there is a subtle bug to do with bindings and lazy
+  ;; sequences. When returning a lazy seq the actual realization
+  ;; might happen outside the `binding` scope and hence might get
+  ;; the wrong value. So as a workaround we make sure
+  ;; the sequence is fully realized.
+  ;; See also http://stackoverflow.com/a/32290387 and
+  ;; http://cemerick.com/2009/11/03/be-mindful-of-clojures-binding/
+  ;; Maybe the binding solution isn't the bees knees after all.
+  (walk/postwalk identity tree))
+
 (defmulti document-sexp (fn [items fmt editorial recommendations options] fmt))

 (defmethod document-sexp :grossdruck
@@ -491,14 +514,7 @@
                                 :recommendation recommendations))]
         [:fo:flow {:flow-name "xsl-region-body"}
          (toc subitems [fmt] 2 nil :heading? true)
-         ;; FIXME: there is a subtle bug to do with bindings and lazy
-         ;; sequences. Since we return a lazy seq here the mapcat
-         ;; might be realized outside the binding scope and might get
-         ;; the wrong *stylesheet*. So as a workaround we make sure
-         ;; the sequence is fully realized with `doall` (see also
-         ;; http://cemerick.com/2009/11/03/be-mindful-of-clojures-binding/).
-         ;; Maybe the binding solution isn't the bees knees after all.
-         (doall
+         (realize-lazy-seqs
           (mapcat #(genre-sexp (get subitems %) fmt % 1) (keys subitems)))])]]))

 (defmethod document-sexp :hörbuch
@@ -584,7 +600,9 @@
        (block {:break-before "odd-page"}) ;; toc should start on recto
        (toc subitems [fmt] 1 nil :heading? true)
        (block {:break-before "odd-page"}) ;; the very first format should start on recto
-       (mapcat #(genre-sexp (get subitems %) fmt % 1) (keys subitems))])]])
+       (binding [*show-genre* false]
+         (realize-lazy-seqs
+          (mapcat #(genre-sexp (get subitems %) fmt % 1) (keys subitems))))])]])

 (defmethod document-sexp :ludo
   [items fmt _ _ {:keys [description date]
@@ -608,7 +626,9 @@
        (block {:break-before "odd-page"}) ;; toc should start on recto
        (toc subitems [fmt] 1 nil :heading? true)
        (block {:break-before "odd-page"}) ;; the very first format should start on recto
-       (mapcat #(genre-sexp (get subitems %) fmt % 1) (keys subitems))])]])
+       (binding [*show-genre* false]
+         (realize-lazy-seqs
+          (mapcat #(genre-sexp (get subitems %) fmt % 1) (keys subitems))))])]])

 (defmethod document-sexp :taktilesbuch
   [items fmt _ _ {:keys [description date]


Display the app name in the html's head title

--- src/instapapure/servlet.clj
+++ src/instapapure/servlet.clj
@@ -12,6 +12,7 @@
 ;; ************* ;;

 (def author {:name "Jeff Mesnil" :address "http://jmesnil.net/"})
+(def app-name "Instapapure")

 ;; ********* ;;
 ;; Web Layer ;;
@@ -58,7 +59,7 @@
   "HTML layout for all pages"
   (html
     [:head
-      [:title title]
+      [:title (str app-name " - " title)]
       (include-js "public/j/jquery.js"
                   "public/j/instapapure.js")
       (include-css "public/s/instapapure.css")


Improve x axis chart slicing

Improve x axis chart slicing

--- maps/src/maps/core.cljs
+++ maps/src/maps/core.cljs
@@ -4,8 +4,6 @@
 (enable-console-print!)

 (defonce points (reagent/atom []))
-
-(defonce ticks (reagent/atom 0))

 (defonce x-min (reagent/atom 0))

@@ -19,7 +17,7 @@

 (defonce height (reagent/atom 600))

-(defonce speed (reagent/atom 1700))
+(defonce pause (reagent/atom 1100))

 (def options
   {:chart       {:type "line"}
@@ -72,30 +70,48 @@
                          :component-did-update #(series-updated %1)}))

 (defn slider [id v min max]
-  [:input {:id        id
-           :type      "range"
-           :min       min
-           :max       max
-           :value     @v
-           :on-change #(reset! v (-> % .-target .-value))}])
+  [:span [:input {:id        id
+                  :type      "range"
+                  :min       min
+                  :max       max
+                  :value     @v
+                  :on-change #(reset! v (-> % .-target .-value))}]
+   @v])
+
+(defn bound-sliders
+  [lower-id lower-v lower-min upper-id upper-v upper-max]
+  [:div
+   [:div
+    [:label {:for lower-id} (str lower-id " value")]
+    [:input {:id        lower-id
+             :type      "range"
+             :min       lower-min
+             :max       (dec (int @upper-v))
+             :value     @lower-v
+             :on-change #(reset! lower-v (-> % .-target .-value))}]
+    @lower-v]
+   [:div
+    [:label {:for upper-id} (str upper-id " value")]
+    [:input {:id        upper-id
+             :type      "range"
+             :min       (inc (int @lower-v))
+             :max       upper-max
+             :value     @upper-v
+             :on-change #(reset! upper-v (-> % .-target .-value))}]
+    @upper-v]])

 (defn logistic-map [x]
   (* 3.9341 x (- 1 x)))

-(defn evolution! [seed ps sp]
+(defn evolution! [seed ps interval]
   (letfn [(evol [x y]
             (do (swap! ps conj [x y])
-                (js/setTimeout #(evol (inc x) (logistic-map y)) (- 2200 @sp))))]
+                (js/setTimeout #(evol (inc x) (logistic-map y)) @interval)))]
     (evol 0 seed)))

 (defn page []
   [:div
-   [:div
-    [:label {:for "x-min"} "x-axis min value"]
-    [slider "x-min" x-min -500 0]]
-   [:div
-    [:label {:for "x-max"} "x-axis max value"]
-    [slider "x-max" x-max 1 1000]]
+   [bound-sliders "x-min" x-min -500 "x-max" x-max 2000]
    [:div
     [:label {:for "y-min"} "y-axis min value"]
     [slider "y-min" y-min -500 0]]
@@ -109,11 +125,11 @@
     [:label {:for "height"} "height"]
     [slider "y-max" height 400 1080]]
    [:div
-    [:label {:for "speed"} "speed"]
-    [slider "speed" speed 200 2000]]
+    [:label {:for "pause"} "pause"]
+    [slider "pause" pause 200 2000]]
    [chart width height points]])

 (reagent/render-component [page]
                           (. js/document (getElementById "app")))

-(defonce foo (evolution! 0.851 points, speed))+(defonce start! (evolution! 0.851 points pause))


[#148] Repl port must be an integer

[#148] Repl port must be an integer

--- api/src/clojure/org/akvo/flow_api/main.clj
+++ api/src/clojure/org/akvo/flow_api/main.clj
@@ -29,5 +29,5 @@
                       (component/start))]
     (add-shutdown-hook ::stop-system #(component/stop system))
     (println "Started HTTP server on port" (-> system :http :port))
-    (let [repl-server (repl/start-server :port (:nrepl-port env 0))]
+    (let [repl-server (repl/start-server :port (Integer/parseInt (:repl-port env "0")))]
       (println "REPL started on port" (:port repl-server)))))


Couple of formatting fixes

Couple of formatting fixes

--- src/ultimate_ttt/core.cljs
+++ src/ultimate_ttt/core.cljs
@@ -15,8 +15,7 @@

 (println "Ready.")

-(fw/start {
-           :on-jsload (fn [] (print "reloaded"))})
+(fw/start {:on-jsload (fn [] (print "reloaded"))})

 (defonce initial-state {:main-board (board-helpers/init-board)
                         :current-owner 1
@@ -32,7 +31,7 @@
 (defn game-progress []
   (let [main-board (subscribe [:main-board])
         current-owner (subscribe [:current-owner])]
-    (fn[]
+    (fn []
       (let [winner (referee/find-winner @main-board)
             current-player (view-helpers/owner->player @current-owner)]
         [:div


prepare not needed, introducing :result activated by :meta true by default

--- src/clj/ephemeris/core.clj
+++ src/clj/ephemeris/core.clj
@@ -10,14 +10,7 @@
                      :TrueNode :Uranus :Neptune :Pluto]
             :angles [:Asc :MC]
             :houses "O"
-            :meta false})
-
-(defn- prepare
-  ([] defaults)
-  ([stuff]
-   (let [want (merge defaults stuff)
-         jd (utc-to-jd (:utc want))]
-    (assoc want :jd jd))))
+            :meta true})

 (defn- geo? [geo]
   (if (and
@@ -67,11 +60,19 @@
     {:houses (zipmap (range 1 13) (rest data))}
     {}))

+;; expects an atom map, key, and value to assoc
+;; returns the value for further use
+(defn- result [a k v]
+  (do (swap! a assoc k v)
+   v))
+
 (defn calc
   ([] (calc {}))
   ([stuff]
-   (let [sw (SwissEph.)
-         want (prepare stuff)
+   (let [want (merge defaults stuff)
+         re (atom {})
+         sw (SwissEph.)
+         jd (result re :jd (utc-to-jd (:utc want)))
          flag (. SweConst SEFLG_SPEED)]
     (merge
       {:points
@@ -81,7 +82,7 @@
                   res (double-array 6)
                   err (StringBuffer.)
                   rc (.swe_calc_ut sw
-                                   (:jd want)
+                                   jd
                                    what
                                    flag
                                    res
@@ -95,7 +96,7 @@
         (let [cusps (double-array 13)
               ascmc (double-array 10)
               rc (.swe_houses sw
-                              (:jd want)
+                              jd
                               0 ;; TODO: flags?
                               (:lat (:geo want))
                               (:lon (:geo want))
@@ -105,4 +106,5 @@
           (merge
             (nice-angles ascmc (:angles want))
             (nice-houses cusps (:houses want)))))
-      (if (:meta want) {:wanted (dissoc want :meta)} {})))))
+      (if (:meta want) {:wanted (dissoc want :meta)
+                        :result @re})))))


Improve CLI with jOptSimple.

Improve CLI with jOptSimple.

--- src/clj/fleetdb/server.clj
+++ src/clj/fleetdb/server.clj
@@ -2,13 +2,13 @@
   (:use     (fleetdb util))
   (:require (fleetdb [embedded :as embedded] [io :as io]
                      [thread-pool :as thread-pool])
-            (clj-stacktrace [repl :as stacktrace])
-            (clojure.contrib [command-line :as cli]))
+            (clj-stacktrace [repl :as stacktrace]))
   (:import  (java.net ServerSocket Socket InetAddress)
             (java.io PushbackReader BufferedReader InputStreamReader
                      PrintWriter    BufferedWriter OutputStreamWriter
                      DataInputStream  BufferedInputStream
-                     DataOutputStream BufferedOutputStream)))
+                     DataOutputStream BufferedOutputStream)
+            (joptsimple OptionParser OptionSet OptionException)))

 (defn- embedded-query [dba q]
   (let [[q-type q-opts] q]
@@ -72,8 +72,8 @@
 (def- protocol-handlers
   {:binary binary-handler :text text-handler})

-(defn run [db-path ephemeral port interface threads protocol]
-  (let [inet          (InetAddress/getByName interface)
+(defn run [db-path ephemeral port addr threads protocol]
+  (let [inet          (InetAddress/getByName addr)
         server-socket (ServerSocket. port 10000 inet)
         pool          (thread-pool/init threads)
         handler       (protocol-handlers protocol)
@@ -91,12 +91,34 @@
         (thread-pool/submit pool #(handler dba socket)))
       (recur))))

-(cli/with-command-line *command-line-args*
-  "FleetDB Server"
-  [[f  "Full path to database log."]
-   [e? "Ephemeral: do not log database changes to disk." false]
-   [p  "TCP port number to listen on." "3400"]
-   [a  "Local address to listen on." "127.0.0.1"]
-   [t  "Maximum number of worker threads." "100"]
-   [i  "Client/server protocol: one of binary or text." "binary"]]
-  (run f e? (Integer/decode p) a (Integer/decode t) (keyword i)))
+(defn- print-help []
+  (println "FleetDB Server                                                             ")
+  (println "-f <path>   Path to database log file                                      ")
+  (println "-e          Ephemeral: do not log changes to disk                          ")
+  (println "-p <port>   TCP port to listen on (default: 3400)                          ")
+  (println "-a <addr>   Local address to listen on (default: 127.0.0.1)                ")
+  (println "-t <num>    Maximum number of worker threads (default: 100)                ")
+  (println "-i <name>   Client/server protocol: one of {binary, text} (default: binary)")
+  (println "-h          Print this help and exit.                                      "))
+
+(defn- parse-int [s]
+  (and s (Integer/decode s)))
+
+(let [opt-parser (OptionParser. "f:ep:a:t:i:h")
+      arg-array  (into-array String *command-line-args*)
+      opt-set    (.parse opt-parser arg-array)]
+  (cond
+    (not-any? #(.has opt-set #^String %) ["f" "e" "p" "a" "t" "i" "h"])
+      (print-help)
+    (.has opt-set "h")
+      (print-help)
+    (not (or (.has opt-set "f") (.has opt-set "e")))
+      (println "You must specify either -e or -f <path>. Use -h for help.")
+    :else
+      (let [db-path (.valueOf opt-set "f")
+            ephemeral (.has opt-set "e")
+            port      (or (parse-int (.valueOf opt-set "p")) 3400)
+            addr      (or (.valueOf opt-set "a") "127.0.0.1")
+            threads   (or (parse-int (.valueOf opt-set "t")) 100)
+            protocol  (or (keyword (or (.valueOf opt-set "i") "binary")))]
+        (run db-path ephemeral port addr threads protocol))))


Document authentication option -x in CLI help.

--- src/clj/fleetdb/server.clj
+++ src/clj/fleetdb/server.clj
@@ -120,6 +120,7 @@
   (println "-p <port>   TCP port to listen on (default: 3400)          ")
   (println "-a <addr>   Local address to listen on (default: 127.0.0.1)")
   (println "-t <num>    Maximum number of worker threads (default: 100)")
+  (println "-x <pass>   Require clients to authenticate                ")
   (println "-v          Print the FleetDB version and exit             ")
   (println "-h          Print this help and exit.                      "))


add to existing counters if Draco gets derezzed and rerezzed

--- src/clj/game/cards-ice.clj
+++ src/clj/game/cards-ice.clj
@@ -379,7 +379,7 @@
    {:prompt "How many power counters?"
     :choices :credit
     :msg (msg "add " target " power counters")
-    :effect (effect (set-prop card :counter target)
+    :effect (effect (add-prop card :counter target)
                     (update-ice-strength card))
     :strength-bonus (req (or (:counter card) 0))
     :abilities [(trace-ability 2 {:label "Give the Runner 1 tag and end the run"