delaney.clj: DSymbol reader is more tolerant of missing data

--- clojure/org/gavrog/clojure/delaney.clj
+++ clojure/org/gavrog/clojure/delaney.clj
@@ -229,10 +229,12 @@
 (defmulti dsymbol class)

 (defn- parse-numbers [str]
-  (map #(Integer/parseInt %) (-> str s/trim (s/split #"\s+"))))
+  (when (and str (< 0 (count (s/trim str))))
+    (map #(Integer/parseInt %) (-> str s/trim (s/split #"\s+")))))

 (defn- parse-number-lists [str]
-  (map parse-numbers (-> str s/trim (s/split #","))))
+  (when str
+    (map parse-numbers (-> str s/trim (s/split #",")))))

 (defn- pairs [data free]
   (when (seq free)
@@ -254,7 +256,7 @@
             (let [j (inc i)]
               (reduce (fn [ds [D m]] (spin ds i j D (/ m (r ds i j D))))
                       ds
-                      (filter (fn [[D m]] (> m 0))
+                      (filter (fn [[D m]] (and (r ds i j D) (> m 0)))
                               (zipmap (orbit-reps ds [i j]) (nth spins i))))))
           ds
           (range (count spins))))
@@ -262,12 +264,14 @@
 (defmethod dsymbol String [code]
   (let [parts (-> code s/trim
                 (s/replace #"^<" "") (s/replace #">$" "") (s/split #":"))
-        data (if (re-matches #"\d+.\d+" (first parts)) (rest parts) parts)
-        [size dim] (parse-numbers (first data))
+        [dims gluings spins] (vec (if (re-matches #"\d+\.\d+" (first parts))
+                                    (rest parts)
+                                    parts))
+        [size dim] (parse-numbers dims)
         d-set (with-gluings (DSymbol. (or dim 2) size {} {})
-                (parse-number-lists (nth data 1)))
+                (parse-number-lists gluings))
         d-sym (with-m-vals d-set
-                (parse-number-lists (nth data 2)))]
+                (parse-number-lists spins))]
     d-sym))

 ;; === Tests
@@ -310,8 +314,37 @@
          (DSymbol. 2 2
                    {0 {1 2, 2 1} 1 {1 1, 2 2} 2 {1 2, 2 1}}
                    {0 {1 2, 2 2} 1 {1 3, 2 3}})))
+  (is (= (dsymbol "1.1:2:2,1 2,2:4,6")
+         (DSymbol. 2 2
+                   {0 {1 2, 2 1} 1 {1 1, 2 2} 2 {1 2, 2 1}}
+                   {0 {1 2, 2 2} 1 {1 3, 2 3}})))
+  (is (= (dsymbol "2:2,1 2,2:4,6")
+         (DSymbol. 2 2
+                   {0 {1 2, 2 1} 1 {1 1, 2 2} 2 {1 2, 2 1}}
+                   {0 {1 2, 2 2} 1 {1 3, 2 3}})))
+  (is (= (dsymbol "2:2,,2:4,6")
+         (DSymbol. 2 2
+                   {0 {1 2, 2 1} 2 {1 2, 2 1}}
+                   {})))
   (is (= (dsymbol "<1.1:2:2,1 2,2:4,5>") nil))
   (is (= (dsymbol "<1.1:2:2,1 2,2:0,6>")
          (DSymbol. 2 2
                    {0 {1 2, 2 1} 1 {1 1, 2 2} 2 {1 2, 2 1}}
-                   {1 {1 3, 2 3}}))))
+                   {1 {1 3, 2 3}})))
+  (is (= (dsymbol "<1.1:2:2,1 2,2:4,>")
+         (DSymbol. 2 2
+                   {0 {1 2, 2 1} 1 {1 1, 2 2} 2 {1 2, 2 1}}
+                   {0 {1 2, 2 2}})))
+  (is (= (dsymbol "<1.1:2:2,1 2,2:>")
+         (DSymbol. 2 2
+                   {0 {1 2, 2 1} 1 {1 1, 2 2} 2 {1 2, 2 1}}
+                   {})))
+  (is (= (dsymbol "<1.1:2:2:>")
+         (DSymbol. 2 2
+                   {0 {1 2, 2 1}}
+                   {})))
+  (is (= (dsymbol "<1.1:2>")
+         (DSymbol. 2 2
+                   {}
+                   {})))
+  )


x -> -x, y -> -y

x -> -x, y -> -y

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@9396 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/SlideExplorer2/src/slide_explorer/view.clj
+++ plugins/SlideExplorer2/src/slide_explorer/view.clj
@@ -129,7 +129,7 @@
                            RenderingHints/VALUE_ANTIALIAS_OFF)))))

 (defn paint-tiles [^Graphics2D g available-tiles screen-state [tile-width tile-height]]
-  (let [pixel-rect (Rectangle. (- (screen-state :x)) (- (screen-state :y))
+  (let [pixel-rect (Rectangle. (screen-state :x) (screen-state :y)
                                (screen-state :width) (screen-state :height))]
     (doseq [[nx ny] (tiles-in-pixel-rectangle pixel-rect [tile-width tile-height])]
       (when-let [proc (get-in available-tiles [(screen-state :zoom) {:nx nx :ny ny :nz (screen-state :z) :nt 0 :nc 0}])]
@@ -139,20 +139,20 @@
 (defn paint-screen [graphics screen-state available-tiles]
   (let [original-transform (.getTransform graphics)]
     (doto graphics
-      (.setClip 0 0 (:width @screen-state) (:height @screen-state))
-      (.translate (:x @screen-state)
-                  (:y @screen-state))
-      ;(.rotate @angle)
+      (.setClip 0 0 (:width screen-state) (:height screen-state))
+      (.translate (- (:x screen-state))
+                  (- (:y screen-state)))
+      ;(do (println (.getClipBounds graphics)))
       enable-anti-aliasing
-      (paint-tiles @available-tiles @screen-state [512 512])
+      (paint-tiles available-tiles screen-state [512 512])
       (.setColor Color/YELLOW)
       (.fillOval -5 -5
                  10 10)
       (.setTransform original-transform)
       (.setColor Color/YELLOW)
-      (.drawString (str @screen-state)
+      (.drawString (str screen-state)
                    (int 0)
-                   (int (- (:height @screen-state) 10))))))
+                   (int (- (:height screen-state) 10))))))

 ;; USER INPUT HANDLING
@@ -232,9 +232,9 @@
           (mouseDragged [e]
                         (let [x (.getX e) y (.getY e)]
                           (swap! position-atom update-in [:x]
-                                 + (- x (:x @drag-origin)))
+                                 - (- x (:x @drag-origin)))
                           (swap! position-atom update-in [:y]
-                                 + (- y (:y @drag-origin)))
+                                 - (- y (:y @drag-origin)))
                           (reset! drag-origin {:x x :y y}))))]
     (doto component
       (.addMouseListener mouse-adapter)
@@ -245,10 +245,10 @@
   (let [binder (fn [key axis step]
                  (bind-key component key
                            #(swap! position-atom update-in [axis] + step) true))]
-    (binder "UP" :y 50)
-    (binder "DOWN" :y -50)
-    (binder "RIGHT" :x -50)
-    (binder "LEFT" :x 50)))
+    (binder "UP" :y -50)
+    (binder "DOWN" :y 50)
+    (binder "RIGHT" :x 50)
+    (binder "LEFT" :x -50)))

 (defn handle-wheel [component z-atom]
   (.addMouseWheelListener component
@@ -270,11 +270,24 @@
                           (update-size)))))
   size-atom)

+;(defn calculate-zoom [screen-state new-zoom [center-x center-y]]
+;  (let [old-zoom (screen-state :zoom)
+;        ratio (Math/pow 2.0 (- new-zoom old-zoom))
+;        old-x (screen-state :x)
+;        old-y (screen-state :y)]
+;    (merge
+;      screen-state
+;      {:zoom new-zoom
+;       :x (* (/ new-scale old-scale) old-x)
+;       :y (* (/ newold-y}))
+
 (defn handle-zoom [window zoom-atom]
   (bind-window-keys window ["ADD" "CLOSE_BRACKET"]
-                   (fn [] (swap! zoom-atom update-in [:zoom] #(min MAX-ZOOM (inc %)))))
+                   (fn [] (swap! zoom-atom update-in [:zoom]
+                                 #(min MAX-ZOOM (inc %)))))
   (bind-window-keys window ["SUBTRACT" "OPEN_BRACKET"]
-                   (fn [] (swap! zoom-atom update-in [:zoom] #(max MIN-ZOOM (dec %))))))
+                   (fn [] (swap! zoom-atom update-in [:zoom]
+                                 #(max MIN-ZOOM (dec %))))))

 (defn watch-keys [window key-atom]
   (let [key-adapter (proxy [KeyAdapter] []
@@ -294,7 +307,7 @@
     (proxy [JPanel] []
       (paintComponent [^Graphics graphics]
         (proxy-super paintComponent graphics)
-        (paint-screen graphics screen-state available-tiles)))
+        (paint-screen graphics @screen-state @available-tiles)))
     (.setBackground Color/BLACK)))

 (defn main-frame []


Implemented Year and major or dept-name for view-apply-project

--- src/verbose_spoon/model/core.clj
+++ src/verbose_spoon/model/core.clj
@@ -60,16 +60,35 @@
   (q/update-profile-query major year username)
   "~~Updated~~")

-;; NOTIFY USER WHEN USER HAS ALREADY BEEN REJECTED
+;view apply project
+(defn req-to-kvp [s]
+  (condp = (first s)
+    \Y {:year (subs s 2)}
+    \D {:dept_name (subs s 2)}
+    \M {:major (subs s 2)}))
+
+(defn map-for-requirements [requirements]
+  (reduce (fn [agg cur] (merge agg (req-to-kvp cur))) {} requirements))
+
+(defn check-requirements? [projectname currentuser]
+  (let [{:keys [major year dept_name]} (first (q/get-major-year-dept-application-query currentuser))
+        {pmajor :major, pyear :year, pdept_name :dept_name} (map-for-requirements (map :requirement_type (q/view-project-requirement-query projectname)))]
+        (cond (and pyear (not= pyear year)) false
+              (and (and pmajor pdept_name) (and (not= pmajor major) (not= pdept_name dept_name))) false
+              (and (and pmajor (nil? pdept_name)) (and (not= pmajor major))) false
+              (and (and pdept_name (nil? pmajor)) (and (not= pdept_name dept_name))) false
+        :else true)))
+
 (defn update-apply-project [projectname currentuser]
-  ;(when-not (empty? (q/check-rejected-application-query projectname currentuser)) (q/update-apply-query projectname currentuser))
   (cond
     (seq (q/check-already-applied-application-query projectname currentuser))(response "You have already been applied for this project. Please check your application statuses.")
     (seq (q/check-rejected-application-query projectname currentuser))(response "You have already been rejected for this project. You cannot apply again")
     (empty? (q/check-user-year-major-exists-query currentuser)) (response "Your year and major do not exist! Please register your year and major on the Edit Profile Page.")
-    (seq (q/check-requirements-application-query projectname currentuser)) (response "You do not meet all the requirements for this project.")
+    (not (check-requirements? projectname currentuser)) (response "You do not meet all the requirements for this project.")
     :else (do (q/update-apply-query projectname currentuser)(response "Successful Application!"))
     ))
+
+;end view apply project

 (defn split-application-info [s]
   (clojure.string/split s #"\|"))


Simplify series-tsplot.

Simplify series-tsplot.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -69,27 +69,23 @@
      :end-t (time-coerce/to-long end-t)}))

 (defn series-tsplot [ series-name plot-end-time query-window ]
-  (let [series-state (reagent/atom {})]
+  (let [series-data (reagent/atom [])
+        subscription (server/subscribe-plot-data series-name #(reset! series-data %))]
+    (server/update-plot-data-range subscription (range-ending-at plot-end-time query-window))
     (reagent/create-class
      {:display-name (str "series-tsplot-" series-name)
-
-      :component-did-mount
-      (fn [ this ]
-        (let [loop-control (server/subscribe-plot-data series-name #(swap! series-state assoc :series-data %))]
-          (swap! series-state assoc :data-loop-control loop-control)
-          (server/update-plot-data-range loop-control (range-ending-at plot-end-time query-window))))

       :component-will-unmount
       (fn [ this ]
-        (server/unsubscribe-plot-data (:data-loop-control @series-state)))
+        (server/unsubscribe-plot-data subscription))

       :component-will-update
       (fn [ this [ _ _ plot-end-time query-window ]]
-        (server/update-plot-data-range (:data-loop-control @series-state) (range-ending-at plot-end-time query-window)))
+        (server/update-plot-data-range subscription (range-ending-at plot-end-time query-window)))

       :reagent-render
       (fn [ series-name plot-end-time query-window ]
-        [series-tsplot-view series-name (:series-data @series-state) (range-ending-at plot-end-time query-window)])})))
+        [series-tsplot-view series-name @series-data (range-ending-at plot-end-time query-window)])})))

 (defn- set-displayed-series! [ series-names ]
   (swap! dashboard-state merge {:displayed-series series-names})


Changed some macros to functions

Changed some macros to functions

--- src/conexp/gui/editors/util.clj
+++ src/conexp/gui/editors/util.clj
@@ -27,18 +27,6 @@
 ;;;

-(defmacro lambda
-  "Takes the free argument as first parameter and the function value as
-    following parameters as function body, i.e.
-
-
-     ( lambda (x y) (do (print x) (* x y)) )
-
-    will produce a function that takes 2 parameters, prints the first one
-    and returns the product of them.
-   "
-  [parameter & body]
-  `(fn [~@parameter] ~@body ))

 (defmacro rho
   "Takes an block that defines a function by omitting its last parameter
@@ -46,11 +34,11 @@
   [ & body ]
   `(fn [x#] (~@body x#)))

-(defmacro *comp
+(defn *comp
   "Takes some functions and returns the covariant function composition
     of them"
   [& fns]
-  `(comp ~@(reverse fns)))
+  (apply comp (reverse fns)))

 (defmacro dosync-wait
   "Returns a dosync block that will block until the operation
@@ -58,9 +46,8 @@
    be returned."
   [ & body]
   `(let [waiting# (promise)]
-     (do
-       (dosync (deliver waiting# (do ~@body)))
-       (deref waiting#))))
+     (dosync (deliver waiting# (do ~@body)))
+     (deref waiting#)))

 (defmacro do-map-tree
   "Returns a function that maps a named list tree using the given functions
@@ -78,9 +65,8 @@
   `(fn mapper# [tree#]
      (let [root# (~mk (first tree#))
             childs# (rest tree#)]
-       (do
-         (doseq [x# childs#] (~do-add root# (mapper# x#)))
-         root#))))
+       (doseq [x# childs#] (~do-add root# (mapper# x#)))
+       root#)))

 (defmacro do-map-tree*
   "Maps a named list tree using the given functions to a new tree structure,
@@ -97,39 +83,22 @@
   [mk do-add tree]
   `((do-map-tree ~mk ~do-add) ~tree))

-(defmacro unroll-parameters
+(defn unroll-parameters
   "Takes a vector that has a function as first argument and does a function
    call giving all other vector elements as parameters."
-  [call_vec]
-  `(let [ vec# ~call_vec
-          count# (count vec#)
-          ]
-     (cond
-       (= count# 0) nil
-       (= count# 1) ((vec# 0))
-       (= count# 2) ((vec# 0) (vec# 1))
-       (= count# 3) ((vec# 0) (vec# 1) (vec# 2))
-       (= count# 4) ((vec# 0) (vec# 1) (vec# 2) (vec# 3))
-       (= count# 5) ((vec# 0) (vec# 1) (vec# 2) (vec# 3) (vec# 4))
-       (= count# 6) ((vec# 0) (vec# 1) (vec# 2) (vec# 3) (vec# 4) (vec# 5)))))
-
-(defmacro unroll-parameters-fn-map
+  [call_seq]
+  (let [ call_vec (vec call_seq)
+         length   (count call_vec)]
+    (when (< 0 length) (apply (call_vec 0) (rest call_vec)))))
+
+(defn unroll-parameters-fn-map
   "Takes a vector that has a function as first argument and does a function
    call giving all other vector elements as parameters, looking up the function
    in the function map"
-  [fn_map call_vec]
-  `(let [ vec# ~call_vec
-          count# (count vec#)
-          ]
-     (cond
-       (= count# 0) nil
-       (= count# 1) ((~fn_map (vec# 0)))
-       (= count# 2) ((~fn_map (vec# 0)) (vec# 1))
-       (= count# 3) ((~fn_map (vec# 0)) (vec# 1) (vec# 2))
-       (= count# 4) ((~fn_map (vec# 0)) (vec# 1) (vec# 2) (vec# 3))
-       (= count# 5) ((~fn_map (vec# 0)) (vec# 1) (vec# 2) (vec# 3) (vec# 4))
-       (= count# 6) ((~fn_map (vec# 0)) (vec# 1) (vec# 2) (vec# 3) (vec# 4)
-                      (vec# 5)))))
+  [fn_map call_seq]
+  (let [ call_vec (vec call_seq)
+         length   (count call_vec)]
+    (when (< 0 length) (apply (fn_map (call_vec 0)) (rest call_vec)))))

 (defn print-doc* [v]
   (println "-------------------------")
@@ -190,11 +159,6 @@
    with the widget as first parameter and the given additional parameters"
   [map key & parameters]
   `(((~map :handler) ~key) ~map ~@parameters))
-
-(defmacro map!
-  "Just like map, but not lazy."
-  [f & colls]
-   `(seq (map ~f ~@colls)))

 ;;;
@@ -328,9 +292,8 @@

          }]
-  (do
       (doseq [x setup] (unroll-parameters-fn-map widget x))
-      widget )))
+      widget ))


Clean before uberjar, just to be sure.

Clean before uberjar, just to be sure.

--- src/leiningen/uberjar.clj
+++ src/leiningen/uberjar.clj
@@ -4,6 +4,7 @@
   (:use [clojure.zip :only [xml-zip]]
         [clojure.java.io :only [file copy]]
         [clojure.contrib.zip-filter.xml :only [xml-> tag=]]
+        [leiningen.clean :only [clean]]
         [leiningen.jar :only [get-jar-filename jar]])
   (:import [java.util.zip ZipFile ZipOutputStream ZipEntry]
            [java.io File FileOutputStream PrintWriter]))
@@ -41,6 +42,7 @@
   "Create a jar like the jar task, but including the contents of each of
 the dependency jars. Suitable for standalone distribution."
   [project]
+  (clean project)
   (jar project)
   (let [jarname-base  (str (:name project) \- (:version project))
         standalone-base (str jarname-base "-standalone.jar")


name generator is an atom, not ref.

name generator is an atom, not ref.

Since that's the only mutable thing we have and there is no need to
coordinate it's changes with other things.

--- clojure/robot-name/robot.clj
+++ clojure/robot-name/robot.clj
@@ -1,6 +1,6 @@
 (ns robot)

-(def name-seq (ref ["A" "A" 0]))
+(def name-seq (atom ["A" "A" 0]))
 (defn- inc-name-seq [curr-seq]
   (update-in curr-seq [2] inc))

@@ -12,7 +12,7 @@

 (defn- next-name []
   (let [name (generate-name)]
-    (dosync (alter name-seq inc-name-seq))
+    (swap! name-seq inc-name-seq)
     name))

 (defn robot []


Move to streaming 'fork/join' for breseq runs

--- services/wgseq-phase2.clj
+++ services/wgseq-phase2.clj
@@ -6,23 +6,16 @@
  :graph {:dir  {:type "func"
                 :name "get-comparison-files"
                 :args ["#1", "#2" "#3"]} ; eid, comparison-file, :NA here
-         :take {:type "func"
-                :name "strm-take"
-                :args [10]}
          :bseq {:type "func"
-                :name "breseq-runs"}
-         :aggr {:type "func"
-                :name "aggregate"}
+                :name "sfj-breseq-runs"}
          :mail {:type "func"
                 :name "mailp2"
                 :args ["#4"        ; recipient
                        "Aerobio job status: wgseq phase-2"
                        "Finished"]}      ; subject, body intro
-         :edges {:dir  [:take]
-                 :take [:bseq]
-                 :bseq [:aggr]
-                 :aggr [:mail]}}
+         :edges {:dir  [:bseq]
+                 :bseq [:mail]}}

  ;; instructional data used in /help
- :description ""
+ :description "Run a full set of breseq runs for experiment '#1' EID, with comparison file '#2' and sending completion msg to recipient '#4'. Uses streaming 'fork/join' breseq runner, which is also able to restart run after last completed run in case of server interruptions."
  }


Add job name extra string to email subj

Add job name extra string to email subj

--- src/clj/runbld/notifications/email.clj
+++ src/clj/runbld/notifications/email.clj
@@ -108,7 +108,8 @@
                 (format "%s %s %s"
                         (-> build :process :status)
                         (-> build :build :org-project-branch)
-                        (-> build :vcs :commit-short)))))
+                        (-> build :vcs :commit-short)
+                        (-> build :build :job-name-extra)))))

 (s/defn send? :- s/Bool
   [build :- StoredBuild]


refactor

refactor

--- src/clj/salava/metabadge/metabadge.clj
+++ src/clj/salava/metabadge/metabadge.clj
@@ -169,7 +169,7 @@
   {:in_progress (metabadges-in-progress ctx user_id)
    :completed (completed-metabadges ctx user_id)})

-(defn is-metabadge? [ctx user_badge_id]
+#_(defn is-metabadge? [ctx user_badge_id]
   (let [x (some-> (select-metabadge-info-from-user-badge {:id user_badge_id} (u/get-db ctx)) first)]
     (reduce-kv (fn [r k v]
                  (assoc r k (if (clojure.string/blank? v) false true))) {} x)))


Add :setup routing directive that allows setup raw handlers into the chain.

--- src/clojure/catacumba/impl/routing.clj
+++ src/clojure/catacumba/impl/routing.clj
@@ -98,6 +98,10 @@
               (.add rspec ServerErrorHandler ehandler)))]
     (.register chain ^Action (hp/fn->action on-register))))

+(defmethod attach-route :setup
+  [^Chain chain [_ ^String path setup]]
+  (.prefix chain path (hp/fn->action setup)))
+
 (defmethod attach-route :default
   [chain [method & handlers-and-path]]
   (let [path (first handlers-and-path)]


Code to figure out available tile keys in a directory.

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@10499 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/SlideExplorer2/src/slide_explorer/disk.clj
+++ plugins/SlideExplorer2/src/slide_explorer/disk.clj
@@ -1,13 +1,13 @@
 (ns slide-explorer.disk
-  (:require [slide-explorer.image :as image])
+  (:require [slide-explorer.image :as image]
+            [clojure.java.io :as io])
   (:import (java.util.concurrent Executors)
            (java.io File)))

-(defn- key-map-to-file-name
-  "Convert the map used as a key in image cache to a file name. Uses
-   the directory stored in the agent's metadata."
+(defn- key-map-to-file
+  "Convert the map used as a key in image cache to a file name."
   [dir key-map]
-  (str (.getAbsolutePath (clojure.java.io/file dir)) "/"
+  (str (.getAbsolutePath (io/file dir)) "/"
        (apply str
               (for [[k v] (into (sorted-map) key-map)]
                 (let [val-str (.replace (str v) "/" "by")]
@@ -17,9 +17,36 @@
 (defn read-tile
   "Read a tile image from disk for the given key."
   [dir key]
-  (image/read-processor (key-map-to-file-name dir key)))
+  (image/read-processor (key-map-to-file dir key)))

 (defn write-tile
   "Save a tile image to disk for the given key."
   [dir key processor]
-  (image/write-processor (key-map-to-file-name dir key) processor))
+  (image/write-processor (key-map-to-file dir key) processor))
+
+(defn parse
+  "Read a number as a number, other text as a string."
+  [x]
+  (try (read-string x) (catch NumberFormatException e x)))
+
+(defn- pair-to-index
+  "Create an [:key value] vector for a given (key,value-str) pair."
+  [[k v]]
+  [(keyword k) (parse (.replace v "by" "/"))])
+
+(defn- file-to-key-map
+  "Convert a filename to an index map."
+  [file]
+  (let [name (.getName (io/file file))]
+    (->> (.split name "_")
+         (partition 2)
+         (map pair-to-index)
+         (into {}))))
+
+(defn available-keys
+  "Returns the list of available index maps for a given directory."
+  [dir]
+  (->> (.listFiles (io/file dir))
+       (map file-to-key-map)
+       (remove empty?)))
+


preserve acquisition settings for the whole explorer map

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@10378 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- plugins/SlideExplorer2/src/slide_explorer/main.clj
+++ plugins/SlideExplorer2/src/slide_explorer/main.clj
@@ -104,32 +104,26 @@
       (core snapImage)
       (core getTaggedImage)))

-(defn acquire-tagged-image-sequence []
+(defn acquire-tagged-image-sequence [settings]
   (let [acq-engine (AcquisitionEngine2010. gui)
-        settings (-> gui .getAcquisitionEngine .getSequenceSettings
-                     engine/convert-settings
-                     (assoc :use-autofocus false
-                            :frames nil
-                            :positions nil
-                            :numFrames 0))
         q (engine/run acq-engine settings false)]
     (take-while #(not= % TaggedImageQueue/POISON)
                 (repeatedly #(.take q)))))

-(defn acquire-processor-sequence []
-  (map tagged-image-to-processor (acquire-tagged-image-sequence)))
+(defn acquire-processor-sequence [settings]
+  (map tagged-image-to-processor (acquire-tagged-image-sequence settings)))

 (def acquire-processor-sequence* (memoize acquire-processor-sequence))

 (defn acquire-at
   "Move the stage to position x,y and acquire a multi-dimensional
    sequence of images using the acquisition engine."
-  ([x y]
-    (acquire-at (Point2D$Double. x y)))
-  ([^Point2D$Double stage-pos]
+  ([x y settings]
+    (acquire-at (Point2D$Double. x y) settings))
+  ([^Point2D$Double stage-pos settings]
     (let [xy-stage (core getXYStageDevice)]
       (set-xy-position stage-pos)
-      (acquire-processor-sequence)
+      (acquire-processor-sequence settings)
       )))

 ;; run using acquisitions
@@ -165,13 +159,15 @@

 (def image-processing-executor (Executors/newFixedThreadPool 1))

-(defn add-tiles-at [memory-tiles [nx ny] affine-stage-to-pixel acquired-images tile-dimensions]
+(defn add-tiles-at [memory-tiles [nx ny] affine-stage-to-pixel acquired-images tile-dimensions
+                    settings]
   (swap! acquired-images conj [nx ny])
   (let [[tile-width tile-height] tile-dimensions]
     (doseq [image (doall (acquire-at (inverse-transform
                                        (Point. (* tile-width nx)
                                                (* tile-height ny))
-                                       affine-stage-to-pixel)))]
+                                       affine-stage-to-pixel)
+                                     settings))]
       (let [indices {:nx nx
                      :ny ny
                      :nz (get-in image [:tags "SliceIndex"])
@@ -189,7 +185,8 @@
   (when-let [next-tile (next-tile @screen-state-atom
                                   acquired-images)]
     (add-tiles-at memory-tiles-atom next-tile affine acquired-images
-                  (@screen-state-atom :tile-dimensions))
+                  (@screen-state-atom :tile-dimensions)
+                  (@screen-state-atom :acq-settings))
     next-tile))

 (def explore-executor (Executors/newFixedThreadPool 1))
@@ -238,7 +235,15 @@
 ;(defn share-positions []
 ;  (reactive/handle-update positions-atom
 ;                          (fn [old new]
-
+
+(defn create-acquisition-settings []
+  (-> gui .getAcquisitionEngine .getSequenceSettings
+      engine/convert-settings
+      (assoc :use-autofocus false
+             :frames nil
+             :positions nil
+             :numFrames 0)))
+

 ;; SAVE AND LOAD SETTINGS

@@ -282,8 +287,11 @@
           [screen-state memory-tiles panel] (show dir acquired-images settings)]
       (when new?
         (core waitForDevice (core getXYStageDevice))
-        (let [affine-stage-to-pixel (origin-here-stage-to-pixel-transform)
-              first-seq (acquire-at (inverse-transform (Point. 0 0) affine-stage-to-pixel))
+        (let [settings (create-acquisition-settings)
+              affine-stage-to-pixel (origin-here-stage-to-pixel-transform)
+              first-seq (acquire-at (inverse-transform
+                                      (Point. 0 0) affine-stage-to-pixel)
+                                    settings)
               explore-fn #(explore memory-tiles screen-state acquired-images
                                    affine-stage-to-pixel)
               stage (core getXYStageDevice)]
@@ -309,7 +317,8 @@
                 (swap! screen-state assoc :xy-stage-position
                        (affine/point-to-vector pixel)))))
           (swap! screen-state merge
-                 {:mode :explore
+                 {:acq-settings settings
+                  :mode :explore
                   :channels (initial-lut-maps first-seq)
                   :tile-dimensions [(core getImageWidth)
                                     (core getImageHeight)]})


Added Prismatic style pragmas and an ns level doc string

--- src/com/puppetlabs/puppetdb/config.clj
+++ src/com/puppetlabs/puppetdb/config.clj
@@ -1,4 +1,9 @@
 (ns com.puppetlabs.puppetdb.config
+  "Centralized place for reading a user-defined config INI file, validating,
+   defaulting and converting into a format that can startup a PuppetDB instance.
+
+   The schemas in this file define what is expected to be present in the INI file
+   and the format expected by the rest of the application."
   (:import [java.security KeyStore])
   (:require [clojure.tools.logging :as log]
             [puppetlabs.kitchensink.ssl :as ssl]
@@ -12,6 +17,58 @@
             [schema.core :as s]
             [com.puppetlabs.puppetdb.schema :as pls]))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Schemas
+
+;; The config is currently broken into the sections that are defined
+;; in the INI file. When the schema defaulting code gets changed to
+;; support defaulting/converting nested maps, these configs can be put
+;; together in a single schema that defines the config for PuppetDB
+
+(def database-config-in
+  "Schema for incoming database config (user defined)"
+  {(s/optional-key :log-slow-statements) (pls/defaulted-maybe s/Int 10)
+   (s/optional-key :conn-max-age) (pls/defaulted-maybe s/Int 60)
+   (s/optional-key :conn-keep-alive) (pls/defaulted-maybe s/Int 45)
+   (s/optional-key :conn-lifetime) (s/maybe s/Int)
+   (s/optional-key :classname) (s/maybe s/String)
+   (s/optional-key :subprotocol) (s/maybe s/String)
+   (s/optional-key :subname) (s/maybe s/String)
+   (s/optional-key :username) s/String
+   (s/optional-key :password) s/String
+   (s/optional-key :syntax_pgs) s/String})
+
+(def write-database-config-in
+  "Includes the common database config params, also the write-db specific ones"
+  (merge database-config-in
+         {(s/optional-key :gc-interval) (pls/defaulted-maybe s/Int 60)
+          (s/optional-key :report-ttl) (pls/defaulted-maybe s/String "14d")
+          (s/optional-key :node-purge-ttl) (pls/defaulted-maybe s/String "0s")
+          (s/optional-key :node-ttl) (s/maybe s/String)
+          (s/optional-key :node-ttl-days) (s/maybe s/Int)}))
+
+(def database-config-out
+  "Schema for parsed/processed database config"
+  {:classname s/String
+   :subprotocol s/String
+   :subname s/String
+   :log-slow-statements pls/Days
+   :conn-max-age pls/Minutes
+   :conn-keep-alive pls/Minutes
+   (s/optional-key :conn-lifetime) (s/maybe pls/Minutes)
+   (s/optional-key :read-only?) pls/SchemaBoolean
+   (s/optional-key :username) s/String
+   (s/optional-key :password) s/String
+   (s/optional-key :syntax_pgs) s/String})
+
+(def write-database-config-out
+  "Schema for parsed/processed database config that includes write database params"
+  (merge database-config-out
+         {:gc-interval pls/Minutes
+          :report-ttl pls/Period
+          :node-purge-ttl pls/Period
+          :node-ttl (s/either pls/Period pls/Days)}))
+
 (def half-the-cores
   "Half the number of CPU cores, used for defaulting the number of
    command processors"
@@ -19,6 +76,20 @@
       (/ 2)
       (int)
       (max 1)))
+
+(def command-processing-in
+  "Schema for incoming command processing config (user defined) - currently incomplete"
+  {(s/optional-key :dlo-compression-threshold) (pls/defaulted-maybe s/String "1d")
+   (s/optional-key :threads) (pls/defaulted-maybe s/Int half-the-cores)
+   (s/optional-key :store-usage) (s/maybe s/Int)
+   (s/optional-key :temp-usage) (s/maybe s/Int)})
+
+(def command-processing-out
+  "Schema for parsed/processed command processing config - currently incomplete"
+  {:dlo-compression-threshold pls/Period
+   :threads s/Int
+   (s/optional-key :store-usage) (s/maybe s/Int)
+   (s/optional-key :temp-usage) (s/maybe s/Int)})

 (defn configure-commandproc-threads
   "Update the supplied config map with the number of
@@ -34,6 +105,9 @@
                              (int)
                              (max 1))]
     (update-in config [:command-processing :threads] #(or % default-nthreads))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Jetty config

 (defn configure-web-server-ssl-from-pems
   "Configures the web server's SSL settings based on Puppet PEM files, rather than
@@ -116,63 +190,8 @@
           (assoc :client-auth :need)
           (assoc :max-threads (jetty7-minimum-threads (:max-threads merged-jetty)))))))

-(def database-config-in
-  "Schema for incoming database config (user defined)"
-  {(s/optional-key :log-slow-statements) (pls/defaulted-maybe s/Int 10)
-   (s/optional-key :conn-max-age) (pls/defaulted-maybe s/Int 60)
-   (s/optional-key :conn-keep-alive) (pls/defaulted-maybe s/Int 45)
-   (s/optional-key :conn-lifetime) (s/maybe s/Int)
-   (s/optional-key :classname) (s/maybe s/String)
-   (s/optional-key :subprotocol) (s/maybe s/String)
-   (s/optional-key :subname) (s/maybe s/String)
-   (s/optional-key :username) s/String
-   (s/optional-key :password) s/String
-   (s/optional-key :syntax_pgs) s/String})
-
-(def write-database-config-in
-  "Includes the common database config params, also the write-db specific ones"
-  (merge database-config-in
-         {(s/optional-key :gc-interval) (pls/defaulted-maybe s/Int 60)
-          (s/optional-key :report-ttl) (pls/defaulted-maybe s/String "14d")
-          (s/optional-key :node-purge-ttl) (pls/defaulted-maybe s/String "0s")
-          (s/optional-key :node-ttl) (s/maybe s/String)
-          (s/optional-key :node-ttl-days) (s/maybe s/Int)}))
-
-(def database-config-out
-  "Schema for parsed/processed database config"
-  {:classname s/String
-   :subprotocol s/String
-   :subname s/String
-   :log-slow-statements pls/Days
-   :conn-max-age pls/Minutes
-   :conn-keep-alive pls/Minutes
-   (s/optional-key :conn-lifetime) (s/maybe pls/Minutes)
-   (s/optional-key :read-only?) pls/SchemaBoolean
-   (s/optional-key :username) s/String
-   (s/optional-key :password) s/String
-   (s/optional-key :syntax_pgs) s/String})
-
-(def write-database-config-out
-  "Schema for parsed/processed database config that includes write database params"
-  (merge database-config-out
-         {:gc-interval pls/Minutes
-          :report-ttl pls/Period
-          :node-purge-ttl pls/Period
-          :node-ttl (s/either pls/Period pls/Days)}))
-
-(def command-processing-in
-  "Schema for incoming command processing config (user defined) - currently incomplete"
-  {(s/optional-key :dlo-compression-threshold) (pls/defaulted-maybe s/String "1d")
-   (s/optional-key :threads) (pls/defaulted-maybe s/Int half-the-cores)
-   (s/optional-key :store-usage) (s/maybe s/Int)
-   (s/optional-key :temp-usage) (s/maybe s/Int)})
-
-(def command-processing-out
-  "Schema for parsed/processed command processing config - currently incomplete"
-  {:dlo-compression-threshold pls/Period
-   :threads s/Int
-   (s/optional-key :store-usage) (s/maybe s/Int)
-   (s/optional-key :temp-usage) (s/maybe s/Int)})
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Database config

 (defn maybe-days
   "Convert the non-nil integer ot days"
@@ -249,6 +268,9 @@
       configure-write-db
       configure-read-db))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Command Processing Config
+
 (defn configure-command-params
   "Validates and converts the command-processing portion of the PuppetDB config"
   [{:keys [command-processing] :as config}]
@@ -265,6 +287,9 @@
   (-> config
       configure-dbs
       configure-command-params))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Global Config

 (defn validate-vardir
   "Checks that `vardir` is specified, exists, and is writeable, throwing
@@ -364,6 +389,9 @@
                      (assoc-when :event-query-limit 20000)
                      (assoc-when :update-server "http://updates.puppetlabs.com/check-for-updates"))))))

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Public
+
 (defn parse-config
   "Parses the given config file/directory and configures its various
   subcomponents.


Added input validation routines to fca.exploration.default-handler

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- conexp/fca/exploration.clj
+++ conexp/fca/exploration.clj
@@ -4,26 +4,6 @@
 	conexp.base
 	conexp.fca.contexts
 	conexp.fca.implications))
-
-(defn falsifies-implication? [new-atts impl]
-  (and (subset? (premise impl) new-atts)
-       (not (subset? (conclusion impl) new-atts))))
-
-(defn ask [prompt]
-  (do
-    (print prompt)
-    (flush)
-    (read)))
-
-(defn default-handler [ctx impl]
-  (do
-    (print ctx)
-    (let [answer (ask (str "Does the implication " impl " hold? "))]
-      (if (= answer 'yes)
-	[true []]
-	(let [new-obj (ask (str "Please enter new object: "))
-	      new-att (ask (str "Please enter the attributes the new object should have: "))]
-	  [false [new-obj (set (map (fn [att] [new-obj att]) new-att))]])))))

 (defn explore-attributes [ctx handler]
   (loop [implications #{}
@@ -55,3 +35,39 @@
 					(clop-by-implications* implications)
 					last)
 		       new-ctx)))))))))
+
+(defn falsifies-implication? [new-atts impl]
+  (and (subset? (premise impl) new-atts)
+       (not (subset? (conclusion impl) new-atts))))
+
+(defn ask [prompt pred fail-message]
+  (do
+    (print prompt)
+    (flush)
+    (loop [answer (read)]
+      (if (pred answer)
+	answer
+	(do
+	  (print fail-message)
+	  (flush)
+	  (recur (read)))))))
+
+(defn default-handler [ctx impl]
+  (do
+    (prn ctx)
+    (let [answer (ask (str "Does the implication " impl " hold? ")
+		      #{'yes 'no}
+		      "Please answer 'yes' or 'no': ")]
+      (if (= answer 'yes)
+	[true []]
+	(let [new-obj (ask (str "Please enter new object: ")
+			   (fn [new-obj] (not ((objects ctx) new-obj)))
+			   "This object is already present, please enter a new one: ")
+	      new-att (ask (str "Please enter the attributes the new object should have: ")
+			   (fn [new-atts]
+			     (and (subset? new-atts (attributes ctx))
+				  (falsifies-implication? new-atts impl)))
+			   "These attributes are not valid or do not falsify the implication.\nPlease enter a new set (in the form #{... atts ...}): "
+
+			   )]
+	  [false [new-obj (set (map (fn [att] [new-obj att]) new-att))]])))))


CMR-4479 - Added support for service lookups.

--- search-app/src/cmr/search/api/concepts_lookup.clj
+++ search-app/src/cmr/search/api/concepts_lookup.clj
@@ -16,7 +16,7 @@
 ;;; Constants

 (def find-by-concept-id-concept-types
-  #{:collection :granule :variable})
+  #{:collection :granule :service :variable})

 (def supported-concept-id-retrieval-mime-types
   {:collection #{mt/any
@@ -40,6 +40,9 @@
               mt/echo10
               mt/iso19115
               mt/iso-smap}
+   :service #{mt/any
+              mt/xml
+              mt/umm-json}}
    :variable #{mt/any
                mt/xml
                mt/umm-json}})


delete fn schema

delete fn schema

--- src/er_cassandra/model/alia/delete.clj
+++ src/er_cassandra/model/alia/delete.clj
@@ -88,7 +88,7 @@

   ([session :- Session
     entity :- Entity
-    key :- t/PrimaryKeySchema
+    key :- r/KeySchema
     record-or-key-value :- r/RecordOrKeyValueSchema
     opts :- r/DeleteOptsSchema]

@@ -100,6 +100,11 @@
                                               nil)
             opts (ts/default-timestamp-opt opts)]
        (if record
-         (delete-with-primary session entity key record opts)
+         (delete-with-primary
+          session
+          entity
+          (-> entity :primary-table :key)
+          record
+          opts)
          (return
           [:ok nil :no-primary-record]))))))


Fixing problem found testing in local vm.

--- src/cmr/metadata_db/services/concept_service.clj
+++ src/cmr/metadata_db/services/concept_service.clj
@@ -9,6 +9,12 @@
             [cmr.metadata-db.services.concept-validations :as cv]
             [cmr.metadata-db.services.provider-service :as provider-service]
             [cmr.metadata-db.data.providers :as provider-db]
+
+            ;; Required to get code loaded
+            [cmr.metadata-db.data.oracle.concepts]
+            [cmr.metadata-db.data.oracle.concepts.collection]
+            [cmr.metadata-db.data.oracle.concepts.granule]
+
             [cmr.common.log :refer (debug info warn error)]
             [cmr.system-trace.core :refer [deftracefn]]
             [clojure.set :as set]


Add test showing :body-params overrides :query-params

--- spec/rook/client_spec.clj
+++ spec/rook/client_spec.clj
@@ -92,6 +92,19 @@
                    ;; Filter out some extra information
                    (select-keys [:request-method :uri :headers :query-params :body-params :params]))))

+  (it "overrides query parameters with body-parameters in the Ring request"
+      (should= {:query-only :query-params
+                :body-only  :body-params
+                :both       :body-params}
+               (-> (c/new-request #(respond (utils/response 200 %)))
+                   (c/to :put :target)
+                   (c/with-query-params {:query-only :query-params :both :query-params})
+                   (c/with-body-params {:body-only :body-params :both :body-params})
+                   c/send
+                   <!!
+                   second
+                   :params)))
+
   (it "by default passes any success code through the success callback"
       ;; We could pass 200 thru 299 to prove a point ...
       (should= :response-body


Add additional statuses to rejected future

--- src/beehive/future.clj
+++ src/beehive/future.clj
@@ -52,9 +52,9 @@
       :error? (identical? :error (status (.getStatus future)))
       :pending? (identical? :pending (status (.getStatus future)))
       :cancelled? (identical? :cancelled (status (.getStatus future)))
+      :rejected? false
       :result (.result future)
       :error (.error future)
-      :rejected? false
       default)))

 (deftype CLJRejectedFuture [reason]
@@ -71,6 +71,11 @@
     (case key
       :status :rejected
       :rejected? true
+      :success? false
+      :timeout? false
+      :error? false
+      :pending? false
+      :cancelled? false
       :rejected-reason reason
       default)))


add application/json to create-workspace

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspaces_list.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspaces_list.cljs
@@ -37,6 +37,7 @@
                        (endpoints/call-ajax-orch
                          {:endpoint (endpoints/create-workspace ns n)
                           :payload {:namespace ns :name n :attributes {}}
+                          :headers {"Content-Type" "application/json"}
                           :on-done (fn [{:keys [success?]}]
                                      (swap! state dissoc :creating-wf)
                                      (if success?


just give us all the details straight from the DB

--- src/hivewing_core/hive_data_stages.clj
+++ src/hivewing_core/hive_data_stages.clj
@@ -103,7 +103,7 @@
          :in         [:data-stream "The data records to test for the alert"]
          :email      [:email   "The email that the hook will hit"]
          :value      [:string "The value we are testing against"]
-         :test       [[:gt :gte :lt :lte :eq] "The comparator"]
+         :test       [:enum  "The comparator" [:gt :gte :lt :lte :eq]]
          }})
   ([stage-def]
     (let [baseline-value (:value stage-def)
@@ -125,7 +125,7 @@
          :in         [:data-stream "The data records to test for the alert"]
          :url        [:url   "The URL that the POST hook will hit"]
          :value      [:string "The value we are testing against"]
-         :test       [[:gt :gte :lt :lte :eq] "The comparator"]
+         :test       [:enum  "The comparator" [:gt :gte :lt :lte :eq]]
          }})
   ([stage-def]
     (let [baseline-value (:value stage-def)
@@ -368,9 +368,7 @@
   [hive-uuid]

   (try
-    (map
-      #(assoc (:params %) :type (:stage_type %))
-      (jdbc/query sql-db ["SELECT * FROM hive_data_processing_stages WHERE hive_uuid = ?" (ensure-uuid hive-uuid)]))
+    (jdbc/query sql-db ["SELECT * FROM hive_data_processing_stages WHERE hive_uuid = ?" (ensure-uuid hive-uuid)])
     (catch clojure.lang.ExceptionInfo e false)))

 (defn hive-data-stages-create


[#455] Remove print statement

[#455] Remove print statement

--- backend/src/akvo/lumen/endpoint/invite.clj
+++ backend/src/akvo/lumen/endpoint/invite.clj
@@ -12,7 +12,6 @@
         (user-manager/invites user-manager tenant-conn))

       (POST "/" {{:strs [email]} :body}
-        (println "@3")
         (user-manager/invite user-manager tenant-conn server-name email jwt-claims)))))

 (defn verify-endpoint [{:keys [tenant-manager user-manager]}]


carry-reagent: bump version; bump carry dep; make carry a provided dep

--- contrib/reagent/project.clj
+++ contrib/reagent/project.clj
@@ -1,5 +1,5 @@
 (defproject
-  carry-reagent "0.3.0"
+  carry-reagent "0.4.0"
   :description "Reagent bindings for Carry."
   :url "https://github.com/metametadata/carry/tree/master/contrib/reagent"
   :license {:name "MIT" :url "http://opensource.org/licenses/MIT"}
@@ -7,7 +7,7 @@
   :dependencies [[org.clojure/clojure "1.8.0" :scope "provided"]
                  [org.clojure/clojurescript "1.8.51" :scope "provided"]

-                 [carry "0.2.0"]
+                 [carry "0.3.0" "provided"]

                  [reagent "0.6.0-alpha2"]]


[#1077] Fix issue when trying to get via string instead of keyword

--- backend/src/akvo/lumen/lib/public_impl.clj
+++ backend/src/akvo/lumen/lib/public_impl.clj
@@ -50,7 +50,7 @@
 (defmethod visualisation "map"
   [tenant-conn visualisation {:keys [windshaft-url]}]
   (let [dataset-id (:datasetId visualisation)
-        layer (get-in visualisation ["spec" "layers" 0])
+        layer (get-in visualisation [:spec "layers" 0])
         [map-data-tag map-data] (maps/create tenant-conn windshaft-url dataset-id layer)
         [dataset-tag dataset] (dataset/fetch tenant-conn dataset-id)]
     (when (and (= map-data-tag ::lib/ok)


Never finished writing this test, apparently

--- test/flatland/useful/fn_test.clj
+++ test/flatland/useful/fn_test.clj
@@ -79,9 +79,3 @@

 (deftest test-ignoring-nils
   (is (= 6 ((ignoring-nils +) 1 nil 2 nil nil 3))))
-
-
-(deftest test-memoize-last
-  (let [a (atom 0)
-        f #(swap! a + %)]
-    ()))


upgrade sablono

upgrade sablono

--- src/leiningen/new/devcards/project.clj
+++ src/leiningen/new/devcards/project.clj
@@ -9,7 +9,7 @@
   :dependencies [[org.clojure/clojure "1.8.0"]
                  [org.clojure/clojurescript "1.9.229"]
                  [devcards "0.2.2"]
-                 [sablono "0.7.1"]
+                 [sablono "0.7.4"]

                  ;; need to specify this for sablono
                  ;; when not using devcards


Don't put the project name in .gitignore.

--- src/cake/tasks/new.clj
+++ src/cake/tasks/new.clj
@@ -49,7 +49,7 @@
     (spit (file template "project.clj") default-template)
     (log "Created template file: project.clj")
     (spit (file template ".gitignore")
-          (apply str (interleave [".cake" "pom.xml" "*.jar" "*.war" "lib" "classes" "build" "./+project+"] (repeat "\n"))))
+          (apply str (interleave [".cake" "pom.xml" "*.jar" "*.war" "lib" "classes" "build"] (repeat "\n"))))
     (log "Created template file: .gitignore")
     (extract-resource "LICENSE" template)
     (log "Created template LICENSE file (Eclipse Public License)")))


Renamed to curr-world, curr-net.

Renamed to curr-world, curr-net.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -61,10 +61,12 @@
                   [22 :event [:b 22]]]}))

 (def run-world (atom {:a 10}))
-
 (def run-world-hover (atom nil))

-(def run-net (atom nil))
+; -------------------------------------------------------------------
+
+(def curr-world (atom nil))
+(def curr-net (atom nil))

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

@@ -184,13 +186,13 @@
                   :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
                           ;         :first-taker-actx actx-or-nil}}.
                   :gen-id gen-id})]
-        (reset! run-world {:world world})
-        (reset! run-net {:net-listen-ch (achan-buf world 10)
-                         :net-connect-ch (achan-buf world 10)})
+        (reset! curr-world {:world world})
+        (reset! curr-net {:net-listen-ch (achan-buf world 10)
+                          :net-connect-ch (achan-buf world 10)})
         (process-events vis event-delay event-ch step-ch render-ch)
         (make-net world
-                  (:net-listen-ch @run-net)
-                  (:net-connect-ch @run-net))
+                  (:net-listen-ch @curr-net)
+                  (:net-connect-ch @curr-net))
         (let [prog (get-el-value "prog")
               prog-js (str "with (cbfg.world.t1) {" prog "}")
               prog-res (try (js/eval prog-js) (catch js/Object ex ex))]


fix for when no user messages in thread

fix for when no user messages in thread

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -387,6 +387,7 @@
                                                         (filter (fn [m] (= (m :user-id) user-id)))
                                                         (map :created-at)
                                                         (map (fn [t] (.getTime t)))
+                                                        (cons 0)
                                                         (apply max))))
                           db->thread
                           first))))))


Parsing `expect` now also parses fakes.

Parsing `expect` now also parses fakes.

--- src/midje/parsing/2_to_lexical_maps/examples.clj
+++ src/midje/parsing/2_to_lexical_maps/examples.clj
@@ -14,6 +14,8 @@
             [midje.data.metaconstant :as metaconstant]
             [midje.data.nested-facts :as nested-facts]
             [midje.parsing.lexical-maps :as lexical-maps]
+            [midje.parsing.2-to-lexical-maps.fakes :as parse-fakes]
+            [midje.parsing.2-to-lexical-maps.data-fakes :as parse-data-fakes]
             [midje.emission.api :as emit])
   (:import midje.data.metaconstant.Metaconstant))

@@ -30,8 +32,16 @@
 (defn expansion [call-form arrow expected-result fakes overrides]
   (pred-cond arrow
     normal-arrows?
-    (let [check (lexical-maps/example call-form arrow expected-result overrides)]
-      `(midje.checking.examples/check-one ~check ~(vec fakes)))
+    (let [check (lexical-maps/example call-form arrow expected-result overrides)
+          expanded-fakes (map (fn [fake]
+                                 ;; TODO: Maybe this wants to be a multimethod,
+                                 ;; but I'm not sure whether the resemblance between
+                                 ;; data-fakes and regular fakes isn't too coincidental.
+                                 (if (first-named? fake "fake")
+                                   (parse-fakes/to-lexical-map-form fake)
+                                   (parse-data-fakes/to-lexical-map-form fake)))
+                               fakes)]
+      `(midje.checking.examples/check-one ~check ~(vec expanded-fakes)))

     macroexpansion-arrow?
     (let [expanded-macro `(macroexpand-1 '~call-form)


try to make sure tests fail

try to make sure tests fail

--- test/metabase_init/core_test.clj
+++ test/metabase_init/core_test.clj
@@ -4,3 +4,6 @@

 ;; Basic sanity check
 (expect 2 (+ 1 1))
+
+;; SHOULD FAIL!
+(expect false)


Add clj unit tests for org.httpkit.client.Decoder

The Decoder class unexpectedly fails to decode a response starting with

    "HTTP/1.1 200 \r\n"

while the following initial line is accepted even if, strictly speaking,
against the RFC 2616:

    "HTTP/1.1 200\r\n"

(I think both should be accepted by HTTP Kit.)

--- test/org/httpkit/client_test.clj
+++ test/org/httpkit/client_test.clj
@@ -11,7 +11,9 @@
   (:require [org.httpkit.client :as http]
             [clojure.java.io :as io]
             [clj-http.client :as clj-http])
-  (:import java.nio.ByteBuffer))
+  (:import java.nio.ByteBuffer
+           [org.httpkit HttpMethod HttpStatus HttpVersion]
+           [org.httpkit.client Decoder IRespListener]))

 (defroutes test-routes
   (GET "/get" [] "hello world")
@@ -325,6 +327,93 @@
                              {:headers {"test-header" sent}}))]
         (is (= received expected)))))

+(defn- utf8 [s] (ByteBuffer/wrap (.getBytes s "UTF-8")))
+
+(defn- decode
+  [method buffer]
+  (let [out (atom [])
+        listener (reify IRespListener
+                   (onInitialLineReceived [_ v s] (swap! out conj [:init v s]))
+                   (onHeadersReceived [_ hs]      (swap! out conj [:headers hs]))
+                   (onBodyReceived [_ buf n]      (swap! out conj [:body (into [] (take n buf))]))
+                   (onCompleted [_]               (swap! out conj [:completed]))
+                   (onThrowable [_ t]             (swap! out conj [:error t])))]
+    (.decode (Decoder. listener method) buffer)
+    @out))
+
+(deftest test-decode-partial-status-line
+  (are [method resp events] (= (decode method (utf8 resp)) events)
+    ;; The Status-Line is only parsed once there is a CRLF in the end.
+    HttpMethod/GET "" []
+    HttpMethod/GET "HTTP/1.1" []
+    HttpMethod/GET "HTTP/1.1 200 OK" []
+    HttpMethod/GET "HTTP/1.1totally-broken-line" []))
+
+(deftest test-decode-http-version
+  (are [method resp events] (= (decode method (utf8 resp)) events)
+    ;; HTTP version string is parsed.
+    HttpMethod/GET "HTTP/1.1 200 OK\r\n" [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]]
+    HttpMethod/GET "HTTP/1.0 200 OK\r\n" [[:init HttpVersion/HTTP_1_0 HttpStatus/OK]]))
+
+(deftest test-decode-empty-reason-phrase
+  (are [method resp events] (= (decode method (utf8 resp)) events)
+    ;; The Reason-Phrase (after Status-Code) may be omitted.
+    HttpMethod/GET "HTTP/1.1 200 \r\n" [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]]
+
+    ;; A Status-Line with no space after the Status-Code does not comply to the RFC 2616,
+    ;; but there is probably little reason not to allow it in the parser.
+    HttpMethod/GET "HTTP/1.1 200\r\n" [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]]))
+
+(deftest test-decode-empty-headers
+  (are [method resp events] (= (decode method (utf8 resp)) events)
+    ;; Empty headers
+    HttpMethod/GET "HTTP/1.1 200 OK\r\n\r\n" [[:init HttpVersion/HTTP_1_1 HttpStatus/OK] [:headers {}]]
+    HttpMethod/GET "HTTP/1.1 200 \r\n\r\n" [[:init HttpVersion/HTTP_1_1 HttpStatus/OK] [:headers {}]]))
+
+(deftest test-decode-headers
+  (are [method resp events] (= (decode method (utf8 resp)) events)
+    ;; Headers are not emitted before two consecutive CRLF's
+    HttpMethod/GET "HTTP/1.1 200 OK\r\nContent-Length: 0\r\n"
+    [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]]
+
+    ;; One header.
+    HttpMethod/GET "HTTP/1.1 200 OK\r\nContent-Length: 0\r\n\r\n"
+    [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]
+     [:headers {"content-length" "0"}]]
+
+    ))
+
+(deftest test-decode-body
+  (are [method resp events] (= (decode method (utf8 resp)) events)
+    ;; Empty body with zero content-length, no matter what bytes follow.
+    HttpMethod/GET "HTTP/1.1 200 OK\r\nContent-Length: 0\r\n\r\n..."
+    [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]
+     [:headers {"content-length" "0"}]]
+
+    ;; Expecting one byte, but no content available yet.
+    HttpMethod/GET "HTTP/1.1 200 OK\r\nContent-Length: 1\r\n\r\n"
+    [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]
+     [:headers {"content-length" "1"}]]
+
+     ;; One byte.
+     HttpMethod/GET "HTTP/1.1 200 OK\r\nContent-Length: 1\r\n\r\n."
+     [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]
+      [:headers {"content-length" "1"}]
+      [:body [46]]]
+
+     ;; One byte. The rest is ignored.
+     HttpMethod/GET "HTTP/1.1 200 OK\r\nContent-Length: 1\r\n\r\n..."
+     [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]
+      [:headers {"content-length" "1"}]
+      [:body [46]]]
+
+    ;; The body is omitted for HEAD requests.
+    HttpMethod/HEAD "HTTP/1.1 200 OK\r\nContent-Length: 3\r\n\r\n..."
+    [[:init HttpVersion/HTTP_1_1 HttpStatus/OK]
+     [:headers {"content-length" "3"}]]
+
+    ))
+
 ;; @(http/get "http://127.0.0.1:4348" {:headers {"Connection" "Close"}})

 ;; run many HTTP request to detect any error. urls are in file /tmp/urls, one per line


direct search url test

direct search url test

--- pedestal-app/test/semtag_web/integration_test.clj
+++ pedestal-app/test/semtag_web/integration_test.clj
@@ -106,6 +106,14 @@
     (is (taxi/element (get expected-tables rel-url)) "renders correct table")
     (url-ends-with rel-url)))

+(deftest direct-search-url-works
+  (taxi/to (full-app-url "#/search?query=maxwell&search-type=tagged-with-type"))
+  (taxi/refresh)
+  (Thread/sleep 500)
+
+  (url-ends-with "#/search?query=maxwell&search-type=tagged-with-type")
+  (is (seq (taxi/elements "#search_table tbody tr"))))
+
 ;; TODO - revisit not being able to go forward - log count stays the same going forward
 #_(deftest history-works
   (click "Tag Stats")


fixed ns comment

fixed ns comment

--- src/clj_camel/core.clj
+++ src/clj_camel/core.clj
@@ -6,50 +6,7 @@
 with or without the vector.

 Expressing the routes as simple clojure vectors allows you to manipulate and compose routes with
-all the goodness of functional programming.
-
-(require '[clj-camel.core :as c])
-
-(defn test-bean [exchange body]
-  (even? body))
-
-(defn make-error-handler []
-  [[:error-handler (c/defaultErrorHandler)]
-   [:log-stack-trace true]
-   [:log-retry-stack-trace true]
-   [:log-handled true]
-   [:log-exhausted true]
-   [:retry-attempted-log-level LoggingLevel/WARN]
-   [:redelivery-delay 1000]
-   [:maximum-redeliveries 3]])
-
-(defn make-test-routes []
-  [
-   [[:from \"direct:test-route-error\"]
-    [:log \"error occurred: ${exception}\"]]
-
-   [[:from \"direst:test-route-2\"]
-    [:to \"file://test\"]]
-
-   [[:from \"direct:test-route-1\"]
-    [:route-id \"test-route-1\"]
-    [:on-exception Exception]
-    [:redelivery-delay 30000]
-    [:handled true]
-    [:to \"direct:test-route-error\"]
-    [:end]
-    [:set-header :exchange][:exchange]
-    [:bean-ref \"test-bean\" \"invoke(${header.:exchange}, ${body})\"]
-    [:to \"direct:test-route-2\"]]
-   ])
-
-(defn start-camel-context []
-  (let [r (SimpleRegistry.)
-        ctx (doto (DefaultCamelContext. r))]
-    (.put r \"test-bean\" test-bean)
-    (c/add-routes ctx (cons (make-error-handler) (make-test-routes)))
-    (.start ctx)
-    ctx))"
+all the goodness of functional programming."

 (:import [org.apache.camel.model ProcessorDefinition MulticastDefinition ThreadsDefinition ChoiceDefinition
           TryDefinition RecipientListDefinition RoutingSlipDefinition DynamicRouterDefinition


Route paths can be evaluated lists again

--- src/compojure/core.clj
+++ src/compojure/core.clj
@@ -25,12 +25,11 @@
 (defn- prepare-route
   "Pre-compile the route."
   [route]
-  (cond
-    (string? route)
-      (route-compile route)
-    (seq? route)
-      (route-compile (first route) (apply hash-map (rest route)))
-    :else route))
+  (if (string? route)
+    (route-compile route)
+    `(if (string? ~route)
+       (route-compile ~route)
+       ~route)))

 (defn- assoc-route-params
   "Associate route parameters with the request map."


CMR-1405: Removed unneeded or clause

CMR-1405: Removed unneeded or clause

--- search-app/src/cmr/search/services/transformer.clj
+++ search-app/src/cmr/search/services/transformer.clj
@@ -59,8 +59,8 @@
         concept-format (mt/mime-type->format (:format concept))
         _ (when-not concept-format
             (errors/internal-error! "Did not recognize concept format" (pr-str (:format concept))))
-        value-map (if (or (or (= format native-format)
-                              (= format :native))
+        value-map (if (or (= format native-format)
+                          (= format :native)
                           (= format concept-format))
                     (select-keys concept [:metadata :concept-id :revision-id :format])
                     (let [metadata (transform-metadata context concept format)]


Use slurp to simplify and avoid a leak.

Use slurp to simplify and avoid a leak.

--- src/od117_walker/core.clj
+++ src/od117_walker/core.clj
@@ -154,7 +154,7 @@
 (defn -main
   "Calculate and print graphs of OD-117 to ranked.dot and general.dot."
   [& args]
-  (let [{:keys [wiki-address turns]} (edn/read (java.io.PushbackReader. (io/reader "data/od117.edn")))]
+  (let [{:keys [wiki-address turns]} (edn/read-string (slurp "data/od117.edn"))]
     (let [authors (extract-links (find-id (find-and-parse-page "scholars"
                                                                wiki-address)
                                           "page-content")


Refactor to make the code more readable.

--- src/om_event_bus/impl.clj
+++ src/om_event_bus/impl.clj
@@ -17,41 +17,39 @@
   (fork [_ down up ch])
   (resolve-route [_ down up]))

-(defn handle-events!
-  [ch f]
-  (async/go-loop []
-    (let [event (async/<! ch)]
-      (when event
-        (f event)
-        (recur)))))
-
-(declare downstream-router event-bus-fork)
+(declare downstream-router event-bus-leg event-bus-fork -build-event-bus handle-events!)

 (defn event-bus
   ([]
     (event-bus (downstream-router)))
   ([router]
-    (event-bus router (async/mult (async/chan)) true))
-  ([router mult close]
-    (let [bus (reify
-            IEventBus
-            (tap [_ ch]
-              (async/tap mult ch))
-            (sink [_ bus]
-              (tap bus (async/muxch* mult)))
-            (add-fork [this handler]
-              (event-bus-fork this router handler))
-            (add-leg [this]
-              (event-bus router mult false))
-            (put [_ event]
-              (async/put! (async/muxch* mult) event))
-            (shutdown [_]
-              (async/untap-all mult)
-              (when close
-                (async/close! (async/muxch* mult))))
-            (route-event [this event]
-              (put this event)))]
-      bus)))
+    (-build-event-bus router (async/mult (async/chan)) true)))
+
+(defn event-bus-leg
+  [router mult]
+  (-build-event-bus router mult false))
+
+(defn -build-event-bus
+  [router mult close]
+  (let [bus (reify
+              IEventBus
+              (tap [_ ch]
+                (async/tap mult ch))
+              (sink [_ bus]
+                (tap bus (async/muxch* mult)))
+              (add-fork [this handler]
+                (event-bus-fork this router handler))
+              (add-leg [this]
+                (event-bus-leg router mult))
+              (put [_ event]
+                (async/put! (async/muxch* mult) event))
+              (shutdown [_]
+                (async/untap-all mult)
+                (when close
+                  (async/close! (async/muxch* mult))))
+              (route-event [this event]
+                (put this event)))]
+    bus))

 (defn event-bus-fork
   ([down-bus router]
@@ -69,8 +67,8 @@
                      (async/put! (async/muxch* up-mult) event))
                    (add-fork [this handler]
                      (event-bus-fork this router handler))
-                   (add-leg [this]
-                     (event-bus router up-mult false))
+                   (add-leg [_]
+                     (event-bus-leg router up-mult))
                    (shutdown [_]
                      (async/untap-all up-mult)
                      (async/close! (async/muxch* up-mult))
@@ -104,9 +102,10 @@
     (resolve-route [_ down _]
       down)))

-
-
-;; TODO: Write tests.
-;; TODO: Allow IEventBus to extend itself so components have no knowledge of that.
-;; TODO: Add support for xforms.
-;; TODO: See if trigger (of ITrigger) can be used on owner and bus to make it more consistent (see om/specify-state-methods!).+(defn handle-events!
+  [ch f]
+  (async/go-loop []
+    (let [event (async/<! ch)]
+      (when event
+        (f event)
+        (recur)))))


Run stream send tests 100 times each.

Run stream send tests 100 times each.

This should increase the intermittent failure rate on CI.

--- web/test-integration/immutant/web/integ_test.clj
+++ web/test-integration/immutant/web/integ_test.clj
@@ -50,13 +50,37 @@
   (get-response (str (cdef-url) "set-handler")
     :query {:new-handler (pr-str form)}))

-(deftest http-session-store
+(let [serializer (java.util.concurrent.Executors/newSingleThreadExecutor)]
+  (defn mark [& msg]
+    (let [ts (.format (java.text.SimpleDateFormat. "HH:mm:ss,SSS")
+               (java.util.Date.))
+          ^Runnable r #(apply println ts msg)]
+      (when (in-container?) (apply println ts msg))
+      (.submit serializer r))))
+
+(defmacro marktest [t & body]
+  `(deftest ~t
+     (let [v# (-> ~t var meta :name)]
+       (mark "START" v#)
+       ~@body
+       (mark "FINISH" v#))))
+
+(defmacro flog
+  "runs the body 100 times"
+  [& body]
+  `(dotimes [n# 100]
+     (mark (format "RUNNING %s (iteration %s)"
+             (-> *testing-vars* first meta :name)
+             n#))
+     ~@body))
+
+(marktest http-session-store
   (is (= "0" (get-body (url) :cookies nil)))
   (is (= {:count 1} (decode (get-body (str (url) "session")))))
   (is (= "1" (get-body (url))))
   (is (= {:count 2} (decode (get-body (str (url) "session"))))))

-(deftest session-invalidation
+(marktest session-invalidation
   (let []
     (is (= "0" (get-body (url) :cookies nil)))
     (is (= "1" (get-body (url))))
@@ -66,7 +90,7 @@
       (is (= expected (-> @cookies first (select-keys [:name :value]))))
       (is (= "0" (get-body (url)))))))

-(deftest share-session-with-websocket
+(marktest share-session-with-websocket
   (is (= "0" (get-body (url) :cookies nil)))
   (is (= "1" (get-body (url))))
   (let [result (promise)]
@@ -78,7 +102,7 @@
         (is (= {:count 2} (:session upgrade))))))
   (is (= "2" (get-body (url)))))

-(deftest request-map-entries
+(marktest request-map-entries
   (get-body (url)) ;; ensure there's something in the session
   (let [request (decode (get-body (str (url) "dump/request?query=help") :headers {:content-type "text/html; charset=utf-8"}))]
     (are [x expected] (= expected (x request))
@@ -98,7 +122,7 @@
     (is (map? (:headers request)))
     (is (< 3 (count (:headers request))))))

-(deftest upgrade-request-map-entries
+(marktest upgrade-request-map-entries
   (let [request (promise)]
     (with-open [s (ws/connect (str (url "ws") "dump?x=y&j=k")
                     :on-receive (fn [m] (deliver request (decode m))))]
@@ -116,14 +140,14 @@
         (is (= "Upgrade" (get-in m [:headers "connection"])))
         (is (= "k" (get-in m [:params "j"])))))))

-(deftest response-charset-should-be-honored
+(marktest response-charset-should-be-honored
   (doseq [charset ["UTF-8" "Shift_JIS" "ISO-8859-1" "UTF-16" "US-ASCII"]]
     (let [{:keys [headers raw-body]} (get-response (str (url) "charset?charset=" charset))]
       (is (= (read-string (headers "BodyBytes"))
             (into [] (.toByteArray raw-body)))))))

 (when (in-container?)
-  (deftest run-in-container-outside-of-init-should-throw
+  (marktest run-in-container-outside-of-init-should-throw
     (try
       (web/run identity)
       (is false)
@@ -132,7 +156,7 @@

 ;; async

-(deftest chunked-streaming
+(marktest chunked-streaming
   (with-open [client (http/create-client)]
     (let [response (http/stream-seq client :get (str (url) "chunked-stream"))
           stream @(:body response)
@@ -150,7 +174,7 @@
       (is (= 10 (count @body)))
       (is (= "biscuit" (:ham headers))))))

-(deftest non-chunked-stream
+(marktest non-chunked-stream
   (let [data (apply str (repeat 128 1))]
     (let [response (get-response (str (url) "non-chunked-stream"))]
       (is (= 200 (:status response)))
@@ -158,7 +182,7 @@
       (is (= (count data) (-> response :headers :content-length read-string)))
       (is (= data (:body response))))))

-(deftest websocket-as-channel
+(marktest websocket-as-channel
   ;; initialize the session
   (get-body (str (url)) :cookies nil)
   (let [result (promise)]
@@ -169,7 +193,7 @@
       (is (= "HELLO" (deref result 5000 :failure)))
       (is (= {:count 1 :ham :sandwich} (decode (get-body (str (url) "session"))))))))

-(deftest nested-ws-routes
+(marktest nested-ws-routes
   (doseq [path ["" "foo" "foo/bar"]]
     (let [result (promise)]
       (with-open [socket (ws/connect (format "%snested-ws/%s" (url "ws") path)
@@ -178,14 +202,7 @@
         (is (= (str "/" path)
               (-> result (deref 5000 "nil") read-string :path-info)))))))

-(let [serializer (java.util.concurrent.Executors/newSingleThreadExecutor)]
-  (defn mark [& msg]
-    (let [^Runnable r #(apply println
-                         (.format (java.text.SimpleDateFormat. "HH:mm:ss,SSS")
-                           (java.util.Date.)) msg)]
-      (.submit serializer r))))
-
-(deftest concurrent-ws-requests-should-not-cross-streams
+(marktest concurrent-ws-requests-should-not-cross-streams
   (replace-handler
     '(fn [request]
        (async/as-channel request
@@ -213,7 +230,7 @@
     (doseq [client @clients]
       (.close client))))

-(deftest request-should-be-attached-to-channel-for-ws
+(marktest request-should-be-attached-to-channel-for-ws
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -234,7 +251,7 @@
       (is (= "/" (:path-info request)))
       (is (= "Upgrade" (get-in request [:headers "connection"]))))))

-(deftest ws-on-close-should-be-invoked-when-closing-on-server-side
+(marktest ws-on-close-should-be-invoked-when-closing-on-server-side
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -246,7 +263,7 @@
     (ws/send-msg socket "hello")
     (is (= 1000 (:code (read-string (get-body (str (cdef-url) "state"))))))))

-(deftest ws-on-close-should-be-invoked-when-closing-on-client
+(marktest ws-on-close-should-be-invoked-when-closing-on-client
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -257,7 +274,7 @@
     (ws/close socket)
     (is (= 1001 (:code (read-string (get-body (str (cdef-url) "state"))))))))

-(deftest ws-on-close-should-be-invoked-for-every-connection
+(marktest ws-on-close-should-be-invoked-for-every-connection
   (replace-handler
     '(do
        (reset! client-state #{})
@@ -270,7 +287,7 @@
     (ws/close socket2)
     (is (= 2 (-> (str (cdef-url) "state") get-body read-string count)))))

-(deftest ws-on-success-should-be-called-after-send
+(marktest ws-on-success-should-be-called-after-send
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -284,7 +301,7 @@
     (ws/send-msg socket "hello")
     (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))))

-(deftest ws-on-error-is-called-if-on-success-throws
+(marktest ws-on-error-is-called-if-on-success-throws
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -298,7 +315,7 @@
     (ws/send-msg socket "hello")
     (is (= "BOOM" (read-string (get-body (str (cdef-url) "state")))))))

-(deftest ws-send!-nil-should-work
+(marktest ws-send!-nil-should-work
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -312,7 +329,7 @@
     (ws/send-msg socket "hello")
     (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))))

-(deftest request-should-be-attached-to-channel-for-stream
+(marktest request-should-be-attached-to-channel-for-stream
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -333,7 +350,7 @@
     (is request)
     (is (= "/" (:path-info request)))))

-(deftest send!-to-stream-with-map-overrides-status-headers
+(marktest send!-to-stream-with-map-overrides-status-headers
   (replace-handler
     '(fn [request]
        (async/as-channel request
@@ -347,7 +364,7 @@
     (is (= 201 status))
     (is (= "bar" (:foo headers)))))

-(deftest send!-to-stream-with-map-after-send-has-started-throws
+(marktest send!-to-stream-with-map-after-send-has-started-throws
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -364,7 +381,7 @@
   (is (re-find #"this is not the first send"
         (read-string (get-body (str (cdef-url) "state"))))))

-(deftest send!-to-ws-with-map-throws
+(marktest send!-to-ws-with-map-throws
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -379,7 +396,7 @@
   (is (re-find #"channel is not an HTTP stream channel"
         (read-string (get-body (str (cdef-url) "state"))))))

-(deftest closing-a-stream-with-no-send-should-honor-original-response
+(marktest closing-a-stream-with-no-send-should-honor-original-response
   (replace-handler
     '(fn [request]
        (assoc (async/as-channel request
@@ -390,7 +407,7 @@
     (is (= 201 status))
     (is (= "biscuit" (:ham headers)))))

-(deftest stream-on-close-should-be-invoked-when-closing-on-server-side
+(marktest stream-on-close-should-be-invoked-when-closing-on-server-side
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -401,7 +418,7 @@
   (is (= nil (get-body (cdef-url))))
   (is (= :closed (read-string (get-body (str (cdef-url) "state"))))))

-(deftest nil-send!-to-stream-should-work
+(marktest nil-send!-to-stream-should-work
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -416,7 +433,7 @@
     (is (nil? body))
     (is (= :closed (read-string (get-body (str (cdef-url) "state")))))))

-(deftest stream-on-success-should-be-called-after-send
+(marktest stream-on-success-should-be-called-after-send
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -429,7 +446,7 @@
   (is (= "ahoy" (get-body (cdef-url))))
   (is (= :complete! (read-string (get-body (str (cdef-url) "state"))))))

-(deftest stream-on-error-is-called-if-on-success-throws
+(marktest stream-on-error-is-called-if-on-success-throws
   (replace-handler
     '(do
        (reset! client-state (promise))
@@ -443,7 +460,7 @@
   (is (= "ahoy" (get-body (cdef-url))))
   (is (= "BOOM" (read-string (get-body (str (cdef-url) "state"))))))

-(deftest send!-a-string
+(marktest send!-a-string
   (let [handler
         '(do
            (reset! client-state (promise))
@@ -460,19 +477,20 @@
                :on-error (fn [_ e]
                            (println "CHANNEL ERROR send!-a-string")
                            (.printStackTrace e)))))]
-    (replace-handler handler)
-    (is (= "biscuit" (get-body (cdef-url))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
-
-    (replace-handler handler)
-    (let [result (promise)]
-      (with-open [socket (ws/connect (cdef-url "ws")
-                           :on-receive (fn [m]
-                                         (deliver result m)))]
-        (is (= "biscuit" (deref result 5000 nil)))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))))
-
-(deftest send!-a-byte-array
+    (flog
+      (replace-handler handler)
+      (is (= "biscuit" (get-body (cdef-url))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
+
+      (replace-handler handler)
+      (let [result (promise)]
+        (with-open [socket (ws/connect (cdef-url "ws")
+                             :on-receive (fn [m]
+                                           (deliver result m)))]
+          (is (= "biscuit" (deref result 5000 nil)))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state"))))))))
+
+(marktest send!-a-byte-array
   (let [handler
         '(do
            (reset! client-state (promise))
@@ -489,20 +507,21 @@
                :on-error (fn [_ e]
                            (println "CHANNEL ERROR send!-a-byte-array")
                            (.printStackTrace e)))))]
-    (replace-handler handler)
-    (is (= "biscuit" (String. (get-body (cdef-url)))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
-
-    (replace-handler handler)
-    (let [result (promise)]
-      (with-open [socket (ws/connect (cdef-url "ws")
-                           :on-binary (fn [m _ _]
-                                        (deliver result m)))]
-        (is (= (into [] (.getBytes "biscuit"))
-              (into [] (deref result 5000 nil))))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))))
-
-(deftest send!-a-sequence
+    (flog
+      (replace-handler handler)
+      (is (= "biscuit" (String. (get-body (cdef-url)))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
+
+      (replace-handler handler)
+      (let [result (promise)]
+        (with-open [socket (ws/connect (cdef-url "ws")
+                             :on-binary (fn [m _ _]
+                                          (deliver result m)))]
+          (is (= (into [] (.getBytes "biscuit"))
+                (into [] (deref result 5000 nil))))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state"))))))))
+
+(marktest send!-a-sequence
   (let [handler
         '(do
            (reset! client-state (promise))
@@ -519,27 +538,28 @@
                :on-error (fn [_ e]
                            (println "CHANNEL ERROR send!-a-sequence")
                            (.printStackTrace e)))))]
-    (replace-handler handler)
-    (is (= "hambiscuitgravy" (String. (get-body (cdef-url)))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
-
-    (replace-handler handler)
-    (let [done? (promise)
-          results (atom [])]
-      (with-open [socket (ws/connect (cdef-url "ws")
-                           :on-receive (fn [m]
-                                         (swap! results conj m)
-                                         (when (= 3 (count @results))
-                                           (deliver done? true)))
-                           :on-binary (fn [m _ _]
-                                        (swap! results conj m)))]
-        (is (deref done? 5000 nil))
-        (let [[h b g] @results]
-          (is (= ["ham" (into [] (.getBytes "biscuit")) "gravy"]
-                [h (into [] b) g])))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))))
-
-(deftest send!-an-empty-sequence
+    (flog
+      (replace-handler handler)
+      (is (= "hambiscuitgravy" (String. (get-body (cdef-url)))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
+
+      (replace-handler handler)
+      (let [done? (promise)
+            results (atom [])]
+        (with-open [socket (ws/connect (cdef-url "ws")
+                             :on-receive (fn [m]
+                                           (swap! results conj m)
+                                           (when (= 3 (count @results))
+                                             (deliver done? true)))
+                             :on-binary (fn [m _ _]
+                                          (swap! results conj m)))]
+          (is (deref done? 5000 nil))
+          (let [[h b g] @results]
+            (is (= ["ham" (into [] (.getBytes "biscuit")) "gravy"]
+                  [h (into [] b) g])))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state"))))))))
+
+(marktest send!-an-empty-sequence
   (let [handler
         '(do
            (reset! client-state (promise))
@@ -556,15 +576,16 @@
                :on-error (fn [_ e]
                            (println "CHANNEL ERROR send!-an-empty-sequence")
                            (.printStackTrace e)))))]
-    (replace-handler handler)
-    (get-body (cdef-url))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
-
-    (replace-handler handler)
-    (with-open [socket (ws/connect (cdef-url "ws"))]
-      (is (= :complete! (read-string (get-body (str (cdef-url) "state"))))))))
-
-(deftest send!-a-file
+    (flog
+      (replace-handler handler)
+      (get-body (cdef-url))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
+
+      (replace-handler handler)
+      (with-open [socket (ws/connect (cdef-url "ws"))]
+        (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))))))
+
+(marktest send!-a-file
   (let [handler
         '(do
            (reset! client-state (promise))
@@ -582,22 +603,23 @@
                :on-error (fn [_ e]
                            (println "CHANNEL ERROR send!-a-file")
                            (.printStackTrace e)))))]
-    (replace-handler handler)
-    (is (= (slurp (io/file (io/resource "public/foo.html")))
-          (String. (get-body (cdef-url)))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
-
-    (replace-handler handler)
-    (let [result (promise)]
-      (with-open [socket (ws/connect (cdef-url "ws")
-                           :on-binary (fn [m _ _]
-                                        (deliver result m)))]
-        (is (= (into [] (-> (io/resource "public/foo.html")
-                          io/file slurp .getBytes))
-              (into [] (deref result 5000 nil))))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))))
-
-(deftest send!-with-input-stream-larger-than-size-hint
+    (flog
+      (replace-handler handler)
+      (is (= (slurp (io/file (io/resource "public/foo.html")))
+            (String. (get-body (cdef-url)))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
+
+      (replace-handler handler)
+      (let [result (promise)]
+        (with-open [socket (ws/connect (cdef-url "ws")
+                             :on-binary (fn [m _ _]
+                                          (deliver result m)))]
+          (is (= (into [] (-> (io/resource "public/foo.html")
+                            io/file slurp .getBytes))
+                (into [] (deref result 5000 nil))))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state"))))))))
+
+(marktest send!-with-input-stream-larger-than-size-hint
   (let [handler
         '(do
            (reset! client-state (promise))
@@ -618,23 +640,24 @@
                            (.printStackTrace e)))))
         data (->> "data"
                io/resource io/file slurp)]
-    (replace-handler handler)
-    (is (= data (get-body (cdef-url))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
-
-    (replace-handler handler)
-    (let [done? (promise)
-          rcvd (atom "")]
-      (with-open [socket (ws/connect (cdef-url "ws")
-                           :on-binary (fn [m _ _]
-                                        (when (= (+ 2 (* 16 1024))
-                                                (count (swap! rcvd #(str % (String. m)))))
-                                          (deliver done? true))))]
-        (is (deref done? 5000 nil))
-        (is (= data @rcvd))))
-    (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))))
-
-(deftest ws-should-timeout-when-idle
+    (flog
+      (replace-handler handler)
+      (is (= data (get-body (cdef-url))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state")))))
+
+      (replace-handler handler)
+      (let [done? (promise)
+            rcvd (atom "")]
+        (with-open [socket (ws/connect (cdef-url "ws")
+                             :on-binary (fn [m _ _]
+                                          (when (= (+ 2 (* 16 1024))
+                                                  (count (swap! rcvd #(str % (String. m)))))
+                                            (deliver done? true))))]
+          (is (deref done? 5000 nil))
+          (is (= data @rcvd))))
+      (is (= :complete! (read-string (get-body (str (cdef-url) "state"))))))))
+
+(marktest ws-should-timeout-when-idle
   (let [handler
         '(do
            (reset! client-state (promise))
@@ -658,7 +681,7 @@
       (is (= "open" (deref ready 1000 :failure)))
       (is (= :closed (read-string (get-body (str (cdef-url) "state"))))))))

-(deftest ws-timeout-should-occur-when-truly-idle
+(marktest ws-timeout-should-occur-when-truly-idle
   (let [handler
         '(do
            (reset! client-state (promise))
@@ -691,7 +714,7 @@
       (Thread/sleep 150)
       (is (= :closed (read-string (get-body (str (cdef-url) "state"))))))))

-(deftest stream-timeouts
+(marktest stream-timeouts
   (if (or (immutant.web.internal.servlet/async-streaming-supported?)
         (not (in-container?)))
     (let [handler
@@ -706,9 +729,10 @@
                  :on-close (fn [_ reason]
                              (println "CLOSE stream-should-timeout")
                              (deliver @client-state :closed)))))]
-      (replace-handler handler)
-      (is (= 200 (:status (get-response (cdef-url)))))
-      (is (= :closed (read-string (get-body (str (cdef-url) "state"))))))
+      (flog
+        (replace-handler handler)
+        (is (= 200 (:status (get-response (cdef-url)))))
+        (is (= :closed (read-string (get-body (str (cdef-url) "state")))))))
     ;; in WF 8.2, a timeout causes a deadlock in ispan around the
     ;; session, so we don't allow timeouts there
     (let [handler
@@ -718,9 +742,7 @@
                (try
                  (async/as-channel request
                    :timeout 100)
-                 (println "TOO FAR")
                  (catch IllegalArgumentException e
-                   (println "HEY" e)
                    (deliver @client-state (.getMessage e))
                    {:status 500}))))]
       (replace-handler handler)
@@ -733,7 +755,7 @@
 (when (not (in-container?))
   ;; TODO: Run this in-container. The only thing stopping us is our
   ;; jersey sse client seems to be incompatible with resteasy
-  (deftest server-sent-events
+  (marktest server-sent-events
     (let [closed (promise)
           result (atom [])
           client (as-> (event-source (str (url) "sse")) c


remove unnecessary atom

remove unnecessary atom

--- src/overtone/sc/mixer.clj
+++ src/overtone/sc/mixer.clj
@@ -10,7 +10,6 @@
 (defonce master-vol*  (ref MASTER-VOL))
 (defonce master-gain* (ref MASTER-GAIN))
 (defonce bus-mixers*  (ref {:in [] :out []}))
-(defonce recording-flag* (atom nil))

 (add-watch master-vol*
            ::update-vol-on-server


prevent selection jumping when toggling docs/code visibility

--- cljs/src/main/plastic/cogs/editor/model.cljs
+++ cljs/src/main/plastic/cogs/editor/model.cljs
@@ -7,7 +7,8 @@
             [clojure.walk :refer [prewalk]]
             [plastic.cogs.editor.parser.utils :as parser]
             [plastic.util.helpers :as helpers]
-            [plastic.util.zip :as zip-utils]))
+            [plastic.util.zip :as zip-utils]
+            [plastic.cogs.editor.render.dom :as dom]))

 (defn parsed? [editor]
   (contains? editor :parse-tree))
@@ -51,7 +52,12 @@
     (set-selections editor new-selections)))

 (defn set-render-state [editor render-state]
-  (assoc-in editor [:render-state] render-state))
+  (if (= (:render-state editor) render-state)
+    editor
+    (let [new-editor (assoc-in editor [:render-state] render-state)]
+      (dom/postpone-selection-overlay-display-until-next-update editor)
+      (dom/postpone-selection-overlay-display-until-next-update new-editor)
+      new-editor)))

 (defn get-id [editor]
   {:post [(pos? %)]}
@@ -72,7 +78,7 @@
 (defn get-top-level-locs [editor]
   (let [top-loc (zip-utils/make-zipper (get-parse-tree editor)) ; root "forms" node
         first-top-level-form-loc (zip/down top-loc)]
-    (zip-utils/collect-all-right first-top-level-form-loc)))    ; TODO: here we should use explicit zipping policy
+    (zip-utils/collect-all-right first-top-level-form-loc))) ; TODO: here we should use explicit zipping policy

 (defn loc-id? [id loc]
   (= (:id (zip/node loc)) id))


update docstrings

update docstrings

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -533,8 +533,8 @@
 (def ^{:dynamic true} *demo-time* 2000)

 (defmacro run
-  "Run an anonymous synth definition.  Useful for experimentation. Does NOT add
-  an out ugen.
+  "Run an anonymous synth definition for a fixed period of time.  Useful for
+  experimentation. Does NOT add  an out ugen - see #'demo for that..
   You can specify a timeout in seconds as the first argument otherwise it
   defaults to *demo-time* ms.

@@ -550,10 +550,10 @@
        note#)))

 (defmacro demo
-  "Try out an anonymous synth definition.  Useful for experimentation.  If the
-  root node is not an out ugen, then it will add one automatically.
-  You can specify a timeout in seconds as the first argument otherwise it
-  defaults to *demo-time* ms.
+  "Listen to an anonymous synth definition for a fixed period of time.  Useful
+  for experimentation.  If the root node is not an out ugen, then it will add
+  one automatically.  You can specify a timeout in seconds as the first argument
+  otherwise it defaults to *demo-time* ms.

   (play (sin-osc 440))      ;=> plays a sine wave for *demo-time* ms
   (play 0.5 (sin-osc 440))  ;=> plays a sine wave for half a second"


significantly improve performance

significantly improve performance

--- src/pain_tetris/core.cljs
+++ src/pain_tetris/core.cljs
@@ -19,12 +19,13 @@
                 {:target (. js/document (getElementById "painTetris"))}))

 (defn setup []
-  ; Set frame rate to 30 frames per second.
-  (q/frame-rate 5)
-  ; Set color mode to HSB (HSV) instead of default RGB.
+  ;; Set frame rate to 30 frames per second.
+  (q/frame-rate 10)
+  ;; Set color mode to HSB (HSV) instead of default RGB.
   (q/color-mode :hsb)
   (t/start-game @t/block-speed)
   {:color 0
+   :last-grid (atom)
    :game (apply q/create-graphics (d/game-size t/grid-dims))
    :border (apply q/create-graphics (d/canvas-size t/grid-dims))})

@@ -33,18 +34,20 @@

 (defn draw-state [state]
   (let [game (get state :game)
-        border (get state :border)]
-    (.beginDraw border)
-    (q/background 255 255 255 0)
-    (.endDraw border)
-    (.beginDraw game)
-    (q/fill 255)
-    (d/clear-game t/grid-dims)
-    (q/stroke-weight 0)
-    (q/stroke-join :round)
-    (d/draw-grid @t/grid)
-    (.endDraw game)
-    ))
+        border (get state :border)
+        last-grid (get state :last-grid)]
+    (when (not (= @last-grid @t/grid))
+      (reset! last-grid @t/grid)
+      (.beginDraw border)
+      (q/background 255 255 255 0)
+      (.endDraw border)
+      (.beginDraw game)
+      (q/fill 255)
+      (d/clear-game t/grid-dims)
+      (q/stroke-weight 0)
+      (q/stroke-join :round)
+      (d/draw-grid @t/grid)
+      (.endDraw game))))

 (defn on-js-reload
   []


Indentation

Indentation

--- src/polismath/metrics.clj
+++ src/polismath/metrics.clj
@@ -1,13 +1,16 @@
 (ns polismath.metrics)
+

 (defn make-socket
 	([] (new java.net.DatagramSocket))
 	([port] (new java.net.DatagramSocket port)))

+
 (defn send-data [send-socket ip port data]
   (let [ipaddress (java.net.InetAddress/getByName ip),
         send-packet (new java.net.DatagramPacket (.getBytes data) (.length data) ipaddress port)]
   (.send send-socket send-packet)))
+

 (defn receive-data [receive-socket]
   (let [receive-data (byte-array 1024),
@@ -15,19 +18,21 @@
   (.receive receive-socket receive-packet)
   (new java.lang.String (.getData receive-packet) 0 (.getLength receive-packet))))

+
 (defn make-receive [receive-port]
 	(let [receive-socket (make-socket receive-port)]
 		(fn [] (receive-data receive-socket))))

+
 (defn make-send [hostname port]
 	(let [send-socket (make-socket)]
-          (fn [data]
-            (println "sending " data " to " hostname ":" port)
-            (send-data send-socket hostname port data))))
+    (fn [data]
+      (println "sending " data " to " hostname ":" port)
+      (send-data send-socket hostname port data))))
+

 (defn make-metric-sender [hostname port carbon-api-key]
-  (let
-      [dosend (make-send hostname port)]
+  (let [dosend (make-send hostname port)]
     (fn
       ([name value optionalTimestampMillis]
          (let [s (str carbon-api-key "." name " " value " " (long (/ optionalTimestampMillis 1000)) "\n")]
@@ -36,11 +41,6 @@
       ([name value]
          (let [s (str carbon-api-key "." name " " value "\n")]
            (println s)
-           (dosend s))
-         )
-      )
-    )
-  )
+           (dosend s))))))

-


fixes #235

fixes #235

--- src/daiquiri/util.cljc
+++ src/daiquiri/util.cljc
@@ -55,8 +55,11 @@
 (defn fragment-tag?
   "Returns true if `tag` is the fragment tag \"*\" or \"<>\", otherwise false."
   [tag]
-  (or (= (name tag) "*")
-      (= (name tag) "<>")))
+  (and (or (keyword? tag)
+           (symbol? tag)
+           (string? tag))
+       (or (= (name tag) "*")
+           (= (name tag) "<>"))))

 (defn fragment? [v]
   (and (vector? v)


refactor file-content-sans-ns

refactor file-content-sans-ns

Wasn't really happy with the previous implementation with internal state
held in an atom

--- src/refactor_nrepl/ns/dependencies.clj
+++ src/refactor_nrepl/ns/dependencies.clj
@@ -213,13 +213,13 @@

 (defn- file-content-sans-ns [file-content]
   (let [rdr (PushbackReader. (StringReader. file-content))
-        ns (read rdr false :eof)
-        contents (atom [])]
-    (loop [form (read rdr false :eof)]
-      (when-not (= form :eof)
-        (swap! contents conj form)
-        (recur (read rdr false :eof))))
-    (str/join "\n" @contents)))
+        ns (read rdr false :eof)]
+    (str/join "\n"
+              (loop [form (read rdr false :eof)
+                     contents []]
+                (if (= form :eof)
+                  contents
+                  (recur (read rdr false :eof) (conj contents form)))))))

 (defn- macro-in-use? [file-content macro]
   (let [m (Pattern/quote (str macro))


STORM-867: fix bug with mk-ssl-connector

--- storm-core/src/clj/backtype/storm/ui/helpers.clj
+++ storm-core/src/clj/backtype/storm/ui/helpers.clj
@@ -149,9 +149,9 @@
     (if (and (not-nil? ts-path) (not-nil? ts-password) (not-nil? ts-type))
       ((.setTrustStore sslContextFactory ts-path)
        (.setTrustStoreType sslContextFactory ts-type)
-       (.setTrustStoreType sslContextFactory ts-password)))
-    (if (need-client-auth) (.setNeedClientAuth sslContextFactory true)
-        (if (want-client-auth) (.setWantClientAuth sslContextFactory true)))
+       (.setTrustStorePassword sslContextFactory ts-password)))
+    (if need-client-auth (.setNeedClientAuth sslContextFactory true)
+        (if want-client-auth (.setWantClientAuth sslContextFactory true)))
     (doto (SslSocketConnector. sslContextFactory)
       (.setPort port))))


Allow upsertion of unique, card-many values

--- src/datascript/db.cljc
+++ src/datascript/db.cljc
@@ -945,6 +945,13 @@
                :entity entity
                :assertion acc }))))

+(defn- collapse-multi-val
+  [db a v]
+  (if (is-attr? db a :db.cardinality/many)
+    (if (coll? v)
+      (-> v sort first)
+      v)
+    v))

 (defn- upsert-eid [db entity]
   (when-some [idents (not-empty (-attrs-by db :db.unique/identity))]
@@ -952,7 +959,7 @@
       (reduce-kv
         (fn [acc a v] ;; acc = [e a v]
           (if (contains? idents a)
-            (if-some [e (:e (first (-datoms db :avet [a v])))]
+            (if-some [e (:e (first (-datoms db :avet [a (collapse-multi-val v)])))]
               (cond
                 (nil? acc)        [e a v] ;; first upsert
                 (= (get acc 0) e) acc     ;; second+ upsert, but does not conflict


fix - supply version key and comparator for sql-model

--- dada-core/src/main/clojure/org/dada/core.clj
+++ dada-core/src/main/clojure/org/dada/core.clj
@@ -245,7 +245,7 @@
        (proxy [Creator] [] (create [args] args))
        [0]
        [1]
-       (proxy [Metadata$Comparator][] (highest [v1 v2] (if (>= (nth 1 v1) (nth 1 v2)) v1 v2)))
+       (proxy [Metadata$Comparator][] (higher [[_ v1] [_ v2]] (> v1 v2)))
        (map
 	(fn [i] (Attribute. i Integer (= i 0) (proxy [Getter] [] (get [s] (nth s i)))))
 	(range length))))
@@ -343,7 +343,7 @@
   "make a SQL query and return the ResultSet as a Model"
   [model-name #^Connection connection #^String sql]
   (let [result-set (.executeQuery (.prepareStatement connection sql))
-	metadata (record-metadata [:id] (sql-attributes (.getMetaData result-set))) ;lets use records...
+	metadata (record-metadata [:id] [] nil (sql-attributes (.getMetaData result-set))) ;lets use records...
 	data (sql-data metadata result-set)
 	sql-model (model model-name nil metadata)]
     (.close result-set)


Remove stale sources even if no packets arrive.

--- src/afterglow/dj_link.clj
+++ src/afterglow/dj_link.clj
@@ -192,6 +192,7 @@
   which are currently visible on the network."
   []
   (start-if-needed)
+  (remove-stale-sources)
   (set (for [[k v] (:sources-seen @state)] (:source v))))

 (defn filter-sources


Tidy up

Tidy up

--- src/discuss/views.cljs
+++ src/discuss/views.cljs
@@ -8,7 +8,6 @@
             [discuss.extensions]
             [discuss.find :as find]
             [discuss.history :as history]
-            [discuss.integration :as integration]
             [discuss.utils.common :as lib]
             [discuss.utils.views :as vlib]
             [discuss.references :as ref]


Factoring out common function

Factoring out common function

--- src/tabular/grafter/tabular/common.clj
+++ src/tabular/grafter/tabular/common.clj
@@ -87,6 +87,11 @@
         (.substring 1)
         keyword)))

+(defn format-or-type [file {:keys [format]}]
+  (if (#{File String} (class file))
+    (or format (extension file))
+    (class file)))
+
 (defmulti open-dataset*
   "Opens a dataset from a datasetable thing i.e. a filename or an existing Dataset.
 The multi-method dispatches based upon a :format option. If this isn't provided then
@@ -97,10 +102,7 @@
 :ext - An overriding file extension (as keyword) to force a particular
        file type to be opened instead of looking at the files extension."

-  (fn [file {:keys [format]}]
-    (if (#{File String} (class file))
-      (or format (extension file))
-      (class file))))
+  format-or-type)

 (defmethod open-dataset* Dataset [dataset opts]
   dataset)
@@ -141,8 +143,7 @@
   (fn [multidatasetable {:keys [format] :as opts}]
     (when (:sheet opts)
       (throw (IllegalArgumentException. "open-datasets cannot open a single sheet.  Use open-dataset* to do this.")))
-    (or format
-        (extension multidatasetable))))
+    (format-or-type multidatasetable format)))

 (defn open-datasets
   "Opens a lazy sequence of datasets from a something that returns multiple


temporary fix for pause

temporary fix for pause

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -68,8 +68,9 @@
                                                :stop on-drag-stop})
 (defn pause []
   (.pause js/soundManager current-sound-id)
-  (.emit socket "pause" (* (.-duration (:current-sound @app-state))
-                           (.-position (:current-sound @app-state)))))
+  (.emit socket "pause" (.-position (:current-sound @app-state))))
+  ;(.emit socket "pause" (* (.-duration (:current-sound @app-state))
+  ;                         (.-position (:current-sound @app-state)))))

 (defn resume []
   (.emit socket "resume"))


commenting out test input

commenting out test input

--- src/gc_parser/core.clj
+++ src/gc_parser/core.clj
@@ -87,14 +87,15 @@
       (let [writeln (fn [x] (.write w (str x NEWLINE)))]
         (writeln headers_ALL_GC_TYPES)
         (doseq [line gcdata]
+            ;(println (str "line=" line))
           (resolve_line line writeln))))))

 ;(process-gc-file-preformat "input/gc.parOld-test.log" TMP_GC_FILE )
 ;(process-gc-file TMP_GC_FILE "data.txt")

-(process-gc-file-preformat "input/parOld-jdk8.log" TMP_GC_FILE )
-(process-gc-file TMP_GC_FILE "data.txt")
+;(process-gc-file-preformat "input/parOld-jdk8.log" TMP_GC_FILE )
+;(process-gc-file TMP_GC_FILE "data.txt")

 ;(process-gc-file-preformat "input/gc.G1.log" TMP_GC_FILE )