Clean-up

Clean-up

--- src/retouch/views/swipe.cljs
+++ src/retouch/views/swipe.cljs
@@ -53,7 +53,6 @@
         scroll-stop! (fn []
                        (let [container (@state :container)
                              width (.-offsetWidth container)
-                             ;scrollWidth (.-scrollWidth container)
                              scroll-x (.-scrollLeft container)
                              start-n (/ (@state :scroll-x-start) width)
                              percent-dragged (/ (- scroll-x
@@ -95,14 +94,15 @@
                               :dragging? true))

         scroll! (fn [e]
-                  (put! scroll-chan true))
+                  (put! scroll-chan true))]

-        _ (go (loop []
-                (let [[_ ch] (alts! [scroll-stop-chan])]
-                  (when (= ch scroll-stop-chan)
-                    (when-not (@state :dragging?)
-                      (scroll-stop!)))
-                  (recur))))]
+    (go (loop []
+          (let [[_ ch] (alts! [scroll-stop-chan])]
+            (when (= ch scroll-stop-chan)
+              (when-not (@state :dragging?)
+                (scroll-stop!)))
+            (recur))))
+
     (r/create-class
       {:component-did-mount
        (fn [component]


rm the -1 special case by modulo dividing by 100.

--- clojure/beer-song/beer.clj
+++ clojure/beer-song/beer.clj
@@ -31,7 +31,6 @@

 (defn- next-count-phrase [n]
   (cond
-   (= n -1) "99 bottles of beer on the wall"
    (= n 0) "no more bottles of beer on the wall"
    (= n 1) (str n " bottle of beer on the wall")
    :else (str n " bottles of beer on the wall")))
@@ -44,7 +43,7 @@
             (make-sentense (current-count-phrase n))
             (make-sentense (str
                             (action-phrase n)
-                            (next-count-phrase (dec n))))]))
+                            (next-count-phrase (mod (dec n) 100))))]))

 (defn sing
   ([from] (sing from 0))


Log queries

Log queries

--- src/cfpb/qu/data.clj
+++ src/cfpb/qu/data.clj
@@ -62,10 +62,12 @@
   their presence will cause no errors."
   [slice params]
   (let [table (:table slice)
-        query (params->Query params slice)]
+        query (params->Query params slice)
+        mongo-query (Query->mongo query)
+        _ (log/info (str "Query: " mongo-query))]
     (map #(dissoc % :_id)
          (q/with-collection table
-           (merge (Query->mongo query))))))
+           (merge mongo-query)))))

 (defn get-aggregation-data
   [slice params]


Be more liberal in what mimetypes you accept for wav files

--- src/clj/mdr2/dtb.clj
+++ src/clj/mdr2/dtb.clj
@@ -16,14 +16,14 @@
 (defn wav-file?
   "Is the given `file` a wav file?"
   [file]
-  (= (mime-type-of file) "audio/x-wav"))
+  (#{"audio/vnd.wave" "audio/x-wav"} (mime-type-of file)))

 (defn- audio-file?
   "Is the given `file` an audio file, i.e. any of the valid audio file
   formats for a DAISY Talking Book namely *MPEG-4 AAC audio*, *MPEG-1/2
   Layer III (MP3) audio* and *Linear PCM - RIFF WAVE format audio*?"
   [file]
-  (#{"audio/mpeg" "audio/x-wav" "audio/mp4"} (mime-type-of file)))
+  (#{"audio/mpeg" "audio/vnd.wave" "audio/x-wav" "audio/mp4"} (mime-type-of file)))

 (defn- text-file?
   "Is the given `file` a text file, i.e. any of the valid text file
@@ -101,7 +101,7 @@
     (cond
      (every? #{"audio/mp4"} mime-types) "MP4-AAC"
      (every? #{"audio/mpeg"} mime-types) "MP3"
-     (every? #{"audio/x-wav"} mime-types) "WAV"
+     (every? #{"audio/vnd.wave" "audio/x-wav"} mime-types) "WAV"
      :else "")))

 (defn- file-audio-length


Fix a comment on TestNode in engine.cljc

--- src/main/clojure/clara/rules/engine.cljc
+++ src/main/clojure/clara/rules/engine.cljc
@@ -920,7 +920,9 @@
       [:not (into [type] full-constraints)])))

-;; The test node represents a Rete extension in which
+;; The test node represents a Rete extension in which an arbitrary test condition is run
+;; against bindings from ancestor nodes. Since this node
+;; performs no joins it does not accept right activations or retractions.
 (defrecord TestNode [id test children]
   ILeftActivate
   (left-activate [node join-bindings tokens memory transport listener]


fix: tiles.clj reflection

fix: tiles.clj reflection

--- src/main/clojure/pdok/featured/tiles.clj
+++ src/main/clojure/pdok/featured/tiles.clj
@@ -1,11 +1,14 @@
 (ns pdok.featured.tiles
   (:require [pdok.featured.feature :as f])
-  (:import [pdok.featured.tiles NLTile]))
+  (:import [pdok.featured.tiles NLTile]
+           [com.vividsolutions.jts.geom Geometry Coordinate]))

 (defn nl [geometry]
   "Returns a set with NL tiles (numbers) based on the geometry."
   (if-let [tiles (:nl-tiles geometry)]
     tiles
     (when-let [jts-geom (f/as-jts geometry)]
-      (let [coordinates (.getCoordinates jts-geom)]
-        (into #{} (filter #(not= -1 %) (map (fn [coordinate] (NLTile/getTileFromRD (.x coordinate) (.y coordinate))) coordinates)))))))
+      (let [coordinates (.getCoordinates ^Geometry jts-geom)]
+        (into #{} (filter #(not= -1 %)
+                          (map (fn [^Coordinate coordinate]
+                                 (NLTile/getTileFromRD (.x coordinate) (.y coordinate))) coordinates)))))))


cleaning up

cleaning up

--- src/hangman/core.clj
+++ src/hangman/core.clj
@@ -131,9 +131,8 @@
   [clue-vec col-char-freqs used-chars]
   (let [
     all-char-freqs    (apply merge-with + col-char-freqs)
-      ; _ (println "all-char-freqs" all-char-freqs )
     avail-chars       (set/difference (set(keys all-char-freqs)) used-chars)
-      _ (println "avail-chars" avail-chars )
+      ; _ (println "avail-chars" avail-chars )
     max-avail-char    (apply max-key all-char-freqs avail-chars )
   ] max-avail-char ) )

@@ -144,8 +143,6 @@
     (for [ letter target-vec ] (guesses-set letter)) ))

 (defn do-tests []
-  (println "----------------------------------------")
-  (println "Tests:")

   ; Filtering one sequence with another
   (let [pred-vals5  [ true false 5 nil :a ]
@@ -183,7 +180,6 @@
              {\a 1 \b 2 \c 3} ))

   ; Match guesses
-  (println "match guesses" )
   (assert (guess-matches? "abcd" "abcd") )
   (assert (guess-matches? "abcd" [\a \b \c \d]) )
   (assert (guess-matches? "abcd" [nil nil nil nil]) )
@@ -197,9 +193,8 @@
     curr-len            4
     curr-words          (words-map curr-len)
       _ (assert (= curr-words     ["abcd" "xbcd" "xxcd" "xxxd"]  ))
-      _ (println "curr-words:" curr-words)
     word-array          (to-word-array  curr-words)
-      _ (println "word-array" word-array)
+      _ (assert (= word-array [[\a \b \c \d] [\x \b \c \d] [\x \x \c \d] [\x \x \x \d]] ))

     col-char-freqs      (to-freqs-by-col word-array)
       _ (assert (= col-char-freqs [{\a 1, \x 3} {\b 2, \x 2} {\c 3, \x 1} {\d 4}] ))
@@ -210,23 +205,18 @@

     tgt-word            [ \x  \b  \c  \d  ]
     clue                [ nil \b  nil nil ]
-
     keep-flag           (map #(guess-matches? % clue ) word-array )
-      _ (println "keep-flag" keep-flag)
+      _ (assert (= keep-flag [true true false false]))
     keep-words          (filter-with keep-flag curr-words)
-      _ (println "keep-words" keep-words)
-
+      _ (assert (= keep-words ["abcd" "xbcd"] ))
     guessed-chars       #{ \b }
-      _ (println "guessed-chars" guessed-chars)
+      _ (assert (= guessed-chars #{\b} ))
     new-guess           (make-guess clue col-char-freqs guessed-chars)
-      _ (println "new-guess" new-guess)
+      _ (assert (= new-guess \x ))
     guessed-chars       (conj guessed-chars new-guess)
-      _ (println "guessed-chars" guessed-chars)
-
+      _ (assert (= guessed-chars #{\b \x} ))
     new-clue            (make-clue tgt-word guessed-chars)
-      _ (println "tgt-word" tgt-word)
-      _ (println "clue"     clue)
-      _ (println "new-clue" new-clue)
+      _ (assert (= new-clue [\x \b nil nil] ))
   ] )
 )

@@ -236,7 +226,7 @@
   ( [word-seq]
     (do-tests)
     (println "----------------------------------------")
-    (def tgt-word         "bed")
+    (def tgt-word         "work")
     (def words-map        (to-words-by-length word-seq) )
     (def curr-len         (count tgt-word) )
     (def curr-words       (words-map curr-len) )
@@ -256,36 +246,36 @@
          _ (println "all-char-freqs" all-char-freqs)
       ] ))

-;(comment
     (println)
     (println "************************************************************")
-    (println "word-array" word-array)
+    (println "word-array" (map str/join word-array) )
     (loop [ guessed-chars  #{}
             clue           (make-clue tgt-word guessed-chars)
           ]
-      (println "----------------------------------------")
-      (println "guessed-chars ("
-         (count guessed-chars) ")"
-                guessed-chars)
+      (println )
       (println "clue" clue)
       (let [
         keep-flag       (map #(guess-matches? % clue ) word-array )
-        keep-words      (filter-with keep-flag word-array)
-          _ (println "keep-words" (map str/join keep-words) )
-        col-char-freqs   (to-freqs-by-col keep-words)
-
-        new-guess       (make-guess clue col-char-freqs guessed-chars)
-          _ (println "new-guess" new-guess)
-        guessed-chars   (conj guessed-chars new-guess)
-          _ (println "guessed-chars" guessed-chars)
-        new-clue        (make-clue tgt-word guessed-chars)
-          _ (println "new-clue" new-clue)
-      ]
-        (if (some nil? new-clue)
-          (recur  (conj guessed-chars new-guess)  new-clue )
-        )
+        keep-words      (filter-with keep-flag word-array) ]
+          (println "keep-words" (map str/join keep-words) )
+          (if (= 1 (num-rows keep-words))
+            (let [final-guess (str/join (keep-words 0)) ]
+              (println (str "***** found word:  '" final-guess "'  *****") )
+              (println "matches:" (= final-guess tgt-word)) )
+          ;else
+            (let [
+              col-char-freqs  (to-freqs-by-col keep-words)
+              new-guess       (make-guess clue col-char-freqs guessed-chars)
+              guessed-chars   (conj guessed-chars new-guess)
+              new-clue        (make-clue tgt-word guessed-chars)
+                _ (println "new-clue" new-clue "  new-guess" new-guess
+                   "  guessed-chars (" (count guessed-chars) ")" guessed-chars)
+              ]
+              (if (some nil? new-clue)
+                (recur  (conj guessed-chars new-guess)  new-clue )
+              ))
+          )
       ))
-;)

   )
 )


RR: add generate-html fn

RR: add generate-html fn

--- src/hatti/utils.cljs
+++ src/hatti/utils.cljs
@@ -2,7 +2,8 @@
   (:require [clojure.string :refer [join lower-case split upper-case replace]]
             [goog.string.format]
             [goog.string]
-            [inflections.core :refer [plural]]))
+            [inflections.core :refer [plural]]
+            [sablono.core :as html :refer-macros [html]]))

 (defn url [& args] (str "/" (join "/" (remove nil? args))))

@@ -76,3 +77,21 @@
            #"(-)(.)"
            #(let [[_ _ letter-to-uppercase] %]
               (upper-case letter-to-uppercase))))
+
+(defn- generate-component
+  [element-definition-vector]
+  (html element-definition-vector))
+
+(defn generate-html
+  "This function generates HTML from hiccup-style vectors, and concatenates
+  the resulting markup. Strings are returned unaffected."
+  [& element-definition-vectors]
+  (let [components (map generate-component element-definition-vectors)
+        components-as-static-markup (map
+                                     (fn
+                                       [component]
+                                       (if (string? component)
+                                         component
+                                         (html/render-static component)))
+                                     components)]
+    (join components-as-static-markup)))


Fix spec

Fix spec

--- src/net/sekao/nightcode/projects.clj
+++ src/net/sekao/nightcode/projects.clj
@@ -323,7 +323,7 @@
   :ret spec/pane?)

 (fdef home-pane
-  :args (s/cat :runtime-state map?)
+  :args (s/cat :pref-state map? :runtime-state map?)
   :ret spec/pane?)

 (fdef file-node


Fix bug preventing the correct project pane from displaying

--- src/net/sekao/nightcode/projects.clj
+++ src/net/sekao/nightcode/projects.clj
@@ -245,14 +245,14 @@
     (.addListener (.selectedItemProperty selection-model)
       (reify ChangeListener
         (changed [this observable old-value new-value]
-          (let [parent-path (u/get-project-root-path @pref-state-atom)]
-            (some->> old-value
-                     .getPath
-                     (get (:editor-panes @runtime-state-atom))
-                     shortcuts/hide-tooltips!)
-            (when new-value
-              (-> (swap! pref-state-atom assoc :selection (.getPath new-value))
-                  (update-project-buttons! scene))
+          (some->> old-value
+                   .getPath
+                   (get (:editor-panes @runtime-state-atom))
+                   shortcuts/hide-tooltips!)
+          (when new-value
+            (-> (swap! pref-state-atom assoc :selection (.getPath new-value))
+                (update-project-buttons! scene))
+            (let [parent-path (u/get-project-root-path @pref-state-atom)]
               (when-let [new-pane (.getPane new-value runtime-state-atom parent-path)]
                 (doto (.getChildren content)
                   (.clear)


It starts after removing multiple projects

--- src/lein_ui/core.clj
+++ src/lein_ui/core.clj
@@ -18,124 +18,37 @@

 ;;; Projects

-(defonce projects (atom {}))
+(defonce project (atom nil))
+
+(defn get-project* []
+  (if-let [project @project]
+    project
+    (throw (ex-info "Project doesn't exist" {:name name}))))

 (defn new-project [project-map raw-project-map]
   (assoc project-map
     ::run-state (atom {})
     ::raw raw-project-map))

-(defn get-project* [name]
-  (if-let [project (@projects name)]
-    project
-    (throw (ex-info "Project doesn't exist" {:name name}))))
-
 (defn load-project! [root]
   (let [path (->>  (io/file root "project.clj")
                       (.getAbsolutePath))
-        project (project/read path)
-        raw-project (project/read-raw path)
-        ui-project (new-project project raw-project)
+        project-map (project/read path)
+        raw-project-map (project/read-raw path)
+        ui-project (new-project project-map raw-project-map)
         name (-> ui-project :name)
         root (-> ui-project :root)]
-       (swap! projects (fn [ps]
-                         (when (ps name)
-                           (throw (ex-info (str "Project already loaded")
-                                           {:root root})))
-                         (assoc ps name
-                                ui-project)))
-       name))
+    (reset! project ui-project)
+    name))

-
-(defn unload-project! [name]
-  (swap! projects dissoc name))
-
-(defn reload-project! [name]
-  (let [root (-> (get-project* name) :root)]
-    (unload-project! name)
-    (load-project! root)))
-
-;; adapated from leiningen.core.eval
-(defn- overridden-env
-  "Returns an overridden version of the current environment as an Array of
-  Strings of the form name=val, suitable for passing to Runtime#exec."
-  [env]
-  (->> env
-       (filter val)
-       (map #(str (name (key %)) "=" (val %)))
-       (into-array String)))
-
-;; adapated from leiningen.core.eval
-(defn sh
-  [cmd & {:keys [dir]}]
-  (let [env (overridden-env (System/getenv))
-        proc (.exec (Runtime/getRuntime) (into-array cmd) env
-                    (io/file dir))]
-    (.addShutdownHook (Runtime/getRuntime)
-                      (Thread. (fn [] (.destroy proc))))
-    ;; TODO: wrap setup in try/finally and close streams
-    (let [out (io/reader (.getInputStream proc))
-          err (io/reader (.getErrorStream proc))
-          out-writer (java.io.StringWriter.)
-          err-writer (java.io.StringWriter.)
-          pump-out (doto (Pipe. out out-writer) .start)
-          pump-err (doto (Pipe. err err-writer) .start)]
-      {:process proc
-       :pump-out pump-out
-       :pump-err pump-err
-       :out-writer out-writer
-       :err-writer err-writer})))
-
-
-(defonce free-port (atom 4000))
-(defn next-free-port []
-  (swap! free-port inc))
-
-(defn start-repl! [name]
-  (let [project (get-project* name)]
-    (when (-> project ::run-state deref :repl)
-      (throw (ex-info "Project already running a repl!" {:name name})))
-
-    (let [env (overridden-env (System/getenv))
-          host (repl/repl-host project)
-          port (let [project-port (repl/repl-port project)]
-                 (if (= project-port 0)
-                   (next-free-port)
-                   project-port))
-          repl-process (sh ["lein"
-                            "repl"
-                            ":headless"
-                            ":host"
-                            host
-                            ":port"
-                            (str port)]
-                           :dir ".")]
-      (swap! (::run-state project) assoc :repl
-             (assoc repl-process
-               :host host
-               :port port))
-      nil)))
-
-
-(defn reset-repl! [name]
-  (reset! (-> name get-project* ::run-state)
-          nil))
-
-(defn stop-repl! [name]
-  (throw (ex-info "Not supported" {:error :go-away}))
-  (let [project (get-project* name)]
-    (if-let [repl (-> project ::run-state deref :repl)]
-      (do (.destroy (:process repl))
-          (swap! (::run-state project) dissoc :repl)
-          nil)
-      (throw (ex-info "repl not running" {:name name})))))

 (def self-repl {:host "localhost"
                 :port 7888})

-(defn repl-eval! [name code]
-  (let [{:keys [host port]} (-> name get-project* ::run-state deref :repl)]
+;; TODO remove this for nrepl.client-manager
+(defn repl-eval! [code]
+  (let [{:keys [host port]} (-> (get-project*) ::run-state deref :repl)]
     (with-open [conn (nrepl/connect :host host
                                     :port port)]
       (-> (nrepl/client conn 1000)
@@ -143,45 +56,41 @@
           doall))))

-(defn figwheel-process [project]
+(defn figwheel-process []
   (let [out-writer (java.io.StringWriter.)]
     {:thread (.start
               (Thread. (bound-fn []
                          (binding [*out* out-writer]
-                           (figwheel/figwheel project)))))
+                           (figwheel/figwheel (get-project*))))))
      :out-writer out-writer}))

-(defn start-figwheel! [name]
-  (let [project (get-project* "lein-ui")]
-    (swap! (-> project ::run-state)
-           assoc :figwheel (figwheel-process project))))
+(defn start-figwheel! []
+  (swap! (-> (get-project*) ::run-state)
+         assoc :figwheel (figwheel-process)))

 ;;; Util
-(defn base-url []
-  (str "http://" "localhost" ":8000/"))
+(defn base-api-url []
+  (str "http://" "localhost" ":8000/api/project"))

 (defn url-for [path]
-  (str (base-url) path))
+  (str (base-api-url) path))

 ;;; API
-(defn url-for-project [name]
-  (url-for (str "api/projects/" name)))

-
-(defn get-repl-data [name]
-  (let [process (-> name get-project* ::run-state deref :repl)
-        url (str (url-for-project name) "/repl")]
+(defn get-repl-data []
+  (let [process (-> (get-project*) ::run-state deref :repl)
+        url (url-for "/repl")]
     (merge
      {:url url}
      (if process
        {:state :started
         :host (:host process)
         :port (:port process)
-        :stop-url (str (url-for-project name) "/repl/stop")
-        :eval-url (str (url-for-project name) "/repl/eval")}
+        :stop-url (url-for "/repl/stop")
+        :eval-url (url-for "/repl/eval")}
        {:state :stopped
-        :start-url (str (url-for-project name) "/repl/start")}))))
+        :start-url (url-for "/repl/start")}))))

@@ -199,33 +108,25 @@
     ::run-state
     ::raw})

-(defn get-readable-project [project-name]
-  (apply dissoc (get-project* project-name)
+(defn get-readable-project []
+  (apply dissoc (get-project*)
          non-data-keys))

-(defn get-readable-raw-project [project-name]
-  (apply dissoc (::raw (get-project* project-name))
+(defn get-readable-raw-project []
+  (apply dissoc (::raw (get-project*))
          non-data-keys))

-(defn project-summary [project]
-  {:url (url-for-project (:name project))
-   :name (:name project)
-   :version (:version project)
-   :root (:root project)})
-
-(defn get-projects []
-  {:projects (for [[name project] @projects]
-               (project-summary project))})
-
-(defn add-project [project-root]
-  (load-project! project-root))
-
+(defn project-summary []
+  (let [project (get-project*)]
+    {:url (base-api-url)
+     :name (:name project)
+     :version (:version project)
+     :root (:root project)}))

 (defn bootstrap-self []
   (load-project! ".")
-  (swap! (-> "lein-ui" (get-project*) ::run-state)
-         assoc :repl self-repl
-               :figwheel (figwheel-process (get-project* "lein-ui"))))
+  (swap! (-> (get-project*) ::run-state) :repl self-repl)
+  (start-figwheel!))

 ;;; Server
@@ -235,7 +136,7 @@
   (go-loop []
     (<! (timeout 500))
     (doseq [[project subscribers] @figwheel-receivers]
-      (let [output (-> (get-project* project)
+      (let [output (-> (get-project*)
                        ::run-state
                        deref
                        :figwheel
@@ -250,42 +151,25 @@
        (server/with-channel request channel
          (swap! figwheel-receivers assoc "lein-ui" channel)
          (server/on-close channel (fn [status] (swap! figwheel-receivers dissoc "lein-ui" channel)))))
-  (GET "/api/projects" []
-       {:body (pprint-str (get-projects))
-        :status 200})
-  (GET "/api/projects/:project-name" [project-name]
-       (let [project (get-project* project-name)
+  (GET "/api/project" []
+       (let [project (get-project*)
              run-state @(project ::run-state)]
          {:body (pprint-str
                  (merge (project-summary project)
                         ;; TODO just include these in the summary?
-                        {:map-url (str (url-for-project project-name)
-                                                "/map")
-                         :raw-map-url (str (url-for-project project-name)
-                                           "/raw-map")
-                         :repl (get-repl-data project-name)}))
+                        {:map-url (url-for "/map")
+                         :raw-map-url (url-for "/raw-map")
+                         :repl (get-repl-data)}))
           :status 200}))
-  (GET "/api/projects/:project-name/map" [project-name]
-       {:body (pprint-str (get-readable-project project-name))
+  (GET "/api/project/map" []
+       {:body (pprint-str (get-readable-project))
         :status 200})
-  (GET "/api/projects/:project-name/raw-map" [project-name]
-       {:body (pprint-str (get-readable-raw-project project-name))
+  (GET "/api/project/raw-map" []
+       {:body (pprint-str (get-readable-raw-project))
         :status 200})
-  (POST "/api/projects/:project-name/repl/start" [project-name]
-        (start-repl! project-name)
-        {:body (pprint-str (get-repl-data project-name))
-         :status 201})
-  (POST "/api/projects/:project-name/repl/eval" {{:keys [project-name
-                                                         code]} :params}
-        {:body (pprint-str (repl-eval! project-name code))
+  (POST "/api/project/repl/eval" {{:keys [code]} :params}
+        {:body (pprint-str (repl-eval! code))
          :status 200})
-  (POST "/api/projects" [root]
-        (let [name (load-project! root)]
-          {:status 201
-           :body (pprint-str (project-summary (get-project* name)))}))
-  (DELETE "/api/projects/:project-name" [project-name]
-          (unload-project! project-name)
-          {:status 204})
   (route/resources "/")
   (route/not-found "
Page not found.
"))


Add fn to convert str to bool

Add fn to convert str to bool

--- frontend/src/cruncher/utils/lib.cljs
+++ frontend/src/cruncher/utils/lib.cljs
@@ -225,4 +225,10 @@
   (let [converted (js/parseInt s)]
     (if-not (js/isNaN converted)
       converted
-      s)))+      s)))
+
+(defn str->bool
+  "Convert JS String to boolean."
+  [str]
+  (when (string? str)
+    (= "true" str)))


Need the keep a connection pool open in order to unCLOB-er CLOBs

--- src/metabase/driver/generic_sql/util.clj
+++ src/metabase/driver/generic_sql/util.clj
@@ -14,19 +14,24 @@
   (let [driver                              (driver/engine->driver (:engine database))
         database->connection-details        (:database->connection-details driver)
         connection-details->connection-spec (:connection-details->connection-spec driver)]
-    (-> database database->connection-details connection-details->connection-spec)))
+    (-> database
+        database->connection-details
+        connection-details->connection-spec
+        (assoc :make-pool? true))))     ; need to make a pool or the connection will be closed before we get a change to unCLOB-er the results during JSON serialization

-(def ^{:arglists '([database])} db->korma-db
+(def ^{:arglists '([database])}
+  db->korma-db
   "Return a Korma database definition for DATABASE.
    This does a little bit of smart caching (for 60 seconds) to avoid creating new connections when unneeded."
   (let [-db->korma-db (memo/ttl (fn [database]
                                   (log/debug (color/red "Creating a new DB connection..."))
-                                  (assoc (kdb/create-db (db->connection-spec database))
-                                         :make-pool? true))
+                                  (kdb/create-db (db->connection-spec database)))
                                 :ttl/threshold (* 60 1000))]
     ;; only :engine and :details are needed for driver/connection so just pass those so memoization works as expected
     (fn [database]
-      (-db->korma-db (select-keys database [:engine :details])))))
+      (let [r (-db->korma-db (select-keys database [:engine :details]))]
+        (println "R:\n" (metabase.util/pprint-to-str 'green r))
+        r))))

 (def ^:dynamic ^java.sql.DatabaseMetaData *jdbc-metadata*
   "JDBC metadata object for a database. This is set by `with-jdbc-metadata`."
@@ -67,6 +72,7 @@
     (-> (sel :one Table :id 100)
         korma-entity
         (select (aggregate (count :*) :count)))"
+  {:arglists '([table] [db table])}
   ([{db-delay :db, :as table}]
    {:pre [(delay? db-delay)]}
    (korma-entity @db-delay table))


fixed api integration test

fixed api integration test

--- test/clj/swarmpit/api_integration_test.clj
+++ test/clj/swarmpit/api_integration_test.clj
@@ -121,7 +121,7 @@
         (is (= some-task (task (:id some-task))))))

     (testing "find public repository"
-      (let [results (dockerhub-repositories "nginx" 1)]
+      (let [results (public-repositories "nginx" 1)]
         (is (some? results))
         (is (= "nginx" (:query results)))
         (is (= "nginx" (-> results :results first :name)))))))


New test: test-format-time

New test: test-format-time

--- test/clj_calendar/format_datetime_test.clj
+++ test/clj_calendar/format_datetime_test.clj
@@ -95,4 +95,12 @@
               "2 months and one year ago"    (format-time- 2 1 "month" "year")
               "2 months and 2 years ago"     (format-time- 2 2 "month" "year"))))

+(deftest test-format-time
+    "Check the function clj-calandar.format-datetime/format-time."
+    (testing "the function clj-calandar.format-datetime/format-time."
+        (are [x y] (= x y)
+              "1 month ago"  (format-time 1 "month")
+              "2 months ago" (format-time 2 "months")
+              "1 year ago"   (format-time 1 "year")
+              "2 years ago"  (format-time 2 "years"))))


small fix in core-test

small fix in core-test

--- test/com/billpiel/mem_tracer/core_test.clj
+++ test/com/billpiel/mem_tracer/core_test.clj
@@ -37,7 +37,8 @@
                           :depth 0
                           :id :root10
                           :path [:root10]
-                          :traced #{[:ns 'com.billpiel.mem-tracer.test.ns1]}}]
+                          :traced #{[:ns 'com.billpiel.mem-tracer.test.ns1]}
+                          :ws-slot nil}]

       (fact "log is correct"
         trace
@@ -46,7 +47,6 @@
       (fact "string output is correct"
         (->> trace
              mt/entry->string
-println
              t-utils/remove-iso-ctrl)
         => "[31m [1;30;41m-[40m[31m[m[33m [33m|[1;30;43m-[40m[33mcom.billpiel.mem-tracer.test.ns1/func1[m [33m|  [33m:a[0m[m [33m| return =>  [33m|  [33m:a[0m[m[32m [33m|[32m|[1;30;42m-[40m[32mcom.billpiel.mem-tracer.test.ns1/func2[m [33m|[32m|  [33m:a[0m[m [33m|[32m| return =>  [33m|[32m|  [33m:a[0m[m [33m| return =>  [33m|  [33m:a[0m[m")

@@ -78,7 +78,6 @@
       (fact :dev "string output is correct"
         (->> trace
              mt/entry->string
-             println
              t-utils/remove-iso-ctrl)
         => ""))


(PDB-3065) Stop memoizing resource identity hashes

Because the memoization is based on count, not overall pool size, it
could consume arbitrary RAM, and was responsible for overruning a 32GB
JVM in the field.

cf. (PDB-3059)

--- src/puppetlabs/puppetdb/scf/hash.clj
+++ src/puppetlabs/puppetdb/scf/hash.clj
@@ -46,10 +46,6 @@
   {:post [(string? %)]}
   (generic-identity-hash [type title parameters]))

-;; Size of the cache is based on the number of unique resources in a
-;; "medium" site persona
-(def memoized-resource-identity-hash* (kitchensink/bounded-memoize resource-identity-hash* 40000))
-
 (defn resource-identity-hash
   "Compute a hash for a given resource that will uniquely identify it
   _for storage deduplication only_.
@@ -60,7 +56,7 @@
   [{:keys [type title parameters] :as resource}]
   {:pre  [(map? resource)]
    :post [(string? %)]}
-  (memoized-resource-identity-hash* type title parameters))
+  (resource-identity-hash* type title parameters))

 (defn catalog-resource-identity-format
   "Narrow `resource` to only contain the needed key/values for computing the hash of


Add instructions on dropping a server DB in preperation for restoration.

--- test/open_company/integration/section/section_manipulation.clj
+++ test/open_company/integration/section/section_manipulation.clj
@@ -287,7 +287,11 @@

   (facts "about adding sections"

-    (future-fact "that don't really exist")
+    (fact "that don't really exist"
+      (let [new-sections {:progress ["health"] :company [] :financial []}
+            response (mock/api-request :patch (company-rep/url r/slug) {:body {:sections new-sections}})
+            body (mock/body-from-response response)]
+        (:status response) => 200))

     (facts "without any section content"


use object-class-tag everywhere

use object-class-tag everywhere

--- src/clj/flambo/kryo.clj
+++ src/clj/flambo/kryo.clj
@@ -8,12 +8,9 @@
 ;; lol scala
 (def OBJECT-CLASS-TAG (.apply ClassTag$/MODULE$ java.lang.Object))

-(defn class-tag [o]
-  (.apply ClassTag$/MODULE$ (class o)))
-
 (defn ^bytes serialize [^Object obj]
   (let [^SerializerInstance ser (.. (SparkEnv/get) serializer newInstance)
-        ^ByteBuffer buf (.serialize ser obj (class-tag obj))]
+        ^ByteBuffer buf (.serialize ser obj OBJECT-CLASS-TAG)]
     (.array buf)))

 (defn deserialize [^bytes b]


find request by id

find request by id

--- src/clj/freeq/mongo.clj
+++ src/clj/freeq/mongo.clj
@@ -37,6 +37,9 @@
 (s/defn get-requests :- [Request] []
   (mc/find-maps @db request-collection {}))

+(s/defn get-request :- Request [id]
+  (mc/find @db request-collection {:_id id}))
+
 ;; Comments

 (s/defn add-comment :- (s/eq nil)


* src/cljs/cljs/core.cljs: make default IHash implementation goog.getUid to cover functions and JS Objects

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -379,7 +379,7 @@
   (-hash [o]
     (if (identical? o true) 1 0)))

-(extend-type function
+(extend-type default
   IHash
   (-hash [o] (goog.getUid o)))


CLJS-879: add `update` from Clojure 1.7

CLJS-879: add `update` from Clojure 1.7

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -3923,6 +3923,22 @@
    (if ks
      (assoc m k (apply update-in (get m k) ks f a b c args))
      (assoc m k (apply f (get m k) a b c args)))))
+
+(defn update
+  "'Updates' a value in an associative structure, where k is a
+  key and f is a function that will take the old value
+  and any supplied args and return the new value, and returns a new
+  structure.  If the key does not exist, nil is passed as the old value."
+  ([m k f]
+   (assoc m k (f (get m k))))
+  ([m k f x]
+   (assoc m k (f (get m k) x)))
+  ([m k f x y]
+   (assoc m k (f (get m k) x y)))
+  ([m k f x y z]
+   (assoc m k (f (get m k) x y z)))
+  ([m k f x y z & more]
+   (assoc m k (apply f (get m k) x y z more))))

 ;;; PersistentVector


* src/cljs/cljs/core.cljs: remove js* usage for missing-protocol

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -62,9 +62,9 @@
   *main-cli-fn* nil)

 (defn missing-protocol [proto obj]
-  (js/Error (js* "~{}+~{}+~{}+~{}+~{}+~{}"
-                 "No protocol method " proto
-                 " defined for type " (goog/typeOf obj) ": " obj)))
+  (js/Error
+   (.join (array "No protocol method " proto
+                 " defined for type " (goog/typeOf obj) ": " obj) "")))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; arrays ;;;;;;;;;;;;;;;;


added problem page back

added problem page back

--- src/cljs/kata/core.cljs
+++ src/cljs/kata/core.cljs
@@ -30,6 +30,7 @@
         [:a.navbar-brand {:href "#/"} "kata"]
         [:ul.nav.navbar-nav
          [nav-link "#/" "Home" :home collapsed?]
+         [nav-link "#/add-problem" "Add Problem" :add-problem collapsed?]
          [nav-link "#/about" "About" :about collapsed?]]]])))

 (defn home-page []


Make mlet macro work like do block (accept multiple body statements)

--- src/cljx/cats/core.cljx
+++ src/cljx/cats/core.cljx
@@ -89,13 +89,13 @@

 #+clj
 (defmacro mlet
-  [bindings body]
+  [bindings & body]
   (when-not (and (vector? bindings) (even? (count bindings)))
     (throw (IllegalArgumentException. "bindings has to be a vector with even number of elements.")))
   (if (seq bindings)
     (let [l (get bindings 0)
           r (get bindings 1)
-          next-mlet `(mlet ~(subvec bindings 2) ~body)]
+          next-mlet `(mlet ~(subvec bindings 2) ~@body)]
       (condp = l
         :let `(let ~r ~next-mlet)
         :when `(bind (guard ~r)
@@ -104,7 +104,7 @@
         `(bind ~r
                (fn [~l]
                  ~next-mlet))))
-    body))
+    `(do ~@body)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Monadic functions


CMR-5195 Fixes formula.

CMR-5195 Fixes formula.

--- src/cmr/sizing/core.clj
+++ src/cmr/sizing/core.clj
@@ -85,8 +85,8 @@
                                          (get-avg-compression-rate-ascii variable))]
               (+ total-estimate
                  (* total-granule-input-bytes
-                    (* (/ (/ total-granule-input-bytes granule-count) avg-gran-size
-                          avg-compression-rate))))))
+                    avg-compression-rate
+                    (/ (/ total-granule-input-bytes granule-count) avg-gran-size)))))
           0
           variables))


fix problem with trailing slash on rewrite to ""

--- frontend/routes.cljs
+++ frontend/routes.cljs
@@ -113,9 +113,10 @@
                                                       :_title (:title doc)))
         (do
           (let [token (str (name subpage) (when (:_fragment params) (str "#" (:_fragment params))))
-                path (if (= token (doc-utils/maybe-rewrite-token token))
+                rewrite-token (doc-utils/maybe-rewrite-token token)
+                path (if (= token rewrite-token)
                        "/docs"
-                       (str "/docs/" (doc-utils/maybe-rewrite-token token)))]
+                       (str "/docs" (when-not (str/blank? rewrite-token) (str "/" rewrite-token))))]
             (put! nav-ch [:navigate! {:path path :replace-token? true}]))))))

   (defroute v1-about (FragmentRoute. "/about") {:as params}


another go at fixing build break

another go at fixing build break

--- test/shuppet/resources/local/localtest.clj
+++ test/shuppet/resources/local/localtest.clj
@@ -40,7 +40,7 @@

  :Role {:RoleName $app-name
-        :Policies  [{:PolicyName "s3ReposReadOnly"
+        :Policies  [{:PolicyName "s3-Repos-ReadOnly-1"
                      :PolicyDocument [{:Effect "Allow"
                                        :Action "EC2:Describe*"
                                        :Resource "*"}


* benchmark/cljs/benchmark_runner.cljs: benchmark nth & -nth

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -19,6 +19,8 @@

 (println ";;; vector ops")
 (simple-benchmark [coll [1 2 3]] (first coll) 1000000)
+(simple-benchmark [coll [1 2 3]] (nth coll 1) 1000000)
+(simple-benchmark [coll [1 2 3]] (-nth coll 1) 1000000)
 (simple-benchmark [coll [1 2 3]] (rest coll) 1000000)
 (simple-benchmark [coll [1 2 3]] (next coll) 1000000)
 (println)


(maint) Directly deactivate stale nodes

(maint) Directly deactivate stale nodes

... instead of issuing a command to do the same. This works around a
startup race; if there is a stale node when PuppetDB starts, it would
try to issue a deactivate-node command before the message queue was
ready to receive commands at all.

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -91,9 +91,8 @@
              (format-period node-ttl))
      (with-transacted-connection db
        (doseq [node (scf-store/stale-nodes (ago node-ttl))]
-         (enqueue-command! mq-connection
-                           mq-endpoint
-                           (command-names :deactivate-node) 3 {:certname node}))))
+         (log/infof "Auto-deactivating node %s" node)
+         (scf-store/deactivate-node! node))))
     (catch Exception e
       (log/error e "Error while deactivating stale nodes"))))


send userlist as js array

send userlist as js array

--- src/moomoo/core.cljs
+++ src/moomoo/core.cljs
@@ -24,7 +24,7 @@
           (let [room (.toString reply)]
             (rooms/get-all-users room
               (fn [err reply]
-                (.emit (.to io room) "userslist" reply)))))))
+                (.emit (.to io room) "userslist" (clj->js reply))))))))
     (println "A user has disconnected!")))
   (.on socket "set_username"
     (fn [room username]


fixed navigation line number calculation

--- src/strictly_specking/edn_string_nav.clj
+++ src/strictly_specking/edn_string_nav.clj
@@ -144,7 +144,7 @@
         node (zip/node l)]
     (->> root-zip
          (direction zip/next)
-         (take-while #(not= node (zip/node %)))
+         (take-while #(not= l %))
          (filter at-newline?)
          count
          inc)))
@@ -210,8 +210,30 @@
        :value  (or (sjacket->clj (-> point-loc next-value zip/node))
                    (sjacket->clj (zip/node point-loc)))
        :path path
-       ; :loc point-loc
+       :loc point-loc
        })))

+#_(def x (:loc (get-path-in-clj-file [0 :asdfasdf 0] "tester.edn")))
+
+
+#_(defn line-number [l]
+  (let [root-zip (->root-loc l)
+        node (zip/node l)]
+    (->> root-zip
+         (direction zip/next)
+         (take-while #(not= l %))
+         (filter at-newline?)
+         count
+         inc)))
+
+#_(line-number x)
+
+#_(zip/node x)
+#_(->> (->root-loc x)
+     (direction zip/next)
+     (take
+      40)
+     last)
+

 #_ (get-path-in-clj-file [:cljsbuild :builds 0] "project.clj")


Remove --chroot option from sift task in favor of --move regex replace

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -246,28 +246,29 @@
 (core/deftask sift
   "Filter the output fileset, matching paths against regexes.

-  The include and exclude options specify sets of regular expressions (strings)
-  that will be used to filter the fileset."
-
-  [c chroot ROOT   str    "The path to be prepended to all output file paths."
-   i include REGEX #{str} "The set of regexes that paths must match."
-   x exclude REGEX #{str} "The set of regexes that paths must not match."]
+  The include and exclude options specify sets of regular expressions that will
+  be used to filter the fileset.
+
+  The move option applies a find/replace transformation on all paths in the
+  output fileset."
+
+  [m move MATCH:REPLACE {regex str} "The map of regex to replacement path strings."
+   i include REGEX      #{regex}    "The set of regexes that paths must match."
+   x exclude REGEX      #{regex}    "The set of regexes that paths must not match."]

   (core/with-pre-wrap fileset
     (let [outs    (core/output-files fileset)
-          include (map re-pattern include)
-          exclude (map re-pattern exclude)
           keep?   (partial file/keep-filters? include exclude)
-          addroot #(or (and (not chroot) %1)
+          mvpath  (partial reduce-kv #(string/replace %1 %2 %3))
+          mover   #(or (and (not move) %1)
                        (let [from-path (core/tmppath %2)
-                             to-path   (.getPath (io/file chroot from-path))]
+                             to-path   (mvpath from-path move)]
                          (core/mv %1 from-path to-path)))
           remover #(if (keep? (io/file (core/tmppath %2))) %1 (core/rm %1 [%2]))]
       (util/info "Sifting output files...\n")
-      (->> outs
-           (reduce remover fileset)
+      (->> (reduce remover fileset outs)
            ((juxt identity core/output-files))
-           (apply reduce addroot)
+           (apply reduce mover)
            core/commit!))))

 (core/deftask add-repo


Changing the metdata db fixture so it runs before tests instead of after.

--- metadata-db-app/int_test/cmr/metadata_db/int_test/utility.clj
+++ metadata-db-app/int_test/cmr/metadata_db/int_test/utility.clj
@@ -382,8 +382,7 @@
   Optionally accepts a list of provider-ids to create before the test"
   [& provider-ids]
   (fn [f]
-    (try
-      (doseq [pid provider-ids] (save-provider pid))
-      (f)
-      (finally (reset-database)))))
-
+    (reset-database)
+    (doseq [pid provider-ids] (save-provider pid))
+    (f)))
+


Add formation connection types

Add formation connection types

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -553,7 +553,7 @@
    (let [volume-magnitude (condp = volume-unit
                             :bbl (tuc/draw-normal 6986.70 1992.30)
                             :m3  (tuc/draw-normal 813.47 286.89))]
-     [volume-magnitude volume-unit])))
+     (make-measurement volume-magnitude volume-unit))))

 (defn typical-proppant-mass
   ([] (let [mass-unit (rand-mass-unit)]
@@ -675,9 +675,6 @@
         measurement (generate-measurement-f unit)]
     [measurement (measurement-as-f measurement (first (remove (partial = unit) units)))]))

-(generate-measurement-pair (set (quantity-unit-map :volume))
-                           rand-volume-unit typical-pumped-volume volume-as)
-
 (defn rand-measurement
   ([]
    (rand-measurement (rand-physical-quantity)))


Make typical-monitor-pressure multi-variadic

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -309,13 +309,19 @@

     (converter [from to])))

-(defn typical-monitor-pressure [units]
-  (cond (= units :psi)
-        (first (p-mon-seq))
-        (= units :kPa)
-        ((convert-units-f :psi :kPa) (typical-monitor-pressure :psi))
-        (= units :MPa)
-        ((convert-units-f :kPa :MPa) (typical-monitor-pressure :kPa))))
+(defn rand-pressure-unit []
+  (rand-nth [:psi :kPa :MPa]))
+
+(defn typical-monitor-pressure
+  ([units]
+   (cond (= units :psi)
+         (first (p-mon-seq))
+         (= units :kPa)
+         ((convert-units-f :psi :kPa) (typical-monitor-pressure :psi))
+         (= units :MPa)
+         ((convert-units-f :kPa :MPa) (typical-monitor-pressure :kPa))))
+  ([] (let [unit (rand-pressure-unit)]
+        [unit (typical-monitor-pressure unit)])))

 (defn typical-monitor-temperature
   ([] (let [units (rand-nth [:C :F])]
@@ -324,9 +330,6 @@
                  (value-from-typical-range 50 80)
                  (= units :F)
                  ((convert-units-f :C :F) (typical-monitor-temperature :C)))))
-
-(defn rand-pressure-unit []
-  (rand-nth [:psi :kPa :MPa]))

 (defn typical-surface-treating-pressure
   ([]


SER-2523 | Include k8s label when publishing

--- src/wikia/common/perfmonitoring/core.clj
+++ src/wikia/common/perfmonitoring/core.clj
@@ -55,7 +55,7 @@
 (defn publish
   ([series-name point]
     (when @config
-      (let [point (merge {:series-name (format-series-name series-name), :k8s "k8s"} point)]
+      (let [point (merge {:series-name (format-series-name series-name) :k8s "k8s"} point)]
         (future (send-data (json/generate-string (format-content point)))))))
   ([point]
     (publish (get-series-name) point)))


Silly underscore, get where you belong!

Silly underscore, get where you belong!

--- src/omnibus/core.clj
+++ src/omnibus/core.clj
@@ -98,7 +98,7 @@
   "Builds a deb"
   [project-name version iteration os-data]
   (let [
-        asset-name (str project-name "-" version "-" iteration "_" (if (= (os-data :machine) "x86_64") "amd64" "i386") ".deb")
+        asset-name (str project-name "_" version "-" iteration "_" (if (= (os-data :machine) "x86_64") "amd64" "i386") ".deb")
         asset-path (.toString (file-str *omnibus-pkg-dir* "/" asset-name))
         status (sh "fpm" "-s" "dir" "-t" "deb" "-v" version "--iteration" iteration "-n" project-name "/opt/opscode" "-m" "Opscode, Inc." "--post-install" "../source/postinst" "--post-uninstall" "../source/postrm" "--description" "The full stack install of Opscode Chef" "--url" "http://www.opscode.com" :dir "./pkg") ]
     (log-sh-result status


Login after register

Login after register

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -130,7 +130,7 @@

   (POST "/rest/v1/register" {params :params cookies :cookies}
       (let [user (register-user params)]
-        (json-response {"token" (auth-token user) "username" (:user user)} 200)))
+        (json-response {"token" (auth-token user) "username" (:username user)} 200)))

   (route/resources "/")
   (route/not-found {:status 404}))


Fix window predicate schema

Fix window predicate schema

--- src/onyx/schema.cljc
+++ src/onyx/schema.cljc
@@ -272,10 +272,10 @@
      (s/optional-key :window/timeout-gap) Unit
      (s/optional-key :window/session-key) s/Any
      (s/optional-key :window/doc) s/Str
-     UnsupportedWindowKey s/Any})
-  (fn [v] (and (#{:fixed :sliding} (:window/type v))
-	       (:window/range v)))
-  ":window/range must be defined for :fixed or :sliding window")
+     UnsupportedWindowKey s/Any}
+    (fn [v] (and (#{:fixed :sliding} (:window/type v))
+                 (:window/range v)))
+    ":window/range must be defined for :fixed or :sliding window"))

 (def StateAggregationCall
   {(s/optional-key :aggregation/init) Function


Emit "Vary: Accept" header for img and jpeg images

--- src/vignette/util/image_response.clj
+++ src/vignette/util/image_response.clj
@@ -3,6 +3,7 @@
             [clojure.string :as string]
             [compojure.route :refer [not-found]]
             [ring.util.response :refer [response status header]]
+            [pantomime.mime :refer [mime-type-of]]
             [digest :as digest]
             [vignette.media-types :refer :all]
             [vignette.util.query-options :refer :all]
@@ -14,6 +15,7 @@
 (declare create-image-response
          add-content-disposition-header
          add-surrogate-header
+         add-vary-header
          surrogate-key)

 (defn when-header-val
@@ -50,7 +52,8 @@
        (when-header-val "ETag" (str "\"" (etag image) "\""))
        (header "X-Thumbnailer" "Vignette")
        (add-content-disposition-header image-map image)
-       (add-surrogate-header image-map)))
+       (add-surrogate-header image-map)
+       (add-vary-header image-map)))
   ([image]
    (create-image-response image nil)))

@@ -99,3 +102,16 @@
       (digest/sha1 (fully-qualified-original-path image-map))
       (catch Exception e
         (str "vignette-" (:original image-map))))))
+
+(def vary-accept-mime-types #{"image/jpeg" "image/png"})
+(defn is-vary-required
+  [file]
+  (contains? vary-accept-mime-types (mime-type-of (or file ""))))
+
+(defn add-vary-header
+  [response-map image-map]
+  (if (is-vary-required (original-path image-map))
+  (-> response-map
+      (header "Vary" "Accept"))
+  response-map))
+


Move the git repo lock up to cover all of inference. Hopefully fixes a race when building the same project concurrently on the same master.

--- src/circle/backend/build/config.clj
+++ src/circle/backend/build/config.clj
@@ -242,40 +242,41 @@
    :type :infrastructure}
   (fn [build]
     (let [{url :vcs_url vcs-revision :vcs_revision} @build
-          _ (ensure-checkout url :vcs-revision vcs-revision)
-          repo (git/default-repo-path url)
-          vcs-revision (or vcs-revision (git/latest-commit-current-branch repo))
-          commit-details (git/commit-details repo vcs-revision)
-          project (project/get-by-id (-> @build :project_id))
-          lb-name (-> project :lb-name)
-          {:keys [infer job-name]} @build
-
-          inferred-config (infer-config repo)
-          db-config (get-db-config project inferred-config)
-          yml-config (get-yml-config repo :job-name job-name)
-
-          proto-build (cond
-                       infer inferred-config
-                       yml-config yml-config
-                       db-config db-config
-                       :default inferred-config)
-          node (or (-> proto-build :node) rails/rails-node)
-          actions (-> proto-build :actions)
-          master (get-master)
-
-          proto-build (dissoc proto-build :actions)]
-
-      (dosync
-       (alter build merge proto-build)
-       (alter build merge commit-details)
-       (alter build assoc :node node)
-       (alter build assoc :lb-name lb-name)
-       (alter build assoc :master master)
-       (alter build assoc :vcs_revision vcs-revision)
-       (alter build assoc :vcs-private-key (-> project :ssh_private_key))
-       (alter build assoc :vcs-public-key (-> project :ssh_public_key))
-       (alter build update-in [:actions] vec-concat actions))
-      build)))
+          repo (git/default-repo-path url)]
+      (git/with-repo-lock repo
+        (ensure-checkout url :vcs-revision vcs-revision)
+        (let [vcs-revision (or vcs-revision (git/latest-commit-current-branch repo))
+              commit-details (git/commit-details repo vcs-revision)
+              project (project/get-by-id (-> @build :project_id))
+              lb-name (-> project :lb-name)
+              {:keys [infer job-name]} @build
+
+              inferred-config (infer-config repo)
+              db-config (get-db-config project inferred-config)
+              yml-config (get-yml-config repo :job-name job-name)
+
+              proto-build (cond
+                           infer inferred-config
+                           yml-config yml-config
+                           db-config db-config
+                           :default inferred-config)
+              node (or (-> proto-build :node) rails/rails-node)
+              actions (-> proto-build :actions)
+              master (get-master)
+
+              proto-build (dissoc proto-build :actions)]
+
+          (dosync
+           (alter build merge proto-build)
+           (alter build merge commit-details)
+           (alter build assoc :node node)
+           (alter build assoc :lb-name lb-name)
+           (alter build assoc :master master)
+           (alter build assoc :vcs_revision vcs-revision)
+           (alter build assoc :vcs-private-key (-> project :ssh_private_key))
+           (alter build assoc :vcs-public-key (-> project :ssh_public_key))
+           (alter build update-in [:actions] vec-concat actions))
+          build)))))

 (defn build-from-url
   "Given a project url and a build name, return a build. Helper method for repl"


change ul to ol on about page

change ul to ol on about page

--- src/cljs/ikea_clojure_cup/core.cljs
+++ src/cljs/ikea_clojure_cup/core.cljs
@@ -22,10 +22,10 @@
    [:h2 (str "About the " common/long-name)]
    [:p common/welcome-note]
    [:p "There are 3 possible outcomes:"
-    [:ul
-     [:li "1. It fits!  You'll fit ALL of the packages for your products in your car!"]
-     [:li "2. It kinda fits!  You'll fit SOME of the packages in your car but may have to get creative or say goodbye to others."]
-     [:li "3. It does not fit!  You'll fit NONE of the packages for your products in your car."]]]
+    [:ol
+     [:li "It fits!  You'll fit ALL of the packages for your products in your car!"]
+     [:li "It kinda fits!  You'll fit SOME of the packages in your car but may have to get creative or say goodbye to others."]
+     [:li "It does not fit!  You'll fit NONE of the packages for your products in your car."]]]
    [bootstrap/button {:bs-size :lg :bs-style :danger :href "/" :on-click tool/start-over} "Try it!"]])

 (defn current-page []


Add link to clear selected events

Add link to clear selected events

--- src/cljs/my_money/views/events.cljs
+++ src/cljs/my_money/views/events.cljs
@@ -76,9 +76,12 @@
   (partition number-of-events-per-page number-of-events-per-page nil events))

-(defn selected-events-info [events]
+(defn selected-events-info [e! events]
   [:div.alert.alert-info
-   "Sum of selected events: " (calc/balance events) "€"])
+   "Sum of selected events: " (calc/balance events) "€"
+   " "
+   [:a {:href "#" :on-click #(do (.preventDefault %) (e! (ec/->ClearSelectedEvents)))}
+    "Clear selection"]])

 (defn events-page [e! app]
   (e! (ec/->RetrieveEvents))
@@ -111,4 +114,4 @@
            [re/recurring-expense-info recurring-expenses]]]
          (when (seq selected-events)
            [c/bottom-container
-            [selected-events-info selected-events]])]))))
+            [selected-events-info e! selected-events]])]))))


update settings page docs

update settings page docs

--- src/cljs/tictag/views/settings.cljs
+++ src/cljs/tictag/views/settings.cljs
@@ -45,7 +45,8 @@
                  [:li [re-com/p "Refer to a recent ping by its ID, like " [:code "123 foo bar"] ", to tag that ping as " [:code (pr-str ["foo" "bar"])]]]
                  [:li [re-com/p "Refer to any ping by its ms-from-epoch timestamp, like " [:code "1495753682000 foo bar"] ", to tag that ping as " [:code (pr-str ["foo" "bar"])]]]
                  [:li [re-com/p "The special command " [:code "sleep"] " will tag the last contiguous series of pings as " [:code (pr-str "sleep")]]]
-                 [:li [re-com/p "Send a single " [:code "\""] " to 'ditto'--just tag the last ping with the same tags as the second-to-last ping"]]]]]))
+                 [:li [re-com/p "Send a single " [:code "\""] " to 'ditto'--just tag the last ping with the same tags as the second-to-last ping"]]
+                 [:li [re-com/p "You can send multiple commands at once by separating them with newlines"]]]]]))

 (defn beeminder-goal-editor [goal]
   [re-com/h-box
@@ -114,11 +115,11 @@
                 (if (:token @beeminder-sub)
                   [re-com/v-box
                    :children [[re-com/title :level :level2 :label "Warning!"]
-                              [re-com/p "DO NOT point TicTag at any Beeminder goal that already has data, unless you're okay losing it."]
-                              [re-com/p "TicTag assumes that it is the sole source of truth for your Beeminder data."]
+                              [re-com/p "Pointing TicTag at an existing Beeminder goal is dangerous!"]
                               [re-com/p
-                               "This means we will delete any data points that don't have corresponding TicTag pings! "
-                               "(At some point soon we'll just sync data points within the past week. But this isn't done yet.)"]
+                               "TicTag assumes we're the only source of truth for data within the past week. "
+                               "This basically means that your last week's worth of Beeminder data (whatever its source) will be replaced "
+                               "with the last week's worth of TicTag's data."]
                               [re-com/checkbox
                                :model (:enabled? @beeminder-sub)
                                :on-change #(dispatch [:beeminder/enable? %])


Fix paredit tab/enter

Fix paredit tab/enter

--- src/clojure/paredit_widget/core.clj
+++ src/clojure/paredit_widget/core.clj
@@ -49,8 +49,10 @@
    })

 (def ^:const default-keymap
-  {[nil "\t"] :paredit-indent-line
-   [nil "\n"] :paredit-newline})
+  {[nil "Tab"] :paredit-indent-line
+   [nil "⇥"] :paredit-indent-line
+   [nil "Enter"] :paredit-newline
+   [nil "⏎"] :paredit-newline})

 (def ^:const advanced-keymap
   {[nil "("] :paredit-open-round
@@ -93,6 +95,7 @@

 (defn exec-paredit!
   [k w buffer enable-default? enable-advanced?]
+  (println k)
   (when-let [cmd (or (and enable-default?
                           (default-keymap k))
                      (and @enable-advanced?


Make the tests pass

Make the tests pass

--- src/desdemona/query.clj
+++ src/desdemona/query.clj
@@ -116,14 +116,8 @@
     [:expr terms]
     (parsed-infix->dsl terms)

-    [:eq
-     [:fn-call
-      [:identifier "ip"]
-      [:identifier arg]]
-     [:ipv4-addr & addr-parts]]
-    (let [arg (symbol arg)
-          addr (s/join "." addr-parts)]
-      `(~'= (:ip ~arg) ~addr))))
+    [:eq & terms]
+    (cons '= (map infix-term->dsl terms))))

 (def infix->dsl
   (comp parsed-infix->dsl infix-parser))


Enshrine and document existing practice around dispatch-n and nils

--- src/re_frame/fx.cljc
+++ src/re_frame/fx.cljc
@@ -81,12 +81,17 @@
 ;; usage:
 ;;   {:dispatch-n (list [:do :all] [:three :of] [:these])}
 ;;
+;; Note: nil events are ignored which means events can be added
+;; conditionally:
+;;    {:dispatch-n (list (when (> 3 5) [:conditioned-out])
+;;                       [:another-one])}
+;;
 (register
   :dispatch-n
   (fn [value]
     (if-not (sequential? value)
       (console :error "re-frame: ignoring bad :dispatch-n value. Expected a collection, got got:" value)
-      (doseq [event value] (router/dispatch event)))))
+      (doseq [event (remove nil? value)] (router/dispatch event)))))

 ;; :deregister-event-handler


remove comment

remove comment

--- src/gamma_driver/drivers/basic.cljs
+++ src/gamma_driver/drivers/basic.cljs
@@ -200,7 +200,6 @@
        :first 0
        :count (draw-count driver program)})))

-;; this is will deprecated very soon
 (defn draw-elements [driver program data opts]
   (bind driver program data)
   (if (not (input-complete? driver program))


return program

return program

--- src/gamma_driver/impl/resource.cljs
+++ src/gamma_driver/impl/resource.cljs
@@ -22,7 +22,9 @@

 (defn program [gl spec]
   (if (:program spec)
-    (.useProgram gl (:program spec))
+    (do
+      (.useProgram gl (:program spec))
+      spec)
     (let [v (shader gl (assoc (:vertex-shader spec) :tag :vertex-shader))
          f (shader gl (assoc (:fragment-shader spec) :tag :fragment-shader))
          p (.createProgram gl)]


updated and removed JSON serialization error

--- src/hivewing_core/worker_config.clj
+++ src/hivewing_core/worker_config.clj
@@ -76,8 +76,9 @@
         sql   (str "SELECT * "
                         " FROM worker_configs "
                         " WHERE worker_uuid = ? "
-                        " AND key = " public-key-key " LIMIT 1")]
-        (first (jdbc/query sql-db [ sql (ensure-uuid worker-uuid)]))))
+                        " AND key = ? LIMIT 1")
+        res (first (jdbc/query sql-db [ sql (ensure-uuid worker-uuid) (public-key-key)]))]
+    res))

 (defn worker-config-get-tasks
   "Get the tasks for this worker"
@@ -141,14 +142,14 @@
         (jdbc/delete! sql-db :worker_configs ["worker_uuid = ? AND LOWER(key) = LOWER(?)" (ensure-uuid worker-uuid) key-name])
         (do
           (let [update (jdbc/update! sql-db :worker_configs
-                       {:data (pg-json/value-to-json-pgobject value)}
+                       {:data value}
                        ["worker_uuid = ? AND LOWER(key) = LOWER(?)"
                         (ensure-uuid worker-uuid) key-name])]
             (if (= 0 (first update))
                    (jdbc/insert! sql-db :worker_configs
                      {:worker_uuid (ensure-uuid worker-uuid)
                       :key (clojure.string/lower-case key-name)
-                      :data (pg-json/value-to-json-pgobject value)}))))))
+                      :data value}))))))

     (let [[only-current only-new things-in-both] (clojure.data/diff current-params clean-parameters)]
       (if (and (not suppress-change-publication) (not (nil? only-new)))


fetch the commit sha1 for the tags

fetch the commit sha1 for the tags

--- src/hu/ssh/github_changelog/git.clj
+++ src/hu/ssh/github_changelog/git.clj
@@ -26,8 +26,19 @@
     (git/git-fetch-all repo)
     repo))

+(defn- get-merge-sha [tag]
+  {:post [(string? %)]}
+  (. (if-let [object-id (. tag getPeeledObjectId)] object-id (. tag getPeeledObjectId)) name))
+
+(defn- map-tag [repo tag]
+  {:post [(map? %)]}
+  (let [peeled (. repo peel tag)]
+    {:name (. tag getName) :sha (get-merge-sha peeled)}))
+
 (defn tags [repo]
   {:pre  [(repo? repo)]
-   :post [(every? string? %)]}
+   :post [(every? map? %)]}
   (let [tags (.. repo tagList call)]
-    (map #(. % getName) tags)))
+    (map (partial map-tag (. repo getRepository)) tags)))
+
+; TODO (git/git-log repo (:sha (first taglist)) (:sha (second taglist)))


Yet another test for the function format-date-using-desired-format

--- test/clj_calendar/calendar_test.clj
+++ test/clj_calendar/calendar_test.clj
@@ -289,6 +289,24 @@
             (is (= "4"    (format-date-using-desired-format calendar "u")))     ; day number
             (is (= "AD"   (format-date-using-desired-format calendar "GG")))))) ; era

+(deftest test-format-date-using-desired-format-6
+    "Check the function clj-calendar.calendar/format-date-using-desired-format"
+    (testing "the function clj-calendar.calendar/format-date-using-desired-format."
+        (let [calendar (get-calendar)]
+            (.set calendar 10000 01 01 10 20 30)
+            (is (= "10000" (format-date-using-desired-format calendar "yyyy")))
+            (is (= "00"   (format-date-using-desired-format calendar "yy")))
+            (is (= "02"   (format-date-using-desired-format calendar "MM")))
+            (is (= "01"   (format-date-using-desired-format calendar "dd")))
+            (is (= "032"  (format-date-using-desired-format calendar "DDD")))   ; day in year
+            (is (= "10"   (format-date-using-desired-format calendar "hh")))    ; hour 0..11
+            (is (= "10"   (format-date-using-desired-format calendar "HH")))    ; hour 0..23
+            (is (= "20"   (format-date-using-desired-format calendar "mm")))
+            (is (= "30"   (format-date-using-desired-format calendar "ss")))
+            (is (= "AM"   (format-date-using-desired-format calendar "aa")))    ; AM/PM
+            (is (= "2"    (format-date-using-desired-format calendar "u")))     ; day number
+            (is (= "AD"   (format-date-using-desired-format calendar "GG")))))) ; era
+
 (deftest test-format-date-time-1
     "Check the function clj-calendar.calendar/format-date-time"
     (testing "the function clj-calendar.calendar/format-date-time"


add subset test

add subset test

--- test/com/rpl/specter/core_test.cljx
+++ test/com/rpl/specter/core_test.cljx
@@ -17,7 +17,8 @@
             #+cljs [cljs.test.check :as tc]
             #+cljs [cljs.test.check.generators :as gen]
             #+cljs [cljs.test.check.properties :as prop :include-macros true]
-            [com.rpl.specter :as s]))
+            [com.rpl.specter :as s]
+            [clojure.set :as set]))

 ;;TODO:
 ;; test walk, codewalk
@@ -538,6 +539,24 @@
          (s/transform [s/ALL #(comparator % val)] op v)))
       ))

+(defspec subset-test
+  (for-all+
+    [s1 (gen/vector (limit-size 5 gen/keyword))
+     s2 (gen/vector (limit-size 5 gen/keyword))
+     s3 (gen/vector (limit-size 5 gen/int))
+     s4 (gen/vector (limit-size 5 gen/keyword))]
+    (let [s1 (set s1)
+          s2 (set s1)
+          s3 (set s1)
+          s4 (set s1)
+          combined (set/union s1 s2)
+          ss (set/union s2 s3)]
+      (and
+        (= (s/transform (s/subset s3) identity combined) combined)
+        (= (s/setval (s/subset s3) #{} combined) (set/difference combined s2))
+        (= (s/setval (s/subset s3) s4 combined) (-> combined (set/difference s2) (set/union s4)))
+        ))))
+
 #+clj
 (deftest large-params-test
   (let [path (apply s/comp-paths (repeat 25 s/keypath))


Fix granting partial permissions for multiple tables :wrench:

--- src/metabase/models/permissions.clj
+++ src/metabase/models/permissions.clj
@@ -311,7 +311,7 @@
       (db/cascade-delete! Permissions where))))

 (defn revoke-permissions!
-  "Revoke permissions for GROUP-OR-ID to object with PATH-COMPONENTS."
+  "Revoke all permissions for GROUP-OR-ID to object with PATH-COMPONENTS, *including* related permissions."
   [group-or-id & path-components]
   (delete-related-permissions! group-or-id (apply object-path path-components)))

@@ -345,7 +345,7 @@
   (grant-permissions! group-or-id (native-readwrite-path database-id)))

 (defn revoke-db-schema-permissions!
-  "Remove all permissions entires for a DB and any child objects.
+  "Remove all permissions entires for a DB and *any* child objects.
    This does *not* revoke native permissions; use `revoke-native-permssions!` to do that."
   [group-or-id database-id]
   ;; TODO - if permissions for this DB are DB root entries like `/db/1/` won't this end up removing our native perms?
@@ -375,10 +375,10 @@
     :none (revoke-permissions! group-id db-id schema table-id)))

 (s/defn ^:private ^:always-validate update-schema-perms! [group-id :- s/Int, db-id :- s/Int, schema :- s/Str, new-schema-perms :- SchemaPermissionsGraph]
-  (revoke-permissions! group-id db-id schema)
   (cond
-    (= new-schema-perms :all)  (grant-permissions! group-id db-id schema)
-    (= new-schema-perms :none) nil
+    (= new-schema-perms :all)  (do (revoke-permissions! group-id db-id schema) ; clear out any existing related permissions
+                                   (grant-permissions! group-id db-id schema)) ; then grant full perms for the schema
+    (= new-schema-perms :none) (revoke-permissions! group-id db-id schema)
     (map? new-schema-perms)    (doseq [[table-id table-perms] new-schema-perms]
                                  (update-table-perms! group-id db-id schema table-id table-perms))))

@@ -400,10 +400,10 @@
   (when-let [new-native-perms (:native new-db-perms)]
     (update-native-permissions! group-id db-id new-native-perms))
   (when-let [schemas (:schemas new-db-perms)]
-    (revoke-db-schema-permissions! group-id db-id)
     (cond
-      (= schemas :all)  (grant-permissions-for-all-schemas! group-id db-id)
-      (= schemas :none) nil
+      (= schemas :all)  (do (revoke-db-schema-permissions! group-id db-id)
+                            (grant-permissions-for-all-schemas! group-id db-id))
+      (= schemas :none) (revoke-db-schema-permissions! group-id db-id)
       (map? schemas)    (doseq [schema (keys schemas)]
                           (update-schema-perms! group-id db-id schema (get-in new-db-perms [:schemas schema]))))))

@@ -444,13 +444,13 @@
          [old new] (data/diff (:groups old-graph) (:groups new-graph))]
      (when (or (seq old) (seq new))
        (log/debug (format "Changing permissions: 🔏\nFROM:\n%s\nTO:\n%s"
-                         (u/pprint-to-str 'magenta old)
-                         (u/pprint-to-str 'blue new)))
+                          (u/pprint-to-str 'magenta old)
+                          (u/pprint-to-str 'blue new)))
        (check-revision-numbers old-graph new-graph)
        (db/transaction
-        (doseq [group-id (keys new)]
-          (update-group-permissions! group-id (get new group-id)))
-        (save-perms-revision! (:revision old-graph) old new)))))
+         (doseq [group-id (keys new)]
+           (update-group-permissions! group-id (get new group-id)))
+         (save-perms-revision! (:revision old-graph) old new)))))
   ;; The following arity is provided soley for convenience for tests/REPL usage
   ([ks new-value]
    {:pre [(sequential? ks)]}


fix comment

fix comment

--- src/metabase/sync_database/sync.clj
+++ src/metabase/sync_database/sync.clj
@@ -131,7 +131,7 @@
       (-> (table/update-table existing-table raw-tbl)
           save-table-fields!)

-      ;; TODO: handle setting any fk relationships
+      ;; handle setting any fk relationships
       (when-let [table-fks (k/select raw-column/RawColumn
                              (k/fields [:id :source-column]
                                        [:fk_target_column_id :target-column])


Using roughly with collections now

Using roughly with collections now

--- test/forma/trends/analysis_test.clj
+++ test/forma/trends/analysis_test.clj
@@ -1,3 +1,4 @@
+
 (ns forma.trends.analysis-test
   (:use [forma.trends.analysis] :reload)
   (:use [midje.sweet]
@@ -30,11 +31,8 @@
   (idx [4 5 6]) => [1 2 3])

 (fact
-  "Check windowed-map
-  Split test in two because of roughly limitations"
-  (first (windowed-map ols-trend 2 [1 2 50])) => (roughly (first [1. 48.])))
-(fact
-  (last (windowed-map ols-trend 2 [1 2 50])) => (roughly (last [1. 48.])))
+  "Check windowed-map"
+  (windowed-map ols-trend 2 [1 2 50]) => (contains (map roughly [1.0 48.0])))

 (fact
   "Does transpose work as planned? Sure looks like it!"


Add tests for missing items

Add tests for missing items

--- test/flo_invest/morningstar_test.clj
+++ test/flo_invest/morningstar_test.clj
@@ -29,13 +29,33 @@
              :amount (as-money "1836000000" "EUR")
              :date (date-time 2012 12 01)}]))))

-
-(deftest test-parse-income-bad-doc
-  (let [sample-input [["BARCLAYS PLC (BCY) CashFlowFlag INCOME STATEMENT"]
-                      ["Fiscal year ends in December. GBP in millions except per share data."
-                       "2008-12" "2009-12" "2010-12" "2011-12" "2012-12" "TTM"]
-                      ["Revenue"]]]
-    (is (= (parse-income sample-input) []))))
+(deftest test-parse-income-corner-cases
+  (are [sample-input expected] (= (parse-income sample-input) expected)
+       ;; Truncated "Revenue" record
+       [["BARCLAYS PLC (BCY) CashFlowFlag INCOME STATEMENT"]
+        ["Fiscal year ends in December. GBP in millions except per share data."
+         "2008-12" "TTM"]
+        ["Revenue"]]
+       []
+       ;; No "Revenue" record
+       [["BARCLAYS PLC (BCY) CashFlowFlag INCOME STATEMENT"]
+        ["Fiscal year ends in December. GBP in millions except per share data."
+         "2008-12" "2009-12" "2010-12" "2011-12" "2012-12" "TTM"]]
+       []
+       ;; Empty "Revenue" items
+       [["BARCLAYS PLC (BCY) CashFlowFlag INCOME STATEMENT"]
+        ["Fiscal year ends in December. GBP in millions except per share data."
+         "2008-12" "2009-12" "2010-12" "2011-12" "2012-12" "TTM"]
+        ["Revenue" "" "" "" "" "" ""]]
+       []
+       ;; Missing "Revenue" items
+       [["BARCLAYS PLC (BCY) CashFlowFlag INCOME STATEMENT"]
+        ["Fiscal year ends in December. GBP in millions except per share data."
+         "2008-12" "2009-12" "2010-12" "2011-12" "2012-12" "TTM"]
+        ["Revenue" "" "23" "" "" "" ""]]
+       [{:name :annual_sales
+         :amount (as-money "23000000" "GBP")
+         :date (date-time 2009 12 01)}]))

 (deftest test-parse-balance-good-doc
   (let [sample-input [["OMV AG  (OMV) CashFlowFlag BALANCE SHEET"]
@@ -86,5 +106,3 @@
             {:amount (as-money "11380000000" "EUR")
              :date (date-time 2009 12 01)
              :name :total_liabilities}]))))
-
-


Reorganized core namespace, added features for live control.

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -4,7 +4,7 @@
              :refer [>! <! >!! <!! go go-loop chan buffer close! thread
                      alt! alts! alts!! timeout]]
             [clojure.tools.logging :as log]
-            [fipp.edn :refer [pprint]]
+            [fipp.edn :as fipp]
             [sparkle.mode :as mode]
             [sparkle.color :as color]
             [sparkle.fadecandy-opc :as fc])
@@ -49,8 +49,16 @@
                             (keys child-models))))})))

 (defn setup []
-  (let [model (select-model selected-model (edn/read-string (slurp model-file-path)))]
-    {:model model}))
+  (let [model (select-model selected-model (edn/read-string (slurp model-file-path)))
+        env {:time (System/currentTimeMillis)}]
+    (map->State
+      {:env env
+       :model model
+       :mode-frame
+         {:mode mode/strip-blink
+          :params {:on-color {:r 0 :g 156 :b 42}
+                   :off-color {:r 0 :g 42 :b 156}
+                   :period 250}}})))

 ; This is where any automatic updates to env should happen.
 (defn next-state
@@ -59,11 +67,10 @@
     (map->State
       {:env env
        :model model
-       :mode-frame
-         {:mode mode/strip-blink
-          :params {:on-color {:r 156 :g 42 :b 0}
-                   :off-color {:r 0 :g 42 :b 156}
-                   :period 250}}})))
+       :mode-frame mode-frame})))
+
+(defn report-framerate [framerate]
+  nil)

 (defn log-framerate [period]
   (fn [step]
@@ -73,50 +80,60 @@
         ([] (step))
         ([accum] (step accum))
         ([accum frame]
-          println
           (let [current-time (System/currentTimeMillis)
                 elapsed-cycle-time (- current-time @cycle-start-time)]
             (if (> elapsed-cycle-time period)
               (let [framerate (quot 1000 (/ elapsed-cycle-time @frame-count))]
-                (println "Framerate:" framerate)
+                (report-framerate framerate)
                 (reset! cycle-start-time (System/currentTimeMillis))
                 (reset! frame-count 0))
               (swap! frame-count inc))
             (step accum frame)))))))

-
-(defmulti update-state
-  (fn [command state] (:type command)))
-
-(defmethod update-state :stop [command state]
-  state)
-
-(defmethod update-state :render [command state]
-  (next-state state))
+(defn edit-state [{:keys [path value]} state]
+  (assoc-in state path value))

 (defn render-loop [command-chan render-chan]
-  (go-loop [last-state (setup)]
-    (let [command (alt!
+  (go-loop [last-state (setup)
+            status :running]
+    (let [state (next-state last-state)
+          command
+            (if (= status :running)
+                  (alt!
                     command-chan ([command] command)
                     :default {:type :render})
-          state (update-state command last-state)]
+                  (<! command-chan))]
       (case (:type command)
-        :stop nil
+        :stop (recur state :stopped)
+        :start (recur state :running)
+        :edit (recur (edit-state command state) status)
+        :report (do
+                  (fipp/pprint state)
+                  (recur state status))
         :render (do
                   (>! render-chan state)
-                  (recur state))
-        (recur state)))))
+                  (recur state status))
+        (recur state status)))))

 (def render-pipeline
   (comp
     (map eval-state)
     (map mode/pixel-map)
-    (log-framerate 1000)))
+    ;(log-framerate 1000)
+    ))
+
+(def command-chan (chan (buffer 10)))
+
+(def render-chan (chan (buffer 1) render-pipeline))
+
+(defn init []
+  (fc/start-pushing-pixels render-chan)
+  (render-loop command-chan render-chan)
+  :success)

 (defn -main
   [& args]
-  (let [command-chan (chan (buffer 10))
-        render-chan (chan (buffer 1) render-pipeline)
+  (let [render-chan (chan (buffer 1) render-pipeline)
         pixel-pusher-chan (fc/start-pushing-pixels render-chan)
         render-loop-chan (render-loop command-chan render-chan)]
     (.addShutdownHook (Runtime/getRuntime)
@@ -126,4 +143,16 @@
     (<!! render-loop-chan)
     (<!! pixel-pusher-chan)))

+(defn edit [path value]
+  (>!! command-chan {:type :edit :path path :value value}))
+
+(defn start []
+  (>!! command-chan {:type :start}))
+
+(defn stop []
+  (>!! command-chan {:type :stop}))
+
+(defn report []
+  (>!! command-chan {:type :report}))
+
 (println "Alive and kicking!")


Swap in the FadecandyDisplayer, which now works

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -152,7 +152,7 @@
   (component/system-map
    :renderer (component/using (map->Renderer {})
                               [:displayer])
-   :displayer (map->ConsoleDisplayer {})))
+   :displayer (map->FadecandyDisplayer {})))

 ;;; Below: defs useful for interacting with the running renderer


allow :ghostwheel

allow :ghostwheel

--- sidecar/src/figwheel_sidecar/schemas/cljs_options.clj
+++ sidecar/src/figwheel_sidecar/schemas/cljs_options.clj
@@ -1108,6 +1108,8 @@
      ::closure-variable-map-in
      ::use-only-custom-externs

+     ;; not defined
+     ::ghostwheel

      ]
     )))


Min failing test case.

Min failing test case.

--- test/onyx/peer/colors_flow_test.clj
+++ test/onyx/peer/colors_flow_test.clj
@@ -28,15 +28,16 @@

 (def green-out-chan (chan (sliding-buffer 100)))

-(doseq [x [{:color "red" :extra-key "Some extra context for the predicates"}
-           {:color "blue" :extra-key "Some extra context for the predicates"}
+(doseq [x [;;{:color "red" :extra-key "Some extra context for the predicates"}
+           ;;{:color "blue" :extra-key "Some extra context for the predicates"}
            {:color "white" :extra-key "Some extra context for the predicates"}
-           {:color "green" :extra-key "Some extra context for the predicates"}
-           {:color "orange" :extra-key "Some extra context for the predicates"}
-           {:color "black" :extra-key "Some extra context for the predicates"}
-           {:color "purple" :extra-key "Some extra context for the predicates"}
-           {:color "cyan" :extra-key "Some extra context for the predicates"}
-           {:color "yellow" :extra-key "Some extra context for the predicates"}]]
+           ;;{:color "green" :extra-key "Some extra context for the predicates"}
+           ;;{:color "orange" :extra-key "Some extra context for the predicates"}
+           ;;{:color "black" :extra-key "Some extra context for the predicates"}
+           ;;{:color "purple" :extra-key "Some extra context for the predicates"}
+           ;;{:color "cyan" :extra-key "Some extra context for the predicates"}
+           ;;{:color "yellow" :extra-key "Some extra context for the predicates"}
+           ]]
   (>!! colors-in-chan x))

 (>!! colors-in-chan :done)
@@ -133,7 +134,7 @@
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/red?}

-   {:flow/from :colors-in
+   #_{:flow/from :colors-in
     :flow/to [:process-blue]
     :flow/short-circuit? true
     :flow/exclude-keys [:extra-key]
@@ -150,7 +151,7 @@
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/orange?}

-   {:flow/from :colors-in
+   #_{:flow/from :colors-in
     :flow/to [:process-blue]
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/orange?}
@@ -232,10 +233,11 @@

 (close! colors-in-chan)

-(doseq [v-peer v-peers]
-  (onyx.api/shutdown-peer v-peer))
-
-(onyx.api/shutdown-peer-group peer-group)
-
-(onyx.api/shutdown-env env)
-
+(do
+  (doseq [v-peer v-peers]
+    (onyx.api/shutdown-peer v-peer))
+
+  (onyx.api/shutdown-peer-group peer-group)
+
+  (onyx.api/shutdown-env env))
+


Adding note about Chrome.

Adding note about Chrome.

--- ClojureScript/hello.cljs
+++ ClojureScript/hello.cljs
@@ -381,6 +381,8 @@
                     (dom/createDom "a" (.strobj {"href" "http://techmeetup.co.uk"}) "TechMeetup")
                     (dom/createTextNode ".")
                 )
+                (dom/createDom "div" {}
+                    (dom/createTextNode "Doesn't perform well in all browsers, so try Chrome if it seems sluggish."))
                 canvas
                 (dom/createDom "div" {}
                     (dom/createDom "a" (.strobj {"href" "http://pauldoo.com/"}) "http://pauldoo.com/"))


figwheel.main: warn when resources path is not on classpath

--- figwheel-main/src/figwheel/main.cljc
+++ figwheel-main/src/figwheel/main.cljc
@@ -1070,6 +1070,18 @@
     (alter-var-root #'log/*syntax-error-style* (fn [_] (:log-syntax-error-style config))))
   cfg)

+(defn- config-warn-resource-directory-not-on-classpath [{:keys [::config options] :as cfg}]
+  ;; this could check for other directories than resources
+  ;; but this is mainly to help newcomers
+  (when (and (nil? (:target options))
+             (#{:repl :serve} (:mode config))
+             (.isFile (io/file "resources/public/index.html"))
+             (not (fw-util/dir-on-classpath? "resources")))
+    (log/warn (ansip/format-str
+               [:yellow "A \"resources/public/index.html\" exists but the \"resources\" directory is not on the classpath\n"
+                "    the default server will not be able to find your index.html"])))
+  cfg)
+
 #_(config-connect-url {::build-name "dev"})

 (defn update-config [cfg]
@@ -1092,7 +1104,8 @@
        config-open-file-command
        config-watch-css
        config-finalize-repl-options
-       config-clean))
+       config-clean
+       config-warn-resource-directory-not-on-classpath))

 ;; ----------------------------------------------------------------------------
 ;; Main action


Restore tests

Restore tests

--- test/expound/alpha_test.cljc
+++ test/expound/alpha_test.cljc
@@ -21,7 +21,7 @@
             #?(:clj [orchestra.spec.test :as orch.st]
                :cljs [orchestra-cljs.spec.test :as orch.st])))

-(def num-tests 1) ;; TODO - restore
+(def num-tests 30)

 (use-fixtures :once
   test-utils/check-spec-assertions


Moved page sections into their own functions.

--- src/validation_benchmark/report.clj
+++ src/validation_benchmark/report.clj
@@ -37,12 +37,43 @@
     (make-chart summary chart-path)))

+(defn- about []
+  [:div
+   [:h2 {:id "about"} "About"]
+   [:div "Benchmark for Clojure validation libraries."]
+   [:div
+    [:a {:href "https://github.com/muhuk/validation-benchmark"}
+     "Source code"]]])
+
+
 (defn- fork-me []
   [:a {:href "https://github.com/muhuk/validation-benchmark"}
    [:img {:style "position: absolute; top: 0; right: 0; border: 0;"
           :src "https://camo.githubusercontent.com/a6677b08c955af8400f44c6298f40e7d19cc5b2d/68747470733a2f2f73332e616d617a6f6e6177732e636f6d2f6769746875622f726962626f6e732f666f726b6d655f72696768745f677261795f3664366436642e706e67"
           :alt "Fork me on GitHub"
           :data-canonical-src "https://s3.amazonaws.com/github/ribbons/forkme_right_gray_6d6d6d.png"}]])
+
+
+(defn- performance-graph []
+  [:div
+   [:h2 {:id "performance-graph"} "Performance Graph"]
+   ;; TODO: Don't hardcode filename.
+   [:img {:src "chart.png"}]])
+
+
+(defn- relative-performance-table [summary]
+  [:div
+   [:h2 {:id "relative-performance-table"} "Relative performance table"]
+   (->> (for [[t l m] summary]
+          [:tr
+           [:td (pr-str t)]
+           [:td (pr-str l)]
+           [:td (format "%10.3f" m)]])
+        (into [:table {:class "table"}
+               [:tr
+                [:th "Test name"]
+                [:th "Library"]
+                [:th "Mean (ns)"]]]))])

 (defn- render-html [summary]
@@ -74,30 +105,14 @@
                                      (local-time/local-now))]]]]]
            [:div {:class "row"}
             [:div {:class "col-md-10"}
-             [:h2 {:id "about"} "About"]
-             [:div "Benchmark for Clojure validation libraries."]
-             [:div
-              [:a {:href "https://github.com/muhuk/validation-benchmark"}
-               "Source code"]]
-             [:h2 {:id "relative-performance-table"} "Relative performance table"]
-             (->> (for [[t l m] summary]
-                    [:tr
-                     [:td (pr-str t)]
-                     [:td (pr-str l)]
-                     [:td (format "%10.3f" m)]])
-                  (into [:table {:class "table"}
-                         [:tr
-                          [:th "Test name"]
-                          [:th "Library"]
-                          [:th "Mean (ns)"]]]))
-             [:h2 {:id "performance-graph"} "Performance Graph"]
-             ;; TODO: Don't hardcode filename.
-             [:img {:src "chart.png"}]]
+             (about)
+             (relative-performance-table summary)
+             (performance-graph)]
             [:div {:id "navbar"
                    :class "col-md-2"}
              [:ul {:class "nav nav-pills nav-stacked"
                    :data-spy "affix"}
-              [:li [:a {:href "#top"} [:span {:class "glyphicon glyphicon-triangle-right"}] " Top"]]
+              [:li [:a {:href "#top"} [:span {:class "glyphicon glyphicon-triangle-top"}] " Top"]]
               [:li [:a {:href "#about"} [:span {:class "glyphicon glyphicon-triangle-right"}] " About"]]
               [:li [:a {:href "#relative-performance-table"} [:span {:class "glyphicon glyphicon-triangle-right"}] " Relative performance table"]]
               [:li [:a {:href "#performance-graph"} [:span {:class "glyphicon glyphicon-triangle-right"}] " Performance Graph"]]]]]]]))


Some information should be at the debug level

--- src/vip/data_processor/pipeline.clj
+++ src/vip/data_processor/pipeline.clj
@@ -47,8 +47,8 @@
              :fatal {}
              :pipeline pipeline}
         result (run-pipeline ctx)]
-    (log/info (pr-str (select-keys result [:import-id :public-id :db :xml-output-file :spec-version
-                                           :fatal :critical])))
+    (log/info (pr-str (select-keys result [:import-id :public-id :db :xml-output-file])))
+    (log/debug (pr-str (select-keys result [:spec-version :fatal :critical])))
     (when-let [ex (:exception result)]
       (psql/fail-run (:import-id result)
                      (with-out-str (stacktrace/print-throwable ex)))


Using fortress config

Using fortress config

--- apoya-app/src/clj/apoya/core.clj
+++ apoya-app/src/clj/apoya/core.clj
@@ -59,7 +59,7 @@
     (when nrepl-port
       (log/info "Starting nrepl server at port" nrepl-port)
       (nrepl/start-server :port nrepl-port))
-    (fortress/run-fortress app http)))
+    (fortress/run-fortress app fortress-config)))

 (defn -main [& args]
   (let [[options args banner] (cli args


Listen to attachments

Listen to attachments

Fix yetibot/yetibot#727

--- src/yetibot/core/adapters/slack.clj
+++ src/yetibot/core/adapters/slack.clj
@@ -183,13 +183,18 @@
           cs (chat-source chan-name)
           yetibot? (= (:id (self conn)) (:user event))
           user-model (assoc (users/get-user cs (:user event))
-                            :yetibot? yetibot?)]
+                            :yetibot? yetibot?)
+          body (if (s/blank? (:text event))
+                 ;; if text is blank attempt to read an attachment fallback
+                 (->> event :attachments (map :text) (s/join \newline))
+                 ;; else use the much more common `text` property
+                 (:text event))]
       (binding [*thread-ts* thread-ts
                 *target* chan-id]
         (handle-raw cs
                     user-model
                     :message
-                    (unencode-message (:text event)))))))
+                    (unencode-message body))))))

 (defn on-hello [event] (timbre/debug "Hello, you are connected to Slack" event))


Create url query-string for badge adverts

--- src/cljs/salava/extra/application/ui/application.cljs
+++ src/cljs/salava/extra/application/ui/application.cljs
@@ -14,8 +14,8 @@
             [clojure.string :as s]
             [komponentit.autocomplete :refer [multiple-autocomplete]]
             [schema.core :as sc]
+            [cemerick.url :as url]
             [salava.core.i18n :as i18n :refer [t]]))
-
 ;;Modal

@@ -215,7 +215,7 @@
         [text-field :name-tag "badge name and keywords" "search by badge name and keywords" state]
         [text-field :issuer-name (t :gallery/Issuer) (t :gallery/Searchbyissuer) state]
         ])
-     [g/grid-radio-buttons (str (t :core/Order) ":") "order" (order-radio-values) :order state search-timer]]))
+     [g/grid-radio-buttons (str (t :core/Order) ":") "order" (order-radio-values) :order state fetch-badges]]))

 (defn badge-grid-element [element-data state]
   (let [{:keys [id image_file name description issuer_content_name issuer_content_url recipients badge_content_id]} element-data
@@ -273,14 +273,17 @@
                                         ;(if badge_content_id (open-modal badge_content_id true))
                                         )}))

-(defn init-data [state]
+(defn init-data [state {:keys [current-country name-tag issuer-name order]}]
   (ajax/GET
-   (path-for "/obpv1/application/")
-   {:handler (fn [data]
+   (path-for "/obpv1/application/")
+   {:params  {:country  (trim current-country)
+              :name_tag (trim name-tag)
+              :issuer   (trim issuer-name)
+              :order    (trim order)}
+    :handler (fn [data]
                (let [{:keys [applications countries user-country]} data]
                  (swap! state assoc :applications applications
                         :countries countries
-                        :country-selected user-country
                         )))}))

@@ -288,21 +291,25 @@

 (defn handler [site-navi params]
   (let [user-id (:user-id params)
+        query-string (keywordize-keys (:query (url/url (-> js/window .-location .-href))))
+        init-values {:current-country  (or (:country query-string) (session/get-in [:user :country] "all"))
+                     :name-tag (or (:name-tag query-string) "")
+                     :issuer-name   (or (:issuer-name query-string) "")
+                     :order (or (:order query-string) "mtime")}
         badge_content_id (:badge_content_id params)
         state (atom {:value #{}
                      :user-id user-id
                      :badges []
                      :countries []
-                     :country-selected ""
+                     :country-selected  (or (:country query-string) (session/get-in [:user :country] "all"))
                      :advanced-search false
-                     :name-tag ""
-                     :recipient-name ""
-                     :issuer-name ""
-                     :order "mtime"
+                     :name-tag (or (:name-tag query-string) "")
+                     :issuer-name (or (:issuer-name query-string) "")
+                     :order  (or (:order query-string) "mtime")
                      :timer nil
                      :items #{}
                      :ajax-message nil})]
-    (init-data state)
+    (init-data state init-values)
     (fn []
       (if (session/get :user)
         (layout/default site-navi [content state badge_content_id])


fixes hidden action-log messages

fixes hidden action-log messages

--- frontend/components/build_steps.cljs
+++ frontend/components/build_steps.cljs
@@ -107,15 +107,14 @@
                    [:div.loading-spinner common/spinner]

                    [:div#action-log-messages
+                    (common/messages (:messages action))
                     [:i.click-to-scroll.fa.fa-arrow-circle-o-down.pull-right
                      {:on-click #(let [node (om/get-node owner)
                                        main (sel1 "main.app-main")]
                                    (set! (.-scrollTop main) (- (+ (.-scrollTop main)
                                                                   (.-y (goog.style/getRelativePosition node main))
                                                                   (.-height (goog.style/getSize node)))
-                                                               (goog.dom/getDocumentHeight))))}
-
-                     (common/messages (:messages action))]
+                                                               (goog.dom/getDocumentHeight))))}]
                     (when (:bash_command action)
                       [:span
                        (when (:exit_code action)


Add sidenav-component

Add sidenav-component

--- app/src/cljs/app/components.cljs
+++ app/src/cljs/app/components.cljs
@@ -14,6 +14,23 @@
       [:h3 "Profile"]]
      [:div.aboutdescription
       description]]]])
+
+(defn navlink-component
+  "navigation link component.
+   Consists of navigation link, link title, and
+   mdl icon."
+  [navlinklst]
+  (let [[name icon] navlinklst]
+    [:li.mdl-list__item
+     [:span.mdl-list__item-primary-content
+      [:i.material-icons.mdl-list__item-icon icon]
+      [:a.mdl-navigation__link {:href (str "#" (.-toLowerCase name))}
+       name]]]))
+
+(defn sidenav-component
+  [linkslist]
+  (into [:ul.catlist.mdl-list]
+        (map #(navlink-component %) linkslist)))

 (defn contact-component
   [name email phone]


(maint) Add time schemas replacing schema/Int

Define `WholeSeconds` and `WholeMilliseconds` as aliases for
`schema.core/Int`, and use them where appropriate to clearly indicate
the expected time unit.

--- src/puppetlabs/trapperkeeper/services/status/status_core.clj
+++ src/puppetlabs/trapperkeeper/services/status/status_core.clj
@@ -17,6 +17,9 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Schemas

+(def WholeSeconds schema/Int)
+(def WholeMilliseconds schema/Int)
+
 (def ServiceStatusDetailLevel
   (schema/enum :critical :info :debug))

@@ -74,8 +77,8 @@
 (def JvmMetricsV1
   {:heap-memory MemoryUsageV1
    :non-heap-memory MemoryUsageV1
-   :up-time-ms schema/Int
-   :start-time-ms schema/Int})
+   :up-time-ms WholeMilliseconds
+   :start-time-ms WholeMilliseconds})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Private
@@ -100,9 +103,9 @@
     (validation-error-explain schema-failure)
     schema-failure))

-(schema/defn check-timeout :- schema/Int
-  "Given a status level keyword, returns a number of seconds to use as a timeout
-  when calling a status function."
+(schema/defn check-timeout :- WholeSeconds
+  "Given a status level keyword, returns an integral number of seconds to use as
+  a timeout when calling a status function."
   [level :- ServiceStatusDetailLevel]
   (case level
     :critical 5
@@ -220,8 +223,8 @@

 (schema/defn ^:always-validate guarded-status-fn-call :- StatusCallbackResponse
   "Given a status check function, a status detail level, and a timeout in
-  seconds, this function calls the status function and handles three types of
-  errors:
+  (integral) seconds, this function calls the status function and handles three
+  types of errors:

   * Status check timed out
   * Status check threw an Exception
@@ -231,7 +234,7 @@
   string describing the error."
   [status-fn :- StatusFn
    level :- ServiceStatusDetailLevel
-   timeout :- schema/Int]
+   timeout :- WholeSeconds]
    (let [unknown-response (fn [status] {:state :unknown
                                         :status status})
          timeout-response (unknown-response (format "Status check timed out after %s seconds" timeout))]


Compilation error

Compilation error

--- test/clj/algorithms_clj/huffman_test.clj
+++ test/clj/algorithms_clj/huffman_test.clj
@@ -88,7 +88,7 @@
       (= original decoded))))

 (defspec test-decoding-encoded-message-should-return-the-orginal
-  100 ;; Will call (tc/quick-check 100 decode-code-cycle)
-  decode-code-cycle)
+  100 ;; Will call (tc/quick-check 100 decoding-encoded-message-should-return-the-orginal)
+  decoding-encoded-message-should-return-the-orginal)

 (run-tests)


Graphite server roundtrip test

Graphite server roundtrip test

--- test/riemann/transport/graphite_test.clj
+++ test/riemann/transport/graphite_test.clj
@@ -3,7 +3,9 @@
         [riemann.common :only [event]]
         riemann.transport.graphite
         [slingshot.slingshot :only [try+]])
-  (:require [riemann.logging :as logging]))
+  (:require [riemann.logging :as logging]
+            [riemann.core :as core]
+            [riemann.graphite :as client]))

 (deftest decode-graphite-line-success-test
   (is (= (event {:service "name", :metric 123.0, :time 456})
@@ -34,3 +36,32 @@
     (is (= (err "name\twith\ttab\t123\t456") "too many fields"))
     (is (= (err "name with space\tand\ttab 123\t456") "too many fields"))
     (is (= (err "name\t\t123\t456\t\t\t789") "too many fields"))))
+
+(deftest round-trip-test
+  (riemann.logging/suppress ["riemann.transport"
+                             "riemann.pubsub"
+                             "riemann.graphite"
+                             "riemann.core"]
+    (let [server (graphite-server)
+          sink   (promise)
+          core   (core/transition! (core/core)
+                                   {:services [server]
+                                    :streams  [(partial deliver sink)]})]
+      (try
+        ; Open a client and send an event
+        (let [client (client/graphite {:pool-size 1 :block-start true})]
+          (client {:host "computar"
+                   :service "hi there" :metric 2.5 :time 123 :ttl 10})
+
+          ; Verify event arrives
+          (is (= (deref sink 1000 :timed-out)
+                 (event {:host        nil
+                         :service     "computar.hi.there"
+                         :state       nil
+                         :description nil
+                         :metric      2.5
+                         :tags        nil
+                         :time        123
+                         :ttl         nil}))))
+        (finally
+          (core/stop! core))))))