tracking errors

tracking errors

--- src/celestial/puppet_standalone.clj
+++ src/celestial/puppet_standalone.clj
@@ -73,9 +73,12 @@
 (defrecord Standalone [remote type]
   Provision
   (apply- [this]
-    (println remote)
-    (let [puppet-std (type :puppet-std) module (puppet-std :module)]
-        (execute puppet-provision {:module module :type type} :web :env {:roles {:web #{remote}}}))))
+    (let [puppet-std (type :puppet-std) module (puppet-std :module)
+          roles {:roles {:web #{remote}}}
+          res (execute puppet-provision {:module module :type type} :web :env roles)]
+        (when-let [fail (-> res first :fail)]
+          (throw fail))
+      )))

 (defmethod pconstruct :puppet-std [type {:keys [machine] :as spec}]


Require project-id

Require project-id

--- src/circle/backend/build/config.clj
+++ src/circle/backend/build/config.clj
@@ -272,6 +272,7 @@
   "Given a project url and a build name, return a build. Helper method for repl"
   [url & {:keys [job-name vcs-revision infer who why]}]
   (let [project (project/get-by-url url)]
+    (throw-if-not (-> project :_id) "project id is required")
     (build/build {:vcs_revision vcs-revision
                   :project_id (-> project :_id)
                   :vcs_url url


Only include closure artifacts when in dev

--- src/clj/clojuredocs/site/common.clj
+++ src/clj/clojuredocs/site/common.clj
@@ -1,6 +1,7 @@
 (ns clojuredocs.site.common
   (:require [clojuredocs.util :as util]
             [clojuredocs.config :as config]
+            [clojuredocs.env :as env]
             [clojuredocs.github :as gh]))

 (def gh-auth-url (gh/auth-redirect-url
@@ -57,9 +58,11 @@
       [:div.row
        [:div.col-md-10.col-md-offset-1
         content]]]
-     [:script {:type "text/javascript" :src "/cljs/goog/base.js"}]
+     (when (env/bool :cljs-dev)
+       [:script {:type "text/javascript" :src "/cljs/goog/base.js"}])
      [:script {:type "text/javascript" :src "/cljs/clojuredocs.js"}]
-     [:script {:type "text/javascript"} "goog.require(\"clojuredocs.main\");"]]]])
+     (when (env/bool :cljs-dev)
+       [:script {:type "text/javascript"} "goog.require(\"clojuredocs.main\");"])]]])

 (defn $avatar [{:keys [email login] :as user}]
   [:a {:href (str "/u/" login)}


remove page from top navigation

remove page from top navigation

--- src/cljs/salava/page/ui/routes.cljs
+++ src/cljs/salava/page/ui/routes.cljs
@@ -1,4 +1,4 @@
-(ns salava.page.ui.routes
+(ns salava.page.ui.routes
   (:require [salava.core.ui.layout :as layout]
             [salava.core.i18n :as i18n :refer [t]]
             [salava.core.ui.helper :refer [base-path]]
@@ -22,8 +22,8 @@
                                      [["/preview/" :page-id] preview/handler]]})

 (defn ^:export navi [context]
-  {(str (base-path context) "/page")                 {:weight 30 :title (t :page/Pages) :top-navi true :breadcrumb (t :page/Pages " / " :page/Mypages)}
-   (str (base-path context) "/page/mypages")         {:weight 31 :title (t :page/Mypages) :site-navi true :breadcrumb (t :page/Pages " / " :page/Mypages)}
+  {;(str (base-path context) "/page")                 #_{:weight 31 :title (t :page/Pages) :top-navi true :breadcrumb (t :page/Pages " / " :page/Mypages)}
+   (str (base-path context) "/page/mypages")         {:weight 32 :title (t :page/Mypages) :site-navi true :breadcrumb (t :page/Pages " / " :page/Mypages)}
    (str (base-path context) "/page/view/\\d+")       {:breadcrumb (t :page/Pages " / " :page/Viewpage)}
    (str (base-path context) "/page/edit/\\d+")       {:breadcrumb (t :page/Pages " / " :page/Editpage)}
    (str (base-path context) "/page/edit_theme/\\d+") {:breadcrumb (t :page/Pages " / " :page/Choosetheme)}


Added genome_uniform_close_mutation instruction.

--- src/clojush/instructions/genome.clj
+++ src/clojush/instructions/genome.clj
@@ -371,4 +371,24 @@
                                         (merge @push-argmap {:uniform-mutation-rate rate}))))
                         :genome)))
       state)))
+
+(define-registered
+  genome_uniform_close_mutation
+  ^{:stack-types [:genome :float]}
+  (fn [state]
+    (if (and (not (empty? (rest (:float state))))
+             (not (empty? (:genome state))))
+      (let [rate1 (mod (first (:float state)) 1.0)
+            rate2 (mod (first (:float state)) 1.0)
+            genome (first (:genome state))]
+        (->> (pop-item :float state)
+             (pop-item :float)
+             (pop-item :genome)
+             (push-item (vec (:genome (uniform-close-mutation
+                                        {:genome genome}
+                                        (merge @push-argmap
+                                               {:uniform-close-mutation-rate rate1
+                                                :close-increment-rate rate2}))))
+                        :genome)))
+      state)))
 ;; @@


New instruction string_contained.

New instruction string_contained.

--- src/clojush/instructions/string.clj
+++ src/clojush/instructions/string.clj
@@ -69,3 +69,17 @@
           loop-state
           (recur (rest char-list)
                  (push-item (str (first char-list)) :string loop-state)))))))
+
+(define-registered
+  string_contained ;;true if top string is a substring of second string; false otherwise
+  (fn [state]
+    (if (empty? (rest (:string state)))
+      state
+      (let [sub (top-item :string state)
+            full (stack-ref :string 1 state)
+            result-boolean         (if (<= 0 (.indexOf full sub))
+                                     true
+                                     false)]
+        (push-item result-boolean
+                   :boolean
+                   (pop-item :string (pop-item :string state)))))))


Document that we don't want any build to be stored if one exists that is invalid

--- test/buildviz/controllers/builds_test.clj
+++ test/buildviz/controllers/builds_test.clj
@@ -220,7 +220,18 @@
     (let [builds (atom {})
           app (the-app-with-builds builds)]
       (post-request app "/builds" (json/generate-string {:jobName "abuild" :buildId "42"}) "application/x-ndjson")
-      (is (nil? (get-in @builds ["abuild" "42"]))))))
+      (is (nil? (get-in @builds ["abuild" "42"])))))
+
+  (testing "should not store any build on invalid format"
+    (let [builds (atom {})
+          app (the-app-with-builds builds)]
+      (post-request app
+                    "/builds"
+                    (clojure.string/join ""
+                                         [(json/generate-string {:jobName "abuild" :buildId "1" :start 1453646247759})
+                                          (json/generate-string {:jobName "abuild" :buildId "42"})])
+                    "text/plain")
+      (is (empty? @builds)))))

 (deftest test-get-builds


fixed chat tests

fixed chat tests

--- test/cljs/status_im/test/chat/events.cljs
+++ test/cljs/status_im/test/chat/events.cljs
@@ -4,7 +4,7 @@
             [re-frame.core :as rf]
             [day8.re-frame.test :refer [run-test-sync]]
             [status-im.constants :as const]
-            [status-im.chat.sign-up :as sign-up]
+            [status-im.chat.console :as console-chat]
             [status-im.chat.events :as chat-events]))

 (def contact
@@ -16,7 +16,7 @@

 (deftest init-console-chat
   (testing "initialising console if console is already added to chats, should not modify anything"
-    (let [db {:chats {const/console-chat-id sign-up/console-chat}}
+    (let [db {:chats {const/console-chat-id console-chat/chat}}
           fx (chat-events/init-console-chat db)]
       (is (= db (:db fx)))
       (is (= #{:db} (-> fx keys set)))))
@@ -26,19 +26,15 @@
                     :accounts/current-account-id nil}
           {:keys [db dispatch-n]} (chat-events/init-console-chat fresh-db)]
       (is (= (:current-chat-id db)
-             (:chat-id sign-up/console-chat)))
+             (:chat-id console-chat/chat)))
       (is (= (:current-chat-id db)
-             const/console-chat-id))
-      (is (= dispatch-n
-             [[:add-contacts [sign-up/console-contact]]
-              sign-up/intro-event]))))
+             const/console-chat-id))))

   (testing "initialising console with existing account and console chat not initialisated"
     (let [fresh-db {:chats {}
                     :accounts/current-account-id (:whisper-identity contact)}
           {:keys [db dispatch-n]} (chat-events/init-console-chat fresh-db)]
       (is (= (:current-chat-id db)
-             (:chat-id sign-up/console-chat)))
+             (:chat-id console-chat/chat)))
       (is (= (:current-chat-id db)
-             const/console-chat-id))
-      (is (= dispatch-n [[:add-contacts [sign-up/console-contact]]])))))
+             const/console-chat-id)))))


Fix ttl test

Fix ttl test

--- test/clojurewerkz/cassaforte/cql_test.clj
+++ test/clojurewerkz/cassaforte/cql_test.clj
@@ -20,8 +20,8 @@

   (deftest test-insert-batch-with-ttl
     (th/test-combinations
-     (let [input [[{:name "Alex" :city "Munich" :age (int 19)} (using :ttl 350)]
-                  [{:name "Alex" :city "Munich" :age (int 19)} (using :ttl 350)]]]
+     (let [input [[{:name "Alex" :city "Munich" :age (int 19)} (using :ttl (int 350))]
+                  [{:name "Alex" :city "Munich" :age (int 19)} (using :ttl (int 350))]]]
        (insert-batch s :users input)
        (is (= (first (first input)) (first (select s :users))))
        (truncate s :users))))


Fix a bug in `lines->numbers`.

Fix a bug in `lines->numbers`.

--- clojure/src/advent2017/core.clj
+++ clojure/src/advent2017/core.clj
@@ -20,7 +20,8 @@
 (defn ->numbers [xs]
   (map #(Integer/parseInt %) xs))

-(def lines->numbers (partial map words->numbers))
+(def lines->numbers (comp (partial map (comp ->numbers ->words))
+                          ->lines))

 (defn csv->numbers [s]
   (->numbers (clojure.string/split s #",")))


shite code to draw the walls that block further sight

--- clojure/src/dnd/showScreen.cljs
+++ clojure/src/dnd/showScreen.cljs
@@ -26,23 +26,15 @@
     (partial draw-x term) line))

 (defn shorten-line [level line]
-  (take-while #(let [[x y] %
+  (def shortened-line (take-while #(let [[x y] %
                      x (min (dec width)  (max 0 (dec x)))
                      y (min (dec height) (max 0 (dec y)))
                      current-block (get-in level [x y])]
                  (not (current-block :solid))
                  ) line))
-
-(defn fov [character]
-  (let [{:keys [x y direction]} character
-        [x y] (map inc [x y])
-        ends (end-points character)
-        lines (map #(let [dx (first %)
-                          dy (second %)
-                          start #js[x y]
-                          end   #js[dx dy]]
-                      (js->clj (bresenham start end))) ends)]
-    lines))
+  (if (apply not= (map count [shortened-line line]))
+    (concat shortened-line (list (nth line (count shortened-line))))
+    line))

 (defn draw-block [term block]
   (let [{:keys [x y solid inhabitants color]} block
@@ -59,10 +51,21 @@
     (apply (.-bgColorRgb term) bgcolor)
     (.moveTo        term x y char)))

-(defn get-block [level coords]
-  (let [[x y] coords]
-    (get-in level [x y])))
+(defn fov [character]
+  (let [{:keys [x y direction]} character
+        [x y] (map inc [x y])
+        ends (end-points character)
+        lines (map #(let [dx (first %)
+                          dy (second %)
+                          start #js[x y]
+                          end   #js[dx dy]]
+                      (js->clj (bresenham start end))) ends)]
+    lines))

+(defn viewable-coords [character level]
+  (let [fov-blocks (fov character)
+        viewable-coords (map (partial shorten-line level) fov-blocks)]
+    (apply concat viewable-coords)))

 (defn dimmed-blocks [level coords]
   (let [flattened-level (flatten level)
@@ -76,18 +79,15 @@
     (map #(if (block-not-in-coords %) (dim-block %) (lit-block %)) flattened-level)
     ))

-(defn viewable-coords [level character]
-  (let [fov-blocks (fov character)
-        viewable-coords (map (partial shorten-line level) fov-blocks)]
-    (apply concat viewable-coords)))
+(defn show-screen [term level character]
+  (defn callback [error] (when error (println error)))

-(defn show-screen [term level character]
-  (def jeah (viewable-coords level character))
-  (def viewable-blocks (map (partial get-block level) jeah))
-  (def new-blocks (dimmed-blocks level jeah))
-  (run! #(draw-block term %) new-blocks)
-  ;(run! (partial draw-line term) viewable-coords)
-
+  (def new-blocks
+    (->> level
+        (viewable-coords character)
+        (dimmed-blocks level)
+        (run! #(draw-block term %))
+        ))

   (.color256    term 7)
   (.bgColor256  term 0)


allow immutable array-buffers

allow immutable array-buffers

--- src/gamma_driver/drivers/basic.cljs
+++ src/gamma_driver/drivers/basic.cljs
@@ -30,7 +30,9 @@
     new))

 (defn default-produce-fn [driver constructor-fn old-spec new-spec]
-  (constructor-fn (gd/gl driver) (merge old-spec new-spec)))
+  (if (and (:immutable? old-spec) (:immutable? new-spec))
+    old-spec
+    (constructor-fn (gd/gl driver) (merge old-spec new-spec))))


Fix order of arguments to ryanmcg/footer.

--- src/incise/layouts/impl/ryanmcg.clj
+++ src/incise/layouts/impl/ryanmcg.clj
@@ -1,5 +1,6 @@
 (ns incise.layouts.impl.ryanmcg
-  (:require (incise.layouts [html :refer [use-layout deflayout defpartial]]
+  (:require (incise.layouts [html :refer [repartial use-layout
+                                          deflayout defpartial]]
                             [core :refer [register]])
             [robert.hooke :refer [add-hook]]
             [incise.layouts.impl.page :refer [page]]
@@ -22,7 +23,7 @@

 (defpartial footer
   "A footer parital with a Creative Commons license attached."
-  [_ {:keys [contacts author]}]
+  [{:keys [contacts author]} _]
   [:hr]
   [:footer
    [:div.row


Remove a note on scroller which raises more questions than it answers.

--- src/re_demo/scroller.cljs
+++ src/re_demo/scroller.cljs
@@ -36,5 +36,5 @@
                                       [p "Notes:"
                                       [:ul
                                        [:li "In this example, if the height of [some-component] is greater than 300px, a vertical scroll bar will be added."]
-                                       [:li "Hiccup is typically supplied for " [:code ":child"] ". Notice that [some-component] is supplied, not some-component."]]]]]]]
+                                       ]]]]]]
               [gap :size "30px"]]])


Removed references to 'routes' from ring.util.servlet

--- src/ring/util/servlet.clj
+++ src/ring/util/servlet.clj
@@ -123,10 +123,10 @@
 (defmacro defservice
   "Defines a service method with an optional prefix suitable for being used by
   genclass to compile a HttpServlet class.
-  e.g. (defservice my-routes)
-       (defservice \"my-prefix-\" my-routes)"
-  ([routes]
-   `(defservice "-" ~routes))
+  e.g. (defservice my-handler)
+       (defservice \"my-prefix-\" my-handler)"
+  ([handler]
+   `(defservice "-" ~handler))
   ([prefix handler]
    `(defn ~(symbol (str prefix "service"))
       [servlet# request# response#]


Fix typo.

Fix typo.

--- src/rosado/processing.clj
+++ src/rosado/processing.clj
@@ -364,7 +364,7 @@

 (defn framerate [new-rate] (.frameRate *applet* (float new-rate)))

-(def frame-rate frame-rate)
+(def frame-rate framerate)

 (defn frustum
   [l r b t near far]


Almost fizz-buzz

Almost fizz-buzz

--- src/shokunin/fizzbuzz.clj
+++ src/shokunin/fizzbuzz.clj
@@ -1,5 +1,9 @@
 (ns shokunin.fizzbuz)

-(def fizz-buzz (let [fizzer (cycle [nil nil "fizz"])
+(def fizz-buzz (let [number (iterate inc 1)
+                     fizzer (cycle [nil nil "fizz"])
                      buzzer (cycle [nil nil nil nil "buzz"])]
-                 (map str fizzer buzzer)))
+                 (map #(or (str %2 %3) %1)
+                      number fizzer buzzer)))
+
+(take 15 fizz-buzz)


optimize analyze-let & macroexpand-1

optimize analyze-let & macroexpand-1

--- src/main/clojure/cljs/analyzer.cljc
+++ src/main/clojure/cljs/analyzer.cljc
@@ -1289,63 +1289,94 @@
      :statements statements :ret ret
      :children (conj (vec statements) ret)}))

+(defn analyze-let-binding-init [env init loop-lets]
+  (binding [*loop-lets* loop-lets]
+    (analyze env init)))
+
+(defn get-let-tag [name init-expr]
+  (let [tag (-> name meta :tag)]
+    (if-not (nil? tag)
+      tag
+      (let [tag (-> init-expr :tag)]
+        (if-not (nil? tag)
+          tag
+          (-> init-expr :info :tag))))))
+
+(defn analyze-let-bindings* [encl-env bindings]
+  (loop [bes []
+         env (assoc encl-env :context :expr)
+         bindings (seq (partition 2 bindings))]
+    (let [binding (first bindings)]
+      (if-not (nil? binding)
+        (let [[name init] binding]
+          (when (or (not (nil? (namespace name)))
+                  #?(:clj  (.contains (str name) ".")
+                     :cljs ^boolean (goog.string/contains (str name) ".")))
+            (throw (error encl-env (str "Invalid local name: " name))))
+          (let [init-expr (analyze-let-binding-init env init (cons {:params bes} *loop-lets*))
+                line (get-line name env)
+                col (get-col name env)
+                be {:name name
+                    :line line
+                    :column col
+                    :init init-expr
+                    :tag (get-let-tag name init-expr)
+                    :local true
+                    :shadow (-> env :locals name)
+                    ;; Give let* bindings same shape as var so
+                    ;; they get routed correctly in the compiler
+                    :op :var
+                    :env {:line line :column col}
+                    :info {:name name
+                           :shadow (-> env :locals name)}
+                    :binding-form? true}
+                be (if (= :fn (:op init-expr))
+                     ;; TODO: can we simplify - David
+                     (merge be
+                       {:fn-var true
+                        :variadic (:variadic init-expr)
+                        :max-fixed-arity (:max-fixed-arity init-expr)
+                        :method-params (map :params (:methods init-expr))})
+                     be)]
+            (recur (conj bes be)
+              (assoc-in env [:locals name] be)
+              (next bindings))))
+        [bes env]))))
+
+(defn analyze-let-bindings [encl-env bindings]
+  (disallowing-recur (analyze-let-bindings* encl-env bindings)))
+
+(defn analyze-let-body* [env context exprs]
+  (analyze (assoc env :context (if (= :expr context) :return context)) `(do ~@exprs)))
+
+(defn analyze-let-body [env context exprs recur-frames loop-lets]
+  (binding [*recur-frames* recur-frames
+            *loop-lets* loop-lets]
+    (analyze-let-body* env context exprs)))
+
 (defn analyze-let
   [encl-env [_ bindings & exprs :as form] is-loop]
   (when-not (and (vector? bindings) (even? (count bindings)))
     (throw (error encl-env "bindings must be vector of even number of elements")))
-  (let [context (:context encl-env)
-        [bes env]
-        (disallowing-recur
-         (loop [bes []
-                env (assoc encl-env :context :expr)
-                bindings (seq (partition 2 bindings))]
-           (if-let [[name init] (first bindings)]
-             (do
-               (when (or (namespace name)
-                         #?(:clj  (.contains (str name) ".")
-                            :cljs (goog.string/contains (str name) ".")))
-                 (throw (error encl-env (str "Invalid local name: " name))))
-               (let [init-expr (binding [*loop-lets* (cons {:params bes} *loop-lets*)]
-                                 (analyze env init))
-                     be {:name name
-                         :line (get-line name env)
-                         :column (get-col name env)
-                         :init init-expr
-                         :tag (or (-> name meta :tag)
-                                  (-> init-expr :tag)
-                                  (-> init-expr :info :tag))
-                         :local true
-                         :shadow (-> env :locals name)
-                         ;; Give let* bindings same shape as var so
-                         ;; they get routed correctly in the compiler
-                         :op :var
-                         :env {:line (get-line name env)
-                               :column (get-col name env)}
-                         :info {:name name
-                                :shadow (-> env :locals name)}
-                         :binding-form? true}
-                     be (if (= (:op init-expr) :fn)
-                          ;; TODO: can we simplify - David
-                          (merge be
-                            {:fn-var true
-                             :variadic (:variadic init-expr)
-                             :max-fixed-arity (:max-fixed-arity init-expr)
-                             :method-params (map :params (:methods init-expr))})
-                          be)]
-                 (recur (conj bes be)
-                        (assoc-in env [:locals name] be)
-                        (next bindings))))
-             [bes env])))
-        recur-frame (when is-loop {:params bes :flag (atom nil)})
-        expr
-        (binding [*recur-frames* (if recur-frame (cons recur-frame *recur-frames*) *recur-frames*)
-                  *loop-lets* (cond
-                                is-loop *loop-lets*
-                                *loop-lets* (cons {:params bes} *loop-lets*))]
-          (analyze (assoc env :context (if (= :expr context) :return context)) `(do ~@exprs)))]
-    {:env encl-env :op (if is-loop :loop :let)
-     :bindings bes :expr expr :form form
-     :children (conj (vec (map :init bes)) expr)}))
+  (let [context      (:context encl-env)
+        [bes env]    (analyze-let-bindings encl-env bindings)
+        recur-frame  (when (true? is-loop)
+                       {:params bes :flag (atom nil)})
+        recur-frames (if recur-frame
+                       (cons recur-frame *recur-frames*)
+                       *recur-frames*)
+        loop-lets    (cond
+                       (true? is-loop) *loop-lets*
+                       (not (nil? *loop-lets*)) (cons {:params bes} *loop-lets*))
+        expr         (analyze-let-body env context exprs recur-frames loop-lets)
+        op           (if (true? is-loop) :loop :let)
+        children     (conj (vec (map :init bes)) expr)]
+    {:op op
+     :env encl-env
+     :bindings bes
+     :expr expr
+     :form form
+     :children children}))

 (defmethod parse 'let*
   [op encl-env form _ _]
@@ -2135,10 +2166,16 @@
               (if #?(:clj (seq? form') :cljs (cljs-seq? form'))
                 (let [sym' (first form')
                       sym  (first form)]
-                  (if #?(:clj (= sym' 'js*) :cljs (symbol-identical? sym' JS_STAR_SYM))
-                    (vary-meta form' merge
-                      (cond-> {:js-op (if (namespace sym) sym (symbol "cljs.core" (str sym)))}
-                        (-> mac-var meta ::numeric) (assoc :numeric true)))
+                  (if #?(:clj  (= sym' 'js*)
+                         :cljs (symbol-identical? sym' JS_STAR_SYM))
+                    (let [sym   (if (namespace sym)
+                                  sym
+                                  (symbol "cljs.core" (str sym)))
+                          js-op {:js-op sym}
+                          js-op (if (true? (-> mac-var meta ::numeric))
+                                  (assoc js-op :numeric true)
+                                  js-op)]
+                      (vary-meta form' merge js-op))
                     form'))
                 form')))
           (if (symbol? op)


minor tweaks to inference, use JS string ops instead of seq ops

--- src/main/clojure/cljs/analyzer.cljc
+++ src/main/clojure/cljs/analyzer.cljc
@@ -750,9 +750,13 @@
   {:op :constant :env env :form sym :tag 'cljs.core/Keyword})

 (defn get-tag [e]
-  (or (-> e :tag)
-      (-> e :info :tag)
-      (-> e :form meta :tag)))
+  (let [tag (-> e :tag)]
+    (if-not (nil? tag)
+      tag
+      (let [tag (-> e :info :tag)]
+        (if-not (nil? tag)
+          tag
+          (-> e :form meta :tag))))))

 (defn find-matching-method [f params]
   ;; if local fn, need to look in :info
@@ -825,7 +829,9 @@
         ret-tag (when-not (nil? (:fn-var info)) (:ret-tag info))]
     (if-not (nil? ret-tag)
       ret-tag
-      (let [ret-tag (infer-tag env (assoc (find-matching-method f (:args e)) :op :method))]
+      (let [args (:args e)
+            me (assoc (find-matching-method f args) :op :method)
+            ret-tag (infer-tag env me)]
         (if-not (nil? ret-tag)
           ret-tag
           ANY_SYM)))))
@@ -2138,12 +2144,16 @@
           (if (symbol? op)
             (let [opname (str op)]
               (cond
-                (identical? (first opname) \.)
+                (identical? \.
+                  #?(:clj  (first opname)
+                     :cljs (.charAt opname 0)))
                 (let [[target & args] (next form)]
                   (with-meta (list* #?(:clj '. :cljs DOT_SYM) target (symbol (subs opname 1)) args)
                     (meta form)))

-                (identical? (last opname) \.)
+                (identical? \.
+                  #?(:clj  (last opname)
+                     :cljs (.charAt opname (dec (. opname -length)))))
                 (with-meta
                   (list* #?(:clj 'new :cljs NEW_SYM) (symbol (subs opname 0 (dec (count opname)))) (next form))
                   (meta form))
@@ -2245,10 +2255,13 @@
       expr)))

 (defn infer-type [env ast]
-  (if-let [tag (and (not (:tag ast))
-                    (infer-tag env ast))]
-    (assoc ast :tag tag)
-    ast))
+  (let [tag (:tag ast)]
+    (if (nil? tag)
+      (let [tag (infer-tag env ast)]
+        (if-not (nil? tag)
+          (assoc ast :tag tag)
+          ast))
+      ast)))

 (def ^:dynamic *passes* nil)


Add explicit dependency to fix sass4clj internal broken dep

--- functions/project.clj
+++ functions/project.clj
@@ -10,6 +10,7 @@
                  [pjstadig/humane-test-output "0.8.2"]
                  [compojure "1.6.0"]
                  [deraen/sass4clj "0.3.1"]
+                 [org.slf4j/slf4j-log4j12 "1.7.9"]
                  [ring/ring-defaults "0.2.1"]]
   :sass {:source-paths ["resources/public/css/scss"]
              :target-path "resources/public/css"


Add specs

Add specs

--- src/net/sekao/nightcode/process.clj
+++ src/net/sekao/nightcode/process.clj
@@ -9,10 +9,12 @@

 (defonce class-name (str *ns*))

+(fdef start-process!
+  :args (s/cat :process spec/atom? :path string? :args (s/coll-of string? [])))
 (defn start-process!
-  [process path & args]
+  [process path args]
   (reset! process (.exec (Runtime/getRuntime)
-                         (into-array (flatten args))
+                         (into-array args)
                          nil
                          (io/file path)))
   (.addShutdownHook (Runtime/getRuntime)
@@ -28,19 +30,22 @@
       (.waitFor @process)
       (reset! process nil))))

+(fdef start-java-process!
+  :args (s/cat :process spec/atom? :path string? :args (s/* string?)))
 (defn start-java-process!
   [process path & args]
   (let [java-cmd (or (System/getenv "JAVA_CMD") "java")
         jar-uri (u/get-exec-uri class-name)]
-    (start-process! process
-                    path
-                    java-cmd
-                    "-cp"
-                    (if (.isDirectory (io/file jar-uri))
-                      (System/getProperty "java.class.path")
-                      (u/uri->str jar-uri))
-                    args)))
+    (start-process! process path
+      (flatten [java-cmd
+                "-cp"
+                (if (.isDirectory (io/file jar-uri))
+                  (System/getProperty "java.class.path")
+                  (u/uri->str jar-uri))
+                args]))))

+(fdef stop-process!
+  :args (s/cat :process spec/atom?))
 (defn stop-process!
   [process]
   (when @process


Tweak some options

Tweak some options

--- src/overtone_workspace/grunbles.clj
+++ src/overtone_workspace/grunbles.clj
@@ -4,7 +4,7 @@
 ;; Inspired by an example in an early chapter of the SuperCollider book

 (definst grumble [speed 6 freq-mul 1 attack 10 release 50]
-  (let [snd (mix (map #(* (lf-tri (* % freq-mul 100))
+  (let [snd (mix (map #(* (lf-saw (* % freq-mul 100))
                           (max 0 (+ (lf-noise1:kr speed)
                                     (env-gen (perc attack release) :action FREE))))
                       [1 (/ 2 3) (/ 3 2) 2]))]
@@ -25,7 +25,7 @@

 (defn player [beat rates]
   (let [rates (if (empty? rates)
-                [4 8 2 2 1.5 1.5]
+                [4 6 2 2 1.5 1.5]
                 rates)
         bpm (metro :bpm)
         dur (/ 60.0 bpm)
@@ -35,8 +35,7 @@
         (do
           (if (zero? (mod beat 8)) (grumble :freq-mul 0.5 :attack attack :release rel))
           (if (zero? (mod beat 8)) (grumble :freq-mul 1 :attack attack :release rel))
-          (if (zero? (mod beat 16))
-            (grumble :freq-mul (choose rates) :attack attack :release rel))
+          (if (zero? (mod beat 16)) (grumble :freq-mul (choose rates) :attack attack :release rel))
           ))
     (apply-by (metro (inc beat)) #'player (inc beat) (next rates) [])
     ))


Reimplement color helpers using google closure library facilities.

--- src/uxbox/util/color.cljs
+++ src/uxbox/util/color.cljs
@@ -7,18 +7,9 @@

 (ns uxbox.util.color
   "Color conversion utils."
-  (:require [cuerdas.core :as str]))
-
-(defn hex->rgb
-  [^string data]
-  (some->> (re-find #"^#?([a-f\d]{2})([a-f\d]{2})([a-f\d]{2})$" data)
-           (rest)
-           (mapv #(js/parseInt % 16))))
-
-(defn hex->rgba
-  [^string data ^number opacity]
-  (-> (hex->rgb data)
-      (conj opacity)))
+  (:require [cuerdas.core :as str]
+            [uxbox.util.math :as math]
+            [goog.color :as gcolor]))

 (defn rgb->str
   [color]
@@ -27,11 +18,32 @@
     (apply str/format "rgb(%s,%s,%s)" color)
     (apply str/format "rgba(%s,%s,%s,%s)" color)))

+(defn rgb->hsv
+  [[r g b]]
+  (into [] (gcolor/rgbToHsv r g b)))
+
+(defn hsv->rgb
+  [[h s v]]
+  (into [] (gcolor/hsvToRgb h s v)))
+
+(defn hex->rgb
+  [v]
+  (into [] (gcolor/hexToRgb v)))
+
 (defn rgb->hex
   [[r g b]]
-  (letfn [(to-hex [c]
-            (let [hexdata (.toString c 16)]
-              (if (= (count hexdata) 1)
-                (str "0" hexdata)
-                hexdata)))]
-    (str "#" (to-hex r) (to-hex g) (to-hex b))))
+  (gcolor/rgbToHex r g b))
+
+(defn hex->hsv
+  [v]
+  (into [] (gcolor/hexToHsv v)))
+
+(defn hsv->hex
+  [[h s v]]
+  (gcolor/hsvToHex h s v))
+
+(defn hex->rgba
+  [^string data ^number opacity]
+  (-> (hex->rgb data)
+      (conj opacity)))
+


slugify properties.

slugify properties.

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -281,6 +281,11 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; properties
+(defn slugify-property
+  "Create a slug for a property in the UI"
+  [property]
+  (assoc property :slug (:address-street-two property)))
+
 (defn properties-table [properties owner]
   (reify
     om/IRender
@@ -327,7 +332,7 @@
                  {:handler  (fn [x]
                               (println "Fetching properties for project: " new-project-id)
                               (om/update! properties :fetching false)
-                              (om/update! properties :data x)
+                              (om/update! properties :data (mapv slugify-property x))
                               (om/update! properties :selected nil))
                   :error-handler (fn [{:keys [status status-text]}]
                                    (om/update! properties :fetching false)
@@ -433,7 +438,7 @@
                   (title-for projects)]]
             [:li [:a
                   {:onClick (back-to-properties history)}
-                  (title-for properties :title-key :address-street-two)]
+                  (title-for properties)]
              " " (when (:fetching devices) [:span {:class "glyphicon glyphicon-cloud-download spinner"}])]]
            (om/build devices-table devices {:opts {:histkey :devices}})]])))))


(PDB-1653) Add response-mult to the dispatcher

This is a mult on the channel that gets all the response messages, not
partitioned by topic.

Also removes the field from the response messages, as it is not needed
and could lead to memory issues.

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -341,13 +341,17 @@
     count of the commands that the current instance has processed
     without triggering an exception).")

+  (response-mult [this]
+    "Returns a core.async mult to which {:id :exception} maps are written after
+     each command has been processed. " )
+
   (response-pub [this]
-    "Returns a core.async publisher to which commands are written after they
-     have been processed. The topic for each message is its uuid." ))
+    "Returns a core.async pub to which {:id :exception} maps are written after
+     each command has been processed. The topic for each message is its
+     id (command uuid)."))

 (defn make-cmd-processed-message [cmd ex]
-  (merge {:command cmd
-          :id (-> cmd :annotations :id)}
+  (merge {:id (-> cmd :annotations :id)}
          (when ex {:exception ex})))

 (defn process-command-and-respond! [cmd config response-pub-chan stats-atom]
@@ -367,26 +371,34 @@
   [[:PuppetDBServer shared-globals]
    [:MessageListenerService register-listener]]
   (init [this context]
-    (let [response-pub-chan (async/chan)]
+    (let [response-chan (async/chan)
+          response-mult (async/mult response-chan)
+          response-chan-for-pub (async/chan)]
+      (async/tap response-mult response-chan-for-pub)
       (assoc context
              :stats (atom {:received-commands 0
                            :executed-commands 0})
-             :response-pub-chan response-pub-chan
-             :response-pub (async/pub response-pub-chan :id))))
+             :response-chan response-chan
+             :response-mult response-mult
+             :response-chan-for-pub response-chan-for-pub
+             :response-pub (async/pub response-chan-for-pub :id))))

   (start [this context]
     (let [{:keys [scf-write-db catalog-hash-debug-dir]} (shared-globals)
           config {:db scf-write-db
                   :catalog-hash-debug-dir catalog-hash-debug-dir}
-          {:keys [response-pub-chan response-pub]} context]
+          {:keys [response-chan response-pub]} context]
       (register-listener
        supported-command?
-       #(process-command-and-respond! % config response-pub-chan (:stats context)))
+       #(process-command-and-respond! % config response-chan (:stats context)))
       context))

-  (stop [this {:keys [response-pub-chan] :as context}]
-    (async/close! response-pub-chan)
-    (dissoc context :response-pub :response-pub-chan))
+  (stop [this context]
+    (async/unsub-all (:response-pub context))
+    (async/untap-all (:response-mult context))
+    (async/close! (:response-chan-for-pub context))
+    (async/close! (:response-chan context))
+    (dissoc context :response-pub :response-chan :response-chan-for-pub :response-mult))

   (stats [this]
     @(:stats (service-context this)))
@@ -405,4 +417,7 @@
       result))

   (response-pub [this]
-    (-> this service-context :response-pub)))
+    (-> this service-context :response-pub))
+
+  (response-mult [this]
+    (-> this service-context :response-mult)))


Support for including the actual children of an element when the child count doesn't match, to make debugging easier

--- web-client/test/test_burgerboard/huh.cljs
+++ web-client/test/test_burgerboard/huh.cljs
@@ -76,6 +76,11 @@
     )
   )

+(defn component-name [component]
+  (.-name component)                    ; This isn't standard JS, but
+                                        ; works enough places, for now
+  )
+
 (defn tag [expected-tag & tests]
   (fn -tag-pred [component]
     (let [actual (tag-name component)]
@@ -87,6 +92,34 @@
           )
         )
       )
+    )
+  )
+
+(defn multiple-components? [component]
+  (= (type component) js/Array))
+
+(declare display-children)
+
+(defn display-child
+  ([component]
+     (cond
+      (not (nil? (.. component -props)))
+      {
+       :tag (tag-name component)
+       :children (display-children (.. component -props -children))
+       }
+      (fn? component) {:sub-component (component-name component)}
+      (string? component) {:text component}
+      (satisfies? IDeref component) {:cursor @component}
+      :else {:unknown "unknown"}
+      )
+     )
+  )
+
+(defn display-children [children]
+  (if (multiple-components? children)
+    (map #(display-child %) children)
+    (display-child children)
     )
   )

@@ -100,7 +133,8 @@
         (let [child-count (count children)]
           (if (not= test-count child-count)
             {:msg "Wrong number of child elements"
-             :expected test-count :actual child-count}
+             :expected test-count :actual child-count
+             :actual-children (display-children children)}
             (if-let [failures
                      (seq (filter (fn [result] (not= true result))
                                   (map (fn [pred child] (pred child))
@@ -113,7 +147,8 @@
           )
         (if (not= 1 test-count) ;; Children is actually just one child
           {:msg "Wrong number of child elements"
-           :expected test-count :actual 1}
+           :expected test-count :actual 1
+           :actual-children (display-children children)}
           ((nth tests 0) children)
           )
         )
@@ -135,11 +170,6 @@
       {:msg "Text does not match" :expected text :actual component}
       )
     )
-  )
-
-(defn component-name [component]
-  (.-name component)                    ; This isn't standard JS, but
-                                        ; works enough places, for now
   )

 (defn sub-component [sub-component cursor]


fix opening recent doc behavior for desktop and mobile

--- src-cljs/frontend/components/doc_viewer.cljs
+++ src-cljs/frontend/components/doc_viewer.cljs
@@ -52,7 +52,10 @@

             (for [doc bucket-docs]
               (html
-                [:a.recent-doc.make {:href (str (urls/doc-path doc) "/doc-viewer")}
+                [:a.recent-doc.make {:href (str (urls/doc-path doc) "/doc-viewer")
+                                     :on-touch-end #(do
+                                                      (.preventDefault %)
+                                                      (put! (om/get-shared owner [:comms :nav]) [:navigate! {:path (str (urls/doc-path doc))}]))}
                  [:img {:src (urls/doc-svg-path doc)}]

                  (common/icon :loading)


Remove cruft

Remove cruft

--- src-cljs/frontend/components/pages/team.cljs
+++ src-cljs/frontend/components/pages/team.cljs
@@ -143,6 +143,7 @@
                                   :actions [(button/button {:on-click #(om/set-state! owner :show-modal? false)} "Cancel")
                                             (forms/managed-button
                                               [:button.btn.btn-success {:data-success-text "Sent"
+                                                                        ;; TODO -ac Switch this to the real implementation before merging
                                                                         :on-click #(.log js/console "Invitees: " (seq (invitees users)))
                                                                         ;; :on-click #(raise! owner [:invited-github-users (merge {:invitees (invitees users)
                                                                         ;;                                                         :vcs_type (:vcs_type opts)}
@@ -158,8 +159,7 @@
              {:disabled? (nil? users)
               :primary? true
               :on-click (fn []
-                          ;; TODO -ac Add tracking back in before merging
-                          #_((om/get-shared owner :track-event)
+                          ((om/get-shared owner :track-event)
                              {:event-type :invite-teammates-clicked
                               :properties {:view :team}})
                           (om/set-state! owner :show-modal? (not (:show-modal? (om/get-render-state owner)))))}
@@ -185,12 +185,7 @@
             selected-org (when selected-org-ident (get-in app selected-org-ident))]
         (when (not= (:selected-org-ident (om/get-render-state owner))
                     selected-org-ident)
-          (api/get-org-settings-normalized name vcs-type api-chan))
-        ;; TODO -ac This is doing the thing, need to make it into a component
-        ;; Fire on WillMount
-        (when (and selected-org
-                   invite-teammates?)
-          #_(api/get-org-members api-chan (:name selected-org)))))
+          (api/get-org-settings-normalized name vcs-type api-chan))))

     om/IRenderState
     (render-state [_ {:keys [selected-org-ident invite-teammates?]}]
@@ -222,13 +217,7 @@
                                    "bitbucket" [:i.fa.fa-bitbucket]
                                    nil)])
                    :action  (om/build invite-teammates-modal {:selected-org-ident selected-org-ident
-                                                              :app app})
-                   ;; TODO -ac Remvoethis cruft
-                   #_(html
-                              [:div (when (:show-modal? (om/get-render-state owner))
-                                      (om/build invite-teammates-modal {:selected-org-ident selected-org-ident
-                                                                        :app app}))
-                               ])}
+                                                              :app app})}
                 (if-let [users (:users selected-org)]
                   (table (add-follow-counts users (:projects selected-org)))
                   (html [:div.loading-spinner common/spinner])))


add correlation coefficients to lt-sz and r-sz

--- src/clj/ceres_analytics/news_measures.clj
+++ src/clj/ceres_analytics/news_measures.clj
@@ -307,7 +307,7 @@
     (let [result  (->> authors
                        (mapcat
                         (fn [author]
-                          (->> (get-user-tree author t0 tmax)
+                          (->> (get-user-tree (key author) t0 tmax)
                                :links
                                (pmap
                                 (fn [[l ls]]
@@ -364,6 +364,24 @@
   "Computes size-radius tuple distribution and evolution for any author's news compound"
   [authors t0 tmax granularity]
   (case granularity
+    :correlation
+    (let [links (mapcat #(:links (get-user-tree (key %) t0 tmax)) authors)
+          lsize (count links)
+          result
+          (->> links
+               (pmap
+                (fn [[l ls]]
+                  (let [contact-times (map (comp c/to-long :ts) ls)]
+                    (if (empty? contact-times)
+                      [0 0]
+                      [(count contact-times)
+                       (/ (t/in-seconds
+                           (t/interval
+                            (:ts l)
+                            (-> (apply min contact-times)
+                                c/from-long)))
+                          60)])))))]
+      (stats/correlation (map first result) (map second result)))
     :distribution
     (let [links (mapcat #(:links (get-user-tree (key %) t0 tmax)) authors)
           lsize (count links)]
@@ -431,4 +449,9 @@

   (lifetime-degree broadcasters t0 tmax :distribution)

+  (size-lifetime broadcasters t0 tmax :correlation)
+
+  (size-radius broadcasters t0 tmax :correlation)
+
+
   )


Small bugfixes

Small bugfixes

--- src/cljs/travel_site/components/city.cljs
+++ src/cljs/travel_site/components/city.cljs
@@ -95,21 +95,7 @@
                                                               {:edit-key :address
                                                                :coords-key :coords
                                                                :className "address-fields" ;; TODO - rename className -> class
-                                                               :placeholder-text "End address"}])]]]
-              [:div {:class "inline fields"}
-               [:div {:class "sixteen wide field"}
-                [:div {:class "ui fluid input time-input"}
-                 (om/build inputs/datetime-picker-input [(-> journey :start-place)
-                                                         {:edit-key :time
-                                                          :coords-key :coords
-                                                          :className "time-fields" ;;TODO - rename className -> class
-                                                          :placeholder-text "Start time"}])]
-                [:div {:class "ui fluid input time-input"}
-                 (om/build inputs/datetime-picker-input [(-> journey :start-place)
-                                                         {:edit-key :time
-                                                          :coords-key :coords
-                                                          :className "time-fields" ;;TODO - rename className -> class
-                                                          :placeholder-text "End time"}])]]]]]))))
+                                                               :placeholder-text "End address"}])]]]]]))))

 ;; Functions for the map view.
@@ -318,7 +304,8 @@
           (om/set-state! owner :google-directions-service google-directions-service)
           (gen-new-renderers owner transit-journey show-vehicle-icons)
           (gen-new-markers owner transit-journey)
-          (fit-map-to-markers (om/get-state owner :google-map) (om/get-state owner :all-markers)))))
+          (if (valid-journey? journey)
+            (fit-map-to-markers (om/get-state owner :google-map) (om/get-state owner :all-markers))))))

     ;; recompute the route upon journey update
     om/IDidUpdate
@@ -400,7 +387,9 @@
               [:div {:class "ui fourteen wide column row basic segment final-directions"}
                [:div {:class "fourteen wide column"}
                 (om/build attraction-map-view [current-city journey transit-journey true])
-                (om/build attraction-map-legend-view transit-journey)]]
+                (if (valid-journey? journey)
+                  (om/build attraction-map-legend-view transit-journey))]]
               [:div {:class "ui fourteen wide column row basic segment final-directions"}
                [:div {:class "fourteen wide column"}
-                (om/build transit-view transit-journey)]]]]))))
+                (if (valid-journey? journey)
+                  (om/build transit-view transit-journey))]]]]))))


Change default result-set-fn.

Change default result-set-fn.

--- src/fhofherr/clj_db_util/jdbc_template.clj
+++ src/fhofherr/clj_db_util/jdbc_template.clj
@@ -13,8 +13,7 @@
                         result-set-fn]
                  :or {:params {}
                       :template-vars {}
-                      ;; TODO identity is wrong!
-                      :result-set-fn identity}}]
+                      :result-set-fn doall}}]
   (let [[argv tree] (->> sql-str
                          (d/parse (db-con/dialect db))
                          (tv/process-template-vars (db-con/dialect db) template-vars)


Add documentation to Cassandra Ring session store.

--- src/containium/ring_session_cassandra.clj
+++ src/containium/ring_session_cassandra.clj
@@ -3,6 +3,8 @@
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.

 (ns containium.ring-session-cassandra
+  "This namespace contains the Containium system offering a Ring
+  SessionStore backed by Cassandra and Nippy."
   (:require [ring.middleware.session.store :refer (SessionStore read-session)]
             [taoensso.nippy :refer (freeze thaw)]
             [clojure.core.cache :refer (ttl-cache-factory)]
@@ -21,6 +23,8 @@
 ;;; Helper functions.

 (defn- ->bytebuffer
+  "Converts some basic type to a ByteBuffer. Currently supported types
+  are: String, Long, byte array and ByteBuffer."
   [primitive]
   (condp instance? primitive
     String
@@ -38,6 +42,9 @@

 (defn- bytebuffer->bytes
+  "Converts a ByteBuffer to a byte array. If the ByteBuffer is backed
+  by an array, a copy of the relevant part of that array is returned.
+  Otherwise, the bytes are streamed into a byte array."
   [^ByteBuffer bb]
   (if (.hasArray bb)
     (Arrays/copyOfRange (.array bb)
@@ -50,11 +57,12 @@

 ;;; General Cassandra functions.

-(def client-state (ClientState. true))
-(def query-state (QueryState. client-state))
+(def ^:private client-state (ClientState. true))
+(def ^:private query-state (QueryState. client-state))

 (defn- prepared-query
+  "Create a prepared CQLStatement."
   [query-str]
   (-> query-str
       (QueryProcessor/prepare client-state false)
@@ -63,6 +71,10 @@

 (defn- do-prepared
+  "Execute a prepared CQLStatement, using the specified consistency (a
+  keyword) and the positional arguments for the prepared query. If
+  rows are returned by the query, an UntypedResultSet is returned,
+  otherwise nil."
   [pp-query consistency & args]
   (let [consistency (case consistency
                       :any ConsistencyLevel/ANY
@@ -81,20 +93,25 @@

 ;;; Session Cassandra definitions.

-(def read-query
+(def ^:private read-query
   (delay (prepared-query "SELECT data FROM ring.sessions WHERE key = ?;")))

 (defn- write-query*
+  "Create a prepared update query, using the configured TTL (in
+  minutes). The TTL is actually doubled for the query, such that as
+  long as the session is in the local core.cache, it is also in the
+  database, without requiring updates in the database each time for
+  the sake of extending the TTL."
   [ttl]
   (prepared-query (str "UPDATE ring.sessions USING TTL " (* ttl 60 2) " SET data = ? WHERE key = ?;")))

-(def write-query (memoize write-query*))
+(def ^:private write-query (memoize write-query*))

-(def remove-query
+(def ^:private remove-query
   (delay (prepared-query "DELETE FROM ring.sessions WHERE key = ?;")))

-(def session-consistency :one)
+(def ^:private session-consistency :one)

 (defn- read-session-data
   [key]
@@ -120,14 +137,22 @@
 (deftype CassandraStore [cache ttl]
   SessionStore
   (read-session [_ key]
+    ;; If the key is non-nil, try the cache or if that fails, try Cassandra.
+    ;; If both fail, or the key was nil, an empty session is returned.
     (or (and key
              (or (get (deref cache) key)
                  (read-session-data key)))
         {}))
+
   (write-session [this key data]
+    ;; Create a key, if necessary.
+    ;; Update the data in the database, except if it already contains a _last_db_write entry,
+    ;; and the time it specifies is younger than the current time minus TTL,
+    ;; and the session data has not changed within the handling of the request.
     (let [new-key (or key (str (UUID/randomUUID)))
           new-data (if-not (and (get data '_last_db_write)
-                                (< (- (System/currentTimeMillis) (* ttl 60000)) (data '_last_db_write))
+                                (< (- (System/currentTimeMillis) (* ttl 60000))
+                                   (data '_last_db_write))
                                 (= data (read-session this key)))
                      (assoc data '_last_db_write (System/currentTimeMillis))
                      data)]
@@ -135,7 +160,10 @@
         (write-session-data new-key new-data ttl))
       (swap! cache assoc new-key new-data)
       new-key))
+
   (delete-session [_ key]
+    ;; Remove the session data from the cache and the database. Return nil, in
+    ;; order to have the session cookie removed.
     (when key
       (remove-session-data key)
       (swap! cache dissoc key))


Cleaning up some warnings about dynamic. Still one left in the declare of log-factory that needs more thought.

--- src/main/clojure/clojure/tools/logging.clj
+++ src/main/clojure/clojure/tools/logging.clj
@@ -41,17 +41,17 @@

 (def ^{:doc
   "The default agent used for performing logging when direct logging is
-  disabled. See log* for details."}
+  disabled. See log* for details." :dynamic true}
   *logging-agent* (agent nil :error-mode :continue))

 (def ^{:doc
   "The set of levels that will require using an agent when logging from within a
-  running transaction. Defaults to #{:info :warn}. See log* for details."}
+  running transaction. Defaults to #{:info :warn}. See log* for details." :dynamic true}
   *tx-agent-levels* #{:info :warn})

 (def ^{:doc
   "Overrides the default rules for choosing between logging directly or via an
-  agent. Defaults to nil. See log* for details."}
+  agent. Defaults to nil. See log* for details." :dynamic true}
   *force* nil)

 (defn log*
@@ -447,6 +447,6 @@
   "An instance satisfying the LogFactory protocol. Used internally when needing
   to obtain an instance satisfying the Log protocol. Defaults to the value
   returned from find-factory. Can be rebound to provide alternate logging
-  implementations"}
+  implementations" :dynamic true}
   *log-factory*
   (find-factory))


Fix scaling to always produce doubles and not fail with 0 division

--- src/clj/clojurewerkz/statistiker/scaling.clj
+++ src/clj/clojurewerkz/statistiker/scaling.clj
@@ -20,8 +20,8 @@
   (let [xmin (apply min x)
         xmax (apply max x)
         diff (- xmax xmin) ]
-    (if (= diff 0)
-      (constantly 0)
+    (if (= (double diff) (double 0))
+      (constantly 0.0)
       (fn [x] (double (/ (- x xmin) diff))))))

 (defn rescale


fix dropdown close when clicking out

fix dropdown close when clicking out

--- src/cljs/daveconservatoire/site/ui_dave.cljs
+++ src/cljs/daveconservatoire/site/ui_dave.cljs
@@ -129,7 +129,7 @@
                 props)
           title)
         (if open?
-          (l/simple-listener {:on-trigger #(om/set-state! this {:open? false})}))
+          (l/simple-listener {::l/on-trigger #(om/set-state! this {:open? false})}))
         (dom/a #js {:className "btn btn-success dropdown-toggle", :href "#"
                     :onClick #(om/set-state! this {:open? (not open?)})}
           (dom/span #js {:className "caret"}))


Fix typo

Fix typo

--- src/io/aviso/rook/response_validation.clj
+++ src/io/aviso/rook/response_validation.clj
@@ -76,10 +76,10 @@
   The keys of the responses metadata are the status codes to match, the values are schemas to match against the body
   of the response (there is no validation of headers).

-  A response schema may be nil, in which case there is no validation of the body (but the status code must be a key
+  A response schema may be nil, in which case there is no validation of the body (but the actual status code must be a key
   of the :responses metadata).

-  A response in the 5xx range is not validated in anyway, as there represent failures within a endpoint function,
+  A response in the 5xx range is not validated in anyway, as these represent failures within a endpoint function,
   or a downstream failure passed through the endpoint function.

   Response validation should generally be the final middleware in a endpoint function's pipeline, to ensure


non stack consuming recursion in read*

non stack consuming recursion in read*

--- src/main/clojure/clojure/tools/reader.clj
+++ src/main/clojure/clojure/tools/reader.clj
@@ -909,23 +909,23 @@
      (when (= :unknown *read-eval*)
        (err/reader-error "Reading disallowed - *read-eval* bound to :unknown"))
      (try
-       ((fn read' []
-          (log-source reader
-            (if (seq pending-forms)
-              (.remove ^List pending-forms 0)
-              (let [ch (read-char reader)]
-                (cond
-                  (whitespace? ch) (read')
-                  (nil? ch) (if eof-error? (err/throw-eof-error reader nil) sentinel)
-                  (= ch return-on) READ_FINISHED
-                  (number-literal? reader ch) (read-number reader ch)
-                  :else (let [f (macros ch)]
-                          (if f
-                            (let [res (f reader ch opts pending-forms)]
-                              (if (identical? res reader)
-                                (read')
-                                res))
-                            (read-symbol reader ch)))))))))
+       (loop []
+         (let [ret (log-source reader
+                     (if (seq pending-forms)
+                       (.remove ^List pending-forms 0)
+                       (let [ch (read-char reader)]
+                         (cond
+                           (whitespace? ch) reader
+                           (nil? ch) (if eof-error? (err/throw-eof-error reader nil) sentinel)
+                           (= ch return-on) READ_FINISHED
+                           (number-literal? reader ch) (read-number reader ch)
+                           :else (let [f (macros ch)]
+                                   (if f
+                                     (f reader ch opts pending-forms)
+                                     (read-symbol reader ch)))))))]
+           (if (identical? ret reader)
+             (recur)
+             ret)))
         (catch Exception e
           (if (ex-info? e)
             (let [d (ex-data e)]


Revert "allow for `{~@foo} and `#{~(gensym) ~(gensym)}"

This reverts commit 0d6d3024566447b9694f97a31e8179842bcad144.

Conflicts:
	src/main/clojure/clojure/tools/reader.clj

--- src/main/clojure/clojure/tools/reader.clj
+++ src/main/clojure/clojure/tools/reader.clj
@@ -29,7 +29,6 @@
          ^:dynamic *read-eval*
          ^:dynamic *data-readers*
          ^:dynamic *default-data-reader-fn*
-         ^:dynamic ^:private gensym-env
          default-data-readers)

 (defn- macro-terminating? [ch]
@@ -201,7 +200,6 @@
           :end-line end-line
           :end-column end-column})))))

-(defrecord SyntaxQuotedMap [val])
 (defn- read-map
   [rdr _]
   (let [[start-line start-column] (when (indexing-reader? rdr)
@@ -210,17 +208,12 @@
         map-count (count the-map)
         [end-line end-column] (when (indexing-reader? rdr)
                                 [(get-line-number rdr) (int (get-column-number rdr))])]
-    (when (and (odd? map-count)
-               (or (not gensym-env)
-                   (not-any? #(= 'clojure.core/unquote-splicing (first %))
-                           (filter seq? the-map))))
+    (when (odd? map-count)
       (reader-error rdr "Map literal must contain an even number of forms"))
     (with-meta
       (if (zero? map-count)
         {}
-        (if gensym-env
-          (SyntaxQuotedMap. the-map)
-          (RT/map (to-array the-map))))
+        (RT/map (to-array the-map)))
       (when start-line
         (merge
          (when-let [file (get-file-name rdr)]
@@ -360,14 +353,11 @@
               (reset-meta! o m)))
           (reader-error rdr "Metadata can only be applied to IMetas"))))))

-(defrecord SyntaxQuotedSet [val])
 (defn- read-set
   [rdr _]
   (let [[start-line start-column] (when (indexing-reader? rdr)
                                     [(get-line-number rdr) (int (dec (get-column-number rdr)))])
-        the-set (if gensym-env
-                  (SyntaxQuotedSet. (read-delimited \} rdr true))
-                  (PersistentHashSet/createWithCheck (read-delimited \} rdr true)))
+        the-set (PersistentHashSet/createWithCheck (read-delimited \} rdr true))
         [end-line end-column] (when (indexing-reader? rdr)
                                 [(get-line-number rdr) (int (get-column-number rdr))])]
     (with-meta the-set
@@ -454,11 +444,10 @@

 (defn- read-unquote
   [rdr comma]
-  (binding [gensym-env nil]
-    (if-let [ch (peek-char rdr)]
-      (if (identical? \@ ch)
-        ((wrapping-reader 'clojure.core/unquote-splicing) (doto rdr read-char) \@)
-        ((wrapping-reader 'clojure.core/unquote) rdr \~)))))
+  (if-let [ch (peek-char rdr)]
+    (if (identical? \@ ch)
+      ((wrapping-reader 'clojure.core/unquote-splicing) (doto rdr read-char) \@)
+      ((wrapping-reader 'clojure.core/unquote) rdr \~))))

 (declare syntax-quote*)
 (defn- unquote-splicing? [form]
@@ -566,14 +555,11 @@

     (coll? form)
     (cond
-     (instance? SyntaxQuotedMap form) (syntax-quote-coll (map-func form) (:val form))
-     (instance? SyntaxQuotedSet form) (syntax-quote-coll 'clojure.core/hash-set (:val form))

      (instance? IRecord form) form
      (map? form) (syntax-quote-coll (map-func form) (flatten-map form))
      (vector? form) (list 'clojure.core/vec (syntax-quote-coll nil form))
      (set? form) (syntax-quote-coll 'clojure.core/hash-set form)
-
      (or (seq? form) (list? form))
      (let [seq (seq form)]
        (if seq


we dont need read-string + breaks // stuff

--- src/main/clojure/pdok/featured/config.clj
+++ src/main/clojure/pdok/featured/config.clj
@@ -27,7 +27,7 @@
       (into {} (for [[k v] props
                      ;; no mustaches, for local use
                      :when (not (re-find #"^\{\{.*\}\}$" v))]
-                 [(keywordize k) (read-string v)])))))
+                 [(keywordize k) v])))))

 (defonce env
   (merge environ/env


Fix ClassCastException on custom ZK port

--- src/main/hbase_region_inspector/hbase.clj
+++ src/main/hbase_region_inspector/hbase.clj
@@ -51,11 +51,11 @@
 ;; https://support.pivotal.io/hc/en-us/articles/200933006-Hbase-application-hangs-indefinitely-connecting-to-zookeeper
 (defn- connect-admin [zk]
   (let [[quorum port] (str/split zk #"/")
-        port (or port 2181)]
+        port (or port "2181")]
     (HBaseAdmin.
       (doto (HBaseConfiguration/create)
         (.set "hbase.zookeeper.quorum" quorum)
-        (.setInt "hbase.zookeeper.property.clientPort" port)
+        (.set "hbase.zookeeper.property.clientPort" port)
         (.setInt "hbase.client.retries.number" 1)
         (.setInt "hbase.regions.slop" 0)
         (.setInt "zookeeper.recovery.retry" 1)))))


fix a couple of reflection warnings

fix a couple of reflection warnings

--- dada-core/src/main/clojure/org/dada/jms.clj
+++ dada-core/src/main/clojure/org/dada/jms.clj
@@ -12,7 +12,7 @@
 (deftype BytesMessageStrategy []
   MessageStrategy
   (createMessage [_ session]
-		 (.createBytesMessage session))
+		 (.createBytesMessage ^Session session))
   (readMessage [_ message]
 	       (let [buffer (byte-array (.getBodyLength ^BytesMessage message))]
 		 (.readBytes ^BytesMessage message buffer)
@@ -23,7 +23,7 @@
 (deftype TextMessageStrategy []
   MessageStrategy
   (createMessage [_ session]
-		 (.createTextMessage session))
+		 (.createTextMessage ^Session session))
   (readMessage [_ message]
 	       (.getText ^TextMessage message))
   (writeMessage [_ message text]


Whitespace.

Whitespace.

--- src/philly_show_checker/server/scraper.clj
+++ src/philly_show_checker/server/scraper.clj
@@ -20,8 +20,7 @@
        (jobs/defjob ~job-name
          [ctx#]
          (let [resp# @(http-client/get ~url)]
-           (db/store-scraper-results
-            (~html-parser-fn resp#))))
+           (db/store-scraper-results (~html-parser-fn resp#))))
        (swap! jobs assoc ~(keyword venue-name) ~job-name))))

 (defscraper union-transfer


more denormalization

more denormalization

--- src/er_cassandra/model/alia/relationship.clj
+++ src/er_cassandra/model/alia/relationship.clj
@@ -51,19 +51,43 @@
    source-record :- t/RecordSchema
    denorm-rel :- t/DenormalizationRelationshipSchema
    target-record :- t/RecordSchema
-   denorm-op :- DenormalizeOp
-   denorm-version :- s/Uuid]
+   denorm-op :- DenormalizeOp]
   (let [[fk fk-val :as fk-vals] (foreign-key-val source-entity source-record denorm-rel)
         fk-map (into {} fk-vals)
         denorm-vals (->> (:denormalize denorm-rel)
-                         (map (fn [scol tcol]
+                         (map (fn [[scol tcol]]
                                 [tcol (get source-record scol)]))
                          (into {}))
-        all-denorm-vals (merge denorm-vals fk-map)
-        new-target-record (merge target-record all-denorm-vals)]
-    (m/upsert session
-              target-entity
-              new-target-record)))
+        ]
+    (case denorm-op
+
+      :upsert
+      (let [all-denorm-vals (merge denorm-vals fk-map)
+            new-target-record (merge target-record all-denorm-vals)]
+        (m/upsert session
+                  target-entity
+                  new-target-record))
+
+      :delete
+      (let [cascade (:cascade target-entity)]
+        (case cascade
+
+          :none
+          (return true)
+
+          :null
+          (let [null-denorm-vals (->> denorm-vals
+                                      (map (fn [[k v]] [k nil]))
+                                      (into {}))]
+            (m/upsert session
+                      target-entity
+                      (merge target-record null-denorm-vals)))
+
+          :delete
+          (m/delete session
+                    target-entity
+                    (-> target-entity :primary-table :key)
+                    target-record))))))

 (s/defn target-record-stream
   "returns a Deferred<Stream<record>> of target records"
@@ -89,49 +113,54 @@

 (s/defn denormalize-rel
   "denormalizes a single relationship"
-  [source-entity :- Entity
+  [session :- Session
+   source-entity :- Entity
    target-entity :- Entity
    source-record :- t/RecordSchema
    denorm-rel :- t/DenormalizationRelationshipSchema
-   denorm-op :- DenormalizeOp
-   denorm-version :- s/Uuid]
+   denorm-op :- DenormalizeOp]
   (with-context deferred-context
-    (mlet [trs (target-record-stream source-entity
+    (mlet [trs (target-record-stream session
+                                     source-entity
                                      target-entity
                                      source-record
                                      denorm-rel)

-           ;; a stream of any errors
+           ;; a (hopefully empty) stream of any errors from denormalization
            :let [trerrs (->> trs
                              (st/map #(denormalize-to-target-record
+                                       session
                                        source-entity
-                                       target-entity
+                                       (-> % :target deref-target-entity)
                                        source-record
                                        denorm-rel
                                        %
-                                       denorm-op
-                                       denorm-version))
+                                       denorm-op))
                              (st/map only-error)
-                             (st/filter identity))]]
+                             (st/filter identity))]
+
+           maybe-err (st/take! trerrs)]

       ;; if there are errors, return the first as an exemplar
-      (if (st/drained? trerrs)
-        (return nil)
-        (st/take! trerrs)))))
+      (if (nil? maybe-err)
+        (return [denorm-rel [:ok]])
+        (return [denorm-rel [:fail maybe-err]])))))

-(s/defn denormalize
-  "denormalize all relationships for a given source record"
-  [source-entity :- Entity
-   target-entity :- Entity
-   source-record :- t/RecordSchema
-   denorm-op :- DenormalizeOp]
-  (let [rels (-> source-entity :denorm-targets vals)
-        v (uuid/v1)
-        resps (->> rels
-                   (map #(denormalize-rel source-entity
-                                          target-entity
-                                          source-record
-                                          %
-                                          denorm-op
-                                          v)))]
-    (apply d/zip resps)))
+;; (s/defn denormalize
+;;   "denormalize all relationships for a given source record
+;;    returns [[denorm-rel [status maybe-err]]*]"
+;;   [session :- Session
+;;    source-entity :- Entity
+;;    source-record :- t/RecordSchema
+;;    denorm-op :- DenormalizeOp]
+;;   (let [rels (-> source-entity :denorm-targets vals)
+;;         v (uuid/v1)
+;;         resps (->> rels
+;;                    (map #(denormalize-rel session
+;;                                           source-entity
+;;                                           target-entity
+;;                                           source-record
+;;                                           %
+;;                                           denorm-op
+;;                                           v)))]
+;;     (apply d/zip resps)))


on second thought, we don't want to cache bust

--- src-cljs/cuttle/main_page.cljs
+++ src-cljs/cuttle/main_page.cljs
@@ -62,9 +62,7 @@
 ;; Check for Updates
 ;;------------------------------------------------------------------------------

-(def latest-version-url (str
-  "http://cljs.info/cuttle-latest.json?_="
-  (uuid)))
+(def latest-version-url "http://cljs.info/cuttle-latest.json")

 ;; NOTE: I was sick while writing this function; please don't judge ;)
 ;; TODO: should do some simple checking that the version number is in a valid


Remove dirac devtools macro ns

Remove dirac devtools macro ns

--- src-cljs/frontend/devtools.clj
+++ src-cljs/frontend/devtools.clj
@@ -1,7 +0,0 @@
-(ns frontend.devtools
-  (:require [environ.core :refer [env]]))
-
-(defmacro require-devtools! []
-  (when (:devtools env)
-    ;; TODO: Replace this with a ClojureScript require function
-    '(js/goog.require "frontend.devtools")))


Make auto-generated test names unique.

Make auto-generated test names unique.

--- test/clj/quil/snippet.clj
+++ test/clj/quil/snippet.clj
@@ -4,6 +4,7 @@
             [quil.util :refer [no-fn]]
             [quil.snippets.all-snippets :as as]
             [clojure.test :as t :refer [is]]
+            [clojure.string :as cstr]
             clojure.pprint

             ;;; Require all snippets.
@@ -28,10 +29,9 @@
   (let [result (promise)
         time (System/currentTimeMillis)
         snip-name (str ns "/" name)]
+    (println "Test:" snip-name)
      (when manual?
-       (println "Test:" snip-name)
        (clojure.pprint/pprint body-str))
-     (println body-str)
      (q/sketch
       :title snip-name
       :size (:size opts default-size)
@@ -57,24 +57,27 @@
       :on-close #(deliver result nil))
      (t/is (nil? @result))))

-(defn define-snippet-as-test [{:keys [name opts setup body body-str] :as snippet}]
-  (intern 'quil.snippet
-          (vary-meta (symbol name) assoc
-                     :test #(run-snippet-as-test snippet)
-                     :test-set (let [cur (swap! current-test inc)
-                                     set (quot cur tests-in-set)]
-                              (when (zero? (mod cur tests-in-set))
-                                  (println "Test set" set (str " Run with: lein test :set-" set)))
-                              set))
-     (fn []
-       (q/sketch
-        :title name
-        :size default-size
-        :setup (fn []
-                 (q/frame-rate 5)
-                 (setup))
-        :renderer (:renderer opts :java2d)
-        :draw body))))
+(defn define-snippet-as-test [{:keys [ns name opts setup body body-str] :as snippet}]
+  (let [test-name (str (cstr/replace ns "." "_")
+                       "_"
+                       name)]
+   (intern 'quil.snippet
+           (vary-meta (symbol test-name) assoc
+                      :test #(run-snippet-as-test snippet)
+                      :test-set (let [cur (swap! current-test inc)
+                                      set (quot cur tests-in-set)]
+                                  (when (zero? (mod cur tests-in-set))
+                                    (println "Test set" set (str " Run with: lein test :set-" set)))
+                                  set))
+           (fn []
+             (q/sketch
+              :title name
+              :size default-size
+              :setup (fn []
+                       (q/frame-rate 5)
+                       (setup))
+              :renderer (:renderer opts :java2d)
+              :draw body)))))

 (doseq [snippet @as/all-snippets]
   (define-snippet-as-test snippet))


Something tangible for d19

Something tangible for d19

--- src/adventofcode/solutions.clj
+++ src/adventofcode/solutions.clj
@@ -730,7 +730,7 @@
           :let [loc [i j]
                 curr (get-in inp loc)
                 surr [[(dec i) (dec j)] [(dec i) j] [(dec i) (inc j)]
-                      [i (dec j)]                   [i (inc j)]
+                      [i (dec j)] [i (inc j)]
                       [(inc i) (dec j)] [(inc i) j] [(inc i) (inc j)]]
                 cnt-on (count (filter #(= \# %) (map #(get-in inp %) surr)))]]
       (curr-f curr cnt-on loc))))
@@ -783,13 +783,25 @@
              ))

 ;day 19
-;failed attempt, I haven't understood task obviously...
-((defn day19 []
-   (let [input (day-input-line-seq 19)
-         size (count input)
-         replacements (map #(let [[_ from to] (first (re-seq #"(\w+) => (\w+)" %))]
-                             [from to]) (take (- size 2) input))
-         src (last input)]
-     [size src replacements]
-     (count (reduce #(let [[from to] %2]
-                      (conj % (clojure.string/replace src from to))) #{} replacements)))))+(defn ^{:private true} d19-processor [s f t]
+  (let [where (.indexOf s f)
+        so-far (+ where (count f))]
+    (when (>= where 0)
+      (let [remainder (subs s so-far)]
+        [where (str (subs s 0 where) t remainder) remainder]))))
+
+(defn day19 []
+  (let [input (day-input-line-seq 19)
+        size (count input)
+        replacements (map #(let [[_ from to] (first (re-seq #"(\w+) => (\w+)" %))]
+                            [from to]) (take (- size 2) input))
+        src (last input)
+        [from to] (first replacements)
+        first-input (d19-processor src from to)]
+    (reduce (fn [a v]
+              (if v
+                (conj a (second v))
+                (reduced a))) #{} (iterate (fn [x]
+                                             (let [[_ _ ns] x]
+                                               (when-let [[w rep remainder] (d19-processor ns from to)]
+                                                 [w (str (subs src 0 w) rep) remainder]))) first-input))))


Fix mouse selection

Fix mouse selection

--- src/asciinema/player/view.cljs
+++ src/asciinema/player/view.cljs
@@ -22,9 +22,7 @@
   (fn [dom-event]
     (when-let [msg (f dom-event)]
       (put! ch msg)
-      (doto dom-event
-        .stopPropagation
-        .preventDefault))))
+      (.stopPropagation dom-event))))

 (defn send! [ch msg]
   (send-value! ch (fn [_] msg)))
@@ -259,15 +257,19 @@
     39 (m/->FastForward)
     nil))

-(defn handle-key-press [msg-ch dom-event]
+(defn handle-key-press [dom-event]
   (when-let [msg (key-press->message dom-event)]
-    (doto dom-event
-      .stopPropagation
-      .preventDefault)
+    (.preventDefault dom-event)
     (if (= msg :toggle-fullscreen)
-      (fullscreen/toggle (.-currentTarget dom-event))
-      (put! msg-ch msg))
-    nil))
+      (do
+        (fullscreen/toggle (.-currentTarget dom-event))
+        nil)
+      msg)))
+
+(defn handle-key-down [dom-event]
+  (when-let [msg (key-down->message dom-event)]
+    (.preventDefault dom-event)
+    msg))

 (defn title-bar [title author author-url author-img-url]
   (let [title-text (if title (str "\"" title "\"") "untitled")]
@@ -303,8 +305,8 @@
   (let [mouse-moves-ch (chan (dropping-buffer 1))
         user-activity-ch (activity-chan mouse-moves-ch 3000 (chan 1 (map m/->ShowHud)))
         on-mouse-move (send! mouse-moves-ch true)
-        on-key-press (partial handle-key-press msg-ch)
-        on-key-down (send-value! msg-ch key-down->message)
+        on-key-press (send-value! msg-ch handle-key-press)
+        on-key-down (send-value! msg-ch handle-key-down)
         wrapper-class-name (reaction (when (:show-hud @player) "hud"))
         player-class-name (reaction (player-class-name (:theme @player)))
         width (reaction (or (:width @player) 80))


Three new tests: test-get-year-existence, test-get-week-existence and test-get-day-of-week-existence

--- test/clj_calendar/calendar_test.clj
+++ test/clj_calendar/calendar_test.clj
@@ -40,3 +40,18 @@
     (testing "if the clj-calendar.calendar/get-calendar-for-week function definition exists."
         (is (callable? 'clj-calendar.calendar/get-calendar-for-week))))

+(deftest test-get-year-existence
+    "Check that the clj-calendar.calendar/get-year function definition exists."
+    (testing "if the clj-calendar.calendar/get-year function definition exists."
+        (is (callable? 'clj-calendar.calendar/get-year))))
+
+(deftest test-get-week-existence
+    "Check that the clj-calendar.calendar/get-week function definition exists."
+    (testing "if the clj-calendar.calendar/get-week function definition exists."
+        (is (callable? 'clj-calendar.calendar/get-week))))
+
+(deftest test-get-day-of-week-existence
+    "Check that the clj-calendar.calendar/get-day-of-week function definition exists."
+    (testing "if the clj-calendar.calendar/get-day-of-week function definition exists."
+        (is (callable? 'clj-calendar.calendar/get-day-of-week))))
+


GM: Add tests for disabled tabs

GM: Add tests for disabled tabs

--- test/hatti/views/dataview_test.cljs
+++ test/hatti/views/dataview_test.cljs
@@ -1,9 +1,10 @@
 (ns hatti.views.dataview-test
   (:require-macros [cljs.test :refer (is deftest testing)]
-                   [dommy.macros :refer [sel1]])
+                   [dommy.macros :refer [sel sel1]])
   (:require [cljs.test :as t]
             [dommy.core :as dommy]
             [hatti.shared :as shared]
+            [hatti.utils :refer [in?]]
             [hatti.views :refer [tabbed-dataview]]
             [hatti.test-utils :refer [big-thin-data
                                       data-gen
@@ -50,11 +51,16 @@
   (let [tabbed-view (tabbed-dataview-container shared/app-state)]
     (testing "Map tab is not rendered when there is no geodata"
       (is (= "map"
-             (-> tabbed-view (sel1 :div.tab-bar) (sel1 :.inactive) (dommy/html)))))
-    #_(testing "Map, Chart and Table tabs are disabled"
-      (let [_ (shared/transact-app-state! shared/app-state
-                                                [:views :disabled]
-                                                [:map :chart :table])
-            tabbed-view (tabbed-dataview-container shared/app-state)]
-        (is (= "map chart table"
-               (-> tabbed-view (sel1 :div.tab-bar) (sel1 :.inactive) (dommy/html))))))))
+             (-> tabbed-view (sel1 :div.tab-bar) (sel1 :.inactive) (dommy/html)))))))
+
+(deftest disabled-tabbed-tests
+  (testing "Map, Chart and Table tabs are disabled"
+    (let [disabled-views [:map :table :chart]
+          data-atom (shared/empty-app-state)
+          _ (shared/transact-app-state! data-atom
+                                        [:views :disabled]
+                                        #(identity disabled-views))
+          tabbed-view (tabbed-dataview-container data-atom)]
+      (doseq [tab (-> tabbed-view (sel1 :div.tab-bar) (sel :.inactive))]
+        (is (in? disabled-views
+                 (keyword (dommy/html tab))))))))


TODO for heartbeat serialization.

TODO for heartbeat serialization.

--- src/onyx/messaging/aeron/endpoint_status.clj
+++ src/onyx/messaging/aeron/endpoint_status.clj
@@ -101,10 +101,11 @@
     this)
   FragmentHandler
   (onFragment [this buffer offset length header]
-    (let [;; don't even grab the first value out because it's in the message, at least for now
-          base-dec (base-decoder/->Decoder buffer offset)
+    (let [base-dec (base-decoder/->Decoder buffer offset)
           msg-type (base-decoder/get-type base-dec)
           msg-rv (base-decoder/get-replica-version base-dec)
+          ;; TODO, avoid full deserialization until we've determined that the message
+          ;; is for us. See below.
           message (sz/deserialize buffer
                                   (+ offset (base-decoder/length base-dec))
                                   (base-decoder/get-payload-length base-dec))


Fix bugs in color/gradient function.

Fix bugs in color/gradient function.

--- src/org/playasophy/wonderdome/util/color.clj
+++ src/org/playasophy/wonderdome/util/color.clj
@@ -76,11 +76,11 @@
   such that p of 0.0 and 1.0 both give the first color in the sequence."
   [colors p]
   (let [s  (count colors)
-        t  (* (- value (int value)) s)
+        t  (* (- p (Math/floor p)) s)
         t0 (int t)
         t1 (if (>= (inc t0) s) 0 (inc t0))
         p  (- t t0)]
-    (blend p (nth colors t0) (nth colors t1))))
+    (blend t (nth colors t0) (nth colors t1))))

 ; TODO: less-angry rainbow!


It's ok. requires a tuple in.

It's ok. requires a tuple in.

--- test/cljc/spec_tools/json_schema_test.cljc
+++ test/cljc/spec_tools/json_schema_test.cljc
@@ -47,8 +47,6 @@
     (is (= (jsc/to-json (s/coll-of string? :into '())) {:type "array" :items {:type "string"}}))
     (is (= (jsc/to-json (s/coll-of string? :into [])) {:type "array" :items {:type "string"}}))
     (is (= (jsc/to-json (s/coll-of string? :into #{})) {:type "array" :items {:type "string"}, :uniqueItems true}))
-    ;; TODO: this is wrong?
-    (is (= (jsc/to-json (s/coll-of string? :into {})) {:type "object", :additionalProperties {:type "string"}}))
     (is (= (jsc/to-json (s/map-of string? integer?))
            {:type "object" :additionalProperties {:type "integer"}}))
     (is (= (jsc/to-json (s/* integer?)) {:type "array" :items {:type "integer"}}))
@@ -65,7 +63,10 @@
     (is (= (jsc/to-json (s/map-of string? clojure.core/integer?))
            {:type "object" :additionalProperties {:type "integer"}}))
     ;; nilable
-    ))
+    )
+  (testing "failing clojure.specs"
+    (is (not= (jsc/to-json (s/coll-of (s/tuple string? any?) :into {}))
+              {:type "object", :additionalProperties {:type "string"}}))))

 #?(:clj
    (defn test-spec-conversion [spec]


add zero check for delete user test

add zero check for delete user test

--- test/spc/models/user_model_test.clj
+++ test/spc/models/user_model_test.clj
@@ -30,4 +30,4 @@
   (let [initial-count (row-count "users_test")]
     (delete-user! (get-last-row-id "users_test") :db :users_test)
     (let [final-count (row-count "users_test")]
-      (is (= final-count (- initial-count 1))))))
+      (is (or (= final-count 0) (= final-count (- initial-count 1)))))))


(PLATFORM-2818) Check file type before forcing webp

--- src/vignette/util/external_hotlinking.clj
+++ src/vignette/util/external_hotlinking.clj
@@ -1,5 +1,6 @@
 (ns vignette.util.external-hotlinking
-  (:require [vignette.protocols :refer :all]
+  (:require [vignette.media-types :refer :all]
+            [vignette.protocols :refer :all]
             [vignette.storage.protocols :refer :all]
             [vignette.util.thumbnail :as u]))

@@ -18,8 +19,8 @@
     (.contains vary-string force-header-val)))

 (defn force-webp? [image-params]
-  (if-let [format (get-in image-params [:options :format])]
-    (.contains format force-webp-val)))
+  (and (= force-webp-val (get-in image-params [:options :format]))
+    (webp-supported? (original-path image-params))))

 (defn image-params->forced-thumb-params [image-params]
   (merge image-params force-thumb-params))


The realtime response update is finally populated

When data is updated on the server then the query and timestamp are
cached for the next time the client asks for a realtime update

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -646,16 +646,22 @@

       (let [the-query        (get @cached-queries   query)
             clients-atom     (:clients @the-query)
+            response-atom    (:update-request @the-query)
             ]
         (swap! the-query assoc  :records       result-id-vector)
         (swap! the-query assoc  :count         record-count)
         (swap! the-query assoc  :timestamp     query-time)
+        (if (not response-atom) (swap! the-query assoc  :update-request (atom {})))

         (println (str "    clients: " @clients-atom))
         (doall (for [client @clients-atom]
-              (println (str "    Client: " client))
-              ))
+                 (do
+                   (println (str "    Client: " client))
+                   (swap! (:update-request @the-query) assoc-in [:queries query] {:timestamp query-time})
+;                   (swap! (:update-request @the-query) assoc  1 2)
+                   )))
+        (println (str "    responses: " (if response-atom @response-atom)))

         ))))
@@ -1010,15 +1016,51 @@
 ; ----------------------------------------------------------------
 (defn !check-for-server-updates [{:keys [
                                      client-data-session-id
-                                     ]}]
-  (let [client-data-atom    (if realtime-clients  (get @realtime-clients client-data-session-id))
+                                     ]}
+                                 ]
+
+  (let [client-data-atom    (if realtime-clients  (get @realtime-clients  client-data-session-id))
         response-atom       (if client-data-atom (get @client-data-atom :update-request))
-                         ]
+        ]
     (println (str "      " ))
     (println "SERVER: check-for-server-updates for client: " client-data-session-id)
     ;(println (str "      " (keys @realtime-clients)))
-    (println (str "      " client-data-atom))
+    (println (str "      " (if client-data-atom @client-data-atom)))
     (println (str "      response: " (if response-atom  @response-atom  [])))
-     (if response-atom  @response-atom  [])))
-
-
+    (if response-atom  @response-atom  [])))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


counter-devcards: stop app on hot reload in order to remove watches etc.

--- examples/counter-devcards/src/app/core.cljs
+++ examples/counter-devcards/src/app/core.cljs
@@ -24,6 +24,8 @@
   ; sync from reference for the first time
   (dispatch-signal [::on-reset @r])

+  #_(println "1 DATA ATOM WATCHES = " (pr-str (count (.-watches r))))
+
   ; sync model from reference
   (add-watch r
              model
@@ -36,7 +38,14 @@
              r
              (fn [_key _ref _old-state new-state]
                (when (not= @r new-state)
-                 (reset! r new-state)))))
+                 (reset! r new-state))))
+
+  #_(println "2 DATA ATOM WATCHES = " (pr-str (count (.-watches r)))))
+
+(defn -unconnect-atom
+  [r model]
+  (remove-watch r model)
+  (remove-watch model r))

 (defn add-atom-sync
   "Carry middleware.
@@ -52,7 +61,14 @@
                          :on-start
                          (do
                            (app-control model signal dispatch-signal dispatch-action)
+
                            (-connect-atom r model dispatch-signal))
+
+                         :on-stop
+                         (do
+                           (-unconnect-atom r model)
+
+                           (app-control model signal dispatch-signal dispatch-action))

                          [::on-reset new-model]
                          (dispatch-action [::reset new-model])
@@ -69,21 +85,28 @@
                          :else
                          (app-reconcile model action)))))))

+(defn with-unmount-callback
+  [_body unmount-cb]
+  (r/create-class {:reagent-render         (fn [body _unmount-cb]
+                                             (into [:div] body))
+                   :component-will-unmount (fn [_this] (unmount-cb))}))
+
 (defcard-rg
   counter-with-history
   (fn [data-atom _]
     (let [app (carry/app (-> counter/spec
                              (add-atom-sync data-atom)))    ; <-- connect devcards atom
           [_ app-view] (carry-reagent/connect app counter/view-model counter/view)]
-      ((:dispatch-signal app) :on-start)
-      app-view))
+      ((:dispatch-signal app) :on-start)                    ; <-- start the app
+
+      [with-unmount-callback
+       [app-view]
+       #((:dispatch-signal app) :on-stop)]))                ; <-- stop the app on umount

   (atom (:initial-model counter/spec))                      ; <-- create devcards atom with initial model value

   {:inspect-data true
    :history      true})
-
-; TODO: remove previous watches on hot reloads? they may leak memory by holding onto the old app instances

 ;;;;;;;;;;;;;;;;;;;;;;;; Figwheel stuff
 (defn before-jsload


got safari rendering better

got safari rendering better

--- support/src/figwheel/client/heads_up.cljs
+++ support/src/figwheel/client/heads_up.cljs
@@ -57,7 +57,7 @@
     (if-not (.querySelector js/document (str "#" cont-id))
       (let [el (node :div { :id cont-id
                            :style
-                           (str "-webkit-transition: all 0.s ease-in-out;"
+                           (str "-webkit-transition: all 0.2s ease-in-out;"
                                 "-moz-transition: all 0.2s ease-in-out;"
                                 "-o-transition: all 0.2s ease-in-out;"
                                 "transition: all 0.2s ease-in-out;"
@@ -123,12 +123,13 @@
                           :paddingTop "10px"
                           :paddingBottom "10px"
                           :width "100%"
-                           #_:minHeight #_"68px"
-                           :height "auto"
-                           :opacity "1.0" }
+                          :minHeight "68px"
+                          :opacity "1.0" }
                           style))
      (set-content! c msg)
-     (<! (timeout 400)))))
+     (<! (timeout 300))
+     (set-style! c {:height "auto"}))))
+

 (defn heading [s]
   (str"<div style=\""
@@ -174,6 +175,7 @@
      (<! (timeout 300))
      (set-style! c { :width "auto"
                     :height "0px"
+                    :minHeight "0px"
                     :padding "0px 10px 0px 70px"
                     :borderRadius "0px"
                     :backgroundColor "transparent" })