more score methods for zippy focus

more score methods for zippy focus

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

--- autofocus/ZippyFocus/src/zippy_focus/core.clj
+++ autofocus/ZippyFocus/src/zippy_focus/core.clj
@@ -1,6 +1,7 @@
 (ns zippy-focus.core
-  (:import [org.micromanager.utils PropertyItem]
-           [org.micromanager.api Autofocus])
+  (:import [org.micromanager.utils ImageUtils PropertyItem]
+           [org.micromanager.api Autofocus]
+           [ij ImagePlus])
   (:use [org.micromanager.mm
             :only (load-mm gui mmc core double-vector)])
   (:gen-class
@@ -25,19 +26,36 @@
       (core isSequenceRunning)))

 (defn pop-burst-image []
-  (while (and (. mmc isSequenceRunning)
+  (while (and ;(. mmc isSequenceRunning)
               (zero? (. mmc getRemainingImageCount)))
     (Thread/sleep 1))
   (core popNextImage))

-(defn grab-images []
-  (doall
-    (for [_ (range) :while (more-images-expected)]
-      (pop-burst-image))))
+(defn grab-images [n]
+    (for [_ (range n) :while (more-images-expected)]
+      (pop-burst-image)))
+
+(defn image-stat [img]
+  (.. ImageUtils (makeProcessor mmc img) getStatistics))
+
+(defn image-mean [img]
+  (.mean (image-stat img)))
+
+(defn image-std-dev [img]
+  (let [stat (image-stat img)]
+    (/ (.stdDev stat) (.mean stat))))
+
+(defn image-sharpness [img]
+  (let [proc (ImageUtils/makeProcessor mmc img)
+        mean (.. proc getStatistics mean)
+        mean-edge (do (.findEdges proc) (.. proc getStatistics mean))]
+    (/ mean-edge mean)))

 (defn score-image [score-type img]
   (condp = score-type
-    "Sum" (apply + img)
+    "Mean" (image-mean img)
+    "StdDev" (image-std-dev img)
+    "Sharpness" (image-sharpness img)
     0))

 (defn acquire-images [z-drive trigger exposure]
@@ -45,9 +63,8 @@
     (core setPosition z-drive (first trigger))
     (core loadStageSequence z-drive (double-vector trigger))
     (core startStageSequence z-drive)
-    (core waitForDevice z-drive)
     (core startSequenceAcquisition (count trigger) 0 false)
-    (grab-images))
+    (grab-images (count trigger)))

 (defn run-autofocus [search-params]
   (let [z-drive (core getFocusDevice)
@@ -55,17 +72,20 @@
         trigger (make-sweep-vector current-z search-params)
         current-exposure (core getExposure)]
     (let [images (acquire-images z-drive trigger (:exposure search-params))
-          scores (map #(score-image "Sum" %) images)
+          scores (map #(score-image (:score-type search-params) %) (seque images))
           best-index (apply max-key #(nth scores %) (range (count images)))
           best-z (nth trigger best-index)]
+      (core stopSequenceAcquisition)
+      (core stopStageSequence z-drive)
       (core setPosition z-drive best-z)
       (core setExposure current-exposure)
       best-z)))

 (defn run-test []
   (reset! search-params
-          {:range 10
-           :tolerance 1.00
-           :score-type "Sum"
-           :exposure 10})
-  (run-autofocus @search-params))+          {:range 5
+           :tolerance 0.25
+           :score-type "Sharpness"
+           :exposure 2})
+  (run-autofocus @search-params)
+  (. gui snapSingleImage))


Fix how defjscomponents resolves JS component definitions

This is necessary for the component factory functions created by
defjscomponents to work with CLJS advanced optimizations. The trick
here is to use (aget <JS module> <component name>) instead of
js/<JS module>.<component name>.

--- src/main/workflo/macros/jscomponents.clj
+++ src/main/workflo/macros/jscomponents.clj
@@ -6,12 +6,12 @@

 (defn defjscomponent*
   [module name]
-  (let [fn-sym (symbol (camel->kebab name))
-        js-sym (symbol "js" (str module "." name))]
+  (let [fn-sym     (symbol (camel->kebab name))
+        module-sym (symbol "js" (str module))]
     `(defn ~fn-sym [props# & children#]
        (.apply ~(symbol "js" "React.createElement") nil
                (into-array
-                (cons ~js-sym
+                (cons (~'aget ~module-sym ~(str name))
                       (cons (~'clj->js props#)
                             children#)))))))


fix issue where sync failed to recognize URL fields. Run in parallel for faster syncing.

--- src/metabase/driver/generic_sql/sync.clj
+++ src/metabase/driver/generic_sql/sync.clj
@@ -68,9 +68,10 @@
   [database]
   (with-jdbc-metadata database
     (fn [md] (->> (-> md
-                    (.getTables nil nil nil (into-array String ["TABLE"])) ; ResultSet getTables(String catalog, String schemaPattern, String tableNamePattern, String[] types)
-                    jdbc/result-set-seq)
-               (mapv :table_name)))))
+                     (.getTables nil nil nil (into-array String ["TABLE"])) ; ResultSet getTables(String catalog, String schemaPattern, String tableNamePattern, String[] types)
+                     jdbc/result-set-seq)
+                 (map :table_name)
+                 doall))))

 (defn jdbc-columns
   "Fetch information about the various columns for Table with TABLE-NAME by getting JDBC metadata for DATABASE."
@@ -110,20 +111,21 @@
   "Sync `Fields` for TABLE."
   [korma-table {table-id :id, table-name :name, db :db}]
   (->> (jdbc-columns db table-name)
-       (map (fn [{:keys [type_name column_name]}]
-              (or (sel :one Field :table_id table-id :name column_name)
-                  (ins Field
-                    :table_id table-id
-                    :name column_name
-                    :base_type (or (*column->base-type* (keyword type_name))
-                                   (throw (Exception. (str "Column '" column_name "' has an unknown type: '" type_name
-                                                           "'. Please add the type mapping to corresponding driver (e.g. metabase.driver.postgres.sync)."))))))))
-       (map (fn [field]
-              (try
-                (check-for-low-cardinality korma-table field)
-                (check-for-large-average-length korma-table field)
-                (check-for-urls korma-table field)
-                (catch Throwable _))))
+       (pmap (fn [{:keys [type_name column_name]}]
+               (or (sel :one Field :table_id table-id :name column_name)
+                   (ins Field
+                     :table_id table-id
+                     :name column_name
+                     :base_type (or (*column->base-type* (keyword type_name))
+                                    (throw (Exception. (str "Column '" column_name "' has an unknown type: '" type_name
+                                                            "'. Please add the type mapping to corresponding driver (e.g. metabase.driver.postgres.sync)."))))))))
+       (pmap (fn [field]
+               (try
+                 (check-for-low-cardinality korma-table field)
+                 (check-for-large-average-length korma-table field)
+                 (check-for-urls korma-table field)
+                 (catch Throwable e
+                   (log/warn (format "Caught exception when syncing field '%s.%s':" table-name (:name field)) e)))))
        dorun))

@@ -200,13 +202,13 @@
     (if (= total-non-null-count 0) 0
         (let [url-count (-> (select korma-table
                                     (aggregate (count :*) :count)
-                                    (where {(keyword field-name) [like "http%://_%.__%"]})) first :count)]
-          (float (/ url-count total-non-null-count))))))
+                                    (where {(keyword field-name) [like "http%://_%.__%"]})) first :count)] ; This is how the old Django app worked. Didn't match URLs like
+          (float (/ url-count total-non-null-count))))))                                                   ; "www.zagat.com". Is this what we want?

 (defn- check-for-urls
   "Check a Field to see if the majority of its *NON-NULL* values are URLs; if so, mark it as `special_type = :url`.
    This only applies to textual fields that *do not* already have a `special_type.`"
-  [korma-table {special-type :special_type, base-type :base_type, field-name :name, field-id :id}]
+  [korma-table {special-type :special_type, base-type :base_type, field-name :name, field-id :id, :as field}]
   (when (and (not special-type)
              (contains? #{:CharField :TextField} base-type))
     (let [percent-urls (field-percent-urls korma-table field)]


Shorten fn a bit.

Shorten fn a bit.

--- src/onyx/windowing/window_extensions.clj
+++ src/onyx/windowing/window_extensions.clj
@@ -141,7 +141,7 @@

   (merge-extents [this extents super-agg-fn segment]
     (let [session-key (get segment (:window/session-key window))]
-      (loop [ks (sort-by :session-lower-bound (filter (fn [e] (= (:session-key e) session-key)) (keys extents)))
+      (loop [ks (sort-by :session-lower-bound (filter #(= (:session-key %) session-key) (keys extents)))
              results (into {} (filter (fn [[e v]] (not= (:session-key e) session-key)) extents))]
         (if-not (seq ks)
           results


(PDB-2231) Fix max-command-size String comparison

Check that when the incoming command is a (legacy) String, it isn't
bigger than 2x max-command-size (given Java's UCS-2 encoding).  The
previous comparison was unintentionally reversed.

--- src/puppetlabs/puppetdb/http/command.clj
+++ src/puppetlabs/puppetdb/http/command.clj
@@ -182,9 +182,9 @@
        (restrained-drained-stream body (long max-command-size)))

       (string? body)
-      ;; Given Java's (UCS-2) encoding, the size should be effectively
-      ;; two bytes per character.
-      (if (> (* 2 (count body)) max-command-size)
+      ;; Given Java's UCS-2 encoding, incoming UTF-8 more or less
+      ;; doubles in size when converted to a String.
+      (if (> (count body) (* 2  max-command-size))
         (throw+ ::body-stream-overflow)
         body)


make sure to fill the greatest with the min values

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

--- src/aurora/join.cljs
+++ src/aurora/join.cljs
@@ -15,14 +15,8 @@
     (assert (== as-len bs-len) (pr-str as bs))
     (loop [i 0]
       (if (< i as-len)
-        (let [a (aget as i)
-              b (aget bs i)
-              a (if (nil? a)
-                  (aget fill i)
-                  a)
-              b (if (nil? b)
-                  (aget fill i)
-                  b)]
+        (let [a (or (aget as i) (aget fill i))
+              b (or (aget bs i) (aget fill i))]
           (if (identical? a b)
             (recur (+ i 1))
             (if (or (and (identical? (typeof a) (typeof b))
@@ -122,10 +116,10 @@
     (if (>= ix len)
       (if found?
         (let [root (aget iterators 0)]
-          (.push results (.slice greatest 0))
+          (.push results (.slice (fill! greatest min-fill) 0))
           (.next root)
           (.key root))
-        greatest)
+        (fill! greatest min-fill))
       (let [comped (filled-key-compare greatest (aget keys ix) min-fill)]
         (println "greatest: " comped (identical? comped greatest))
         (recur (inc ix) comped (and found? (identical? comped greatest)))))))


fixing build

fixing build

--- src/aws/provider.clj
+++ src/aws/provider.clj
@@ -24,8 +24,8 @@

 (def ids (synched-map :aws-keys))

-(defn wait-for-status [s instance & {:keys [timeout] :or {timeout }}]
- (while (not (= status (.status Instance)))
+(defn wait-for-status [req-stat instance & {:keys [timeout] :or {timeout 3000}}]
+ (while (not (= req-stat (.status instance)))

    )
   )


Typical subsurface location uses length-as

--- src/test_utils/fracture_diagnostics.cljc
+++ src/test_utils/fracture_diagnostics.cljc
@@ -514,10 +514,11 @@
 (defn typical-subsurface-location
   ([] (typical-subsurface-location (rand-length-unit)))
   ([length-unit]
-   (let [typical-location-in-ft [(rand-easting) (rand-northing) (typical-vertical-depth)]]
+   (let [typical-location-in-ft (vec (map #(make-measurement % :ft)
+                                          [(rand-easting) (rand-northing) (typical-vertical-depth)]))]
      (if (= length-unit :ft)
-       [:ft typical-location-in-ft]
-       [:m (vec (map (convert-units-f :ft :m) typical-location-in-ft))]))))
+       typical-location-in-ft
+       (vec (map #(length-as % :m) typical-location-in-ft))))))

 (defn rand-well-reference-frame-xy []
   (rand-nth [:project :well-head :absolute-state-plane]))


removed not used requires from core

removed not used requires from core

--- src/bløggr/core.clj
+++ src/bløggr/core.clj
@@ -3,11 +3,6 @@
             [bløggr.posts :refer :all]
             [stasis.core :as stasis]
             [clojure.string :as str]
-            [clj-time.format :as tf]
-            [clj-time.core :as t]
-            [net.cgrand.enlive-html :as html]
-            [clygments.core :as pygments]
-            [clojure.java.io :as io]
             [optimus.prime :as optimus]
             [optimus.assets :as assets]
             [optimus.optimizations :as optimizations]


Handle most autotools generation problems.

--- src/circle/proto.clj
+++ src/circle/proto.clj
@@ -84,17 +84,34 @@
   (if (not= (:exit (apply shell/sh :return-map true args)) 0)
     (throw (Exception. (str "Failed thing: " args)))))

+; there is a program called autogen.sh on sourceforge that apparently
+; does magic here
+(defn autotools-generate
+  [srcdir]
+  (let [exists? #(fs/exists? (fs/join srcdir %))
+        has-configure-in (some exists? ["configure.in" "configure.ac"])
+        has-makefile-am (exists? "Makefile.am")
+        has-configure (exists? "configure")
+        has-makefile (exists? "Makefile")
+        has-autogen-sh (exists? "autogen.sh")]
+    (if-not (or has-makefile has-configure)
+      (if has-autogen-sh
+        (shell-out "autogen.sh" :dir srcdir)
+        (do
+          (when has-makefile-am (shell-out "aclocal" :dir srcdir))
+          (when has-configure-in (shell-out "autoconf"))
+          (when has-makefile-am (shell-out "automake")))))))
+
+
 (defn autotools-handler
   [{:keys [type srcdir configurations]
     {autoconf-version :version} :autoconf}]
-
   (when (= type "autotools")
     (let [autoconf-version (or autoconf-version "")
           configurations (or configurations [])
           srcdir (or srcdir "")
           automake "automake"]
-      (shell-out (autoconf autoconf-version) :dir srcdir)
-      (shell-out "./configure" :dir srcdir)
+      (autotools-generate srcdir)
       (shell-out "make" :dir srcdir)
       (shell-out "make" "check" :dir srcdir))))


Simple command-line UI for picking a discovered device/simulator

--- Clojure/src/ambly/repl/jsc.clj
+++ Clojure/src/ambly/repl/jsc.clj
@@ -16,13 +16,22 @@
 (defn set-logging-level [logger-name level]
   (.setLevel (java.util.logging.Logger/getLogger logger-name) level))

-;; For now, this impl simply returns the first service as soon as it is discovered
-(defn discover-ambly-webdav-bonjour-services
-  "Looks for Ambly WebDAV services advertised via Bonjour."
-  [timeout]
+(defn service-name->display-name [service-name]
+  (subs service-name (count "Ambly WebDAV Server on ")))
+
+(defn service-map->choice-list [service-map]
+  (map vector (iterate inc 1) service-map))
+
+(defn print-services [service-map]
+  (doseq [[choice-number [service-name _]] (service-map->choice-list service-map)]
+    (println (str "[" choice-number "] " (service-name->display-name service-name)))))
+
+(defn discover-and-pick-ambly-instance
+  "Looks for Ambly WebDAV services advertised via Bonjour and presents
+  a simple command-line UI letting user pick one."
+  []
   (let [reg-type "_http._tcp.local."
-        ;discovered-services (atom {})
-        discovered-services (promise)
+        discovered-services (atom (sorted-map))
         mdns-service (JmDNS/create)
         service-listener
         (reify ServiceListener
@@ -31,21 +40,40 @@
               (when (.startsWith name "Ambly WebDAV Server")
                 (.requestServiceInfo mdns-service (.getType service-event) (.getName service-event) 1))))
           (serviceRemoved [_ service-event]
-            #_(swap! discovered-services dissoc (.getName service-event)))
+            (swap! discovered-services dissoc (.getName service-event)))
           (serviceResolved [_ service-event]
             (let [entry {(.getName service-event)
                          (let [info (.getInfo service-event)]
                            {:address (.getAddress info)
                             :port    (.getPort info)})}]
-              #_(swap! discovered-services merge entry)
-              (deliver discovered-services entry))))]
+              (swap! discovered-services merge entry))))]
     (try
       (.addServiceListener mdns-service reg-type service-listener)
-      #_(Thread/sleep timeout)
-      (deref discovered-services timeout {})
+      (loop [count 0]
+        (when (empty? @discovered-services)
+          (Thread/sleep 100)
+          (when (= 1000 count)
+            (println "\nSearching ..."))
+          (recur (inc count))))
+      (Thread/sleep 500)                                    ;; Sleep a little more to catch stragglers
+      (loop [current-discovered-services @discovered-services]
+        (println)
+        (print-services current-discovered-services)
+        (println "\n[r] Refresh\n")
+        (print "Choice: ")
+        (flush)
+        (let [choice (read-line)]
+          (if (= "r" choice)
+            (recur @discovered-services)
+            (let [choices (service-map->choice-list current-discovered-services)
+                  choice-ndx (try (dec (Long/parseLong choice)) (catch NumberFormatException _ nil))]
+              (if (< -1 choice-ndx (count choices))
+                (second (nth choices choice-ndx))
+                (recur current-discovered-services))))))
       (finally
-        (.removeServiceListener mdns-service reg-type service-listener)
-        (.close mdns-service)))))
+        (future
+          (.removeServiceListener mdns-service reg-type service-listener)
+          (.close mdns-service))))))

 (defn socket [host port]
   (let [socket (Socket. host port)
@@ -156,11 +184,8 @@
 (defn setup
   [repl-env opts]
   (let [_ (set-logging-level "javax.jmdns" java.util.logging.Level/SEVERE)
-        discovered-endpoints (discover-ambly-webdav-bonjour-services 15000)
-        _ (when (empty? discovered-endpoints)
-            (throw (Exception. "No device or simulator running Ambly discovered.")))
-        ; TODO Need some UI and/config facilitating picking an Ambly instance
-        [webdav-endpoint-name webdav-endpoint] (first discovered-endpoints)
+        [webdav-endpoint-name webdav-endpoint] (discover-and-pick-ambly-instance)
+        _ (println "\nConnecting to" (service-name->display-name webdav-endpoint-name) "...\n")
         ; Assuming IPv4 for now
         endpoint-address (.getHostAddress (:address webdav-endpoint))
         endpoint-port (:port webdav-endpoint)
@@ -169,7 +194,6 @@
         _ (.mkdirs output-dir)
         env (ana/empty-env)
         core (io/resource "cljs/core.cljs")]
-    (println "Connecting to" (subs webdav-endpoint-name (count "Ambly WebDAV Server on ")))
     (reset! (:webdav-mount-point repl-env) webdav-mount-point)
     (shell/sh "mount_webdav" (str "http://" endpoint-address ":" endpoint-port) webdav-mount-point)
     (reset! (:socket repl-env)


Wip on #42

Wip on #42

--- Clojure/src/ambly/repl/jsc.clj
+++ Clojure/src/ambly/repl/jsc.clj
@@ -110,7 +110,7 @@
           (.close mdns-service))))))

 (defn socket [host port]
-  (let [socket (Socket. host port)
+  (let [socket (doto (Socket. host port) (.setKeepAlive true))
         in     (io/reader socket)
         out    (io/writer socket)]
     {:socket socket :in in :out out}))
@@ -271,8 +271,7 @@
           webdav-mount-point (mount-webdav repl-env bonjour-name endpoint-address endpoint-port)
           output-dir (io/file webdav-mount-point)
           env (ana/empty-env)
-          core (io/resource "cljs/core.cljs")
-          reconnect-fn (partial reconnect repl-env opts)]
+          core (io/resource "cljs/core.cljs")]
       ((println-fn opts) "\nConnecting to" (bonjour-name->display-name bonjour-name) "...\n")
       (set-up-socket repl-env opts endpoint-address (dec endpoint-port))
       (when (= "true" (:value (jsc-eval repl-env "typeof cljs === 'undefined'")))


correct game over doc strings and name, and simplify animation

--- src/client/core.cljs
+++ src/client/core.cljs
@@ -77,20 +77,18 @@
 ;; Game-driven STATE CHANGES
 ;;------------------------------------------------------------

-(defn game-over!
-  "You lost, get to the chopper"
+(defn go-go-game-over!
+  "Kicks off game over routine. (and get to the chopper)"
   []
   (go
     (doseq [y (reverse (range 22))
             x (range 10)]
       (if (even? x)
         (<! (timeout 2)))
-      (let [board (write-to-board x y :I (:board @state))]
-         (swap! state assoc :board board))))
-    )
+      (swap! state update-in [:board] #(write-to-board x y :I %)))))

 (defn spawn-piece!
-  "Spawns a random piece at the starting position."
+  "Spawns the given piece at the starting position."
   [piece]
     (swap! state assoc :piece piece
                        :position start-position))
@@ -103,7 +101,7 @@
         board (:board @state)]
     (if (piece-fits? piece x y board)
       (spawn-piece! piece)
-      (game-over!))))
+      (go-go-game-over!))))

 (defn collapse-rows!
   "Collapse all filled rows."


Small but significant fix to doc of lexicase-slippage; lein release :patch.

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -257,9 +257,9 @@
           ;; location, so doesn't play nice with trivial geography).

           :lexicase-slippage 0
-          ;; If using leaky lexicase selection, the probability that each step of the lexicase
-          ;; selection process will "slip" and return a random candidate from the current pool, rather
-          ;; than continuing to filter the pool.
+          ;; If using lexicase or leaky lexicase selection, the probability that each step of the
+          ;; lexicase selection process will "slip" and return a random candidate from the current
+          ;; pool, rather than continuing to filter the pool.

           :tournament-size 7
           ;; If using tournament selection, the size of the tournaments.


updates add-captain function

updates add-captain function

--- src/cptnapi/core.clj
+++ src/cptnapi/core.clj
@@ -21,12 +21,11 @@
     (mc/update db "captains" {:name captain} {$inc {:votes 1}})))

 (defn add-captain
-  [params]
-  (let [{:keys [name pic-url source]} params
-        conn  (mg/connect)
+  [cappy]
+  (let [conn  (mg/connect)
         db (mg/get-db conn "captains")
         coll "captains"]
-    (mc/save-and-return db coll {:name name :votes 1 :image pic-url :source source})))
+    (mc/save-and-return db coll cappy)))

 (defn get-captains
   []
@@ -42,7 +41,7 @@
 (defroutes app
   (GET "/" [] (clojure.java.io/resource "public/index.html"))
   (GET "/api/captains" [] (get-captains))
-  (POST "/api/captain" {params :params} (add-captain params))
+  (POST "/api/captain" [cappy] (add-captain cappy))
   (resources "/")
   (not-found "not found"))


fix-model available via main

fix-model available via main

--- src/crawler/main.clj
+++ src/crawler/main.clj
@@ -344,29 +344,9 @@
                                           model
                                           budget))

-          ;; (:fix-model options)
-          ;; (let [model-file (:fix-model options)
-
-          ;;       associated-corpus-file (:fix-model)])
-
-          ;; (:fix-model options)
-          ;; (let [directory (:fix-model options)
-          ;;       model-file (.getAbsolutePath
-          ;;                   (first
-          ;;                    (filter
-          ;;                     #(re-find #"\.model$" (.getAbsolutePath %))
-          ;;                     (file-seq (io/file directory)))))
-          ;;       corpus-file (.getAbsolutePath
-          ;;                    (first
-          ;;                     (filter
-          ;;                      #(re-find #"\.corpus$" (.getAbsolutePath %))
-          ;;                      (file-seq (io/file directory)))))
-
-          ;;       fixed-model
-          ;;       (crawler-model/fix-model model-file
-          ;;                                corpus-file)]
-          ;;   (pprint fixed-model (io/writer (str (:fix-model options)
-          ;;                                       "pruned-model"))))
+          (:fix-model options)
+          (let [model-file (:fix-model options)]
+            (fix-model model-file))

           :else
           (println "Pick one bruh"))))


add happy path case for working arguments

--- src/fat_jar/core.clj
+++ src/fat_jar/core.clj
@@ -19,4 +19,6 @@
     (cond
       (errors? options) (do (print-help options) (print (:errors options)))
       (help? options) (print-help options)
-      :else (print-help options))))+      :else (do
+        (println "doing stuff")
+        (println options)))))


handle starting/stopping

handle starting/stopping

--- src/gangway/util.clj
+++ src/gangway/util.clj
@@ -12,13 +12,26 @@
                   :worker-fn gw-worker/do-work}})

 (defn start-queues!
-  ([] (start-queues! queues))
-  ([queues]
+;; TODO: handle exceptions
+  ([system] (start-queues! system queues))
+  ([system queues]
      (dorun
       (map (fn start-queues!- [[k q]]
              (msg/start (:name q))
              (if (:worker-fn q)
                (msg/listen (:name q) (:worker-fn q))))
-           queues))))
+           queues))
+     (assoc-in system [:gangway :queues]
+               (set (concat (get-in system [:gangway :queues])
+                            (keys queues))))))

-
+(defn stop-queues!
+;; TODO: handle exceptions
+  ([system] (stop-queues! system queues))
+  ([system queues]
+     (dorun
+      (map (fn stop-queues!- [k]
+             (let [q (queues k)]
+               (msg/stop (:name q))))
+           (get-in system [:gangway :queues])))
+     (assoc-in system [:gangway :queues] #{})))


Fixing renderer to render correct mailto:email@adress and renamed to email-renderer

--- src/grid/render.cljs
+++ src/grid/render.cljs
@@ -67,8 +67,8 @@
   (fn [event reactid]
     (render-grid (f column-key))))

-(defn link-renderer [val]
-  (d/a {:className "byline" :href val} val))
+(defn email-renderer [val]
+  (d/a {:className "byline" :href (str 'mailto: val)} val))

 (def my-data {:data [{:name "John Doe"
                       :email "user@email.com"
@@ -87,7 +87,7 @@
                        :title "Email"
                        :className "email"
                        :onClick (create-sorter column-sorter :email)
-                       :renderer link-renderer}
+                       :renderer email-renderer}
                       {:key :name
                        :title "Name"
                        :onClick (create-sorter column-sorter :name)}


CMR-2442: Minor refactoring.

CMR-2442: Minor refactoring.

--- search-app/src/cmr/search/results_handlers/metadata_results_handler.clj
+++ search-app/src/cmr/search/results_handlers/metadata_results_handler.clj
@@ -69,14 +69,16 @@
         hits (get-in elastic-results [:hits :total])
         elastic-matches (get-in elastic-results [:hits :hits])
         result-items (mapv #(elastic-result->query-result-item concept-type %) elastic-matches)
-        concept-tags-map (into {} (mapv #(hash-map [(:concept-id %) (:revision-id %)] (:tags %)) result-items))
         tuples (mapv #(vector (:concept-id %) (:revision-id %)) result-items)
         [req-time tresults] (u/time-execution
                               (t/get-formatted-concept-revisions context tuples result-format false))
         items (map #(select-keys % qe/metadata-result-item-fields) tresults)
         ;; add tags to result items if necessary
         items (if (contains? (set result-features) :tags)
-                (add-tags items concept-tags-map)
+                (let [concept-tags-map (into {}
+                                             (mapv #(hash-map [(:concept-id %) (:revision-id %)] (:tags %))
+                                                   result-items))]
+                  (add-tags items concept-tags-map))
                 items)]
     (debug "Transformer metadata request time was" req-time "ms.")
     (results/map->Results {:hits hits :items items :result-format result-format})))


fix plot description

fix plot description

--- ws/network-contact-latency.clj
+++ ws/network-contact-latency.clj
@@ -77,7 +77,7 @@
          [:xlab "Seconds"]
          [:ylab "Density"]
          [:theme_bw]
-         [:ggtitle (str "Latency Histogram of " (element-name coll))])]
+         [:ggtitle (str (element-name coll) " latency histogram" )])]
       {:width 5 :height 5})) )
 ;; @@
 ;; =>


remove websocket session from logs

remove websocket session from logs

--- src/kabel/client.clj
+++ src/kabel/client.clj
@@ -60,7 +60,7 @@
         http-client
         (proxy [Endpoint] []
           (onOpen [session config]
-            (info {:event :websocket-opened :websocket session :url url})
+            (info {:event :websocket-opened :url url})
             (go-loop-super S [m (<? S out)] ;; ensure draining out on disconnect
               (if m
                 (do


Update server.cljs

Update server.cljs

--- src/meta/server.cljs
+++ src/meta/server.cljs
@@ -43,8 +43,8 @@
 (defn with-error-handler [app]
   (debug "Loading server Error Handler api")
   (-> app
-    exp/not-found
-    exp/error-handler))
+    (exp/not-found #js{:verbose false})
+    (exp/error-handler)))

 (defn using [app path svc]
   (debug "Passing app.use call to feathers")


Framerate reporting now working.

Framerate reporting now working.

Switched back to transducer-oriented render pipeline.

--- src/sparkle/core.clj
+++ src/sparkle/core.clj
@@ -73,11 +73,12 @@
         ([] (step))
         ([accum] (step accum))
         ([accum frame]
+          println
           (let [current-time (System/currentTimeMillis)
                 elapsed-cycle-time (- current-time @cycle-start-time)]
             (if (> elapsed-cycle-time period)
               (let [framerate (quot 1000 (/ elapsed-cycle-time @frame-count))]
-                (log/info "Framerate:" framerate)
+                (println "Framerate:" framerate)
                 (reset! cycle-start-time (System/currentTimeMillis))
                 (reset! frame-count 0))
               (swap! frame-count inc))
@@ -93,7 +94,7 @@
 (defmethod update-state :render [command state]
   (next-state state))

-(defn render-loop [command-chan pixel-chan]
+(defn render-loop [command-chan render-chan]
   (go-loop [last-state (setup)]
     (let [command (alt!
                     command-chan ([command] command)
@@ -102,7 +103,7 @@
       (case (:type command)
         :stop nil
         :render (do
-                  (>! pixel-chan (mode/pixel-map (eval-state state)))
+                  (>! render-chan state)
                   (recur state))
         (recur state)))))

@@ -110,20 +111,19 @@
   (comp
     (map eval-state)
     (map mode/pixel-map)
-    ;(log-framerate 1000)
-    ))
+    (log-framerate 1000)))

 (defn -main
   [& args]
   (let [command-chan (chan (buffer 10))
-        pixel-chan (chan (buffer 1)) ;render-pipeline)
-        pixel-pusher-chan (fc/start-pushing-pixels pixel-chan)
-        render-loop-chan (render-loop command-chan pixel-chan)]
+        render-chan (chan (buffer 1) render-pipeline)
+        pixel-pusher-chan (fc/start-pushing-pixels render-chan)
+        render-loop-chan (render-loop command-chan render-chan)]
     (.addShutdownHook (Runtime/getRuntime)
       (Thread. (fn []
-                  (log/info "Recieved shutdown signal. Halting...")
+                  (println "\nRecieved shutdown signal. Halting...")
                   (>!! command-chan {:type :stop}))))
     (<!! render-loop-chan)
     (<!! pixel-pusher-chan)))

-(log/info "Alive and kicking!")
+(println "Alive and kicking!")


Require clojure.pprint

Require clojure.pprint

It appears that heroku couldn't compile until I did this.

--- src/ahnentafel/server/pages/search.clj
+++ src/ahnentafel/server/pages/search.clj
@@ -1,5 +1,6 @@
 (ns ahnentafel.server.pages.search
-  (:require [ahnentafel.gedcom.query :as query]
+  (:require [clojure.pprint :as pprint]
+            [ahnentafel.gedcom.query :as query]
             [ahnentafel.server.pages.layout :refer [def-layout-template]]
             [ahnentafel.server.pages.util :refer :all]
             [net.cgrand.enlive-html :as html]))
@@ -11,8 +12,8 @@

   [:span#description]
   (html/content
-   (clojure.pprint/cl-format nil "~[No~:;~:*~D~] record~:P found for \"~A\""
-                             (count results) query))
+   (pprint/cl-format nil "~[No~:;~:*~D~] record~:P found for \"~A\""
+                     (count results) query))

   [:ul#result-list :li]
   (html/clone-for [result results]


Add saving of productions

Add saving of productions

--- src/mdr2/db.clj
+++ src/mdr2/db.clj
@@ -10,3 +10,5 @@
 (defn get-productions []
   (jdbc/query db ["SELECT * FROM productions"]))

+(defn add-production [production]
+    (jdbc/insert! db :productions production))


refactor

refactor

--- src/clj/salava/metabadge/metabadge.clj
+++ src/clj/salava/metabadge/metabadge.clj
@@ -130,12 +130,12 @@
                                  )) [] all-badges)]

     (reduce-kv
-      (fn [r k v] (distinct-by :id (into [] (r/flatten (conj r  (->> v :metabadge
+      (fn [r k v] (distinct-by :id (into [] (r/flatten (conj r  (->> v
+                                                                     :metabadge
                                                                      (map (fn [m]
                                                                             (let [amount_received (count (filter :received (-> m :required_badges)))]
-                                                                              (assoc m :completion_status (%completed (-> m :min_required ) amount_received)))
-                                                                            ))
-                                                                     (map #(identity %))))))))
+                                                                              (assoc m :completion_status (%completed (-> m :min_required ) amount_received)))))
+                                                                     #_(map #(identity %))))))))
       []
       metabadges)))


multiple focus modification improved

multiple focus modification improved

--- src/clj/webapp/routes/multipdgmmod.clj
+++ src/clj/webapp/routes/multipdgmmod.clj
@@ -252,12 +252,13 @@
                             {:title "Header", :name "header"}
                             [:option {:value headers} (str headers)]
                             ]]]
-                     [:tr [:td "Pivot: "]
-                      [:td [:select#pivot.required
-                            {:title "Pivot", :name "pivot"}
-                            (for [head headers]
-                            [:option {:value (.indexOf headers head)} head] )
-                            ]]]
+                     [:tr [:td "Pivots: "]
+                      [:td
+                       [:div {:class "form-group"}
+                        [:label
+                         (for [head headers]
+                           [:span
+                           (check-box {:name "pivotlist[]" :value (.indexOf headers head)} head) head])]]]]
                      [:tr [:td "PString: "]
                      [:td [:select#pdgms.required
                             {:title "PDGMS", :name "pdgmstr2"}
@@ -407,18 +408,19 @@
         hmap2 (apply hash-map hmap1)]
     (clojure.walk/keywordize-keys hmap2)))

-(defn make-pivot-map
-  [prow pivots]
-  ;; build up pkey and pval, then hash-map
-  (for [pivot pivots]
-    (let [pkey (nth prow pivot)])))
-
+(defn make-pmap
+  "Build up hash-map key by joining pivot-vals and val by removing pivot-vals"
+  [pcell pivots]
+    (let [pklist (vec (for [pivot pivots] (nth pcell pivot)))
+          pkstr (join "+" pklist)]
+      (hash-map  pkstr (vec (remove (set pklist) pcell)))))

 (defn handle-multimodplldisplay4
   "In this version pivot/keyset can be generalized beyond png any col (eventually any sequence of cols) between col-1 and token column. (Need to find out how to 'presort' cols before initial display?)"
   [pdgms headerset2 pdgmstr2 pivotlist]
   (let [pnamestr (clojure.string/replace pdgms #"[\[\]\"]" "")
         pnames (split pnamestr #" ")
+        pivots (map read-string pivotlist)
         ;;pivot (read-string pivotname)
         ;; get rid of spurious line-feeds
         ;;pdgmstr2a (str pdgmstr2)
@@ -426,13 +428,9 @@
         ;; map each 'val-string-w/o-pivot-val token' to token
         prows (split pdgmstr3 #"\\r\\n")
         pcells (for [prow prows] (split prow #","))
-        ;; build up pkey by joining pivot-vals and pval by removing pivot-vals
-        pklist (make-pklist pcells pivotlist)
-        pvlist (make-pvlist pcells pivotlist)
-        pivots (split pivotlist #",")
-        pivot-map (for [prow pcells] (hash-map pkey pval))
-        ;; pivot-map (for [prow pcells] (hash-map (nth prow pivot) (vec-remove prow pivot)))
-        pivot-map (for [prow pcells] (make-pivot-map prow pivots))
+        pivotlist2 (str "pdgm,num")
+        ;;pivots (split pivotlist2 #",")
+        pivot-map (for [pcell pcells] (make-pmap pcell pivots))
         ;; group the val-tokens associated with each pivot val
         newpdgms (merge-matches pivot-map)
         pdgmnums (into [] (take (clojure.core/count pnames) (iterate inc 1)))
@@ -450,7 +448,9 @@
         pmaps (for [prmap prmaps] (apply conj prmap))
         headerset3 (clojure.string/replace headerset2 #"[\[\]\"]" "")
         heads (split (str headerset3) #" ")
-        headvec (vec-remove heads pivotlist)
+        ;;headvec (for [pivot pivotlist] (vec-remove heads pivotlist))
+        pivotnames (vec (for [pivot pivots] (nth heads pivot)))
+        headvec (vec (remove (set pivotnames) heads))
         ;; set of lists of vaue-combination-terms
         keylists (set (for [pmap pmaps] (keys pmap)))
         ;;keylists (set (keys pmap))
@@ -487,9 +487,11 @@
                 (for [pmap pmaps]
                [:td (kstrkey pmap)])])]) ]]
        [:div [:h4 "======= Debug Info: ======="]
+        [:p "pdgms: " [:pre pdgms]]
         [:p "pnames: " (str pnames)]
         [:p "headerset2: " [:pre headerset2]]
-        ;; [:p "pivot: " [:pre pivot]]
+        [:p "pivotlist: " (str pivotlist)]
+        [:p "pivotnames: " (str pivotnames)]
         [:p "heads: " (str heads)]
         [:p "headvec: " (str headvec)]
         [:p "prows: "  (str prows) [:pre prows]]
@@ -518,4 +520,4 @@
   (POST "/multimodqry" [languages pos] (handle-multimodqry languages pos))
   (POST "/multimoddisplay" [valclusters pos] (handle-multimoddisplay valclusters pos))
   ;;(POST "/multimodplldisplay" [pdgmnames header pdgmstr2] (handle-multimodplldisplay2 pdgmnames header pdgmstr2)))
-(POST "/multimodplldisplay" [pdgmnames header pdgmstr2 pivot] (handle-multimodplldisplay4 pdgmnames header pdgmstr2 pivot)))
+(POST "/multimodplldisplay" [pdgmnames header pdgmstr2 pivotlist] (handle-multimodplldisplay4 pdgmnames header pdgmstr2 pivotlist)))


render 'Loading...' until accounts are loaded

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -116,7 +116,10 @@
     [:tr
      [:th "Name"]
      [:th (util/space)]]
-    (doall (mapcat #(account-type-rows %) (nest @*accounts*)))]])
+    (if (seq @*accounts*)
+      (doall (mapcat #(account-type-rows %) (nest @*accounts*)))
+      [:tr
+       [:td {:colSpan 2} [:span.inline-status "Loading..."]]])]])

 (defn- accounts-page []
   (accounts/get-all (:id @state/current-entity)


correction texte

correction texte

--- resources/workshop/do_things.clj
+++ resources/workshop/do_things.clj
@@ -12,7 +12,7 @@

 (exercice
-  "Ceci est un REPL "
+  "Ceci est un REPL n'hésitez tester les exemples ici ! "
   [] [])

 "Faire des choses: un cours Clojure crash
@@ -310,13 +310,16 @@
   )

-"Certains autres langues vous obligent à utiliser différents opérateurs lorsque l'on compare les valeurs de différents types. Par exemple, vous pourriez avoir à utiliser une sorte de l'opérateur spécial \"chaîne de l'égalité\" particulièrement fait juste pour les chaînes. Vous ne avez pas besoin de quelque chose bizarre ou pénible comme ça pour tester l'égalité lors de l'utilisation des structures de données intégrées de Clojure."
+"Certains autres languages vous obligent à utiliser différents opérateurs lorsque l'on compare les valeurs de différents types. Par exemple, vous pourriez avoir à utiliser un opérateur spécial \"égalité de String\" particulièrement fait juste pour les chaînes de caractère.
+Vous n'avez pas besoin de quelque chose bizarre ou pénible comme ça pour tester l'égalité lors de l'utilisation des structures de données intégrées de Clojure."

 [[:section {:tags "nombres" :title "Nombres"}]]

-"Clojure support numérique a assez sophistiqué. Je ne vais pas passer beaucoup de temps se attarder sur les détails techniques ennuyeux (comme la coercition et de la contagion), parce que cela va obtenir de la manière de faire les choses. Si vous êtes intéressé par ces détails ennuyeux, consultez http://clojure.org/data_structures#Data Ouvrages d'art-Numbers . Autant dire que Clojure va gaiement gérer à peu près tout ce que vous lui lancez."
-
-"Dans le même temps, nous allons travailler avec des nombres entiers et flottants. Nous allons aussi travailler avec des ratios, qui Clojure peut représenter directement. Voici un nombre entier, un flotteur, et un rapport:"
+"Le support des nombres dans Clojure est assez sophistiqué. Je ne vais pas passer beaucoup de temps sur les détails techniques ennuyeux (comme la coercition et de la contagion).
+ Si vous êtes intéressé par ces détails ennuyeux, consultez http://clojure.org/data_structures#Data. Autant dire que Clojure va gaiement gérer à peu près tout ce que vous lui lancez."
+
+"Dans le même temps, nous allons travailler avec des nombres entiers et flottants. Nous allons aussi travailler avec des ratios,
+que Clojure peut représenter directement. Voici un nombre entier, un flotteur, et un rapport:"

 (comment

@@ -336,11 +339,11 @@
   )

-"Notez que Clojure ne permet guillemets pour délimiter les chaînes. 'Lord Voldemort' , par exemple, ne est pas une chaîne valide. Notez également que Clojure n'a pas interpolation de chaîne. Il ne permet concaténation via le str fonction:"
-
-[[:section {:tags "map" :title "maps"}]]
-
-"Les maps sont semblables à des dictionnaires ou hachés dans d'autres langues. Ils sont une façon d'associer une valeur à une autre valeur. Voici par exemple map littéraux:"
+"Notez que Clojure ne permet pas les guillemets pour délimiter les chaînes. 'Lord Voldemort' , par exemple, n'est pas une chaîne valide. Notez également que Clojure n'a pas interpolation de chaîne. Il ne permet pas la concaténation via la fonction str :"
+
+[[:section {:tags "map" :title "Maps"}]]
+
+"Les maps sont semblables à des dictionnaires dans d'autres langues. Voici par exemple map littéraux:"

 (comment

@@ -359,9 +362,9 @@
   {:name {:first "John" :middle "Jacob" :last "Jingleheimerschmidt"}}
   )

-"Notez que les valeurs d'une map peuvent être de tout type. Chaîne, nombre, map, vecteur, même fonctionner! Clojure ne se soucient pas!
-
-Vous pouvez rechercher des valeurs dans les cartes avec la fonction *get* :"
+"Notez que les valeurs d'une map peuvent être de tout type. Chaîne, nombre, map, vecteur, même fonctionner!
+
+Vous pouvez rechercher des valeurs dans les Maps avec la fonction *get* :"

 (comment

@@ -373,7 +376,7 @@
   )

-"*get* retourera nil si elle ne trouve pas votre clé, mais vous pouvez lui donner une valeur par défaut pour retourner:"
+"*get* retourera **nil** si elle ne trouve pas votre clé, mais vous pouvez lui donner une valeur par défaut pour retourner:"

 (comment

@@ -467,7 +470,7 @@

 [[:section {:tags "keywords" :title "Mots Clés"}]]

-"Les mots-clés en Clojure sont mieux compris par la façon dont ils sont utilisés. Ils sont principalement utilisés comme clés dans les maps, comme vous pouvez le voir ci-dessus. Exemples de mots clés:"
+"Les mots-clés en Clojure sont mieux compris par les cas d'utilisation. Ils sont principalement utilisés comme clés dans les maps, comme vous pouvez le voir ci-dessus. Exemples de mots clés:"

 (comment
@@ -495,7 +498,7 @@
   ; => "FAERIES"
   )

-"Je pense que ce est super cool et réel Clojurists le fais tout le temps. Vous devriez le faire aussi!
+"Je pense que c'est super cool et les *reals* Clojurists le font tout le temps. Vous devriez le faire aussi!

 Outre l'utilisation de la map littéraux, vous pouvez utiliser le hash-map fonction pour créer une map:"

@@ -504,7 +507,7 @@
 ; => {:a 1 :b 2}
 )

-"Clojure vous permet également de créer des maps triées, mais je ne couvrira pas cela."
+"Clojure vous permet également de créer des maps triées."

 [[:section {:tags "vectors" :title "Vecteurs"}]]

@@ -588,7 +591,7 @@
 [[:section {:tags "listes" :title "Listes"}]]

-"Les listes sont similaires à vecteurs en ce qu'ils sont linéaires collections de valeurs. Il ya quelques différences, cependant. Vous ne pouvez pas récupérer les éléments de liste avec get :"
+"Les listes sont similaires à vecteurs sur certain point. Cependant, vous ne pouvez pas récupérer les éléments de liste avec get :"

 (comment
@@ -626,8 +629,6 @@
 ;  => (4 1 2 3)
 )

-"Quand devriez-vous utiliser une liste et quand faut-il utiliser un vecteur? Pour l'instant, vous êtes probablement mieux de simplement en utilisant des vecteurs. Comme vous en apprendre davantage, vous aurez une bonne idée de quand utiliser quel."
-

@@ -760,7 +761,8 @@

   )

-"Vous pouvez créer des ensembles de vecteurs et les listes existantes en utilisant le set fonction. Une utilisation non évidente pour ce est de vérifier si un élément existe dans une collection:"
+"Vous pouvez créer des ensembles de vecteurs et les listes existantes en utilisant la fonction set .
+Une utilisation non évidente est de vérifier si un élément existe dans une collection:"

 (comment
@@ -776,7 +778,7 @@
   ; => nil

   )
-"Tout comme vous pouvez créer des maps et des maps de hachage triés, vous pouvez créer des ensembles de hachage et des jeux triés:"
+"Tout comme vous pouvez créer des maps , vous pouvez créer des ensembles de hachage et des jeux triés:"

 (comment
   (Hash-set 1 1 3 1 2)
@@ -786,7 +788,7 @@
   ;  => # {: A: b: c}
   )

-"Clojure vous permet également de définir la façon dont un ensemble est trié en utilisant l' sorted-set-by fonction, mais ce livre ne couvre pas que."
+"Clojure vous permet également de définir la façon dont un ensemble est trié en utilisant la fonction sorted-set-by."

 (exercice
@@ -826,7 +828,9 @@

 "Dans ce cas, def associe la valeur [\"Gone With the Moving Air\" \"Swellfellas\"] avec les symboles failed-movie-titles .

-Vous pensez peut-être: «Alors quoi? Tout autre langage de programmation permet de me associer un nom à une valeur. Big Whoop!\" Lisps, toutefois, vous permettent de manipuler des symboles comme des données, quelque chose que nous allons voir beaucoup de quand nous commençons à travailler avec des macros. Fonctions peuvent retourner symboles et les prendre comme arguments:
+Vous pensez peut-être: «Alors quoi? Tout autre langage de programmation permet de m'associer un nom à une valeur. Big Whoop!\"
+Lisps, toutefois, vous permettent de manipuler des symboles comme des données, quelque chose que nous allons voir beaucoup de quand nous commençons à travailler avec des macros.
+ Fonctions peuvent retourner symboles et les prendre comme arguments:

 "

@@ -836,14 +840,13 @@
   ; => test
   )

-"Pour l'instant, cependant, il est OK pour penser \"Big Whoop!\" et ne pas être très impressionné.
-"

 [[:section {:tags "quote" :title "Quote"}]]

-"Vous avez peut-être remarqué la apostrophe, ' , dans les exemples ci-dessus. Ceci est appelé \"citant\". Vous apprendrez à connaître en détail dans le chapitre \"Clojure Alchemy: lecture, l'évaluation et les macros». Voici l'explication rapide pour l'instant.
-
-Donner Clojure un symbole renvoie l '«objet», il se réfère à:"
+"Vous avez peut-être remarqué l'apostrophe, ' , dans les exemples ci-dessus. Ceci est appelé \"citant\".
+  Voici l'explication rapide pour l'instant.
+
+Donner à Clojure un symbole  il renvoie l '«objet», il se réfère à:"

 (comment


Add datetime validator.

Add datetime validator.

--- src/uxbox/schema.clj
+++ src/uxbox/schema.clj
@@ -8,7 +8,8 @@
   (:refer-clojure :exclude [keyword uuid vector boolean])
   (:require [bouncer.core :as b]
             [bouncer.validators :as v]
-            [cuerdas.core :as str]))
+            [cuerdas.core :as str])
+  (:import java.time.Instant))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Validators
@@ -63,6 +64,12 @@
   (let [len (count v)]
     (>= v len)))

+(v/defvalidator datetime
+  "Validat if `v` is a valid java.time.Instant instance."
+  {:default-message-format "% must be a Instant instance."}
+  [v]
+  (instance? Instant v))
+
 (def required v/required)
 (def number v/number)
 (def integer v/integer)


test composition of systems

test composition of systems

--- test/com/stuartsierra/component_test.clj
+++ test/com/stuartsierra/component_test.clj
@@ -169,3 +169,28 @@
                                    :c (error-start-c)))
                 (catch Exception e e))]
     (is (started? (-> ex ex-data :system :b :a)))))
+
+(defrecord System2b [one]
+  component/Lifecycle
+  (start [this]
+    (assert (started? (get-in one [:b :a])))
+    this)
+  (stop [this]
+    (assert (started? (get-in one [:b :a])))
+    this))
+
+(defrecord System2 [alpha beta]
+  component/Lifecycle
+  (start [this]
+    (component/start-system this (keys this)))
+  (stop [this]
+    (component/stop-system this (keys this))))
+
+(defn system-2 []
+  (map->System2 {:alpha (system-1)
+                 :beta (component/using (->System2b nil)
+                         {:one :alpha})}))
+
+(deftest composed-systems
+  (let [system (component/start (system-2))]
+    (is (started? (get-in system [:beta :one :d :my-c])))))


Pass :close-fn to the modal component

Pass :close-fn to the modal component

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -218,7 +218,8 @@
                                                  (raise! owner [:preferences-updated {state/user-in-beta-key true}])
                                                  ((om/get-shared owner :track-event) {:event-type :beta-accept-terms-clicked})
                                                  (close-fn))}
-                                   "Accept")]})))
+                                   "Accept")]
+                        :close-fn close-fn})))

 (defn join-beta-program [app owner]
   (reify


keywordize vcs_type and username in org ids

--- src-cljs/frontend/components/account.cljs
+++ src-cljs/frontend/components/account.cljs
@@ -359,7 +359,8 @@
                                                  (compare x-name y-name)
                                                  vcs-compare))))
                             (map (fn [{:keys [vcs_type username]}]
-                                   [vcs_type username])
+                                   [(keyword vcs_type)
+                                    (keyword username)])
                                  projects))]
     (reify
       om/IRenderState
@@ -372,9 +373,11 @@
             [:label "Choose an account"]
             [:select.form-control
              {:on-change #(let [value (-> % .-target .-value)]
-                            (om/set-state! owner [:selected-org] (string/split value #"/")))}
+                            (om/set-state! owner [:selected-org] (map keyword (string/split value #"/"))))}
              (for [[vcs_type username] followed-orgs
-                   :let [org-id (string/join "/" [vcs_type username])]]
+                   :let [org-id (->> [vcs_type username]
+                                     (map name)
+                                     (string/join "/"))]]
                [:option
                 {:value org-id}
                 org-id])]]]
@@ -399,7 +402,7 @@
              [:h4 "Repo"]
              [:h4 "Email preference"]]
             (for [project projects
-                  :when (= [(:vcs_type project) (:username project)] selected-org)]
+                  :when (= [(keyword (:vcs_type project)) (keyword (:username project))] selected-org)]
               (om/build project/email-pref {:project project :user user} {:react-key (:reponame project)}))]]])))))

 (defn notifications [app owner]


Improve hint about private Email in invite

Whenever a user has set his Email in GitHub to private,
this user can't be invited without providing an Email address.
This is now explained more clearly.

--- src-cljs/frontend/components/invites.cljs
+++ src-cljs/frontend/components/invites.cljs
@@ -36,8 +36,9 @@
                     :value email
                     :id (str login "-email")}]
            [:label {:for (str login "-email")}
-            [:i.fa.fa-exclamation-circle]
-            " Fix Email"]]
+            [:i.fa.fa-exclamation-circle
+             {:title "Entering an Email address is required for sending invites to this user"}]
+            " Email not available"]]
           [:label.invite-select {:id (str login "-label")
                                  :for (str login "-checkbox")}
            [:input {:type "checkbox"


Hide license banner when we have nothing to show.

--- src-cljs/frontend/components/license.cljs
+++ src-cljs/frontend/components/license.cljs
@@ -3,9 +3,6 @@
             [cljs-time.coerce :as t-coerce]
             [cljs-time.core :as t])
   (:require-macros [frontend.utils :refer [html]]))
-
-(def show-banner?
-  (complement nil?))

 (defn- days-until-api-time
   "Takes a string representing a time in the format the API delivers it and
@@ -16,29 +13,40 @@
        (t/interval (t/now))
        t/in-days))

+(defn- banner-for-license
+  "Returns the banner for the given license, or nil if no banner applies."
+  [license]
+  (case (:status license)
+    "current"
+    (let [days-until-expiry (days-until-api-time (:expiry_date license))]
+      [:.license-banner {:class (:status license)}
+       [:.indicator "Trial Account"]
+       [:.message "Welcome to CircleCI."]
+       [:.timing [:span.days days-until-expiry] " days left in trial"]
+       [:a.contact-sales
+        {:href "mailto:enterprise@circleci.com"}
+        "Contact Sales…"]])
+
+    "in-violation"
+    (let [days-until-suspension (days-until-api-time (:hard_expiry_date license))]
+      [:.license-banner {:class (:status license)}
+       [:.indicator "Trial Expired"]
+       [:.message "Your trial period has expired."]
+       [:.timing [:span.days days-until-suspension] " days before suspension"]
+       [:a.contact-sales
+        {:href "mailto:enterprise@circleci.com"}
+        "Contact Sales…"]])
+    nil))
+
+(defn show-banner?
+  "Should we show a banner for the given license?"
+  [license]
+  (boolean (banner-for-license license)))
+
 (defn license-banner [license owner]
   (reify
     om/IDisplayName (display-name [_] "License Banner")
     om/IRender
     (render [_]
       (html
-       (case (:status license)
-         "current"
-         (let [days-until-expiry (days-until-api-time (:expiry_date license))]
-           [:.license-banner {:class (:status license)}
-            [:.indicator "Trial Account"]
-            [:.message "Welcome to CircleCI."]
-            [:.timing [:span.days days-until-expiry] " days left in trial"]
-            [:a.contact-sales
-             {:href "mailto:enterprise@circleci.com"}
-             "Contact Sales…"]])
-
-         "in-violation"
-         (let [days-until-suspension (days-until-api-time (:hard_expiry_date license))]
-           [:.license-banner {:class (:status license)}
-            [:.indicator "Trial Expired"]
-            [:.message "Your trial period has expired."]
-            [:.timing [:span.days days-until-suspension] " days before suspension"]
-            [:a.contact-sales
-             {:href "mailto:enterprise@circleci.com"}
-             "Contact Sales…"]]))))))
+       (banner-for-license license)))))


fix some edge-cases in code block extraction

--- src/chat/client/views/helpers.cljs
+++ src/chat/client/views/helpers.cljs
@@ -71,11 +71,10 @@
   []
   (fn [xf]
     (let [state (volatile! ::start)
-          code-lang (volatile! "")
           block-type (volatile! nil)
           in-code (volatile! [])]
       (fn
-        ([]  (xf))
+        ([] (xf))
         ([result] (if (= @state ::in-code)
                     (let [prefix (if (= @block-type :block) "```" "`")]
                       (reduce xf result (update-in @in-code [0] (partial str prefix))))
@@ -86,18 +85,16 @@
              ; TODO: handle starting code block with backtick not at beginning of word
              ; start multiline
              (and (= @state ::start) (.startsWith input "```"))
-             (do (vreset! state ::in-code)
-                 (vreset! block-type :block)
-                 ; Note: using [\s\S] to match anything because javascript doesn't have (?s) flag
-                 ; to make dot match newlines as well, apparently
-                 (let [[_ type code] (re-matches #"```(\w*)\s?([\s\S]*)" input)]
-                   (vreset! code-lang type)
-                   (vswap! in-code conj code))
-                 result)
+             (if (and (not= "```" input) (.endsWith input "```"))
+               (xf result (dom/code #js {:className "multiline-code"} (.slice input 3 (- (.-length input) 3))))
+               (do (vreset! state ::in-code)
+                   (vreset! block-type :block)
+                   (vswap! in-code conj (.slice input 3))
+                   result))

              ; start inline
              (and (= @state ::start) (.startsWith input "`"))
-             (if (.endsWith input "`")
+             (if (and (not= input "`") (.endsWith input "`"))
                (xf result (dom/code #js {:className "inline-code"} (.slice input 1 (dec (.-length input)))))
                (do (vreset! state ::in-code)
                    (vswap! in-code conj (.slice input 1))
@@ -105,12 +102,10 @@

              ; end multiline
              (and (= @state ::in-code) (= @block-type :block) (.endsWith input "```"))
-             (let [code (conj @in-code (.slice input 0 (- (.-length input) 3)))
-                   code-class @code-lang]
+             (let [code (conj @in-code (.slice input 0 (- (.-length input) 3)))]
                (vreset! state ::start)
                (vreset! in-code [])
-               (vreset! code-lang "")
-               (xf result (dom/code #js {:className (str "multiline-code " code-class)} (string/join " " code))))
+               (xf result (dom/code #js {:className "multiline-code"} (string/join " " code))))

              ; end inline
              (and (= @state ::in-code) (.endsWith input "`"))


clean up homepage

clean up homepage

--- webapp/src/webapp/core.clj
+++ webapp/src/webapp/core.clj
@@ -23,17 +23,15 @@
 				[:ul (linkfy "ff" "Fantasy Football")]
 				[:ul "Full Blog"]
 				[:ul "Poetry Reader"]
-				; [:ul (linkfy "site_stats" "Site Statistics")]
-				[:ul "Site Statistics"]]]
-		)))
+				[:ul (linkfy "site_stats" "Site Statistics")]
+		]])))

 (defroutes router*
-	(GET "/" request (do (log request "homepage" "page-view" (:remote-addr request) {}) (str site-map request)))
+	(GET "/" request (do (log request "homepage" "page-view" (:remote-addr request) {}) site-map))
 	(GET "/ff" request (do (log request "fantasy-football" "page-view" (:remote-addr request) {}) ff))
 	(GET "/microblog" request (do (log request "microblog" "page-view" (:remote-addr request) {}) (microblog)))
 	(GET "/microblog/post" request (do (log request "microblog_post" "page-view" (:remote-addr request) {}) (mb_post)))
     (POST "/microblog_post" request (let [message (:message (:params request))] (do (log request "microblog_post" "publish" (:remote-addr request) {:message message}) (mb_post_post message))))
-    ; (GET "/site_stats" request (do (log request "site_stats" "page-view" (:remote-addr request) {}) "Site Statistics"))
     (GET "/site_stats" request (do (log request "site_stats" "page-view" (:remote-addr request) {}) (stats-output)))
 	(compojure.route/not-found "Link not found."))


Url to connect to supports new transport schemes

It was hardcoded to `nrepl` (bencode), now the user
can pass the `scheme` if a different transport
is used.

--- src/clj/reply/eval_modes/nrepl.clj
+++ src/clj/reply/eval_modes/nrepl.clj
@@ -137,13 +137,13 @@
          (recur (last (doall (map execute forms)))))))))

 ;; TODO: this could be less convoluted if we could break backwards-compat
-(defn- url-for [attach host port]
+(defn- url-for [attach host port scheme]
   (if (and attach (re-find #"^\w+://" attach))
     attach
     (let [[port host] (if attach
                         (reverse (.split ^String attach ":"))
                         [port host])]
-      (format "nrepl://%s:%s" (or host "localhost") port))))
+      (format "%s://%s:%s" scheme (or host "localhost") port))))

 (defn- load-drawbridge
   "Load Drawbridge (and therefore get its HTTP/HTTPS multimethods
@@ -153,12 +153,13 @@
     (require '[drawbridge.client])
     (catch Exception e)))

-(defn get-connection [{:keys [attach host port]}]
+(defn get-connection [{:keys [attach host port scheme]
+                       :or {scheme "nrepl"}}]
   (let [server (when-not attach
                  (nrepl.server/start-server :port port))
         port (when-not attach
                (:port server))
-        url (url-for attach host port)]
+        url (url-for attach host port scheme)]
     (when server
       (reset! nrepl-server server))
     (when (-> url java.net.URI. .getScheme .toLowerCase #{"http" "https"})


Remove unused state value (escape radius)

--- src/cljs/mandelbrot_cljs/core.cljs
+++ src/cljs/mandelbrot_cljs/core.cljs
@@ -19,7 +19,6 @@

 (defonce app-state (atom {:canvas         (.getElementById js/document "canvas")
                           :overlay-canvas (.getElementById js/document "overlay-canvas")
-                          :escape-radius  10000
                           :stats          {}}))

 (defonce rendering-data-history (atom []))


board refact

board refact

--- src/cljs/triboard/logic/board.cljs
+++ src/cljs/triboard/logic/board.cljs
@@ -7,7 +7,7 @@

 ;; -----------------------------------------
-;; Private
+;; Public Types
 ;; -----------------------------------------

 (def width 16)
@@ -15,16 +15,6 @@

 (def coordinates
   (vec (for [x (range width) y (range height)] [x y])))
-
-(def empty-board
-  "An empty board of `width` columns times `height` owners"
-  (let [empty-column (vec (repeat height :none))]
-    (vec (repeat width empty-column))))
-
-
-;; -----------------------------------------
-;; Public Types
-;; -----------------------------------------

 (s/def ::coord (set coordinates))

@@ -53,6 +43,11 @@
 ;; Public API
 ;; -----------------------------------------

+(def empty-board
+  "An empty board of `width` columns times `height` owners"
+  (let [empty-column (vec (repeat height :none))]
+    (vec (repeat width empty-column))))
+
 (defn convert-cell
   [board coord owner]
   (assoc-in board coord owner))


Change code order for clarity

Change code order for clarity

--- src/clojure/nightcode/builders.clj
+++ src/clojure/nightcode/builders.clj
@@ -194,17 +194,17 @@

 (defn create-builder
   [path]
-  (let [; create the atoms that keep track of important values
+  (let [; create the console and the panel that holds it
+        console (editors/create-console "clj")
+        build-group (s/border-panel
+                      :center (s/config! console :id :build-console))
+        ; create the atoms that keep track of important values
         process (atom nil)
         auto-process (atom nil)
         last-reload (atom nil)
-        ; create the console and the panel that holds it
-        console (editors/create-console "clj")
-        build-group (s/border-panel
-                      :center (s/config! console :id :build-console))
-        ; put the atoms and views in vectors to make it easier to pass them
+        ; put the views and atoms in vectors to make it easier to pass them
+        views [console build-group]
         atoms [process auto-process last-reload]
-        views [console build-group]
         ; create the buttons with their actions attached
         btn-group (ui/wrap-panel
                     :items (map (fn [k]


Compute call-read time on trace

Compute call-read time on trace

--- src/com/wsscode/pathom/parser.cljc
+++ src/com/wsscode/pathom/parser.cljc
@@ -346,8 +346,8 @@
                                 (:prop :join :union)
                                 (do
                                   (assert read "Parse read attempted but no :read function supplied")
-                                  (trace env {::pt/event ::call-read :key key})
-                                  (read env))
+                                  (tracing env {::pt/event ::call-read :key key}
+                                    (read env)))

                                 nil)]
                     (cond


aggregate test without extension

aggregate test without extension

--- test/nha/boot_uglify/files_util_test.clj
+++ test/nha/boot_uglify/files_util_test.clj
@@ -46,8 +46,11 @@
     (let [dir  (tmp-dir!)
           name-p1 ["a" "b" "c"]
           name-p2 [1 2 3]
-          files (gen-files! dir name-p1 name-p2 [".js" ".txt" ".gz"])]
-      (is (= (* (count name-p1) (count name-p2)) (count (sut/aggregate (str dir) ".js"))))))
+          name-ext [".js" ".txt" ".gz"]
+          files (gen-files! dir name-p1 name-p2 name-ext)]
+      (is (= (* (count name-p1) (count name-p2)) (count (sut/aggregate (str dir) ".js"))))
+      (is (= (+ 1 ;; for directory
+                (* (count name-p1) (count name-p2) (count name-ext))) (count (sut/aggregate (str dir) ""))))))

   (testing "can find files recursively based on extension"


update build.boot dependency

update build.boot dependency

--- build.boot
+++ build.boot
@@ -2,7 +2,7 @@
   :dependencies '[[org.clojure/clojure       "1.6.0"     :scope "provided"]
                   [boot/core                 "2.0.0-rc6" :scope "provided"]
                   [adzerk/bootlaces          "0.1.9"     :scope "test"]
-                  [org.clojure/clojurescript "0.0-2629"  :scope "test"]])
+                  [org.clojure/clojurescript "0.0-2727"  :scope "test"]])

 (require '[adzerk.bootlaces :refer :all])


Needed for defaulting the repl client

Needed for defaulting the repl client

--- build.boot
+++ build.boot
@@ -89,7 +89,8 @@
    (speak)
    (sass :output-style :expanded)
    (reload :on-jsload 'edge.main/init)
-   (cljs-repl :nrepl-opts {:port repl-port
+   (cljs-repl :nrepl-opts {:client false
+                           :port repl-port
                            :init-ns 'user}) ; this is also the server repl!
    (cljs :ids #{"edge"} :optimizations :none)
    (dev-system)


Narrow clj test scope

Narrow clj test scope

--- build.boot
+++ build.boot
@@ -138,7 +138,7 @@
   "Runs the tests on JVM."
   []
   (comp (testing)
-        (boot-test/test)))
+        (boot-test/test :namespaces ['mikron.test])))

 (deftask test-node
   "Runs the tests in a Node.js environment."


Update Clojure  to 1.7

Update Clojure  to 1.7

--- src/leiningen/new/figwheel/project.clj
+++ src/leiningen/new/figwheel/project.clj
@@ -4,7 +4,7 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}

-  :dependencies [[org.clojure/clojure "1.6.0"]
+  :dependencies [[org.clojure/clojure "1.7.0-beta3"]
                  [org.clojure/clojurescript "0.0-3297"]
                  [org.clojure/core.async "0.1.346.0-17112a-alpha"]{{#om?}}
                  [sablono "0.3.4"]


Don't crash when cue variables nil.

Don't crash when cue variables nil.

--- src/afterglow/web/routes/show_control.clj
+++ src/afterglow/web/routes/show_control.clj
@@ -228,17 +228,16 @@
   currently running effects."
   [show current]
   (flatten
-       (for [effect current]
-         (for [v (:variables (:cue effect))]
-           (let [value (cues/get-cue-variable (:cue effect) v :show show :when-id (:id effect))]
-             (when value
-               {:effect (:key effect)
-                :id (:id effect)
-                :var (merge {:name (name (:key v))}
-                            (select-keys v [:key :name :min :max :type]))
-                :value (case (:type v)
-                         :color (colors/rgb-hexstr value)
-                         value)}))))))
+   (for [effect current]
+     (for [v (:variables (:cue effect))]
+       (let [value (cues/get-cue-variable (:cue effect) v :show show :when-id (:id effect))]
+         {:effect (:key effect)
+          :id (:id effect)
+          :var (merge {:name (name (:key v))}
+                      (select-keys v [:key :name :min :max :type]))
+          :value (case (:type v)
+                   :color (when value (colors/rgb-hexstr value))
+                   value)})))))

 (defn- cue-var-changes
   "Returns information about any cue variables for current effects


fixed some bug

fixed some bug

--- src/clj/de/sveri/friendui/routes/user.clj
+++ src/clj/de/sveri/friendui/routes/user.clj
@@ -31,15 +31,15 @@

 (defn validRegister? [storage email pass confirm]
   (vali/rule (vali/has-value? email)
-             [:id "An email address is required"])
+             [:id "An email address is required."])
   (vali/rule (vali/is-email? email)
-             [:id "A valid email is required"])
+             [:id "A valid email is required."])
   (vali/rule (not (globals/username-exists? storage email))
              [:id "This username exists in the database. Please choose another one."])
   (vali/rule (vali/min-length? pass 5)
-             [:pass "Password must be at least 5 characters"])
+             [:pass "Password must be at least 5 characters."])
   (vali/rule (= pass confirm)
-             [:confirm "Entered passwords do not match"])
+             [:confirm "Entered passwords do not match."])
   (not (vali/errors? :id :pass :confirm)))

 (defn activate-account [storage id & [{:keys [activate-account-succ-func]}]]
@@ -125,20 +125,5 @@
     (vali/wrap-noir-validation
       (POST "/user/add" [email password confirm]
             (friend/authorize #{:user/admin}
-                              (add-user storage email password confirm "/user/admin" (partial admin-view storage)))))
-    (friend/logout (ANY "/user/logout" [] (redirect "/")))))
-
-
-;took out profile capabilities for now
-
-;(GET "/user/profile" [] (friend/authenticated (profile)))
-;(POST "/user/profile" request (friend/authenticated (handle-profile (:params request))))
-;(defn profile []
-;  (layout/render "user/profile.html"
-;                 {:fields (user/get-profile-data (:username (friend/current-authentication)))}))
-;
-;(defn handle-profile [params]
-;  (user/update-user
-;    (globals/username-kw (friend/current-authentication))
-;    (select-keys params globals/add-profile-keywords))
-;  (profile))+                              (add-user storage email password confirm "/user/admin" (partial admin-view storage) false))))
+    (friend/logout (ANY "/user/logout" [] (redirect "/")))))


Use ok alias for consistency

Use ok alias for consistency

Change instance of schema/optional-key to use ok alias instead
for consistency with the rest of the file.

--- src/clj/puppetlabs/http/client/common.clj
+++ src/clj/puppetlabs/http/client/common.clj
@@ -68,8 +68,7 @@
    :body            Body
    :decompress-body schema/Bool
    :as              BodyType
-   (schema/optional-key
-     :persistent)   schema/Bool})
+   (ok :persistent) schema/Bool})

 (def SslContextOptions
   {:ssl-context SSLContext})


Add changes side panel tab

Add changes side panel tab

--- src/cljs/gtfve/components/side_panel.cljs
+++ src/cljs/gtfve/components/side_panel.cljs
@@ -187,7 +187,11 @@
                                           :tab tab})
                 (om/build side-panel-tab {:key :trips
                                           :label "Trips"
-                                          :tab tab})]
+                                          :tab tab})
+                (om/build side-panel-tab {:key :changes
+                                          :label "Changes"
+                                          :tab tab
+                                          :badge (count (:changes data))})]
                [:div.tab-content {:ref "tab-content"}
                 ;; stops
                 (om/build stop-panel {:tab tab


fix editing issues with markdown editor

fix editing issues with markdown editor

--- src/cljs/salava/badge/ui/endorsement.cljs
+++ src/cljs/salava/badge/ui/endorsement.cljs
@@ -1,6 +1,7 @@
 (ns salava.badge.ui.endorsement
   (:require [salava.core.i18n :refer [t]]
             [reagent.core :refer [atom cursor create-class]]
+            [reagent.dom :as reagent]
             [salava.core.time :refer [unix-time date-from-unix-time]]
             [salava.core.ui.ajax-utils :as ajax]
             [salava.core.ui.helper :refer [path-for private?]]
@@ -162,38 +163,34 @@
                               "link" "horizontal-rule"
                               "preview"))

-(defn init-editor [value element-id]
-  (let [editor (js/SimpleMDE. (js-obj "element" (.getElementById js/document element-id)
-                                      "toolbar" simplemde-toolbar
-                                      "autofocus" "true"
-                                      "spellChecker" "false"
-                                      ))]
-
-    (js/setTimeout (fn [] (.value editor @value)) 200) ;;delay for editor to load
-
-    ;(.value editor @value)
-    (set! (.-onclick js/document) (fn [] (js/setTimeout (fn [] (.value editor @value)) 10))) ;refresh editor value
-    (.codemirror.on editor "mousedown" (fn [] (.value editor @value)))
-    (.codemirror.on editor "change" (fn [] (reset! value (.value editor))))))
+(def editor (atom nil))
+
+(defn init-editor [element-id value]
+  (reset! editor (js/SimpleMDE. (clj->js {:element (.getElementById js/document element-id)
+                                          :toolbar simplemde-toolbar})))
+  (.value @editor @value)
+  (js/setTimeout (fn [] (.value @editor @value)) 200)
+  (.codemirror.on @editor "change" (fn [] (reset! value (.value @editor)))))
+

 (defn markdown-editor [value]
   (create-class {:component-did-mount (fn []
-                                        #_(.getScript (js* "$") "/js/simplemde.min.js")
-                                        (init-editor value (str "editor" (-> (session/get :user) :id))))
+                                        (init-editor (str "editor" (-> (session/get :user) :id)) value))
                  :reagent-render (fn []
                                    [:div.form-group {:style {:display "block"}}
                                     [:textarea {:class "form-control"
                                                 :id (str "editor" (-> (session/get :user) :id))
                                                 :defaultValue @value
-                                                ;:on-change #(reset! value (.-target.value %))
-                                                }]]) }))
+                                                :on-change #(reset! value (.-target.value %))
+                                                }]])}))

 (defn process-text [s state]
   (let [text (-> js/document
                  (.getElementById (str "editor" (-> (session/get :user) :id)))
                  (.-innerHTML))
         endorsement-claim (str text (if (blank? text) "" "\n\n") "* " s)]
-    (reset! (cursor state [:endorsement-comment]) endorsement-claim)))
+    (reset! (cursor state [:endorsement-comment]) endorsement-claim)
+    (.value @editor  @(cursor state [:endorsement-comment]))))

 (defn endorse-badge-content [state]
@@ -212,9 +209,9 @@
       [:div.col-xs-12
        [:div.list-group
         [:a.list-group-item {:id "phrase1" :href "#" :on-click #(do
-                                                    (.preventDefault %)
-                                                    (process-text (t :badge/Endorsephrase1) state)
-                                                    )} [:i.fa.fa-plus-circle](t :badge/Endorsephrase1)]
+                                                                  (.preventDefault %)
+                                                                  (process-text (t :badge/Endorsephrase1) state)
+                                                                  )} [:i.fa.fa-plus-circle](t :badge/Endorsephrase1)]
         [:a.list-group-item {:href "#" :on-click #(do
                                                     (.preventDefault %)
                                                     (process-text (t :badge/Endorsephrase2) state)
@@ -495,12 +492,12 @@
                                            :data-dismiss "modal"} [:i.fa.fa-remove] (t :badge/Declineendorsement)]]]]
                [:div.row.flip.buttons
                 [:div.col-md-8 #_[:button.btn.btn-primary {:on-click #(do
-                                                                      (.preventDefault %)
-                                                                      (edit-endorsement id user_badge_id @(cursor params [:endorsement :content])))
-                                                         :disabled (blank? @(cursor params [:endorsement :content]))
-                                                         :data-dismiss "modal"
-
-                                                         } (t :core/Save)]
+                                                                        (.preventDefault %)
+                                                                        (edit-endorsement id user_badge_id @(cursor params [:endorsement :content])))
+                                                           :disabled (blank? @(cursor params [:endorsement :content]))
+                                                           :data-dismiss "modal"
+
+                                                           } (t :core/Save)]
                  [:button.btn.btn-warning.cancel {:data-dismiss "modal"} (t :core/Cancel)]]
                 ;[:div.col-xs-12.delete-btn {:style {:margin "10px 0px 10px 0px" :cursor "pointer" :width "100%"}}
                 [:div.col-md-4 [:a.delete-btn {:style {:line-height "4" :cursor "pointer"}


remove warn-on-reflection

remove warn-on-reflection

--- src/main/clojure/clojure/tools/cli.clj
+++ src/main/clojure/clojure/tools/cli.clj
@@ -3,8 +3,6 @@
   (:use [clojure.string :only (replace)]
         [clojure.pprint :only (pprint cl-format)])
   (:refer-clojure :exclude [replace]))
-
-(set! *warn-on-reflection* true)

 (defn build-doc [{:keys [switches docs default required]}]
   [(apply str (interpose ", " switches))


CMR-5493: Cleanup user namespace.

CMR-5493: Cleanup user namespace.

--- schema-validation-lib/dev/user.clj
+++ schema-validation-lib/dev/user.clj
@@ -1,12 +1,13 @@
 (ns user
-  (:require [clojure.pprint :refer (pprint pp)]
-            [clojure.tools.namespace.repl :refer (refresh refresh-all)]
-            ;; Make Proto REPL lib properties available.
-            [proto-repl.saved-values])
-  (:use [clojure.test :only [run-all-tests]]
-        [clojure.repl]
-        ;; Needed to make debug-repl available
-        [alex-and-georges.debug-repl]))
+  (:require
+   ;; Needed to make debug-repl available
+   [alex-and-georges.debug-repl]
+   [clojure.pprint :refer [pprint pp]]
+   [clojure.repl]
+   [clojure.test :only [run-all-tests]]
+   [clojure.tools.namespace.repl :refer [refresh refresh-all]]
+   ;; Make Proto REPL lib properties available.
+   [proto-repl.saved-values]))

 (defn reset []
   (refresh))


up version

up version

--- kafka-clj/project.clj
+++ kafka-clj/project.clj
@@ -26,7 +26,7 @@
                  [org.clojure/tools.logging "0.2.6"]
                  [clj-tcp "0.2.17-SNAPSHOT"]
                  [fmap-clojure "0.1.4"]
-                 [fun-utils "0.3.0"]
+                 [fun-utils "0.3.2"]
                  [clj-tuple "0.1.4"]
                  [clj-json "0.5.3"]
                  [com.codahale.metrics/metrics-core "3.0.1"]


Add documentation.

Add documentation.

--- src/fhofherr/clj_db_util/transactions.clj
+++ src/fhofherr/clj_db_util/transactions.clj
@@ -1,18 +1,46 @@
 (ns fhofherr.clj-db-util.transactions
   (:require [clojure.java.jdbc :as jdbc]))

+;; Wrapper for a transaction. `op` is a function of two arguments returning
+;; a map {::connection con ::value v}. The first argument to `op` is the
+;; dialect currently in use, the second the connection.
 (defrecord Transaction [op])

-(defn tx-return [v] (Transaction. (fn [dialect con]
-                                    {::connection con ::value v})))
+(alter-meta! #'->Transaction assoc :no-doc true)
+(alter-meta! #'map->Transaction assoc :no-doc true)

-(defn tx-bind [tx f]
+(defn tx-return
+  "Take an arbitrary value `v` and wrap it into a transaction.
+
+  *Parameters*:
+
+  - `v` an arbitrary value to wrap into a transaction."
+  [v]
+  (Transaction. (fn [dialect con] {::connection con ::value v})))
+
+(defn tx-bind
+  "Take a transacton `tx` containting a value `v` and a function `f` of
+  one argument returning another transaction. Apply `f` to `v` and return
+  the resulting transaction.
+
+  *Parameters*:
+
+  - `tx` a transaction.
+  - `f` a function expecting one argument and returning a transaction."
+  [tx f]
   (Transaction. (fn [dialect con]
                   (let [{con* ::connection v ::value} ((:op tx) dialect con)
                         tx* (f v)]
                     ((:op tx*) dialect con*)))))

 (defmacro deftxfn
+  "Define a function that creates a transaction. The first entry of the
+  definitions argument vector will be bound to the dialect used during the
+  execution of the transaction. The second entry of the argument vector
+  will be bound to the current database connection. Further arguments are
+  optional."
+  {:arglists '([fn-name [dialect db-spec & args] & body]
+               [fn-name doc-string [dialect db-spec & args] & body])}
   [fn-name & body]
   (let [has-doc? (string? (first body))
         doc-string (if has-doc? (first body) nil)
@@ -28,6 +56,9 @@
                         ::value (do ~@decls)})))))

 (defmacro deftxfn-
+  "Same as [[deftxfn]] but yielding a non-public def."
+  {:arglists '([fn-name [dialect db-spec & args] & body]
+               [fn-name doc-string [dialect db-spec & args] & body])}
   [fn-name & body]
   `(deftxfn ~(with-meta fn-name (assoc (meta fn-name) :private true))
      ~@body))
@@ -43,6 +74,17 @@
   (reduce (fn [a s] (conj a (emit-tx-step s))) [] bindings))

 (defmacro tx->
+  "Evaluate transactions within a lexical context. The values of the
+  transactions are bound to the given binding symbols. The last transaction
+  in the bindings is returned as the evaluation result.
+
+  *Examples*:
+
+  ```clojure
+  (tx-> _ (t/insert! :fruit {:name \"Apple\" :cost 2.99})
+        _ (t/insert! :fruit_orders
+                     {:fruit_id 1 :customer_name \"Fruit Sales Inc.\"})
+  ```"
   [& bindings]
   (assert (even? (count bindings))
           "Need an even number of bindings!")
@@ -61,10 +103,15 @@
          ~@(emit-tx-steps reordered-bindings))))

 (defn tx-exec
+  "Execute the transaction `tx` in the database represented by `db-spec`.
+  The `dialect` is added for convenience since some database functions need it
+  to perform their tasks (this might not be a good idea, in which case I'll
+  remove the dialect)."
   [dialect db-spec tx]
   (jdbc/with-db-transaction [con db-spec]
     (::value ((:op tx) dialect con))))

 (defmacro tx-exec->
+  "Like [[tx->]] but immediately call [[tx-exec]] on the result."
   [dialect db-spec & bindings]
   `(tx-exec ~dialect ~db-spec (tx-> ~@bindings)))


some tidying up

some tidying up

--- src/main/clojure/org/dada/core.clj
+++ src/main/clojure/org/dada/core.clj
@@ -8,6 +8,7 @@
 	      FilteredView$Filter
 	      Getter
 	      GetterMetadata
+	      Metadata
 	      Model
 	      Transformer
 	      Transformer$Transform
@@ -73,7 +74,7 @@
 ;; factory
 ;; "org.dada.tmp.Amount"
 ;; :id int :version int :amount double)
-(defn make-class [class-name superclass & attribute-key-types]
+(defn make-class [#^String class-name #^Class superclass & attribute-key-types]
   (let [attribute-map (apply array-map attribute-key-types)]
     (. #^DynamicClassLoader
        (deref clojure.lang.Compiler/LOADER)
@@ -91,12 +92,6 @@
 ;; fields => [model field]

-;; might be better than runtime make instance, if we could have
-;; selected the right ctor - not used at moment...
-(defn make-constructor [class & types]
-  (let [ctor (symbol (str (.getCanonicalName class) "."))]
-    (fn [& args] (apply ctor args))))
-
 ;; see http://groups.google.com/group/clojure/browse_thread/thread/106a2f73fb49f492#

 ;; I'm going with directly invoking this ctor, because it seems to be
@@ -104,7 +99,7 @@
 ;; new on a symbol... What I really want to do is come up with
 ;; something that compiles down to bytecode that calls the correct
 ;; ctor for the given args directly... - TODO - more thought...
-(defn make-instance [class & args]
+(defn make-instance [#^Class class & args]
   (clojure.lang.Reflector/invokeConstructor class (to-array args)))

 (require '[clojure.contrib.str-utils2 :as s])
@@ -115,26 +110,11 @@
 (defn make-getter-name [property-name]
   (str "get" (s/capitalize property-name)))

-;; (defmacro make-lambda-getter [input-type output-type #^String property-name]
-;;   (let [method-name (symbol (make-getter-name property-name))]
-;;     `(fn [bean#] (. bean# ~method-name))))
-
-(defn make-lambda-getter [input-type output-type #^String property-name]
-  (let [method-name (symbol (make-getter-name property-name))]
-    (eval (list 'fn '[bean] (list '. 'bean method-name)))))
-
-;;(with-meta here (:tag output-type))
-
-;; TODO : should this not be a a macro - use proper syntax...
-(defn make-proxy-getter [input-type output-type property-name]
-  (let [method (symbol (make-getter-name property-name))]
-    (eval (list 'proxy '[Getter] '[] (list 'get '[bean] (list '. 'bean method))))
-    ))
-
 (defn getter-2 [#^Class input-type #^Class output-type #^String method-name]
   (let [method# (symbol (str "." method-name))]
-    (eval `(proxy [Getter] []
-		  (#^{:tag ~output-type} get [#^{:tag ~input-type} bean#] (~method# bean#))))
+    (eval
+     `(proxy [Getter] []
+	     (#^{:tag ~output-type} get [#^{:tag ~input-type} bean#] (~method# bean#))))
     ))

 (defn getter [#^Class input-type #^Class output-type #^Keyword key]
@@ -166,7 +146,7 @@
 	 (map name (keys attribute-map))
 	 (map (fn [[key type]] (getter class type key)) attribute-map))))

-(defn model [name metadata]
+(defn model [#^String name #^Metadata metadata]
   (let [names (.getAttributeNames metadata)
 	getters (.getAttributeGetters metadata)
 	getter-map (apply array-map (interleave names getters))
@@ -175,10 +155,9 @@
 	version-getter (getter-map (second key-names))]
     (new VersionedModelView name metadata id-getter version-getter)))

-;; (defmacro make-proxy-getter [input-type output-type property-name]
-;;   (let [method (symbol (make-getter-name property-name))]
-;;     `(proxy [Getter] [] (get [bean#] (. bean# ~method)))
-;;     ))
+;;----------------------------------------
+;; refactored to here
+;;----------------------------------------

 ;; should [if required] connect a transformer between model and view...
 ;; each property should be able to register a converter fn as part of the transformation...
@@ -236,6 +215,12 @@
 	defaulter (if (fn? default) default (fn [value] default))
 	retriever (fn [value] (convert (. src-getter get value)))]
     [tgt-type tgt-key retriever]
+    ))
+
+;; TODO : should this not be a a macro - use proper syntax...
+(defn make-proxy-getter [input-type output-type property-name]
+  (let [method (symbol (make-getter-name property-name))]
+    (eval (list 'proxy '[Getter] '[] (list 'get '[bean] (list '. 'bean method))))
     ))

 (defn make-getter-map [tgt-class fields]


Added console output option

Added console output option

--- src/parbench/core.clj
+++ src/parbench/core.clj
@@ -4,6 +4,7 @@
   (:require [clj-http.client :as client])
   (:import  [java.util.concurrent Executors]
             [javax.swing JFrame]
+            [java.util TimerTask Timer]
             [processing.core PApplet]))

 ; Size of Rectangles
@@ -63,9 +64,26 @@
        (binding [*applet* this]
        (on-draw this)))))

+(defn req-map-counts []
+  "Returns a mapping of req-map states to counts"
+  (reduce (fn [stats point]
+            (let [[x y state] (deref point)]
+               (assoc stats
+                 :progress (inc (stats :progress 0))
+                 state     (inc (stats state     0)))))
+          {}
+          (deref req-map) ))
+
+(defn initialize-console []
+  "Sets up display loop for console output"
+  (let [task (proxy [TimerTask] []
+               (run [] (println (req-map-counts))))]
+    (. (new Timer) (scheduleAtFixedRate task (long 0) (long 1000)))))
+
 (defn initialize-graphics [width height]
+  "Sets up GUI output via Processing"
   (let [pb-applet   (create-pb-applet width height)
-        swing-frame (JFrame. "Graphical HTTP Tester")]
+        swing-frame (JFrame. "Parbench HTTP Tester")]
     (.init pb-applet)
       (doto swing-frame
         (.setDefaultCloseOperation JFrame/EXIT_ON_CLOSE)
@@ -74,10 +92,12 @@
         (.pack)
         (.show))))

-(defn -main [concurrencyArg reqsArg url]
+(defn -main [mode concurrencyArg reqsArg url]
   (let [requests    (Integer. reqsArg)
         concurrency (Integer. concurrencyArg)
         width       (* gfx-scale requests)
         height      (* gfx-scale concurrency)]
-    (initialize-graphics width height)
+    (initialize-console)
+    (cond (not= mode "console")
+      (initialize-graphics width height))
     (run-requests requests concurrency url)))


backend side of handling replaying transactions

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -12,6 +12,7 @@
             [pc.datomic.web-peer :as web-peer]
             [pc.email :as email]
             [pc.http.datomic2 :as datomic2]
+            [pc.http.datomic.common :as datomic-common]
             [pc.models.access-grant :as access-grant-model]
             [pc.models.access-request :as access-request-model]
             [pc.models.chat :as chat]
@@ -20,6 +21,7 @@
             [pc.models.layer :as layer]
             [pc.models.permission :as permission-model]
             [pc.models.team :as team-model]
+            [pc.replay :as replay]
             [pc.rollbar :as rollbar]
             [pc.utils :as utils]
             [slingshot.slingshot :refer (try+ throw+)]
@@ -583,6 +585,14 @@
         (access-request-model/deny-request request annotations))
       (comment (notify-invite "Please sign up to send an invite.")))))

+(defmethod ws-handler :frontend/replay-transactions [{:keys [client-id ?data ?reply-fn] :as req}]
+  (check-document-access (-> ?data :document/id) req :admin)
+  (let [doc (->> ?data :document/id (doc-model/find-by-id (:db req)))]
+    (let [txes (replay/get-document-transactions (:db req) doc)]
+      (doseq [tx txes]
+        (Thread/sleep 250)
+        ((:send-fn @sente-state) client-id [:datomic/transaction (datomic-common/frontend-document-transaction tx)])))))
+
 (defmethod ws-handler :team/deny-access-request [{:keys [client-id ?data ?reply-fn] :as req}]
   (let [team-uuid (-> ?data :team/uuid)]
     (check-team-access team-uuid req :admin)


Add assertions

Add assertions

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -508,6 +508,12 @@

     (set-screen! my-game main-screen text-screen)"
   [^Game game-object & screen-objects]
+  (assert (isa? (type game-object) Game)
+          "Attempted to set screen with an invalid game object.")
+  (doseq [screen screen-objects]
+    (assert (every? #(fn? (get screen %))
+                    [:show :render :hide :pause :resize :resume])
+            "Attempted to set an invalid screen."))
   (let [run-fn! (fn [k & args]
                   (doseq [screen screen-objects]
                     (apply (get screen k) args)))]


folds/minimum/maximum: implement with min-key, max-key.

--- src/reimann/folds.clj
+++ src/reimann/folds.clj
@@ -51,9 +51,9 @@
 (defn minimum
   "Returns the minimum event, by metric."
   [events]
-  (first (sorted-sample-extract events [0])))
+  (apply min-key :metric events))

 (defn maximum
   "Returns the maximum event, by metric."
   [events]
-  (first (sorted-sample-extract events [1])))
+  (apply max-key :metric events))


More tweaks for with-swing-error-msg

More tweaks for with-swing-error-msg

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

--- src/conexp/contrib/gui/util.clj
+++ src/conexp/contrib/gui/util.clj
@@ -57,11 +57,13 @@
           (dialog :parent ~frame
                   :size [600 :by 300]
                   :content (vertical-panel :items [[:fill-v 10]
-                                                   (.getMessage cause#)
+                                                   (.getMessage ^Throwable cause#)
                                                    [:fill-v 10]
                                                    (scrollable (text :text (apply str (root-cause e#) "\n"
                                                                                (interpose "\n" (.getStackTrace e#)))
-                                                                     :multi-line? true))])
+                                                                     :multi-line? true
+                                                                     :editable? false
+                                                                     :caret-position 0))])
                   :type :error
                   :title ~title))))))


Add map<

Add map<

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -126,38 +126,47 @@
                [:text {:x 20 :y 150 :style {:font-size "64pt"
                                             :color "white"} :fill "white"} (str n)])]

+            ;;
+
+
             ;; Put
             [:g {:transform "translate(160,65)"
                  :onClick (fn [_]
                             (when-let [n (om/get-state owner :pending-put)]
                               (om/set-state! owner :pending-put nil)
                               (go
-                                (>! ch (str n))
+                                (>! ch n)
                                 (new-random-pick owner)
                                 ;; Forces a re-render
                                 (om/set-state! owner :modified (new js/Date)))))}
-             [:rect {:x 0 :y 0 :width 100 :height 100 :fill "red"}]
+             [:rect {:x 0 :y 0 :width 100 :height 100 :fill "black"}]
              [:text {:x 0 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}} ">!"]]

             ;; Buffer
             (for [x (range bufsize)]
-              [:g {:transform (str "translate(300,320)")}
+              [:g {:transform (str "translate(280,320)")}
                [:g {:transform (str "rotate(" (- (* (- x (/ bufsize 2) (- 1)) (/ 180 bufsize))) ") translate(200)")}
                 [:circle {:cx 0 :cy radius :r radius :style {:fill "#224"}}]
                 [:text {:x (- 0 (/ radius 2) 5) :y (* 1.7 radius) :style {:font-size default-font :fill "white"}}
                  (str (aget (.-arr (.-buf buf)) (mod (+ x (.-head (.-buf buf))) bufsize)))]]])

-            ;; Take
-            [:g {:transform "translate(160,475)"
-                 :onClick (fn [_]
-                            (go
-                              (om/set-state! owner :last-get (<! ch))
-                              (om/set-state! owner :modified (new js/Date))))}
-
-             [:rect {:x 0 :y 0 :width 100 :height 100 :fill "black"}]
-             [:text {:x 0 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}} "<!"]
-
-             ]
+            (let [ops (:ops data)]
+
+              ;; Take
+              [:g {:transform "translate(160,475)"
+                   ;; TODO add ops here
+                   :onClick (fn [_]
+                              (go
+                                (let [v (<! (case ops
+                                              :map (map< inc ch)
+                                              ch))]
+                                  (om/set-state! owner :last-get v))
+                                (om/set-state! owner :modified (new js/Date))))}
+
+               [:rect {:x 0 :y 0 :width 100 :height 100 :fill "black"}]
+               [:text {:x 0 :y 80 :style {:font-size default-font :stroke "white" :fill "white"}} "<!"]
+
+               ])

             ;; Receive box
             [:g  {:transform "translate(30,475)"}
@@ -342,7 +351,7 @@
            ]]]]))))

 (def app-model
-  (atom {:current-slide 4
+  (atom {:current-slide 7
          :slides
          ;; TODO Add cardinal such that each slide has its own number to avoid react warning
          (vec
@@ -374,7 +383,7 @@
              :custom channels-slide
              :opts {:buffer-size 7 :font-size "72pt" :radius 40}}

-            {:subtitle "putting on a channel"
+            {:subtitle "put"
              :custom channels-slide
              :put true
              :opts {:buffer-size 7 :font-size "72pt" :radius 40}}
@@ -382,6 +391,11 @@
             ;; TODO Add source code on right hand side of slide
             {:subtitle "put and take"
              :custom put-and-take-slide
+             :opts {:buffer-size 7 :font-size "72pt" :radius 50}}
+
+            {:subtitle "put and take with map"
+             :custom put-and-take-slide
+             :ops :map
              :opts {:buffer-size 7 :font-size "72pt" :radius 50}}

             {:subtitle "timeouts"


core: if-some

core: if-some

--- data/core.clj
+++ data/core.clj
@@ -1147,3 +1147,23 @@
        (when temp#
          (let [~form temp#]
            ~@body)))))
+
+(defmacro if-some
+  "bindings => binding-form test
+
+  If test is not nil, evaluates then with binding-form bound to the
+  value of test, if not, yields else"
+  {:added "1.0"}
+  ([bindings then]
+   `(if-some ~bindings ~then nil))
+  ([bindings then else & oldform]
+   (assert-args
+    (vector? bindings) "a vector for its binding"
+    (nil? oldform) "1 or 2 forms after binding vector"
+    (= 2 (count bindings)) "exactly 2 forms in binding vector")
+   (let [form (bindings 0) tst (bindings 1)]
+     `(let [temp# ~tst]
+        (if (nil? temp#)
+          ~else
+          (let [~form temp#]
+            ~then))))))


util/context.clj: added use-property-function

--- src/org/altlaw/util/context.clj
+++ src/org/altlaw/util/context.clj
@@ -2,6 +2,9 @@

 (defn get-property-function [name]
   (System/getProperty name))
+
+(defn use-property-function [f]
+  (alter-var-root #'get-property-function (fn [_] f)))

 (defn get-property [name]
   (or (get-property-function name)