@cochrane343 add title to all pages

@cochrane343 add title to all pages

--- src/cljs/conference_rating/core.cljs
+++ src/cljs/conference_rating/core.cljs
@@ -37,6 +37,8 @@
 (defn mount-root []
   (reagent/render [current-page] (.getElementById js/document "app")))

+(set! (. js/document -title) "conference voices")
+
 (defn init! []
   (history/hook-browser-navigation!)
   (mount-root))


Fixing up some opentracing issues and adding more spans to the match cycle (#2111)

* Fixing up some opentracing issues and adding more spans to the match cycle

* Addressing review feedback

* Removing unused import

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -685,48 +685,50 @@
 (defn generate-user-usage-map
   "Returns a mapping from user to usage stats"
   [unfiltered-db pool-name]
-  (timers/time!
-    generate-user-usage-map-duration
-    (->> (tools/get-running-task-ents unfiltered-db)
-         (map :job/_instance)
-         (remove #(not= pool-name (cached-queries/job->pool-name %)))
-         (group-by :job/user)
-         (pc/map-vals (fn [jobs]
-                        (->> jobs
-                             (map tools/job->usage)
-                             (reduce (partial merge-with +))))))))
+  (tracing/with-span [s {:name "scheduler.generate-user-usage-map"
+                         :tags {:pool pool-name :component tracing-component-tag}}]
+    (timers/time!
+      generate-user-usage-map-duration
+      (->> (tools/get-running-task-ents unfiltered-db)
+           (map :job/_instance)
+           (remove #(not= pool-name (cached-queries/job->pool-name %)))
+           (group-by :job/user)
+           (pc/map-vals (fn [jobs]
+                          (->> jobs
+                               (map tools/job->usage)
+                               (reduce (partial merge-with +)))))))))

 (defn pending-jobs->considerable-jobs
   "Limit the pending jobs to considerable jobs based on usage and quota.
    Further limit the considerable jobs to a maximum of num-considerable jobs."
   [db pending-jobs user->quota user->usage num-considerable pool-name]
-  (tracing/with-span [s {:name "scheduler.pending-jobs-to-considerable" :num-pending-jobs pending-jobs
-                         :tags {:pool pool-name :component tracing-component-tag}}])
-  (log-structured/debug (print-str "There are pending jobs:" pending-jobs)
-                        {:pool pool-name :num-pending-jobs (count pending-jobs)})
-  (let [enforcing-job-launch-rate-limit? (ratelimit/enforce? quota/per-user-per-pool-launch-rate-limiter)
-        user->rate-limit-count (atom {})
-        user->passed-count (atom {})
-        considerable-jobs
-        (->> pending-jobs
-             (tools/filter-pending-jobs-for-quota pool-name user->rate-limit-count user->passed-count
-                                                  user->quota user->usage
-                                                  (tools/global-pool-quota (config/pool-quotas) pool-name))
-             (filter (fn [job] (tools/job-allowed-to-start? db job)))
-             (filter launch-plugin/filter-job-launches)
-             (take num-considerable)
-             ; Force this to be taken eagerly so that the log line is accurate.
-             (doall))]
-    (swap! tools/pool->user->num-rate-limited-jobs update pool-name (constantly @user->rate-limit-count))
-    (log-structured/info "Job launch rate-limiting"
-              {:enforcing-job-launch-rate-limit? enforcing-job-launch-rate-limit?
-               :total-rate-limit-count (->> @user->rate-limit-count vals (reduce +))
-               :user->rate-limit-count @user->rate-limit-count
-               :total-passed-count (->> @user->passed-count vals (reduce +))
-               :user->passed-count @user->passed-count
-               :pool pool-name})
-    (tracing/set-tags {:num-considerable (count considerable-jobs)})
-    considerable-jobs))
+  (tracing/with-span [s {:name "scheduler.pending-jobs-to-considerable"
+                         :tags {:pool pool-name :component tracing-component-tag :num-pending-jobs pending-jobs}}]
+    (log-structured/debug (print-str "There are pending jobs:" pending-jobs)
+                          {:pool pool-name :num-pending-jobs (count pending-jobs)})
+    (let [enforcing-job-launch-rate-limit? (ratelimit/enforce? quota/per-user-per-pool-launch-rate-limiter)
+          user->rate-limit-count (atom {})
+          user->passed-count (atom {})
+          considerable-jobs
+          (->> pending-jobs
+               (tools/filter-pending-jobs-for-quota pool-name user->rate-limit-count user->passed-count
+                                                    user->quota user->usage
+                                                    (tools/global-pool-quota (config/pool-quotas) pool-name))
+               (filter (fn [job] (tools/job-allowed-to-start? db job)))
+               (filter launch-plugin/filter-job-launches)
+               (take num-considerable)
+               ; Force this to be taken eagerly so that the log line is accurate.
+               (doall))]
+      (swap! tools/pool->user->num-rate-limited-jobs update pool-name (constantly @user->rate-limit-count))
+      (log-structured/info "Job launch rate-limiting"
+                {:enforcing-job-launch-rate-limit? enforcing-job-launch-rate-limit?
+                 :total-rate-limit-count (->> @user->rate-limit-count vals (reduce +))
+                 :user->rate-limit-count @user->rate-limit-count
+                 :total-passed-count (->> @user->passed-count vals (reduce +))
+                 :user->passed-count @user->passed-count
+                 :pool pool-name})
+      (tracing/set-tags {:num-considerable (count considerable-jobs)})
+      considerable-jobs)))

 (defn matches->jobs
@@ -1024,22 +1026,24 @@
   compute-cluster->jobs map. That is the API any future
   improvements need to stick to."
   [autoscalable-jobs pool-name compute-clusters job->acceptable-compute-clusters-fn]
-  (let [compute-cluster->jobs
-        (group-by
-          (fn choose-compute-cluster-for-autoscaling
-            [{:keys [job/uuid] :as job}]
-            (let [preferred-compute-clusters
-                  (job->acceptable-compute-clusters-fn job compute-clusters)]
-              (if (empty? preferred-compute-clusters)
-                :no-acceptable-compute-cluster
-                (nth preferred-compute-clusters
-                     (-> uuid hash (mod (count preferred-compute-clusters)))))))
-          autoscalable-jobs)]
-    (when-let [jobs (:no-acceptable-compute-cluster compute-cluster->jobs)]
-      (log-structured/info "There are jobs with no acceptable compute cluster for autoscaling"
-                           {:pool pool-name
-                            :first-ten-jobs (print-str (->> jobs (take 10) (map :job/uuid) (map str)))}))
-    (dissoc compute-cluster->jobs :no-acceptable-compute-cluster)))
+  (tracing/with-span [s {:name "scheduler.distribute-jobs-to-compute-cluster"
+                         :tags {:pool pool-name :component tracing-component-tag}}]
+    (let [compute-cluster->jobs
+          (group-by
+            (fn choose-compute-cluster-for-autoscaling
+              [{:keys [job/uuid] :as job}]
+              (let [preferred-compute-clusters
+                    (job->acceptable-compute-clusters-fn job compute-clusters)]
+                (if (empty? preferred-compute-clusters)
+                  :no-acceptable-compute-cluster
+                  (nth preferred-compute-clusters
+                       (-> uuid hash (mod (count preferred-compute-clusters)))))))
+            autoscalable-jobs)]
+      (when-let [jobs (:no-acceptable-compute-cluster compute-cluster->jobs)]
+        (log-structured/info "There are jobs with no acceptable compute cluster for autoscaling"
+                             {:pool pool-name
+                              :first-ten-jobs (print-str (->> jobs (take 10) (map :job/uuid) (map str)))}))
+      (dissoc compute-cluster->jobs :no-acceptable-compute-cluster))))

 (defn trigger-autoscaling!
   "Autoscales the given pool to satisfy the given pending jobs, if:
@@ -1136,7 +1140,7 @@
   (let [offer-stash (atom nil)] ;; This is a way to ensure we never lose offers fenzo assigned if an error occurs in the middle of processing
     ;; TODO: It is possible to have an offer expire by mesos because we recycle it a bunch of times.
     ;; TODO: If there is an exception before offers are sent to fenzo (scheduleOnce) then the offers will be lost. This is fine with offer expiration, but not great.
-    (tracing/with-span [s {:name "scheduler.handle-resource-offers" :tags {:pool pool-name :tags {:component tracing-component-tag}}}]
+    (tracing/with-span [s {:name "scheduler.handle-resource-offers" :tags {:pool pool-name :component tracing-component-tag}}]
       (timers/time!
         (timers/timer (metric-title "handle-resource-offer!-duration" pool-name))
         (try
@@ -1311,11 +1315,14 @@
                                                       (max number-unmatched-jobs)) ; Autoscale at least the pods that failed to match.
                   ;; We need to filter pending jobs based on quota so that we don't
                   ;; trigger autoscaling beyond what users have quota to actually run
-                  autoscalable-jobs (->> pool-name
-                                         (get @pool-name->pending-jobs-atom)
-                                         (tools/filter-pending-jobs-for-quota pool-name (atom {}) (atom {})
-                                                                              user->quota user->usage (tools/global-pool-quota (config/pool-quotas) pool-name))
-                                         (take max-jobs-for-autoscaling-scaled))
+                  autoscalable-jobs (tracing/with-span [s {:name "scheduler.handle-resource-offers.generate-autoscalable-jobs"
+                                                           :tags {:pool pool-name :component tracing-component-tag}}]
+                                                       (->> pool-name
+                                                            (get @pool-name->pending-jobs-atom)
+                                                            (tools/filter-pending-jobs-for-quota pool-name (atom {}) (atom {})
+                                                                                user->quota user->usage (tools/global-pool-quota (config/pool-quotas) pool-name))
+                                                            (take max-jobs-for-autoscaling-scaled)
+                                                            (doall)))
                   filtered-autoscalable-jobs (remove #(.getIfPresent caches/recent-synthetic-pod-job-uuids (:job/uuid %)) autoscalable-jobs)]
               ; When we have at least a minimum number of jobs being looked at, metric which fraction have matched.
               ; This lets us measure how well we're matching on existing resources.
@@ -1405,7 +1412,8 @@
                           ;;  2. Once the above two items are addressed, user->usage should always correctly
                           ;;     reflect *Cook*'s understanding of the state of the world at this point.
                           ;;     When this happens, users should never exceed their quota
-                          user->usage-future (future (generate-user-usage-map (d/db conn) pool-name))
+                          user->usage-future (future (tracing/with-span [s1 {:from s :finish? false}] ; NOTE: finish? is set to false to prevent early finishing of the span
+                                                                        (generate-user-usage-map (d/db conn) pool-name)))
                           ;; Try to clear the channel
                           ;; Merge the pending offers from all compute clusters.
                           compute-clusters (vals @cook.compute-cluster/cluster-name->compute-cluster-atom)
@@ -1421,20 +1429,25 @@
                                                                                t)
                                                                              (list))))
                                                                        compute-clusters)))
-                          _ (doseq [offer offers
-                                    :let [slave-id (-> offer :slave-id :value)]]
-                              ; Cache offers for rebalancer so it can use job constraints when doing preemption decisions.
-                              ; Computing get-offer-attr-map is pretty expensive because it includes calculating
-                              ; currently running pods, so we have to union the set of pods k8s says are there and
-                              ; the set of pods we're trying to put on the node. Even though it's not used by
-                              ; rebalancer (and not needed). So it's OK if it's stale, so we do not need to refresh
-                              ; and only store if it is a new node.
-                              (when-not (ccache/get-if-present agent-attributes-cache identity slave-id)
-                                (ccache/put-cache! agent-attributes-cache identity slave-id (offer/get-offer-attr-map offer))))
+                          _ (tracing/with-span [s {:name "scheduler.offer-handler.cache-offers-for-rebalancer"
+                                                   :tags {:pool pool-name :component tracing-component-tag}}]
+                                               (doseq [offer offers
+                                                       :let [slave-id (-> offer :slave-id :value)]]
+                                                 ; Cache offers for rebalancer so it can use job constraints when doing preemption decisions.
+                                                 ; Computing get-offer-attr-map is pretty expensive because it includes calculating
+                                                 ; currently running pods, so we have to union the set of pods k8s says are there and
+                                                 ; the set of pods we're trying to put on the node. Even though it's not used by
+                                                 ; rebalancer (and not needed). So it's OK if it's stale, so we do not need to refresh
+                                                 ; and only store if it is a new node.
+                                                 (when-not (ccache/get-if-present agent-attributes-cache identity slave-id)
+                                                   (ccache/put-cache! agent-attributes-cache identity slave-id (offer/get-offer-attr-map offer)))))
                           using-pools? (not (nil? (config/default-pool)))
                           user->quota (quota/create-user->quota-fn (d/db conn) (if using-pools? pool-name nil))
+                          user->usage (tracing/with-span [s {:name "scheduler.offer-handler.resolve-user-to-usage-future"
+                                                             :tags {:pool pool-name :component tracing-component-tag}}]
+                                                         @user->usage-future)
                           matched-head? (handle-resource-offers! conn fenzo-state pool-name->pending-jobs-atom
-                                                                 mesos-run-as-user @user->usage-future user->quota
+                                                                 mesos-run-as-user user->usage user->quota
                                                                  num-considerable offers
                                                                  rebalancer-reservation-atom pool-name compute-clusters
                                                                  job->acceptable-compute-clusters-fn)]


Name unused argument _ for more idiomatic clojure

--- clojure-http-kit/src/sse_server/core.clj
+++ clojure-http-kit/src/sse_server/core.clj
@@ -25,7 +25,7 @@
                               "Connection" "keep-alive"}
                     :body ":ok\n\n"} false)
     (swap! channel-hub assoc channel req)
-    (on-close channel (fn [status]
+    (on-close channel (fn [_]
                         (swap! channel-hub dissoc channel)))))

 (defn app [req]


Delete cluster test.

Delete cluster test.

--- test/onyx/coordinator/cluster_test.clj
+++ test/onyx/coordinator/cluster_test.clj
@@ -1,140 +0,0 @@
-(ns onyx.coordinator.cluster-test
-  (:require [clojure.test :refer :all]
-            [clojure.core.async :refer [chan <!! >!! <! >! tap go timeout]]
-            [clojure.data.generators :as gen]
-            [com.stuartsierra.component :as component]
-            [datomic.api :as d]
-            [onyx.system :as s]
-            [onyx.coordinator.extensions :as extensions]
-            [onyx.coordinator.log.datomic :as datomic]
-            [onyx.coordinator.sim-test-utils :refer [with-system]]))
-
-
-(defn start-peers! [peers coordinator sync-storage]
-  (doseq [peer peers]
-    (go (try
-          (let [payload (extensions/create sync-storage :payload)
-                sync-spy (chan 1)
-                status-spy (chan 1)]
-            (extensions/write-place sync-storage peer payload)
-            (extensions/on-change sync-storage payload #(go (>! sync-spy %)))
-
-            (>! (:born-peer-ch-head coordinator) peer)
-
-            (loop [payload-node payload]
-              (<! (timeout (rand-nth (range 800))))
-              (<! sync-spy)
-
-              (let [nodes (:nodes (extensions/read-place sync-storage payload-node))]
-                (extensions/on-change sync-storage (:status nodes) #(go (>! status-spy %)))
-                (extensions/touch-place sync-storage (:ack nodes))
-                (<! status-spy)
-                (<! (timeout (rand-nth (range 1200))))
-
-                (let [next-payload (extensions/create sync-storage :payload)]
-                  (extensions/write-place sync-storage peer next-payload)
-                  (extensions/on-change sync-storage next-payload #(go (>! sync-spy %)))
-                  (extensions/touch-place sync-storage (:completion nodes))
-
-                  (recur next-payload)))))
-          (catch Exception e (prn e))))))
-
-(defn run-cluster [n-jobs n-peers]
-  (with-system
-    (fn [coordinator sync-storage log]
-      (let [tx-queue (d/tx-report-queue (:conn log))
-            offer-spy (chan 10000)
-
-            catalog [{:onyx/name :in
-                      :onyx/direction :input
-                      :onyx/consumption :sequential
-                      :onyx/type :queue
-                      :onyx/medium :hornetq
-                      :hornetq/queue-name "in-queue"}
-                     {:onyx/name :inc
-                      :onyx/type :transformer
-                      :onyx/consumption :sequential}
-                     {:onyx/name :out
-                      :onyx/direction :output
-                      :onyx/consumption :sequential
-                      :onyx/type :queue
-                      :onyx/medium :hornetq
-                      :hornetq/queue-name "out-queue"}]
-            workflow {:in {:inc :out}}
-            tasks-per-job 3]
-
-        (tap (:offer-mult coordinator) offer-spy)
-
-        (doseq [_ (range n-jobs)]
-          (>!! (:planning-ch-head coordinator) {:catalog catalog :workflow workflow}))
-
-        (doseq [_ (range n-jobs)]
-          (<!! offer-spy))
-
-        (let [peers (take n-peers (repeatedly (fn [] (extensions/create sync-storage :peer))))]
-          (start-peers! peers coordinator sync-storage)
-          (testing "All tasks complete"
-
-            (loop []
-              (let [db (:db-after (.take tx-queue))
-                    query '[:find (count ?task) :where [?task :task/complete? true]]
-                    result (ffirst (d/q query db))]
-                (prn result)
-                (when-not (= result (* n-jobs tasks-per-job))
-                  (recur)))))
-
-          (d/db (:conn log)))))
-    {:eviction-delay 500000}))
-
-
-(deftest small-even-cluster
-  (let [n-jobs 15
-        n-peers 10
-        tasks-per-job 3
-        result-db (run-cluster n-jobs n-peers)]
-
-    (testing "No tasks are left incomplete"
-      (task-completeness result-db))
-
-    (testing "No sequential task ever had more than 1 peer"
-      (task-safety result-db))
-
-    (testing "No peers got 0 tasks"
-      (peer-liveness result-db n-peers))
-
-    (testing "All peers got a roughly even number of tasks assigned"
-      (peer-fairness result-db n-peers n-jobs tasks-per-job))))
-
-(deftest small-cluster-many-jobs
-  (let [n-jobs 150
-        n-peers 10
-        tasks-per-job 3
-        result-db (run-cluster n-jobs n-peers)]
-
-    (testing "No tasks are left incomplete"
-      (task-completeness result-db))
-
-    (testing "No sequential task ever had more than 1 peer"
-      (task-safety result-db))
-
-    (testing "No peers got 0 tasks"
-      (peer-liveness result-db n-peers))
-
-    (testing "All peers got a roughly even number of tasks assigned"
-      (peer-fairness result-db n-peers n-jobs tasks-per-job))))
-
-(deftest big-cluster-few-jobs
-  (let [n-jobs 10
-        n-peers 200
-        tasks-per-job 3
-        result-db (run-cluster n-jobs n-peers)]
-
-    (testing "No tasks are left incomplete"
-      (task-completeness result-db))
-
-    (testing "No sequential task ever had more than 1 peer"
-      (task-safety result-db))))
-
-(run-tests 'onyx.coordinator.cluster-test)
-
-


Update builtins.clj

Update builtins.clj

--- src/iyye/subcon/knowledge/builtins.clj
+++ src/iyye/subcon/knowledge/builtins.clj
@@ -89,7 +89,7 @@

 (defn- create-entry [entry] {(:Uname (:atom entry)) entry})

-(defn- init-builtin-words []
+(defn init-builtin-words []
   (let [actor (words/create-iyye-type "actor" true)
         ai (words/create-iyye-type "ai" true)
         iyye (words/create-iyye-type "iyye" true)
@@ -104,7 +104,7 @@
                    (create-entry ai) (create-entry iyye) (create-entry human)
                    (create-entry yumzya)))))

-(defn- init-builtin-relations []
+(defn init-builtin-relations []
   (let [t_is (create-iyye-builtin-relation "is" ["type" "type"] iyye_is_type_function iyye_is_type_predicate_function)
         t_is2 (create-iyye-builtin-relation "is" [:UNKNOWN "type"] iyye_is_type_create_function iyye_is_type_predicate_function)
         consistsof (create-iyye-builtin-relation "consists" [] iyye_consists_function iyye_is_type_predicate_function)
@@ -114,7 +114,7 @@
     (dosync (ref-set iyye_create_instance instof))
     (dosync (alter words/action-words conj (create-entry t_is) (create-entry t_is2) (create-entry consistsof) (create-entry instof)))))

-(defn- apply-builtin-relations []
+(defn apply-builtin-relations []
   (do
     ((:Function @iyye_is_type) @iyye_ai @iyye_actor)
     ((:Function @iyye_is_type) @iyye_human @iyye_actor)


clean up file list

clean up file list

--- src/leiningen/new/reagent_liveedit.clj
+++ src/leiningen/new/reagent_liveedit.clj
@@ -8,27 +8,25 @@
   (let [data {:name name
               :ns-name (sanitize-ns name)
               :sanitized (name-to-path name)}]
-    (->files data ["src/env/dev/cljs/{{sanitized}}/dev.cljs" (render "dev.cljs" data)]
-["src/cljs/{{sanitized}}/core.cljs" (render "core.cljs" data)]
-["src/styles/{{sanitized}}/styles/dev.clj" (render "dev.clj" data)]
-["src/clj/{{sanitized}}/server/handler.clj" (render "handler.clj" data)]
-["test/{{sanitized}}/core_test.cljs" (render "core_test.cljs" data)]
-["src/env/dev/cljs/{{sanitized}}/testrunner.cljs" (render "testrunner.cljs" data)]
-["src/clj/{{sanitized}}/server/services.clj" (render "services.clj" data)]
-["src/cljs/{{sanitized}}/test.cljs" (render "test.cljs" data)]
-["src/cljs/{{sanitized}}/state.cljs" (render "state.cljs" data)]
-["src/env/prod/cljs/{{sanitized}}/prod.cljs" (render "prod.cljs" data)]
-["src/clj/{{sanitized}}/server/services.clj" (render "services.clj" data)]
-["test/{{sanitized}}/test_macros.clj" (render "test_macros.clj" data)]
-["src/cljs/{{sanitized}}/state.cljs" (render "state.cljs" data)]
-["src/cljs/{{sanitized}}/test.cljs" (render "test.cljs" data)]
-["project.clj" (render "project.clj" data)]
-["src/styles/{{sanitized}}/styles/site.clj" (render "site.clj" data)]
-["src/clj/{{sanitized}}/server/handler.clj" (render "handler.clj" data)]
-["src/cljs/{{sanitized}}/core.cljs" (render "core.cljs" data)]
-["resources/public/index.html" (render "index.html" data)]
-["README.md" (render "README.md")]
-[".gitignore" (render ".gitignore")]
-["LICENSE" (render "LICENSE")]
-["resources/templates/js/function_prototype_polyfill.js" (render "function_prototype_polyfill.js")]
+    (->files
+     data
+     ["src/env/dev/cljs/{{sanitized}}/dev.cljs" (render "dev.cljs" data)]
+     ["project.clj" (render "project.clj" data)]
+     ["README.md" (render "README.md")]
+     ["LICENSE" (render "LICENSE")]
+     [".gitignore" (render ".gitignore")]
+     ["src/cljs/{{sanitized}}/core.cljs" (render "core.cljs" data)]
+     ["src/cljs/{{sanitized}}/state.cljs" (render "state.cljs" data)]
+     ["src/cljs/{{sanitized}}/test.cljs" (render "test.cljs" data)]
+     ["src/clj/{{sanitized}}/server/handler.clj" (render "handler.clj" data)]
+     ["src/clj/{{sanitized}}/server/services.clj" (render "services.clj" data)]
+     ["src/env/dev/cljs/{{sanitized}}/testrunner.cljs" (render "testrunner.cljs" data)]
+     ["src/env/prod/cljs/{{sanitized}}/prod.cljs" (render "prod.cljs" data)]
+     ["src/styles/{{sanitized}}/styles/dev.clj" (render "dev.clj" data)]
+     ["src/styles/{{sanitized}}/styles/site.clj" (render "site.clj" data)]
+     ["test/{{sanitized}}/core_test.cljs" (render "core_test.cljs" data)]
+     ["test/{{sanitized}}/test_macros.clj" (render "test_macros.clj" data)]
+     ["resources/public/index.html" (render "index.html" data)]
+
+     ["resources/templates/js/function_prototype_polyfill.js" (render "function_prototype_polyfill.js")]
 )))


remove debugging

remove debugging

--- server/src/gratefulplace/db/manage.clj
+++ server/src/gratefulplace/db/manage.clj
@@ -75,7 +75,6 @@
   (ensure-schema-attribute conn schema-attr)
   (doseq [schema-name schema-names]
     (when-not (has-schema? (d/db conn) schema-attr schema-name)
-      (println schema-name schema-names)
       (let [{:keys [requires txes]} (get schema-map schema-name)]
         (apply ensure-schemas conn schema-attr schema-map requires)
         (if txes


Change the swank task to alter-var-root cake/*context* to the value requested.


prep work to have modules support foreign dependencies


Second stab

Second stab

--- src/clojush/evaluate.clj
+++ src/clojush/evaluate.clj
@@ -157,10 +157,13 @@
                                      (if (<= (first case-history) error-threshold)
                                        0 ;; solved, improvement doesn't matter
                                        (let [improvements (mapv (fn [[older-error newer-error]]
-                                                                  (max 0 (- older-error newer-error)))
+                                                                  (- older-error newer-error))
                                                                 (partition 2 1 case-history))
-                                             weights (iterate (partial * 0.5) 0.5)]
-                                         (/ 1.0 (reduce + (mapv * improvements weights)))))))))
+                                             weights (iterate (partial * 0.5) 0.5)
+                                             sum (reduce + (mapv * improvements weights))]
+                                         (if (<= sum 0)
+                                           (+ 1.0 (Math/abs sum))
+                                           (/ 1.0 sum))))))))
                           ;
                           (= cat :reproductive-fidelity)
                           (let [g (:genome ind)]


Update regex used for JS obj printing

Update regex used for JS obj printing

--- planck-cljs/src/planck/pprint/data.cljs
+++ planck-cljs/src/planck/pprint/data.cljs
@@ -64,7 +64,7 @@
       (pretty-coll this "#js [" x :line "]" visit)
       (object? x)
       (let [kvs (map (fn [k]
-                       [(cond-> k (some? (re-matches #"[A-Za-z][\w\*\+\?!\-']*" k)) keyword)
+                       [(cond-> k (some? (re-matches #"[A-Za-z_\*\+\?!\-'][\w\*\+\?!\-']*" k)) keyword)
                         (gobj/get x k)])
                   (js-keys x))]
         (pretty-coll this "#js {" kvs [:span "," :line] "}"


demages list + map legend

demages list + map legend

--- src/amindblowingworld/view_index.clj
+++ src/amindblowingworld/view_index.clj
@@ -4,9 +4,29 @@
       [page :refer [html5]]
       [page :refer [include-js include-css]]]))

-;(def map-legend []
-;  ()
-;)
+(def landscape-colors [["Settlement" 255 0 0]
+                       ["Ocean" 0 0 225]
+                       ["Iceland" 255 255 255]
+                       ["Tundra" 141 227 0]
+                       ["Alpine" 141 227 0]
+                       ["Glacier" 255 255 255]
+                       ["Grassland" 80 173 88]
+                       ["Rock Desert" 105 120 59]
+                       ["Sand Desert" 205 227 141]
+                       ["Forest" 59 120 64]
+                       ["Savanna" 171 161 27]
+                       ["Jungle" 5 227 34]])
+
+(defn landscape-color-to-table-row [landscape-name red green blue]
+  [:tr [:td {:style (format "background-color: rgb(%d,%d,%d);" red green blue)} "    "]
+       [:td landscape-name]])
+
+(defn landscape-colors-legend []
+  (map #(apply landscape-color-to-table-row %) landscape-colors))
+
+
+(defn damage-reasons [damages isChecked]
+  (map (fn [damage] [:div [:input {:type :radio :name :damage :value damage :checked isChecked} damage] [:br]]) damages))

 (defn index-page []
   (html5
@@ -18,14 +38,15 @@
       (include-css "/css/app.css")]
     [:body {:onload "initApp();"}
       [:h1 "AMindBlowingWorld"]
-      [:div#authDiv "auth here"]
       [:div#appDiv
         [:div#world.column
           [:h3 "World Map"]
           [:img#worldMap {:src "/map.png"}]]
         [:div#menu.column
-          [:h3 "Menu"]
-          [:textarea {:cols "30" :rows "30"}]]
+          [:h3 "Landscape Colours"]
+          [:table (landscape-colors-legend)]
+          [:h3 "Make damage!"]
+          [:form#damageReasons (damage-reasons ["Vulcano"] true) (damage-reasons ["Vulcano" "Earthquake" "Hunger" "Tsunami" "Tornado" "Meteor" "Russian invasion" "Crazy Putin"] false)]]
         [:div#news.column
           [:h3 "News"]
           [:select#newsList {:size 30}


Bumps version to 1.40.3-SNAPSHOT

Bumps version to 1.40.3-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.40.2"
+(defproject cook "1.40.3-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.8.0"]


Add interface overlay support.

Add interface overlay support.

Use to start implementing metronome configuration pads.

--- src/afterglow/controllers/ableton_push.clj
+++ src/afterglow/controllers/ableton_push.clj
@@ -16,8 +16,66 @@
             [taoensso.timbre :refer [info warn]])
   (:import [java.util Arrays]))

-;; TODO: Move globals into a map allocated when binding to a show, so
-;;       multiple controllers can be active at once.
+(defonce
+  ^{:private true
+    :doc "Protect protocols against namespace reloads"}
+  _PROTOCOLS_
+  (do
+    (defprotocol IOverlay
+  "An activity which takes over part of the user interface
+  while it is active."
+  (captured-controls [this]
+    "The MIDI control-change events that will be consumed by this
+  overlay while it is active, a set of integers.")
+  (captured-notes [this]
+    "The MIDI note events that will be consumed by this overlay while
+  it is active, a set of integers.")
+  (adjust-interface [this controller]
+    "Set values for the next frame of the controller interface; return
+  a falsey value if the overlay is finished and should be removed.")
+  (handle-control-change [this controller message]
+    "Called when a MIDI control-change event matching the
+  captured-controls lists has been received. Return a truthy value if
+  the overlay has consumed the event, so it should not be processed
+  further. If the special value :done is returned, it further
+  indicates the overlay is finished and should be removed.")
+  (handle-note-on [this controller message]
+    "Called when a MIDI note-on event matching the captured-notes
+  lists has been received. Return a truthy value if the overlay has
+  consumed the event, so it should not be processed further. If the
+  special value :done is returned, it further indicates the overlay is
+  finished and should be removed.")
+  (handle-note-off [this controller message]
+    "Called when a MIDI note-off event matching the captured-notes
+  lists has been received. Return a truthy value if the overlay has
+  consumed the event, so it should not be processed further. If the
+  special value :done is returned, it further indicates the overlay is
+  finished and should be removed."))))
+
+(defn add-overlay
+  "Add a temporary overlay to the interface."
+  [controller overlay]
+  (let [id (swap! (:next-overlay controller) inc)]
+    (swap! (:overlays controller) assoc id overlay)))
+
+(defn add-pad-held-feedback-overlay
+  "Builds a simple overlay which just adds something to the user
+  interface until a particular pad is released, and adds it to the
+  controller. The overlay will end when a control-change message with
+  value 0 is sent to the specified control number. Other than that,
+  all it does is call the supplied function every time the interface
+  is being updated."
+  [controller control-num f]
+  (add-overlay controller
+               (reify IOverlay
+                 (captured-controls [this] #{control-num})
+                 (captured-notes [this] #{})
+                 (adjust-interface [this controller] (f))
+                 (handle-control-change [this controller message]
+                   (when (= (:velocity message) 0)
+                     :done))
+                 (handle-note-off [this controller message])
+                 (handle-note-on [this controller message]))))

 (defn velocity-for-color
   "Given a target color, calculate the MIDI note velocity which will
@@ -182,35 +240,34 @@
                  (button-state button state color-key))]
      (midi/midi-control (:port-out controller) (:control button) state))))

-(defn track-select-state
+(defn top-pad-state
   "Calculate the numeric value that corresponds to a particular
   named state for the specified top-row pad, and (if supplied),
   named color."
-  ([x state]
-   (track-select-state x state :amber))
-  ([x state color-key]
-   {:pre [(<= 0 x 7)]}
+  ([state]
+   (top-pad-state state :amber))
+  ([state color-key]
    (let [base-value ((keyword state) monochrome-button-states)
          color-shift (or (when-not (= state :off)
                            ((keyword color-key) color-button-colors))
                          0)]
      (+ base-value color-shift))))

-(defn set-track-select-state
+(defn set-top-pad-state
   "Set one of the top-row pads to a particular state and color.
   If state is already a number, it is used as-is, otherwise it is
-  calculated using track-select-state."
+  calculated using top-pad-state."
   ([controller x state]
-   (set-track-select-state controller x state :amber))
+   (set-top-pad-state controller x state :amber))
   ([controller x state color-key]
    {:pre [(<= 0 x 7)]}
    (let [state (if (number? state)
                  state
-                 (track-select-state x state color-key))]
+                 (top-pad-state state color-key))]
      (midi/midi-control (:port-out controller) (+ x 20) state))))

-(defn set-scene-launch-color
-  "Set the color of one of the 8 scene-launch touch pads (right above
+(defn set-second-pad-color
+  "Set the color of one of the 8 second-row touch pads (right above
   the 8x8 pad of larger, velocity sensitive, pads) to the closest
   approximation available for a desired color."
   [controller x color]
@@ -255,6 +312,18 @@
       (System/arraycopy (get (:next-display controller) row) 0
                         (get (:last-display controller) row) 0 68))))

+(defn update-top-pads
+  "Sees if any of the top row of pads have changed state since
+  the interface was updated, and if so, sends the necessary MIDI
+  control values to update them on the Push."
+  [controller]
+  (doseq [x (range 8)]
+    (let [next-state (aget (:next-top-pads controller) x)]
+      (when (not= next-state
+                  (aget (:last-top-pads controller) x))
+        (set-top-pad-state controller x next-state)
+        (aset (:last-top-pads controller) x next-state)))))
+
 (defn update-text-buttons
   "Sees if any labeled buttons have changed state since the last time
   the interface was updated, and if so, sends the necessary MIDI
@@ -282,6 +351,64 @@
     (doseq [[i val] (map-indexed vector bytes)]
       (aset (get (:next-display controller) row) (+ (* cell 17) i) (util/ubyte val)))))

+(defn- interpret-tempo-tap
+  "React appropriately to a tempo tap, based on the sync mode of the
+  show metronome."
+  [controller]
+  ;; TODO: Do other things when synced.
+  ((:tap-tempo-handler controller)))
+
+(defn- enter-metronome-showing
+  "Activate the persistent metronome display, with sync and reset pads
+  illuminated."
+  [controller]
+  (swap! (:metronome-mode controller) assoc :showing true)
+  (add-overlay controller
+               (reify IOverlay
+                 (captured-controls [this] #{3 9 20 21})
+                 (captured-notes [this] #{})
+                 (adjust-interface [this controller]
+                   ;; Make the metronome button bright, since its information is active
+                   (swap! (:next-text-buttons controller)
+                          assoc (:metronome control-buttons)
+                          (button-state (:metronome control-buttons) :bright))
+
+                   ;; Add the labels for reset and sync, and light the pads
+                   (write-display-cell controller 3 0 "Reset    Manual")
+                   (aset (:next-top-pads controller) 0 (top-pad-state :dim :red))
+                   (aset (:next-top-pads controller) 1 (top-pad-state :dim :green)))
+                 (handle-control-change [this controller message]
+                   (case (:note message)
+                     3 ; Tap tempo button
+                     (when (> (:velocity message) 0)
+                       (interpret-tempo-tap controller)
+                       true)
+
+                     9 ; Metronome button
+                     (when (> (:velocity message) 0)
+                       (swap! (:metronome-mode controller) dissoc :showing)
+                       ;; Exit the overlay
+                       :done)
+
+                     20 ; Reset pad
+                     (when (> (:velocity message) 0)
+                       (rhythm/metro-phrase-start (:metronome (:show controller)) 1)
+                       (add-pad-held-feedback-overlay controller 20
+                                                      #(aset (:next-top-pads controller)
+                                                             0 (top-pad-state :bright :red)))
+                       true)
+                     21 ; Sync pad
+                     (when (> (:velocity message) 0)
+                       ;; TODO: Actually implement a new overlay
+                       (add-pad-held-feedback-overlay controller 21
+                                                      #(aset (:next-top-pads controller)
+                                                             1 (top-pad-state :bright :green)))
+                       true)))
+                 (handle-note-on [this controller message]
+                   false)
+                 (handle-note-off [this controller message]
+                   false))))
+
 (defn- update-metronome-section
   "Updates the sections of the interface related to metronome
   control."
@@ -292,22 +419,28 @@
         metronome-mode @(:metronome-mode controller)]
     ;; Should the first cell display metronome information?
     (if (seq metronome-mode)
+      ;; Draw the beat and BPM information
       (let [metronome (:metronome (:show controller))
             marker (rhythm/metro-marker metronome)
             bpm (format "%.1f" (float (rhythm/metro-bpm metronome)))
             chars (+ (count marker) (count bpm))
             padding (apply str (take (- 17 chars) (repeat " ")))]
-        (swap! (:next-text-buttons controller)
-               assoc metronome-button (button-state metronome-button :bright))
         (write-display-cell controller 1 0 (str marker padding bpm))
         (write-display-cell controller 0 0 "Beat        BPM  ")
+
+        ;; Draw the beat-adjustment arrow if that encoder is being held
         (when (:adjusting-beat metronome-mode)
           (let [arrow-pos (if @(:shift-mode controller)
                             (dec (.indexOf marker "." (inc (.indexOf marker "."))))
                             (dec (count marker)))]
             (aset (get (:next-display controller) 2) arrow-pos (:up-arrow special-symbols))))
+
+        ;; Draw the BPM adjustment arrow if that encoder is being held
+        ;; (and the BPM is not externally synced)
         (when (:adjusting-bpm metronome-mode)
           (aset (get (:next-display controller) 2) 16 (:up-arrow special-symbols))))
+
+      ;; The metronome section is not active, so make its button dim
       (swap! (:next-text-buttons controller)
              assoc metronome-button (button-state metronome-button :dim)))
     ;; Regardless, flash the tap tempo button on beats
@@ -326,6 +459,7 @@
     (doseq [row (range 4)]
       (Arrays/fill (get (:next-display controller) row) (byte 32)))
     (reset! (:next-text-buttons controller) {})
+    (Arrays/fill (:next-top-pads controller) 0)

     ;; TODO: Loop over the most recent four active cues, rendering information
     ;;       about them.
@@ -338,8 +472,16 @@
            (button-state (:shift control-buttons)
                          (if @(:shift-mode controller) :bright :dim)))

+    ;; Add any contributions from interface overlays, removing them
+    ;; if they report being finished.
+    (doseq [[k overlay] (reverse @(:overlays controller))]
+      (when-not (adjust-interface overlay controller)
+        (swap! (:overlays controller) dissoc k)))
+
     (update-text controller)
+    (update-top-pads controller)
     (update-text-buttons controller)
+
     (catch Throwable t
       (warn t "Problem updating Ableton Push Interface"))))

@@ -379,13 +521,13 @@

       (= @counter 16)
       (doseq [x (range 0 8)]
-        (set-track-select-state controller x :bright :amber))
+        (set-top-pad-state controller x :bright :amber))

       (= @counter 17)
       (doseq [x (range 0 8)]
-        (set-scene-launch-color controller x
+        (set-second-pad-color controller x
                                 (com.evocomputing.colors/create-color :h 45 :s 100 :l 50))
-        (set-track-select-state controller x :bright :red))
+        (set-top-pad-state controller x :bright :red))

       (< @counter 26)
       (doseq [x (range 0 8)]
@@ -397,11 +539,11 @@
       (do
         (show-labels controller :dim :amber)
         (doseq [x (range 0 8)]
-          (set-track-select-state controller x :off)))
+          (set-top-pad-state controller x :off)))

       (= @counter 27)
       (doseq [x (range 0 8)]
-          (set-scene-launch-color controller x off-color))
+          (set-second-pad-color controller x off-color))

       (< @counter 36)
       (doseq [x (range 0 8)]
@@ -411,6 +553,7 @@
       (do
         (clear-interface controller)
         (amidi/add-global-handler! @(:midi-handler controller))
+        (enter-metronome-showing controller)
         (reset! (:task controller) (at-at/every (:refresh-interval controller)
                                                 #(update-interface controller)
                                                 controllers/pool))
@@ -437,8 +580,8 @@
   (doseq [line (range 4)]
     (clear-display-line controller line))
   (doseq [x (range 8)]
-    (set-track-select-state controller x :off)
-    (set-scene-launch-color controller x off-color)
+    (set-top-pad-state controller x :off)
+    (set-second-pad-color controller x off-color)
     (doseq [y (range 8)]
       (set-pad-color controller x y off-color)))
   (doseq [[_ button] control-buttons]
@@ -460,20 +603,49 @@
      (- val 128)
      val))

+(defn- overlay-handled?
+  "See if there is an interface overlay active which wants to consume
+  this message; if so, send it, and see if the overlay consumes it.
+  Returns truthy if an overlay consumed the message, and it should
+  not be given to anyone else."
+  [controller message]
+  (case (:command message)
+    (:note-on :note-off)
+    (some (fn [[k overlay]]
+            (when (contains? (captured-notes overlay) (:note message))
+              (let [result (if (= :note-on (:command message))
+                             (handle-note-on overlay controller message)
+                             (handle-note-off overlay controller message))]
+                (when (= result :done)
+                  (swap! (:overlays controller) dissoc k))
+                result)))
+          (seq @(:overlays controller)))
+
+    :control-change
+    (some (fn [[k overlay]]
+            (when (contains? (captured-controls overlay) (:note message))
+              (let [result (handle-control-change overlay controller message)]
+                (when (= result :done)
+                  (swap! (:overlays controller) dissoc k))
+                result)))
+          (seq @(:overlays controller)))
+
+    ;; Nothing we process
+    false))
+
 (defn- control-change-received
+  "Process a control change message which was not handled by an
+  interface overlay."
   [controller message]
   (case (:note message)
     3 ; Tap tempo button
     (when (> (:velocity message) 0)
-      ;; TODO: Do other things when synced.
-      ((:tap-tempo-handler controller))
-      (swap! (:metronome-mode controller) #(assoc % :showing true)))
+      (interpret-tempo-tap controller)
+      (enter-metronome-showing controller))

     9 ; Metronome button
     (when (> (:velocity message) 0)
-      (swap! (:metronome-mode controller) #(if (:showing %)
-                                             (dissoc % :showing)
-                                             (assoc % :showing :true))))
+      (enter-metronome-showing controller))

     14 ; Beat encoder
     (let [delta (sign-velocity (:velocity message))
@@ -498,25 +670,29 @@
     nil))

 (defn- note-on-received
+  "Process a note-on message which was not handled by an interface
+  overlay."
   [controller message]
   (case (:note message)
     9 ; BPM encoder
-    (swap! (:metronome-mode controller) #(assoc % :adjusting-bpm :true))
+    (swap! (:metronome-mode controller) assoc :adjusting-bpm :true)

     10 ; Beat encoder
-    (swap! (:metronome-mode controller) #(assoc % :adjusting-beat :true))
+    (swap! (:metronome-mode controller) assoc :adjusting-beat :true)

     ;; Something we don't care about
     nil))

 (defn- note-off-received
+  "Process a note-off message which was not handled by an interface
+  overlay."
   [controller message]
   (case (:note message)
     9 ; BPM encoder
-    (swap! (:metronome-mode controller) #(dissoc % :adjusting-bpm))
+    (swap! (:metronome-mode controller) dissoc :adjusting-bpm)

     10 ; Beat encoder
-    (swap! (:metronome-mode controller) #(dissoc % :adjusting-beat))
+    (swap! (:metronome-mode controller) dissoc :adjusting-beat)

     ;; Something we don't care about
     nil))
@@ -528,12 +704,13 @@
   [controller message]
   (when (= (:device message) (:port-in controller))
     ;(info message)
-    (when (= (:status message) :control-change)
-      (control-change-received controller message))
-    (when (= (:command message) :note-on)
-      (note-on-received controller message))
-        (when (= (:command message) :note-off)
-      (note-off-received controller message))))
+    (when-not (overlay-handled? controller message)
+      (when (= (:status message) :control-change)
+        (control-change-received controller message))
+      (when (= (:command message) :note-on)
+        (note-on-received controller message))
+      (when (= (:command message) :note-off)
+        (note-off-received controller message)))))

 (defn bind-to-show
   "Establish a connection to the Ableton Push, for managing the given
@@ -572,11 +749,14 @@
          :next-display (vec (for [_ (range 4)] (byte-array (take 68 (repeat 32)))))
          :last-text-buttons (atom {})
          :next-text-buttons (atom {})
-         :metronome-mode (atom {:showing true})
+         :last-top-pads (int-array 8)
+         :next-top-pads (int-array 8)
+         :metronome-mode (atom {})
          :shift-mode (atom false)
          :midi-handler (atom nil)
          :tap-tempo-handler (amidi/create-tempo-tap-handler (:metronome show))
-         }]
+         :overlays (atom (sorted-map-by >))
+         :next-overlay (atom 0)}]
     (reset! (:midi-handler controller) (partial midi-received controller))
     (clear-interface controller)
     (welcome-animation controller)


Implemented multiple-key retrieve.

Implemented multiple-key retrieve.

--- src/appengine_magic/services/datastore.clj
+++ src/appengine_magic/services/datastore.clj
@@ -238,29 +238,50 @@
 ;;; user functions and macros
 ;;; ----------------------------------------------------------------------------

-(defn retrieve [entity-record-type key-value &
+(defn retrieve [entity-record-type key-value-or-values &
                 {:keys [parent kind]
                  :or {kind (unqualified-name (.getName entity-record-type))}}]
-  (let [key-object (if parent
-                       (KeyFactory/createKey (get-key-object parent)
-                                             kind
-                                             (coerce-key-value-type key-value))
-                       (KeyFactory/createKey kind
-                                             (coerce-key-value-type key-value)))
-        entity (.get (get-datastore-service) key-object)
-        raw-properties (into {} (.getProperties entity))
-        properties (reduce (fn [m [k v]]
-                             (assoc m
-                               (keyword k)
-                               (coerce-java-type v)))
-                           {}
-                           raw-properties)
-        ;; XXX: No good choice but to use eval here. No way to know the number
-        ;; of arguments to the record constructor at compile-time, and no clean
-        ;; way to access any custom constructor defined by defentity, since that
-        ;; constructor would be in a different namespace.
-        entity-record (eval `(new ~entity-record-type ~@(repeat (count raw-properties) nil)))]
-    (with-meta (merge entity-record properties) {:key (.getKey entity)})))
+  (let [make-key-from-value (fn [key-value real-parent]
+                              (if real-parent
+                                  (KeyFactory/createKey (get-key-object real-parent)
+                                                        kind
+                                                        (coerce-key-value-type key-value))
+                                  (KeyFactory/createKey kind
+                                                        (coerce-key-value-type key-value))))
+        make-blank (fn [num-fields]
+                     ;; XXX: No good choice but to use eval here. No way to know the number
+                     ;; of arguments to the record constructor at compile-time, and no clean
+                     ;; way to access any custom constructor defined by defentity, since that
+                     ;; constructor would be in a different namespace.
+                     (eval `(new ~entity-record-type ~@(repeat num-fields nil))))
+        to-clj-properties (fn [raw-properties]
+                            (reduce (fn [m [k v]]
+                                      (assoc m
+                                        (keyword k)
+                                        (coerce-java-type v)))
+                                    {}
+                                    raw-properties))]
+    (if (sequential? key-value-or-values)
+        ;; handles sequences of values
+        (let [key-objects (map (fn [kv] (if (sequential? kv)
+                                            (make-key-from-value (first kv) (second kv))
+                                            (make-key-from-value kv nil)))
+                               key-value-or-values)
+              entities (.get (get-datastore-service) key-objects)
+              model-record (make-blank (count (.. (first entities) getValue getProperties)))]
+          (map #(let [v (.getValue %)]
+                  (with-meta
+                    (merge model-record (to-clj-properties (.getProperties v)))
+                    {:key (.getKey v)}))
+               entities))
+        ;; handles singleton values
+        (let [key-object (make-key-from-value key-value-or-values parent)
+              entity (.get (get-datastore-service) key-object)
+              raw-properties (into {} (.getProperties entity))
+              entity-record (make-blank (count raw-properties))]
+          (with-meta
+            (merge entity-record (to-clj-properties raw-properties))
+            {:key (.getKey entity)})))))

 (defn delete! [target]


Only run phpunit when php files are present

--- src/circle/backend/build/inference/php.clj
+++ src/circle/backend/build/inference/php.clj
@@ -27,7 +27,8 @@
   "Run phpunit on the test directory."
   [repo]
   (->>
-    [(phpunit repo (fs/join repo "test"))]
+   [(when (dir-contains-php-files? repo)
+      (phpunit repo (fs/join repo "test")))]
     (filter identity)))


whitespace

whitespace

--- src/cljs/reagent_demo/views/home_page.cljs
+++ src/cljs/reagent_demo/views/home_page.cljs
@@ -64,7 +64,7 @@
   (map #(button-row %) grid-range))

 (defn main []
-   [:div [:h2 "Welcome to reagent_demo"]
+  [:div [:h2 "Welcome to the bla"]
     [:div [:a {:href "#/about"} "go to about page"]]
     [:br]
     (button-grid)])


Minor code cleanup (arg destructuring)

Minor code cleanup (arg destructuring)

--- src/com/frereth/server/comms/registrar.clj
+++ src/com/frereth/server/comms/registrar.clj
@@ -86,12 +86,10 @@

 (s/defn do-registrations :- com-skm/async-channel
   ;; TODO: This really seems like it should be a defnk
-  [this :- Registrar]
-  (let [event-loop (:event-loop this)
-        interface (:interface this)
+  [{:keys [done event-loop ex-chan]} :- Registrar]
+  (let [interface (:interface event-loop)
         ->out (:in-chan interface)
-        in<- (:ex-chan event-loop)
-        done (:done this)
+        in<- ex-chan
         raw-sources [done in<-]
         minutes-5 (partial async/timeout (* 5 (util/minute)))]
     (async/go-loop [[v c] (async/alts! (conj raw-sources (minutes-5)))]


Documentation on CUT, but this is not the way to go apparently

--- src/clj/algorithms_clj/ancestors.clj
+++ src/clj/algorithms_clj/ancestors.clj
@@ -24,6 +24,8 @@
 ;; is_child(C):-parent(_,C),!.
 ;; => is_child(X) => returns only one result => it becomes the query "there exists a child"

+;; http://kti.ms.mff.cuni.cz/~bartak/prolog/how.html
+
 (defn test-dbg
   []
   (pldb/db-rel link src dst)
@@ -38,9 +40,7 @@

   (defn has-parent?
     [x]
-    (all
-      (fresh [z] (link z x))
-      ))
+    (fresh [z] (link z x)))

   (pldb/with-db dbg-facts
     (run* [childs]


add generic daily values function

add generic daily values function

--- src/clj/ceres_analytics/measures.clj
+++ src/clj/ceres_analytics/measures.clj
@@ -167,3 +167,9 @@
    #(mc/count @db coll {:ts {$gt (t/plus t0 (t/hours %))
                              $lt (t/plus t0 (t/hours (inc %)))}})
    hour-range))
+
+
+(defn daily-values [coll t0 day-range f]
+  (map
+   #(f coll (t/plus t0 (t/days %)) (t/plus t0 (t/days (inc %))))
+   day-range))


Replace dec->int100 function with an anonymous function.

--- src/clj/forma/postprocess/output.clj
+++ src/clj/forma/postprocess/output.clj
@@ -54,19 +54,15 @@
   [series]
   (cons (first series) (rest (reductions max series))))

-(defn dec->int100
-  [coll]
-  (map (comp int round (partial * 100)) coll))
-
 (defn clean-probs
-  "smooth the probabilities with a backward-looking moving average, make the
+  "Smooth the probabilities with a backward-looking moving average, make the
   series monotonically increasing, and finally make each probability 0->1 an
   integer 0->100"
   [coll]
   (let [window 3]
-    [(vec (-> (backward-looking-mavg window coll)
-              (mono-inc)
-              (dec->int100)))]))
+    [(vec (->> (backward-looking-mavg window coll)
+               (mono-inc)
+               (map #(round (* % 100)))))]))

 (defn date-no-sep
   [date-str]


Added code from Dave that he shared on Github:

* https://github.com/ztellman/potemkin/issues/31#issuecomment-110689951

--- src/cljc/cmr/client/common/util.cljc
+++ src/cljc/cmr/client/common/util.cljc
@@ -93,3 +93,30 @@
     ([parent-client-options http-options]
      (client-data-constructor parent-client-options
                               http-options))))
+
+(defmacro import-def
+  "import a single fn or var
+   (import-def a b) => (def b a/b)
+  "
+  [from-ns def-name]
+  (let [from-sym# (symbol (str from-ns) (str def-name))]
+    `(def ~def-name ~from-sym#)))
+
+(defmacro import-vars
+  "import multiple defs from multiple namespaces
+   works for vars and fns. not macros.
+   (same syntax as potemkin.namespaces/import-vars)
+   (import-vars
+     [m.n.ns1 a b]
+     [x.y.ns2 d e f]) =>
+   (def a m.n.ns1/a)
+   (def b m.n.ns1/b)
+    ...
+   (def d m.n.ns2/d)
+    ... etc
+  "
+  [& imports]
+  (let [expanded-imports (for [[from-ns & defs] imports
+                               d defs]
+                           `(import-def ~from-ns ~d))]
+  `(do ~@expanded-imports)))


change phone component to use image

change phone component to use image

--- src/cljs/phonecat_re_frame/core.cljs
+++ src/cljs/phonecat_re_frame/core.cljs
@@ -89,8 +89,10 @@

 (defn phone-component
   [phone]
-  [:li
-   [:span (:name phone)]
+  [:li {:class "thumbnail"}
+   [:a {:href (str "#/phones/" (:id phone))}
+    [:img {:src (:imageUrl phone)}]]
+   [:a {:href (str "#/phones/" (:id phone))} (:name phone)]
    [:p (:snippet phone)]])

 (defn matches-query?


add phone-details-sub to step8

add phone-details-sub to step8

--- src/cljs/phonecat_re_frame/core.cljs
+++ src/cljs/phonecat_re_frame/core.cljs
@@ -34,6 +34,11 @@
    (reaction (:order-prop @db))))

 (re-frame/register-sub
+ :phone-details
+ (fn [db]
+   (reaction (:phone-details @db))))
+
+(re-frame/register-sub
  :phone-query
  (fn [db [_ phone-id]]
    (let [phone-details-reaction (reaction (:phone-details @db))]
@@ -94,6 +99,7 @@
  (fn
    [_ _]                   ;; Ignore both params (db and v).
    {:phones []
+    :phone-details {}
     :search-input ""
     :order-prop "name"}))


added another destructuring function

added another destructuring function

--- src/clojure/flambo/destructuring.clj
+++ src/clojure/flambo/destructuring.clj
@@ -19,6 +19,10 @@
 (defn tuple-fn [f]
   (fn [^Tuple2 t]
     (f (._1 t) (._2 t))))
+
+(defn tuple-seq-fn [f]
+  (fn [^Tuple2 t]
+    (f (seq (._1 t)) (seq (._2 t)))))

 (defn tuple-value-fn [f]
   (fn [^Tuple2 t]


Fix misuse of metrics.core/remove-metrics.

--- src/onyx/monitoring/metrics_monitoring.clj
+++ src/onyx/monitoring/metrics_monitoring.clj
@@ -187,7 +187,7 @@
   (component/stop [{:keys [registry reporter] :as component}]
     (info "Stopping Metrics Reporting to JMX.")
     (.stop ^JmxReporter reporter)
-    (metrics.core/remove-metrics registry)
+    (metrics.core/remove-metrics registry (fn [_] true))
     (assoc component :registry nil :reporter nil)))

 (defn new-monitoring []
@@ -364,7 +364,7 @@
   (component/stop [{:keys [registry reporter id] :as component}]
     (info id "Stopping Task Metrics Reporter. Stopped reporting to JMX.")
     (.stop ^JmxReporter reporter)
-    (metrics.core/remove-metrics registry)
+    (metrics.core/remove-metrics registry (fn [_] true))
     (assoc component :registry nil :reporter nil)))

 (defn new-task-monitoring [event]


The function read-job-info should return only first result, not list with one item

--- src/emender_service/db_interface.clj
+++ src/emender_service/db_interface.clj
@@ -63,8 +63,9 @@
 (defn read-job-info
     [job-id]
     (try
-        (jdbc/query db-spec/emender-service-db
-                    ["select * from results where id = ?" job-id])
+        (first
+            (jdbc/query db-spec/emender-service-db
+                        ["select * from results where id = ?" job-id]))
         (catch Exception e
             (println e)
             [])))


update introspection schema

update introspection schema

--- src/graphql_clj/schema_validator.clj
+++ src/graphql_clj/schema_validator.clj
@@ -14,6 +14,7 @@
   types: [__Type!]!
   queryType: __Type!
   mutationType: __Type
+  subscriptionType: __Type
   directives: [__Directive!]!
 }

@@ -85,10 +86,22 @@
 enum __DirectiveLocation {
   QUERY
   MUTATION
+  SUBSCRIPTION
   FIELD
   FRAGMENT_DEFINITION
   FRAGMENT_SPREAD
   INLINE_FRAGMENT
+  SCHEMA
+  SCALAR
+  OBJECT
+  FIELD_DEFINITION
+  ARGUMENT_DEFINITION
+  INTERFACE
+  UNION
+  ENUM
+  ENUM_VALUE
+  INPUT_OBJECT
+  INPUT_FIELD_DEFINITION
 }")

 (defn- reserved-name? [s]


MAJ de l'exercice two-fer pour clojure

MAJ de l'exercice two-fer pour clojure

--- exercism/clojure/two-fer/src/two_fer.clj
+++ exercism/clojure/two-fer/src/two_fer.clj
@@ -1,6 +1,6 @@
 (ns two-fer)

 (defn two-fer
-  ([] "One for you, one for me.")
+  ([] (two-fer "you"))
   ([name] (str "One for " name ", one for me."))
 )


set safe mode for pokemon-crunching

set safe mode for pokemon-crunching

--- frontend/src/cruncher/shredder/main.cljs
+++ frontend/src/cruncher/shredder/main.cljs
@@ -22,7 +22,8 @@
       (when (js/confirm "Do you really want to send away the selected Pokemon?\nYou won't get them back!\n\nConsider your decision.")
         (lib/loading!)
         (POST (clib/make-url url)
-              {:body            (clib/clj->json {:ids selected-pokemon})
+              {:body            (clib/clj->json {:ids selected-pokemon
+                                                 :safe 1})
                :handler         success-handler
                :error-handler   com/error-handler
                :response-format :json


:fire: Remove some prn's lines.

:fire: Remove some prn's lines.

--- frontend/src/uxbox/main/data/viewer.cljs
+++ frontend/src/uxbox/main/data/viewer.cljs
@@ -93,7 +93,6 @@
   (ptk/reify ::create-share-link
     ptk/WatchEvent
     (watch [_ state stream]
-      (prn "create-share-link")
       (let [id (get-in state [:viewer-local :page-id])]
         (->> (rp/mutation :generate-page-share-token {:id id})
              (rx/map (fn [{:keys [share-token]}]
@@ -103,7 +102,6 @@
   (ptk/reify ::delete-share-link
     ptk/WatchEvent
     (watch [_ state stream]
-      (prn "delete-share-link")
       (let [id (get-in state [:viewer-local :page-id])]
         (->> (rp/mutation :clear-page-share-token {:id id})
              (rx/map (fn [_]


Boolean is enough - no need for additional action rets

--- src/onyx/messaging/acking_daemon.clj
+++ src/onyx/messaging/acking_daemon.clj
@@ -25,7 +25,7 @@
           (timbre/fatal e)))
       (recur))))

-(defrecord AckState [state last-action])
+(defrecord AckState [state completed?])

 (defn ack-segment [ack-state completion-ch message-id completion-id ack-val]
   (let [rets
@@ -37,12 +37,12 @@
               (if ack
                 (let [updated-ack-val (bit-xor ^long (:ack-val ack) ^long ack-val)]
                   (if (zero? updated-ack-val)
-                    (->AckState (dissoc state message-id) :completed)
-                    (->AckState (assoc state message-id (assoc ack :ack-val updated-ack-val)) :updated)))
+                    (->AckState (dissoc state message-id) true)
+                    (->AckState (assoc state message-id (assoc ack :ack-val updated-ack-val)) false)))
                 (if (zero? ^long ack-val)
-                  (->AckState state :completed)
-                  (->AckState (assoc state message-id (->Ack nil completion-id ack-val (now))) :initialised))))))]
-    (when (= :completed (:last-action rets))
+                  (->AckState state false)
+                  (->AckState (assoc state message-id (->Ack nil completion-id ack-val (now))) false))))))]
+    (when (:completed? rets)
       (>!! completion-ch
            {:id message-id :peer-id completion-id}))))

@@ -63,7 +63,7 @@
           completion-ch (chan completion-buffer-size)
           acking-buffer-size (arg-or-default :onyx.messaging/completion-buffer-size opts)
           acking-ch (chan acking-buffer-size)
-          state (atom (->AckState {} nil))
+          state (atom (->AckState {} false))
           ack-segments-fut (future (ack-segments-loop state acking-ch completion-ch))
           timeout-fut (future (clear-messages-loop state opts))]
       (assoc component


Remove misleading comment related to login flow

--- src/status_im/accounts/login/core.cljs
+++ src/status_im/accounts/login/core.cljs
@@ -16,14 +16,6 @@
             [status-im.models.transactions :as transactions]
             [status-im.i18n :as i18n]
             [status-im.node.core :as node]))
-
-;; login flow:
-;;
-;; - event `:ui/login` is dispatched
-;; - node is initialized with user config or default config
-;; - `node.started` signal is received, applying `:login` fx
-;; - `:callback/login` event is dispatched, account is changed in datastore, web-data is cleared
-;; - `:init.callback/account-change-success` event is dispatched

 (defn login! [address password]
   (status/login address password #(re-frame/dispatch [:accounts.login.callback/login-success %])))


Be clear that the new routes are not landing pages.

Rather, we are providing a directory of landing pages.

--- search-app/src/cmr/search/site/data.clj
+++ search-app/src/cmr/search/site/data.clj
@@ -55,3 +55,4 @@
   "Generate the data necessary to render EOSDIS directory page links."
   [context]
   (base-page context))
+


using namespaces directive to only compile main

--- project.clj
+++ project.clj
@@ -1,9 +1,11 @@
 (defproject overtone "0.1.1"
   :description "An audio/musical experiment."
+  :url "http://project-overtone.org"
+  :namespaces [overtone.app.main]
   :dependencies [[org.clojure/clojure "1.1.0"]
                  [org.clojure/clojure-contrib "1.1.0"]
                  [org.freedesktop.tango/tango-icon-theme "0.8.90"]
-                 [org.clojars.nakkaya/miglayout "3.7"]
+                 [org.clojars.nakkaya/miglayout "3.7.3.1"]
                  [scenegraph "0.0.1-SNAPSHOT"]

                  [overtone/jsyntaxpane "0.9.5-b27"]


"Properly" indent two lines [skip ci]

"Properly" indent two lines [skip ci]

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -530,8 +530,8 @@
                              :target "_blank"
                              :href "https://circleci.com/beta-access/"
                              :on-click #(aside-nav-clicked owner :changelog-icon-clicked)}
-             (icon/engine-2)
-             [:div.nav-label "What's New"]]
+               (icon/engine-2)
+               [:div.nav-label "What's New"]]

              (when (:admin user)


Sanitize line endings when using sendmail.

--- src/clj/com/draines/postal/sendmail.clj
+++ src/clj/com/draines/postal/sendmail.clj
@@ -35,8 +35,11 @@
 (defn sendmail-find []
   (first (filter #(.isFile (java.io.File. %)) sendmails)))

+(defn sanitize [text]
+  (.replaceAll text "\r\n" (System/getProperty "line.separator")))
+
 (defn sendmail-send [msg]
-  (let [mail (message->str msg)
+  (let [mail (sanitize (message->str msg))
         cmd (concat
              [(sendmail-find) (format "-f %s" (sender msg))]
              (recipients msg))


Removed code for debugging

Removed code for debugging

--- src/cljs/color_eyes/color_selector.cljs
+++ src/cljs/color_eyes/color_selector.cljs
@@ -27,10 +27,9 @@
      [:input {:type "number" :value a
               :on-change
               #(change-color-value rgba :a (js/parseInt (-> % .-target .-value)))}]
-     (if (> r 130)
-       [:div.color-display
-        [:div.color-box
-         {:style {:color css-color}}]])
+     [:div.color-display
+      [:div.color-box
+       {:style {:color css-color}}]]
      [:p (str css-color)]])
   )


fix visibility flag bug in sprite

fix visibility flag bug in sprite

--- src/cljs/infinitelives/pixi/sprite.cljs
+++ src/cljs/infinitelives/pixi/sprite.cljs
@@ -35,7 +35,7 @@
     (set! (.-x s) x)
     (set! (.-y s) y)
     (set! (.-rotation s) rotation)
-    (set! (.-visibile s) visible)
+    (set! (.-visible s) visible)
     (when-not (= scale 1)
       (set! (.-scale s)
             (if (number? scale)


fix broken sound loading

fix broken sound loading

--- src/cljs/infinitelives/utils/sound.cljs
+++ src/cljs/infinitelives/utils/sound.cljs
@@ -23,7 +23,7 @@
     (.open req "GET" url true)
     (set! (.-responseType req) "arraybuffer")
     (set! (.-onload req)
-          (fn [] (.decodeAudioData audio-context (.-response req) #(put! c %))))
+          (fn [] (.decodeAudioData audio-context (.-response req) #(put! c [url %]))))
     (.send req)
     c))


added title string to header

added title string to header

--- src/cljs/redditv/components/header.cljs
+++ src/cljs/redditv/components/header.cljs
@@ -10,4 +10,4 @@
      [:.redditv-header-flex
       [:.header-logo "redditv"]
       [:.header-subreddit (str "/r/" subreddit)]
-      [:.header-title (str (-> selected :title))]]]))
+      [:.header-title {:title (:title selected)} (str (:title selected))]]]))


rename

rename

--- src/cljs/tictactoe/logic/constants.cljs
+++ src/cljs/tictactoe/logic/constants.cljs
@@ -6,9 +6,7 @@
 (def board-size 3)

 (def coordinates
-  (for [x (range board-size)
-        y (range board-size)]
-    [x y]))
+  (for [x (range board-size) y (range board-size)] [x y]))

 (def cell-count (count coordinates))


Reimplement interceptor as simple handler instead router directive.

--- src/clojure/catacumba/handlers/misc.clj
+++ src/clojure/catacumba/handlers/misc.clj
@@ -152,17 +152,13 @@
   It wraps the rest of route chain the execution. It receive a
   continuation (as a cloure function) that must be called in
   order for processing to proceed."
-  [context interceptor]
-  (let [^Context ctx (:catacumba/context context)
-        ^Execution exec (.getExecution ctx)]
-    (.addInterceptor exec
-                     (exec-interceptor interceptor)
-                     (reify Block
-                       (^void execute [_]
-                         (.next ctx))))))
+  [callback]
+  (fn [context]
+    (let [^Context ctx (:catacumba/context context)
+          ^Execution exec (.getExecution ctx)]
+      (.addInterceptor exec
+                       (exec-interceptor callback)
+                       (reify Block
+                         (^void execute [_]
+                          (.next ctx)))))))

-(defmethod routing/attach-route :interceptor
-  [^Chain chain [_ interceptor']]
-  (let [handler #(interceptor % interceptor')]
-    (.all chain ^Handler (hs/adapter handler))))
-


Do age filtering before random screen; lein release :patch

--- src/clojush/pushgp/parent_selection.clj
+++ src/clojush/pushgp/parent_selection.clj
@@ -62,8 +62,8 @@
   [pop {:keys [tournament-size total-error-method] :as argmap}]
   (let [subpop (-> pop
                    (nonempties-when-autoconstructing argmap)
-                   (screen argmap)
-                   (age-mediate argmap))
+                   (age-mediate argmap)
+                   (screen argmap))
         tournament-set (doall
                          (for [_ (range tournament-size)]
                            (lrand-nth subpop)))
@@ -84,8 +84,8 @@
   [pop argmap]
   (loop [survivors (-> pop
                        (nonempties-when-autoconstructing argmap)
+                       (age-mediate argmap)
                        (screen argmap)
-                       (age-mediate argmap)
                        (retain-one-individual-per-error-vector))
          cases (lshuffle (range (count (:errors (first pop)))))]
     (if (or (empty? cases)
@@ -130,8 +130,8 @@
   [pop {:keys [epsilon-lexicase-epsilon] :as argmap}]
   (loop [survivors (-> pop
                        (nonempties-when-autoconstructing argmap)
+                       (age-mediate argmap)
                        (screen argmap)
-                       (age-mediate argmap)
                        (retain-one-individual-per-error-vector))
          cases (lshuffle (range (count (:errors (first pop)))))]
     (if (or (empty? cases)
@@ -188,8 +188,8 @@
   [pop argmap]
   (loop [survivors (-> pop
                        (nonempties-when-autoconstructing argmap)
+                       (age-mediate argmap)
                        (screen argmap)
-                       (age-mediate argmap)
                        (retain-one-individual-per-error-vector))
          cases (lshuffle (map lrand-nth @elitegroups))]
     (if (or (empty? cases)
@@ -250,8 +250,8 @@
   [pop argmap]
   (-> pop
       (nonempties-when-autoconstructing argmap)
+      (age-mediate argmap)
       (screen argmap)
-      (age-mediate argmap)
       (lrand-nth)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -280,4 +280,3 @@
                                                                1
                                                                (inc sel-count)))))
     selected))
-


Move "deactived" column into a new migration

Now that we have at least one active user, such schema changes need to be
migrations.

--- src/com/puppetlabs/cmdb/scf/migrate.clj
+++ src/com/puppetlabs/cmdb/scf/migrate.clj
@@ -22,8 +22,7 @@
   "Create the initial database schema."
   []
   (sql/create-table :certnames
-                    ["name" "TEXT" "PRIMARY KEY"]
-                    ["deactivated" "TIMESTAMP"])
+                    ["name" "TEXT" "PRIMARY KEY"])

   (sql/create-table :catalogs
                     ["hash" "VARCHAR(40)" "NOT NULL" "PRIMARY KEY"]
@@ -106,10 +105,17 @@
   (sql/do-commands
    "CREATE INDEX idx_catalog_resources_tags ON catalog_resources(tags)"))

+(defn allow-node-deactivation
+  "Add a column storing when a node was deactivated."
+  []
+  (sql/do-commands
+    "ALTER TABLE certnames ADD deactivated TIMESTAMP WITH TIME ZONE"))
+
 ;; The available migrations, as a map from migration version to migration
 ;; function.
 (def migrations
-  {1 initialize-store})
+  {1 initialize-store
+   2 allow-node-deactivation})

 (defn schema-version
   "Returns the current version of the schema, or 0 if the schema


requestUpdate

requestUpdate

--- examples/hello-famous/src/hello_famous/core.cljs
+++ examples/hello-famous/src/hello_famous/core.cljs
@@ -32,5 +32,5 @@
                                                   )}
                           ))
 (defonce spinner-id (.. logo (addComponent spinner)))
-(.. logo (requestUpdateOnNextTick spinner-id))
+(.. logo (requestUpdate spinner-id))
 (.. FamousEngine init)


(PDB-4636) migrate: move schema validation to require-valid-schema

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1607,12 +1607,32 @@
        (into known-migrations)
        (difference applied-migrations)))

-(defn run-migrations
+(defn require-valid-schema
+  "Returns true if the database is ready for use, otherwise throws."
   []
   (let [applied-migration-versions (applied-migrations)
         latest-applied-migration (last applied-migration-versions)
-        known-migrations (apply sorted-set (keys migrations))
-        small-tables (set ["value_types" "report_statuses"])
+        known-migrations (apply sorted-set (keys migrations))]
+
+    (when (and latest-applied-migration
+               (< latest-applied-migration (first known-migrations)))
+      (throw (IllegalStateException.
+              (str
+               (trs "Found an old and unuspported database migration (migration number {0})." latest-applied-migration)
+               " "
+               (trs "PuppetDB only supports upgrading from the previous major version to the current major version.")
+               " "
+               (trs "As an example, users wanting to upgrade from 2.x to 4.x should first upgrade to 3.x.")))))
+
+    (when-let [unexpected (first (unrecognized-migrations applied-migration-versions known-migrations))]
+      (throw (IllegalStateException.
+              (trs "Your PuppetDB database contains a schema migration numbered {0}, but this version of PuppetDB does not recognize that version."
+                   unexpected))))
+    true))
+
+(defn run-migrations
+  []
+  (let [small-tables (set ["value_types" "report_statuses"])
         analyze (fn [tables]
                   (let [exists?  (->> "select tablename from pg_catalog.pg_tables"
                                       jdbc/query-to-vec
@@ -1623,22 +1643,7 @@
                                    (str/join ", " tables)))
                     (apply jdbc/do-commands-outside-txn
                            (map #(str "vacuum analyze " %) tables))))]
-
-    (when (and latest-applied-migration
-               (< latest-applied-migration (first known-migrations)))
-      (throw (IllegalStateException.
-              (str
-               (trs "Found an old and unuspported database migration (migration number {0})." latest-applied-migration)
-               " "
-               (trs "PuppetDB only supports upgrading from the previous major version to the current major version.")
-               " "
-               (trs "As an example, users wanting to upgrade from 2.x to 4.x should first upgrade to 3.x.")))))
-
-    (when-let [unexpected (first (unrecognized-migrations applied-migration-versions known-migrations))]
-      (throw (IllegalStateException.
-              (trs "Your PuppetDB database contains a schema migration numbered {0}, but this version of PuppetDB does not recognize that version."
-                   unexpected))))
-
+    (require-valid-schema)
     (if-let [pending (seq (pending-migrations))]
       (let [tables (jdbc/with-db-transaction []
                      (->> pending


Make warm macro cache messages no-ops

Make warm macro cache messages no-ops

Temporary solution to #150

--- src/refactor_nrepl/find/find_macros.clj
+++ src/refactor_nrepl/find/find_macros.clj
@@ -246,10 +246,12 @@
        (map #(select-keys % [:name :line-beg :line-end :col-beg :col-end :file]))))

 (defn warm-macro-occurrences-cache []
-  (let [tracker (tracker/build-tracker)]
-    (doseq [f (tracker/project-files-in-topo-order)]
-      (when-let [ns-for-file (core/path->namespace :no-error f)]
-        (doseq [dep-ns (-> (:clojure.tools.namespace.track/deps tracker)
-                           :dependencies
-                           (get (ns-name ns-for-file)))]
-          (dorun (find-used-macros f dep-ns)))))))
+  ;; TODO rewrite this, it's completely broken
+  ;; See https://github.com/clojure-emacs/refactor-nrepl/issues/150
+  #_(let [tracker (tracker/build-tracker)]
+      (doseq [f (tracker/project-files-in-topo-order)]
+        (when-let [ns-for-file (core/path->namespace :no-error f)]
+          (doseq [dep-ns (-> (:clojure.tools.namespace.track/deps tracker)
+                             :dependencies
+                             (get (ns-name ns-for-file)))]
+            (dorun (find-used-macros f dep-ns)))))))


Increasing alarm frequency, 5 minutes is too long for my own habits

--- src/background/booklet/background.cljs
+++ src/background/booklet/background.cljs
@@ -278,7 +278,7 @@
           replacing? (not= windowId (:windowId active-tab))
           is-none?   (= windowId windows/none)]
       (when is-none?
-        (alarms/create window-alarm {:periodInMinutes 5}))
+        (alarms/create window-alarm {:periodInMinutes 1}))
       (if replacing?
         (do
           (dispatch [:handle-deactivation active-tab])


focus text box after click tag autocomplete

--- src/chat/client/views/new_message.cljs
+++ src/chat/client/views/new_message.cljs
@@ -173,6 +173,7 @@
             autocomplete-open? (and (not force-close?) (not (nil? results)))]
           (dom/div #js {:className "message new"}
             (dom/textarea #js {:placeholder (config :placeholder)
+                               :ref "message-text"
                                :value (state :text)
                                :onChange (fn [e]
                                            (let [text (.slice (.. e -target -value) 0 5000)]
@@ -226,7 +227,8 @@
                                                       (when (= i highlighted-result-index) "highlight"))
                                       :style #js {:cursor "pointer"}
                                       :onClick (fn []
-                                                 (choose-result! result))}
+                                                 (choose-result! result)
+                                                 (.focus (om/get-node owner "message-text")))}
                           ((result :html))))
                       results))
                   (dom/div #js {:className "result"}


Remove reflection

Remove reflection

This removes a little bit of reflection and fixes #19.

--- src/clj/com/climate/claypoole/impl.clj
+++ src/clj/com/climate/claypoole/impl.clj
@@ -220,10 +220,10 @@
   [pool]
   (cond
     (instance? java.util.concurrent.ScheduledThreadPoolExecutor pool)
-    (.getCorePoolSize pool)
+    (.getCorePoolSize ^java.util.concurrent.ScheduledThreadPoolExecutor pool)

     (instance? java.util.concurrent.ThreadPoolExecutor pool)
-    (.getMaximumPoolSize pool)
+    (.getMaximumPoolSize ^java.util.concurrent.ThreadPoolExecutor pool)

     :else
     nil))
@@ -236,7 +236,7 @@
   (defn- queue-reader
     "Make a lazy sequence from a queue, stopping upon reading the unique
     end-marker object."
-    [q]
+    [^LinkedBlockingQueue q]
     (lazy-seq
       (let [x (.take q)]
         (when-not (identical? x end-marker)
@@ -250,7 +250,7 @@

   (defn queue-seq-add!
     "Add an item to a queue (and its lazy sequence)."
-    [q x]
+    [^LinkedBlockingQueue q x]
     (.add q x))

   (defn queue-seq-end!


Update sente doc string

Update sente doc string

--- src/clj/com/palletops/bakery/sente.clj
+++ src/clj/com/palletops/bakery/sente.clj
@@ -27,8 +27,7 @@
 (defn start [{:keys [msg-handler path sente-config announce-fn]} chan-sock-atom]
   {:pre [msg-handler chan-sock-atom]}
   (let [chan-sock (sente/make-channel-socket! path sente-config)
-        router (sente/start-chsk-router-loop!
-                msg-handler (:ch-recv chan-sock))]
+        router (sente/start-chsk-router-loop! msg-handler (:ch-recv chan-sock))]
     (reset! chan-sock-atom chan-sock)
     (when announce-fn
       (announce-fn chan-sock))
@@ -57,11 +56,12 @@

 (defn sente
   "Return a sente component, routing messages to `msg-handler`.
-  `announce-fn` will be called on start with the channel socket as an
-  argument.  The `:routes` key will contain Ring routes for handling
-  asynchronous requests, which need to be injected into your
-  application's routes.  The `:path` key can be used to override the
-  default path for these routes."
+  `sente-config` is a map passed to the last argument of sente's
+  `make-channel-socket!` function.  `announce-fn` will be called on
+  start with the channel socket as an argument.  The `:routes` key
+  will contain Ring routes for handling asynchronous requests, which
+  need to be injected into your application's routes.  The `:path` key
+  can be used to override the default path for these routes."
   [{:keys [path msg-handler announce-fn sente-config]}]
   (let [chan-sock-atom (atom nil)
         config {:path (or path "/chsk")


Item-cache-fn returns id after side-effects

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -108,7 +108,8 @@
          (swap! data assoc-in child-path {})
          (bind! data child-path
                 (id->fbref id)
-                story-binder))))))
+                story-binder)))
+     id)))

 (defn stories-binder [f]
   (fn [data path msg]


print to server now instead of to MozREPL

--- src/cljs/ubolonton/xulrunner/repl.cljs
+++ src/cljs/ubolonton/xulrunner/repl.cljs
@@ -52,16 +52,17 @@
       (close! print))))

 ;;; XXX: Monkey-patch clojure.browser.repl/repl-print
-;; (aset js/clojure.browser.repl "repl_print"
-;;       (fn [data]
-;;         (put! (:print @connections)
-;;               (repl/wrap-message :print (pr-str data)))))
+(aset js/clojure.browser.repl "repl_print"
+      (fn [data]
+        (util/log "repl:printing" data)
+        (put! (:print @connections) (pr-str data))))

 ;;; Temp hack while piggy-backing on MozRepl for development Not
 ;;; simply js/repl.print, because it's a method (using this), not a
 ;;; function.
-(defn log [str]
-  (js/repl.print str))
-(set-print-fn! log)
+(comment
+  (defn log [str]
+    (js/repl.print str))
+  (set-print-fn! log)

-(aset js/clojure.browser.repl "repl_print" log)
+  (aset js/clojure.browser.repl "repl_print" log))


Specialise key=, key-not= and key-lt

Specialise key=, key-not= and key-lt

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -52,13 +52,44 @@
       false)))

 (defn ^boolean key= [as bs]
-  (== 0 (key-compare as bs)))
+  (let [as-len (alength as)
+        bs-len (alength bs)]
+    (assert (== as-len bs-len) (pr-str as bs))
+    (loop [i 0]
+      (if (< i as-len)
+        (let [a (aget as i)
+              b (aget bs i)]
+          (if (identical? a b)
+            (recur (+ i 1))
+            false))
+        true))))

 (defn ^boolean key-not= [as bs]
-  (not (== 0 (key-compare as bs))))
+  (let [as-len (alength as)
+        bs-len (alength bs)]
+    (assert (== as-len bs-len) (pr-str as bs))
+    (loop [i 0]
+      (if (< i as-len)
+        (let [a (aget as i)
+              b (aget bs i)]
+          (if (identical? a b)
+            (recur (+ i 1))
+            true))
+        false))))

 (defn ^boolean key-lt [as bs]
-  (== -1 (key-compare as bs)))
+  (let [as-len (alength as)
+        bs-len (alength bs)]
+    (assert (== as-len bs-len) (pr-str as bs))
+    (loop [i 0]
+      (if (< i as-len)
+        (let [a (aget as i)
+              b (aget bs i)]
+          (if (or (and (identical? (typeof a) (typeof b))
+                       (< a b))
+                  (< (typeof a) (typeof b)))
+            true
+            false))))))

 (defn ^boolean key-gt [as bs]
   (== 1 (key-compare as bs)))


Fix so that errors are properly printed

Fix so that errors are properly printed

--- ClojureScript/replete/src/replete/core.cljs
+++ ClojureScript/replete/src/replete/core.cljs
@@ -262,24 +262,8 @@
   ([error]
    (print-error error true))
   ([error include-stacktrace?]
-   (let [cause (.-cause error)]
-     (println (.-message cause))
-     ;; For now, disable stack traces because they take too long to load and
-     ;; when paired with Parinfer (which requires calls into ClojureScript)
-     ;; things can more easily appear to be locked up to the user.
-     (comment
-       (when include-stacktrace?
-         (load-core-source-maps!)
-         (let [canonical-stacktrace (st/parse-stacktrace
-                                      {}
-                                      (.-stack cause)
-                                      {:ua-product :safari}
-                                      {:output-dir "file://(/goog/..)?"})]
-           (println
-             (mapped-stacktrace-str
-               canonical-stacktrace
-               (or (:source-maps @st) {})
-               nil))))))))
+   (let [e (or (.-cause error) error)]
+     (println (.-message e)))))

 (defn get-var
   [env sym]


Add mapping between producer-raw and producer for HSL Kreuzlingen

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -151,6 +151,7 @@
    24  "DZB, Leipzig"
    25  "CAB, Landschlacht"
    26  "Reformierte Blindenpflege Zürich"
+   27  "HSL, Kreuzlingen"
    30  "VzFB, Hannover"
    31  "BBI, Wien"
    32  "Paderborn"


cleaning up require

cleaning up require

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -17,7 +17,7 @@
     [ring.middleware.params :refer (wrap-params)]
     [metrics.ring.instrument :refer  (instrument)]
     [swag.model :refer (defmodel wrap-swag)]
-    [celestial.common :refer (import-logging get! version wrap-errors)]
+    [celestial.common :refer (import-logging get! version wrap-errors success)]
     [compojure.core :refer (defroutes routes)]
     [clojure.core.strint :refer (<<)]
     [celestial.ui-api :refer (public sessions)]


updated id

updated id

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -117,7 +117,7 @@

   (PUT- "/action/:id" [^:int id & ^:action action] {:nickname "updateActions" :summary "Update an actions set"}
         (p/update-action id action)
-        (success {:msg "updated actions"}))
+        (success {:msg "updated actions" :id id}))

   (GET- "/action/by-target/:type" [^:string type] {:nickname "getActionsByTargetType" :summary "Gets actions that operate on a target type"}
         (success {:ids (p/get-action-index :operates-on type)}))


latest systems-toolbox

latest systems-toolbox

--- iwaswhere-web/project.clj
+++ iwaswhere-web/project.clj
@@ -22,7 +22,7 @@
                  [com.drewnoakes/metadata-extractor "2.9.1"]
                  [ubergraph "0.3.0"]
                  [camel-snake-kebab "0.4.0"]
-                 [matthiasn/systems-toolbox "0.6.2"]
+                 [matthiasn/systems-toolbox "0.6.3"]
                  [matthiasn/systems-toolbox-ui "0.6.1"]
                  [matthiasn/systems-toolbox-sente "0.6.1"]
                  ;[matthiasn/systems-toolbox-probe "0.6.2"]


Added function to pull raster data out of a subdataset and store it in a java int-array.

--- src/clj/forma/hdf.clj
+++ src/clj/forma/hdf.clj
@@ -1,6 +1,7 @@
 (ns forma.hdf
   (:use cascalog.api)
-  (:import [org.gdal.gdal gdal Dataset]
+  (:import [org.gdal.gdal gdal Dataset Band]
+           [org.gdal.gdalconst gdalconstConstants]
            [org.apache.hadoop.io BytesWritable])
   (:require [cascalog [ops :as c] [workflow :as w] [io :as io]]
             [clojure.contrib [math :as m] [io :as i] [string :as s]]))
@@ -8,7 +9,8 @@
 ;; ##Constants

 (def
-  #^{:doc "Map between symbols and chosen substrings of MODIS subdataset keys."}
+  #^{:doc "Map between symbols and chosen substrings of
+MODIS subdataset keys."}
   *modis-subsets*
   {:evi "monthly EVI"
    :qual "VI Quality"
@@ -25,6 +27,11 @@
   #^{:doc "Default set of data for FORMA processing."}
   *forma-subsets*
   #{:ndvi :evi :qual :reli})
+
+(def
+  #^{:doc "Arbitrary number of pixels in a chunk of MODIS data."}
+  *chunk-size*
+  24000)

 ;; ##Helper Functions
 ;; These are organized fairly well... more docs later.
@@ -44,14 +51,14 @@

 (defn subdataset-filter
   "Generates a predicate function that compares Hashtable entries to a supplied
-   list of acceptable keys. These keys should exist in *modis-subsets*."
-  [to-keep]
-  (let [kept-keys (map *modis-subsets* to-keep)]
+   set of acceptable keys. These keys should exist in *modis-subsets*."
+  [good-keys]
+  (let [kept-substrings (map *modis-subsets* good-keys)]
     (fn [entry]
       (let [val (.getValue entry)
             key (.getKey entry)]
         (and (s/substring? "_NAME" key)
-             (some #(s/substring? % val) kept-keys))))))
+             (some #(s/substring? % val) kept-substrings))))))

 (def forma-dataset? (subdataset-filter *forma-subsets*))

@@ -73,20 +80,33 @@
   (let [path (.toString hdf-file)]
     (metadata (gdal/Open path) "SUBDATASETS")))

+(defn raster-array
+  "Unpacks the data inside of a MODIS band into a 1xN integer array."
+  [^Dataset data]
+  (let [band (.GetRasterBand data 1)
+        type (gdalconstConstants/GDT_UInt16)
+        width (.GetXSize band)
+        height (.GetYSize band)
+        ret (int-array (* width height))]
+    (do (.ReadRaster band 0 0 width height type ret)
+        ret)))
+
 ;; ##Cascalog Custom Functions
 ;; These guys actually get called by the queries inside of core.

 (defmapop
-  #^{:doc "Generates metadata values for a given unpacked MODIS Dataset and a seq of keys."}
+  #^{:doc "Generates metadata values for a given unpacked MODIS
+Dataset and a seq of keys."}
   [meta-values [meta-keys]] [modis]
   (let [metadata (metadata modis "")]
     (map #(.get metadata %) meta-keys)))

 (defmapcatop
-  #^{:doc "Stateful approach to unpacking HDF files. Registers all gdal formats,
-Creates a temp directory, then saves the byte array to disk. This byte
-array is processed with gdal, and then the temp directory is destroyed.
-Function returns the decompressed MODIS file as a 1-tuple."}
+  #^{:doc "Stateful approach to unpacking HDF files. Registers all
+gdal formats, Creates a temp directory, then saves the byte array to
+disk. This byte array is processed with gdal, and then the temp
+directory is destroyed. Function returns the decompressed MODIS file
+as a 1-tuple."}
   unpack {:stateful true}
   ([]
      (do


Populate the scm tag in the pom with git data if available.

--- src/leiningen/pom.clj
+++ src/leiningen/pom.clj
@@ -1,9 +1,9 @@
 (ns leiningen.pom
   "Write a pom.xml file to disk for Maven interop."
   (:require [lancet])
-  (:use [clojure.contrib.duck-streams :only [writer]]
+  (:use [clojure.contrib.duck-streams :only [reader writer]]
         [clojure.contrib.java-utils :only [file]])
-  (:import [org.apache.maven.model Model Parent Dependency Repository]
+  (:import [org.apache.maven.model Model Parent Dependency Repository Scm]
            [org.apache.maven.project MavenProject]
            [org.apache.maven.artifact.ant Pom]))

@@ -12,6 +12,63 @@
   Please do not edit it directly; instead edit project.clj and regenerate it.
   It should not be considered canonical data. For more information see
   http://github.com/technomancy/leiningen -->\n")
+
+(defn read-git-ref
+  "Reads the commit SHA1 for a git ref path."
+  [git-dir ref-path]
+  (.trim (slurp (str (file git-dir ref-path)))))
+
+(defn read-git-head
+  "Reads the value of HEAD and returns a commit SHA1."
+  [git-dir]
+  (let [head (.trim (slurp (str (file git-dir "HEAD"))))]
+    (if-let [ref-path (second (re-find #"ref: (\S+)" head))]
+      (read-git-ref git-dir ref-path)
+      head)))
+
+(defn read-git-origin
+  "Reads the URL for the remote origin repository."
+  [git-dir]
+  (with-open [rdr (reader (file git-dir "config"))]
+    (->> (map #(.trim %) (line-seq rdr))
+         (drop-while #(not= "[remote \"origin\"]" %))
+         (next)
+         (take-while #(not (.startsWith % "[")))
+         (map #(re-matches #"url\s*=\s*(\S*)\s*" %))
+         (filter identity)
+         (first)
+         (second))))
+
+(defn parse-github-url
+  "Parses a GitHub URL returning a [username repo] pair."
+  [url]
+  (when url
+    (next
+     (or
+      (re-matches #"(?:git@)?github.com:([^/]+)/([^/]+).git" url)
+      (re-matches #"[^:]+://(?:git@)?github.com/([^/]+)/([^/]+).git" url)))))
+
+(defn github-urls [url]
+  (when-let [[user repo] (parse-github-url url)]
+    {:public-clone (str "git://github.com/" user "/" repo ".git")
+     :dev-clone (str "ssh://git@github.com/" user "/" repo ".git")
+     :browse (str "http://github.com/" user "/" repo)}))
+
+(defn make-git-scm [git-dir]
+  (try
+   (let [origin (read-git-origin git-dir)
+         head (read-git-head git-dir)
+         urls (github-urls origin)
+         scm (Scm.)]
+     (.setUrl scm (:browse urls))
+     (.setTag scm head)
+     (when (:public-clone urls)
+       (.setConnection scm (str "scm:git:" (:public-clone urls))))
+     (when (:dev-clone urls)
+       (.setDeveloperConnection scm (str "scm:git:" (:dev-clone urls))))
+     scm)
+   (catch java.io.FileNotFoundException e
+     nil)))

 (defn make-dependency [[dep version]]
   (doto (Dependency.)
@@ -35,7 +92,8 @@
                 (.setName (:name project))
                 (.setVersion (:version project))
                 (.setGroupId (:group project))
-                (.setDescription (:description project)))]
+                (.setDescription (:description project))
+                (.setScm (make-git-scm (file (:root project) ".git"))))]
     ;; TODO: add leiningen as a test-scoped dependency
     (doseq [dep (:dependencies project)]
       (.addDependency model (make-dependency dep)))


Close port on shutdown

Close port on shutdown

--- src/pericles/core.clj
+++ src/pericles/core.clj
@@ -16,6 +16,8 @@
         gpio-port 17]
     (try
       (gpio/init-port gpio-port)
+      (.addShutdownHook (Runtime/getRuntime)
+                        (Thread. (fn [] (gpio/destroy-port gpio-port))))
       ;; Passing app as var makes it possible to redefine routes/handlers while
       ;; the server is running.
       (reset! server (run-jetty #'app {:port server-port :join? false}))