improvements

improvements

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -13,15 +13,16 @@
              [xml :refer [emit-str indent parse-str sexp-as-element]]]
             [clojure.java.io :as io :refer [make-parents writer]]
             [clojure.tools.logging :as log]
-            [json-path :refer [at-path]]
-            [dk.ative.docjure.spreadsheet :refer [load-workbook sheet-seq row-seq cell-seq read-cell]]
-            [clojure.data.xml :refer [cdata]])
+            [dk.ative.docjure.spreadsheet
+             :refer
+             [load-workbook read-cell row-seq select-sheet sheet-seq]]
+            [json-path :refer [at-path]])
   (:import [clojure.data.xml CData Element]
            clojure.lang.ExceptionInfo
            java.lang.Integer
-           java.util.concurrent.Executors
+           java.text.SimpleDateFormat
            java.util.Calendar
-           java.text.SimpleDateFormat))
+           java.util.concurrent.Executors))

 (def ^:const fields [:suite :test :url :verb :headers :payload :params :exp-status :exp-body
                      :exp-headers :options :extractions])
@@ -178,23 +179,27 @@
    (or (and (visited x) x)
        (some #(cyclic? deps % (conj visited x)) (deps x)))))

-(defmulti read-rows (fn [file]
+(defmulti read-rows (fn [file _]
                       (cond
                         (str/ends-with? file ".csv") :csv
                         (str/ends-with? file ".xlsx") :excel)))

-(defmethod read-rows :excel [file]
-  (into [] (->> (load-workbook file) sheet-seq first row-seq
-                (map #(map (fn[i] (if-let [c (.getCell % i)] (str (read-cell c)) ""))
-                           (range (count fields))))
-                rest)))
-
-(defmethod read-rows :csv [file]
+(defmethod read-rows :excel [file sheet]
+  (let [wk-book (load-workbook file)
+        wk-sheet (cond
+                   (string? sheet) (-> wk-book (select-sheet sheet))
+                   :else (-> wk-book sheet-seq first))]
+    (into [] (->> wk-sheet row-seq
+                  (map #(map (fn[i] (if-let [c (.getCell % i)] (str (read-cell c)) ""))
+                             (range (count fields))))
+                  rest))))
+
+(defmethod read-rows :csv [file _]
   (with-open [in-file (io/reader file)]
     (doall (rest (csv/read-csv in-file)))))

-(defn tests-from [file]
-  (let [tests (->> (map #(zipmap fields %) (read-rows file))
+(defn tests-from [file sheet]
+  (let [tests (->> (map #(zipmap fields %) (read-rows file sheet))
                    (map-indexed #(-> %2 (assoc :placeholders (placeholders-of %2) :id %1)
                                      (update :extractions str->map #"\s*=\s*"))))
         extractors (for [t tests :when (:extractions t)] [(:id t) (map first (:extractions t))])
@@ -294,22 +299,23 @@
       (print (if (:success test) "\u001B[32m [v] " "\u001B[31m [x] "))
       (println (:test test) "\t" (or result :success) "\u001B[0m"))))

-(defn junit-report [dest-file src-file {:keys [suites]}]
-  (make-parents dest-file)
-  (with-open [out (writer dest-file)]
-    (indent (sexp-as-element
-             [:testsuites
-              (for [{:keys [name tests total failure error skipped]} suites]
-                [:testsuite {:name name :errors error :tests total :failures failure}
-                 (for [test tests]
-                   [:testcase {:name (:test test) :classname src-file :time (:time test)}
-                    (condp test nil
-                      :error :>> #(vector :error {:message %})
-                      :failure :>> #(vector :failure {:message %}
-                                            [:-cdata (print-http-message test (:resp test))])
-                      :skipped [:skipped]
-                      nil)])])])
-            out)))
+(defn junit-report [opts src-file {:keys [suites]}]
+  (let [dest-file (opts "report.file" (str "target/" (str/replace src-file #"\.[^.]+" "-results.xml")))]
+    (make-parents dest-file)
+    (with-open [out (writer dest-file)]
+      (indent (sexp-as-element
+               [:testsuites
+                (for [{:keys [name tests total failure error skipped]} suites]
+                  [:testsuite {:name name :errors error :tests total :failures failure}
+                   (for [test tests]
+                     [:testcase {:name (:test test) :classname src-file :time (:time test)}
+                      (condp test nil
+                        :error :>> #(vector :error {:message %})
+                        :failure :>> #(vector :failure {:message %}
+                                              [:-cdata (print-http-message test (:resp test))])
+                        :skipped [:skipped]
+                        nil)])])])
+              out))))

 (defn -main
   "Executes HTTP requests specified in the argument provided spreadsheet."
@@ -326,12 +332,9 @@
     (set-agent-send-off-executor! (Executors/newFixedThreadPool pool-size)))
   (try
     (let [opts (apply hash-map (map-indexed #(if (even? %1) (subs %2 1) %2) (rest args)))
-          _ (println "running with arguments:" opts)
           tests-file (first args)
-          xml-report (or (opts "report")
-                         (str "target/" (str/replace tests-file #"\.csv" "-results.xml")))
-          results (-> tests-file tests-from (exec-tests opts) summarise-results)]
-      ((juxt #(junit-report xml-report tests-file %) print-test-results) results)
+          results (-> tests-file (tests-from (opts "sheet")) (exec-tests opts) summarise-results)]
+      ((juxt #(junit-report opts tests-file %) print-test-results) results)
       (System/exit (- (results :total 0) (results :success 0))))
     (finally
       (shutdown-agents))))


fix syntax error

fix syntax error

--- src/rester/core.clj
+++ src/rester/core.clj
@@ -131,7 +131,7 @@
                (let [result (cond
                               (.startsWith path "$") (at-path path body)
                               (.startsWith path "#") (re-find (re-pattern path) body)
-                              (at-path (str "$." path) resp))]
+                              true (at-path (str "$." path) resp))]
                  (log/info "extracted:" name "=" result)
                  [name result])
                (catch Exception e


improve comments

improve comments

--- src/workshop/challenge_2_0.clj
+++ src/workshop/challenge_2_0.clj
@@ -27,9 +27,9 @@
       ;; type. :input and :output catalog entries talk to plugins.
       ;; Plugins are the mechanism by which data is moved in and out of
       ;; Onyx. The important thing to note here is :onyx/ident.
-      ;; This is mapped to a predefined keyword by the plugin author.
-      ;; You'd typically find this catalog entry in the README of the
-      ;; plugin repository.
+      ;; This is mapped to a predefined keyword (resolved to a fn in that namespace)
+      ;; by the plugin author. You'd typically find this
+      ;; catalog entry in the README of the plugin repository.
       {:onyx/name :read-segments
        :onyx/plugin :onyx.plugin.core-async/input
        :onyx/type :input
@@ -40,11 +40,10 @@
        :onyx/doc "Reads segments from a core.async channel"}

       ;; Onyx function tasks require a :onyx/fn parameter to
-      ;; be defined, pointing to a keyword that represents
-      ;; a function. This function *must* be required onto
-      ;; the classpath before it is resolved. Unless otherwise
-      ;; specified, it should take exactly one parameter - a single
-      ;; segment.
+      ;; be defined, which is a keyword that maps to a namespace and var name
+      ;; The function's ns *must* be required onto the classpath before it is
+      ;; resolved. Unless otherwise specified, it should take exactly one
+      ;; parameter - a single segment.
       {:onyx/name :times-two
        :onyx/fn :workshop.challenge-2-0/times-two
        :onyx/type :function
@@ -103,4 +102,4 @@

    {:lifecycle/task :write-segments
     :lifecycle/calls :onyx.plugin.core-async/writer-calls
-    :onyx/doc "core.async plugin base lifecycle"}])+    :onyx/doc "core.async plugin base lifecycle"}])


Improve trigger summary in information model doc.

--- doc/information_model.clj
+++ doc/information_model.clj
@@ -285,7 +285,7 @@
                                            :type :function
                                            :optional? false}}}
  :trigger-entry
- {:summary "In this section, we talk about Triggers. Triggers are a feature that interact with Windows. Windows capture and bucket data over time. Triggers let you release the captured data over a variety stimuli."
+ {:summary "Triggers are a feature that interact with Windows. Windows capture and bucket data over time. Triggers let you release the captured data over a variety stimuli."
   :link nil
   :model {:trigger/window-id
           {:doc "The name of a `:window/id` window to fire the trigger against."


rename exception

rename exception

--- src/shuppet/aws.clj
+++ src/shuppet/aws.clj
@@ -70,7 +70,7 @@
                  (zip/xml-zip))]
     (if (= 200 status)
       body
-      (throw+ {:type ::clj-http
+      (throw+ {:type ::elb
                :status status
                :code (xml1-> body :Error :Code text)
                :message (xml1-> body :Error :Message text) }))))


Fix config iss for redismq hook

Fix config iss for redismq hook

--- src/ctia/flows/hooks/event_hooks.clj
+++ src/ctia/flows/hooks/event_hooks.clj
@@ -68,7 +68,9 @@
               port 6379}}
         (get-in @properties [:ctia :hook :redismq])]
     (->RedisMQPublisher (rmq/make-queue queue-name
-                                        (lr/server-connection host port timeout-ms)
+                                        {:host host
+                                         :port port
+                                         :timeout-ms timeout-ms}
                                         {:max-depth max-depth}))))

 (defrecord ChannelEventPublisher []


Use an auto-qualified keyword

Use an auto-qualified keyword

--- src/desdemona/lifecycles/logging.clj
+++ src/desdemona/lifecycles/logging.clj
@@ -20,4 +20,4 @@
      [:lifecycles]
      conj
      {:lifecycle/task task
-      :lifecycle/calls :desdemona.lifecycles.logging/log-calls})))
+      :lifecycle/calls ::log-calls})))


delineate between startup and fetch time

--- src/gh_waiting_room/github_tasks.clj
+++ src/gh_waiting_room/github_tasks.clj
@@ -4,6 +4,7 @@
             [gh-waiting-room.github :refer [all-hooks]]))

 (defn print-hooks []
+  (println "Fetching hooks...")
   (let [hooks (->> (all-hooks)
                    ;; convert to subvectors for table ordering
                    (map #(vec [(:name %) (:owner %) (clojure.string/join "," (:hooks %))]))


Decrease item utility on one-hit kills

Decrease item utility on one-hit kills

--- src/cljc/robinson/combat.cljc
+++ src/cljc/robinson/combat.cljc
@@ -442,6 +442,11 @@
           (if (contains? (set defender-path) :npcs)
             ;; defender is npc
             (-> state
+              ;; attacks use wielded weapons
+              (as-> state
+                (if attack-item
+                  (rp/dec-item-utility state (get attack-item :hotkey))
+                  state))
               ;; update stats and will-to-live
               (rp/update-npc-killed defender attack)
               ;; trigger on-death script for defender


Fixed searching

Fixed searching

--- src/cljs/bookmarx/search.cljs
+++ src/cljs/bookmarx/search.cljs
@@ -1,25 +1,25 @@
 (ns bookmarx.search
   (:require [clojure.string :as str]
             [reagent.session :as session]
-            [accountant.core :as accountant]
             [goog.window :as gwin]
             [taoensso.timbre :as log]
             [bookmarx.common :refer [env]]
             [bookmarx.header :as header]))

 (defn search-bookmarks "Search the bookmarks for the given text."
-  ([text bookmarks] (search-bookmarks text bookmarks []))
-  ([text bookmarks matches]
+  ([text bookmark-ids] (search-bookmarks text bookmark-ids []))
+  ([text bookmark-ids matches]
    (cond (nil? text) []
-         (empty? bookmarks) matches
-         (nil? (:bookmark/url (first bookmarks)))
-         (recur text (rest bookmarks)
-                (search-bookmarks text (-> bookmarks first :bookmark/id session/get :bookmark/children)
-                                  matches))
-         (or (str/index-of (str/upper-case (:bookmark/title (first bookmarks))) (str/upper-case text))
-             (str/index-of (str/upper-case (:bookmark/url (first bookmarks))) (str/upper-case text)))
-         (recur text (rest bookmarks) (conj matches (first bookmarks)))
-         :else (recur text (rest bookmarks) matches))))
+         (empty? bookmark-ids) matches
+         (nil? (:bookmark/url (session/get (first bookmark-ids))))
+         (recur text (rest bookmark-ids)
+                (search-bookmarks text (-> bookmark-ids first session/get :bookmark/children) matches))
+         (or (str/index-of (str/lower-case (:bookmark/title (session/get (first bookmark-ids))))
+                           (str/lower-case text))
+             (str/index-of (str/lower-case (:bookmark/url (session/get (first bookmark-ids))))
+                           (str/lower-case text)))
+         (recur text (rest bookmark-ids) (conj matches (first bookmark-ids)))
+         :else (recur text (rest bookmark-ids) matches))))

 (defn bookmark-link "Render a bookmark link."
   [bookmark]
@@ -43,7 +43,7 @@
   [:div.col-sm-12
    [header/header]
    [:div.breadcrumbs "Search: \"" (session/get :search) "\"" ]
-   (doall (map #(bookmark-link %)
+   (doall (map #(bookmark-link (session/get %))
                (search-bookmarks (session/get :search)
                                  (:bookmark/children (session/get 1)))))
    [:div [:a {:href (str (:prefix env) "/")} "go to the home page"]]])


refactor

refactor

--- src/com/kaicode/infamous.cljs
+++ src/com/kaicode/infamous.cljs
@@ -19,6 +19,9 @@
 (defonce RotationalSpring (.. physics -RotationalSpring))
 (defonce Quaternion (.. math -Quaternion))
 (defonce Vec3 (.. math -Vec3))
+
+(defn get-node-by-id [id]
+      (ffirst (d/q '[:find (pull ?node [*]) :in $ ?id :where [?node :node/id ?id]] @conn id)))

 (defn get-famous-components [node]
       (.. (:node/famous-node node) getComponents))
@@ -63,7 +66,6 @@
              :node/physics    {:db/cardinality :db.cardinality/one
                                :db/isComponent true
                                :db/valueType   :db.type/ref}})
-
 (def conn (d/create-conn schema))

 (defn save [scene-graph]
@@ -82,67 +84,66 @@
                                                       (put! c (or (payload-function) event))))))
         c))

-(defn create-component [component-descriptor famous-node]
-      (let [component-type (:component/type component-descriptor)]
-           (if (keyword? component-type)
-             (let [component-constructor (famous-components component-type)
-                   component (component-constructor. famous-node)
-                   properties (dissoc component-descriptor :component/type :db/id)]
-                  (doseq [p properties
-                          :let [name (name (first p))
-                                value (second p)]]
-                         (cond
-                           (= name "content") (.. component (setContent value))
-                           (= name "classes") (doseq [clz value]
-                                                     (.. component (addClass clz)))
-                           :else (do
-                                   (.. component (setProperty name value)))))
-                  component)
-             (let [component (clj->js component-descriptor)]
-                  (.. famous-node (addComponent component))
-                  component))))
-
-(defn- get-node-by-id [id]
-       (ffirst (d/q '[:find (pull ?node [*]) :in $ ?id :where [?node :node/id ?id]] @conn id)))
+(defn- create-component [component-descriptor famous-node]
+       (let [component-type (:component/type component-descriptor)]
+            (if (keyword? component-type)
+              (let [component-constructor (famous-components component-type)
+                    component (component-constructor. famous-node)
+                    properties (dissoc component-descriptor :component/type :db/id)]
+                   (doseq [p properties
+                           :let [name (name (first p))
+                                 value (second p)]]
+                          (cond
+                            (= name "content") (.. component (setContent value))
+                            (= name "classes") (doseq [clz value]
+                                                      (.. component (addClass clz)))
+                            :else (do
+                                    (.. component (setProperty name value)))))
+                   component)
+              (let [component (clj->js component-descriptor)]
+                   (.. famous-node (addComponent component))
+                   component))))

-(defn attach-famous-node-to-scene-graph [node]
-      (let [famous-node (Node.)
-            size-mode (clj->js (:node/size-mode node))
-            absolute-size (clj->js (:node/absolute-size node))
-            align (clj->js (:node/align node))
-            position (clj->js (:node/position node))
-            mount-point (clj->js (:node/mount-point node))
-            origin (clj->js (:node/origin node))
-            proportional-size (clj->js (:node/proportional-size node))
-            differential-size (clj->js (:node/differential-size node))
-            ]
-           (.apply (.-setSizeMode famous-node) famous-node size-mode)
-           (.apply (.-setAbsoluteSize famous-node) famous-node absolute-size)
-           (.apply (.-setAlign famous-node) famous-node align)
-           (.apply (.-setPosition famous-node) famous-node position)
-           (.apply (.-setMountPoint famous-node) famous-node mount-point)
-           (.apply (.-setOrigin famous-node) famous-node origin)
-           (.apply (.-setProportionalSize famous-node) famous-node proportional-size)
-           (.apply (.-setDifferentialSize famous-node) famous-node differential-size)
-
-           (doseq [child-node (:node/children node)
-                   :let [a-child-node (attach-famous-node-to-scene-graph child-node)
-                         a-famous-child-node (:node/famous-node a-child-node)]]
-                  (.. famous-node (addChild a-famous-child-node)))
-
-           (d/transact! conn [{:db/id            (:db/id node)
-                               :node/famous-node famous-node}])
-
-           (update-in node [:node/famous-node] #(identity famous-node))))

-(defn find-nodes-with-physics []
-      (map #(first %) (d/q '[:find (pull ?node [*]) :where [?node :node/physics _]] @conn)))
+(defn- attach-famous-node-to-scene-graph [node]
+       (let [famous-node (Node.)
+             size-mode (clj->js (:node/size-mode node))
+             absolute-size (clj->js (:node/absolute-size node))
+             align (clj->js (:node/align node))
+             position (clj->js (:node/position node))
+             mount-point (clj->js (:node/mount-point node))
+             origin (clj->js (:node/origin node))
+             proportional-size (clj->js (:node/proportional-size node))
+             differential-size (clj->js (:node/differential-size node))
+             ]
+            (.apply (.-setSizeMode famous-node) famous-node size-mode)
+            (.apply (.-setAbsoluteSize famous-node) famous-node absolute-size)
+            (.apply (.-setAlign famous-node) famous-node align)
+            (.apply (.-setPosition famous-node) famous-node position)
+            (.apply (.-setMountPoint famous-node) famous-node mount-point)
+            (.apply (.-setOrigin famous-node) famous-node origin)
+            (.apply (.-setProportionalSize famous-node) famous-node proportional-size)
+            (.apply (.-setDifferentialSize famous-node) famous-node differential-size)
+
+            (doseq [child-node (:node/children node)
+                    :let [a-child-node (attach-famous-node-to-scene-graph child-node)
+                          a-famous-child-node (:node/famous-node a-child-node)]]
+                   (.. famous-node (addChild a-famous-child-node)))
+
+            (d/transact! conn [{:db/id            (:db/id node)
+                                :node/famous-node famous-node}])
+
+            (update-in node [:node/famous-node] #(identity famous-node))))

-(defn find-nodes-with-components []
-      (map #(first %) (d/q '[:find (pull ?node [*]) :where [?node :node/components _]] @conn)))
+(defn- find-nodes-with-physics []
+       (map #(first %) (d/q '[:find (pull ?node [*]) :where [?node :node/physics _]] @conn)))
+
+
+(defn- find-nodes-with-components []
+       (map #(first %) (d/q '[:find (pull ?node [*]) :where [?node :node/components _]] @conn)))

 (defn render-scene-graph [root-id]
       (let [simulation (PhysicsEngine.)


fixed cljs obj-extends? to have special case for nil because it cannot be reflected on like normal objects

--- src/com/rpl/specter/impl.cljc
+++ src/com/rpl/specter/impl.cljc
@@ -102,13 +102,15 @@

 :cljs
 (defn obj-extends? [prot-sym obj]
-  ;; this requires that prot-sym be fully qualified
-  (let [props (->> obj type .-prototype (.getOwnPropertyNames js/Object) seq)
-        ns (namespace prot-sym)
-        n (name prot-sym)
-        lookup (str (s/replace ns "." "$") "$" n "$")]
-    (seq-contains? props lookup)
-    ))
+  (if (nil? obj)
+    (= prot-sym `p/StructurePath)
+    ;; this requires that prot-sym be fully qualified
+    (let [props (->> obj type .-prototype (.getOwnPropertyNames js/Object) seq)
+          ns (namespace prot-sym)
+          n (name prot-sym)
+          lookup (str (s/replace ns "." "$") "$" n "$")]
+      (seq-contains? props lookup)
+      )))
 )

 #?(:clj


amended docstrings

amended docstrings

--- euler-clj/src/euler_clj/core.clj
+++ euler-clj/src/euler_clj/core.clj
@@ -43,7 +43,7 @@
   (apply + (filter even? (take-while (partial > n) (fib-seq)))))

 (defn stepped-fib-seq
-  "Retur a lazy sequence of every nth Fibonacci numbers."
+  "Retur a lazy sequence of every nth Fibonacci number."
   [step]
   (map fib (iterate #(+ % step) step)))


include counts of members of base-clusters in n-members of groups

--- src/polismath/conversation.clj
+++ src/polismath/conversation.clj
@@ -295,7 +295,12 @@
                                          (mapv #(((votes-base tid) vote) %))
                                          (apply +)))]
                                [id
-                                {:n-members (count members)
+                                {:n-members (reduce + 0
+                                              ; Add up the count of members in each base-cluster in this group-cluster
+                                              (map (fn [bid]
+                                                     (count (:members
+                                                         (first (filter (fn [x] (= bid (:id x))) base-clusters)))))
+                                                   members))
                                  :votes (plmb/map-from-keys
                                           (fn [tid]
                                             {:A (count-fn tid :A)


Renamed unused input parameters with _

Renamed unused input parameters with _


added caching test, fixed broken test

added caching test, fixed broken test

--- test/staircase/test/assets.clj
+++ test/staircase/test/assets.clj
@@ -223,6 +223,19 @@
         (is (= 200 (:status resp)))
         (is (= expected-css (-> resp :body (.trim))))))))

+(deftest not-modified-responses
+  (testing "use of the if-none-match header"
+    (let [pipeline (pipeline :ls "ls" :coffee "coffee"
+                             :js-dir "/js"
+                             :css-dir "/css"
+                             :as-resource "assets")
+          handler (fn [{uri :uri :as req}] (if (= uri "/") fake-index i-know-nothing!))
+          app (pipeline handler)
+          cksm (checksum ls-file)
+          req  (-> (GET "/js/test.ls") (assoc :headers {"if-none-match" (str cksm)}))
+          resp (app req)]
+      (is (= 304 (:status resp))))))
+
 (deftest test-pipeline
   (testing "default pipeline"
     (let [pipeline (pipeline :ls "ls" :coffee "coffee"


Simple changes - Better reporting (for unit testing unit testing) - Factored out System/exit call (for with-redefs mock-out)

--- jvm-runner/src/clojure/codewars/clojure/test.clj
+++ jvm-runner/src/clojure/codewars/clojure/test.clj
@@ -14,7 +14,7 @@

 (defn- print-context []
   (when (seq *testing-contexts*)
-      (->> (testing-contexts-str) (str "<IT::>") println)))
+    (->> (testing-contexts-str) (str "<IT::>") println)))

 (defn- print-with-message [status {:keys [:message]}]
   (if (string? message)
@@ -30,28 +30,33 @@
 (defn- print-expectations [{:keys [:expected :actual]}]
   (println "expected:" (pr-str expected) "- actual:" (expr-str actual)))

+(defn- fail []
+  (flush)
+  (System/exit 1))
+
 (defmulti codewars-report :type)

 (defmethod codewars-report :pass [_]
   (with-test-out
+    (inc-report-counter :pass)
     (print-context)
     (println "<PASSED::>Test Passed")))

 (defmethod codewars-report :fail [m]
   (with-test-out
+    (inc-report-counter :fail)
     (print-context)
     (print-with-message "<FAILED::>" m)
     (print-expectations m))
-  (flush)
-  (System/exit 1))
+  (fail))

 (defmethod codewars-report :error [m]
   (with-test-out
+    (inc-report-counter :error)
     (print-context)
     (print-with-message "<ERROR::>" m)
     (print-expectations m))
-  (flush)
-  (System/exit 1))
+  (fail))

 (defmethod codewars-report :begin-test-ns [_])
 (defmethod codewars-report :end-test-ns [_])


Changing date time generator to be a var instead of a function.

--- src/cmr/common/test/test_check_ext.clj
+++ src/cmr/common/test/test_check_ext.clj
@@ -131,7 +131,6 @@
   ([min-size max-size]
    (gen/fmap s/join (gen/vector gen/char-alpha-numeric min-size max-size))))

-(defn date-time
-  "Creates a generator that will return a Joda DateTime between 1970-01-01T00:00:00.000Z and 2114-01-01T00:00:00.000Z"
-  []
+(def date-time
+  "A generator that will return a Joda DateTime between 1970-01-01T00:00:00.000Z and 2114-01-01T00:00:00.000Z"
   (gen/fmap c/from-long (gen/choose 0 4544208000000)))


Provide a means for braid consumers to stop the application

--- src/braid/core.clj
+++ src/braid/core.clj
@@ -1,24 +1,34 @@
 (ns braid.core
   (:gen-class)
   (:require
-    [mount.core :as mount]
-    [org.httpkit.client]
-    [org.httpkit.sni-client]
-    [braid.core.modules :as modules]
-    ;; all following requires are for mount:
-    [braid.core.server.core]
-    [braid.core.server.email-digest :refer [email-jobs]]))
+   [mount.core :as mount]
+   [org.httpkit.client]
+   [org.httpkit.sni-client]
+   [braid.core.modules :as modules]
+   ;; all following requires are for mount:
+   [braid.core.server.core]
+   [braid.core.server.email-digest :refer [email-jobs]]))

 ;; because we often use http-kit as our http-client
 ;; including this so that SNI works
 (alter-var-root #'org.httpkit.client/*default-client*
                 (fn [_] org.httpkit.sni-client/default-client))

+(defn start!
+  "Entry point for prod"
+  [port]
+  ;; modules must run first
+  (modules/init!)
+  (-> (mount/with-args {:port port})
+      (mount/start {:port port})))
+
+(defn stop!
+  "Helper function for stopping all Braid components."
+  []
+  (mount/stop))
+
 (defn -main
   "Entry point for prod"
   [& args]
   (let [port (Integer/parseInt (first args))]
-    ; modules must run first
-    (modules/init!)
-    (-> (mount/with-args {:port port})
-        (mount/start {:port port}))))
+    (start! port)))


Got rid of root-actx atomic race.

Got rid of root-actx atomic race.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -282,7 +282,6 @@
         gen-id #(swap! last-id inc)
         w [{:gen-id gen-id
             :event-ch event-ch}]
-        root-actx (atom nil)
         vis (atom {:actxs {} ; {actx -> {:children {child-actx -> true},
                              ;           :wait-chs {ch -> [:take|:put optional-ch-name])},
                              ;           :loop-state last-loop-bindings
@@ -305,32 +304,31 @@
         (when (> @event-delay 0) (<! (timeout @event-delay)))
         (when (< @event-delay 0) (<! step-ch)))
         (recur (inc num-events)))
-    (go-loop [vis-last nil ; Process render-ch, updating U/I.
-              vis-last-positions nil
-              vis-last-html nil
-              vis-last-svg nil]
-      (let [[vis-next deltas after event-str] (<! render-ch)]
-        (set-el-innerHTML (str el-prefix "-event") event-str)
-        (if after
-          (let [vis-next-positions (atom {})
-                actx-ch-ch-infos (group-by #(:first-taker-actx (second %)) (:chs vis-next))]
-            (assign-positions vis-next @root-actx vis-next-positions actx-ch-ch-infos nil)
-            (let [vis-next-html (apply str (flatten (vis-html-actx vis-next @root-actx
-                                                                   actx-ch-ch-infos)))
-                  vis-next-svg (apply str (flatten (vis-svg-actxs vis-next @vis-next-positions
-                                                                  deltas true)))]
-              (when (not= vis-next-html vis-last-html)
-                (set-el-innerHTML (str el-prefix "-html") vis-next-html))
-              (when (not= vis-next-svg vis-last-svg)
-                (set-el-innerHTML (str el-prefix "-svg") vis-next-svg))
-              (recur vis-next @vis-next-positions vis-next-html vis-next-svg)))
-          (let [vis-next-svg (apply str (flatten (vis-svg-actxs vis-last vis-last-positions
-                                                                deltas false)))]
-            (when (not= vis-next-svg vis-last-svg)
-              (set-el-innerHTML (str el-prefix "-svg") vis-next-svg))
-            (recur vis-last vis-last-positions vis-last-html vis-next-svg)))))
     (ago world w
-         (reset! root-actx world)
+         (go-loop [vis-last nil ; Process render-ch, updating U/I.
+                   vis-last-positions nil
+                   vis-last-html nil
+                   vis-last-svg nil]
+           (let [[vis-next deltas after event-str] (<! render-ch)]
+             (set-el-innerHTML (str el-prefix "-event") event-str)
+             (if after
+               (let [vis-next-positions (atom {})
+                     actx-ch-ch-infos (group-by #(:first-taker-actx (second %)) (:chs vis-next))]
+                 (assign-positions vis-next world vis-next-positions actx-ch-ch-infos nil)
+                 (let [vis-next-html (apply str (flatten (vis-html-actx vis-next world
+                                                                        actx-ch-ch-infos)))
+                       vis-next-svg (apply str (flatten (vis-svg-actxs vis-next @vis-next-positions
+                                                                       deltas true)))]
+                   (when (not= vis-next-html vis-last-html)
+                     (set-el-innerHTML (str el-prefix "-html") vis-next-html))
+                   (when (not= vis-next-svg vis-last-svg)
+                     (set-el-innerHTML (str el-prefix "-svg") vis-next-svg))
+                   (recur vis-next @vis-next-positions vis-next-html vis-next-svg)))
+               (let [vis-next-svg (apply str (flatten (vis-svg-actxs vis-last vis-last-positions
+                                                                     deltas false)))]
+                 (when (not= vis-next-svg vis-last-svg)
+                   (set-el-innerHTML (str el-prefix "-svg") vis-next-svg))
+                 (recur vis-last vis-last-positions vis-last-html vis-next-svg)))))
          (let [in-ch (achan-buf world 100)
                out-ch (achan-buf world 0)]
            (ago-loop user-in world [num-ins 0]


Restore old require

Restore old require

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -1,8 +1,7 @@
 (ns expound.alpha
   "Generates human-readable errors for `clojure.spec`"
   (:require [expound.problems :as problems]
-            #?(:clj [clojure.spec.alpha :as s]
-               :cljs [cljs.spec.alpha :as s])
+            [clojure.spec.alpha :as s]
             [clojure.string :as string]
             [clojure.set :as set]
             [clojure.walk :as walk]


Change a link to ChromeDriver source code (#208)

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -8,7 +8,7 @@
   https://www.w3.org/TR/webdriver/

   Chrome:
-  https://github.com/bayandin/chromedriver/
+  https://chromium.googlesource.com/chromium/src/+/master/chrome/test/chromedriver/

   Firefox (Geckodriver):
   https://github.com/mozilla/geckodriver


cjl - Unit translation

cjl - Unit translation

--- src/icfp2015/board.clj
+++ src/icfp2015/board.clj
@@ -14,13 +14,19 @@
     :filled filled
     :current-unit initial-unit })

+(defn translate [dx dy]
+  (fn [unit]
+    (let [f (fn [[x y]] [(+ x dx) (+ y dy)])]
+      { :members (set (map f (:members unit)))
+        :pivot (f (:pivot unit)) })))
+
 ; these are possible commands
 ; [ [:move :west] [:move :east] [:move :southwest] [:move :southeast]
 ;   [:rotate :clockwise] [:rotate :counterclockwise] ]
 (defn transition-board
   "Given a board and command, returns a new board. Raises if performing
   the command puts the board into an illegal state"
-  [board command]
+  [board [command direction]]
   nil)

 (defn lock-and-spawn


Fix styles

Fix styles

--- src/gol/styles.clj
+++ src/gol/styles.clj
@@ -10,8 +10,8 @@
   [:#app {
     :display "table-cell"
     :vertical-align "middle"
-    :text-align "center" }
-    :margin [[0 (px -1) (px -1) 0]]]
+    :text-align "center"
+    :margin [[0 (px -1) (px -1) 0]]}]

   [:.cell-area {
     :display "inline-block"


Don't put a question mark at the end of the route urls

--- src-cljs/tamarack/routes.cljs
+++ src-cljs/tamarack/routes.cljs
@@ -66,10 +66,18 @@
 (defn remove-route-defaults [route]
   (update-in route [:query-params] remove-default-query-params))

+(defn cleanup-query-params [route]
+  (if (-> route :query-params empty?)
+    (dissoc route :query-params)
+    route))
+
 (defn navigate-to
   ([route arg]
-     (let [url (route (remove-route-defaults
-                       (merge {:query-params (timeslice-query-params)} arg)))]
+     (let [url (->> arg
+                    (merge {:query-params (timeslice-query-params)})
+                    remove-route-defaults
+                    cleanup-query-params
+                    route)]
        (.setToken history/history (subs url 1))))
   ([route]
      (navigate-to route {})))
@@ -84,5 +92,7 @@
         new-query-params (remove-default-query-params
                           (merge query-params (timeslice-query-params)))
         new-query-string (secretary/encode-query-params new-query-params)
-        token (string/join "?" [path new-query-string])]
+        token (if (empty? new-query-string)
+                path
+                (string/join "?" [path new-query-string]))]
     (.setToken history/history token)))


Show specialization title instead of id in error message

--- src/kmg/domain.clj
+++ src/kmg/domain.clj
@@ -83,13 +83,16 @@
        (sort-by-second)
        (every-first)))

+(defn specialization-title [db spec-id]
+  (:specialization/title (d/entity db spec-id)))
+
 (defn check-if-spec-is-one-of-goal-history
   [db user spec]
   (let [goal-history (user-goals-history db user)]
     (if (not (in? goal-history spec))
       (throw (IllegalArgumentException.
               (str "Trying get recommendations for specialization that is not one of users history of goals; User: "
-                   user "; Specialization: " spec))))))
+                   user "; Specialization: " (specialization-title db spec)))))))

 ;; (recommendations-for-user (db) "user2")
 (defn recommendation-ids


Added expand-cluster

Added expand-cluster

--- src/pscan/core.clj
+++ src/pscan/core.clj
@@ -15,14 +15,56 @@
           dy (- (a 1) (b 1))]
       (Math/sqrt (+ (* dx dx) (* dy dy))))))

-(defn region-query-serial
+(defn region-query
   "Serial region query; returns all pts within eps of pt by metric."
   [pt pts metric eps]
   (letfn [(is-local? [x] (<= (metric pt x) eps))]
     (into [] (filter is-local? pts))))

+(defn expand-cluster
+  "Expand cluster at pt
+   Returns false if there is not cluster to be had
+   Returns the core points of the cluster and an updated visited set otherwise"
+  [pt pts metric eps min-pts visited]
+
+  (let [local (region-query pt pts metric eps)]
+    (if (< (count local) min-pts)
+      false
+    ;else
+      (loop [s (disj (set (remove #(visited %) local)) pt)
+             c #{pt}
+             v (conj visited pt)]
+        (if (empty? s)
+          {:core c, :visited v}
+        ;else
+          (let [current-point (first s)
+                result (region-query current-point pts metric eps)
+                size (count result)
+                unvisited-result (filter #(not (v %)) result)]
+
+            (if (>= size min-pts) ;new core point
+              (recur (disj (into s unvisited-result) current-point)
+                     (conj c current-point)
+                     (conj v current-point))
+            ;else
+              (recur (disj s current-point)
+                     c
+                     (conj v current-point)))))))))
+
+
+
+

 (comment
+
+(def star [[0 0] [0 1] [1 0] [-1 0] [0 -1]])
+
+(expand-cluster [0 0] star r2-dist 1 2 #{})
+
+(expand-cluster [0 0] star r2-dist 1 5 #{})
+
+(expand-cluster [-1 0] star r2-dist 1.5 5 #{})
+
 (def x (into [] (take 10000000 (repeatedly rand))))

 (time (into [] (filter #(> % 0.999999) x)))
@@ -35,7 +77,8 @@

 (time (r/fold (r/monoid s/union hash-set) conj (r/filter #(> % 0.999999) x)))

-(region-query-serial [0 0] pts r2-dist 2)
+(region-query [0 0] pts r2-dist 2)

-  )
+(map #(region-query % pts r2-dist 1) '([0 0] [0 1]))
+)


shared(:subcat :1 :person, :subcat :2 :person)

--- src/babel/espanol/lexicon.clj
+++ src/babel/espanol/lexicon.clj
@@ -452,6 +452,7 @@
    (let [subject-semantics (ref {:human true})
          called-semantics (ref :top)
          subject-gender (ref :top)
+         subject-person (ref :top)
          subject-number (ref :top)]
      {:synsem {:cat :verb
                :sem {:pred :be-called
@@ -459,10 +460,12 @@
                      :subj subject-semantics
                      :obj called-semantics}
                :subcat {:1 {:agr {:number subject-number
+                                  :person subject-person
                                   :gender subject-gender}
                             :propernoun false ;; avoid things like 'Juan se llamó Juan'
                             :sem subject-semantics}
                         :2 {:agr {:number subject-number
+                                  :person subject-person
                                   :gender subject-gender}
                             :pronoun true
                             :reflexive true


It works!

It works!

--- src/clj/cljstatic/scheme2.clj
+++ src/clj/cljstatic/scheme2.clj
@@ -53,7 +53,7 @@
    (match (seq form)
      nil form

-     (['quote val] :seq) val
+     (['quote val] :seq) (list 'quote val)

      (['lambda params & body] :seq)
      (let [lambda-env (extend-env env params)]
@@ -137,10 +137,10 @@
 (defn gen-closure-fields
   [^ClassVisitor cv closed-overs]
   (doseq [c closed-overs]
-    (. cv visitField (+ Opcodes/ACC_FINAL ) (close-name c) (.getDescriptor object-type) nil nil)))
+    (. cv visitField Opcodes/ACC_FINAL (close-name c) (.getDescriptor object-type) nil nil)))

 (defn gen-ctor
-  [cw fv]
+  [cw fqname fv]
   (let [ctor (Method. "<init>" Type/VOID_TYPE (into-array Type (repeat (count fv) object-type)))
         gen (GeneratorAdapter. Opcodes/ACC_PUBLIC ctor nil nil cw)]
     (. gen visitCode)
@@ -149,7 +149,7 @@
     (dotimes [n (count fv)]
       (. gen loadThis)
       (. gen loadArg n)
-      (. gen putField (close-name (nth fv n)) object-type))
+      (. gen putField (Type/getObjectType fqname) (close-name (nth fv n)) object-type))
     (. gen returnValue)
     (. gen endMethod)))

@@ -169,34 +169,55 @@
     (. gen returnValue)
     (. gen endMethod)))

+(defn emit-array
+  [gen asm-type contents]
+  (AsmUtil/pushInt gen (count contents))
+  (. gen newArray asm-type)
+  (dotimes [n (count contents)]
+    (. gen dup)
+    (AsmUtil/pushInt gen n)
+    (if (fn? (nth contents n))
+      ((nth contents n))
+      (. gen push (nth contents n)))
+    (. gen arrayStore asm-type)))
+
 (defn method-type
   [gen arity]
   (. gen push object-type)
-  (. gen push (count arity))
-  (. gen newArray (asmtype Class))
-  (dotimes [n (count arity)]
-    (. gen dup)
-    (. gen push n)
-    (. gen push object-type)
-    (. gen arrayStore))
+  (emit-array gen (asmtype Class) (repeat arity object-type))
   (. gen invokeStatic (asmtype MethodType) (Method/getMethod "java.lang.invoke.MethodType methodType(Class,Class[])")))

 (defn gen-handle
   [cw fqname arity]
   (let [^ClassVisitor cv cw]
-    (. cv visitField (+ Opcodes/ACC_STATIC Opcodes/ACC_FINAL) (handle-name arity) nil nil nil))
+    (. cv visitField (+ Opcodes/ACC_STATIC Opcodes/ACC_FINAL) (handle-name arity)
+       (.getDescriptor (asmtype MethodHandle)) nil nil))

   (let [clinitgen (GeneratorAdapter. (+ Opcodes/ACC_PUBLIC Opcodes/ACC_STATIC)
                                      (Method/getMethod "void <clinit>()")
-                                     nil nil cw)]
+                                     nil nil cw)
+        mt-local (. clinitgen newLocal (asmtype MethodType))]
     (. clinitgen visitCode)
+    (method-type clinitgen arity)
+    (. clinitgen storeLocal mt-local)
+
     (. clinitgen invokeStatic (asmtype MethodHandles) (Method/getMethod "java.lang.invoke.MethodHandles$Lookup lookup()"))
     (. clinitgen push (Type/getObjectType fqname))
     (. clinitgen push "invoke")
-    (method-type clinitgen arity)
+    (. clinitgen loadLocal mt-local)
     (. clinitgen invokeVirtual (asmtype MethodHandles$Lookup)
        (Method/getMethod "java.lang.invoke.MethodHandle findVirtual(Class,String,java.lang.invoke.MethodType)"))
-    (. clinitgen putField (handle-name arity) (asmtype MethodHandle))
+
+    (. clinitgen loadLocal mt-local)
+    (AsmUtil/pushInt clinitgen 0)
+    (emit-array clinitgen (asmtype Class) [ilambda-type])
+    (. clinitgen invokeVirtual (asmtype MethodType)
+       (Method/getMethod "java.lang.invoke.MethodType insertParameterTypes(int,Class[])"))
+
+    (. clinitgen invokeVirtual (asmtype MethodHandle)
+     (Method/getMethod "java.lang.invoke.MethodHandle asType(java.lang.invoke.MethodType)"))
+    (. clinitgen putStatic (Type/getObjectType fqname) (handle-name arity) (asmtype MethodHandle))
+
     (. clinitgen returnValue)
     (. clinitgen endMethod))

@@ -205,9 +226,11 @@
         false-label (. gen newLabel)
         end-label (. gen newLabel)]
     (. gen visitCode)
+    (. gen loadArg 0)
+    (AsmUtil/pushInt gen arity)
     (. gen ifCmp Type/INT_TYPE GeneratorAdapter/NE false-label)

-    (. gen getField (Type/getObjectType fqname) (handle-name arity) (asmtype MethodHandle))
+    (. gen getStatic (Type/getObjectType fqname) (handle-name arity) (asmtype MethodHandle))
     (. gen goTo end-label)

     (. gen mark false-label)
@@ -220,7 +243,7 @@
     (. gen invokeVirtual (asmtype StringBuilder) (Method/getMethod "StringBuilder append(String)"))
     (. gen loadArg 0)
     (. gen invokeVirtual (asmtype StringBuilder) (Method/getMethod "StringBuilder append(int)"))
-    (. gen push (str " for " (count arity) ")"))
+    (. gen push (str " for " arity ")"))
     (. gen invokeVirtual (asmtype StringBuilder) (Method/getMethod "StringBuilder append(String)"))
     (. gen invokeVirtual (asmtype StringBuilder) (Method/getMethod "String toString()"))
     (. gen invokeConstructor (asmtype IllegalArgumentException) (Method/getMethod "void <init>(String)"))
@@ -230,27 +253,30 @@
     (. gen returnValue)
     (. gen endMethod)))

+(def ^:dynamic *compiled-lambdas*)
 (defn compile
   "Compiles a given sanitized lambda form. If the input is not already
   sanitized, the results are undefined!

   Returns a vector of [<class name>, <closed-overs>, <bytecode>]"
   [[_ params & body :as lambda]]
-  (println "Compiling:" lambda)
-  (let [fv (vec (free-vars lambda))
-        cw (ClassWriter. ClassWriter/COMPUTE_FRAMES)
-        lname (str "lambda_" (next-id))
-        fqname (str "cljstatic/scheme2/" lname)
-        _ (println "fqname:" fqname)
-        dotname (.replace fqname "/" ".")
-        ifaces (make-array String 0)
-        env {:params params, :closed-overs fv, :locals {}}]
-    (. cw visit Opcodes/V1_7 Opcodes/ACC_PUBLIC fqname nil "java/lang/Object" ifaces)
-    (gen-closure-fields cw fv)
-    (gen-ctor cw fv)
-    (gen-body cw env body)
-    (gen-handle cw fqname (count params))
-    [dotname fv (.toByteArray cw)]))
+  (when-not (get @*compiled-lambdas* lambda)
+    (println "Compiling:" lambda)
+    (let [fv (vec (free-vars lambda))
+          cw (ClassWriter. ClassWriter/COMPUTE_FRAMES)
+          lname (str "lambda_" (next-id))
+          fqname (str "cljstatic/scheme2/" lname)
+          _ (println "fqname:" fqname)
+          dotname (.replace fqname "/" ".")
+          ifaces (into-array String ["cljstatic/ILambda"])
+          env {:params params, :closed-overs fv, :locals {} :thistype (Type/getObjectType fqname)}]
+      (. cw visit Opcodes/V1_7 Opcodes/ACC_PUBLIC fqname nil "java/lang/Object" ifaces)
+      (gen-closure-fields cw fv)
+      (gen-ctor cw fqname fv)
+      (gen-body cw env body)
+      (gen-handle cw fqname (count params))
+      (swap! *compiled-lambdas* conj lambda)
+      [dotname fv (.toByteArray cw)])))

 (defn emit
   [env context gen form]
@@ -265,7 +291,7 @@
    (emit-value context gen form)))

 (defn emit-symbol
-  [{:keys [params closed-overs locals] :as env} context gen sym]
+  [{:keys [params closed-overs locals thistype] :as env} context gen sym]
   (cond
    ((set params) sym)
    (. gen loadArg (.indexOf params sym))
@@ -273,7 +299,7 @@
    ((set closed-overs) sym)
    (do
      (. gen loadThis)
-     (. gen getField object-type (close-name sym) object-type))
+     (. gen getField thistype (close-name sym) object-type))

    ((set (keys locals)) sym)
    (. gen loadLocal (get locals sym))
@@ -354,13 +380,7 @@
 (defmethod emit-dup clojure.lang.Seqable
   [gen ^clojure.lang.Seqable lis]
   (println "emit-dup list" lis)
-  (. gen push (count lis))
-  (. gen newArray object-type)
-  (dotimes [n (count lis)]
-    (. gen dup)
-    (AsmUtil/pushInt gen n)
-    (emit-value :context/expression gen (nth lis n))
-    (. gen arrayStore object-type))
+  (emit-array gen object-type (map #(fn [] (emit-value :context/expression gen %)) lis))
   (. gen invokeStatic (asmtype java.util.Arrays) (Method/getMethod "java.util.List asList(Object[])"))
   (. gen invokeStatic (asmtype clojure.lang.PersistentList) (Method/getMethod "clojure.lang.IPersistentList create(java.util.List)")))

@@ -432,23 +452,45 @@
     (emit env context gen else)
     (. gen mark end-label)))

+(defn asm-println
+  "Generates bytecode to print the toString of whatever is on top of
+  the stack. Leaves stack unchaged."
+  [gen]
+  (. gen dup)
+  (. gen invokeVirtual object-type (Method/getMethod "String toString()"))
+  (. gen push "DEBUG: ")
+  (. gen swap)
+  (. gen invokeVirtual (asmtype String) (Method/getMethod "String concat(String)"))
+  (. gen push "clojure.core")
+  (. gen push "*out*")
+  (. gen invokeStatic (asmtype RT) (Method/getMethod "clojure.lang.Var var(String,String)"))
+  (. gen invokeVirtual (asmtype clojure.lang.Var) (Method/getMethod "Object deref()"))
+  (. gen checkCast (asmtype java.io.PrintWriter))
+  (. gen swap)
+  (. gen invokeVirtual (asmtype java.io.PrintWriter) (Method/getMethod "void println(String)")))
+
 (defmethod emit-seq -invoke-
   [env context gen [fun & args :as call]]
   (println "emitting invoke:" call)
   (println "context:" context)
+
   (emit env :context/expression gen fun)
+  (. gen dup)
   (. gen checkCast ilambda-type)
   (AsmUtil/pushInt gen (count args))
   (. gen invokeInterface ilambda-type (Method/getMethod "java.lang.invoke.MethodHandle getHandle(int)"))
+  (. gen swap)
+
   (doseq [a args]
     (emit env :context/expression gen a))
-  (. gen invokeVirtual (asmtype MethodHandle) (Method. "invoke" object-type (into-array Type (repeat (count args) object-type))))
+  (. gen invokeVirtual (asmtype MethodHandle) (Method. "invoke" object-type (into-array Type (cons ilambda-type (repeat (count args) object-type)))))
   (when (= context :context/statement)
     (. gen pop)))

 (defn scheme-eval
   [form]
-  (let [[name _ bytecode] (compile (sanitize {} `(~'lambda () '~form)))]
-    (.defineClass *class-loader* name bytecode form)
-    (.. (Class/forName name true *class-loader*) newInstance invoke)))
+  (binding [*compiled-lambdas* (atom #{})]
+    (let [[name _ bytecode] (compile (sanitize {} (list 'lambda () form)))]
+      (.defineClass *class-loader* name bytecode form)
+      (.. (Class/forName name true *class-loader*) newInstance invoke))))


Add cache-control header for some mime types

--- src/clj/clojuredocs/entry.clj
+++ src/clj/clojuredocs/entry.clj
@@ -89,6 +89,21 @@
   (fn [{:keys [session] :as r}]
     (h (assoc r :user (:user session)))))

+(defn wrap-long-caching [h]
+  (fn [r]
+    (let [res (h r)
+          res-ct (get-in res [:headers "Content-Type"])
+          content-types #{"text/css"
+                          "text/javascript"
+                          "application/font-woff"
+                          "font/opentype"
+                          "application/vnd.ms-fontobject"
+                          "image/svg+xml"
+                          "application/x-font-ttf"}]
+      (if (get content-types res-ct)
+        (update-in res [:headers] merge {"Cache-Control" "public, max-age=31536000"})
+        res))))
+
 (def routes
   (-> _routes
       promote-session-user
@@ -97,4 +112,9 @@
       wrap-params
       (wrap-session {:store session-store})
       (wrap-file "resources/public" {:allow-symlinks? true})
-      wrap-file-info))
+      (wrap-file-info {"woff" "application/font-woff"
+                       "otf" "font/opentype"
+                       "eot" "application/vnd.ms-fontobject"
+                       "svg" "image/svg+xml"
+                       "ttf" "application/x-font-ttf"})
+      wrap-long-caching))


only list not hidden files

only list not hidden files

--- src/clj/hdfs_cleaner/hdfs.clj
+++ src/clj/hdfs_cleaner/hdfs.clj
@@ -17,28 +17,32 @@
       (.globStatus path-pattern)))

 (defn scan** [^Path path depth max-depth]
-  (map
-    (fn [^FileStatus file]
-      (let [path (.getPath file)]
-        (merge {:name (-> path (.getName))
-                :is-dir (.isDirectory file)
-                :last-modified (.getModificationTime file)
-                :replication (.getReplication file)}
-               (try
-                 (if (and (.isDirectory file)
-                          (or (and depth max-depth (>= depth max-depth))))
-                   {:size (get-dir-size path)
-                    :sub-files "..."}
-                   (let [sub-files (when (.isDirectory file)
-                                     (scan** path (inc depth) max-depth))]
-                     {:sub-files sub-files
-                      :size (if sub-files
-                              (reduce + (map :size sub-files))
-                              (.getLen file))}))
-                 (catch Exception e
-                   (log/error e "Scan failed for dir:" (-> path (.toString)))
-                   {:has-error true})))))
-    (.listStatus HDFS/dfs path)))
+  (-> (map
+        (fn [^FileStatus file]
+          (let [path (.getPath file)
+                name (-> path (.getName))]
+            (when-not
+              (.startsWith name ".")
+              (merge {:name (-> path (.getName))
+                      :is-dir (.isDirectory file)
+                      :last-modified (.getModificationTime file)
+                      :replication (.getReplication file)}
+                     (try
+                       (if (and (.isDirectory file)
+                                (or (and depth max-depth (>= depth max-depth))))
+                         {:size (get-dir-size path)
+                          :sub-files "..."}
+                         (let [sub-files (when (.isDirectory file)
+                                           (scan** path (inc depth) max-depth))]
+                           {:sub-files sub-files
+                            :size (if sub-files
+                                    (reduce + (map :size sub-files))
+                                    (.getLen file))}))
+                       (catch Exception e
+                         (log/error e "Scan failed for dir:" (-> path (.toString)))
+                         {:has-error true}))))))
+        (.listStatus HDFS/dfs path))
+      (filter identity)))

 (defn scan* [^String path max-depth]
   (let [start-time (System/currentTimeMillis)]


RR: show calculate field on view-by dropdown

--- src/cljs/hatti/views/map.cljs
+++ src/cljs/hatti/views/map.cljs
@@ -97,7 +97,8 @@
             language (:current (om/observe owner (shared/language-cursor)))
             fields (filter #(or (f/categorical? %)
                                 (f/numeric? %)
-                                (f/time-based? %))
+                                (f/time-based? %)
+                                (f/calculate? %))
                                (f/non-meta-fields form))]
         (html
         [:div {:class "legend viewby top left"}


Allow shorthand partition shuffle to specify only key class.

--- src/clojure/parkour/graph.clj
+++ src/clojure/parkour/graph.clj
@@ -13,6 +13,7 @@
              [ignore-errors returning doto-let mpartial prev-reset!]])
   (:import [java.util.concurrent ExecutionException]
            [clojure.lang Var]
+           [org.apache.hadoop.io NullWritable]
            [org.apache.hadoop.mapreduce Job]
            [org.apache.hadoop.mapreduce.lib.partition HashPartitioner]))

@@ -175,16 +176,16 @@
 (defn shuffle
   "Base shuffle configuration; sets map output key & value types to
 the classes `ckey` and `cval` respectively."
-  [ckey cval]
-  (fn [^Job job]
-    (.setMapOutputKeyClass job ckey)
-    (.setMapOutputValueClass job cval)))
+  ([ckey] (shuffle ckey NullWritable))
+  ([ckey cval]
+     (fn [^Job job]
+       (.setMapOutputKeyClass job ckey)
+       (.setMapOutputValueClass job cval))))

 (defn ^:private shuffle-classes?
   "True iff `classes` is a vector of two classes."
   [classes]
   (and (vector? classes)
-       (= 2 (count classes))
        (every? class? classes)))

 (def ^:private partition* nil)


Allow gene mutation probabilities smaller than 1%.

--- src/clojure_robby/genetic.clj
+++ src/clojure_robby/genetic.clj
@@ -14,7 +14,7 @@
 (def multipliers (map (fn [n] (** (count tiles) n)) (range 5))) ; Used to calculate genes to use.
 (def dir-vects ['(0 -1) '(0 1) '(-1 0) '(1 0) '(0 0)]) ; Direction vectors, corresponding to the 5 actions.

-(def mutation-prob 1) ; Probability in 100 that a gene will mutate.
+(def mutation-prob 0.01) ; Probability that a gene will mutate.
 (def wall-penalty 5) ; How many points robot loses when hitting the wall
 (def pick-up-penalty 1) ; How many points the robot loses when pickin up on an empty spot.
 (def gold-value 10) ; How many points picking up gold is worth.
@@ -49,7 +49,7 @@

 (defn mutate [dna]
   "Randomly replace some genes in the DNA."
-  (let [mutate-gene (fn [gene] (if (< (rand-int 100) mutation-prob) (rand-gene) gene))]
+  (let [mutate-gene (fn [gene] (if (< (rand) mutation-prob) (rand-gene) gene))]
     (mapv mutate-gene dna)))


Add :track-instruction-maps option to argmap

--- src/clojush/pushgp/pushgp.clj
+++ src/clojush/pushgp/pushgp.clj
@@ -126,6 +126,7 @@
           :print-ancestors-of-solution false ; If true, final report prints the ancestors of the solution. Requires :maintain-ancestors to be true.
           :print-behavioral-diversity false ; If true, prints the behavioral diversity of the population each generation. Note: The error function for the problem must support behavioral diversity. For an example, see wc.clj
           :print-homology-data false ; If true, prints the homology statistics
+          :track-instruction-maps false ;; If true, each Plush instruction map will have a UUID attached to it. If the gene has a "parent gene", it will also have the UUID of its parent.
           ;;
           ;;----------------------------------------
           ;; Arguments related to printing JSON, EDN, or CSV logs


Removing println

Removing println

--- src/cmr/search/api/routes.clj
+++ src/cmr/search/api/routes.clj
@@ -123,7 +123,6 @@
 (defn process-context-info
   "Adds information to the context including the current token and the client id"
   [context params headers]
-  (println (pr-str headers))
   (-> context
       (assoc :token (get-token params headers))
       (assoc :client-id (get-client-id headers))))


Added resolve-and-load-namespace helper

Added resolve-and-load-namespace helper

--- src/de/kotka/gorilla/util.clj
+++ src/de/kotka/gorilla/util.clj
@@ -214,3 +214,11 @@
 (defmethod clj->vim Number
   [thing]
   (str thing))
+
+; Namespace helpers
+(defn resolve-and-load-namespace
+  "Loads and returns the namespace named by the given string or symbol."
+  [namespace]
+  (let [namespace (if (symbol? namespace) namespace (symbol namespace))]
+    (require namespace)
+    (the-ns namespace)))


round average

round average

--- src/github_authors/github.clj
+++ src/github_authors/github.clj
@@ -51,7 +51,8 @@
   (github-api-call user-repos user (assoc (gh-auth) :all-pages true)))

 (defn average [num denom]
-  (if (zero? denom) 0 (/ num (Float. (str denom)))))
+  (format "%.2f"
+          (if (zero? denom) 0.0 (/ num (float denom)))))

 (defn ->repo [open closed repo]
   (let [all-issues (into open closed)


Add ctx button

Add ctx button

--- src/webcv/web.cljs
+++ src/webcv/web.cljs
@@ -6,9 +6,8 @@
             [webcv.audio :as audio]
             [webcv.bootstrap :refer [read-eval]]))

-(defn render [text cb]
-  (let [ctx (audio/make-ctx)
-        graph (read-eval text)]
+(defn render [ctx text cb]
+  (let [graph (read-eval text)]
     (audio/make-synth ctx (:value graph))
     (cb {::ctx ctx
          ::graph graph})))
@@ -32,15 +31,22 @@
   "(out (sin-osc (lfo 440 100 0.2)))")

 (defn repl []
-  (let [input (r/atom init-text)
+  (let [ctx (r/atom nil)
+        input (r/atom init-text)
         output (r/atom nil)]
     (fn []
       [:div
        [editor input]
        [:div
         [:button
-         {:on-click #(render @input (partial reset! output))}
+         {:on-click #(do
+                       (if-let [old-ctx @ctx] (.close (::audio/actx old-ctx)))
+                       (reset! ctx (audio/make-ctx)))}
+         "reset context"]
+        [:button
+         {:on-click #(render @ctx @input (partial reset! output))}
          "run"]]
+       [:p (if @ctx "ctx loaded" "ctx not loaded")]
        [:p (with-out-str (pprint (::graph @output)))]])))

 (defn -main []


Noodle round renaming stuff.

Noodle round renaming stuff.

--- src/kolmogorov_music/song.clj
+++ src/kolmogorov_music/song.clj
@@ -39,19 +39,19 @@
 (defn digit-shift [x n]
   (apply * x (repeat n (bigint 10))))

-(defn decode-note [time a b c d]
+(defn construct [a b c d]
   (if (zero? (* a b))
-    {:time time :duration (/ c (max d 1))}
-    {:time time :duration (/ a b) :pitch (+ (digit-shift c 1) d)}))
+    {:duration (/ c (max d 1))}
+    {:duration (/ a b) :pitch (+ (digit-shift c 1) d)}))

 (defn decode*
   [state [a b c d & digits :as remaining?]]
   (when remaining?
-    (let [index (least state)
-          time (get state index)
-          note (decode-note time a b c d)]
+    (let [voice (least state)
+          time (get state voice)
+          note (assoc (construct a b c d) :time time)]
       (->> digits
-           (decode* (-> state (increment index (:duration note))))
+           (decode* (-> state (increment voice (:duration note))))
            lazy-seq
            (cons note)))))


Better (?) session manager code

Better (?) session manager code

--- src/lein_ui/nrepl/handler.clj
+++ src/lein_ui/nrepl/handler.clj
@@ -2,44 +2,12 @@
   (:require [org.httpkit.server :as server]
             [clojure.tools.nrepl :as nrepl]
             [lein-ui.core :as ui]
+            [lein-ui.nrepl :as ui-nrepl]
             [lein-ui.util :refer [pprint-str]]))

 ;; TODO figure out users
 ;; TODO register watcher for messages
-
-
-
-(defn repl-eval! [host port message]
-  (with-open [conn (nrepl/connect :host host
-                                  :port port)]
-  (-> (nrepl/client conn 2000)
-      (nrepl/message message)
-      doall)))
-
-(defonce repl-channels (atom {:connections {}
-                              :sessions {}}))
-
-(defn ensure-project-connection
-  ([project]
-     (if-let [conn (-> @repl-channels :connections (get project))]
-       conn
-       (ensure-project-connection project (apply nrepl/connect
-                                                 (apply concat (ui/get-repl-data project))))))
-  ([project conn]
-     (let [channels @repl-channels]
-       (if (compare-and-set! repl-channels
-                             channels
-                             (assoc-in channels [:connections project] conn))
-         conn
-         (if-let [conn* (get-in @repl-channels [:connections project])]
-           ;; a competing connection was inserted, close ours
-           (do (.close conn) conn*)
-           ;; some other connection or session was created or destroyed
-           (recur project conn))))))
-
-;; Experiment and take notes on "multiple agents can read the client
-;; response stream without interference from each other"

@@ -65,106 +33,117 @@

 ;; {log & notify} [callback]

-(fn []
-  (expected-message? msg callback)

-  (ui-nrepl/remove-handler-for-id (msg :id))
+(defonce repl-channels (atom {:connections {}
+                              :sessions {}}))

-  (if (set-fn (msg :new-session))
-    (callback :success (msg :new-session))
-    (close-session (msg :new-session) callback)))
+(defn set-nil-path!
+  "Attempts to set value at path in the deref'd state.  set-nil-path!
+  ensures that (get-in @state path) is nil before and during setting.
+  It will return true if `value` is set in state or false if it is not"
+  [state path value]
+  (let [now @state]
+    (if (get-in @state path)
+      false
+      (let [new (assoc-in now path value)
+            set? (compare-and-set! state now new)]
+        (if set?
+          true
+          (recur state path value))))))

-(fn [project user conn channel msg]
-  ;; put the new session in our state, cleaning up if there's a
-  ;; race. let the user know what's up and log pertinent information
-  (if (contains? (-> msg :status set)
-                 "done")
-    (do ;;(ui-nrepl/remove-handler-for-id (msg :id))
-        (if-let [session-id (msg :new-session)]
-          (do (swap! repl-channels update-in [:sessions user]
-                     (fn [user-sessions]
-                       (if (user-sessions project)
-                         ;; inside a swap here - normally we don't cause
-                         ;; side effects because it can be run more than
-                         ;; once but we throw after performing the side
-                         ;; effects here so they won't happen again
-                         ;; since swap! will fail.  Not concerned about
-                         ;; performance of competing transactions
-                         ;; (assume low volume)
-                         (do
-                           (nrepl/message conn {:op "close"
-                                                :session session-id})
-                           (println
-                            (format "Duplicate session created for %s on %s"
-                                    user project))
-                           (server/send! channel (pprint-str
-                                                  {:type :error
-                                                   :subject project
-                                                   :error :duplicate-session}))
-                           (throw (ex-info "Duplicate session" {:project project :user user}))))
-                       (assoc user-sessions project session-id)))
-              (println (format "Session created for %s on %s: %s"
-                               user project session-id))
-              (server/send! channel (pprint-str {:type :nrepl/session
-                                                 :subject project
-                                                 :status :created})))
-          (do
-            (println (format (str "Response to create session"
-                                  "for %s on project % with id %s"
-                                  "did not contain a session id")
-                             user project (msg :id)))
-            (server/send! channel (pprint-str
-                                   {:type :error
-                                    :subject project
-                                    :error :unknown-session-error})))))
-    (println "Unexpected response" msg)))
+(defn ensure-project-connection [project]
+  (if-let [conn (-> @repl-channels :connections (get project))]
+    conn
+    (let [conn (apply nrepl/connect (apply concat (ui/get-repl-data project)))]
+      (if (set-nil-path! repl-channels [:connections project] conn)
+        conn
+        (do
+          (.close conn)
+          (recur project))))))
+
+(defn set-user-session! [state project user session-id]
+  (set-nil-path! state [:sessions project user] session-id))
+
+
+(defn new-session-response-callback [project user callback]
+  (fn [{:keys [id status new-session] :as msg}]
+    (ui-nrepl/remove-handler-for-id! id)
+
+    (when-not (contains? (set status) "done")
+      (println (format (str "Response to create session"
+                            "for %s on project % with id %s"
+                            "did not contain a session id")
+                       user project new-session))
+      (throw (ex-info "Bad message in response to new session" msg)))
+
+    (println (format "Session created for %s on %s: %s"
+                     user project new-session))
+
+    (when-not (set-user-session! repl-channels project user new-session)
+      (do
+        (nrepl/message (get-in @repl-channels [:connections project])
+                       {:op "close" :session new-session})
+        (println
+         (format "Duplicate session created for %s on %s, closing %s"
+                 user project new-session))))
+
+    (callback :success (get-in @repl-channels [:sessions user project]))))

-(defn ensure-user-session
-  ([conn project user]
-     (if-let [session (-> @repl-channels (get-in [:sessions user project]))]
-       session
-       (ensure-user-session conn project user
-                            (apply nrepl/connect
-                                   (apply concat (ui/get-repl-data project))))))
-  ([conn project user session]
-     (let [channels @repl-channels]
-       (if (compare-and-set! repl-channels
-                             channels
-                             (assoc-in channels [:connections project] conn))
-         conn
-         (if-let [conn* (get-in @repl-channels [:connections project])]
-           ;; a competing connection was inserted, close ours
-           (do (.close conn) conn*)
-           ;; some other connection or session was created or destroyed
-           (recur conn project user session))))))
-
 (defn find-repl-session [user project]
-  (let [channels @repl-channels
-        project-connection (get-in channels [:connections project])
-        user-session (get-in channels [:sessions user])]
-    (if-not project-connection
-      )
-    ))
+  (ensure-project-connection project)
+  (ensure-user-session project user)
+  (get-in @repl-channels [user project])))

 (defmulti handle-message (fn [msg user] (msg :type)))

 (defmethod handle-message :nrepl/command [msg user app-state]
-  (let [conn (find-repl-connection user (msg :subject))]
-    (repl-eval! host port (msg  :message))))
+  (let [session-id (find-repl-session user (msg :subject))]
+    (nrepl/message (assoc (msg :nrepl/message)
+                     :session session-id))))

 (defn nrepl-socket-handler [request]
   (let [user :current-user]
     (server/with-channel request channel
-      (on-receive channel (fn [msg]
-                            (try
-                              (handle-message msg user (request :lein-ui/app-state))
-                              (catch Throwable t
-                                (println t)
-                                (server/send! channel (pprint-str
-                                                       {:type :error
-                                                        :exception (str t)}))))))
-      (on-close channel (fn [status]
-                          ;; (release-repl-connections user)
-                          (cleanup user))))))
+      (server/on-receive channel (fn [msg]
+                                   (try
+                                     (handle-message msg user (request :lein-ui/app-state))
+                                     (catch Throwable t
+                                       (println t)
+                                       (server/send! channel (pprint-str
+                                                              {:type :error
+                                                               :exception (str t)}))))))
+      (server/on-close channel (fn [status]
+                                 ;; (schedule (-> 10 minutes) #(cleanup user)
+                                 (println "User" user "disconnected"))))))
+
+
+
+;; Can multiple agents can read the client response stream without
+;; interference from each other?
+
+;; No! Need a single agent reading the response stream and interested
+;; parties must subscribe - hence callbacks.
+
+;; lein-ui.nrepl.handler> (def a-connection (nrepl/connect :port 7888))
+
+;; lein-ui.nrepl.handler> (def some-responses (nrepl/response-seq a-connection 1000))
+
+;; lein-ui.nrepl.handler> (nrepl/message (nrepl/client a-connection 1000) {:op "eval" :code ":hello"})
+;; ({:id "5f1f304b-d13f-4ee5-a416-a629e721f3db", :ns "user", :session "3a878c88-e11e-46ab-9e67-2bf7b9644111", :value ":hello"} {:id "5f1f304b-d13f-4ee5-a416-a629e721f3db", :session "3a878c88-e11e-46ab-9e67-2bf7b9644111", :status ["done"]})
+
+;; lein-ui.nrepl.handler> some-responses
+;; ()
+
+
+
+;; lein-ui.nrepl.handler> (def mmhmm (nrepl/message (nrepl/client a-connection 1000) {:op "eval" :code ":hello"}))
+
+;; lein-ui.nrepl.handler> (def some-responses (nrepl/response-seq a-connection 1000))
+
+;; lein-ui.nrepl.handler> some-responses
+;; ({:id "c614d72b-1472-4607-a648-528cfab5883b", :ns "user", :session "2eb5fe14-7f3d-4211-9540-ff6d81069562", :value ":hello"} {:id "c614d72b-1472-4607-a648-528cfab5883b", :session "2eb5fe14-7f3d-4211-9540-ff6d81069562", :status ["done"]})
+
+;; lein-ui.nrepl.handler> mmhmm
+;; ()


Cosmetic fixs on sitemap refs.

Cosmetic fixs on sitemap refs.

--- src/uxbox/main/ui/workspace/sidebar/sitemap.cljs
+++ src/uxbox/main/ui/workspace/sidebar/sitemap.cljs
@@ -29,12 +29,16 @@

 ;; --- Lenses

+(defn- resolve-page
+  [state]
+  (let [project (get-in state [:workspace :project])]
+    (->> (vals (:pages-by-id state))
+         (filter #(= project (:project %)))
+         (sort-by :created-at))))
+
 (def pages-l
-  (letfn [(getter [state]
-            (let [project (get-in state [:workspace :project])]
-              (stpr/project-pages state project)))]
-    (-> (l/lens getter)
-        (l/derive st/state))))
+  (-> (l/lens resolve-page)
+      (l/derive st/state)))

 ;; --- Component


change bootstrap project.clj to exclude Storm JAR

this makes "lein uberjar" work for now, though there is actually
a better way to handle this situation

--- streamparse/bootstrap/project/project.jinja2.clj
+++ streamparse/bootstrap/project/project.jinja2.clj
@@ -1,13 +1,13 @@
 (defproject {{ project_name }} "0.0.1-SNAPSHOT"
   :source-paths ["topologies"]
   :resource-paths ["_resources"]
-  :aot :all
   :target-path "_build"
   :min-lein-version "2.0.0"
   :jvm-opts ["-client"]
-  :dependencies [[org.apache.storm/storm-core "0.9.1-incubating"]
-                 [com.parsely/streamparse "0.0.1-SNAPSHOT"]
-                 [org.clojure/clojure "1.5.1"]
-                 [org.clojure/data.json "0.2.4"]
-                 [org.clojure/tools.cli "0.3.1"]]
+  :dependencies [     [org.clojure/data.json "0.2.4"]
+                      [org.clojure/tools.cli "0.3.1"]
+                      [org.apache.storm/storm-core "0.9.1-incubating"]
+                      [com.parsely/streamparse "0.0.1-SNAPSHOT"]]
+  :jar-exclusions     [#"log4j\.properties" #"backtype" #"trident" #"META-INF" #"meta-inf" #"\.yaml"]
+  :uberjar-exclusions [#"log4j\.properties" #"backtype" #"trident" #"META-INF" #"meta-inf" #"\.yaml"]
   )


handle a few more edge cases in JS deps

handle a few more edge cases in JS deps

--- src/main/shadow/build/npm.clj
+++ src/main/shadow/build/npm.clj
@@ -164,6 +164,8 @@
            suffix))])))

 (defn find-package-require [npm require]
+  {:pre [(not (util/is-relative? require))
+         (not (util/is-absolute? require))]}
   (let [[package-name suffix]
         (split-package-require require)

@@ -185,9 +187,11 @@
             [entry entry-file]
             (or (reduce
                   (fn [_ entry]
-                    (when-let [file (or (test-file package-dir entry)
-                                        ;; some libs have main:"some/dir/foo" without the .js
-                                        (test-file-exts npm package-dir entry))]
+                    ;; test file exts first, so we don't pick a directory over a file
+                    ;; lib/jsdom
+                    ;; lib/jsdom.js
+                    (when-let [file (or (test-file-exts npm package-dir entry)
+                                        (test-file package-dir entry))]

                       (reduced [entry file])))
                   nil
@@ -276,7 +280,17 @@
           ;; so for each directory first test if there is file by the same name
           (.isDirectory file)
           (or (test-file-exts npm rel-dir require)
-              (test-file-exts npm file "index"))
+              (test-file-exts npm file "index")
+              (let [package-json (io/file file "package.json")]
+                (when (.exists package-json)
+                  ;; node_modules/htmlparser2/lib/Stream.js
+                  ;; has a require("../") which resolves to node_modules/htmlparser2
+                  ;; which is the root of the package (without a index.js)
+                  ;; didn't even know that was allowed but node seems to resolve this
+                  ;; by looking at the package and picking the main
+                  ;; so we mimick that
+                  (find-package-require npm (-> file (.getCanonicalFile) (.getName)))
+                  )))

           :else
           file)]
@@ -359,27 +373,42 @@
     (util/is-relative? require)
     (find-relative npm require-from require)

-    ;; FIXME: do node libs ever have nested things?
-    ;; path/foo would not be overridden by path
     :else
-    (let [browser-override
-          (and require-from
-               (let [{:keys [browser-overrides] :as require-from-pkg}
-                     (find-package-for-file npm require-from)]
-                 (get browser-overrides require)))
+    (let [require-from-pkg
+          (when require-from ;; no overrides for entries
+            (find-package-for-file npm require-from))
+
+          browser-override
+          (and require-from-pkg
+               (get-in require-from-pkg [:browser-overrides require]))

           override
           (if (some? browser-override)
             browser-override
             (get node-libs-browser require))]
+
       (cond
+        (nil? override)
+        (find-package-require npm require)
+
+        ;; "canvas": false
         (false? override)
         false

-        (nil? override)
-        (find-package-require npm require)
+        (not (string? override))
+        (throw (ex-info (format "invalid override in package: %s" require-from)
+                 {:require require
+                  :require-from require-from
+                  :override override}))
+
+        ;; jsdom
+        ;; "contextify": "./lib/jsdom/contextify-shim.js"
+        ;; overrides a package require from within the package to a local file
+        (util/is-relative? override)
+        (find-relative npm (:package-dir require-from-pkg) override)

         ;; "foo":"bar"
+        ;; swap one package with the other
         :else
         (find-package-require npm override)
         ))))
@@ -641,7 +670,8 @@

           ;; FIXME: is "./lib/some-file.js":"some-package" allowed?
           ;; currently assumes its always a file in the package itself
-          (string? override)
+          (and (string? override)
+               (util/is-relative? override))
           (let [override-file
                 (-> (io/file package-dir override)
                     (.getCanonicalFile))]


Page parameter for debugging.

Page parameter for debugging.

--- src/mash_commander/state.cljs
+++ src/mash_commander/state.cljs
@@ -34,12 +34,15 @@

 (defn init []
   (let [set (:set (url-params))
-        chroot (:chroot (url-params))]
+        chroot (:chroot (url-params))
+        page (:page (url-params))]
     (cond
       ;; Start Nix
       (= "nix" chroot)
-      (swap! app-state #(assoc-in % [:lines] {:active (mode/initial-line-state {:mode :nix})
-                                              :history []}))
+      (do
+        (when page (swap! app-state #(assoc-in % [:characters :nix :page :current-page] (keyword page))))
+        (swap! app-state #(assoc-in % [:lines] {:active (mode/initial-line-state {:mode :nix})
+                                                :history []})))
       ;; Start in a set
       (contains? @set-manifest/sets set)
       (swap! app-state #(assoc-in % [:lines]


protect refs from ns reloading

protect refs from ns reloading

--- src/overtone/config/store.clj
+++ src/overtone/config/store.clj
@@ -15,8 +15,8 @@
    :server :internal
    :sc-args []})

-(def config* (ref {}))
-(def live-config (partial live-file-store config*))
+(defonce config* (ref {}))
+(defonce live-config (partial live-file-store config*))

 (defn config-get
   "Get config value. Returns default if specified and the config does


add #'remote-file-size and #'dir-empty? file helper fns

--- src/overtone/helpers/file.clj
+++ src/overtone/helpers/file.clj
@@ -146,6 +146,13 @@
   [pattern]
   (let [pattern (resolve-tilde-path pattern)]
     (satta-glob/glob pattern)))
+
+(defn remote-file-size
+  "Returns the size of the file referenced by url in bytes."
+  [url]
+  (let [url (URL. url)
+        con (.openConnection url)]
+    (.getContentLength con)))

 (defn- download-file-without-timeout
   "Downloads remote file at url to local file specified by target path. Has
@@ -282,6 +289,12 @@
   (let [path (resolve-tilde-path path)
         f (file path)]
     (and (.exists f) (.isDirectory f))))
+
+(defn dir-empty?
+  "Returns true if the directory specified by path is empty or doesn't exist"
+  [path]
+  (let [contents (ls-names path)]
+    (empty? contents)))

 (defn mk-tmp-dir!
   "Creates a unique temporary directory on the filesystem. Typically in /tmp on


Namespace has changed

Namespace has changed

--- src/pedantic/cluppet_core.clj
+++ src/pedantic/cluppet_core.clj
@@ -15,7 +15,7 @@
             [slingshot.slingshot :refer [try+ throw+]]))

 (def ^:private cluppet-tester
-  (conj secure-tester-without-def (blanket "cluppet" "environ")))
+  (conj secure-tester-without-def (blanket "environ" "pedantic")))

 (defn- make-sandbox
   []


remove the token cookie from the proper domain

--- src/cljs/org/broadinstitute/firecloud_ui/utils.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/utils.cljs
@@ -77,7 +77,7 @@
 (def access-token (atom nil))

 (defn delete-access-token-cookie []
-  (.remove goog.net.cookies "FCtoken"))
+  (.remove goog.net.cookies "FCtoken" "/" (join "." (rest (split js/window.location.hostname ".")))))

 (defn set-access-token-cookie [token]
   (if token


get rid of nav blip by putting js (bootstrap + thus jq) in head

I thought I read that js in cljs apps should be put at the
end of the body but can't remember why

--- src/semtag_web/views/main.clj
+++ src/semtag_web/views/main.clj
@@ -18,13 +18,13 @@
     [:head
       [:title "Semtag"]
       (include-css "/css/application.css")
+      (include-js "/js/jquery-1.8.3.min.js")
+      (include-js "/js/jquery.tablesorter.min.js")
+      (include-bootstrap)
      ]
     [:body
      (navbar)
      [:div#main body]
-      (include-js "/js/jquery-1.8.3.min.js")
-      (include-js "/js/jquery.tablesorter.min.js")
-      (include-bootstrap)
       (include-js "/cljs/main.js")
      (when-let [js-fn (:js-fn options)]
       [:script {:type "text/javascript"} (str "semtag_web.client.main." js-fn "();")])


Step based zoom (#12)

Step based zoom (#12)

--- src/uxbox/data/workspace.cljs
+++ src/uxbox/data/workspace.cljs
@@ -18,12 +18,19 @@
             [uxbox.data.shapes :as uds]
             [uxbox.util.datetime :as dt]
             [uxbox.util.math :as mth]
+            [uxbox.util.data :refer (index-of)]
             [uxbox.util.geom.point :as gpt]
             [uxbox.util.workers :as uw]))

 ;; --- Initialize Workspace

 (declare initialize-alignment-index)
+
+(defonce zoom-levels [0.20 0.21 0.22 0.23 0.24 0.25 0.27 0.28 0.30 0.32 0.34
+                      0.36 0.38 0.40 0.42 0.44 0.46 0.48 0.51 0.54 0.57 0.60
+                      0.63 0.66 0.69 0.73 0.77 0.81 0.85 0.90 0.95 1.00 1.05
+                      1.10 1.15 1.21 1.27 1.33 1.40 1.47 1.54 1.62 1.70 1.78
+                      1.87 1.96 2.06 2.16 2.27 2.38 2.50 2.62 2.75 2.88 3.00])

 (defrecord InitializeWorkspace [project page]
   rs/UpdateEvent
@@ -120,7 +127,7 @@
 (defrecord IncreaseZoom []
   rs/UpdateEvent
   (-apply-update [_ state]
-    (let [increase #(min (mth/precision (* % 1.05) 2) 3)]
+    (let [increase #(nth zoom-levels (+ (index-of zoom-levels %) 1) (last zoom-levels))]
       (update-in state [:workspace :zoom] (fnil increase 1)))))

 (defn increase-zoom
@@ -132,7 +139,7 @@
 (defrecord DecreaseZoom []
   rs/UpdateEvent
   (-apply-update [_ state]
-    (let [decrease #(max (mth/precision (* % 0.95) 2) 0.15)]
+    (let [decrease #(nth zoom-levels (- (index-of zoom-levels %) 1) (first zoom-levels))]
       (update-in state [:workspace :zoom] (fnil decrease 1)))))

 (defn decrease-zoom


[WR] change formatting code, refactor filename join

--- src/vip/data_processor/s3.clj
+++ src/vip/data_processor/s3.clj
@@ -31,27 +31,23 @@
                 (into-array [StandardCopyOption/REPLACE_EXISTING]))
     tmp-path))

-(defn format-fips-code [fips]
-  (let [fips-length (count fips)]
-    (if-not (= fips-length (or 2 5))
-      (let [padding-length (- 5 fips-length)
-            padding (apply str (repeat padding-length "0"))]
-        (str padding fips))
-      fips)))
-
 (defn xml-filename [ctx]
-  (let [fips (-> (get-in ctx [:tables :sources])
-                 korma/select first :vip_id format-fips-code)
+  (let [fips (->> (get-in ctx [:tables :sources])
+                  korma/select first :vip_id)
+        formatted-fips (if (< (count fips) 2)
+                         (format "%02d" (Integer/parseInt fips))
+                         (if (< (count fips) 5)
+                           (format "%05d" (Integer/parseInt fips))
+                           fips))
         election-date (->> (get-in ctx [:tables :elections])
                            korma/select first :date)
         timestamp (.getTime (java.util.Date.))]
-    (->> (vector "vipFeed" fips election-date timestamp)
-         (join "-"))))
+    (join "-" ["vipfeed" fips election-date timestamp])))

 (defn upload-to-s3
   "Uploads the generated xml file to the specified S3 bucket."
   [ctx]
   (let [new-filename (xml-filename ctx)]
     (put-object (str "processed-feeds/" new-filename)
-                (slurp (str (:xml-output-file ctx))))
+                (.toFile (:xml-output-file ctx)))
     ctx))


update wow solution

update wow solution

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -633,19 +633,17 @@
                            (mem mem (rest s1) (rest s2))))))))]
     (levenshtein (memoize levenshtein) x y)))
 ;; wow solution
-;;(fn [w1 w2]
-;;  (letfn [
-;;          (dist [d w1 w2]
+;;(fn levenshtein-distance [s t]
+;;  (let [f (fn [f s t]
 ;;            (cond
-;;              (empty? w1) (count w2)
-;;              (empty? w2) (count w1)
-;;              :else
-;;              (min
-;;               (inc (d d (rest w1) w2))
-;;               (inc (d d w1 (rest w2)))
-;;               (+ (if (= (first w1) (first w2)) 0 1)
-;;                  (d d (rest w1) (rest w2))))))]
-;;    (dist (memoize dist) w1 w2)));;
+;;              (empty? s) (count t)
+;;              (empty? t) (count s)
+;;              :else (let [cost (if (= (first s) (first t)) 0 1)]
+;;                      (min (inc (f f (rest s) t))
+;;                           (inc (f f s (rest t)))
+;;                           (+ cost (f f (rest s) (rest t)))))))
+;;        g (memoize f)]
+;;    (g g s t)))

 ;;102 intoCamelCase
 (defn f[w]


delete old fixtures test

delete old fixtures test

--- test/test_test.clj
+++ test/test_test.clj
@@ -1,14 +0,0 @@
-(ns test-test
-  (:use clojure.test cake))
-
-(declare *once* *every*)
-
-(defn run-once [f]
-  (binding [*once* true]
-    (f)))
-
-(use-fixtures :once run-once)
-
-(deftest fixtures-test
-  (testing "once"
-    (is *once*)))


indenting

indenting

--- test/celestial/test/model.clj
+++ test/celestial/test/model.clj
@@ -11,7 +11,8 @@

 (fact "constructing a proxmox model"
   (with-conf
-    (second (translate model))) => {:node "proxmox" :flavor :debian :features ["nfs:on"] :system-id 1})
+    (second (translate model))) =>
+      {:node "proxmox" :flavor :debian :features ["nfs:on"] :system-id 1})

 (fact "cloning purge"
    (:proxmox (clone model)) =not=> (contains [[:vmid 101]])


Getting closer (?!)

Getting closer (?!)

--- test/icecap/e2e/http_test.clj
+++ test/icecap/e2e/http_test.clj
@@ -2,7 +2,9 @@
   "End-to-end tests for making HTTP requests."
   (:require [icecap.e2e.common :refer :all]
             [clojure.test :refer :all]
-            [aleph.http :as http]))
+            [aleph.http :as http]
+            [manifold.deferred :refer [let-flow]]
+            [byte-streams :as bs]))

 (def ^:dynamic http-server)
 (def ^:dynamic recvd-reqs)
@@ -29,4 +31,11 @@
 (use-fixtures :each store-reqs-fixture)

 (deftest http-tests
-  (is (let [x (create-cap {:type :http})])))
+  (is (let [d (let-flow
+               [create-result (create-cap {:type :http})
+                cap-url (bs/to-string (:body create-result))
+                exercise-result (execute-cap cap-url)]
+               [create-result exercise-result cap-url])
+            [{create-code :code} {} cap-url] @d]
+        (and (= create-code 201)
+             (= cap-url nil)))))


Minor refactoring

Minor refactoring

--- test/obb_rules/board_test.clj
+++ test/obb_rules/board_test.clj
@@ -1,5 +1,7 @@
 (ns obb-rules.board-test
   (:use clojure.test obb-rules.board))
+
+(def dummy-element :dummy-element)

 (deftest board
   (testing "create-board"
@@ -13,7 +15,7 @@

   (testing "managing elements"
     (let [board (create-board 8 8)
-          element :dummy-element-placeholder]
+          element dummy-element]

       (testing "operations with coordinate"
         (let [new-board (place-element board [1 1] element)]


mapc -> arg fs = vector OR hashmap OK

mapc -> arg fs = vector OR hashmap OK


405 test

405 test

--- test/yada/helloworld_test.clj
+++ test/yada/helloworld_test.clj
@@ -21,6 +21,7 @@
        "content-type" (when-not (mime/string->media-type v) "mime-type not valid")
        "last-modified" (when-not (instance? java.util.Date (parse-date v)) "last-modified not a date")
        "vary" (when-not (pos? (count (parse-csv v))) "vary empty")
+       "allow" (when-not (pos? (count (parse-csv v))) "allow empty")
        "etag" (when-not (etag? v) "not a valid etag")
        (throw (ex-info "Cannot validate unrecognized header" {:k k :v v}))))
    (remove nil?) vec))
@@ -49,10 +50,18 @@

 ;; TODO: conditional request

-;; TODO: mutation
+(deftest put-not-allowed
+  (let [resource hello/hello]
+    (given @(resource (request :put "/"))
+      :status := 405
+      [:headers keys set] := #{"allow"}
+      [:headers validate-headers?] := []
+      [:headers "allow" parse-csv set] := #{"OPTIONS" "GET" "HEAD"}
+      :body := nil)))
+
+;; TODO: mutable-hello

 ;; TODO: head request
-

 #_(deftest parameters-test
   (let [resource hello/hello-parameters]
@@ -81,5 +90,3 @@
         ;; TODO: Test a lot more, like content-type
         [:headers "content-language"] := "en"
         [:body to-string] := "Hello World!\n"))))
-
-;; TODO: swagger


Suppress lifecycle warnings after RN upgrade


Refactor some functions in read-loop to simplify body.

--- src/org/playasophy/wonderdome/input/usb_hid.clj
+++ src/org/playasophy/wonderdome/input/usb_hid.clj
@@ -15,6 +15,11 @@
 (def ^:private library-name
   "JNI library to load when finding devices."
   "hidapi-jni-64")
+
+
+(def ^:private ^:const poll-period
+  "Milliseconds to wait for new input from USB device."
+  100)

 (def ^:private ^:const buffer-size
@@ -57,20 +62,26 @@
   interrupting the thread."
   ^Runnable
   [^HIDDevice device read-state state-events channel]
-  (let [buffer (byte-array buffer-size)]
+  (let [buffer (byte-array buffer-size)
+
+        read-device!
+        (fn []
+          (let [len (.readTimeout device buffer poll-period)]
+            (when (pos? len)
+              (read-state buffer len))))
+
+        put-events!
+        (fn [events]
+          (dorun (map (partial >!! channel)
+                      (remove nil? events))))]
     (fn []
       (try
-        (loop [start (System/currentTimeMillis)
+        (loop [t (System/currentTimeMillis)
                old-state nil]
           (when-not (Thread/interrupted)
-            (let [len (.readTimeout device buffer 100)
-                  new-state (if (pos? len)
-                              (read-state buffer len)
-                              old-state)
-                  now (System/currentTimeMillis)
-                  elapsed (- now start)
-                  events (state-events old-state new-state elapsed)]
-              (dorun (map (partial >!! channel) (remove nil? events)))
+            (let [new-state (or (read-device!) old-state)
+                  now (System/currentTimeMillis)]
+              (put-events! (state-events old-state new-state (- now t)))
               (recur now new-state))))
         (catch InterruptedException e
           nil)))))


with the extra print statements the output percentiles are correct but remove the extra print statement and they are incorrect

--- client/perf/src/perf/core.clj
+++ client/perf/src/perf/core.clj
@@ -7,6 +7,67 @@

 (defn parse-int [s]
    (Integer. (re-find  #"\d+" s )))
+
+(defn flatten-one-level [coll]
+  (mapcat  #(if (sequential? %) % [%]) coll))
+
+(defn extract-entity-action
+  ""
+  [tuple]
+  [(first tuple) (second tuple)])
+
+(defn extract-entity-actions
+  ""
+  [tuples]
+  (into
+    #{}
+    (for [tuple tuples]
+      (extract-entity-action tuple))))
+
+(defn entity-action-match
+  ""
+  [entity-action tuple]
+  (let [test (extract-entity-action tuple)]
+	  (and
+	    (= (first entity-action) (first test))
+      (= (second entity-action) (second test)))))
+
+; https://github.com/nathanmarz/cascalog/wiki/Guide-to-custom-operations
+
+(c/defbufferfn agg-perf-data
+  ""
+  [tuples]
+  (println "in agg-perf-data")
+  (println tuples)
+  (let [entity-actions (extract-entity-actions tuples)
+        retVal
+			    (for [entity-action entity-actions]
+			      (let [entity-action-counts
+                  (sort
+                    (map
+                      (fn [x] (parse-int (nth x 2)))
+                       (doall
+                         (filter
+                           (fn [x] (entity-action-match entity-action x))
+                           tuples))))]
+           (println entity-action)
+           (println entity-action-counts)
+		           (str
+		             (first entity-action)
+		             "|"
+		             (second entity-action)
+		             "="
+		             (count entity-action-counts)
+		             ","
+		             (nth entity-action-counts (/ (count entity-action-counts) 2))
+		             ","
+		             (nth entity-action-counts
+                    (/
+                      (*
+                        (count entity-action-counts)
+                        95)
+                      100)))))]
+       [(s/join ":" retVal)]))

 (defn parse-data-line
   ""
@@ -20,7 +81,7 @@
           (parse-data-line ?line :> ?year ?month ?day ?hour ?minute ?entity ?action ?count)
           (:distinct false))))

-(defn roll-up-by-minute
+(defn roll-up-by-minute-entity-action
   ""
   [input-directory output-directory]
   (let [data-point (metrics input-directory)
@@ -31,6 +92,16 @@
               (parse-int ?count :> ?cnt)
               (o/sum ?cnt :> ?total))))

+(defn roll-up-by-minute
+  ""
+  [input-directory output-directory]
+  (let [data-point (metrics input-directory)
+        output (hfs-delimited output-directory :sinkmode :replace :delimiter ",")]
+       (c/?<- output
+              [?year ?month ?day ?hour ?minute ?rpt]
+              (data-point ?year ?month ?day ?hour ?minute ?entity ?action ?count)
+              (agg-perf-data ?entity ?action ?count :> ?rpt))))
+
 (defn -main
   ""
   [& args]


check active before updating text (vs async race)

--- qmon.clj
+++ qmon.clj
@@ -132,5 +132,7 @@
       (.add sp)
       (.setVisible true))
     (while true
-      (if @active (.setText ta (show user)))
+      (if @active
+        (let [newtext (show user)]
+          (if @active (.setText ta newtext))))
       (Thread/sleep 5000))))


added-atoms -> added-removed-atoms

added-atoms -> added-removed-atoms

--- test/atom_finder/commits_added_removed_test.clj
+++ test/atom_finder/commits_added_removed_test.clj
@@ -28,10 +28,10 @@
             (merge
              (before-after-data gcc-repo rev-commit "libstdc++-v3/src/c++11/snprintf_lite.cc")
              {:rev-commit rev-commit})
-            atoms-added (added-atoms snprintf_lite-src)]
+            atoms-added (added-removed-atoms snprintf_lite-src)]

         (->> atoms-added
-             count-added-atoms
+             count-added-removed-atoms
              :added-atoms
              (= {:operator-precedence 1, :pre-increment 1, :repurposed-variable 1})
              is)
@@ -42,7 +42,7 @@
                              {:rev-commit rev-commit})

             ;; this function used to take ~6mins, so fail it if it regresses over 20 seconds
-            added-atoms-res (->> cp_pt-src added-atoms (with-timeout 20))
+            added-atoms-res (->> cp_pt-src added-removed-atoms (with-timeout 20))
             ]


Re-enable tagged constraints test

Re-enable tagged constraints test

--- test/onyx/scheduler/tagged_constraints_test.clj
+++ test/onyx/scheduler/tagged_constraints_test.clj
@@ -271,7 +271,7 @@
       (is (some (into #{} task-a-peers) #{:p9 :p10}))
       (is (some (into #{} task-f-peers) #{:p9 :p10}))))))

-#_(deftest peer-leave-tagged-deallocate
+(deftest peer-leave-tagged-deallocate
   (let [job-1-id "job-1"
         job-1 {:workflow [[:a :b] [:b :c]]
                :catalog [{:onyx/name :a


Story ID: RPC-236 Summary: Mocking print-exception in terminal-spec

--- test/untangled_spec/reporters/terminal_spec.clj
+++ test/untangled_spec/reporters/terminal_spec.clj
@@ -1,5 +1,5 @@
 (ns untangled-spec.reporters.terminal-spec
-  (:require [untangled-spec.reporters.terminal :refer [get-exp-act]]
+  (:require [untangled-spec.reporters.terminal :refer [get-exp-act print-exception]]
             [untangled-spec.assertions :refer [triple->assertion]]
             [clojure.test :as t :refer (are is deftest with-test run-tests testing do-report assert-expr)]
             [untangled-spec.core :refer [specification component behavior provided assertions]])
@@ -14,6 +14,7 @@

       (provided "with :extra, ie: from triple->assertion"
         (clojure.test/do-report x) => x
+        (print-exception _) => _

         (component "=>"
           (behavior "basic"


Add promise/deliver example from chapter 6.


Add queries to database layer

Add queries to database layer

--- src/madouc/db.clj
+++ src/madouc/db.clj
@@ -16,5 +16,7 @@
                            (env :db-user)
                            (env :db-password)))
   :stop (conman/disconnect! con))
+
+(conman/bind-connection con "sql/queries.sql")


Fix metadata update when metadata key is removed from post

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -129,7 +129,10 @@
             updated-files (pod/with-call-in @pod
                              (io.perun.markdown/parse-markdown ~md-files ~options))
             initial-metadata (perun/merge-meta* (perun/get-meta fileset) @prev-meta)
-            final-metadata   (perun/merge-meta* initial-metadata updated-files)
+            ; Pure merge instead of `merge-with merge` (meta-meta).
+            ; This is because updated metadata should replace previous metadata to
+            ; correctly handle cases where a metadata key is removed from post metadata.
+            final-metadata   (vals (merge (perun/key-meta initial-metadata) (perun/key-meta updated-files)))
             final-metadata   (remove #(-> % :path removed?) final-metadata)]
         (reset! prev-fs fileset)
         (reset! prev-meta final-metadata)


better subject

better subject

--- src/pc/email.clj
+++ src/pc/email.clj
@@ -184,7 +184,7 @@
     (mailgun/send-message {:from "Precursor <joinme@prcrsr.com>"
                            :to (:cust/email grantee)
                            :subject (str (format-inviter granter)
-                                         " invited you to a document on Precursor")
+                                         " gave you access to a document on Precursor")
                            :text (str "Hey there,\nCome draw with me on Precursor: https://prcrsr.com/document" doc-id)
                            :html (permission-grant-html doc-id image-permission)
                            :o:tracking "yes"