Fix up help

Fix up help

--- src/backloggery/core.clj
+++ src/backloggery/core.clj
@@ -15,13 +15,14 @@

 (def help
   {"commands"
-   "Command    Desc
+   "    Command    Desc
     -------    ----
     add        Add games to Backloggery, or write game list to a file.
-    edit       Edit game entries already on Backloggery, or delete game entries."
+    edit       Edit game entries already on Backloggery, or delete game entries.
+    help       Display help. Alias for '--help usage'."

    "formats"
-   "This tool can read and write a variety of sources. The --from and --to
+   "    This tool can read and write a variety of sources. The --from and --to
     options control what formats it reads and write; the --input and --output
     options control what file it writes to or reads from, for formats that are
     stored in files.
@@ -62,8 +63,8 @@
    })

 (defn -main
-  [& args]
-  (let [[opts args _] (getopts args)
+  [& argv]
+  (let [[opts args _] (getopts argv)
         command (if (:help opts) "help" (first args))]
     (binding [*opts* opts]
       (if-let [command-fn (commands command)]


beginning to get joins coming out now :-)

--- dada2-core/src/test/clojure/org/dada2/test_join_model.clj
+++ dada2-core/src/test/clojure/org/dada2/test_join_model.clj
@@ -21,10 +21,17 @@
 ;;--------------------------------------------------------------------------------
 ;; impl

-(defn- lhs-upsert [old-indeces i ks v]
-  (let [old-index (nth old-indeces i)
-	new-index (mapv (fn [index key] (group index (key v) v)) old-index ks)
-	new-indeces (assoc old-indeces i new-index)]
+;; TODO: return a pair - first is notification fn, second is new-indeces - use swap*! to apply
+
+(defn- derive-joins [v rhs-indeces ks join-fn]
+  (map
+   (fn [args] (apply join-fn v args))
+   (permute [[]] (map (fn [index key] (index (key v))) rhs-indeces ks))))
+
+(defn- lhs-upsert [[old-index & rhs-indeces] ks v join-fn]
+  (let [new-index (mapv (fn [index key] (group index (key v) v)) old-index ks)
+	new-indeces (apply vector new-index rhs-indeces)]
+    (println "JOINS: " (derive-joins v rhs-indeces ks)		;TODO: what should we do with this ?
     new-indeces))

 ;;; TODO
@@ -32,15 +39,17 @@
 (defn- lhs-upserts [old-indeces i k vs])
 (defn- lhs-deletes [old-indeces i k vs])

-(defn- lhs-view [indeces i keys]
+(defn- lhs-view [indeces i keys join-fn]
   (reify
    View
    ;; singleton changes
-   (on-upsert [_ upsertion] (swap! indeces lhs-upsert i keys upsertion) nil)
+   (on-upsert [_ upsertion] (swap! indeces lhs-upsert keys upsertion join-fn) nil)
    (on-delete [_ deletion]  (swap! indeces lhs-delete i keys deletion) nil)
    ;; batch changes
    (on-upserts [_ upsertions] (swap! indeces lhs-upserts i keys upsertions) nil)
    (on-deletes [_ deletions]  (swap! indeces lhs-deletes i keys deletions) nil)))
+
+;; TODO: return a pair - first is notification fn, second is new-indeces - use swap*! to apply

 (defn- rhs-upsert [old-indeces i k v]
   (let [old-index (nth old-indeces i)
@@ -69,11 +78,11 @@

 ;;; attach lhs to all rhses such that any change to an rhs initiates an
 ;;; attempt to [re]join it to the lhs and vice versa.
-(defn- join-views [[lhs-model & lhs-keys] & rhses]
+(defn- join-views [join-fn [lhs-model & lhs-keys] & rhses]
   (let [indeces (atom [(apply vector (repeat (count rhses) {}))])]
     ;; view lhs
     (log2 :info (str " lhs: " lhs-model ", " lhs-keys))
-    (attach lhs-model (lhs-view indeces 0 lhs-keys))
+    (attach lhs-model (lhs-view indeces 0 lhs-keys join-fn))
     ;; view rhses
     (doseq [[model key] rhses]
 	(let [i (count @indeces)]   ; figure out offset for this index
@@ -93,7 +102,7 @@
   )

 (defn join-model [name joins join-fn]
-  (let [state (apply join-views joins)]
+  (let [state (apply join-views join-fn joins)]
     (->JoinModel name state (atom []))))

 ;;--------------------------------------------------------------------------------
@@ -125,6 +134,29 @@
   (is (= (->ACE :a 0 :c :e)
 	 (join-ace (->A :a 0 :b :d)(->B :b 0 :c)(->D :d 0 :e)))))

+;;; calculate all permutations for a given list of sets...
+;;; e.g.
+;;; (permute [[]] [[:a1 :a2][:b1 :b2 :b3][:c1]]) ->
+;;; ([:a1 :b1 :c1] [:a1 :b2 :c1] [:a1 :b3 :c1] [:a2 :b1 :c1] [:a2 :b2 :c1] [:a2 :b3 :c1])
+
+;;; TODO: should use recurse
+(defn- permute [state [head & tail]]
+  (if (empty? head)
+    state
+    (permute (mapcat (fn [i] (map (fn [j] (conj i j)) head)) state) tail)))
+
+;;; consider outer joins
+;; (defn- permute2 [inner state [head & tail]]
+;;   (if (empty? tail)
+;;     state
+;;     (if-let [head (if (and (empty? head) inner) nil [nil])]
+;; 	(permute (mapcat (fn [i] (map (fn [j] (conj i j)) head)) state) tail))))
+
+(deftest test-permute
+  (is (=
+       [[:a1 :b1 :c1] [:a1 :b2 :c1] [:a1 :b3 :c1] [:a2 :b1 :c1] [:a2 :b2 :c1] [:a2 :b3 :c1]]
+       (permute [[]] [[:a1 :a2][:b1 :b2 :b3][:c1]]))))
+
 (deftest test-join-model
   (let [as (versioned-optimistic-map-model (str :as) :name :version >)
 	bs (versioned-optimistic-map-model (str :bs) :name :version >)


use (hash) again

use (hash) again

--- src/bzzz/index_store.clj
+++ src/bzzz/index_store.clj
@@ -114,7 +114,6 @@
                   { index {:done true
                            :took-internal (time-took t0)
                            :attempt-to-write (count documents)}}))))
-
 (defn store [input]
   (let [{:keys [index documents analyzer
                 facets shard alias-set alias-del
@@ -135,8 +134,8 @@
                                                  (filter (fn [doc]
                                                            ;; FIXME: use consistent hashing
                                                            (let [hashCode (if-let [id (:id doc)]
-                                                                            (.hashCode id)
-                                                                            (.hashCode doc))]
+                                                                            (hash id)
+                                                                            (hash doc))]
                                                              (= n (mod hashCode number-of-shards))))
                                                          documents)
                                                  facets


Untabify.

Untabify.

--- src/cake/tasks/check.clj
+++ src/cake/tasks/check.clj
@@ -1,20 +1,20 @@
 (ns cake.tasks.check
     "Check syntax and warn on reflection."
   (:use cake
-	cake.core
-	[cake.file :only [file rmdir]]
-	[cake.tasks.compile :only [source-dir]]))
+        cake.core
+        [cake.file :only [file rmdir]]
+        [cake.tasks.compile :only [source-dir]]))

 (deftask check
   (let [source-path (source-dir)]
     (bake (:use [bake.core :only [log print-stacktrace]]
-		[bake.find-namespaces :only [find-clojure-sources-in-dir
-					     read-file-ns-decl]])
-	  [source-path source-path] ;; Just copy the var over to bake.
-	  (binding [*warn-on-reflection* true]
-	    (doseq [src-file (find-clojure-sources-in-dir source-path)]
-	      (log "Compiling namespace " (second (read-file-ns-decl src-file)))
-	      (try
-		(load-file (.getPath src-file))
-		(catch ExceptionInInitializerError e
-		  (print-stacktrace e))))))))+                [bake.find-namespaces :only [find-clojure-sources-in-dir
+                                             read-file-ns-decl]])
+          [source-path source-path] ;; Just copy the var over to bake.
+          (binding [*warn-on-reflection* true]
+            (doseq [src-file (find-clojure-sources-in-dir source-path)]
+              (log "Compiling namespace " (second (read-file-ns-decl src-file)))
+              (try
+                (load-file (.getPath src-file))
+                (catch ExceptionInInitializerError e
+                  (print-stacktrace e))))))))


adding ssh-key and ostemplates

adding ssh-key and ostemplates

--- src/celestial/config.clj
+++ src/celestial/config.clj
@@ -100,6 +100,8 @@
 (def ^{:doc "digital ocean section validation"} digital-v
   {:digital-ocean {
      :token #{:required :String}
+     :ssh-key #{:required :String}
+     :ostemplates #{:required :Map}
      }})

 (def ^{:doc "aws section validation"} aws-v


Allow the language_in && the language_out option to be set for the google closure compiler

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -49,6 +49,7 @@
            java.util.List
            com.google.common.collect.ImmutableList
            com.google.javascript.jscomp.CompilerOptions
+           com.google.javascript.jscomp.CompilerOptions$LanguageMode
            com.google.javascript.jscomp.CompilationLevel
            com.google.javascript.jscomp.SourceMap$Format
            com.google.javascript.jscomp.SourceMap$DetailLevel
@@ -91,6 +92,19 @@
   [opts ^CompilerOptions compiler-options]
   (when (contains? opts :pretty-print)
     (set! (.prettyPrint compiler-options) (:pretty-print opts)))
+
+  (when (contains? opts :language-in)
+    (case (:language-in opts)
+      :ecmascript5        (.setLanguageIn compiler-options CompilerOptions$LanguageMode/ECMASCRIPT5)
+      :ecmascript5-strict (.setLanguageIn compiler-options CompilerOptions$LanguageMode/ECMASCRIPT5_STRICT)
+      :ecmascript3        (.setLanguageIn compiler-options CompilerOptions$LanguageMode/ECMASCRIPT3)))
+
+  (when (contains? opts :language-out)
+    (case (:language-out opts)
+      :ecmascript5        (.setLanguageOut compiler-options CompilerOptions$LanguageMode/ECMASCRIPT5)
+      :ecmascript5-strict (.setLanguageOut compiler-options CompilerOptions$LanguageMode/ECMASCRIPT5_STRICT)
+      :ecmascript3        (.setLanguageOut compiler-options CompilerOptions$LanguageMode/ECMASCRIPT3)))
+
   (when (contains? opts :print-input-delimiter)
     (set! (.printInputDelimiter compiler-options)
       (:print-input-delimiter opts))))


changing heartbeat a bit

changing heartbeat a bit

--- src/clj_discord/core.clj
+++ src/clj_discord/core.clj
@@ -48,9 +48,10 @@
                        (if (nil? @the-heartbeat-interval)
                          (Thread/sleep 100)
                          (do
+                           (if log-events (println "\n" "Sending heartbeat " @the-seq))
+                           (ws/send-msg @the-socket (json/write-str {:op 1, :d @the-seq}))
                            (Thread/sleep @the-heartbeat-interval)
-                           (if log-events (println "\n" "Sending heartbeat " @the-seq))
-                           (ws/send-msg @the-socket (json/write-str {:op 1, :d @the-seq}))))))))
+                           ))))))
   (Thread/sleep 2000)
   (ws/send-msg @the-socket (json/write-str {:op 2, :d {"token" @the-token
                                                        "properties" {"$os" "linux"


simple examples at bottom of file.

simple examples at bottom of file.

--- src/cljs/bardo/core.cljs
+++ src/cljs/bardo/core.cljs
@@ -63,4 +63,15 @@
                              speed-new)))))
        out)))

-;; (transition {} {})
+
+;; examples
+
+#_(defn log-transition [t]
+    (go-loop []
+             (when-let [v (<! t)]
+               (log v)
+               (recur))))
+
+;; (log-transition (transition 1 5))
+;; (log-transition (transition [1 10] [5 3] 2000))
+;; (log-transition (transition {:a 1 :b 10} {:a 5 :b 300} 1000 :elastic-in-out))


Fix arity issue

Fix arity issue

--- src/beehive/hive.clj
+++ src/beehive/hive.clj
@@ -132,7 +132,7 @@

 (defn future [^BeehiveCompletable completable]
   (let [java-f (.future ^PrecipicePromise (.-completable completable))]
-    (f/->BeehiveFuture java-f (.-result_key__GT_enum completable))))
+    (f/->BeehiveFuture java-f)))

 (defn release
   ([beehive {:keys [permit-count]}]


Factor out blob validation.

Factor out blob validation.

--- src/blobble/core.clj
+++ src/blobble/core.clj
@@ -40,6 +40,17 @@
   [content]
   (when content
     (multihash/sha1 content)))
+
+
+(defn validate!
+  "Checks that the identifier of a blob matches the actual digest of the
+  content. Throws an exception if the id does not match."
+  [blob]
+  (let [id' (identify (:content blob))]
+    (when (not= (:id blob) id')
+      (throw (IllegalStateException.
+               (str "Invalid blob with id " (:id blob)
+                    " but content digest " id'))))))

 (defn read!
@@ -111,11 +122,7 @@
   and throws an exception if it does not match."
   [store id]
   (when-let [blob (get* store id)]
-    (let [id' (identify (:content blob))]
-      (when (not= id id')
-        (throw (IllegalStateException.
-                 (str "Store " store " returned invalid content: requested "
-                      id " but got " id')))))
+    (validate! blob)
     blob))


fix fixtures

fix fixtures

and report exceptions if fixtures throw

--- src/bolth/runner.clj
+++ src/bolth/runner.clj
@@ -64,8 +64,8 @@
      (.add ^AbstractQueue *result-queue* x#)))

 (defn gather-tests-from-ns [^AbstractQueue queue n]
-  (let [once-fixture-fn (clojure.test/join-fixtures (::once-fixtures (meta n)))
-        each-fixture-fn (clojure.test/join-fixtures (::each-fixtures (meta n)))]
+  (let [once-fixture-fn (clojure.test/join-fixtures (:clojure.test/once-fixtures (meta n)))
+        each-fixture-fn (clojure.test/join-fixtures (:clojure.test/each-fixtures (meta n)))]
     (doseq [v (vals (ns-interns n))]
       (when (:test (meta v))
         (swap! queue conj (->TestSpec v each-fixture-fn once-fixture-fn))))))
@@ -119,10 +119,17 @@
         (loop []
           (if-let [{:keys [var each-fixture-fn once-fixture-fn]} (.poll tests-to-run)]
             (do
-              (once-fixture-fn
-                (fn []
-                  (each-fixture-fn
-                    #(test-var results var))))
+              (try
+                (once-fixture-fn
+                  (fn []
+                    (each-fixture-fn
+                      #(test-var results var))))
+                (catch Throwable e
+                  (record-test-result var :error)
+                  (clojure.test/do-report
+                    {:type :error, :message "Uncaught exception, not in assertion."
+                     :expected nil, :actual e})
+                  nil))
               (recur))
             (do
               (deliver (nth finished worker-id) clojure.test/*report-counters*)))))


prevent square from rotating

prevent square from rotating

--- src/client/core.cljs
+++ src/client/core.cljs
@@ -106,8 +106,10 @@
 (defn rotate-piece
   "Create a new piece by rotating the given piece clockwise."
   [piece]
-  (let [new-coords (map (fn [[x y]] [(- y) x]) (:coords piece))]
-    (assoc piece :coords new-coords)))
+  (if (= :O (:name piece))
+    piece
+    (let [new-coords (map (fn [[x y]] [(- y) x]) (:coords piece))]
+      (assoc piece :coords new-coords))))

 (defn coord-empty?
   "Determines if the given coordinate on the board is empty."


queue size

queue size

--- src/clj/neb/cell.clj
+++ src/clj/neb/cell.clj
@@ -16,7 +16,7 @@
 (def ^:dynamic *cell-hash* nil)
 (def ^:dynamic ^Trunk *cell-trunk* nil)

-(def pending-frags (a/chan 5000))
+(def pending-frags (a/chan 1000))

 (defmacro with-cell [^CellReader cell-reader & body]
   `(let ~(vec (mapcat


ClojureScript isn't currently shipping with a version of the Google Closure library that has dom.query; use the native el#querySelector method.

--- src/cljs/c2/dom.cljs
+++ src/cljs/c2/dom.cljs
@@ -25,12 +25,14 @@

 (defmulti select node-type)
 (defmethod select :selector
-  ([selector] (first (gdom/query selector)))
-  ([selector container] (first (gdom/query selector container))))
+  ([selector] (.querySelector js/document selector))
+  ([selector container] (.querySelector (select container) selector)))
 (defmethod select :dom [node] node)

 (defmulti select-all node-type)
-(defmethod select-all :selector [selector] (gdom/query selector))
+(defmethod select-all :selector
+  ([selector] (.querySelectorAll js/document selector))
+  ([selector container] (.querySelectorAll (select container) selector)))
 (defmethod select-all :dom [nodes] nodes)

@@ -46,9 +48,11 @@

 (defn append! [container el]
-  (if (dom-element? el)
-    (gdom/appendChild container el)
-    (recur container (build-dom-elem el))))
+  (gdom/appendChild (select container)
+                    (if (dom-element? el)
+                      el
+                      (build-dom-elem el))))
+

 (defn attr
   ([el] (let [attrs (.-attributes el)]


Add cljs float stub in svg namespace.

Add cljs float stub in svg namespace.

--- src/cljx/c2/svg.cljx
+++ src/cljx/c2/svg.cljx
@@ -12,6 +12,8 @@
                                 sin cos mean]])
          (:require [c2.dom :as dom]))

+;;Stub for float fn, which does not exist on cljs runtime
+^:cljs (def float identity)

 (defn ->xy
   "Convert coordinates (potentially map of `{:x :y}`) to 2-vector."


Automatically add tag-related instruction ephemeral random constants when :autoconstructive is true.

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -465,11 +465,23 @@
       (when (not (some #{instr} (:atom-generators @push-argmap)))
         (swap! push-argmap assoc :atom-generators (conj (:atom-generators @push-argmap) instr))))
     (swap! push-argmap assoc
-           :atom-generators (conj (:atom-generators @push-argmap) (fn [] (lrand))))
-    (swap! push-argmap assoc
-           :atom-generators (conj (:atom-generators @push-argmap) (fn [] (lrand-int 100))))
-    (swap! push-argmap assoc
-           :atom-generators (conj (:atom-generators @push-argmap) (fn [] (lrand-nth [true false]))))
+           :atom-generators (conj (:atom-generators @push-argmap)
+                                  (fn [] (lrand))))
+    (swap! push-argmap assoc
+           :atom-generators (conj (:atom-generators @push-argmap)
+                                  (fn [] (lrand-int 100))))
+    (swap! push-argmap assoc
+           :atom-generators (conj (:atom-generators @push-argmap)
+                                  (fn [] (lrand-nth [true false]))))
+    (swap! push-argmap assoc
+           :atom-generators (conj (:atom-generators @push-argmap)
+                                  (tag-instruction-erc [:integer :boolean :exec :float] 1000)))
+    (swap! push-argmap assoc
+           :atom-generators (conj (:atom-generators @push-argmap)
+                                  (untag-instruction-erc 1000)))
+    (swap! push-argmap assoc
+           :atom-generators (conj (:atom-generators @push-argmap)
+                                  (tagged-instruction-erc 1000)))
     (dotimes [n (:autoconstructive-integer-rand-enrichment @push-argmap)]
       (swap! push-argmap assoc
              :atom-generators (conj (:atom-generators @push-argmap) 'autoconstructive_integer_rand)))
@@ -500,3 +512,4 @@
    (reset-globals)))

+


Use ->Def with the implicit platform of "clj"

--- src/grimoire/doc.clj
+++ src/grimoire/doc.clj
@@ -150,7 +150,7 @@
   [{:keys [groupid artifactid version] :as config}]
   (doseq [[sym {:keys [forms doc] :as fake-meta}] @#'clojure.repl/special-doc-map]
     (api/write-meta config
-                    (t/->Def groupid artifactid version "clojure.core" (name sym))
+                    (t/->Def groupid artifactid version "clj" "clojure.core" (name sym))
                     {:ns       "clojure.core"
                      :name     sym
                      :doc      doc


try to delay the fetching of env vars

try to delay the fetching of env vars

--- src/holston/core.clj
+++ src/holston/core.clj
@@ -29,23 +29,24 @@
   (or (System/getenv name)
       (throw (Exception. (str "Mandatory environment variable missing: " name)))))

-(def client-config
+(defn create-client-config []
   {:client-id (get-mandatory-env-var "HOLSTON_GOOGLE_CLIENT_ID")
    :client-secret (get-mandatory-env-var "HOLSTON_GOOGLE_CLIENT_SECRET")
    :callback {:domain "http://localhost:8080" :path "/oauth2callback"}})

-(def uri-config
-  {:authentication-uri {:url "https://accounts.google.com/o/oauth2/auth"
-                       :query {:client_id (:client-id client-config)
-                               :response_type "code"
-                               :redirect_uri (format-config-uri client-config)
-                               :scope "https://www.googleapis.com/auth/userinfo.email" }}
+(defn uri-config []
+  (let [client-config (create-client-config)]
+    {:authentication-uri {:url "https://accounts.google.com/o/oauth2/auth"
+                          :query {:client_id (:client-id client-config)
+                                  :response_type "code"
+                                  :redirect_uri (format-config-uri client-config)
+                                  :scope "https://www.googleapis.com/auth/userinfo.email" }}

-   :access-token-uri {:url "https://accounts.google.com/o/oauth2/token"
-                      :query {:client_id (:client-id client-config)
-                              :client_secret (:client-secret client-config)
-                              :grant_type "authorization_code"
-                              :redirect_uri (format-config-uri client-config)}}})
+     :access-token-uri {:url "https://accounts.google.com/o/oauth2/token"
+                        :query {:client_id (:client-id client-config)
+                                :client_secret (:client-secret client-config)
+                                :grant_type "authorization_code"
+                                :redirect_uri (format-config-uri client-config)}}}))

 (defn- fetch-email-address [access-token]
   (let [response (client/get
@@ -91,8 +92,8 @@
     ring-app
     {:allow-anon? true
      :workflows [(oauth2/workflow
-                  {:client-config client-config
-                   :uri-config uri-config
+                  {:client-config (create-client-config)
+                   :uri-config (uri-config)
                    ;;:config-auth config-auth
                    :auth-error-fn (fn [error]
                                     (ring.util.response/response error))


index: add a fake index to benchmark store alone

--- src/io/cyanite/index.clj
+++ src/io/cyanite/index.clj
@@ -65,7 +65,23 @@
       (set
        (mapcat #(es/query client % false) queries)))))

+(defn empty-index
+  []
+  (reify
+    component/Lifecycle
+    (start [this] this)
+    (stop [this] this)
+    MetricIndex
+    (register! [this metric])
+    (leaves [this query])
+    (prefixes [this query])))
+
+
 (defmulti build-index (comp (fnil keyword "memory") :type))
+
+(defmethod build-index :empty
+  [options]
+  (empty-index))

 (defmethod build-index :memory
   [options]


fixed another potential source for exceptions

--- src/crawler/extractor.clj
+++ src/crawler/extractor.clj
@@ -22,9 +22,6 @@
 (def *sample-fraction* (/ 1 4))   ; fraction of links to look at
                                   ; before sampling

-(def *xpath-hrefs*   (atom {}))   ; hold the unique hrefs for each xpath
-(def *xpath-df*      (atom {}))   ; hold the df score for each xpath
-(def *xpath-tf*      (atom {}))   ; per-page tf scores
 (def *visited*       (atom
                       (set [])))  ; set of visited documents
 (def *url-documents* (atom {}))   ; url -> body map
@@ -44,17 +41,6 @@
        (swap!
         *url-documents* utils/atom-merge-with set/union {a-link (set [body])})
        body)))
-
-(defn update-tf
-  [xpaths-tfs]
-  (doseq [[xpath tf] xpaths-tfs]
-    (swap! *xpath-tf* utils/atom-merge-with concat {xpath [tf]})))
-
-(defn record-explore-potential
-  "At first, we just use # of distinct links"
-  [a-record]
-  (-> a-record
-      (records/record-anchors)))

 (defn sample
   ([urls host n]
@@ -81,23 +67,6 @@
            (recur urls host (dec n) (conj sampled-list sampled))
            (recur urls host 0 sampled-list))))))

-(defn update-df
-  "Each XPath's df score is incremented"
-  [xpaths-hrefs]
-  (let [xpaths     (map first xpaths-hrefs)
-        xpaths-cnt (map (fn [x] {x 1}) xpaths)]
-    (doseq [xpath-cnt xpaths-cnt]
-      (swap! *xpath-df* utils/atom-merge-with +' xpath-cnt))))
-
-(defn update-hrefs
-  "Union of explored hrefs and observed hrefs"
-  [xpaths-hrefs]
-  (swap!
-   *xpath-hrefs*
-   utils/atom-merge-with
-   set/union
-   (into {} xpaths-hrefs)))
-
 (defn novelty
   [a-diff]
   (reduce
@@ -172,7 +141,8 @@
                                 :similarity))
                           explorations)]
     (when (and (seq explorations) (< 0 (count explorations)))
-      (> (/ (apply + similarities) (count explorations)) *page-sim-thresh*))))
+      (try (> (/ (apply + similarities) (count explorations)) *page-sim-thresh*)
+           (catch Exception e nil)))))

 (defn enum-candidate-info
   "Uses the information sent and the snapshot info"


note length abstractions, WIP

note length abstractions, WIP

--- src/mantra/core.cljs
+++ src/mantra/core.cljs
@@ -88,13 +88,13 @@

 (defn- gain-ramp [gain-node level]
   (let [time (.-currentTime (.-context gain-node))]
-    (.linearRampToValueAtTime (.-gain gain-node) level (+ time 0.1))))
+    (.exponentialRampToValueAtTime (.-gain gain-node) level (+ time 0.1))))

 (defn- silence [gain-node]
   (gain gain-node 0))

 (defn- silence-ramp [gain-node]
-  (gain-ramp gain-node 0))
+  (gain-ramp gain-node 0.0001))

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

@@ -152,10 +152,18 @@
    :half          2
    :whole         1})

+(defn note-length->duration [nl]
+  (let [beats (/ 4 nl)
+        beat-duration (* 1000 (/ 60 @*tempo*))]
+    (* beats beat-duration)))
+
 (defn parse-duration [duration]
   (cond
     (number? duration)     duration
-    (keyword? duration)    "TODO"
+    (keyword? duration)    (do
+                             (assert (contains? note-lengths duration)
+                                     (str duration " is not a valid note length."))
+                             (note-length->duration (note-lengths duration)))
     (sequential? duration) (apply + (map parse-duration duration))))

 (defn- play-note*
@@ -168,7 +176,7 @@

     (when duration
       (let [duration-ms (parse-duration duration)]
-        (c/set-timeout! clock #(stop-osc osc-impl) duration)))))
+        (c/set-timeout! clock #(stop-osc osc-impl) duration-ms)))))

 (defn play-note
   "Uses a one-off oscillator to play a note.
@@ -192,7 +200,8 @@
   (reduce (fn [timeout {:keys [pitch duration volume] :as note-model}]
             (when pitch
               (c/set-timeout! clock #(play-fn osc-model note-model) timeout))
-            (+ timeout (or duration 0)))
+            (let [duration-ms (parse-duration (or duration 0))]
+              (+ timeout duration-ms)))
           0
           notes))


removed old version of `subst`

removed old version of `subst`

--- src/midje/util/unify.clj
+++ src/midje/util/unify.clj
@@ -15,26 +15,13 @@
   "Attempts to substitute the bindings into any symbol in the given form."
   [form bindings]
   (prewalk (fn [expr]
-                  (if (and (symbol? expr)
-                           (not= (get bindings expr 'not-found) 'not-found))
-                    (bindings expr)
-                    expr))
+                (if (and (symbol? expr)
+                         (contains? bindings expr))
+                  (bindings expr)
+                  expr))
                 form))
-
-;; TODO: Alex - Dec 8, 2011: see if I can get rid of this
-(defn old-subst
-  "Attempts to substitute the bindings into any symbol beginning with '?' in the given expression."
-  [x binds]
-  (letfn [(variable? [x] (and (symbol? x)
-                              (.startsWith (name x) "?")))]
-    (prewalk (fn [expr]
-                    (if (and (variable? expr)
-                             (not= (get binds expr 'not-found) 'not-found))
-                      (binds expr)
-                      expr))
-                  x)))

 (defn ?form [] (symbol (name (ns-name *ns*)) "?form")) ; this cannot be right

 (defn inject-form [outer-form inner-form]
-  (old-subst outer-form {(?form) inner-form}))+  (subst outer-form {(?form) inner-form}))


allow changing listener socket address (and port)

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -364,22 +364,29 @@
 (defn get-port [^ServerSocketChannel listener]
   (.. listener socket getLocalPort))

+(defn channel-socket-address [^ServerSocketChannel listener]
+  {:post [(s/valid? ::inet/socket-address %)]}
+  (let [s (.socket listener)]
+    {::inet/address (.getInetAddress s)
+     ::inet/port (.getLocalPort s)}))
+
 (defn update-listener [^ServerSocketChannel listener config]
   (when-let [l (get-in config [:config :log-level])]
     (when-not (= l (:level log/*config*))
       (log/info (str "Setting log level to " l))
       (log/set-level! l)))
-  (if-let [req-addr (log/spy :trace (get-in config [:config :listen-address]))]
-    (let [req-port (::conf/port req-addr)
-          old-port (and listener (get-port listener))]
-      (if (and listener
-               (= old-port req-port))
+  (if-let [config-addr (log/spy :trace
+                                (get-in config [:config :listen-address]))]
+    (let [new-addr (resolve-socket-address config-addr)
+          old-addr (and listener (channel-socket-address listener))]
+      (if (and listener (= old-addr new-addr))
         (log/spy :trace listener)
         (let [new-l (ServerSocketChannel/open)]
           (and listener (.close listener))
           (doto  new-l
             (.configureBlocking false)
-            (.bind (InetSocketAddress. req-port))))))
+            (.bind (InetSocketAddress. (::inet/address new-addr)
+                                       (::inet/port new-addr)))))))
     nil))

 (defn conform-or-warn [spec data]


si muove

si muove

--- src/merlion/core.clj
+++ src/merlion/core.clj
@@ -32,14 +32,19 @@

 (defn make-backend-channel [backend]
-  (let [ch (chan)]
+  (let [ch (chan)
+        backend-addr (parse-address (:listen-address backend))]
     (go
       (loop []
         (when-let [[req out-ch] (<! ch)]
           (println [:got-backend-req
-                    (parse-address (:listen-address backend))])
+                    backend-addr])
           (>! out-ch
-              (http/get "http://localhost:8000/LOG.md" {:raw-stream? true}))
+              (http/request (assoc req
+                                   :raw-stream? true
+                                   :follow-redirects? false
+                                   :server-name (:address backend-addr)
+                                   :server-port (:port  backend-addr))))
           (close! out-ch)
           (println "done")
           (recur )))


#9 fix use position

#9 fix use position

--- src/misaki/transform.clj
+++ src/misaki/transform.clj
@@ -27,9 +27,9 @@
   [sexp]
   (let [[defs sexp] (split-with-definition sexp)]
     `(do
+       (use 'misaki.html.core)
        ~@defs
        (fn [~'contents]
-         (use 'misaki.html.core)
          (let [~'site (meta ~'contents)]
            ~sexp)))))


center topic header images if they are smaller than the table

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -58,7 +58,8 @@
 (defn- topic-image [image-url]
   [:tr
     [:th
-      [:img {:src image-url}]]])
+      [:center
+        [:img {:src image-url}]]]])

 (defn- content-topic [snapshot topic-name topic topic-url]
   (let [title (:title topic)


giving each label its own collection

giving each label its own collection

--- src/ophion/aggregate.clj
+++ src/ophion/aggregate.clj
@@ -16,70 +16,70 @@
   [{:$match where}])

 (defn from-edge
-  [{:keys [label where]}]
-  [{:$lookup
-    {:from "edge" ;; label
-     :localField "gid"
-     :foreignField "to"
-     :as "edge"}}
-   {:$unwind "$edge"}
-   {:$match
-    (merge
-     where
-     {:edge.label label})}
-   {:$addFields {"edge._history" "$_history"}}
-   {:$replaceRoot {:newRoot "$edge"}}])
+  ([label] (from-edge label {}))
+  ([label where]
+   [{:$lookup
+     {:from label
+      :localField "gid"
+      :foreignField "to"
+      :as "edge"}}
+    {:$unwind "$edge"}
+    {:$match where}
+    {:$addFields {"edge._history" "$_history"}}
+    {:$replaceRoot {:newRoot "$edge"}}]))

 (defn to-edge
-  [{:keys [label where]}]
-  [{:$lookup
-    {:from "edge" ;; label
-     :localField "gid"
-     :foreignField "from"
-     :as "edge"}}
-   {:$unwind "$edge"}
-   {:$match
-    (merge
-     where
-     {:edge.label label})}
-   {:$addFields {"edge._history" "$_history"}}
-   {:$replaceRoot {:newRoot "$edge"}}])
+  ([label] (to-edge label {}))
+  ([label where]
+   [{:$lookup
+     {:from label
+      :localField "gid"
+      :foreignField "from"
+      :as "edge"}}
+    {:$unwind "$edge"}
+    {:$match where}
+    {:$addFields {"edge._history" "$_history"}}
+    {:$replaceRoot {:newRoot "$edge"}}]))

 (defn from-vertex
-  [{:keys [where]}]
-  [{:$lookup
-    {:from "vertex" ;; "$$fromLabel"
-     :localField "from"
-     :foreignField "gid"
-     :as "vertex"}}
-   {:$unwind "$vertex"}
-   {:$match (or where {})}
-   {:$addFields {"vertex._history" "$_history"}}
-   {:$replaceRoot {:newRoot "$vertex"}}])
+  ([label] (from-vertex label {}))
+  ([label where]
+   [{:$lookup
+     {:from label
+      :localField "from"
+      :foreignField "gid"
+      :as "vertex"}}
+    {:$unwind "$vertex"}
+    {:$match where}
+    {:$addFields {"vertex._history" "$_history"}}
+    {:$replaceRoot {:newRoot "$vertex"}}]))

 (defn to-vertex
-  [{:keys [where]}]
-  [{:$lookup
-    {:from "vertex" ;; "$$toLabel"
-     :localField "to"
-     :foreignField "gid"
-     :as "vertex"}}
-   {:$unwind "$vertex"}
-   {:$match (or where {})}
-   {:$addFields {"vertex._history" "$_history"}}
-   {:$replaceRoot {:newRoot "$vertex"}}])
+  ([label] (to-vertex label {}))
+  ([label where]
+   [{:$lookup
+     {:from label
+      :localField "to"
+      :foreignField "gid"
+      :as "vertex"}}
+    {:$unwind "$vertex"}
+    {:$match where}
+    {:$addFields {"vertex._history" "$_history"}}
+    {:$replaceRoot {:newRoot "$vertex"}}]))

 (defn from
-  ([what]
+  ([edge-label vertex-label] (from edge-label vertex-label {}))
+  ([edge-label vertex-label where]
    (concat
-    (from-edge (select-keys what [:label]))
-    (from-vertex (select-keys what [:where])))))
+    (from-edge edge-label)
+    (from-vertex vertex-label where))))

 (defn to
-  ([what]
+  ([edge-label vertex-label] (to edge-label vertex-label {}))
+  ([edge-label vertex-label where]
    (concat
-    (to-edge (select-keys what [:label]))
-    (to-vertex (select-keys what [:where])))))
+    (to-edge edge-label)
+    (to-vertex vertex-label where))))

 (defn values
   [values]
@@ -214,10 +214,10 @@

 (defn apply-step
   [steps step]
-  (let [step-key (-> step keys first)
-        about (-> step vals last)
+  (let [step-key (first step)
+        about (rest step)
         traverse (get steps step-key)]
-    (traverse about)))
+    (apply traverse about)))

 (defn translate
   ([query] (translate {} query))


correct regular-editor regression that broke matching parens editor

--- src/parinfer/editor.cljs
+++ src/parinfer/editor.cljs
@@ -209,7 +209,7 @@
   ([element-id] (create-regular-editor! element-id {}))
   ([element-id opts]
    (let [element (js/document.getElementById element-id)
-         cm (js/CodeMirror.fromTextArea element (clj->js (merge editor-opts opts)))
+         cm (js/CodeMirror.fromTextArea element (clj->js (merge editor-opts {:mode "clojure"} opts)))
          wrapper (.getWrapperElement cm)]
      (set! (.-id wrapper) (str "cm-" element-id))
      cm)))


Last couple of tweaks to get correct vote signs working

--- src/polismath/export.clj
+++ src/polismath/export.clj
@@ -76,7 +76,7 @@
     :zinvite))

-(defn get-conversation-votes
+(defn get-conversation-votes*
   ([zid]
    (kdb/with-db (db/db-spec)
      (ko/select db/votes
@@ -88,6 +88,12 @@
        (ko/where {:zid zid :created [<= final-vote-timestamp]})
        ; ordering by tid is important, since we rely on this ordering to determine the index within the comps, which needs to correspond to the tid
        (ko/order [:zid :tid :pid :created] :asc)))))
+
+(defn get-conversation-votes
+  [& args]
+  ;; Flip the signs on the votes XXX (remove when we switch)
+  (map  #(update-in % [:vote] (partial * -1))
+       (apply get-conversation-votes* args)))

 (defn get-conversation-data
   "Return a map with :topic and :description keys"
@@ -234,8 +240,6 @@
 (defn reconstruct-vote-matrix
   [votes]
   (let [new-nmat (nm/named-matrix)
-        ;; Flip the signs on the votes XXX (remove when we switch)
-        votes (map #(update-in % [:vote] (partial * -1)) votes)
         vote-tuples (map #(map % [:pid :tid :vote]) votes)]
     (nm/update-nmat new-nmat vote-tuples)))

@@ -275,8 +279,10 @@
                  (count (filter #(= (:pid %) ptpt) comments))
                  (count (remove nil? row))
                  ;; XXX God damn aggree vs disagree...
-                 (count (filter #{-1} row))
-                 (count (filter #{1} row))]
+                 ;; Fixed this upstream, for now; so should be good to go once we've fixed it at the source. But
+                 ;; keep an eye on it for now... XXX
+                 (count (filter #{1} row))
+                 (count (filter #{-1} row))]
                 row))
         (nm/rownames mat)
         (.matrix mat)))))
@@ -298,8 +304,10 @@
   (map
     (fn [{:keys [pid] :as comment-data}]
       (let [comment-votes (filter #(= pid (:pid %)) votes)
-            aggrees (filter #(= -1 (:vote %)) comment-votes)
-            disagrees (filter #(= 1 (:vote %)) comment-votes)]
+            ;; Fixed this upstream, for now; so should be good to go once we've fixed it at the source. But
+            ;; keep an eye on it for now... XXX
+            aggrees (filter #(= 1 (:vote %)) comment-votes)
+            disagrees (filter #(= -1 (:vote %)) comment-votes)]
         (assoc comment-data :aggrees (count aggrees) :disagrees (count disagrees))))
     comments))


Revert "threaded poller"

Revert "threaded poller"

This reverts commit e3967464034723bffd3641b4bca103dab2c9b93b.

--- src/polismath/poller.clj
+++ src/polismath/poller.clj
@@ -12,9 +12,7 @@
             [clojure.java.jdbc :as sql]
             [monger.core :as mg]
             [monger.collection :as mgcol]
-            [clojure.tools.trace :as tr]
             [environ.core :as env]))
-

@@ -67,83 +65,35 @@
                (encode-seq (into-array v) jsonGenerator)))

-(def poll-interval 1000)
-(def pg-spec         (heroku-db-spec (env/env :database-url)))
-(def mg-db           (mongo-connect! (env/env :mongo-url)))
-(def last-timestamp  (atom 0))
-(def conversations   (atom {})) ; generated artifacts
-(def pending-votes   (ref {})) ; zid -> votes

-(def dinner-bell (Object.))
-(def active-zids (ref #{}))
-(def pending-votes (ref {})) ; zid -> new votes
-
-(defn notify-workers []
-  (locking dinner-bell
-    (.notifyAll dinner-bell)))
-
-(defn wait-for-dinner-bell []
-  (locking dinner-bell
-    (.wait dinner-bell)))
-
-(defn pending-inactive-zids []
-  (filter (fn [zid] (not (contains? @active-zids zid)))
-          (keys @pending-votes)))
-
-(defn should-take-votes []
-  (> (count (pending-inactive-zids)) 0))
-
-(defn should-not-take-votes []
-  (not (should-take-votes)))
-
-
-(defn make-worker-thread [id]
- (fn [] ;; closure to capture the id
-  (do
-    (println "starting worker thread" id)
-   (while #(true)
-     (do
-       (println "worker" id "checking for votes")
-    ; if there are votes pending, take a zid and go for it.
-    ; otherwise, wait for a notification
-    (while (should-not-take-votes)
-      (do
-        (println "worker" id "no votes to take")
-        (wait-for-dinner-bell)))
-    ;
-    (let [
-          [zid votes]
-          (dosync
-           ; TODO ensure that we actually get votes here.
-           (let [zid (first (shuffle (pending-inactive-zids)))
-                 votes (@pending-votes zid)]
-             (do
-               (ref-set pending-votes (dissoc @pending-votes zid))
-               (ref-set active-zids (conj @active-zids zid))
-               (vector zid votes))))]
-
-      (println "worker thread" id "starting on math for zid:" zid)
-
-
-    ; DO MATH
-      (swap!
-       conversations
-       (fn [convs]
-         (assoc convs zid
-                (try
-                  (do
-                    (conv-update (or (convs zid) {:rating-mat (named-matrix)}) votes))
-                  (catch Exception e
-                    (do
-                      (println "exception when processing zid: " zid)
-                      (.printStackTrace e)))))))
-
-
-    ; UPLOAD/PUBLISH - do this in worker thread so we don't start more
-    ; work on a zid before we upload the result. That may be a later optimization.
-
-      (let [lastVoteTimestamp (:created (last votes))]
-          (println "zid: " zid)
+(defn -main []
+  (println "launching poller " (System/currentTimeMillis))
+  (let [poll-interval 1000
+        pg-spec         (heroku-db-spec (env/env :database-url))
+        mg-db           (mongo-connect! (env/env :mongo-url))
+        last-timestamp  (atom 0)
+        conversations   (atom {})]
+    (endlessly poll-interval
+      (println "poll >" @last-timestamp)
+      (let [new-votes (poll pg-spec @last-timestamp)
+            zid-to-votes (group-by :zid new-votes)
+            zid-votes (shuffle (into [] zid-to-votes))
+            ]
+        (doseq [[zid votes] zid-votes]
+          (let [lastVoteTimestamp (:created (last votes))]
+            (swap! conversations
+              (fn [convs]
+                (assoc convs zid
+                    (try
+                      (do
+                        (println "zid: " zid)
+                        (conv-update (or (convs zid) {:rating-mat (named-matrix)}) votes))
+                      (catch Exception e
+                        (do
+                          (println "exception when processing zid: " zid)
+                          (.printStackTrace e)))))))
+
+            (println "zid: " zid)
             (println "time: " (System/currentTimeMillis))
             (println "\n\n")
             (let [
@@ -163,49 +113,7 @@
                 (assoc obj
                  "lastVoteTimestamp" lastVoteTimestamp
                  "zid" zid))))
-            )

-      (println "worker thread" id "finished zid" zid)
-      (dosync ; do-sync needed?
-       (ref-set active-zids (disj @active-zids zid)))
-  ))))))
+        (swap! last-timestamp (fn [_] (:created (last new-votes))))

-
-(defn merge-pending-votes [zid-votes-pairs]
-  (dosync ;; dosync needed?
-   (ref-set pending-votes
-    (reduce
-     (fn [o zid-vote-pair]
-       (let [zid (first zid-vote-pair) votes (second zid-vote-pair)]
-         (assoc o zid
-                (concat (or (get o zid) [])
-                        votes))))
-     @pending-votes
-     zid-votes-pairs
-     ))))
-
-
-(defn -main []
-  (println "launching poller " (System/currentTimeMillis))
-
-  (let [threads (map #(Thread. %1)
-                     (map make-worker-thread
-                          (range 4)))]
-    (println (map #(.start %1) threads))
-    )
-
-
-  (endlessly poll-interval
-      (println "poll >" @last-timestamp)
-      (let [new-votes (poll pg-spec @last-timestamp)
-            zid-to-votes (group-by :zid new-votes)
-            zid-votes (into [] zid-to-votes)
-            ]
-        (if (> (count zid-votes) 0)
-          (do
-            (println "poller found new votes for" (count zid-votes) "conversations.")
-            (merge-pending-votes zid-votes)
-            (notify-workers)
-            (swap! last-timestamp (fn [_] (:created (last new-votes))))))
-
-        )))
+      ))))))


3-arg $syntax-error

3-arg $syntax-error

--- src/pyjure/utilities.clj
+++ src/pyjure/utilities.clj
@@ -146,6 +146,10 @@
 (defn $syntax-error
   ([x fmt args map] ($error 'syntax-error fmt args
                             (merge map {:expr x :source-info (:source-info x)})))
+  ([x fmt args] (loop [xargs args args [] map {}]
+                  (if-let [[name arg & more] xargs]
+                    (recur more (conj args name) (assoc map name arg))
+                    ($syntax-error fmt args map))))
   ([x fmt] ($syntax-error x fmt [:expr] {}))
   ([x] ($syntax-error x nil nil {})))


crude authentication stub and setting of cookie.

Todo: encrypt the authentication token; use MD5
checksum to verify that secret is okay etc.

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -8,9 +8,16 @@
 (require '[monger.collection :as mc])
 (use 'ring.middleware.file)
 (use 'ring.middleware.cookies)
+(use '[ring.middleware.params :only (wrap-params)])
 (use '[clojure.data.json :only (read-json json-str)])

 (use '[ontrail.summary])
+
+(defn authenticate [user password]
+  (and (= user "esko") (= password "morko")))
+
+(defn auth-token [user password]
+  (str user ":" password))

 (defn json-response [data & [status authToken]]
   {:status (or status 200)
@@ -21,6 +28,11 @@
 (defroutes app-routes
   "Routes requests to their handler function. Captures dynamic variables."
   (GET "/summary/:user" [user] (json-response (get-overall-summary user)))
+  (POST "/login" [user password]
+    (if (authenticate user password)
+      (json-response {"success" "Authentication successful"} 200 (auth-token user password))
+      (json-response {"error" "Authentication failed"} 401)))
+
   (route/resources "/")
   (route/not-found "Page not found"))

@@ -29,5 +41,6 @@
   all the routes we specified and is websocket ready."
   (start-http-server (-> app-routes
                        wrap-cookies
+                       wrap-params
                        wrap-ring-handler)
                      {:host "localhost" :port 8080 :websocket true}))


Fix request numbering. Add CORS for event create.

--- src/ruuvi_server/api.clj
+++ src/ruuvi_server/api.clj
@@ -16,21 +16,20 @@
   "Logs each incoming request"
   [app]
   (fn [request]
-    (swap! request-counter inc)
-    (let [request-method (:request-method request)
+    (let [counter (swap! request-counter inc)
+          request-method (:request-method request)
           uri (:uri request)
           query-params (:query-params request)
           start (System/currentTimeMillis)]
-      (info (str "REQUEST:" @request-counter)
+      (info (str "REQUEST:" counter)
             request-method uri ":query-params" query-params)
       (let [response (app request)
             duration (- (System/currentTimeMillis) start)
             status (:status response)]
-        (info (str "RESPONSE:" @request-counter)
+        (info (str "RESPONSE:" counter)
               (str "duration: " duration " msec")
               status)
-        response
-        )
+        response)
     )))

 (def url-prefix "/v1-dev")
@@ -57,6 +56,7 @@

 ;; TODO do some macro thing that creates automatically OPTIONS route
 (defroutes api-routes
+  ;; Client-API
   (OPTIONS (str url-prefix "/ping") []
        (-> #'success-handler
            (wrap-cors-headers "GET")
@@ -65,10 +65,6 @@
        (-> #'client-api/ping
            (wrap-cors-headers "GET")
            (wrap-request-logger)))
-
-  (POST (str url-prefix "/events") []
-        (-> #'tracker-api/handle-create-event
-            (wrap-request-logger)))

   (OPTIONS [(str url-prefix "/trackers/:ids") :ids #"([0-9]+,?)+"] [ids]
        (-> #'success-handler
@@ -81,7 +77,7 @@

   (OPTIONS [(str url-prefix "/trackers/:ids/events") :ids #"([0-9]+,?)+"] [ids]
        (-> #'success-handler
-           (wrap-cors-headers "GET")
+           (wrap-cors-headers "GET" )
            (wrap-request-logger)))
   (GET [(str url-prefix "/trackers/:ids/events") :ids #"([0-9]+,?)+"] [ids]
        (-> (fn [request] (client-api/fetch-events (merge request {:tracker_ids ids})))
@@ -108,10 +104,16 @@

   (OPTIONS (str url-prefix "/events") []
        (-> #'success-handler
-           (wrap-cors-headers "GET")
+           (wrap-cors-headers "GET" "POST")
            (wrap-request-logger)))
   (GET (str url-prefix "/events") []
        (-> #'client-api/fetch-events
-           (wrap-cors-headers "GET")
-           (wrap-request-logger)
-           )))
+           (wrap-cors-headers "GET" "POST")
+           (wrap-request-logger)))
+
+  ;; Tracker-API
+  (POST (str url-prefix "/events") []
+        (-> #'tracker-api/handle-create-event
+            (wrap-request-logger)
+            ))
+  )


Update data.cljs

Update data.cljs

CHRISTINA: Changed "click on" to "hover over" for chart areas within indiv hospital results.

--- src/prais2/data.cljs
+++ src/prais2/data.cljs
@@ -720,7 +720,7 @@

 (rum/defc nav-aid []
   [:p {:style {:font-style "italic"
-               :margin-top "20px"}} [:i.fa.fa-arrow-up {:style {:color "orange"}}] " Click or tap on the chart areas for more detail on " [:strong "this"] " hospital. " [:br] [:i.fa.fa-arrow-down {:style {:color "orange"}}] " See below for further explanation of the bars and the dot."]
+               :margin-top "20px"}} [:i.fa.fa-arrow-up {:style {:color "orange"}}] " Hover over or tap on the chart areas for more detail on " [:strong "this"] " hospital. " [:br] [:i.fa.fa-arrow-down {:style {:color "orange"}}] " See below for further explanation of the bars and the dot."]
 )

 (rum/defc hospital-detail < rum/reactive


Update util.clj

Update util.clj

--- src/swagger_gen/util.clj
+++ src/swagger_gen/util.clj
@@ -38,10 +38,7 @@
 (defn params-of-type
   "Extract swagger params of a given type i.e :body or :path"
   [swagger-route param-type]
-  (->> swagger-route
-       :parameters
-       (filter #(= (:in %) param-type))
-       (into [])))
+  (->> swagger-route :parameters (filter #(= (:in %) param-type)) (into [])))

 (defn body-params
   "Extract one or more body params from a swagger path"


Fixup 9bb67a5

Fixup 9bb67a5

* Listener thread should close on connection errors.
* Handler exceptions should be logged.

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -7,7 +7,8 @@
              (utils       :as utils)
              (protocol    :as protocol)
              (connections :as conns)
-             (commands    :as commands)])
+             (commands    :as commands)]
+            [taoensso.timbre :as timbre])
   (:import [org.apache.commons.pool.impl GenericKeyedObjectPool]
            [taoensso.carmine.connections ConnectionPool]
            [taoensso.carmine.protocol    Serialized]
@@ -348,9 +349,11 @@
      (future-call ; Thread to long-poll for messages
       (bound-fn []
         (while true ; Closes when conn closes
-          (try
-            (@handler-atom# (protocol/get-basic-reply! in# false) @state-atom#)
-            (catch Throwable _#)))))
+          (let [reply# (protocol/get-basic-reply! in# false)]
+            (try
+              (@handler-atom# reply# @state-atom#)
+              (catch Throwable t#
+                (timbre/error t# "Listener handler exception")))))))

      (protocol/with-context conn# ~@body)
      (Listener. conn# handler-atom# state-atom#)))


Add valid-ip? check.

Add valid-ip? check.


RR: flatten child nodes in repeat groups

--- src/hatti/ona/forms.cljs
+++ src/hatti/ona/forms.cljs
@@ -231,7 +231,7 @@
               (repeat? nd) (if flatten-repeats?
                              (concat (conj acc mini-nd) new-children)
                              (conj acc (assoc nd :children
-                                         (apply concat new-children))))
+                                                 (flatten (apply concat new-children)))))
               :else (conj acc nd))))]
     (let [nodes (flatten (map #(name-label-map % nil []) (:children form)))
           langs (->> nodes (map #(:langs (meta %))) flatten distinct)]


CMR-6894: Updated revision-date for deleted expired concepts.

--- metadata-db-app/src/cmr/metadata_db/services/concept_service.clj
+++ metadata-db-app/src/cmr/metadata_db/services/concept_service.clj
@@ -1106,7 +1106,7 @@
         (doseq [c expired-concepts]
           (let [tombstone (-> c
                               (update-in [:revision-id] inc)
-                              (assoc :deleted true :metadata ""))]
+                              (assoc :deleted true :metadata "" :revision-date (time-keeper/now)))]
             (try
               (try-to-save db provider context tombstone)
               (ingest-events/publish-event


update docs

update docs

--- src/thread_load/core.clj
+++ src/thread_load/core.clj
@@ -42,9 +42,13 @@
        :terminate state
        (recur (exec-on-data queue exec state)))))

-(defn create-pool [& {:keys [queue-limit] :or {queue-limit 100}}]
+(defn create-pool
+  "Entry point to the API and creates a pool from which consumers can be added
+   Optional keys are :queue-limit = the default is 100 and is the number items a queue can fill before it blocks,
+                     :thread-pool = default is a cached thread pool, and is the thread pool in which consumers will run"
+  [& {:keys [queue-limit thread-pool] :or {queue-limit 100 thread-pool (Executors/newCachedThreadPool)}}]
   {:queue (ArrayBlockingQueue. queue-limit)
-   :thread-pool  (Executors/newCachedThreadPool)
+   :thread-pool thread-pool
    })

 (defn add-consumer


Add `precision` helper on math ns.

Add `precision` helper on math ns.

--- src/uxbox/util/math.cljs
+++ src/uxbox/util/math.cljs
@@ -44,6 +44,10 @@
   [^number v]
   (js/Math.ceil v))

+(defn precision
+  [^number v ^number n]
+  (js/parseFloat (.toFixed v n)))
+
 (defn radians
   "Converts degrees to radians."
   [^number degrees]


update for release

update for release

--- kafka-clj/project.clj
+++ kafka-clj/project.clj
@@ -1,4 +1,4 @@
-(defproject kafka-clj "3.0.5-SNAPSHOT"
+(defproject kafka-clj "3.0.5"
   :description "fast kafka library implemented in clojure"
   :url "https://github.com/gerritjvv/kafka-fast"
   :license {:name "Eclipse Public License"


update version

update version

--- kafka-clj/project.clj
+++ kafka-clj/project.clj
@@ -1,4 +1,4 @@
-(defproject kafka-clj "3.5.3-SNAPSHOT"
+(defproject kafka-clj "3.5.3"
   :description "fast kafka library implemented in clojure"
   :url "https://github.com/gerritjvv/kafka-fast"
   :license {:name "Eclipse Public License"


add TODO

add TODO

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -577,7 +577,8 @@
      "chiacchierare" {:synsem {:cat :verb
                                :sem {:pred :chat}}}

-     "chiamarsi" (let [subject-semantics (atom {:animate true})
+   ;; TODO: add :3 to this verb (see French)
+   "chiamarsi" (let [subject-semantics (atom {:animate true})
                    subject-agr (atom :top)]
                {:synsem {:cat :verb
                          :essere true


query: prepare for query hook in api.

query: prepare for query hook in api.

--- src/io/cyanite/query.clj
+++ src/io/cyanite/query.clj
@@ -6,31 +6,29 @@
             [io.cyanite.query.ast    :as ast]
             [io.cyanite.query.path   :as path]
             [io.cyanite.index        :as index]
-            [io.cyanite.store        :as store]))
+            [io.cyanite.store        :as store]
+            [io.cyanite.engine       :as engine]))

-(defn by-name
-  [index store from to path]
-  (let [leaves (index/leaves index path)]
-    (store/fetch! store from to leaves)))
+(defn path-leaves
+  [index paths]
+  (reduce merge {} (for [p paths] [p (index/leaves index p)])))

-(defn by-pattern
-  [index store from to paths]
-  (reduce merge {} (for [p paths] [p (by-name index store from to p)])))
+(defn merge-paths
+  [by-path series]
+  (->> (for [[p leaves] by-path]
+         [p (remove nil? (map (partial get series) leaves))])
+       (reduce merge {})))

 (defn run-query!
-  [index store from to q]
-  (let [tokens (parser/query->tokens q)
-        paths  (path/tokens->paths tokens)
-        series (by-pattern index store from to paths)]
-    (ast/run-query! tokens series)))
-
-(comment
-
-  (parser/query->tokens "divideSeries(sumSeries(f1,f2),scale(f3,2.0))")
-  (ast/tokens->ast (parser/query->tokens "scale(f1,2.0)"))
-  (ast/tokens->ast (parser/query->tokens "sumSeries(scale(f1,2.0),divideSeries(f2,f3))"))
-  (run-query! "scale(f1,2.0)")
-  (run-query! "sumSeries(f1,f2)")
-  (run-query! "divideSeries(sumSeries(f1,f2),scale(f3,2.0))")
-
-)
+  [index store engine from to query]
+  (let [tokens  (parser/query->tokens query)
+        paths   (path/tokens->paths tokens)
+        by-path (path-leaves index paths)
+        leaves  (->> (mapcat val by-path)
+                     (partial engine/resolution from)
+                     (remove nil?)
+                     (set))
+        series  (store/query! store from to (seq leaves))
+        merged  (merge-paths by-path series)
+        params  (select-keys series [:from :to :step])]
+    (assoc params :series (ast/run-query! tokens merged))))


Swap manual drill downs into AST with calls to extract fn.

* Also remove first-content fn.

--- src/isla/interpreter.clj
+++ src/isla/interpreter.clj
@@ -3,7 +3,7 @@
   (:use [isla.library])
   (:require [clojure.string :as str]))

-(declare run-sequence first-content lookup nreturn instantiate-type
+(declare run-sequence lookup nreturn instantiate-type
          friendly-class friendly-symbol assign extract thr)

 (defmulti interpret (fn [& args] (:tag (first args))))
@@ -18,7 +18,7 @@
   (run-sequence (:content node) env))

 (defmethod interpret :expression [node env]
-  (interpret (first (:content node)) env))
+  (interpret (extract node [:content 0]) env))

 (defmethod interpret :value-assignment [node env]
   (let [assignee (extract node [:content 0])
@@ -35,28 +35,27 @@
       (throw (Exception. (str "I do not know what a " type-identifier " is."))))))

 (defmethod interpret :invocation [node env]
-  (def content (vec (:content node)))
-  (def function (lookup (interpret (first content) env) env))
-  (def param (interpret (nth content 1) env))
+  (def function (lookup (interpret (extract node [:content 0]) env) env))
+  (def param (interpret (extract node [:content 1]) env))
   (let [return-val (function env param)] ;; call fn
     (nreturn (:ctx env) return-val)))

 (defmethod interpret :value [node env]
-  (if (= :identifier (:tag (first-content node)))
-    (lookup (first-content (first-content node)) env) ;; sub is identifier - lookup+return
-    (interpret (first-content node) env)))
+  (if (= :identifier (:tag (extract node [:content 0])))
+    (lookup (extract node [:content 0 :content 0]) env) ;; sub is identifier - lookup+return
+    (interpret (extract node [:content 0]) env)))

 (defmethod interpret :identifier [node _]
-  (first-content node))
+  (extract node [:content 0]))

 (defmethod interpret :assignee [node _]
-  (first-content node))
+  (extract node [:content 0]))

 (defmethod interpret :integer [node _]
-  (first-content node))
+  (extract node [:content 0]))

 (defmethod interpret :string [node _]
-  (str/replace (first-content node) "'" ""))
+  (str/replace (extract node [:content 0]) "'" ""))

 (defmulti assign (fn [_ assignee-node _] (extract assignee-node [:content 0 :tag])))

@@ -81,9 +80,6 @@

 (defn lookup [identifier env]
   (get (:ctx env) identifier))
-
-(defn first-content [node]
-  (first (:content node)))

 (defn extract [ast route]
   (if-let [nxt (first route)]


Split `lookup` into two fns, one that will recurse through nested refs to get value, the other that will take a plain string identifier.

* The extra fn is a helper for lookuppers who don't want to wrap their string identifiers, like: {:ref "myid"}

--- src/isla/interpreter.clj
+++ src/isla/interpreter.clj
@@ -3,7 +3,7 @@
   (:use [isla.library])
   (:require [clojure.string :as str]))

-(declare run-sequence lookup nreturn instantiate-type
+(declare run-sequence lookup-ref lookup nreturn instantiate-type
          friendly-class friendly-symbol assign extract thr)

 (defmulti interpret (fn [& args] (:tag (first args))))
@@ -86,8 +86,13 @@
 (defn remret [env]
   (assoc env :ret nil))

+(defn lookup-ref [ref env]
+  (lookup (get (:ctx env) ref) env))
+
 (defn lookup [identifier env]
-  (get (:ctx env) identifier))
+  (if (contains? identifier :ref)
+    (lookup (get (:ctx env) (:ref identifier)) env)
+    identifier))

 (defn extract [ast route]
   (if-let [nxt (first route)]


remove debugging

remove debugging

--- src/bracketolojy/tournament.clj
+++ src/bracketolojy/tournament.clj
@@ -184,12 +184,7 @@
        zip/root))

 (defn- sort-node-teams [cmp node]
-  (let [before (get-in node [:data :teams])
-        after (update-in node [:data :teams] (partial sort cmp))]
-    (dbg-v "")
-    (dbg-v before)
-    (dbg-v (get-in after [:data :teams]))
-    after))
+  (update-in node [:data :teams] (partial sort cmp)))

 (defn- sort-teams-helper [cmp loc]
   (if (zip/end? loc)


add partition-fixed function

add partition-fixed function

--- src/clj/backtype/storm/util.clj
+++ src/clj/backtype/storm/util.clj
@@ -695,3 +695,28 @@

 (defn url-encode [s]
   (java.net.URLEncoder/encode s))
+
+(defn join-maps [& maps]
+  (let [all-keys (apply set/union (for [m maps] (-> m keys set)))]
+    (into {}
+      (for [k all-keys]
+        [k (for [m maps] (m k))]
+        ))))
+
+(defn partition-fixed [max-num-chunks aseq]
+  (if (zero? max-num-chunks)
+    (throw (IllegalArgumentException. "Cannot partition into zero chunks"))
+    (let [chunks (->> (integer-divided (count aseq) max-num-chunks)
+                      (#(dissoc % 0))
+                      (sort-by (comp - first))
+                      (mapcat (fn [[size amt]] (repeat amt size)))
+                      )]
+      (loop [result []
+             [chunk & rest-chunks] chunks
+             data aseq]
+        (if (nil? chunk)
+          result
+          (let [[c rest-data] (split-at chunk data)]
+            (recur (conj result c)
+                   rest-chunks
+                   rest-data)))))))


Now using int arrays for static stuff.

Now using int arrays for static stuff.

--- src/clj/forma/source/static.clj
+++ src/clj/forma/source/static.clj
@@ -93,4 +93,4 @@
                                           -9999))]
     (<- [?dataset ?spatial-res ?t-res ?tilestring ?chunkid ?chunk]
         (window-src ?dataset ?spatial-res ?t-res ?tilestring  _ ?chunkid ?window)
-        (p/window->struct [:double] ?window :> ?chunk))))
+        (p/window->struct [:int] ?window :> ?chunk))))


Convert deseasonalized matrix to vector

Convert deseasonalized matrix to vector

--- src/clj/forma/trends/filter.clj
+++ src/clj/forma/trends/filter.clj
@@ -32,8 +32,8 @@
         xtx (i/mmult xt x)
         coefs (i/mmult (i/solve xtx) xt ts)
         fitted (i/mmult x coefs)]
-    (i/plus (i/minus ts fitted)
-            (s/mean ts))))
+    (i/to-vect (i/plus (i/minus ts fitted)
+                       (s/mean ts)))))

 ;; Remove seasonal component by harmonic decomposition


More documentation for core.async

More documentation for core.async

--- src/clj/momentum/core/async.clj
+++ src/clj/momentum/core/async.clj
@@ -167,7 +167,9 @@
 ;; ==== Async value ====

 (defn async-val
-  "Returns a new unrealized asynchronous value."
+  "Returns a new unrealized asynchronous value. Dereferencing will
+  cause the current thread to block until the asynchronous value is
+  realized."
   []
   (AsyncVal.))

@@ -187,6 +189,11 @@
   (Join. args))

 (defn recur*
+  "Accepts an aribtrary number of arguments, passing them to
+  join. Once the joined asynchronous value is realized, the current
+  callback function will be reinvoked with the joined realized values
+  from the supplied arguments. Must be called from the tail position
+  of a doasync callback."
   ([]                (Pipeline$Recur. nil))
   ([v1]              (Pipeline$Recur. v1))
   ([v1 v2]           (Pipeline$Recur. (join v1 v2)))
@@ -280,7 +287,9 @@
     #(first %)))

 (defn batch
-  "Returns an async value that is realized with the given collection
+  "Alpha - subject to change
+
+  Returns an async value that is realized with the given collection
   when all (or n if supplied) elements of the collection have been
   realized."
   ([coll] (batch Integer/MAX_VALUE coll))
@@ -294,13 +303,23 @@
              coll))))))

 (defn map*
-  [f coll]
-  (async-seq
-    (doasync coll
-      (fn [[v & more]]
-        (cons v (map* f more))))))
+  "Returns an asynchronous sequence consisting of the result of recursively
+  applying f to the set of first items of each coll once they become
+  realized. Function f should accept the number of colls arguments."
+  ([f coll]
+     (async-seq
+       (doasync coll
+         (fn [[v & more]]
+           (cons v (map* f more))))))
+  ([f c1 & colls]
+     (throw (Exception. "Not implemented yet."))))

 (defmacro doseq*
+  "Repeatedly executes body (presumably for side-effects) with
+  bindings as they are realized and filtering as provided by
+  \"for\". Does not retain the head of the sequence. Returns an
+  asynchronous value that will be realized with nil once all of the
+  items have been handled."
   [seq-exprs & body]
   (assert (vector? seq-exprs) "a vector for its binding")
   (assert (even? (count seq-exprs)) "an even number of forms in binding vector")
@@ -357,6 +376,9 @@
           (splice (dissoc map k)))))))

 (defmacro future*
+  "Takes a body of expressions and invoke it in another
+  thread. Returns an asynchronous value that will be realized with the
+  result once the computation completes."
   [& body]
   `(let [val# (async-val)]
      (future
@@ -442,6 +464,8 @@
             (cons v nxt)))))))

 (defn channel
+  "Returns a new channel. Calling seq with a channel returns an
+  asynchronous sequence of the values that are put into the channel."
   ([]  (channel nil 0))
   ([f] (channel f 1))
   ([f capacity]
@@ -451,6 +475,7 @@
        ch)))

 (defn enqueue
+  "Put multiple values into a channel."
   ([_])
   ([ch & vs]
      (loop [vs vs cont? true]
@@ -459,6 +484,8 @@
            (recur more (put ch v)))))))

 (defn close
+  "Close a channel. Closing a channel causes any associated
+  asynchronous sequences to terminate."
   [ch]
   (.close (.transfer ch)))


Factorization

Factorization

--- src/cljs/clojure_rest/core.cljs
+++ src/cljs/clojure_rest/core.cljs
@@ -74,16 +74,17 @@
 (defn render-card
   []
   (let [is-show-details (r/atom false)
-        show-details #(swap! is-show-details not)]
+        show-details #(swap! is-show-details not)
+        title-style #(if % :div.card__title--is-open :div.card__title)]
     (fn [card]
-      (if-not @is-show-details
-        [:div.card
-         [:div.card__title {:on-click show-details} (:title card)]]
-        [:div.card
-         [:div.card__title--is-open {:on-click show-details} (:title card)]
-         [:div.card__details (:description card)]
-         [render-tasks (:tasks card)]]
-        ))
+      [:div.card
+       [(title-style @is-show-details) {:on-click show-details} (:title card)]
+       (when @is-show-details
+         [:div.card__details
+          (:description card)
+          [render-tasks (:tasks card)]
+         ])
+       ])
     ))

 (defn render-list


Fix current-item not fully resetting

Fix current-item not fully resetting

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -159,6 +159,7 @@

 (secretary/defroute "/items/:id" [id]
   (swap! app-state assoc :render-view :item)
+  (base/unbind! app-state [:current-item])
   (base/bind! app-state [:current-item]
               (base/id->fbref id)
               base/item-binder))


Chart title use new weighted random

Chart title use new weighted random

--- src/cljs/mokkameister/core.cljs
+++ src/cljs/mokkameister/core.cljs
@@ -1,6 +1,7 @@
 (ns mokkameister.core
   (:require-macros [cljs.core.async.macros :refer [go]])
-  (:require [reagent.core :as reagent :refer [atom]]
+  (:require [mokkameister.random :refer [rand-nth-weighted]]
+            [reagent.core :as reagent :refer [atom]]
             [ajax.core :refer [GET POST]]
             [cljs.core.async :as async :refer [timeout <!]]))

@@ -72,10 +73,9 @@
            [:td (get stats line)]])]])
     (loading-gif)))

-(def ^:private chart-titles
-  (flatten [(repeat 2 "Brygg per monade")
-            (repeat 8 "Brygg per månad")
-            (repeat 1 "Mikrodosar per månad")]))
+(def ^:private chart-titles {"Brygg per monade" 2
+                             "Brygg per månad" 8
+                             "Mikrodosar per månad" 1})

 (defn chart [chart-data]
   (let [month-count (map :count chart-data)]
@@ -83,7 +83,7 @@
                           (clj->js {:width 85}))]))

 (defn chart-panel []
-  (let [title (rand-nth chart-titles)
+  (let [title (rand-nth-weighted chart-titles)
         chart-data (get-in @state [:stats :month-stats])]
     [:div.panel.panel-info
      [:div.panel-heading


Add support bezier-vertex to with-shape macro.

--- src/cljs/quil/helpers/tools.clj
+++ src/cljs/quil/helpers/tools.clj
@@ -17,7 +17,14 @@

 (defmacro with-shape [mode & body]
-  `(do
-     (cljs.quil.core/begin-shape ~mode)
-     ~@body
-     (cljs.quil.core/end-shape)))
+  (if (keyword? mode)
+    `(do
+       (cljs.quil.core/begin-shape ~mode)
+       ~@body
+       (cljs.quil.core/end-shape))
+
+    `(do
+       (cljs.quil.core/begin-shape)
+       ~mode
+       ~@body
+       (cljs.quil.core/end-shape))))


Fix load-game-file so it doesn't rely on the classloader

--- src/clojure/nightmod/public.clj
+++ src/clojure/nightmod/public.clj
@@ -13,8 +13,7 @@

 (defmacro load-game-file
   [n]
-  (some->> (or (io/resource n)
-               (throw (Throwable. (str "File not found: " n))))
+  (some->> (io/file @u/project-dir n)
            slurp
            (format "(do %s\n)")
            jail/safe-read))


daily update

daily update

--- src/clojure_dominion/action.clj
+++ src/clojure_dominion/action.clj
@@ -160,10 +160,10 @@
           buy (action @board (:virtual-money state))]
       (single-action board player hand (update-state-for-buy state buy)))))

-(defn update-move-state
+(defn update-state-for-move
   [state action]
-  (let [new-state (merge-with - state {:free-action 1})]
-    (update-in new-state [:played] conj {action 1})))
+  (-> (merge-with - state {:free-action 1})
+    (update-in [:played] conj {action 1})))

 (defn single-action
   "Executes single player action as play card or single buy.
@@ -176,7 +176,7 @@
         (println "play card= " action-card ", hand=" hand " state=" state)
         (play-card action-card board player
                    (merge-with - hand {action-card 1})
-                   (update-move-state state action-card)))
+                   (update-state-for-move state action-card)))
       (if (pos? (:free-buy state 0))
         (buy-card board player hand
                   (merge-with - state {:free-buy 1}))


Accept json in programmes POST request.

Accept json in programmes POST request.

--- src/kixi/hecuba/amon.clj
+++ src/kixi/hecuba/amon.clj
@@ -127,7 +127,7 @@

   :post!
   (fn [{{body :body} :request}]
-    {:programme-id (upsert! commander :programme (-> body read-edn-body ->shallow-kebab-map))})
+    {:programme-id (upsert! commander :programme (-> body read-json-body ->shallow-kebab-map))})

   :handle-created
   (fn [{id :programme-id {routes :modular.bidi/routes} :request}]
@@ -165,7 +165,7 @@
 (defresource projects [{:keys [commander querier]} handlers]
   :allowed-methods #{:get :post}
   :available-media-types ["text/html" "application/json" "application/edn"]
-  :known-content-type? #{"application/edn"}
+  :known-content-type? #{"application/json"}
   :authorized? (authorized? querier :project)

   :handle-ok
@@ -202,7 +202,7 @@
 (defresource project [{:keys [commander querier]} handlers]
   :allowed-methods #{:get}
   :available-media-types ["text/html" "application/json" "application/edn"]
-  :known-content-type? #{"application/edn"}
+  :known-content-type? #{"application/json"}
   :authorized? (authorized? querier :project)

   :exists?


Change 'fail' to throw an ex-info to be printed with 'print-err'.

--- src/mvxcvi/directive.clj
+++ src/mvxcvi/directive.clj
@@ -1,5 +1,6 @@
 (ns mvxcvi.directive
   (:require
+    [clojure.stacktrace :refer [print-cause-trace]]
     [clojure.string :as str]
     [clojure.tools.cli :as cli]))

@@ -7,10 +8,17 @@
 ;; UTILITY FUNCTIONS

 (defn fail
-  "Indicates a failure has occurred."
-  [msg]
+  "Throws an exception indicating a failure has occurred. This exception will
+  be caught and the message printed to stderr."
+  [& args]
+  (throw (ex-info (apply str args) {::failure true})))
+
+
+(defn print-err
+  "Prints the given arguments to stderr and returns false."
+  [& args]
   (binding [*out* *err*]
-    (println msg))
+    (println (apply str args)))
   false)

@@ -121,14 +129,18 @@
     (do (println usage) true)

     action
-    (action opts args)
+    (try
+      (action opts args)
+      (catch Exception e
+        (if (::failure (ex-data e))
+          (print-err (.getMessage e))
+          (print-cause-trace e))))

     :else
-    (fail
-      (str
-        (when (seq args)
-          (println "Unrecognized arguments:" (str/join " " args) "\n"))
-        usage))))
+    (print-err
+      (when (seq args)
+        (str "Unrecognized arguments:" (str/join " " args) "\n"))
+      usage)))

 (defn execute
@@ -147,7 +159,7 @@
          (parse-command-args options (:specs cmd) arguments)]
      (cond
        errors
-       (fail (str/join \newline errors))
+       (print-err (str/join \newline errors))

        (and (empty? branch) (= "help" (first arguments)))
        (recur cmd branch


Eliminate reflection warnings. Bring in some zookeeper-clj functions

--- src/onyx/log/curator.clj
+++ src/onyx/log/curator.clj
@@ -1,19 +1,50 @@
 (ns onyx.log.curator
   (:require [clojure.core.async :refer [chan >!! <!! close! thread]]
             [taoensso.timbre :refer [fatal warn trace]]
-            [onyx.static.default-vals :refer [defaults]]
-            [zookeeper :as zk]
-            [zookeeper.internal :as zi])
+            [onyx.static.default-vals :refer [defaults]])
   (:import [org.apache.zookeeper CreateMode]
-           [org.apache.zookeeper KeeperException$NoNodeException KeeperException$NodeExistsException]
+           [org.apache.zookeeper KeeperException$NoNodeException KeeperException$NodeExistsException Watcher]
            [org.apache.curator.test TestingServer]
            [org.apache.zookeeper.data Stat]
            [org.apache.curator.framework CuratorFrameworkFactory CuratorFramework]
-           [org.apache.curator.framework.api CuratorWatcher PathAndBytesable Versionable]
+           [org.apache.curator.framework.api CuratorWatcher PathAndBytesable Versionable GetDataBuilder
+            SetDataBuilder DeleteBuilder ExistsBuilder GetChildrenBuilder Pathable Watchable]
            [org.apache.curator.framework.state ConnectionStateListener ConnectionState]
            [org.apache.curator.framework.imps CuratorFrameworkState]
            [org.apache.curator RetryPolicy]
            [org.apache.curator.retry BoundedExponentialBackoffRetry]))
+
+;; Thanks to zookeeper-clj
+(defn stat-to-map
+  ([^org.apache.zookeeper.data.Stat stat]
+   ;;(long czxid, long mzxid, long ctime, long mtime, int version, int cversion, int aversion, long ephemeralOwner, int dataLength, int numChildren, long pzxid)
+   (when stat
+     {:czxid (.getCzxid stat)
+      :mzxid (.getMzxid stat)
+      :ctime (.getCtime stat)
+      :mtime (.getMtime stat)
+      :version (.getVersion stat)
+      :cversion (.getCversion stat)
+      :aversion (.getAversion stat)
+      :ephemeralOwner (.getEphemeralOwner stat)
+      :dataLength (.getDataLength stat)
+      :numChildren (.getNumChildren stat)
+      :pzxid (.getPzxid stat)})))
+
+(defn event-to-map
+  ([^org.apache.zookeeper.WatchedEvent event]
+     (when event
+       {:event-type (keyword (.name (.getType event)))
+        :keeper-state (keyword (.name (.getState event)))
+        :path (.getPath event)})))
+
+;; Watcher
+
+(defn make-watcher
+  ([handler]
+     (reify Watcher
+       (process [this event]
+         (handler (event-to-map event))))))

 (defn ^CuratorFramework connect
   ([connection-string]
@@ -51,12 +82,12 @@
 (defn create
   [^CuratorFramework client path & {:keys [data] :as opts}]
   (try
-    (let [cr (.. client
+    (let [cr ^SetDataBuilder (.. client
                  create
                  (withMode (create-mode opts)))]
       (if data
-        (.forPath cr path data)
-        (.forPath cr path)))
+        (.forPath ^SetDataBuilder cr path data)
+        (.forPath ^SetDataBuilder cr path)))
     (catch org.apache.zookeeper.KeeperException$NodeExistsException e
       false)))

@@ -68,8 +99,8 @@
                  creatingParentsIfNeeded
                  (withMode (create-mode opts)))]
       (if data
-        (.forPath cr path data)
-        (.forPath cr path)))
+        (.forPath ^SetDataBuilder cr path data)
+        (.forPath ^SetDataBuilder cr path)))
     (catch org.apache.zookeeper.KeeperException$NodeExistsException e
       false) ))

@@ -77,30 +108,31 @@
   "Deletes the given node if it exists. Otherwise returns false."
   [^CuratorFramework client path]
   (try
-    (.. client (delete) (forPath path))
+    (.forPath ^DeleteBuilder (.delete client) path )
     (catch KeeperException$NoNodeException e false)))

 (defn children
-  ([^CuratorFramework curator path & {:keys [watcher]}]
-   (.forPath
-     (cond-> (.getChildren curator)
-       watcher (.usingWatcher (zi/make-watcher watcher)))
-     path)))
+  ([^CuratorFramework client path & {:keys [watcher]}]
+   (let [children-builder ^GetChildrenBuilder (.getChildren client)]
+     (if watcher
+       (.forPath ^GetChildrenBuilder (.usingWatcher children-builder ^Watcher (make-watcher watcher)) path)
+       (.forPath ^GetChildrenBuilder children-builder path)))))

-(defn data [client path]
-  (let [stat (Stat.)
-        data (.forPath (.storingStatIn (.getData client) stat) path)]
+(defn data [^CuratorFramework client path]
+  (let [stat ^Stat (Stat.)
+        data (.forPath ^GetDataBuilder (.storingStatIn ^GetDataBuilder (.getData client) stat) path)]
     {:data data
-     :stat (zi/stat-to-map stat)}))
+     :stat (stat-to-map stat)}))

-(defn set-data [client path data version]
-  (.. client
-      (setData)
-      (withVersion version)
-      (forPath path data)))
+(defn set-data [^CuratorFramework client path data version]
+  (.forPath ^SetDataBuilder (.withVersion ^SetDataBuilder (.setData client)
+                                          version)
+            path
+            data))

-(defn exists [client path & {:keys [watcher]}]
-  (zi/stat-to-map
-    (cond-> (.. client checkExists)
-      watcher (.usingWatcher (zi/make-watcher watcher))
-      true (.forPath path))))
+(defn exists [^CuratorFramework client path & {:keys [watcher]}]
+  (stat-to-map
+    (let [builder ^ExistsBuilder (.. client checkExists)]
+      (if watcher
+        (.forPath ^ExistsBuilder (.usingWatcher builder ^Watcher (make-watcher watcher)) path)
+        (.forPath builder path)))))


collection per vertex and edge type

collection per vertex and edge type

--- src/ophion/aggregate.clj
+++ src/ophion/aggregate.clj
@@ -18,56 +18,56 @@
 (defn from-edge
   [{:keys [label where]}]
   [{:$lookup
-    {:from "edge"
+    {:from label ;; "edge"
      :localField "gid"
      :foreignField "to"
-     :as "from"}}
-   {:$unwind "$from"}
-   {:$match
-    (merge
-     where
-     {:from.label label})}
-   {:$addFields {"from._history" "$_history"}}
-   {:$replaceRoot {:newRoot "$from"}}])
+     :as "edge"}}
+   {:$unwind "$edge"}
+   {:$match (or where {})}
+    ;; (merge
+    ;;  where
+    ;;  {:from.label label})
+   {:$addFields {"edge._history" "$_history"}}
+   {:$replaceRoot {:newRoot "$edge"}}])

 (defn to-edge
   [{:keys [label where]}]
   [{:$lookup
-    {:from "edge"
+    {:from label ;; "edge"
      :localField "gid"
      :foreignField "from"
-     :as "to"}}
-   {:$unwind "$to"}
-   {:$match
-    (merge
-     where
-     {:to.label label})}
-   {:$addFields {"to._history" "$_history"}}
-   {:$replaceRoot {:newRoot "$to"}}])
+     :as "edge"}}
+   {:$unwind "$edge"}
+   {:$match (or where {})}
+    ;; (merge
+    ;;  where
+    ;;  {:to.label label})
+   {:$addFields {"edge._history" "$_history"}}
+   {:$replaceRoot {:newRoot "$edge"}}])

 (defn from-vertex
   [{:keys [where]}]
   [{:$lookup
-    {:from "vertex"
+    {:from "$from-label" ;; "vertex"
      :localField "from"
      :foreignField "gid"
-     :as "from"}}
-   {:$unwind "$from"}
+     :as "vertex"}}
+   {:$unwind "$vertex"}
    {:$match (or where {})}
-   {:$addFields {"from._history" "$_history"}}
-   {:$replaceRoot {:newRoot "$from"}}])
+   {:$addFields {"vertex._history" "$_history"}}
+   {:$replaceRoot {:newRoot "$vertex"}}])

 (defn to-vertex
   [{:keys [where]}]
   [{:$lookup
-    {:from "vertex"
+    {:from "$to-label" ;; "vertex"
      :localField "to"
      :foreignField "gid"
-     :as "to"}}
-   {:$unwind "$to"}
+     :as "vertex"}}
+   {:$unwind "$vertex"}
    {:$match (or where {})}
-   {:$addFields {"to._history" "$_history"}}
-   {:$replaceRoot {:newRoot "$to"}}])
+   {:$addFields {"vertex._history" "$_history"}}
+   {:$replaceRoot {:newRoot "$vertex"}}])

 (defn from
   ([what]
@@ -295,12 +295,13 @@

 (defn ingest-batches!
   [graph element all]
-  (doseq [lines (partition-all 1000 all)]
-    (let [labels (group-by :label lines)]
-      (doseq [[label messages] labels]
-        (mongo/ensure-collection! graph element label)
-        (pprint/pprint
-         (mongo/bulk-insert! graph label messages))))))
+  (let [processed (map (if (= element "vertex") process-vertex process-edge) all)]
+    (doseq [lines (partition-all 1000 processed)]
+      (let [labels (group-by :label lines)]
+        (doseq [[label messages] labels]
+          (mongo/ensure-collection! graph element label)
+          (pprint/pprint
+           (mongo/bulk-insert! graph label messages)))))))

 (defn ingest-batches-from-path!
   [graph path]


0.9.0 is here!

0.9.0 is here!

--- src/overtone/version.clj
+++ src/overtone/version.clj
@@ -3,7 +3,7 @@
 (def OVERTONE-VERSION {:major 0
                        :minor 9
                        :patch 0
-                       :snapshot true})
+                       :snapshot false})

 (def OVERTONE-VERSION-STR
   (let [version OVERTONE-VERSION]


Abbrev 'clojure.spec.alpha' ns name

Abbrev 'clojure.spec.alpha' ns name

--- src/pinpointer/core.cljc
+++ src/pinpointer/core.cljc
@@ -73,9 +73,11 @@

 (defn- simplify-spec [spec]
   (walk/postwalk (fn [x]
-                   (if (and (symbol? x)
-                            (= (namespace x) "clojure.core"))
-                     (symbol (name x))
+                   (if (symbol? x)
+                     (condp #(= (namespace %2) %1) x
+                       "clojure.core" (symbol (name x))
+                       "clojure.spec.alpha" (symbol "s" (name x))
+                       x)
                      x))
                  spec))


Fix typo.

Fix typo.

--- clstreams/test/clstreams/examples/count_words_prc/topology_test.clj
+++ clstreams/test/clstreams/examples/count_words_prc/topology_test.clj
@@ -21,7 +21,7 @@
                   "some" "2"
                   "words" "1"
                   "more" "1"}]
-    (is (= (into { } (through-kstreams-topology sut/word-counts-landscape
-                                                builder :input :output msgs))
+    (is (= (into {} (through-kstreams-topology sut/word-counts-landscape
+                                               builder :input :output msgs))
            expected))))


Fix for Issue #79.

Fix for Issue #79.

--- src/re_com/validate.cljs
+++ src/re_com/validate.cljs
@@ -196,7 +196,13 @@
                   :on-blur :on-change :on-click :on-copy :on-cut :on-double-click :on-drag :on-drag-end :on-drag-enter :on-drag-exit :on-drag-leave
                   :on-drag-over :on-drag-start :on-drop :on-focus :on-input :on-key-down :on-key-press :on-key-up :on-mouse-down :on-mouse-enter
                   :on-mouse-leave :on-mouse-move :on-mouse-out :on-mouse-over :on-mouse-up :on-paste :on-scroll :on-submit :on-touch-cancel
-                  :on-touch-end :on-touch-move :on-touch-start :on-wheel})
+                  :on-touch-end :on-touch-move :on-touch-start :on-wheel
+                  :on-blur-capture :on-change-capture :on-click-capture :on-copy-capture :on-cut-capture :on-double-click-capture :on-drag-capture
+                  :on-drag-end-capture :on-drag-enter-capture :on-drag-exit-capture :on-drag-leave-capture :on-drag-over-capture :on-drag-start-capture
+                  :on-drop-capture :on-focus-capture :on-input-capture :on-key-down-capture :on-key-press-capture :on-key-up-capture :on-mouse-down-capture
+                  :on-mouse-enter-capture :on-mouse-leave-capture :on-mouse-move-capture :on-mouse-out-capture :on-mouse-over-capture :on-mouse-up-capture
+                  :on-paste-capture :on-scroll-capture :on-submit-capture :on-touch-cancel-capture :on-touch-end-capture :on-touch-move-capture
+                  :on-touch-start-capture :on-wheel-capture})

 ;; Reference: http://facebook.github.io/react/docs/tags-and-attributes.html#supported-attributes


fix [:do-paused :add-event] state transition

--- src/re_frame/router.cljs
+++ src/re_frame/router.cljs
@@ -161,7 +161,7 @@
             [:paused :resume-run ]  [:do-paused #(-resume-run this)]

             ;; processing an event which previously caused the queue to be paused
-            [:do-paused :add-event  ] [:paused     #(-add-event this arg1)]
+            [:do-paused :add-event  ] [:do-paused  #(-add-event this arg1)]
             [:do-paused :exception  ] [:quiescent  #(-exception this arg1)]
             [:do-paused :done-paused] [:running    #(-run-queue this)]


message_string is nicer than string for an indentifier

--- src/riemann/campfire.clj
+++ src/riemann/campfire.clj
@@ -31,6 +31,6 @@
         camp)))"
   [token ssl sub-domain room-name]
   (fn [e]
-    (let [string (campfire_message e)
+    (let [message_string (campfire_message e)
           settings (cf-settings token ssl sub-domain)]
-      (cf/message (room settings room-name) string))))
+      (cf/message (room settings room-name) message_string))))


Add `prim-keys` to table description

Add `prim-keys` to table description

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -188,6 +188,8 @@
   java.util.HashMap   (as-map [m] (utils/keyword-map as-map m))

   AttributeValue      (as-map [v] (db-val->clj-val v))
+  AttributeDefinition (as-map [d] {:name (keyword       (.getAttributeName d))
+                                   :type (utils/un-enum (.getAttributeType d))})
   KeySchemaElement    (as-map [e] {:name (keyword (.getAttributeName e))
                                    :type (utils/un-enum (.getKeyType e))})
   KeysAndAttributes
@@ -230,10 +232,17 @@
                  :creation-date (.getCreationDateTime t)
                  :item-count    (.getItemCount t)
                  :size          (.getTableSizeBytes t)
-                 :key-schema    (as-map (.getKeySchema t))
                  :throughput    (as-map (.getProvisionedThroughput t))
                  :indexes       (as-map (.getLocalSecondaryIndexes t))
-                 :status        (utils/un-enum (.getTableStatus t))}))
+                 :status        (utils/un-enum (.getTableStatus t))
+                 :prim-keys
+                 (let [schema (as-map (.getKeySchema t))
+                       defs   (as-map (.getAttributeDefinitions t))]
+                   (merge-with merge
+                     (reduce-kv (fn [m k v] (assoc m (:name v) {:key-type  (:type v)}))
+                                {} schema)
+                     (reduce-kv (fn [m k v] (assoc m (:name v) {:data-type (:type v)}))
+                                {} defs)))}))

   LocalSecondaryIndexDescription
   (as-map [d] {:name       (keyword (.getIndexName d))


Use the facing-block function instead of a bunch of java calls

--- src/memorystone/core.clj
+++ src/memorystone/core.clj
@@ -3,7 +3,8 @@
   (:require [cljminecraft.player :as pl])
   (:require [cljminecraft.bukkit :as bk])
   (:require [cljminecraft.logging :as log]
-            [cljminecraft.commands :as cmd])
+            [cljminecraft.commands :as cmd]
+            [cljminecraft.world :as w])
   (:require [cljminecraft.files :as files]))

 (defonce plugin (atom nil))
@@ -69,12 +70,8 @@
 (defn go-command [sender memorystone]
   (when memorystone
     (log/info "Teleporting %s to %s " sender memorystone)
-    (let [block (:block memorystone)
-          sign-face (.. block getState getData getFacing)]
-      (log/info "Block: %s" block)
-      (log/info "Sign-face: %s" block)
-      (.teleport sender (.getLocation (.getFace block sign-face)))
-      {:msg "Teleported"})))
+    (.teleport sender (.getLocation (w/facing-block (:block memorystone))))
+    {:msg "Teleported"}))

 ;; Plugin lifecycle


remove comment

remove comment

--- src/server/core.cljs
+++ src/server/core.cljs
@@ -459,7 +459,6 @@
       #(.leave socket "mc"))

     ; Start the game
-    #_(.on socket "start-lines" #(close! if-not @game-mode (go-go-game! io :line)))
     (.on socket "start-time" #(close! @start-game-chan))

     ; Stop the game.


Display dialog for adding new word into the Glossary

--- src/zg/html_renderer.clj
+++ src/zg/html_renderer.clj
@@ -296,7 +296,6 @@
         ]
         [:br]
         [:br]
-        (comment
         (form/form-to [:post (str url-prefix "add-word-to-glossary")]
                 [:table {:style "border-collapse: separate; border-spacing: 10px;"}
                     [:tr [:td [:div {:class "_label _label-primary"} "New word:"]]
@@ -320,7 +319,7 @@
                     [:tr [:td " "]
                          [:td " "]
                          [:td (form/submit-button {:class "btn btn-primary"} "Add new word")]]]
-                [:br]))
+                [:br])
         [:br]])

 (defn yes-no


Remove console clutter

Remove console clutter

--- src/yada/swagger.clj
+++ src/yada/swagger.clj
@@ -30,20 +30,10 @@
   Keyword (encode [k] (str "{" (name k) "}")))

 (defn- to-path [route]
-  #_(infof "to-path arg is %s" (pr-str route))
   (let [path (->> route :path (map encode) (apply str))
         http-resource (-> route :handler :delegate)
         {:keys [resource options methods parameters representations]} http-resource
         swagger (:swagger options)]
-    (infof "path is %s" path)
-    (infof "http-resource is %s" http-resource)
-
-    (infof "resource is %s" resource)
-    #_(infof "options is %s" options)
-    (infof "methods is %s" methods)
-    (infof "parameters is %s" parameters)
-    (infof "representations is %s" (pr-str (map #(dissoc % :charset) representations)))
-
     [path
      (merge-with merge
                  (into {}


Create data only message if event has no title and body.

--- src/forces_assemble/handler.clj
+++ src/forces_assemble/handler.clj
@@ -41,13 +41,18 @@

 (defn build-notification
   [event client]
-  {:to client
-   :priority "high"
-   :collapse_key (:id event)
-   :data (or (:data event) {})
-   :notification {:title (or (:title event) "")
-                  :body (or (:body event) "")
-                  :sound "default"}})
+  (let [title (:title event)
+        body (:body event)
+        notification {:to client
+                      :priority "high"
+                      :collapse_key (:id event)
+                      :data (or (:data event) {})
+                      :notification {:title (or (:title event) "")
+                                     :body (or (:body event) "")
+                                     :sound "default"}}]
+    (if (every? cstr/blank? [title body])
+      (dissoc notification :notification)
+      notification)))

 (defn push-event
   [channel-id event]


Fix y-axis unit labels.

Fix y-axis unit labels.

--- src-cljs/kixi/hecuba/widgets/chart.cljs
+++ src-cljs/kixi/hecuba/widgets/chart.cljs
@@ -166,17 +166,17 @@
           (.attr "transform" "translate(-15,0)")
           (.call y-axis-left)
           (.append "svg:text")
-          (.attr "y" 20)
-          (.attr "dx" "-3em")
-          (.style "text-anchor" "start")
+          (.attr "y" 0)
+          (.attr "dx" "-.7em")
+          (.style "text-anchor" "end")
           (.text unit-left))
       (-> (.append "svg:g")
           (.attr "class" "y axis axisRight")
           (.attr "transform" (str "translate(" (+ 15 width) ",0)"))
           (.call y-axis-right)
           (.append "svg:text")
-          (.attr "y" 20)
-          (.attr "dx" ".5em")
+          (.attr "y" 0)
+          (.attr "dx" ".7em")
           (.style "text-anchor" "start")
           (.text unit-right)))


Spiral challenge

Spiral challenge

--- src/main/cljc/clojure_club/spiral_challenge/mbastian.cljc
+++ src/main/cljc/clojure_club/spiral_challenge/mbastian.cljc
@@ -1,14 +1,49 @@
-(ns clojure-club.spiral-challenge.mbastian)
+(ns clojure-club.spiral-challenge.mbastian
+  (:require [clojure.string :as cs]))

-
-(def seed [[0]])
-
-(def dirs [[1 0] [0 1] [-1 0] [0 -1]])
+(def dirs [[0 -1] [1 0] [0 1] [-1 0]])

 (def dir-map (zipmap dirs (drop 1 (cycle dirs))))

-(defn step [{:keys [grid dir loc f]}]
-  (let [turn? (nil? (get-in grid (mapv + loc (dirs dir))))]
-    {:grid grid :dir dir :loc n f}))
+(defn punch-out [{:keys [dir] :as m}]
+  (case dir
+    [1 0] (update m :max-x inc)
+    [0 1] (update m :max-y inc)
+    [-1 0] (update m :min-x dec)
+    [0 -1] (update m :min-y dec)))

-(step {:grid [[0]] :dir [1 0] :loc [0 0] :f inc})+(defn spiral-step [{:keys [min-x max-x min-y max-y dir loc] :as m}]
+  (let [[cx cy :as n] (mapv + (peek loc) dir)]
+    (cond-> (update m :loc conj n)
+            (or (< cx min-x) (< cy min-y) (> cx max-x) (> cy max-y))
+            (-> punch-out (update :dir dir-map)))))
+
+(def spiral-seq
+  (iterate spiral-step {:loc [[0 0]] :min-x 0 :max-x 0 :min-y 0 :max-y 0 :dir [1 0]}))
+
+(defn construct-grid [{:keys [min-x max-x min-y max-y]}]
+  (let [r (vec (repeat (inc (- max-x min-x)) nil))]
+    (vec (repeat (inc (- max-y min-y)) r))))
+
+(def fib-seq (map first (iterate (fn [[a b]] [b (+ a b)]) [1 1])))
+
+(defn char-sqrs
+  ([] (char-sqrs 2N))
+  ([n] (let [digits (reverse (map (comp #(Long/parseLong %) str) (seq (str n))))]
+         (lazy-seq (reduce (fn [s digit] (cons digit s)) (char-sqrs (* n n)) digits)))))
+
+(defn grid-sum [grid [x y :as coord]]
+  (let [xs ((juxt inc inc identity dec dec dec identity inc) x)
+        ys ((juxt identity inc inc inc identity dec dec dec) y)
+        neighbors (map vector xs ys)]
+    (max 1 (reduce + (map #(or (get-in grid (rseq %)) 0) neighbors)))))
+
+(defn generate-spiral [f n]
+  (let [{:keys [min-x min-y loc] :as s} (nth spiral-seq n)
+        locs (mapv #(mapv - % [min-x min-y]) loc)
+        grid (construct-grid s)]
+    (reduce (fn [g loc] (assoc-in g (rseq loc) (f g loc))) grid locs)))
+
+(defn print! [grid]
+  (doseq [row (rseq grid)]
+    (prn row)))


Formatting

Formatting

--- src/cljs/cglossa/search_inputs/cwb.cljs
+++ src/cljs/cglossa/search_inputs/cwb.cljs
@@ -103,23 +103,29 @@
                         simple)
         languages     (:langs @corpus)
         multilingual? (> (count languages) 1)
-        set-view (fn [view e] (reset! search-view view) (.preventDefault e))]
+        set-view      (fn [view e] (reset! search-view view) (.preventDefault e))]
     [:span
      [:div.search-input-links
       (if (= view simple)
         [:b "Simple"]
-        [:a {:href "" :title "Simple search box"
-             :on-click #(set-view :simple %)} "Simple"])
+        [:a {:href     ""
+             :title    "Simple search box"
+             :on-click #(set-view :simple %)}
+         "Simple"])
       " | "
       (if (= view extended)
         [:b "Extended"]
-        [:a {:href "" :title "Search for grammatical categories etc."
-             :on-click #(set-view :extended %)} "Extended"])
+        [:a {:href     ""
+             :title    "Search for grammatical categories etc."
+             :on-click #(set-view :extended %)}
+         "Extended"])
       " | "
       (if (= view cqp)
         [:b "CQP query"]
-        [:a {:href "" :title "CQP expressions"
-             :on-click #(set-view :cqp %)} "CQP query"])
+        [:a {:href     ""
+             :title    "CQP expressions"
+             :on-click #(set-view :cqp %)}
+         "CQP query"])
       [search-button multilingual?]
       (when multilingual? [add-language-button])]


set alpha func

set alpha func

--- src/cljs/infinitelives/pixi/sprite.cljs
+++ src/cljs/infinitelives/pixi/sprite.cljs
@@ -38,6 +38,9 @@
 (defn set-anchor! [sprite x y]
   (set! (.-anchor sprite) (make-point x y)))

+(defn set-alpha! [sprite alpha]
+  (set! (.-alpha sprite) alpha))
+
 (defn set-pivot! [sprite x y]
   (set! (.-pivot.x sprite) x)
   (set! (.-pivot.y sprite) y))


More rendering precision

More rendering precision

--- src/cljs/mandelbrot_cljs/rendering.cljs
+++ src/cljs/mandelbrot_cljs/rendering.cljs
@@ -58,7 +58,7 @@
         screen-height            (.-height canvas)
         {:keys [x0 y0 scale]}    (enclosing-rectangle x0 y0 width height screen-width screen-height)

-        max-iterations           (int (+ 100 (* (Math/log scale) (Math/log scale)))) ; Sensible?
+        max-iterations           (int (+ 200 (/ (Math/pow (Math/log scale) 3) 10))) ; Sensible?
         start                    (.getTime (js/Date.))

         context                  (.getContext canvas "2d")


Remove unused imports on impl/handlers.

Remove unused imports on impl/handlers.

--- src/clojure/catacumba/impl/handlers.clj
+++ src/clojure/catacumba/impl/handlers.clj
@@ -57,9 +57,7 @@
            ratpack.exec.Blocking
            ratpack.registry.Registry
            org.apache.commons.io.IOUtils
-           org.reactivestreams.Publisher
-           io.netty.buffer.Unpooled
-           io.netty.buffer.ByteBuf))
+           org.reactivestreams.Publisher))

 ;; --- Base Handling Protocols


Make :age-mediated-parent-selection work for all selection methods.

--- src/clojush/pushgp/parent_selection.clj
+++ src/clojush/pushgp/parent_selection.clj
@@ -7,10 +7,10 @@
 (defn tournament-selection
   "Returns an individual that does the best out of a tournament."
   [pop location {:keys [tournament-size total-error-method]}]
-  (let [tournament-set
-        (doall
-          (for [_ (range tournament-size)]
-            (lrand-nth pop)))
+  (let [subpop (age-mediate pop argmap)
+        tournament-set (doall
+                         (for [_ (range tournament-size)]
+                           (lrand-nth subpop)))
         err-fn (case total-error-method
                  :sum :total-error
                  (:hah :rmse :ifs) :weighted-error
@@ -165,7 +165,10 @@
 (defn elitegroup-lexicase-selection
   "Returns an individual produced by elitegroup lexicase selection."
   [pop]
-  (loop [survivors (retain-one-individual-per-error-vector pop)
+  (loop [survivors (retain-one-individual-per-error-vector
+                     (possibly-remove-individuals-with-empty-genomes
+                       (age-mediate pop argmap)
+                       argmap))
          cases (lshuffle (map lrand-nth @elitegroups))]
     (if (or (empty? cases)
             (empty? (rest survivors)))
@@ -223,7 +226,7 @@
 (defn uniform-selection
   "Returns an individual uniformly at random."
   [pop]
-  (lrand-nth pop))
+  (lrand-nth (age-mediate pop argmap)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; parent selection
@@ -252,9 +255,3 @@
                                                                (inc sel-count)))))
     selected))

-
-
-
-
-
-