Add a bunch of handy update uperations

Add a bunch of handy update uperations

--- src/detritus/update.clj
+++ src/detritus/update.clj
@@ -1,6 +1,10 @@
 (ns detritus.update
   "A collection of helper functions useful for updating and
   conditionally updating datastructures.")
+
+
+;; Mapping update operations
+;;--------------------------------------------------------------------

 (defn map-vals
   "λ {A → B} → (λ B → more* → C) → more* → {A → C}
@@ -11,6 +15,36 @@
   (->> (for [[k v] m]
        [k (apply f v args)])
      (into {})))
+
+
+(defn map-keys
+  "Create a new map from m by calling function f on each key to get a
+  new key."
+  [m f & args]
+  (when m
+    (into {}
+          (for [[k v] m]
+            (map-entry (apply f k args) v)))))
+
+
+(defn map-vals-with-keys
+  "Create a new map from m by calling function f, with two
+  arguments (the key and value) to get a new value."
+  [m f & args]
+  (when m
+    (into {}
+          (for [[k v] m]
+            (map-entry k (apply f k v args))))))
+
+
+(defn map-keys-and-vals
+  "Create a new map from m by calling function f on each key & each
+  value to get a new key & value"
+  [m f & args]
+  (when m
+    (into {}
+          (for [[k v] m]
+            (map-entry (apply f k args) (apply f v args))))))

 (defn fix
@@ -35,6 +69,9 @@
   (assoc map key
          (apply f (get map key) args)))

+
+;; Conditional update operations
+;;--------------------------------------------------------------------

 (defn ->when-update
   "Function of a value, a predicate, an updater and optional


First init logger then hijack js/console

--- src/devtools/debug.cljs
+++ src/devtools/debug.cljs
@@ -55,8 +55,8 @@
                              (js-apply old-log js/console args)))))

 (defn init! []
-  (hijack-console!)
-  (init-logger!))
+  (init-logger!)
+  (hijack-console!))

 (defn hook-monitor [name hook]
   (fn [value]


Fix ns bug in traits

Fix ns bug in traits

--- src/edu/berkeley/ai/util/traits.clj
+++ src/edu/berkeley/ai/util/traits.clj
@@ -16,10 +16,10 @@
         method-args    (second method)
         method-body    (next (next method))
         all-args       (vec (concat method-args args))
-        fn-name        (gensym (str proto "-" method-name))
+        fn-name        (gensym (str (name proto) "-" method-name))
         scoped-fn-name (symbol ns (name fn-name))]
     (assert (apply distinct? (cons nil all-args)))
-    [(symbol ns (name proto))
+    [proto #_(symbol ns (name proto))
      `(~method-name ~method-args (~scoped-fn-name ~@all-args))
      `(defn ~fn-name ~all-args (loop ~(vec (interleave (next method-args) (next method-args))) ~@method-body))]))
 ;; Loop allows proper recur semantics ...


added lower-x, upper-y, and lower-y.

added lower-x, upper-y, and lower-y.

--- src/hydrofoil/model.clj
+++ src/hydrofoil/model.clj
@@ -55,10 +55,33 @@
   (double (/ (int (+ (* n 10000) 0.5)) 10000)))

-;;(defn upper-surface-x-function
-;;  "takes an x  and gives an x coordinate on the paremetric upper-surface-x-function
-;;  (theta =  atan(G)), x - thickness-function * sin(theta)."
-;;  [x thickess]
-;;  (- x (* (thickness-function thickess x)
-;;          (Math/sin (FILL IN STUFF)))))
+(defn upper-surface-x-function
+  "takes an x  and gives an x coordinate on the paremetric upper-surface-x-function
+  (theta =  atan(G)), x - thickness-function * sin(theta)."
+  [x thickess]
+  (- x (* (thickness-function thickess x)
+          (Math/sin (Math/atan (gradient-function individual x))))))

+
+(defn lower-surface-x-function
+  "takes an x  and gives an x coordinate on the paremetric lower-surface-x-function
+  (theta =  atan(G)), x + thickness-function * sin(theta)."
+  [x thickess]
+  (+ x (* (thickness-function thickess x)
+          (Math/sin (Math/atan (gradient-function individual x))))))
+
+
+(defn upper-surface-y-function
+  "takes an x  and gives an y coordinate on the paremetric upper-surface-x-function
+  (theta =  atan(G)), camber-function + thickness-function * cos(theta)."
+  [x thickess]
+  (+ camber-function (* (thickness-function thickess x)
+          (Math/cos (Math/atan (gradient-function individual x))))))
+
+
+(defn lower-surface-y-function
+  "takes an x  and gives an y coordinate on the paremetric upper-surface-x-function
+  (theta =  atan(G)), camber-function - thickness-function * cos(theta)."
+  [x thickess]
+  (- camber-function (* (thickness-function thickess x)
+          (Math/cos (Math/atan (gradient-function individual x))))))


Add showing save paths, rework layout a bit

--- src/ecregister/core.clj
+++ src/ecregister/core.clj
@@ -21,7 +21,10 @@

 (def state (atom {:stamp-type :bottom
                   :stamp-path {:bottom "/home/dimka/free-away/avatars/stamp_bot.png"
-                               :top    "/home/dimka/free-away/avatars/stamp_top.png"} }))
+                               :top    "/home/dimka/free-away/avatars/stamp_top.png"}
+                  :save-dir-orig "/home/dimka/free-away/avatars/orig/"
+                  :save-dir-new "/home/dimka/free-away/avatars/new/"
+                  }))
 (defn update-state [& args]
   (apply swap! state assoc args))

@@ -52,17 +55,31 @@
                   (av/stamped image-orig
                               (get-in @state [:stamp-path (:stamp-type @state)])
                               (:image-ext @state)))
-    (config! (select form [:#stamped-ava]) :icon (:image-stamped @state))))
+    (config! (select form [:#stamped-ava]) :icon (:image-stamped @state))
+    (let [filename (str (:username @state) "." (:image-ext @state))]
+      (config! (select form [:#save-label-orig])
+               :text (str (:save-dir-orig @state) filename))
+      (config! (select form [:#save-label-new])
+               :text (str (:save-dir-new @state) filename)))))

 (defn build-avatars-tab []
   (let [bg-stamp-pos (button-group)
         form (mig-panel
               :items [[(label "Имя пользователя:") ""]
                       [(text :id :username :columns 15)]
-                      [(label :id :orig-ava
-                              :border (line-border :color "#ddd" :thickness 1)
-                              :halign :center)
-                       "span 1 3,w 105px::, h 105px::,wrap,top"]
+                      [(vertical-panel
+                        :items [(label :id :orig-ava
+                                       :border (line-border :color "#ddd" :thickness 1)
+                                       :halign :center
+                                       :valign :center
+                                       :size [106 :by 106]) [:fill-v 10]
+                                (label :id :stamped-ava
+                                       :border (line-border :color "#ddd" :thickness 1)
+                                       :halign :center
+                                       :valign :center
+                                       :size [106 :by 106]
+                                       )])
+                       "span 1 7,wrap,top"]
                       [(label "Положение штампа:")]
                       [(flow-panel :items [(radio :id :top
                                                   :text "Сверху"
@@ -73,12 +90,20 @@
                                                   :group bg-stamp-pos
                                                   :selected? (= :bottom (:stamp-type @state))
                                                   )]) "wrap"]
+                      [(label
+                        :foreground "#bbb"
+                        :font "Terminus"
+                        :text "Аватарки будут сохранены в:") "span 2,wrap"]
+                      [(label :id :save-label-orig
+                              :font "Terminus"
+                              :foreground "#bbb"
+                              :text (:save-dir-orig @state)) "span 2,wrap"]
+                      [(label :id :save-label-new
+                              :font "Terminus"
+                              :foreground "#bbb"
+                              :text (:save-dir-new @state)) "span 2,wrap"]
                       [(button :text "Проштамповать") "wrap,skip 1"]
-                      [(label "") "grow,push,span 2"] ;; empty filler
-                      [(label :id :stamped-ava
-                              :border (line-border :color "#ddd" :thickness 1)
-                              :halign :center)
-                       "w 105px::, h 105px::,wrap,top,gaptop 20px"]
+                      [(label "") "grow,push,span 2,wrap"] ;; empty filler
                       [(scrollable (log-window :id :log
                                                :rows 8
                                                :columns 80
@@ -96,6 +121,7 @@
                             (do
                               ;; important to put it back to channel immediately so others could read
                               (>! active-chan false)
+                              (update-state :username (text te-name))
                               (prepare-avatars (text te-name) lb-log form)
                               ))))


Median based on median of 50th percentile

--- src/engulf/recorder.clj
+++ src/engulf/recorder.clj
@@ -12,6 +12,7 @@
          {:avg (.getAvg p)
           :min (.getMin p)
           :max (.getMax p)
+          :median (.getMedian p)
           :count (.getCount p)
           :total (.getTotal p)})
        unformatted)))
@@ -46,7 +47,7 @@
         percentiles (format-percentiles (.percentiles runtime-percentiles-recorder))]
     {:runtime runtime
      :runs-sec (/ runs-total (/ runtime 1000))
-     :median-runtime (:median (nth percentiles 50))
+     :median-runtime (:avg (nth percentiles 50))
      :runtime-percentiles percentiles}))

 (defprotocol Recordable


figwheel.main started repl api

figwheel.main started repl api

--- figwheel-main/src/figwheel/main.clj
+++ figwheel-main/src/figwheel/main.clj
@@ -38,7 +38,7 @@
 (defn watch-build [id inputs opts cenv & [reload-config]]
   (when-let [inputs (if (coll? inputs) inputs [inputs])]
     (fww/add-watch!
-     id
+     [::autobuild id]
      (merge
       {::watch-info (merge
                      (:extra-info reload-config)
@@ -520,7 +520,7 @@
     (if-let [paths (and (not= mode :build-once) (not-empty watch-dirs))]
       (do
         (bapi/build (apply bapi/inputs paths) options cenv)
-        (watch-build (keyword (:id build "dev"))
+        (watch-build (:id build "dev")
                      paths options cenv (select-keys config [:reload-clj-files])))
       (cond
         source
@@ -554,23 +554,27 @@
                    ::build {:id id :config config})
             update-config)
         cenv (cljs.env/default-compiler-env)]
-    (println "Figwheel: Starting background autobuild for build: " (:id build))
-    (binding [cljs.env/*compiler* cenv]
-      (bapi/build (apply bapi/inputs (:watch-dirs config)) (:options cfg) cenv)
-      (watch-build (:id build)
-                   (:watch-dirs config)
-                   (:options cfg)
-                   cenv
-                   (select-keys config [:reload-clj-files]))
-      (when (figwheel-mode? cfg)
-        (binding [cljs.repl/*repl-env* (figwheel.repl/repl-env*
-                                        (select-keys repl-env-options
-                                                     [:connection-filter]))]
-          (figwheel.core/start*))))))
+    (when (not-empty (:watch-dirs config))
+      (println "Figwheel: Starting background autobuild for build: " (:id build))
+      (binding [cljs.env/*compiler* cenv]
+        (bapi/build (apply bapi/inputs (:watch-dirs config)) (:options cfg) cenv)
+        (watch-build (:id build)
+                     (:watch-dirs config)
+                     (:options cfg)
+                     cenv
+                     (select-keys config [:reload-clj-files]))
+        ;; TODO need to move to this pattern instead of repl evals
+        (when (first (filter #{'figwheel.core} (:preloads (:options cfg))))
+          (binding [cljs.repl/*repl-env* (figwheel.repl/repl-env*
+                                          (select-keys repl-env-options
+                                                       [:connection-filter]))]
+            (figwheel.core/start*)))))))

 (defn start-background-builds [{:keys [::background-builds] :as cfg}]
   (doseq [build background-builds]
     (background-build cfg build)))
+
+(def ^:dynamic *config*)

 ;; TODO what happens to inits like --init and --eval in all cases

@@ -582,34 +586,35 @@
         {:keys [mode pprint-config]} config
         repl-env (apply repl-env-fn (mapcat identity repl-env-options))
         cenv (cljs.env/default-compiler-env)]
-    (cljs.env/with-compiler-env cenv
-      (if pprint-config
-        (do (clojure.pprint/pprint b-cfg) b-cfg)
-        (binding [cljs.repl/*repl-env* repl-env]
-          (let [fw-mode? (figwheel-mode? b-cfg)]
-            (build config options cenv)
-            (when-not (= mode :build-once)
-              (start-background-builds cfg)
-              (doseq [init-fn (::initializers b-cfg)] (init-fn))
-              (cond
-                (= mode :repl)
-                ;; this forwards command line args
-                (repl repl-env repl-options)
-                (or (= mode :serve) fw-mode?)
-                ;; we need to get the server host:port args
-                (serve {:repl-env repl-env
-                        :repl-options repl-options
-                        ;; TODO need to iterate through the inits
-                        :eval-str (when fw-mode? (start-figwheel-code config))
-                        :join? (get b-cfg ::join-server? true)})))))))))
+    (binding [*config* b-cfg]
+      (cljs.env/with-compiler-env cenv
+        (if pprint-config
+          (do (clojure.pprint/pprint b-cfg) b-cfg)
+          (binding [cljs.repl/*repl-env* repl-env]
+            (let [fw-mode? (figwheel-mode? b-cfg)]
+              (build config options cenv)
+              (when-not (= mode :build-once)
+                (start-background-builds cfg)
+                (doseq [init-fn (::initializers b-cfg)] (init-fn))
+                (cond
+                  (= mode :repl)
+                  ;; this forwards command line args
+                  (repl repl-env repl-options)
+                  (or (= mode :serve) fw-mode?)
+                  ;; we need to get the server host:port args
+                  (serve {:repl-env repl-env
+                          :repl-options repl-options
+                          ;; TODO need to iterate through the inits
+                          :eval-str (when fw-mode? (start-figwheel-code config))
+                          :join? (get b-cfg ::join-server? true)}))))))))))

 (defn start [{:keys [figwheel-options build join-server?]}]
   (let [[build-id build-options] (if (map? build)
                                    [(:id build) (:options build)]
                                    [build])
-        build-id (or build-id "dev")
+        build-id (name (or build-id "dev"))
         options  (or (and (not build-options)
-                          (get-build (name build-id)))
+                          (get-build build-id))
                      build-options
                      {})
         cfg
@@ -621,17 +626,114 @@
           true        (update-in [::start-figwheel-options :mode] #(if-not % :repl %)))]
     (default-compile cljs.repl.figwheel/repl-env cfg)))

-;; TODO still searching for an achitecture here
-;; we need a better overall plan for config data
-;; we need to be aiming towards concrete config for the actions to be taken
-;; :repl-env-options :repl-options and compiler :options
-;; :watcher options
-;; :background builds need their own options
-
-
-(def server (atom nil))
-
-(def ^:dynamic *config*)
+;; ----------------------------------------------------------------------------
+;; REPL api
+;; ----------------------------------------------------------------------------
+
+(defn clean-build [{:keys [output-to output-dir]}]
+  (when (and output-to output-dir)
+    (doseq [file (cons (io/file output-to)
+                       (reverse (file-seq (io/file output-dir))))]
+      (when (.exists file) (.delete file)))))
+
+(defn select-autobuild-watches [ids]
+  (->> ids
+       (map #(vector ::autobuild %))
+       (select-keys (:watches @fww/*watcher*))
+       vals))
+
+(defn currently-watched-ids []
+  (set (map second (filter
+               #(and (coll? %) (= (first %) ::autobuild))
+               (keys (:watches @fww/*watcher*))))))
+
+(defn warn-on-bad-id [ids]
+  (when-let [bad-ids (not-empty (remove (currently-watched-ids) ids))]
+    (doseq [bad-id bad-ids]
+      (println "No autobuild currently has id:" bad-id))))
+
+;; TODO should this default to cleaning all builds??
+;; I think yes
+(defn clean* [ids]
+  (let [ids (->> ids (map name) distinct)]
+    (warn-on-bad-id ids)
+    (doseq [watch' (select-autobuild-watches ids)]
+      #_(prn watch')
+      (when-let [options (-> watch' ::watch-info :options)]
+        (println "Cleaning build id:" (-> watch' ::watch-info :id))
+        (clean-build options)))))
+
+(defmacro clean [& ids]
+  (clean* (map name ids))
+  nil)
+
+(defn status* []
+  (println "------- Figwheel Main Status -------")
+  (if-let [ids (not-empty (currently-watched-ids))]
+    (println "Currently building:" (string/join ", " ids))
+    (println "No builds are currently being built.")))
+
+(defmacro status []
+  (status*) nil)
+
+(defn stop-builds* [ids]
+  (let [ids (->> ids (map name) distinct)]
+    (warn-on-bad-id ids)
+    (doseq [k (map #(vector ::autobuild %) ids)]
+      (when (-> fww/*watcher* deref :watches (get k))
+        (println "Stopped building id:" (last k))
+        (fww/remove-watch! k)))))
+
+;; TODO should this default to stopping all builds??
+;; I think yes
+(defmacro stop-builds [& ids]
+  (stop-builds* ids)
+  nil)
+
+(defn main-build? [id]
+  (and *config* (= (name id) (-> *config* ::build :id))))
+
+(defn hydrate-all-background-builds [cfg ids]
+  (reduce background-build-opt (dissoc cfg ::background-builds) ids))
+
+(defn start-builds* [ids]
+  (let [ids (->> ids (map name) distinct)
+        already-building (not-empty (filter (currently-watched-ids) ids))
+        ids (filter (complement (currently-watched-ids)) ids)]
+    (when (not-empty already-building)
+      (doseq [i already-building]
+        (println "Already building id: " i)))
+    (let [main-build-id     (first (filter main-build? ids))
+          bg-builds (remove main-build? ids)]
+      #_(prn main-build-id bg-builds)
+      (when main-build-id
+        (let [{:keys [options repl-env-options ::config]} *config*
+              {:keys [watch-dirs]} config]
+          (println "Starting build id:" main-build-id)
+          ;; TODO these fns should provide feedback internally
+          (bapi/build (apply bapi/inputs watch-dirs) options cljs.env/*compiler*)
+          (watch-build main-build-id
+                       watch-dirs options
+                       cljs.env/*compiler*
+                       (select-keys config [:reload-clj-files]))
+          (when (first (filter #{'figwheel.core} (:preloads options)))
+            (binding [cljs.repl/*repl-env* (figwheel.repl/repl-env*
+                                            (select-keys repl-env-options
+                                                         [:connection-filter]))]
+              (figwheel.core/start*)))))
+      (when (not-empty bg-builds)
+        (let [cfg (hydrate-all-background-builds
+                   {::start-figwheel-options (::config *config*)}
+                   bg-builds)]
+          (start-background-builds cfg))))))
+
+;; TODO should this default to stopping all builds??
+;; I think yes
+(defmacro start-builds [& ids]
+  (start-builds* ids)
+  nil)
+
+;; TODO reset, build-once

 ;; we should add a compile directory option

@@ -653,6 +755,12 @@
 ;; in default compile
 ;; takes care of default watch and default repl
 ;; merges build-options with provided options
+
+;; ----------------------------------------------------------------------------
+;; Main
+;; ----------------------------------------------------------------------------
+
+(def server (atom nil))

 (defn split-at-opt [opt-set args]
     (split-with (complement opt-set) args))


use threads to convert files

use threads to convert files

--- src/fscrawler_tika_convert/core.clj
+++ src/fscrawler_tika_convert/core.clj
@@ -20,10 +20,17 @@
         directory (:directory body)
         relpath (:relpath (:entry body))
         fp (string/join File/separator [directory relpath])
-        converted (tika/parse fp)
+        ;; converted (tika/parse fp)
         ]
         ;;
-    (println "dir" fp " ****" (:content-type converted))))
+    (future (let [converted (tika/parse fp)]
+              (println "before ack" (Thread/currentThread) (:delivery-tag metadata))
+              (lb/ack ch (:delivery-tag metadata))
+              (println "done" fp " ****" )))
+
+    (println "scheduled" fp " ****" )))
+
+    ;; (println "dir" fp " ****" (:content-type converted))))

 ;; (println "got message" metadata (String. payload "UTF-8")))

@@ -40,7 +47,9 @@
                      (lb/ack ch delivery-tag))]
     ;; (lq/declare ch queue-name :exclusive false :auto-delete true)
     ;; (lq/bind    ch queue-name "nextbot")
-    (lcons/subscribe ch queue-name handle-message :auto-ack false)))
+    (lb/qos ch 10)
+    (lcons/subscribe ch queue-name handle-message :auto-ack false)
+    (println "done with subscribing")))

 (defn -main [& args]
@@ -55,5 +64,4 @@
                  ["--root" "Root directory of web server" :default "public"])]
     (println "port:" (:port options))
     (println "root:" (:root options)))
-  (run-with-connection)
-)
+  (run-with-connection))


named params

named params

--- src/functions/core.cljc
+++ src/functions/core.cljc
@@ -16,6 +16,8 @@

 (defn foo [str]
   (println "hello " str))
+
+(def foo (fn [] true))

 ;; Multi Arity

@@ -38,6 +40,18 @@
   ([x y & extra] (/ (reduce + (+ x y) extra)
                     (+ 2 (count extra)))))

+;; Named Params & Defaults
+
+(defn foo [& {:keys [bar baz]
+              :or {bar "default1"
+                   car "default2"}}]
+  [bar baz])
+
+(comment
+  (foo)
+  (foo :bar "my bar")
+  (foo :bar "my bar" :car "my car"))
+
 ;; Destructuring

 (defn printer [& {name :name


install to build/native. fix make. add make clean

--- build.clj
+++ build.clj
@@ -6,11 +6,11 @@
   (ant ExecTask {:dir (file srcdir) :executable "./configure"}
        (args [(str "--prefix=" dest)])
        (env environment))
-  (ant ExecTask {:dir (file srcdir) :executable "make"}
-       (args ["install"])))
+  (ant ExecTask {:dir (file srcdir) :executable "make"})
+  (ant ExecTask {:dir (file srcdir) :executable "make"} (args ["install"])))

 (deftask compile-native
-  (let [dest (file "build/install")]
+  (let [dest (file "build/native")]
     (when-not (.exists dest)
       (.mkdirs dest)
       (let [dest (.getPath dest)]
@@ -20,3 +20,10 @@
                 "CPPFLAGS"  (str "-I" dest "/include -L" dest "/lib")})
         (ant Copy {:todir (file "classes")}
              (add-zipfileset {:src (str dest "/lib/tokyocabinet.jar") :includes "**/*.class"}))))))
+
+(defn clean [srcdir]
+  (ant ExecTask {:dir (file srcdir) :executable "make"} (args ["clean"])))
+
+(deftask clean
+  (clean "src/tokyocabinet-1.4.45")
+  (clean "src/tokyocabinet-java-1.23"))


most of the http stuff is done

most of the http stuff is done

--- src/sourceninja-node/core.cljs
+++ src/sourceninja-node/core.cljs
@@ -1,9 +1,49 @@
-(ns sourceninja-node.core
+ (ns sourceninja-node.core
   (:require  [clojure.set :as set]
              [cljs.nodejs :as node]))

 (def npm
   (node/require "npm"))
+
+(def https
+  (node/require "https"))
+
+(def post-port
+  443)
+
+(def post-host
+  "app.sourceninja.com")
+
+(defn post-url
+  [product_id token]
+  (str "/products/" product_id "/import?import_type=npm&token=" token))
+
+(defn post-options
+  [product_id token json]
+  {"host" post-host
+   "port" post-port
+   "path" (post-url product_id token)
+   "method" "POST"
+   "headers" (create-headers json)})
+
+(defn create-headers
+  "create a header hash for the given content string"
+  [content]
+  {"Host" "www.example.com"
+   "Content-Type" "application/json"
+   "Content-Length" (. content -length)})
+
+(defn json-generate
+  "Returns a newline-terminate JSON string from the given
+   ClojureScript data."
+  [data]
+  (str (JSON/stringify (vec data)) "\n"))
+
+(defn get-product-and-token
+  []
+  (let [env (. js/process -env)]
+    [(. env -SOURCENINJA_PRODUCT_ID)
+     (. env -SOURCENINJA_PRODUCT_TOKEN)]))

 (def test-deps
   {
@@ -46,33 +86,84 @@
    }
   )

+(defn extract-name-and-version
+  "Take the intermediate output and create a set of
+   hashes. Each hash contains a name and a version"
+  [input]
+  (into #{}
+        (for [[name data] input]
+          {"name" name
+           "version" (get data "version")})))
+
 (defn flatten-deps
+  "Consume the graph that we get from NPM and spit out a hash of hashes.
+   Each hash contains a name and a version, duplicates are eliminated"
   [input]
-  (loop [output {}
-         input input]
+  (extract-name-and-version
+   (loop [output {}
+          input input]

-    (if-not (empty? input)
+     (if-not (empty? input)

-      (let [notseen (remove (partial contains? output) (keys input))
-            newout (reduce #(assoc %1 %2 (get input %2)) output notseen)
-            ndeps (apply merge (map #(get (get input %1) "dependencies") notseen))]
+       (let [notseen (remove (partial contains? output) (keys input))
+             newout (reduce #(assoc %1 %2 (get input %2)) output notseen)
+             ndeps (apply merge (map #(get (get input %1) "dependencies") notseen))]

-        (recur newout ndeps))
-      output)))
+         (recur newout ndeps))
+       output))))
+
+(defn post-deps
+  [deps]
+  (let [json (json-generate deps)
+        [product_id token] (get-product-and-token)
+        request (.request https (post-options product_id token json))]
+    (.write request json)
+    (.end request)))

 (defn npm-ls-callback
   [_ _ lite]
   (let [deps (flatten-deps (js->clj (. js/lite -dependencies)))]
-    (println deps)))
+    (post-deps deps)))

 (defn load-npm-callback
   [_ npm]
   (.ls (. js/npm -commands) [] true npm-ls-callback))

-(defn print-deps
-  []
-  (println
-   (flatten-deps test-deps)))

 (set! *main-cli-fn* #(.load npm load-npm-callback))
+
 ;;(set! *main-cli-fn* print-deps)
+
+;; (def http
+;;   (node/require "http"))
+
+;; (defn handler
+;;   [_ res]
+;;   (.writeHead res 200 (str {"Content-Type" "text/plain"}))
+;;   (.end res "Hello World!\n"))
+
+;; (defn start
+;;   [& _]
+;;   (let [server (.createServer http handler)]
+;;     (.listen server 8001 "127.0.0.1")
+;;     (println "Server running at http://127.0.0.1:8001/")))
+
+;; var http = require('http');
+;; var fs = require('fs');
+
+;; var server = http.createServer(function (req, res) {
+;;   console.log("blargl");
+;;   res.writeHead(200, { "Content-Type": "text/plain" });
+;;   res.end(" " + fs.readdirSync(process.cwd()));
+;; });
+
+
+;; var npm = require('npm');
+
+;; npm.load(function(err, npm) {
+;;     npm.commands.ls([], true, function(err, data, lite) {
+;;         console.log(data); //or lite for simplified output
+;;     });
+;; });
+
+;; server.listen(process.env.PORT || 8001);


fix navigable path detection

fix navigable path detection

--- src/strictly_specking/core.clj
+++ src/strictly_specking/core.clj
@@ -1093,7 +1093,7 @@

 (defn navigable-in-path? [error]
   (try (= (get-in (::root-data error)
-                  (-> error ::error-path :in-path))
+                  (fix-path error))
           (:val error))
        (catch Throwable e
          false)))


Moved parse-figures to gridref.core

Moved parse-figures to gridref.core

--- src/gridref_web/web.clj
+++ src/gridref_web/web.clj
@@ -8,11 +8,7 @@
             [ring.middleware.stacktrace :as trace]
             [ring.adapter.jetty :as jetty]
             [environ.core :refer [env]]
-            [gridref.core :refer [parse-gridref parse-coord gridref2coord coord2gridref]]))
-
-(defn parse-figures
-  [figures]
-  (try (Integer/parseInt figures) (catch Exception e 10)))
+            [gridref.core :refer [parse-gridref parse-coord parse-figures gridref2coord coord2gridref]]))

 (defn convert
   [arg figures]


Remove println that made prod

Remove println that made prod

--- src/grimoire/things.clj
+++ src/grimoire/things.clj
@@ -397,7 +397,6 @@
   (let [[_ scheme type _ extension path
          :as groups] (re-find full-uri-pattern uri-string)]
     (assert groups "Failed to parse URI. No regex match!")
-    (println groups)
     (let [t (url-path->thing path)]
       (assert (= (thing->type-name t) type)
               "Failed to parse URI. Path didn't round trip to expected type!")


add devbar to template file list

add devbar to template file list

--- src/leiningen/new/lein_quick_om.clj
+++ src/leiningen/new/lein_quick_om.clj
@@ -12,6 +12,7 @@
     (main/info "Generating fresh 'lein new' lein-quick-om project.")
     (->files data
              ["src/{{sanitized}}/core.cljs" (render "core.cljs" data)]
+             ["src/{{sanitized}}/devbar.cljs" (render "devbar.cljs" data)]
              ["project.clj" (render "project.clj" data)]
              ["Dockerfile" (render "Dockerfile" data)]
              ["Makefile" (render "Makefile" data)]


quick fixes

quick fixes

--- src/main/clojure/dojo/solutions.clj
+++ src/main/clojure/dojo/solutions.clj
@@ -29,6 +29,8 @@
 ;; add up results by team
 (def HOME-WINS (mapv esum (slices (* HWINS HOME-GAMES))))
 (def AWAY-WINS (mapv esum (slices (* AWINS AWAY-GAMES))))
+(def HOME-LOSSES (mapv esum (slices (* AWINS HOME-GAMES))))
+(def AWAY-LOSSES (mapv esum (slices (* HWINS AWAY-GAMES))))
 (def DRAW-RESULTS (mapv esum (slices (add (* DRAWS AWAY-GAMES) (* DRAWS HOME-GAMES)))))

 ;; percentages


handlers is a better name than 'result'

handlers is a better name than 'result'

--- src/kixi/hecuba/web.clj
+++ src/kixi/hecuba/web.clj
@@ -51,9 +51,9 @@
          remaining (next pairs)
          parent-resource nil      ; nil the root entity in the hierarchy
          unknown-child-resource (promise) ; see below
-         result {}]
+         handlers {}]
     (if-not pair
-      result ; return at the end
+      handlers ; return at the end
       (let [
             ;; item-resource needs to know the child-resource this is a
             ;; catch-22, we can't know what the child resource handler
@@ -69,7 +69,7 @@
         (deliver unknown-child-resource specific-resource)

         (recur (first remaining) (next remaining) specific-resource child-resource
-               (assoc result plural index-resource singular specific-resource))))))
+               (assoc handlers plural index-resource singular specific-resource))))))

 (defn make-routes [producer-config handlers {:keys [querier commander]}]
   ["/"


Story ID: Changelog: - Fixed rerender problems with figwheel. REQUIRES APP CHANGES TO WORK.

--- src/untangled/client/core.cljs
+++ src/untangled/client/core.cljs
@@ -2,7 +2,9 @@
   (:require
     [om.next :as om]
     [untangled.client.impl.application :as app]
-    [untangled.client.impl.network :as net]))
+    [untangled.client.impl.network :as net]
+    [untangled.client.logging :as log]
+    [untangled.dom :as udom]))

 (declare map->Application)

@@ -27,8 +29,9 @@
       (do (refresh this) this)
       (app/initialize this initial-state root-component dom-id-or-node)))

-  (refresh [this] (when (om/mounted? (om/app-root reconciler))
-                    (om/force-root-render! reconciler))))
+  (refresh [this]
+    (log/info "RERENDER: NOTE: If your UI doesn't change, make sure you query for :react-key on your Root and embed that as :key in your top-level DOM element")
+    (swap! (om/app-state reconciler) assoc :react-key (udom/unique-key))))

 (defn new-untangled-test-client
   "A test client that has no networking. Useful for UI testing with a real Untangled app container."


match-length macro

match-length macro

--- src/kmp_search/core.clj
+++ src/kmp_search/core.clj
@@ -20,6 +20,16 @@
     [this data]
     [this data limit]))

+(defmacro match-length
+  [data i pattern j border]
+  `(let [b# (aget ~data ~i)]
+     (-> (loop [~j ~j]
+           (if (or (neg? ~j) (= (aget ~pattern ~j) b#))
+             ~j
+             (recur (aget ~border ~j))))
+         (int)
+         (inc))))
+
 (defn border
   [^bytes pattern]
   {:pre [(isa? byte-array-class (class pattern))]}
@@ -28,34 +38,25 @@
     (loop [i 0 j -1]
       (aset-int border i j)
       (when (< i length)
-        (let [p (aget pattern i)
-              j (int (loop [j j]
-                       (if (or (neg? j) (= (aget pattern j) p))
-                         j
-                         (recur (aget border j)))))]
-          (recur (inc i) (inc j)))))
+        (recur (inc i) (match-length pattern i pattern j border))))
     border))

 (defrecord KMP
     [^bytes pattern ^int length ^ints border ^long offset ^int i ^int j]
   Search
-  (search [this bytes]
-    (search this bytes (count bytes)))
-  (search [this bytes limit]
-    {:pre [(isa? byte-array-class (class bytes))
-           (<= limit (count bytes))]}
-    (let [limit (int limit)
+  (search [this data]
+    (search this data (count data)))
+  (search [this data limit]
+    {:pre [(isa? byte-array-class (class data))
+           (<= limit (count data))]}
+    (let [data (bytes data)
+          limit (int limit)
           [i j] (loop [i i j j]
-                  (if (or (= i limit) (= j length))
-                    [i j]
-                    (let [b (aget ^bytes bytes i)
-                          j (int (loop [j j]
-                                   (if (or (neg? j) (= (aget pattern j) b))
-                                     j
-                                     (recur (aget border j)))))]
-                      (recur (inc i) (inc j)))))]
+                  (if (and (< i limit) (< j length))
+                    (recur (inc i) (match-length data i pattern j border))
+                    [i j]))]
       (if (= j length)
-        [(+ offset (- i j)) (assoc this :offset offset :i i :j (aget border j))]
+        [(+ offset (- i j)) (assoc this :i i :j (aget border j))]
         [nil (assoc this :offset (+ offset i) :i 0 :j j)]))))

 (extend-type Kernel


refresh new ui every 5 seconds

refresh new ui every 5 seconds

--- src/lambdacd/new_ui.clj
+++ src/lambdacd/new_ui.clj
@@ -14,6 +14,7 @@
   <head>
   <title>LambdaCD - Pipeline</title>
   </head>
+   <meta http-equiv=\"refresh\" content=\"5\">
   <link rel=\"stylesheet\" type=\"text/css\" href=\"/ui2/semantic-ui/semantic.css\"/>
 <link rel=\"stylesheet\" type=\"text/css\" href=\"/ui2/css/main.css\"/>
 <body>")


Fix accidental padding introduced by empty div

--- src-cljs/frontend/components/builds_table.cljs
+++ src-cljs/frontend/components/builds_table.cljs
@@ -161,12 +161,11 @@
                       :href url}
                   (build-model/github-revision build)]))]

-        [:div.metadata-item.recent-user
-         {:title (build-model/ui-user build)}
-          (when-let [author (build-model/author build)]
-            (list
-              (dashboard-icon "Builds-Author")
-              author))]
+        (when-let [author (build-model/author build)]
+          [:div.metadata-item.recent-user
+           {:title (build-model/ui-user build)}
+           (dashboard-icon "Builds-Author")
+           author])

         (if (or (not (:start_time build))
                 (= "not_run" (:status build)))


Fix docstring and key-fn devcards in tables

--- src-cljs/frontend/components/pieces/table.cljs
+++ src-cljs/frontend/components/pieces/table.cljs
@@ -33,7 +33,7 @@
              the columns' :cell-fns to generate each cell.
   :key-fn  - A function of a row object which returns a value to use as the React
              key for the row.
-  :striped - (optional) Adds a .striped class to the table."
+  :striped? - (optional) Adds a .striped class to the table."
   [{:keys [columns rows key-fn striped? ]} owner]
   {:pre (fn? key-fn)}
   (reify
@@ -41,8 +41,8 @@
     (render [_]
       (component
         (html
-         [:table
-          [:thead {:class (when striped? "striped")}
+         [:table {:class (when striped? "striped")}
+          [:thead
            [:tr
             (for [[idx {:keys [header type]}] (map-indexed vector columns)]
               ;; We never reorder columns in a table, so the index works as a
@@ -78,7 +78,8 @@

   (defn table-parent [data owner]
     (om/component
-        (om/build table {:rows [{:name "John"
+        (om/build table {:key-fn :name
+                         :rows [{:name "John"
                                  :birthday (js/Date. "1940-10-09")}
                                 {:name "Paul"
                                  :birthday (js/Date. "1942-06-18")}


Use default-plan in watch

Use default-plan in watch

--- src/main/clojure/lazytest/watch.clj
+++ src/main/clojure/lazytest/watch.clj
@@ -1,7 +1,7 @@
 (ns lazytest.watch
   (:gen-class)
   (:use [lazytest.attach :only (all-groups)]
-	[lazytest.plan :only (flat-plan)]
+	[lazytest.plan :only (default-plan)]
 	[lazytest.run :only (run)]
 	[lazytest.report :only (report)]
 	[clojure.contrib.find-namespaces
@@ -38,7 +38,7 @@
 	(doseq [n names] (remove-ns n))
 	(doseq [n names] (require n :reload))
 	(println "Running examples at" (java.util.Date.))
-	(reporter (run (flat-plan (all-groups))))))
+	(reporter (run (default-plan)))))
     (catch Exception e
       (println "ERROR:" e))))


Fix locale value

Fix locale value

A new string? assertion introduced in https://github.com/fulcrologic/fulcro/commit/d025516779d4551fa390b9706309c8d0a57293c5 made this version of the template break.

--- src/main/fulcro_template/server.clj
+++ src/main/fulcro_template/server.clj
@@ -110,7 +110,7 @@
           uri         (:uri req)
           bidi-match  (bidi/match-route routing/app-routes uri) ; where they were trying to go. NOTE: This is shared code with the client!
           valid-page? (boolean bidi-match)
-          language    (some-> req :headers (get "accept-language") (str/split #",") first keyword)]
+          language    (some-> req :headers (get "accept-language") (str/split #",") first)]

       ; . no valid bidi match. BYPASS. We don't handle it.
       (if valid-page?


Updating atom-shell app works

Updating atom-shell app works

Removed unused exec-path and mac-resources-path

--- src/lt/objs/deploy.cljs
+++ src/lt/objs/deploy.cljs
@@ -29,8 +29,8 @@

 (defn tar-path [v]
   (if (cache/fetch :edge)
-    (str "http://temp2.kodowa.com.s3.amazonaws.com/playground/releases/" v ".tar.gz")
-    (str "https://d35ac8ww5dfjyg.cloudfront.net/playground/releases/" v ".tar.gz")))
+    (str "https://api.github.com/repos/LightTable/LightTable/tarball/master")
+    (str "https://api.github.com/repos/LightTable/LightTable/tarball/" v)))

 (def version-regex #"^\d+\.\d+\.\d+(-.*)?$")

@@ -67,12 +67,6 @@
 (defn is-newer? [v1 v2]
   (compare-versions (str->version v1) (str->version v2)))

-(defn exec-path []
-  (.-execPath js/process))
-
-(defn mac-resources-path [p]
-  (.resolve fs-path (exec-path) (files/join "../../../../../Resources" p)))
-
 (defn download-file [from to cb]
   (let [options (js-obj "url" from
                         "headers" (js-obj "User-Agent" "Light Table"))
@@ -84,8 +78,8 @@
 (defn download-zip [ver cb]
   (let [n (notifos/working (str "Downloading version " ver " .."))]
     (download-file (tar-path ver) (str home-path "/tmp.tar.gz") (fn [e r body]
-                                                               (notifos/done-working)
-                                                               (cb e r body)))))
+                                                                  (notifos/done-working)
+                                                                  (cb e r body)))))

 (defn untar [from to cb]
   (let [t (.createReadStream fs from)]
@@ -95,8 +89,9 @@
         (on "end" cb))))

 (defn move-tmp []
-  (doseq [file (files/full-path-ls (str home-path "/tmp/"))]
-    (.cp shell "-rf" file home-path))
+  (let [parent-dir (first (files/full-path-ls (str home-path "/tmp/")))]
+    (doseq [file (files/full-path-ls (str parent-dir "/deploy/"))]
+      (.cp shell "-rf" file home-path)))
   (.rm shell "-rf" (str home-path "/tmp*")))

 (defn fetch-and-deploy [ver]
@@ -112,10 +107,7 @@
                                                          restart to get the latest and greatest.")
                                               :buttons [{:label "ok"}]}))))))

-(defn version-url []
-  (if (cache/fetch :edge)
-    "http://app.kodowa.com/latest-version/nw-edge"
-    "http://app.kodowa.com/latest-version/nw"))
+(def tags-url "https://api.github.com/repos/LightTable/LightTable/tags")

 (defn should-update-popup [data]
   (popup/popup! {:header "There's a newer version of Light Table!"
@@ -125,20 +117,28 @@
                             :action (fn []
                                       (fetch-and-deploy data))}]}))

+(defn ->latest-version [body]
+  (->> (js/JSON.parse body)
+       ;; Ensure only version tags
+       (keep #(when (re-find version-regex (.-name %)) (.-name %)))
+       sort
+       last))
+
 (defn check-version [& [notify?]]
-  (fetch/xhr (version-url) {}
+  (fetch/xhr tags-url {}
              (fn [data]
-               (when (re-seq version-regex data)
-                 (if (and (not= data "")
-                          (not= data (:version version))
-                          (is-newer? (:version version) data)
-                          (or notify?
-                              (not= js/localStorage.fetchedVersion data)))
-                   (do
-                     (set! js/localStorage.fetchedVersion data)
-                     (should-update-popup data))
-                   (when notify?
-                     (notifos/set-msg! (str "At latest version: " (:version version)))))))))
+               (let [latest-version (->latest-version data)]
+                 (when (re-find version-regex latest-version)
+                   (if (and (not= latest-version "")
+                            (not= latest-version (:version version))
+                            (is-newer? (:version version) latest-version)
+                            (or notify?
+                                (not= js/localStorage.fetchedVersion latest-version)))
+                     (do
+                       (set! js/localStorage.fetchedVersion latest-version)
+                       (should-update-popup latest-version))
+                     (when notify?
+                       (notifos/set-msg! (str "At latest version: " (:version version))))))))))

 (defn binary-version []
   (aget js/process.versions "node-webkit"))


last little fix for the version check, we're at 0.6.0

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/deploy.cljs
+++ src/lt/objs/deploy.cljs
@@ -158,7 +158,7 @@
 (defn notify [obj]
   (let [{:keys [nw-version]} obj]
     (cond
-     (not nw-version) (alert-binary-update)
+     nw-version (alert-binary-update)
      :else obj)))

 (defn check-all []
@@ -186,3 +186,5 @@
                                 (set! js/localStorage.fetchedVersion nil))
                               (check-version)
                               (every version-timeout check-version)))
+
+(object/tag-behaviors :app [::check-deploy])


Make sure existing structure file is overwritten on new upload

--- src/mdr2/production.clj
+++ src/mdr2/production.clj
@@ -9,7 +9,8 @@
             [mdr2.db :as db]
             [mdr2.state :as state]
             [mdr2.production.path :as path]
-            [mdr2.obi :as obi]))
+            [mdr2.obi :as obi])
+  (:import java.nio.file.StandardCopyOption))

 (def ^:private default-publisher "Swiss Library for the Blind, Visually Impaired and Print Disabled")
 (def ^:private default-date-formatter (f/formatters :date))
@@ -35,6 +36,25 @@
   "Return an id for a production as it is expected by legacy systems"
   [{id :id}]
   (str "dam" id))
+
+(defn uuid
+  "Return a randomly generated UUID optionally prefixed with `prefix`"
+  ([] (uuid "ch-sbs-"))
+  ([prefix] (str prefix (java.util.UUID/randomUUID))))
+
+(defn default-meta-data
+  "Return default meta data"
+  []
+  {:publisher default-publisher
+   :date (f/unparse default-date-formatter (t/now))
+   :identifier (uuid)
+   :language "de"
+   :state state/initial-state})
+
+(defn add-default-meta-data
+  "Add the default meta data to a production"
+  [production]
+  (merge (default-meta-data) production))

 (defn create
   "Create a production"
@@ -100,31 +120,12 @@
   (db/delete id)
   (delete-all-dirs {:id id}))

-(defn uuid
-  "Return a randomly generated UUID optionally prefixed with `prefix`"
-  ([] (uuid "ch-sbs-"))
-  ([prefix] (str prefix (java.util.UUID/randomUUID))))
-
-(defn default-meta-data
-  "Return default meta data"
-  []
-  {:publisher default-publisher
-   :date (f/unparse default-date-formatter (t/now))
-   :identifier (uuid)
-   :language "de"
-   :state state/initial-state})
-
-(defn add-default-meta-data
-  "Add the default meta data to a production"
-  [production]
-  (merge (default-meta-data) production))
-
 (defn add-structure
   "Add a DTBook XML to a `production`. This will also set the status
   to :structured"
   [production f]
   ;; move the file to the right place
-  (fs/move f (xml-path production))
+  (fs/move f (xml-path production) StandardCopyOption/REPLACE_EXISTING)
   ;; create a config file for obi
   (obi/config-file production)
   ;; update the status


Rename Clinici.co to Patavi

Rename Clinici.co to Patavi

--- server/project.clj
+++ server/project.clj
@@ -1,5 +1,5 @@
 (defproject patavi.server "0.2.1"
-  :description "Clinici.co is a distributed system for exposing R as WAMP"
+  :description "Patavi is a distributed system for exposing R as WAMP"
   :license {:name "The MIT License"
             :url "http://opensource.org/licenses/MIT"
             :distribution :repo}


make 2 more tweaks to our SQL driver connection pool settings to aid in preventing situations where 1) dbs actively close long running connections and 2) dbs have low max connections and the pool fills up those connections and never reduces again.

--- src/metabase/driver/generic_sql.clj
+++ src/metabase/driver/generic_sql.clj
@@ -91,7 +91,11 @@
   (memoize/ttl
    (fn [spec]
      (log/debug (u/format-color 'magenta "Creating new connection pool..."))
-     (kdb/connection-pool (assoc spec :minimum-pool-size 1)))
+     (kdb/connection-pool (assoc spec :minimum-pool-size           3
+                                      ;; prevent broken connections closed by dbs by testing them every 3 mins
+                                      :idle-connection-test-period (* 3 60)
+                                      ;; prevent overly large pools by condensing them when connections are idle for 15m+
+                                      :excess-timeout              (* 15 60))))
    :ttl/threshold (* 60 60 1000)))

 (defn db->jdbc-connection-spec


Fixing repl

Fixing repl

--- apoya-app/src/cljs/apoya/repl.cljs
+++ apoya-app/src/cljs/apoya/repl.cljs
@@ -5,4 +5,3 @@
   (.write js/document "<script src=\"repl/piggieback_browser.js\"></script>")
   (.write js/document "<script>goog.require('piggieback_browser')</script>"))

-


Eliminate redundant call to prepare-forward in train-step

--- cortex/src/cortex/nn/network.cljc
+++ cortex/src/cortex/nn/network.cljc
@@ -83,8 +83,7 @@
   "Trains a network for a single training example.
    Returns network with updated gradient."
   [input answer network loss-fn]
-  (let [network (cp/prepare-forward network)
-        network (core/forward network input)
+  (let [network (core/forward network input)
         temp-answer (core/output network)
         loss (cp/loss loss-fn temp-answer answer)
         loss-gradient (cp/loss-gradient loss-fn temp-answer answer)]


added Christina's blog after feedback

added Christina's blog after feedback

--- src/prais2/content.cljc
+++ src/prais2/content.cljc
@@ -1169,7 +1169,8 @@
                                 do better.” by Christina Pagel, UCL and David Spiegelhalter, University of Cambridge."]]
                               [:h4 {:style {:margin-left "40px"}} "Other coverage"]
                               [:ul.charities
-                               [:li [:a (core/href "" :target "_blank") "The NIHR Blog:"] " “Five steps to help you involve the public in communicating research”"]
+                               [:li "Sense about Science discuss their new public engagement guide based on this website work " [:a (core/href "https://www.nihr.ac.uk/blogs/five-steps-to-help-you-involve-the-public-in-communicating-research/7359" :target "_blank") " in this NIHR Blog."]]
+                               [:li [:a (core/href "https://www.nihr.ac.uk/blogs/my-journey-through-the-five-steps-of-public-engagement-an-academics-story/7429 ") "Christina Pagel discusses"] " the five steps of public engagement and how they applied to this website in this NIHR blog."]
                                [:li [:a (core/href "http://www.bmj.com/content/353/bmj.i3539" :target "_blank") "The BMJ/News:"]
                                 " “Children’s heart surgery website aims to end confusion over survival rates”"]
                                [:li [:a (core/href "http://www.thelancet.com/pdfs/journals/lancet/PIIS0140-6736(16)30888-1.pdf"


simplify error checking code a bit

simplify error checking code a bit

--- src-cljs/core.cljs
+++ src-cljs/core.cljs
@@ -87,9 +87,8 @@
            (fn [e]
              (let [xhr (.-target e)
                    code (.getStatus xhr)
-                   o (and (< code 400) (.getResponseJson xhr))
-                   r (and o (js->clj o))]
-               (put! channel (or r []))))
+                   o (and (< code 400) (js->clj (.getResponseJson xhr)))]
+               (put! channel (or o []))))
            "POST"
            (string/join
             " AND "


Cleanup some syntax

Cleanup some syntax

--- src/b3api/core.clj
+++ src/b3api/core.clj
@@ -9,12 +9,12 @@

 (defonce channel-list (atom [])) ;; The list of open websockets
-(defonce status (atom {}))       ;; The actual status, once read from the json
-(defonce tokens (atom []))       ;; List of master tokens
+(defonce status       (atom {})) ;; The actual status, once read from the json
+(defonce tokens       (atom [])) ;; List of master tokens

 (defn log-append!
-  "Append a new message to the log"
+  "Append a new message to the log file"
   [entry]
   (with-open [w (io/writer (str fs/*cwd* "/data/status.log") :append true)]
     (binding [*out* w] ;; Redirecting stdout to file
@@ -48,8 +48,8 @@
 (defn update-status
   "Handle client messages, only when authenticated"
   [data]
-  (let [data-map (parse-string data true)
-        key (:key data-map)
+  (let [data-map    (parse-string data true)
+        key         (:key data-map)
         new-message (dissoc data-map :key)]
     ;; Because authentication
     (if (and key (some #{key} @tokens))
@@ -70,8 +70,9 @@
     (update-status data)))

-(defn root-handler [ring-request]
+(defn root-handler
   "Handles the websocket requests, with fallback on HTTP GET"
+  [ring-request]
   (let [big-json (generate-string @status)]
     ;; Get an async channel from ring request
     (with-channel ring-request channel


make sure we've loaded checkout before we show users the plans

--- frontend/components/org_settings.cljs
+++ frontend/components/org_settings.cljs
@@ -11,6 +11,7 @@
             [frontend.components.plans :as plans-component]
             [frontend.components.shared :as shared]
             [frontend.state :as state]
+            [frontend.stripe :as stripe]
             [frontend.utils :as utils :include-macros true]
             [frontend.utils.github :as gh-utils]
             [frontend.utils.vcs-url :as vcs-url]
@@ -245,13 +246,37 @@

 (defn plan [app owner]
   (reify
-    om/IRender
-    (render [_]
-      (let [plan (get-in data state/org-plan-path)
-            org-name (get-in data state/org-name-path)
+
+    ;; We're loading Checkout here because the loading status is not something
+    ;; that we can hope to serialize into the state. It will be stale when we
+    ;; move to a different browser or auto-refresh the page.
+    ;; Making the component responsible for loading Checkout seems like the best
+    ;; way to make sure it's loaded when we need it.
+    om/IInitState
+    (init-state [_]
+      {:checkout-loaded? (stripe/checkout-loaded?)
+       :checkout-loaded-chan (chan)})
+    om/IWillMount
+    (will-mount [_]
+      (let [ch (om/get-state owner [:checkout-loaded-chan])
+            checkout-loaded? (om/get-state owner [:checkout-loaded?])]
+        (when-not checkout-loaded?
+          (go (<! ch) ;; wait for success message
+              (utils/mlog "Stripe checkout loaded")
+              (om/set-state! owner [:checkout-loaded?] true))
+          (utils/mlog "Loading Stripe checkout")
+          (stripe/load-checkout ch))))
+    om/IWillUnmount
+    (will-unmount [_]
+      (close! (om/get-state owner [:checkout-loaded-chan])))
+
+    om/IRenderState
+    (render-state [_ {:keys [checkout-loaded?]}]
+      (let [plan (get-in app state/org-plan-path)
+            org-name (get-in app state/org-name-path)
             controls-ch (om/get-shared owner [:comms :controls])]
         (html
-         (if-not plan
+         (if-not (and plan checkout-loaded?)
            [:div.loading-spinner common/spinner]

            [:div#billing.plans.pricing.row-fluid


Move step! function for consistency

Move step! function for consistency

--- minimal-3d-physics/desktop/src-common/minimal_3d_physics/core.clj
+++ minimal-3d-physics/desktop/src-common/minimal_3d_physics/core.clj
@@ -76,8 +76,8 @@
   (fn [screen entities]
     (clear!)
     (->> entities
-         (step! screen)
-         (render! screen)))
+         (render! screen)
+         (step! screen)))
   :on-resize
   (fn [{:keys [width height] :as screen} entities]
     (size! screen width height))


Finally remove hardcoded path in sampled-piano with new asset stuff.

--- src/overtone/inst/sampled_piano.clj
+++ src/overtone/inst/sampled_piano.clj
@@ -1,7 +1,9 @@
 (ns overtone.inst.sampled-piano
   (:use [overtone.core]))

-(defonce piano-samples (load-samples "~/Desktop/Desktop/samples/MIS_Stereo_Piano/Piano/*LOUD*"))
+(def piano-dir (bundled-asset-dir "http://www.ericmhobbs.com/Blackhole/music-backup/MIS_Stereo_Piano.zip"))
+
+(defonce piano-samples (load-samples piano-dir "Piano" "*LOUD*"))

 (defn- matching-notes
   "Find the matching sample in piano-samples which matches the midi note.


Play around with new buttons

Play around with new buttons

--- frontend/src/cruncher/selections.cljs
+++ frontend/src/cruncher/selections.cljs
@@ -39,5 +39,13 @@
                         (dom/p #js {:className "lead"} "Selections")
                         (vlib/button-primary select-all "Select all")
                         (vlib/button-primary unselect-all "Unselect all")
-                        (vlib/button-primary select-all-but-favorite "Select all but favorite"))))
+                        (vlib/button-primary select-all-but-favorite "Select all but favorite")
+                        (dom/input #js {:type "range"})
+                        (dom/div #js {:className "input-group"
+                                      :style #js {:width "200px"}}
+                                 (dom/span #js {:className "input-group-addon"} "IV <")
+                                 (dom/input #js {:type "text", :className "form-control"})
+                                 (dom/span #js {:className "input-group-addon"} "%")
+                                 )
+                        )))
 (def controls (om/factory SelectionButtons))


Cleanup + runner update

Cleanup + runner update

--- src/portal_clj/models/migration.clj
+++ src/portal_clj/models/migration.clj
@@ -70,7 +70,7 @@
   (sql/execute! db/spec
                 ["CREATE TABLE IF NOT EXISTS tags (
                    id INT(11) NOT NULL AUTO_INCREMENT PRIMARY KEY,
-                   name VARCHAR(256),
+                   name VARCHAR(256)
                  )"]))

 (defn post-tag-migration []
@@ -80,7 +80,7 @@
                    post_id INT(11) NOT NULL,
                    tag_id INT(11) NOT NULL,
                    FOREIGN KEY (post_id) REFERENCES posts(id) ON DELETE CASCADE,
-                   FOREIGN KEY (tag_id) REFERENCES tags(id) ON DELETE CASCACDE
+                   FOREIGN KEY (tag_id) REFERENCES tags(id) ON DELETE CASCADE
                  )"]))

 (defn do-migrate []
@@ -89,6 +89,10 @@
     (user-migration)
     (page-migration)
     (post-migration)
+    (author-migration)
+    (comment-migration)
+    (tag-migration)
+    (post-tag-migration)
     (println "Successfully created DB entries.")))

 (defn migrated? [table-name]
@@ -103,6 +107,4 @@
    (migrated? "pages")))

 (defn -main []
-  ;(if (all-migrated?)
-  ;  (println "Migrations already up to date.")
   (do-migrate))


Using map< for more DRY.

Using map< for more DRY.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -5,7 +5,7 @@
   (:require-macros [cljs.core.async.macros :refer [go go-loop]]
                    [cbfg.ago :refer [ago ago-loop achan-buf aput atake]])
   (:require [clojure.string :as string]
-            [cljs.core.async :refer [<! >! put! chan timeout merge]]
+            [cljs.core.async :refer [<! >! put! chan timeout merge map<]]
             [goog.dom :as gdom]
             [goog.events :as gevents]
             [om.core :as om :include-macros true]
@@ -118,11 +118,11 @@
                              (let [result (atake main-out out)]
                                (set-el-innerHTML "output" (str "<pre>" result "</pre>"))
                                (recur (conj acc result))))]
-           (ago-loop main-in w-actx []
-                     (let [cmd (.-id (.-target (<! cmds)))
-                           cmd-handler ((get cmd-handlers cmd))]
+           (ago-loop main-in w-actx [num-cmds 0]
+                     (let [cmd (<! cmds)
+                           cmd-handler ((get cmd-handlers (:op cmd)) cmd)]
                        (aput main-in in cmd-handler)
-                       (recur)))))))
+                       (recur (inc num-cmds))))))))

 ;; ------------------------------------------------

@@ -136,19 +136,19 @@
        (<! (timeout delay))
        (- x y)))

-(def cmd-handlers {"add" (fn []
-                           (let [x (js/parseInt (get-el-value "x"))
-                                 y (js/parseInt (get-el-value "y"))
-                                 fence (get-el-value "fence")
-                                 delay (js/parseInt (get-el-value "delay"))]
-                             {:rq #(example-add % x y delay) :fence (= fence "1")})),
-                   "sub" (fn []
-                           (let [x (js/parseInt (get-el-value "x"))
-                                 y (js/parseInt (get-el-value "y"))
-                                 fence (get-el-value "fence")
-                                 delay (js/parseInt (get-el-value "delay"))]
-                             {:rq #(example-sub % x y delay) :fence (= fence "1")}))})
+(def example-cmd-handlers
+  {"add" (fn [cmd]
+           {:rq #(example-add % (:x cmd) (:y cmd) (:delay cmd))
+            :fence (= (:fence cmd) "1")})
+   "sub" (fn [cmd]
+           {:rq #(example-sub % (:x cmd) (:y cmd) (:delay cmd))
+            :fence (= (:fence cmd) "1")})})

-(vis-init (merge [(listen (gdom/getElement "add") "click")
-                  (listen (gdom/getElement "sub") "click")])
-          cmd-handlers)
+(vis-init (map< (fn [id] {:op (.-id (.-target id))
+                          :x (js/parseInt (get-el-value "x"))
+                          :y (js/parseInt (get-el-value "y"))
+                          :fence (get-el-value "fence")
+                          :delay (js/parseInt (get-el-value "delay"))})
+                (merge [(listen (gdom/getElement "add") "click")
+                        (listen (gdom/getElement "sub") "click")]))
+          example-cmd-handlers)


More comments.

More comments.

--- src/cbfg/fence.clj
+++ src/cbfg/fence.clj
@@ -13,41 +13,47 @@
      (doseq [n (range s e)]
        (<! (timeout delay))
        (>! c n))
-     (close! c))))
+     (close! c))
+    c))

 ;; request format
 ;; {:rq function-to-call :fence true-or-false}

 (defn make-rq-processor []
-  (let [input-channel (chan 100)
-        output-channel (chan)]
+  (let [in-channel (chan 100)
+        out-channel (chan)]
     (go-loop
-     [receiving #{}
-      fenced-on nil
-      fenced-value nil]
-     (let [ports (vec receiving)
-           ports (if fenced-on ports (conj ports input-channel))
-           [v ch] (if-not (empty? ports) (alts! ports) [nil nil])]
-       (cond
-        (= nil v ch) (close! output-channel)
-        (= ch input-channel) (if (nil? v)
-                               (recur receiving output-channel nil)
-                               (recur (conj receiving ((:rq v)))
-                                      (if (:fence v) ch nil)
-                                      nil))
-        (= v nil) (let [new-receiving (disj receiving ch)]
-                    (if (empty? new-receiving)
-                      (do (if fenced-value
-                            (>! output-channel fenced-value))
-                          (recur new-receiving nil nil))
-                      (recur new-receiving fenced-on fenced-value)))
-        (= ch fenced-on) (do (if fenced-value
-                               (>! output-channel fenced-value))
-                             (recur receiving fenced-on v))
-        :else (do (>! output-channel v)
-                  (recur receiving fenced-on fenced-value)))))
-    {:in input-channel
-     :out output-channel}))
+        [inflight #{}         ; chans of requests currently being processed.
+         fenced nil           ; chan of last, inflight "fenced" request.
+         fenced-res nil]      ; last received result from last fenced request.
+      (let [i (vec (if fenced ; if we're fenced, ignore in-channel and just
+                     inflight ; focus on completing the current inflight requests.
+                     (conj inflight in-channel)))
+            [v ch] (if (empty? i) ; empty when in-channel has been closed.
+                     [nil nil]
+                     (alts! i))]
+        (cond
+         (= nil v ch) (close! out-channel)
+         (= ch in-channel) (if (nil? v)
+                             (recur inflight out-channel nil)
+                             (recur (conj inflight ((:rq v)))
+                                    (if (:fence v) ch nil)
+                                    nil))
+         ; at this point, ch must be an inflight chan.
+         ; next, see if that inflight chan is done.
+         (= v nil) (let [new-inflight (disj inflight ch)]
+                     (if (empty? new-inflight)
+                       (do (when fenced-res
+                             (>! out-channel fenced-res))
+                           (recur new-inflight nil nil))
+                       (recur new-inflight fenced fenced-res)))
+         (= ch fenced) (do (when fenced-res
+                             (>! out-channel fenced-res))
+                           (recur inflight fenced v))
+         :else (do (>! out-channel v)
+                   (recur inflight fenced fenced-res)))))
+    {:in in-channel
+     :out out-channel}))

 (def test-requests
   [{:rq #(add-two 1 3000)}


Change port, don't wait to scrape in main

--- src/mars_ogler/main.clj
+++ src/mars_ogler/main.clj
@@ -7,6 +7,5 @@
 (defn -main
   [& _]
   (setup-state!)
-  (run-jetty ogler-handler {:join? false, :port 3000})
-  (Thread/sleep (* 60 1000))
+  (run-jetty ogler-handler {:join? false, :port 2001})
   (scrape-loop!))


(PDB-2159) Augment the command processed message

... so we can do better cache invalidation by observing response-mult.

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -310,7 +310,10 @@
      id (command uuid)."))

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

 (defn process-command-and-respond! [cmd db response-pub-chan stats-atom]


Fixed issue #6

Fixed issue #6

--- src/alfresco_technical_validation/source_validation.clj
+++ src/alfresco_technical_validation/source_validation.clj
@@ -71,7 +71,8 @@
         :sec05          #"(?:^|\s)eval\("
       }
     :web-script-descriptor {
-        :stb19-stb20    #"<transaction>"
+        :stb19          #"<transaction>\s*none\s*</transaction>"
+        :stb20          #"<transaction>"
         :sec03          #"<authentication>\s*none\s*</authentication>"
       }
     :spring-app-context {
@@ -206,23 +207,25 @@
                          true
                          "The technology does not synchronize.")))

-(defn- stb19-stb20-web-script-transaction-setting
-  [source content-index]
-  (vector
-    (standard-validation source
-                         content-index
-                         :stb19-stb20
-                         "STB19"
-                         "Uses of <transaction> setting"
-                         false
-                         "The technology does not use the <transaction> setting.")
-    (standard-validation source
-                         content-index
-                         :stb19-stb20
-                         "STB20"
-                         "Uses of <transaction> setting"
-                         false
-                         "The technology does not use the <transaction> setting.")))
+(defn- stb19-avoid-none-transactions
+  [source content-index]
+  (standard-validation source
+                       content-index
+                       :stb19
+                       "STB19"
+                       "Uses of <transaction>none</transaction>"
+                       false
+                       "The technology does not use <transaction>none</transaction>."))
+
+(defn- stb20-avoid-transaction-setting
+  [source content-index]
+  (standard-validation source
+                       content-index
+                       :stb20
+                       "STB20"
+                       "Uses of <transaction> setting"
+                       false
+                       "The technology does not use the <transaction> setting."))

 (defn- perf02-judicious-use-of-indexed-properties
   [source content-index]
@@ -315,6 +318,8 @@
          (api05-inject-serviceregistry-not-services  source content-index)
          (com03-unique-module-identifier             source content-index)
          (com08-unique-namespace-prefixes            source content-index)
+         (stb19-avoid-none-transactions              source content-index)
+         (stb20-avoid-transaction-setting            source content-index)
          (perf02-judicious-use-of-indexed-properties source content-index)
          (perf03-dont-store-property-values          source content-index)
          (sec03-none-authentication-in-web-scripts   source content-index)
@@ -323,7 +328,6 @@
          (up03-repo-min-max                          source content-index)
          (up04-module-editions                       source content-index)
        )
-       (stb08-stb09-use-of-synchronized            source content-index)
-       (stb19-stb20-web-script-transaction-setting source content-index)
+       (stb08-stb09-use-of-synchronized source content-index)
      )]))


Fixed issue #11

Fixed issue #11

--- src/alfresco_technical_validation/source_validation.clj
+++ src/alfresco_technical_validation/source_validation.clj
@@ -197,7 +197,7 @@
                          :stb08-stb09
                          "STB08"
                          "Uses of synchronized"
-                         true
+                         false
                          "The technology does not synchronize.")
     (standard-validation source
                          content-index


Test fix :wrench:

Test fix :wrench:

--- src/metabase/driver.clj
+++ src/metabase/driver.clj
@@ -7,6 +7,7 @@
             (metabase [config :as config]
                       [db :as db])
             (metabase.models [database :refer [Database]]
+                             field
                              [query-execution :refer [QueryExecution]]
                              [setting :refer [defsetting]])
             [metabase.util :as u])


convert tabs to spaces

convert tabs to spaces

--- src/client/mc.cljs
+++ src/client/mc.cljs
@@ -1,9 +1,9 @@
 (ns client.mc
-	(:require-macros [hiccups.core :as hiccups])
+  (:require-macros [hiccups.core :as hiccups])
   (:require
     [cljs.reader :refer [read-string]]
     [client.socket :refer [socket]]
-		hiccups.runtime))
+    hiccups.runtime))

 (def $ js/$)


Add more tests and fix some others.

Add more tests and fix some others.

--- test/buddy/test_buddy_auth.clj
+++ test/buddy/test_buddy_auth.clj
@@ -2,59 +2,99 @@
   (:require [clojure.test :refer :all]
             [ring.util.response :refer [response? response]]
             [buddy.crypto.core :refer :all]
+            [buddy.crypto.signing :as signing]
             [buddy.auth :refer [throw-notauthorized]]
-            [buddy.auth.backends.httpbasic :refer [http-basic-backend]]
+            [buddy.auth.backends.httpbasic :refer [http-basic-backend parse-httpbasic-header]]
+            [buddy.auth.backends.stateless-token :as stoken]
             [buddy.auth.middleware :refer [wrap-authentication wrap-authorization]]))

-(defn make-request
+(defn make-httpbasic-request
   [username, password]
   (if (and username password)
     {:headers {"authorization" (format "Basic %s" (str->base64 (format "%s:%s" username password)))}}
     {:headers {}}))

-(defn auth-fn
+(defn httpbasic-auth-fn
   [request parsed-data]
   (let [username (:username parsed-data)]
     (cond
       (= username "foo") :foo)))

-(deftest authentication-middleware-test
+(def secret-key "test-secret-key")
+
+(deftest http-basic-parse-test
+  (testing "Parse httpbasic header from request"
+    (let [header  (format "Basic %s" (str->base64 "foo:bar"))
+          request {:headers {"authorization" header}}
+          parsed  (parse-httpbasic-header request)]
+      (is (not (nil? parsed)))
+      (is (= (:password parsed) "bar"))
+      (is (= (:username parsed) "foo")))))
+
+(deftest stateless-token-test
+  (testing "Parse authorization header"
+    (let [signed-data     (signing/dumps {:userid 1} secret-key)
+          header-content  (format "Bearer %s" signed-data)
+          request         {:headers {"authorization" header-content}}
+          parsed          (stoken/parse-authorization-header request)]
+      (is (= parsed signed-data))))
+
+  (testing "Simple backend authentication 01"
+    (let [signed-data     (signing/dumps {:userid 1} secret-key)
+          header-content  (format "Bearer %s" signed-data)
+          request         {:headers {"authorization" header-content}}
+          backend         (stoken/stateless-token-backend secret-key)
+          handler         (fn [req] req)
+          handler         (wrap-authentication handler backend)
+          resp            (handler request)]
+      (is (= (:identity resp) {:userid 1}))))
+  (testing "Simple backend authentication 02"
+    (let [signed-data     (signing/dumps {:userid 1} "wrong-key")
+          header-content  (format "Bearer %s" signed-data)
+          request         {:headers {"authorization" header-content}}
+          backend         (stoken/stateless-token-backend secret-key)
+          handler         (fn [req] req)
+          handler         (wrap-authentication handler backend)
+          resp            (handler request)]
+      (is (nil? (:identity resp))))))
+
+(deftest authentication-middleware-test-with-httpbasic
   (testing "Auth middleware with http-basic backend 01"
     (let [backend (http-basic-backend :realm "Foo")
           handler (fn [req] req)
           handler (wrap-authentication handler backend)
-          req     (make-request "user" "pass")
+          req     (make-httpbasic-request "user" "pass")
           resp    (handler req)]
         (is (nil? (:identity resp)))))

   (testing "Auth middleware with http-basic backend 02"
-    (let [backend (http-basic-backend :realm "Foo" :authfn auth-fn)
+    (let [backend (http-basic-backend :realm "Foo" :authfn httpbasic-auth-fn)
           handler (fn [req] req)
           handler (wrap-authentication handler backend)]
-      (let [req   (make-request "user" "pass")
+      (let [req   (make-httpbasic-request "user" "pass")
             resp  (handler req)]
         (is (nil? (:identity resp))))
-      (let [req   (make-request "foo" "pass")
+      (let [req   (make-httpbasic-request "foo" "pass")
             resp  (handler req)]
         (is (= (:identity resp) :foo))))))

-(deftest authorization-middleware-test
+(deftest authorization-middleware-test-with-httpbasic
   (testing "Auth middleware with http-basic backend 01"
-    (let [backend (http-basic-backend :realm "Foo" :authfn auth-fn)
+    (let [backend (http-basic-backend :realm "Foo" :authfn httpbasic-auth-fn)
           handler (fn [req] (if (nil? (:identity req))
                               (throw-notauthorized {:msg "FooMsg"})
                               req))
           handler (wrap-authentication handler backend)
           handler (wrap-authorization handler backend)
-          req     (make-request "user" "pass")
+          req     (make-httpbasic-request "user" "pass")
           resp    (handler req)]
       (is (= (:status resp) 401)))
-    (let [backend (http-basic-backend :realm "Foo" :authfn auth-fn)
+    (let [backend (http-basic-backend :realm "Foo" :authfn httpbasic-auth-fn)
           handler (fn [req] (if (nil? (:identity req))
                               (throw-notauthorized {:msg "FooMsg"})
                               req))
           handler (wrap-authentication handler backend)
           handler (wrap-authorization handler backend)
-          req     (make-request "foo" "pass")
+          req     (make-httpbasic-request "foo" "pass")
           resp    (handler req)]
       (is (= (:identity resp) :foo)))))


chat.suggestions: updated regex for switch from ! to / command char

--- src/status_im/chat/suggestions.cljs
+++ src/status_im/chat/suggestions.cljs
@@ -41,7 +41,7 @@

 (defn check-suggestion [db message]
   (when-let [suggestion-text (when (string? message)
-                               (re-matches #"^![^\s]+\s" message))]
+                               (re-matches (re-pattern (str "^" chat-consts/command-char "[^\\s]+\\s")) message))]
     (let [suggestion-text' (s/trim suggestion-text)]
       (->> (get-commands db)
            (filter #(= suggestion-text' (->> % second :name (str chat-consts/command-char))))


delete-recursively will be a no-op if the given directory does not exist

--- src/integration/clojure/com/xebia/visualreview/mock.clj
+++ src/integration/clojure/com/xebia/visualreview/mock.clj
@@ -22,7 +22,7 @@
             [com.xebia.visualreview.api-test :as api]
             [com.xebia.visualreview.itest-util :as util])
   (:import [java.io File]
-           [java.nio.file Files Paths SimpleFileVisitor FileVisitResult]
+           [java.nio.file Files Paths SimpleFileVisitor FileVisitResult Path LinkOption]
            [java.nio.file.attribute BasicFileAttributes]))

 (def ^:dynamic *conn* {:classname      "org.h2.Driver"
@@ -32,23 +32,27 @@
                        :init-pool-size 1
                        :max-pool-size  1})

+(defn- path-exists? [^Path path]
+  (Files/exists path (into-array LinkOption nil)))
+
 (defn delete-recursively!
   "Deletes all files and subdirectories recursively. Will not follow or delete symlinks."
   [filename]
-  (let [path (Paths/get filename (into-array String nil))
-        file-visitor (proxy [SimpleFileVisitor] []
-                       (preVisitDirectory [_ ^BasicFileAttributes attrs]
-                         (if (.isSymbolicLink attrs)
-                           FileVisitResult/SKIP_SUBTREE
-                           FileVisitResult/CONTINUE))
-                       (visitFile [file ^BasicFileAttributes attrs]
-                         (when-not (.isSymbolicLink attrs)
-                           (Files/delete file))
-                         FileVisitResult/CONTINUE)
-                       (postVisitDirectory [dir _]
-                         (Files/delete dir)
-                         FileVisitResult/CONTINUE))]
-    (Files/walkFileTree path file-visitor)))
+  (let [path (Paths/get filename (into-array String nil))]
+    (when (path-exists? path)
+      (let [file-visitor (proxy [SimpleFileVisitor] []
+                           (preVisitDirectory [_ ^BasicFileAttributes attrs]
+                             (if (.isSymbolicLink attrs)
+                               FileVisitResult/SKIP_SUBTREE
+                               FileVisitResult/CONTINUE))
+                           (visitFile [file ^BasicFileAttributes attrs]
+                             (when-not (.isSymbolicLink attrs)
+                               (Files/delete file))
+                             FileVisitResult/CONTINUE)
+                           (postVisitDirectory [dir _]
+                             (Files/delete dir)
+                             FileVisitResult/CONTINUE))]
+        (Files/walkFileTree path file-visitor)))))

 (def test-screenshot-dir "target/temp/screenshots")


Cast strings before decoding.

Cast strings before decoding.

--- src/multihash/core.cljc
+++ src/multihash/core.cljc
@@ -253,9 +253,9 @@
   (decode
     [source]
     (decode-array
-      (if (hex/valid? source)
-        (hex/decode source)
-        (b58/decode source))))
+      (if (hex/valid? (str source))
+        (hex/decode (str source))
+        (b58/decode (str source)))))

   #?@(:clj


displays count of running tests (#316)

displays count of running tests (#316)

--- waiter/test/waiter/test_helpers.clj
+++ waiter/test/waiter/test_helpers.clj
@@ -75,10 +75,11 @@
   (defmethod report :end-test-var [m]
     (let [test-name (full-test-name m)
           elapsed-millis (- (System/currentTimeMillis) (get @start-millis test-name))]
-      (with-test-out
-        (println \tab (blue "FINISH:") test-name (cyan (format-duration elapsed-millis)) @*report-counters*))
       (swap! test-durations #(assoc % test-name elapsed-millis))
       (swap! running-tests #(dissoc % test-name))
+      (with-test-out
+        (println \tab (blue "FINISH:") test-name (cyan (format-duration elapsed-millis))
+                 (assoc @*report-counters* :running (count @running-tests))))
       (log-running-tests)))

   (defmethod report :summary [m]


Better status handling in workers

Better status handling in workers

This fixes status handling such that the job-exception-handler still
returns the keyword status (:aborted, :failed, etc), and the job-handler
is configured to properly return :finished on completion such that we
can distinguish and transact a status update.

--- src/overseer/worker.clj
+++ src/overseer/worker.clj
@@ -26,16 +26,6 @@
        (map (partial core/->job-entity db))
        (filter (comp job-handlers :job/type))))

-(defn reserve-job
-  "Attempt to reserve a job and return it, or return nil on failure"
-  [exception-handler conn job]
-  (let [job-id (:job/id job)]
-    (try-thunk exception-handler
-      #(do (timbre/info "Reserving job" job-id)
-           (core/reserve conn job-id)
-           (timbre/info "Reserved job" job-id)
-           job))))
-
 (defn sentry-capture [dsn ex]
   (let [extra (or (ex-data ex) {})
         ex-map
@@ -61,18 +51,29 @@
   "Exception handler for job thunks; invokes the default handler,
    then returns a status keyword. Attempts to parse special signal
    status out of ex, else defaults to :failed"
-  [system ex]
+  [system job]
   (fn [ex]
-    (let [default-handler (->default-exception-handler system)]
+    (let [default-handler (->default-exception-handler system)
+          status (or (get (ex-data ex) :overseer/status)
+                     :failed)]
       (default-handler ex)
-      (or (get (ex-data ex) :overseer/status)
-          :failed))))
+      status)))
+
+(defn reserve-job
+  "Attempt to reserve a job and return it, or return nil on failure"
+  [exception-handler conn job]
+  (let [{:keys [job/id job/type]} job]
+    (try-thunk exception-handler
+      #(do (timbre/info (format "Reserving job %s (%s)" id type))
+           (core/reserve conn id)
+           (timbre/info "Reserved job" id)
+           job))))

 (defn select-and-reserve
   "Attempt to select a ready job to run and reserve it, returning
    nil on failure"
   [{:keys [conn] :as system} jobs conn]
-  (let [job (core/->job-entity (d/db conn) (rand-nth jobs))
+  (let [job (core/->job-entity (d/db conn) (rand-nth (vec jobs)))
         ex-handler (->default-exception-handler system)]
     (when (reserve-job ex-handler conn job)
       job)))
@@ -82,13 +83,15 @@
   [{:keys [conn] :as system} job-handlers job]
   (let [job-id (:job/id job)
         job-handler (get job-handlers (:job/type job))
-        exit-status (try-thunk (->job-exception-handler system)
-                               #(job-handler system job))
+        exit-status (try-thunk (->job-exception-handler system job)
+                               (fn []
+                                 (job-handler system job)
+                                 :finished))
         txns (core/update-job-status-txns (d/db conn) job-id exit-status)]
-    (timbre/info "Exited job" job-id "with status" exit-status)
-    (when (= exit-status :aborted)
+    (timbre/info "Job" job-id "exited with status" exit-status)
+    (if (= exit-status :aborted)
       (timbre/info "Found :aborted job; aborting all dependents of" job-id))
-    (d/transact conn txns)))
+    @(d/transact conn txns)))

 (defn ->job-executor
   "Construct a function that will reserve a job off the queue and execute it,


It's probably not ever sensible to reset busses when server is rebooted. Given that they're coordinated ids, they are still good to go...

--- src/overtone/sc/bus.clj
+++ src/overtone/sc/bus.clj
@@ -120,8 +120,6 @@
 ;; bus isn't used for important data.
 (defonce ___reserve-overtone-first-control-bus___
   (control-bus "Reserved Bus 0"))
-
-;;(on-sync-event :reset reset-buses ::reset-buses)

 (defn- ensure-valid-bus-offset!
   [bus offset]


Added add and omit.

Added add and omit.

--- src/overtunes/pitch.clj
+++ src/overtunes/pitch.clj
@@ -66,13 +66,6 @@
 (def raise #(+ % octave))
 (def lower #(- % octave))

-; Paramatisesd transformations
-(defn flattened [key] #(update-in % [key] flat))
-(defn sharpened [key] #(update-in % [key] sharp))
-(defn raised [key] #(update-in % [key] raise))
-(defn lowered [key] #(update-in % [key] lower))
-(defn bass [key] (comp (lowered :bass) #(assoc % :bass (key major-scale))))
-
 ; Transformations
 (def suspended-second #(assoc % :iii (:ii major-scale)))
 (def suspended-fourth #(assoc % :iii (:iv major-scale)))
@@ -85,6 +78,15 @@
 (def first-inversion #(update-values % (keys-except % [:i]) lower))
 (def second-inversion #(update-values % (keys-except % [:i :iii]) lower))

+; Paramatisesd transformations
+(defn flattened [key] #(update-in % [key] flat))
+(defn sharpened [key] #(update-in % [key] sharp))
+(defn raised [key] #(update-in % [key] raise))
+(defn lowered [key] #(update-in % [key] lower))
+(defn add [key] #(assoc % key (key major-scale)))
+(defn omit [key] #(dissoc % key))
+(defn bass [key] (comp (lowered :bass) #(assoc % :bass (key major-scale))))
+
 ; Qualities
 (def major (select-keys major-scale [:i :iii :v]))
 (def minor ((flattened :iii) major))


Renamed allowed-request? to authenticate-request

This is because we are not yet determining whether the request is
allowed to proceed at this stage, so the name is misleading.

--- src/cylon/core.clj
+++ src/cylon/core.clj
@@ -82,11 +82,11 @@

 (defprotocol HttpRequestAuthenticator
   ;; Return a map, potentially containing entries to be merged with the request.
-  (allowed-request? [_ request]))
+  (authenticate-request [_ request]))

 (extend-protocol HttpRequestAuthenticator
   Boolean
-  (allowed-request? [this request]
+  (authenticate-request [this request]
     (when this {})))

 (defprotocol UserAuthenticator
@@ -201,7 +201,7 @@
 that authentication fails."
   ([h authenticator failure-handler]
      (fn [req]
-       (let [auth (allowed-request? authenticator req)]
+       (let [auth (authenticate-request authenticator req)]
          (cond auth (h (merge req auth))
                failure-handler (failed-authentication failure-handler req)
                ;; Continue without merging auth
@@ -295,7 +295,7 @@

 (defrecord HttpBasicRequestAuthenticator [user-authenticator user-roles]
   HttpRequestAuthenticator
-  (allowed-request? [_ request]
+  (authenticate-request [_ request]
     (when-let [auth (get-in request [:headers "authorization"])]
       (when-let [basic-creds (second (re-matches #"\QBasic\E\s+(.*)" auth))]
         (let [[username password] (->> (String. (DatatypeConverter/parseBase64Binary basic-creds) "UTF-8")
@@ -315,7 +315,7 @@

 (defrecord SessionBasedRequestAuthenticator [http-session-store user-roles]
   HttpRequestAuthenticator
-  (allowed-request? [_ request]
+  (authenticate-request [_ request]
     (when-let [session (get-session http-session-store (:cookies (cookies-request request)))]
       {:session session ; retain compatibility with Ring's wrap-session
        ::session session
@@ -332,8 +332,8 @@

 (defrecord CompositeDisjunctiveRequestAuthenticator [delegates]
   HttpRequestAuthenticator
-  (allowed-request? [_ request]
-    (some #(allowed-request? % request) delegates)))
+  (authenticate-request [_ request]
+    (some #(authenticate-request % request) delegates)))

 (defn new-composite-disjunctive-request-authenticator [& delegates]
   (->CompositeDisjunctiveRequestAuthenticator (s/validate [(s/protocol HttpRequestAuthenticator)] delegates)))


update vscode setup

update vscode setup

--- main/src/dda/pallet/dda_managed_ide/infra/vscode.clj
+++ main/src/dda/pallet/dda_managed_ide/infra/vscode.clj
@@ -38,4 +38,4 @@
 ; mv joker /usr/local/bin/
 ; code --install-extension cospaia.clojure4vscode martinklepsch.clojure-joker-linter DavidAnson.vscode-markdownlint

-; # Settings can be found at $HOME/.config/Code/User/settings.json+; # Settings can be found at $HOME/.config/Code/User/settings.json


Track user input in an atom

Track user input in an atom

--- src/bolt/core.cljs
+++ src/bolt/core.cljs
@@ -11,6 +11,7 @@
   (:import [goog History]
            [goog.history EventType]))

+(def user-input (atom ""))
 (def app-state (atom {}))
 (def event-ch (chan 10))
 (def commands-index
@@ -71,10 +72,13 @@
 ;; UI

 (defn submit-search [e ch]
-  (put! ch [:service.search
-            (-> (.querySelector js/document "#search_term")
-                .-value)])
+  (put! ch [:service.search @user-input])
   false)
+
+(rum/defc input < rum/reactive [ref attributes]
+  [:input (merge attributes {:type "text"
+                             :value (rum/react ref)
+                             :on-change #(reset! ref (.. % -target -value))})])

 (rum/defc search-form []
  [:form {:onSubmit #(submit-search % event-ch)
@@ -82,7 +86,7 @@
   [:datalist#commands (map #(vector :option {:value (name %)
                                              :key (str "command-" (name %))})
                            (sort (keys (commands-index))))]
-  [:input#search_term {:type "text" :autoFocus "autofocus" :list "commands"}]
+  (input user-input {:autoFocus "autofocus" :list "commands" :id "search_term"})
   [:a {:className "btn btn-default mic" :href "#" :onClick (partial speech/toggle-speech "#search_term" "#search_submit")}
    [:img#mic {:src "img/mic.gif"}]]
   [:input#search_submit {:type "submit" :value "Search" :className "btn btn-default btn-lg"}]])


Unify naming convention.

Unify naming convention.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -105,7 +105,7 @@
                                         "The first example sentence is followed by another example sentence. "
                                         "The second sentence is followed by another example sentence.")
                       "pcap" pcap-byte-array-test-data
-                      "self-adaptivity" 1
+                      "self-adaptive" 1
                       "nil" nil))
           _ (println "in-data:" in-data)
           fn-mapping (atom (:fn-mapping options))


mlet indentation fixes

mlet indentation fixes

--- src/cats/core.cljc
+++ src/cats/core.cljc
@@ -418,7 +418,7 @@
   (ctx/with-context (ctx/get-current mv)
     (mlet [v mv
            :when (p v)]
-          (return v))))
+      (return v))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Haskell-style aliases and util functions.
@@ -466,7 +466,7 @@
   (ctx/with-context (ctx/get-current mf)
     (mlet [a (mf x)
            b (mg a)]
-          (return b))))
+      (return b))))

 (defn <=<
   "Right-to-left composition of monads.
@@ -475,7 +475,7 @@
   (ctx/with-context (ctx/get-current mf)
     (mlet [a (mf x)
            b (mg a)]
-          (return b))))
+      (return b))))

 (defn extract
   "Generic function for unwrap/extract


Refactor to have placeholder  vis-svg-actx func.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -153,8 +153,14 @@
        "</div>"])
     "no actx"))

-;; ------------------------------------------------
-
+(defn vis-svg-actx [vis actx actx-ch-ch-infos]
+  ["<circle cx='"
+   (mod ((:last-id vis)) 500)
+   "' cy='100' r='10'"
+   " stroke='black' stroke-width='3'"
+   " fill='red'/>"])
+
+;; ------------------------------------------------

 (defn vis-init [cmds cmd-handlers]
   (let [max-inflight (atom 10)
@@ -171,7 +177,8 @@
                    :chs {}   ; {ch -> {:id (gen-id),
                              ;         :msgs {msg -> true}
                              ;         :first-taker-actx actx-or-nil}}.
-                   :gen-id gen-id})
+                   :gen-id gen-id
+                   :last-id (fn [] @last-id)})
         run-controls {"run"      #(do (when (< @event-delay 0) (put! step-ch true))
                                       (reset! event-delay 0))
                       "run-slow" #(do (when (< @event-delay 0) (put! step-ch true))
@@ -191,18 +198,14 @@
             [verb step & args] event
             vis-event-handler (get (get vis-event-handlers verb) step)]
         (vis-event-handler vis actx args)
-        (set-el-innerHTML "vis-html"
-                          (apply str
-                                 (flatten [(vis-html-actx @vis @root-actx
-                                                          (group-by #(:first-taker-actx (second %))
-                                                                    (:chs @vis)))])))
-        (set-el-innerHTML "vis-svg"
-                          (str "<circle cx='"
-                               (mod num-events 500)
-                               "' cy='100' r='10'"
-                               " stroke='black' stroke-width='3'"
-                               " fill='red'/>"))
-        (set-el-innerHTML "event" (str (last actx) " " verb " " step " " args)))
+        (let [actx-ch-ch-infos (group-by #(:first-taker-actx (second %)) (:chs @vis))]
+          (set-el-innerHTML "vis-html"
+                            (apply str (flatten (vis-html-actx @vis @root-actx
+                                                               actx-ch-ch-infos))))
+          (set-el-innerHTML "vis-svg"
+                            (apply str (flatten (vis-svg-actx @vis @root-actx
+                                                              actx-ch-ch-infos))))
+          (set-el-innerHTML "event" (str (last actx) " " verb " " step " " args))))
       (recur (inc num-events)))
     (ago w-actx w
          (reset! root-actx w-actx)


Added max-inflights.

Added max-inflights.

--- src/cbfg/fence.clj
+++ src/cbfg/fence.clj
@@ -19,15 +19,16 @@
 ;; request format
 ;; {:rq function-to-call :fence true-or-false}

-(defn make-rq-processor []
+(defn make-rq-processor [max-inflights]
   (let [in-channel (chan 100)
         out-channel (chan)]
     (go-loop
-        [inflights #{}         ; chans of requests currently being processed.
-         fenced nil            ; chan of last, inflight "fenced" request.
-         fenced-res nil]       ; last received result from last fenced request.
-      (let [i (vec (if fenced  ; if we're fenced, ignore in-channel and just
-                     inflights ; focus on completing the current inflight requests.
+        [inflights #{}            ; chans of requests currently being processed.
+         fenced nil               ; chan of last, inflight "fenced" request.
+         fenced-res nil]          ; last received result from last fenced request.
+      (let [i (vec (if (or fenced ; if we're fenced or too many inflight requests,
+                           (>= (count inflights) max-inflights))
+                     inflights    ; then ignore in-channel & finish existing inflight requests.
                      (conj inflights in-channel)))
             [v ch] (if (empty? i) ; empty when in-channel is closed and no inflights.
                      [nil nil]
@@ -67,7 +68,7 @@
    ])

 (defn test-rq-processor []
-  (let [{:keys [in out]} (make-rq-processor)
+  (let [{:keys [in out]} (make-rq-processor 2)
         done (go-loop [] (let [result (<! out)]
                   (when result
                     (println "Got result: " result)


dissoc player data from players

dissoc player data from players

--- src/clj/mpd/ws.clj
+++ src/clj/mpd/ws.clj
@@ -9,6 +9,7 @@

 (defn closed [id channel status]
   (swap! clients dissoc id)
+  (swap! players dissoc id)
   (doseq [other (vals @clients)]
     (send! other (json/write-str {:type "remove" :id id})))
   (info channel "closed, status" status))


whitespace.

whitespace.

--- namespaces/common/src/main/clojure/immutant/util.clj
+++ namespaces/common/src/main/clojure/immutant/util.clj
@@ -71,7 +71,7 @@
             .getAddress
             .getHostAddress))
       (catch Exception e
-        (log/warn (format "Unable to obtain %s interface address (%s)" iface, e) )))))
+        (log/warn (format "Unable to obtain %s interface address (%s)" iface, e))))))

 (def ^{:doc "Looks up the ip address for the AS management interface."}
   management-interface-address


Documentation updates

Documentation updates

--- src/h5gal/core.clj
+++ src/h5gal/core.clj
@@ -109,8 +109,6 @@

 (remove nil? (map (partial extractPathInfo (file dataDir)) (walk dataDir)))

-
-
 (defn -main
   "I don't do a whole lot ... yet."
   [& args]