print '\!' when exception thrown

print '\!' when exception thrown

--- src/com/billpiel/sayid/string_output.clj
+++ src/com/billpiel/sayid/string_output.clj
@@ -139,6 +139,11 @@
       []
       [(get-line-meta tree :header? true)
        (slinky-pipes-MZ depth :end (when start? "v"))
+       (when (:throw tree)
+         [(color-code-MZ :fg 1 :bg 7)
+          "!"
+          (color-code-MZ)
+          " "])
        (if parent-name
          [(color-code-MZ :fg 0 :bg* (dec depth) :bold false)
           (str (if-not (nil? form)


fix :npm-module source maps

fix :npm-module source maps

prepend somehow got lost somewhere in the past

fixes #617

--- src/main/shadow/build/output.clj
+++ src/main/shadow/build/output.clj
@@ -175,7 +175,7 @@

 (defn generate-source-map
   [state
-   {:keys [resource-name output-name file input] :as src}
+   {:keys [resource-name output-name file] :as src}
    output
    js-file
    prepend]
@@ -204,7 +204,7 @@
           (encode-source-map-json
             state
             ;; ugly hack to change the "sources":["/absolute/path/to/file.cljs"] in source maps
-            (assoc src :resource-name source-name)
+            (assoc src :resource-name source-name :prepend prepend)
             output)]

       (io/make-parents src-map-file)
@@ -411,7 +411,7 @@
       (subs s 0 idx)
       s)))

-(defn js-module-src-prepend [state {:keys [resource-id resource-name output-name provides requires deps] :as src} require?]
+(defn js-module-src-prepend [state {:keys [output-name] :as src} require?]
   (let [dep-syms
         (data/deps->syms state src)


A little more documentation, tweak to colours.

--- src/od117_walker/core.clj
+++ src/od117_walker/core.clj
@@ -4,11 +4,14 @@
             [clj-http.client :as client]
             [pl.danieljanus.tagsoup :as ts]))

+;; Base address of wiki to walk.
+(def wiki-address "http://od117.wikidot.com/")
+
 (defn find-and-parse-page
   "Download the given wiki page and run it through the parser."
   [page]
   (->> page
-       (str "http://od117.wikidot.com/")
+       (str wiki-address)
        (client/get)
        (:body)
        (ts/parse-string)))
@@ -91,13 +94,15 @@
                    out))))
       out)))

+;; Colours used for different author's bubbles.
+;; Manually chosen for maximum style.
 (def author-colours {"/catalogatrix-maridia" "aquamarine"
                      "/isabella-yutani" "brown1"
                      "/john-9eb99c7f-e482-492f-8807-dc6f208b5c60" "burlywood1"
                      "/major-kaspar-parmenides" "cadetblue1"
                      "/prof-cuthburt-robinson-smithe" "chocolate1"
                      "/qitik-von-gratzk" "darkorchid2"
-                     "/research-droid-8608c29d-d2e6-441e-9d6c-edaf932a7e82" "darkslategray1"})
+                     "/research-droid-8608c29d-d2e6-441e-9d6c-edaf932a7e82" "forestgreen"})

 (defn graphify-one
   "Create graphviz dot language entries for given graph node (in internal map format)."


Cosmetics

Cosmetics

--- src/alfresco_technical_validation/validation.clj
+++ src/alfresco_technical_validation/validation.clj
@@ -47,10 +47,10 @@
 (defn- build-loc-bookmarks
   [locs type]
   (let [[f l] (get locs type)
-        files (str f)
-        loc   (str l)]
-    { (str type "Files") (if (s/blank? files) "0" files)
-      (str type "LOC")   (if (s/blank? loc)   "0" loc) }))
+        files (if (s/blank? f) "0" f)
+        loc   (if (s/blank? l) "0" l)]
+    { (str type "Files") files
+      (str type "LOC")   loc }))

 (defn- count-locs
   [source source-index]


Distinguish between atom and value from tools.namespace

--- src/midje/data/project_state.clj
+++ src/midje/data/project_state.clj
@@ -69,7 +69,7 @@

 ;; Global state.

-(defonce state-tracker (atom (nstrack/tracker)))
+(defonce state-tracker-atom (atom (nstrack/tracker)))

 (defn file-modification-time [file]
   (.lastModified file))
@@ -132,7 +132,7 @@

 (defn mkfn:scan-and-react [options scanner]
   (fn []
-    (swap! state-tracker
+    (swap! state-tracker-atom
            #(let [new-tracker (apply scanner % (:files options))]
               (react-to-tracker! new-tracker options)
               (prepare-for-next-scan new-tracker)))))


Add and use reducers version of `concat`.

--- src/clojure/parkour/reducers.clj
+++ src/clojure/parkour/reducers.clj
@@ -1,10 +1,16 @@
 (ns parkour.reducers
-  (:refer-clojure :exclude [map-indexed reductions distinct count first keep])
-  (:require [clojure.core.reducers :as r]
+  (:refer-clojure
+   , :exclude [concat map-indexed reductions distinct count first keep])
+  (:require [clojure.core :as cc]
+            [clojure.core.reducers :as r]
             [clojure.core.protocols :as ccp]
             [transduce.reducers :as tr]
             [parkour.util :refer [returning]])
   (:import [java.util Random]))
+
+(defn concat
+  "Reducers version of `concat`."
+  [& colls] (r/mapcat identity colls))

 (defn map-indexed
   "Reducers version of `map-indexed`."
@@ -18,7 +24,7 @@
   ([f coll] (reductions f (f) coll))
   ([f init coll]
      (let [sentinel (Object.)]
-       (->> (r/mapcat identity [coll [sentinel]])
+       (->> (concat coll [sentinel])
             (tr/map-state (fn [acc x]
                             (if (identical? sentinel x)
                               [nil acc]
@@ -32,7 +38,7 @@
 `r/reduce`."
   ([keyfn f coll]
      (let [sentinel (Object.)]
-       (->> (r/mapcat identity [coll [sentinel]])
+       (->> (concat coll [sentinel])
             (tr/map-state (fn [[k acc] x]
                             (if (identical? sentinel x)
                               [nil acc]
@@ -83,7 +89,7 @@
      (fn
        ([o] (apply f o x y more))
        ([o z] (apply f o x y z more))
-       ([o z & args] (apply f o x y z (concat more args))))))
+       ([o z & args] (apply f o x y z (cc/concat more args))))))

 (defn mjuxt
   "Return a function which calls each function in `fs` on the


Fix position of avatar in user hover

Fix position of avatar in user hover

--- src/braid/core/client/ui/styles/hover_cards.cljs
+++ src/braid/core/client/ui/styles/hover_cards.cljs
@@ -6,7 +6,7 @@
     [braid.core.client.ui.styles.vars :as vars]))

 (def offset (px 5))
-(def avatar-size (rem 2.5))
+(def avatar-size (rem 1.0))

 (defn card []
   [:&
@@ -75,7 +75,8 @@

    [:>.header
     ; reserve room for avatar, which is absolutely positioned
-    {:padding-right avatar-size}
+    {:padding-right avatar-size
+     :position "relative"}

     [:>.status
      {:display "inline-block"


Fix (close) function so sketch stops after current iteration not after next one.

--- src/quil/applet.clj
+++ src/quil/applet.clj
@@ -59,11 +59,11 @@
 (defn applet-close
   "Stop the applet and close the window. Call on-close function afterwards."
   [applet]
+  (applet-safe-exit applet)
   (javax.swing.SwingUtilities/invokeLater
     (fn []
       (when-let [frame @(:target-obj (meta applet))]
-        (.hide frame))
-      (applet-safe-exit applet))))
+        (.hide frame)))))

 (defn- launch-applet-frame
   [applet title renderer keep-on-top?]


CEO-108 Simplify common error checking

CEO-108 Simplify common error checking

--- src/clj/collect_earth_online/db/institutions.clj
+++ src/clj/collect_earth_online/db/institutions.clj
@@ -34,7 +34,7 @@
                         :base64Image      base64_image})) ; base64Image is last so it does not appear in the logs.
       (data-response (str "Institution " institution-id " is not found.")))))

-(defn- check-inputs [name description]
+(defn- get-common-errors [name description]
   (cond
     (or (nil? name) (= name ""))
     (str "Name is required.")
@@ -48,14 +48,9 @@
     (> (count description) max-description-length)
     (str "Institution description must not exceed " max-description-length " characters.")))

-(defn- get-create-errors [name description]
-  (let [input-error (check-inputs name description)]
-    (cond
-      input-error
-      input-error
-
-      (sql-primitive (call-sql "institution_name_taken" name -1))
-      (str "Institution with the name " name " already exists."))))
+(defn- get-create-errors [name]
+  (when (sql-primitive (call-sql "institution_name_taken" name -1))
+    (str "Institution with the name " name " already exists.")))

 (defn create-institution [{:keys [params]}]
   (let [user-id      (:userId params -1)
@@ -63,7 +58,8 @@
         base64-image (:base64Image params)
         url          (:url params)
         description  (:description params)]
-    (if-let [error-message (get-create-errors name description)]
+    (if-let [error-message (or (get-common-errors name description)
+                               (get-create-errors name))]
       (data-response error-message)
       (if-let [institution-id (sql-primitive (call-sql "add_institution" name url description))]
         (do
@@ -72,19 +68,15 @@
           (doseq [admin-id (set [user-id 1])]
             (call-sql "add_institution_user" institution-id admin-id 1))
           (data-response institution-id))
-        (data-response "")))))
+        (data-response "Unknown server error.")))))

-(defn- get-update-errors [institution-id user-id name description]
-  (let [input-error (check-inputs name description)]
-    (cond
-      input-error
-      input-error
+(defn- get-update-errors [institution-id user-id name]
+  (cond
+    (nil? (first (call-sql "select_institution_by_id" institution-id user-id)))
+    (str "Institution " institution-id " is not found.")

-      (nil? (first (call-sql "select_institution_by_id" institution-id user-id)))
-      (str "Institution " institution-id " is not found.")
-
-      (sql-primitive (call-sql "institution_name_taken" name institution-id))
-      (str "Institution with the name " name " already exists."))))
+    (sql-primitive (call-sql "institution_name_taken" name institution-id))
+    (str "Institution with the name " name " already exists.")))

 (defn update-institution [{:keys [params]}]
   (let [user-id        (:userId params -1)
@@ -93,7 +85,8 @@
         base64-image   (:base64Image params)
         url            (:url params)
         description    (:description params)]
-    (if-let [error-message (get-update-errors institution-id user-id name description)]
+    (if-let [error-message (or (get-common-errors name description)
+                               (get-update-errors institution-id user-id name))]
       (data-response error-message)
       (do
         (call-sql "update_institution" institution-id name url description)


GAWB-1543: suggested changes

GAWB-1543: suggested changes

--- src/cljs/main/broadfcui/common/entity_table.cljs
+++ src/cljs/main/broadfcui/common/entity_table.cljs
@@ -28,10 +28,9 @@
 (react/defc EntityTable
   {:update-data
    (fn [{:keys [refs after-update]} reinitialize?]
-     (if reinitialize?
-       (do (react/call :refresh-rows (@refs "table"))
-           (after-update #(react/call :reinitialize (@refs "table"))))
-       (react/call :refresh-rows (@refs "table"))))
+       (react/call :refresh-rows (@refs "table"))
+       (when reinitialize?
+             (after-update #(react/call :reinitialize (@refs "table")))))
    :refresh
    (fn [{:keys [props state this after-update]} & [entity-type reinitialize?]]
      (endpoints/call-ajax-orch
@@ -139,7 +138,7 @@
                                                             "pageSize" rows-per-page
                                                             "filterTerms" (js/encodeURIComponent filter-text)
                                                             "sortField" sort-column
-                                                            "sortDirection" (name (utils/cljslog sort-order))})
+                                                            "sortDirection" (name sort-order)})
                :on-done (fn [{:keys [success? get-parsed-response status-text status-code]}]
                           (if success?
                             (let [{:keys [results]


clean up pre-synth

clean up pre-synth

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -448,21 +448,21 @@
     `(let [~@param-proxies]
           (binding [*ugens* []
                     *constants* #{}]
-            (let [[ugens# constants#] (gather-ugens-and-constants
-                                        (with-overloaded-ugens ~@ugen-form))
-                  ugens# (topological-sort-ugens ugens#)
-                  main-tree# (set ugens#)
-                  side-tree# (filter #(not (main-tree# %)) *ugens*)
-                  ugens# (concat ugens# side-tree#)
-                  n-local-bufs# (count-ugens ugens# "LocalBuf")
-                  ugens# (if (> n-local-bufs# 0)
-                           (cons (max-local-bufs n-local-bufs#) ugens#)
-                           ugens#)
-                  constants# (if (> n-local-bufs# 0)
-                               (cons n-local-bufs# constants#)
-                               constants#)
-                  constants# (into [] (set (concat constants# *constants*)))]
-              [~sname ~params ugens# constants#])))))
+            (let [[ugens# consts#] (gather-ugens-and-constants
+                                    (with-overloaded-ugens ~@ugen-form))
+                  ugens#           (topological-sort-ugens ugens#)
+                  main-tree#       (set ugens#)
+                  side-tree#       (filter #(not (main-tree# %)) *ugens*)
+                  ugens#           (concat ugens# side-tree#)
+                  n-local-bufs#    (count-ugens ugens# "LocalBuf")
+                  ugens#           (if (> n-local-bufs# 0)
+                                     (cons (max-local-bufs n-local-bufs#) ugens#)
+                                     ugens#)
+                  consts#          (if (> n-local-bufs# 0)
+                                     (cons n-local-bufs# consts#)
+                                     consts#)
+                  consts#       (into [] (set (concat consts# *constants*)))]
+              [~sname ~params ugens# consts#])))))

 (defn synth-player
   [sdef params this & args]


add docstrings for ugen done-action constants

--- src/overtone/sc/ugens.clj
+++ src/overtone/sc/ugens.clj
@@ -5,38 +5,21 @@
   (:use [overtone.sc.machinery.ugen fn-gen]))

 ;; Done actions are typically executed when an envelope ends, or a sample ends
-;; 0	do nothing when the UGen is finished
-;; 1	pause the enclosing synth, but do not free it
-;; 2	free the enclosing synth
-;; 3	free both this synth and the preceding node
-;; 4	free both this synth and the following node
-;; 5	free this synth; if the preceding node is a group then do g_freeAll on it, else free it
-;; 6	free this synth; if the following node is a group then do g_freeAll on it, else free it
-;; 7	free this synth and all preceding nodes in this group
-;; 8	free this synth and all following nodes in this group
-;; 9	free this synth and pause the preceding node
-;; 10	free this synth and pause the following node
-;; 11	free this synth and if the preceding node is a group then do g_deepFree on it, else free it
-;; 12	free this synth and if the following node is a group then do g_deepFree on it, else free it
-;; 13	free this synth and all other nodes in this group (before and after)
-;; 14	free the enclosing group and all nodes within it (including this synth)
-
-;;Done Actions
-(def NO-ACTION 0)
-(def PAUSE 1)
-(def FREE 2)
-(def FREE-AND-BEFORE 3)
-(def FREE-AND-AFTER 4)
-(def FREE-AND-GROUP-BEFORE 5)
-(def FREE-AND-GROUP-AFTER 6)
-(def FREE-UPTO-THIS 7)
-(def FREE-FROM-THIS-ON 8)
-(def FREE-PAUSE-BEFORE 9)
-(def FREE-PAUSE-AFTER 10)
-(def FREE-AND-GROUP-BEFORE-DEEP 11)
-(def FREE-AND-GROUP-AFTER-DEEP 12)
-(def FREE-CHILDREN 13)
-(def FREE-GROUP 14)
+(def NO-ACTION "Do nothing when the ugen is finished" 0)
+(def PAUSE "Pause the enclosing synth, but do not free it" 1)
+(def FREE "Free the enclosing synth" 2)
+(def FREE-AND-BEFORE "Free both this synth and the preceding node" 3)
+(def FREE-AND-AFTER "Free both this synth and the following node" 4)
+(def FREE-AND-GROUP-BEFORE "Free this synth; if the preceding node is a group then do g_freeAll on it, else free it" 5)
+(def FREE-AND-GROUP-AFTER "Free this synth; if the following node is a group then do g_freeAll on it, else free it" 6)
+(def FREE-UPTO-THIS "Free this synth and all preceding nodes in this group" 7)
+(def FREE-FROM-THIS-ON "Free this synth and all following nodes in this group" 8)
+(def FREE-PAUSE-BEFORE "Free this synth and pause the preceding node" 9)
+(def FREE-PAUSE-AFTER "Free this synth and pause the following node" 10)
+(def FREE-AND-GROUP-BEFORE-DEEP "Free this synth and if the preceding node is a group then do g_deepFree on it, else free it" 11)
+(def FREE-AND-GROUP-AFTER-DEEP "Free this synth and if the following node is a group then do g_deepFree on it, else free it" 12)
+(def FREE-CHILDREN "Free this synth and all other nodes in this group (before and after)" 13)
+(def FREE-GROUP "Free the enclosing group and all nodes within it (including this synth)" 14)

 ;;FFT Windows
 (def SINE 0)


Add the ability to associate metadata to callable-maps.

--- src/overtone/util/lib.clj
+++ src/overtone/util/lib.clj
@@ -103,22 +103,29 @@
     (val [] v)
     (getValue [] v)))

-(defn callable-map [m fun]
-    (proxy [clojure.lang.Associative clojure.lang.IFn] []
-      (count       [] (count m))
-      (seq         [] (seq m))
-      (cons        [[k v]] (callable-map (assoc m k v) fun))
-      (empty       [] {})
-      (equiv       [o] (= o m))
-      (containsKey [k] (contains? m k))
-      (entryAt     [k] (map-entry k (get m k)))
-      (assoc       [k v] (callable-map (assoc m k v) fun))
-      (valAt
-                  ([k] (get m k))
-                  ([k d] (get m k d)))
-      (invoke      [& args] (apply fun args))
-      (applyTo    ([args] (apply fun args)))
-      (toString   [] "Callable Map")))
+(defn callable-map
+  "Create a map-like datastructure which overrides it's behaviour when called as
+  a fn from lookup to an arbitrary fn you specify at creation time."
+  ([m fun] (callable-map m fun {}))
+  ([m fun metadata]
+     (proxy [clojure.lang.Associative clojure.lang.IFn clojure.lang.IObj clojure.lang.IMeta]
+         []
+       (count       [] (count m))
+       (seq         [] (seq m))
+       (cons        [[k v]] (callable-map (assoc m k v) fun))
+       (empty       [] {})
+       (equiv       [o] (= o m))
+       (containsKey [k] (contains? m k))
+       (entryAt     [k] (map-entry k (get m k)))
+       (assoc       [k v] (callable-map (assoc m k v) fun))
+       (valAt
+         ([k] (get m k))
+         ([k d] (get m k d)))
+       (invoke      [& args] (apply fun args))
+       (applyTo    ([args] (apply fun args)))
+       (toString   [] "Callable Map")
+       (withMeta   [new-metadata] (callable-map m fun new-metadata))
+       (meta       [] metadata))))

 (defn- syms-to-keywords [coll]
   (map #(if (symbol? %)


Comment plugins spec to avoid instrumentation problems

--- src/com/wsscode/pathom/core.cljc
+++ src/com/wsscode/pathom/core.cljc
@@ -78,8 +78,9 @@

 (s/def ::plugin (s/keys :opt [::wrap-read ::wrap-parser]))

+#_
 (s/def ::plugins
-  (s/coll-of ::plugin :kind vector?))
+  (s/with-gen (s/coll-of ::plugin :kind vector?) #(s/gen #{[]})))

 (s/def ::parent-join-key (s/or :prop ::spec.query/property
                                :ident ::spec.query/ident


CLJS-855: combinatorial code generation under advanced compilation

Under advanced compilation, :static-fns is true - efficient code
generation was done naively resulting in exponential code size when
nesting function calls of unknown arity.

Now if an invoke expression involves a fn of unknown arity instead
generate locals for the arguments then invoke. Google Closure will
intelligently rewrite these kinds of redundant assignments under
advanced compilation.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -1345,11 +1345,12 @@
 (defn parse-invoke
   [env [f & args :as form]]
   (disallowing-recur
-   (let [enve (assoc env :context :expr)
-         fexpr (analyze enve f)
+   (let [enve     (assoc env :context :expr)
+         fexpr    (analyze enve f)
          argexprs (vec (map #(analyze enve %) args))
-         argc (count args)]
-     (when (-> fexpr :info :fn-var)
+         argc     (count args)
+         fn-var?  (-> fexpr :info :fn-var)]
+     (when fn-var?
        (let [{:keys [variadic max-fixed-arity method-params name]} (:info fexpr)]
          (when (and (not (some #{argc} (map count method-params)))
                     (or (not variadic)
@@ -1361,8 +1362,13 @@
        (warning :fn-deprecated env {:fexpr fexpr}))
      (when (-> fexpr :info :type)
        (warning :invoke-ctor env {:fexpr fexpr}))
-     {:env env :op :invoke :form form :f fexpr :args argexprs
-      :children (into [fexpr] argexprs)})))
+     (if (or (not *cljs-static-fns*) (not (symbol? f)) fn-var? (contains? (meta f) ::analyzed))
+       {:env env :op :invoke :form form :f fexpr :args argexprs
+        :children (into [fexpr] argexprs)}
+       (let [arg-syms (take argc (repeatedly gensym))]
+         (analyze env
+           `(let [~@(vec (interleave arg-syms args))]
+              (~(vary-meta f assoc ::analyzed true) ~@arg-syms))))))))

 (defn analyze-symbol
   "Finds the var associated with sym"


CLJS-631: Use ana/namespaces for shadowing vars

The compiler used to be keeping track of namespaces it
had emitted and using that atom to determine whether a
variable shadowed a declared namespace. If dependent
namespaces were emitted before their dependencies, this
could result in the dependent file shadowing the names
of the not-yet-compiled dependency. This happened both
during out-of-order clean compilation and certain
instances of incremental compilation.

This patch utilizes the analyzer's existing namespaces atom
to track loaded namespaces rather than maintaining a separate
atom in the compiler.

Files are guaranteed to be analyzed in dependency order, so
this ensures that all files with valid ns forms will know of
the namespaces they need to avoid shadowing and behave
accordingly.

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -50,7 +50,9 @@
   [& args]
   `(.println System/err (str ~@args)))

-(defonce ns-first-segments (atom '#{"cljs" "clojure"}))
+(defn ns-first-segments []
+  (letfn [(get-first-ns-segment [ns] (first (string/split (str ns) #"\.")))]
+    (map get-first-ns-segment (keys @ana/namespaces))))

 ; Helper fn
 (defn shadow-depth [s]
@@ -58,7 +60,7 @@
     (loop [d 0, {:keys [shadow]} info]
       (cond
        shadow (recur (inc d) shadow)
-       (@ns-first-segments (str name)) (inc d)
+       (some #{(str name)} (ns-first-segments)) (inc d)
        :else d))))

 (defn munge
@@ -744,7 +746,6 @@

 (defmethod emit :ns
   [{:keys [name requires uses requires-macros env]}]
-  (swap! ns-first-segments conj (first (string/split (str name) #"\.")))
   (emitln "goog.provide('" (munge name) "');")
   (when-not (= name 'cljs.core)
     (emitln "goog.require('cljs.core');"))


* src/clj/cljs/compiler.clj: better handling of :col, simplify conditional logic

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -244,11 +244,11 @@
                (swap! *cljs-mappings*
                       (fn [lines]
                         (let [last (conj (peek lines)
-                                         {:file *cljs-file*
-                                          :gcol *cljs-gen-col*
-                                          :line (when m (:line m))
-                                          :col 0
-                                          :name (when m (str (:name m)))})]
+                                         (merge {:file *cljs-file*
+                                                 :gcol *cljs-gen-col*}
+                                                (when m {:line (:line m)
+                                                         :col (or (:col m) 0)
+                                                         :name (:name m)})))]
                           (conj (pop lines) last))))
                (swap! *cljs-gen-col* (fn [col] (+ col (count s)))))
              (print s))))


* src/clj/cljs/compiler.clj: closure will lift the test, no need to do it manually.

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -324,9 +324,8 @@
       (print (str "(" (when-not (bool-expr? test) "cljs.core.truth_")
                   "(" (emits test) ")?" (emits then) ":" (emits else) ")"))
       (let [testsym (gensym "test")]
-        (print (str "var " testsym " = " (emits test) ";\n"
-                    "if(" (when-not (bool-expr? test) "cljs.core.truth_")
-                    "(" testsym "))\n{" (emits then) "} else\n{" (emits else) "}\n"))))))
+        (print (str "if(" (when-not (bool-expr? test) "cljs.core.truth_")
+                    "(" (emits test) "))\n{" (emits then) "} else\n{" (emits else) "}\n"))))))

 (defmethod emit :throw
   [{:keys [throw env]}]


only analyze files that don't need recompilation if we haven't seen them before.

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -833,9 +833,10 @@
           (if (or (requires-compilation? src-file dest-file) (:source-map opts))
             (do (mkdirs dest-file)
               (compile-file* src-file dest-file opts))
-            (do
-              (ana/analyze-file src-file)
-              (parse-ns src-file dest-file opts)))
+            (let [ns-info (parse-ns src-file dest-file opts)]
+              (when-not (contains? @ana/namespaces (:ns ns-info))
+                (ana/analyze-file src-file))
+              ns-info))
           (catch Exception e
             (throw (ex-info (str "failed compiling file:" src) {:file src} e))))
         (throw (java.io.FileNotFoundException. (str "The file " src " does not exist.")))))))


Represent pileup results using more space-efficient data structures

--- src/cljam/algo/pileup.clj
+++ src/cljam/algo/pileup.clj
@@ -40,21 +40,26 @@
   (let [empty-qual? (and (= (.length qual) 1)
                          (= (.charAt qual 0) \*))]
     (if empty-qual?
-      (vec (repeat (count idx) 93)) ;; \~
-      (mapv (fn [[_ x]]
-              (if (number? x)
-                (qual/fastq-char->phred-byte (.charAt qual x))
-                93))
-            idx))))
+      (short-array (repeat (count idx) 93)) ;; \~
+      (->> idx
+           (map (fn [[_ x]]
+                  (if (number? x)
+                    (qual/fastq-char->phred-byte (.charAt qual x))
+                    93)))
+           short-array))))
+
+(deftype PosBase [^char base indel])

 (defn- seqs-at-ref
   [idx ^String s]
-  (mapv (fn [[op x xs]]
-          (let [c (if (number? x) (.charAt s x) x)]
-            (case op
-              :m [c]
-              :d [c xs]
-              :i [c (subs s (first xs) (last xs))]))) idx))
+  (->> idx
+       (map (fn [[op x xs]]
+              (let [c (if (number? x) (.charAt s x) x)]
+                (case op
+                  :m (->PosBase c nil)
+                  :d (->PosBase c xs)
+                  :i (->PosBase c (subs s (first xs) (last xs)))))))
+       object-array))

 (defn index-cigar
   "Align bases and base quality scores with the reference coordinate."
@@ -83,8 +88,10 @@
   "Find a piled-up base and an indel from an alignment."
   [^long ref-pos ^SAMAlignment aln]
   (let [relative-pos (- ref-pos (.pos aln))
-        qual ((:quals-at-ref aln) relative-pos)
-        [base indel] ((:seqs-at-ref aln) relative-pos)
+        qual (aget ^shorts (:quals-at-ref aln) relative-pos)
+        ^PosBase pb (aget ^objects (:seqs-at-ref aln) relative-pos)
+        base (.base pb)
+        indel (.indel pb)
         deletion? (number? indel)]
     (plpio/->PileupBase
      (zero? relative-pos)
@@ -106,7 +113,7 @@
   "Convert a pile into `cljam.io.pileup.LocusPile`."
   [chr [pos pile]]
   (when (seq pile)
-    (LocusPile. chr pos pile)))
+    (LocusPile. chr pos (object-array pile))))

 (defn filter-by-base-quality
   "Returns a predicate for filtering piled-up reads by base quality at its
@@ -114,7 +121,7 @@
   [^long min-base-quality]
   (fn [p]
     (->> #(<= min-base-quality (.qual ^PileupBase %))
-         (partial filterv)
+         (partial filter)
          (update p 1))))

 (defn- unzip-2
@@ -138,31 +145,30 @@
 (defn- merge-corrected-quals
   "Merge corrected quals with the uncorrected part."
   [^SAMAlignment aln ^long correct-start corrected-quals]
-  (let [quals (:quals-at-ref aln)
+  (let [^shorts quals (:quals-at-ref aln)
         start (.pos aln)
-        len   (count corrected-quals)]
-    (if (< start correct-start)
-      (-> quals
-          (subvec 0 (- correct-start start))
-          (into corrected-quals)
-          (into (subvec quals (+ (- correct-start start) len))))
-      (into corrected-quals (subvec quals len)))))
+        len   (count corrected-quals)
+        quals' (java.util.Arrays/copyOf quals (alength quals))
+        start' (if (< start correct-start) (- correct-start start) 0)]
+    (dotimes [i len]
+      (aset quals' (+ start' i) (short (corrected-quals i))))
+    quals'))

 (defn- correct-pair-qual
   [^SAMAlignment a1 ^SAMAlignment a2]
   (let [pos1 (.pos a1)
         pos2 (.pos a2)
-        quals1 (:quals-at-ref a1)
-        quals2 (:quals-at-ref a2)
-        seqs1  (:seqs-at-ref a1)
-        seqs2  (:seqs-at-ref a2)]
+        ^shorts quals1 (:quals-at-ref a1)
+        ^shorts quals2 (:quals-at-ref a2)
+        ^objects seqs1 (:seqs-at-ref a1)
+        ^objects seqs2 (:seqs-at-ref a2)]
     (fn [^long pos]
       (let [relative-pos1 (- pos pos1)
             relative-pos2 (- pos pos2)
-            ^int q1 (quals1 relative-pos1)
-            ^int q2 (quals2 relative-pos2)
-            [b1] (seqs1 relative-pos1)
-            [b2] (seqs2 relative-pos2)]
+            q1 (aget quals1 relative-pos1)
+            q2 (aget quals2 relative-pos2)
+            b1 (-> seqs1 ^PosBase (aget relative-pos1) .-base)
+            b2 (-> seqs2 ^PosBase (aget relative-pos2) .-base)]
         (if (= b1 b2)
           [(min 200 (+ q1 q2)) 0]
           (if (<= q2 q1)


Require datom fragments to have a value, but let it be nil.

--- src/vault/entity/core.clj
+++ src/vault/entity/core.clj
@@ -22,7 +22,7 @@
   :op, :attr, and :value."
   [(schema/one schema/Keyword "operation")
    (schema/one schema/Keyword "attribute")
-   (schema/optional (schema/pred some? "some?") "value")])
+   (schema/one schema/Any "value")])

 (def DatomFragments


Added more video file types

Added more video file types

--- src/video_server/file.clj
+++ src/video_server/file.clj
@@ -14,7 +14,7 @@
             [video-server.format :refer [dimensions]])
   (:import (java.io File FilenameFilter)))

-(def movie-exts #{".mkv" ".mp4" ".m4v" ".avi" ".mov"})
+(def movie-exts #{".mkv" ".mp4" ".m4v" ".webm" ".avi" ".mov" ".flv" ".f4v" ".wmv" ".mpg" ".mpeg"})
 (def subtitle-exts #{".vtt" ".srt"})
 (def image-exts #{".jpg" ".jpeg" ".png" ".webp"})
 (def metadata-exts #{".json"})


WIP: connector-dump CLI with corresponding changes and refactor of the code.

--- db-serializers/scripts/connector-dump.clj
+++ db-serializers/scripts/connector-dump.clj
@@ -74,7 +74,7 @@
         (fwrite vals (format "connector-%s.edn" cname))
         (fwrite desc (format "connector-%s-desc.edn" cname))))))

-(def usage "Usage -x <path or URL> [-s <user:pass>] [-c <connector name>]")
+(def usage "Usage: -x <path or URL> [-s <user:pass>] [-c <connector name>]")

 (defn error-usage
   [& msg]


Minor refactoring in ns vault.store.

Minor refactoring in ns vault.store.

--- src/vault/store.clj
+++ src/vault/store.clj
@@ -41,12 +41,12 @@
   (not (nil? (stat store blobref))))

-(defn- adjust-prefix
-  "Adds the store's algorithm to a blobref prefix if none is specified."
-  [algorithm prefix]
-  (if-not (some (partial = \:) prefix)
-    (str (name algorithm) \: prefix)
-    prefix))
+(defn prefix-address
+  "Adds the given algorithm to a blobref if none is specified."
+  [algorithm address]
+  (if-not (some (partial = \:) address)
+    (str (name algorithm) \: address)
+    address))

 (defn select-blobrefs
@@ -70,7 +70,9 @@
   ([store]
    (enumerate store))
   ([store prefix]
-   (let [prefix (adjust-prefix (:algorithm store) prefix)]
-     (enumerate store {:prefix prefix})))
+   (->> prefix
+        (prefix-address (:algorithm store))
+        (hash-map :prefix)
+        (enumerate store)))
   ([store prefix & more]
    (mapcat (partial enumerate-prefixes store) (cons prefix more))))


Adds comment about development handler behavior

--- src/yuubin/core.clj
+++ src/yuubin/core.clj
@@ -31,7 +31,7 @@
                mail-handler
                json/write-str)}))

-;; For `lein ring server`
+;; For `lein ring server`. Doesn't contact mail server, only echoes request back.
 (def handler
   (let [template-dir (.getFile (-> "templates" clojure.java.io/resource))]
     (ring-handler (fn [json] (mail/format-for-mailgun json template-dir)))))


update! no longer used

update! no longer used

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -110,9 +110,6 @@
   (if flow-conditions
     (apply-post-transformation message routes event)
     message))
-
-(defn update! [coll k1 f]
-  (assoc! coll k1 (f (get coll k1))))

 (defrecord AccumAckSegments [ack-val segments])


JC | library html file loaded at run-time instead of compile time

--- src/stonecutter/view/profile.clj
+++ src/stonecutter/view/profile.clj
@@ -1,23 +1,22 @@
 (ns stonecutter.view.profile
-  (:require [traduki.core :as t]
-            [net.cgrand.enlive-html :as html]
+  (:require [net.cgrand.enlive-html :as html]
             [stonecutter.config :as config]
             [stonecutter.routes :as r]
             [stonecutter.view.view-helpers :as vh]))

-(defn add-username [request enlive-m]
+(defn add-username [enlive-m request]
   (let [email (get-in request [:session :user-login])]
     (html/at enlive-m
              [:.clj--card-email] (html/content email))))

 (def library-template (vh/load-template "public/library.html"))

-(def application-list-item (first (html/select library-template [:.clj--authorised-app__list-item])))
+(defn application-list-item [library-m] (first (html/select library-template [:.clj--authorised-app__list-item])))

-(def empty-application-list-item (first (html/select library-template [:.clj--authorised-app__list-item--empty])))
+(defn empty-application-list-item [library-m] (first (html/select library-template [:.clj--authorised-app__list-item--empty])))

-(defn application-list-items [authorised-clients]
-  (html/at application-list-item
+(defn application-list-items [authorised-clients library-m]
+  (html/at (application-list-item library-m)
            [:.clj--authorised-app__list-item]
            (html/clone-for [client authorised-clients]
                            [:.clj--client-name] (html/content (:name client))
@@ -25,11 +24,11 @@
                                                                                "?client_id="
                                                                                (:client-id client))))))

-(defn add-application-list [request enlive-m]
+(defn add-application-list [enlive-m request library-m]
   (let [authorised-clients (get-in request [:context :authorised-clients])]
     (if-not (empty? authorised-clients)
-      (html/at enlive-m [:.clj--app__list] (html/content (application-list-items authorised-clients)))
-      (html/at enlive-m [:.clj--app__list] (html/content empty-application-list-item)))))
+      (html/at enlive-m [:.clj--app__list] (html/content (application-list-items authorised-clients library-m)))
+      (html/at enlive-m [:.clj--app__list] (html/content (empty-application-list-item library-m))))))

 (defn set-sign-out-link [enlive-m]
   (html/at enlive-m
@@ -43,17 +42,17 @@
   (html/at enlive-m
            [:.clj--delete-account__link] (html/set-attr :href (r/path :show-delete-account-confirmation))))

-(defn hide-admin-span [request enlive-m]
+(defn hide-admin-span [enlive-m request]
   (let [role (get-in request [:context :role])]
     (html/at enlive-m [:.clj--admin__span]
              (when (= role (:admin config/roles)) identity))))

-(defn diplay-email-unconfirmed-message [request enlive-m]
+(defn diplay-email-unconfirmed-message [enlive-m request]
   (if (= false (get-in request [:context :confirmed?]))
     enlive-m
     (vh/remove-element enlive-m [:.clj--unconfirmed-email-message-container])))

-(defn set-flash-message [request enlive-m]
+(defn set-flash-message [enlive-m request]
   (case (:flash request)
     :password-changed (html/at enlive-m [:.clj--flash-message-text] (html/set-attr :data-l8n "content:flash/password-changed"))
     :email-confirmed (html/at enlive-m [:.clj--flash-message-text] (html/set-attr :data-l8n "content:flash/email-confirmed"))
@@ -61,13 +60,14 @@
     (vh/remove-element enlive-m [:.clj--flash-message-container])))

 (defn profile [request]
-  (->> (vh/load-template "public/profile.html")
-       (set-flash-message request)
-       (diplay-email-unconfirmed-message request)
-       (add-username request)
-       (add-application-list request)
-       set-sign-out-link
-       set-change-password-link
-       set-delete-account-link
-       (hide-admin-span request)
-       vh/remove-work-in-progress))
+  (let [library-m (vh/load-template "public/library.html")]
+    (->  (vh/load-template "public/profile.html")
+         (set-flash-message request)
+         (diplay-email-unconfirmed-message request)
+         (add-username request)
+         (add-application-list request library-m)
+         set-sign-out-link
+         set-change-password-link
+         set-delete-account-link
+         (hide-admin-span request)
+         vh/remove-work-in-progress)))


Added pre-read and post-read control support

--- src/clj_ldap/client.clj
+++ src/clj_ldap/client.clj
@@ -22,6 +22,11 @@
             LDAPEntrySource
             EntrySourceException
             SearchScope])
+  (:import [com.unboundid.ldap.sdk.controls
+            PreReadRequestControl
+            PostReadRequestControl
+            PreReadResponseControl
+            PostReadResponseControl])
   (:import [com.unboundid.util.ssl
             SSLUtil
             TrustAllTrustManager
@@ -29,11 +34,38 @@

 ;;======== Helper functions ====================================================

+(defn- entry-as-map
+  "Converts an Entry object into a map"
+  [entry]
+  (let [col-a (.getAttributes entry)
+        attrs (seq (.getAttributes entry))]
+      (apply hash-map :dn (.getDN entry)
+             (mapcat extract-attribute attrs))))
+
+(defn- add-response-control
+  "Adds the values contained in given response control to the given map"
+  [m control]
+  (condp instance? control
+    PreReadResponseControl
+    (update-in m [:pre-read] merge (entry-as-map (.getEntry control)))
+    PostReadResponseControl
+    (update-in m [:post-read] merge (entry-as-map (.getEntry control)))
+    m))
+
+(defn- add-response-controls
+  "Adds the values contained in the given response controls to the given map"
+  [controls m]
+  (reduce add-response-control m (seq controls)))
+
 (defn- ldap-result
-  "Converts an LDAPResult object into a vector"
+  "Converts an LDAPResult object into a map"
   [obj]
-  (let [res (.getResultCode obj)]
-    [(.intValue res) (.getName res)]))
+  (let [res (.getResultCode obj)
+        controls (.getResponseControls obj)]
+    (add-response-controls
+     controls
+     {:code (.intValue res)
+      :name (.getName res)})))

 (defn- connection-options
   "Returns a LDAPConnectionOptions object"
@@ -128,13 +160,7 @@
       (> (.size attr) 1)     [k (vec (.getValues attr))]
       :else                  [k (.getValue attr)])))

-(defn- entry-as-map
-  "Converts an Entry object into a map"
-  [entry]
-  (let [col-a (.getAttributes entry)
-        attrs (seq (.getAttributes entry))]
-      (apply hash-map :dn (.getDN entry)
-             (mapcat extract-attribute attrs))))
+

 (defn- set-entry-kv!
   "Sets the given key/value pair in the given entry object"
@@ -166,6 +192,18 @@
   (for [[k v] modify-map]
     (create-modification modify-op (name k) v)))

+(defn- add-request-controls
+  [request options]
+  "Adds LDAP controls to the given request"
+  (when (contains? options :pre-read)
+    (let [attributes (map name (options :pre-read))
+          pre-read-control (PreReadRequestControl. (into-array attributes))]
+      (.addControl request pre-read-control)))
+  (when (contains? options :post-read)
+    (let [attributes (map name (options :post-read))
+          pre-read-control (PostReadRequestControl. (into-array attributes))]
+      (.addControl request pre-read-control))))
+

 (defn- get-modify-request
   "Sets up a ModifyRequest object using the contents of the given map"
@@ -173,9 +211,10 @@
   (let [adds (modify-ops ModificationType/ADD (modifications :add))
         deletes (modify-ops ModificationType/DELETE (modifications :delete))
         replacements (modify-ops ModificationType/REPLACE
-                                 (modifications :replace))]
-    (ModifyRequest. dn (into-array (concat adds deletes replacements)))))
-
+                                 (modifications :replace))
+        all (concat adds deletes replacements)]
+    (doto (ModifyRequest. dn (into-array all))
+      (add-request-controls modifications))))

 (defn- next-entry
   "Attempts to get the next entry from an LDAPEntrySource object"
@@ -313,7 +352,13 @@
          :attribute-e [value1 value2]}
       :replace
         {:attibute-d value
-         :attribute-e [value1 value2]}}
+         :attribute-e [value1 value2]}
+      :pre-read
+        #{:attribute-a :attribute-b}
+      :post-read
+        #{:attribute-c :attribute-d}}
+
+Where :add adds an attribute value, :delete deletes an attribute value and :replace replaces the set of values for the attribute with the ones specified. The entries :pre-read and :post-read specify attributes that have be read and returned either before or after the modifications have taken place.
 "
   [connection dn modifications]
   (let [modify-obj (get-modify-request dn modifications)]


Removing old comments from core.cljs

Removing old comments from core.cljs

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -756,47 +756,3 @@
          ([x y z] (reduce #(conj %1 (%2 x y z)) [] fs))
          ([x y z & args] (reduce #(conj %1 (apply %2 x y z args)) [] fs))))))

-
-(comment
-  (use 'cljs.compiler)
-
-  (import '[javax.script ScriptEngineManager])
-
-  (def jse (-> (ScriptEngineManager.) (.getEngineByName "JavaScript")))
-  (.eval jse bootjs)
-  (.eval jse (clojure.java.io/reader "closure/library/closure/goog/base.js"))
-
-  (defmacro js [form & [ns]]
-    `(emit (analyze {:ns (@namespaces '~(or ns 'cljs.user)) :context :statement :locals {}} '~form)))
-
-  (defn jseval-prn [form & [ns]]
-    (let [js (emits (analyze {:ns (@namespaces (or ns 'cljs.user)) :context :expr :locals {}}
-                             form))]
-      ;;(prn js)
-      (.eval jse (str "print(" js ")"))))
-
-  (defn jseval [form & [ns]]
-    (let [js (emits (analyze {:ns (@namespaces (or ns 'cljs.user)) :context :expr :locals {}}
-                             form))]
-      ;;(prn js)
-      (.eval jse (str js))))
-
-  (with-open [r (java.io.PushbackReader. (clojure.java.io/reader "src/cljs/cljs/core.cljs"))]
-    (doseq [f (take-while identity (repeatedly (fn [] (read r false nil))))]
-      (jseval f 'cljs.user)))
-
-  (jseval '(seq nil))
-  (jseval '(next (cons 1 nil)))
-  (jseval '(nnext (cons (cons 1 nil) (cons 2 (cons 1 nil)))))
-
-  (jseval '(rest (conj (conj nil 1) 2)))
-  ;; 3 arg case needs apply?
-  (doseq [args [[1] [1 2] #_[1 2 3]]]
-    (doseq [op ['+ '- '* '/ '> '>= '< '<=]]
-      (println `(~op ~@args) " => " (jseval `(~op ~@args)))))
-
-  (jseval '(+ 1 2))
-
-  (js '(+ 1 2 3))
-
-  )


fixed remove-method test made helper fn args consistent with MultiFn deftype

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -2883,8 +2883,9 @@
    {} coll))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Tests ;;;;;;;;;;;;;;;;
-
-(defn ^{:export false} test-stuff []
+(declare test-multimethods)
+
+(defn ^{:export true} test-stuff []
   (assert (= [4 3 2 1 0] (loop [i 0 j ()]
                  (if (< i 5)
                    (recur (inc i) (conj j (fn [] i)))
@@ -3341,13 +3342,13 @@
     (assert (= @s (reverse v))))

   ;; delay
-  (let [d (delay (. (js/Date.) (getTime)))]
-    (assert (false? (realized? d)))
-    (let [d2 (. (js/Date.) (getTime))]
-      (assert (> d2 (deref d))))
-    (assert (true? (realized? d)))
-    (let [d3 (deref d)]
-      (assert (= (deref d) d3))))
+  ;; (let [d (delay (. (js/Date.) (getTime)))]
+  ;;   (assert (false? (realized? d)))
+  ;;   (let [d2 (. (js/Date.) (getTime))]
+  ;;     (assert (> d2 (deref d))))
+  ;;   (assert (true? (realized? d)))
+  ;;   (let [d3 (deref d)]
+  ;;     (assert (= (deref d) d3))))

   ;; assoc
   (assert (= {1 2 3 4} (assoc {} 1 2 3 4)))
@@ -3480,6 +3481,8 @@
   ;; vary-meta
   (assert (= {:a 1} (meta (vary-meta [] assoc :a 1))))
   (assert (= {:a 1 :b 2} (meta (vary-meta (with-meta [] {:b 2}) assoc :a 1))))
+
+  (test-multimethods)
   :ok
   )

@@ -3585,7 +3588,7 @@
   supplied defaults to, and modifies, the global hierarchy."
   ([tag parent]
      ;; (alter-var-root #'global-hierarchy underive tag parent)
-     (swap! global-hierarchy derive tag parent) nil)
+     (swap! global-hierarchy underive tag parent) nil)
   ([h tag parent]
     (let [parentMap (:parents h)
 	  childsParents (if (parentMap tag)
@@ -3628,7 +3631,7 @@
   (or (prefers* x y prefer-table) (isa? x y)))

 (defn- find-and-cache-best-method
-  [name dispatch-val method-table prefer-table cached-hierarchy hierarchy method-cache]
+  [name dispatch-val hierarchy method-table prefer-table method-cache cached-hierarchy]
   (let [best-entry (reduce (fn [be [k _ :as e]]
 			     (when (isa? dispatch-val k)
 			       (let [be2 (if (or (nil? be) (dominates k (first be) prefer-table))
@@ -3647,8 +3650,8 @@
 	  (second best-entry))
 	(do
 	  (reset-cache method-cache method-table cached-hierarchy hierarchy)
-	  (find-and-cache-best-method name dispatch-val method-table prefer-table
-				      cached-hierarchy hierarchy method-cache))))))
+	  (find-and-cache-best-method name dispatch-val hierarchy method-table prefer-table
+				      method-cache cached-hierarchy))))))

 (defprotocol IMultiFn
   (-reset [mf])
@@ -3694,8 +3697,8 @@
       (reset-cache method-cache method-table cached-hierarchy hierarchy))
     (if-let [target-fn (@method-cache dispatch-val)]
       target-fn
-      (if-let [target-fn (find-and-cache-best-method name dispatch-val method-table prefer-table
-      						     cached-hierarchy hierarchy method-cache)]
+      (if-let [target-fn (find-and-cache-best-method name dispatch-val hierarchy method-table
+						     prefer-table method-cache cached-hierarchy)]
 	target-fn
 	(@method-table default-dispatch-val))))

@@ -3838,7 +3841,6 @@
   (assert (= :a-return (foo :a)))
   (assert (= :default-return (foo 1)))

-
   ;; (defmulti area :Shape)
   ;; (defn rect [wd ht] {:Shape :Rect :wd wd :ht ht})
   ;; (defn circle [radius] {:Shape :Circle :radius radius})
@@ -3855,8 +3857,9 @@
   ;; (assert (= :oops (area {})))

   (assert (= 2 (count (methods bar))))
-  (remove-method bar [[:rect ::shape]])
+  (remove-method bar [::rect ::shape])
   (assert (= 1 (count (methods bar))))
-  (remove (zero? (count (methods bar))))
+  (remove-all-methods bar)
+  (assert (zero? (count (methods bar))))

   )


Fix bug so that cells outside the bounds of the matrix are ignored (#1)

--- src/cljs_life/core.cljs
+++ src/cljs_life/core.cljs
@@ -6,14 +6,16 @@

 (def world-size 500)
 (def size 5)
-(def max-cells (inc (/ world-size size)))
+(def max-cells (/ world-size size))

 (defn neighbours
   "Returns the coordinates of the cell's 8 neighbours"
   [[x y]]
-  (for [dx [-1 0 1]
+  (filter
+    (defn f [c] (every? #(and (< %1 max-cells) (>= %1 0)) c))
+    (for [dx [-1 0 1]
         dy (if (zero? dx) [-1 1] [-1 0 1])]
-    [(+ dx x) (+ dy y)]))
+      [(+ dx x) (+ dy y)])))

 (defn will-live?
   "Checks if a cell will be alive in the next iteration"
@@ -57,4 +59,4 @@
              :draw #'draw-world

              :features [:global-key-events]
-             :middleware [m/fun-mode])+             :middleware [m/fun-mode])


Add docstrings.

Add docstrings.

--- src/cljx/quil/core.cljx
+++ src/cljx/quil/core.cljx
@@ -257,6 +257,8 @@
     :subcategory "Keyboard"
     :added "1.0"}
   get-key []
+  "The system variable key always contains the value of the most recently pressed key on the keyboard.
+   For detecting the arrow keys, the keyCode variable is set to either UP, DOWN, LEFT, or RIGHT."
   (.-key (current-graphics)))

@@ -268,16 +270,22 @@
     :subcategory nil
     :added "1.0"}
   get-sketch-by-id [id]
+  "Returns sketch object by id of canvas element of sketch."
   (.getInstanceById js/Processing id))

 #+cljs
-(defn size
+(defn
   ^{:requires-bindings true
     :processing-name "size()"
     :category "Structure"
     :subcategory nil
     :added "1.0"}
+  size
+  "Defines the dimension of the display window in units of pixels.
+  The size() function must be the first line in setup().
+  If size() is not called, the default size of the window is 100x100 pixels.
+  The system variables width and height are set by the parameters passed to the size() function."
   ([width height]
     (.size (current-graphics) (int width) (int height)))


move verb-pred-defaults again

move verb-pred-defaults again

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -2119,8 +2119,6 @@
 (def lexicon (-> (compile-lex lexicon-source
                               morph/exception-generator
                               morph/phonize morph/english-specific-rules)
-
-                 (verb-pred-defaults encyc/verb-pred-defaults)

                  ;; add :sem :obj if necessary, so that intransitivize is triggered.
                  (if-then {:synsem {:cat :verb
@@ -2133,7 +2131,9 @@

                  ;; if verb does specify a [:sem :obj], then fill it in with subcat info.
                  transitivize
-
+
+                 (verb-pred-defaults encyc/verb-pred-defaults)
+
                  ;; if a verb has an object,
                  ;; and the object is not {:reflexive true}
                  ;; then the object is {:reflexive false}


fixed farie to faire

fixed farie to faire

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -304,7 +304,7 @@
              {:synsem {:pred :do}})
       (merge shared-part-of-faire
              {:synsem {:pred :make}})
-      (merge shared-part-of-farie
+      (merge shared-part-of-faire
              (let [subject-semantics (ref {:human true})
                   subject-agr (ref :top)]
                {:synsem {:cat :verb


Update :1.8 profile with clojure 1.8-RC1

--- profiles.clj
+++ profiles.clj
@@ -9,5 +9,4 @@
             [lein-ancient "0.6.7"]]}
  :1.6 {:dependencies [[org.clojure/clojure "1.6.0"]]}
  :1.5 {:dependencies [[org.clojure/clojure "1.5.1"]]}
- :1.8 {:dependencies [[org.clojure/clojure "1.8.0-beta2"]]}}
-
+ :1.8 {:dependencies [[org.clojure/clojure "1.8.0-RC1"]]}}


Adjust test-helper accordingly

Adjust test-helper accordingly

--- test/clojure/clojurewerkz/cassaforte/test_helper.clj
+++ test/clojure/clojurewerkz/cassaforte/test_helper.clj
@@ -4,47 +4,53 @@
             [clojurewerkz.cassaforte.cql :refer :all]
             [clojurewerkz.cassaforte.query :refer :all]))

+(declare ___test-session)
+
 (defn make-test-session
   []
-  (client/connect ["127.0.0.1"]))
+  (defonce ___test-session (client/connect ["127.0.0.1"]))
+  ___test-session)

 (defn with-temporary-keyspace
-  [session f]
-  (drop-keyspace session :new_cql_keyspace (if-exists))
+  [f]

-  (create-keyspace session "new_cql_keyspace"
-                   (with {:replication
-                          {:class "SimpleStrategy"
-                           :replication_factor 1 }}))
+  (let [session (make-test-session)]

-  (use-keyspace session :new_cql_keyspace)
+    (drop-keyspace session :new_cql_keyspace (if-exists))

-  (create-table session :users
-                (column-definitions {:name :varchar
-                                     :age  :int
-                                     :city :varchar
-                                     :primary-key [:name]}))
+    (create-keyspace session "new_cql_keyspace"
+                     (with {:replication
+                            {:class "SimpleStrategy"
+                             :replication_factor 1 }}))

-  (create-table session :user_posts
-                (column-definitions {:username :varchar
-                                     :post_id  :varchar
-                                     :body     :text
-                                     :primary-key [:username :post_id]}))
+    (use-keyspace session :new_cql_keyspace)

-  (create-table session :user_counters
-                (column-definitions {:name :varchar
-                                     :user_count  :counter
-                                     :primary-key [:name]}))
+    (create-table session :users
+                  (column-definitions {:name :varchar
+                                       :age  :int
+                                       :city :varchar
+                                       :primary-key [:name]}))

-  (create-table session :events_by_device_id_and_date
-                (column-definitions {:date        :varchar
-                                     :device_id   :varchar
-                                     :created_at  :timeuuid
-                                     :payload     :text
-                                     :primary-key [[:device_id :date] :created_at]}))
+    (create-table session :user_posts
+                  (column-definitions {:username :varchar
+                                       :post_id  :varchar
+                                       :body     :text
+                                       :primary-key [:username :post_id]}))

-  (f)
-  (drop-keyspace session :new_cql_keyspace))
+    (create-table session :user_counters
+                  (column-definitions {:name :varchar
+                                       :user_count  :counter
+                                       :primary-key [:name]}))
+
+    (create-table session :events_by_device_id_and_date
+                  (column-definitions {:date        :varchar
+                                       :device_id   :varchar
+                                       :created_at  :timeuuid
+                                       :payload     :text
+                                       :primary-key [[:device_id :date] :created_at]}))
+
+    (f)
+    (drop-keyspace session :new_cql_keyspace)))

 (defmacro test-combinations
   "Run given queries in both plain and prepared modes."


make safari stop showing the "are you sure you want to leave" dialog

--- src-cljs/frontend/core.cljs
+++ src-cljs/frontend/core.cljs
@@ -243,7 +243,8 @@
         handle-mouse-move!       #(handle-mouse-move cast! %)
         handle-canvas-mouse-down #(handle-mouse-down cast! %)
         handle-canvas-mouse-up   #(handle-mouse-up   cast! %)
-        handle-close!            #(cast! :application-shutdown [@histories])]
+        handle-close!            #(do (cast! :application-shutdown [@histories])
+                                      nil)]

     (swap! state assoc :undo-state undo-state)


Fix quotes

Fix quotes

--- web/src/immutant/web.clj
+++ web/src/immutant/web.clj
@@ -31,14 +31,14 @@

    options can be a map or kwargs, with these valid keys [default]:

-     * :host          The interface bind address [localhost]
+     * :host          The interface bind address [\"localhost\"]
      * :port          The port listening for requests [8080]
-     * :path          Maps the handler to a prefix of the url path [/]
+     * :path          Maps the handler to a prefix of the url path [\"/\"]
      * :virtual-host  Virtual host name[s] (a String or a List of Strings) [nil]

    Note the web server only binds to the loopback interface, by
    default. To expose your handler to the network, set :host to an
-   external IP address, or use `0.0.0.0` to bind it to all interfaces.
+   external IP address, or use \"0.0.0.0\" to bind it to all interfaces.

    The :virtual-host option enables name-based virtual hosting which,
    along with the :path option, distinguishes the handlers on a single


removed tiny unhelpful function, and hopefully added clarity as well

--- src/midje/ideas/background.clj
+++ src/midje/ideas/background.clj
@@ -112,14 +112,11 @@
 (defn against-background-body [form]
   `(do ~@(rest (rest form))))

-(letfn [(against-background-wrappers [against-background-form]
-          (background-wrappers (second against-background-form)))]
+(defn against-background-contents-wrappers [[_against-background_ background-forms & _]]
+  (filter (for-wrapping-target? :contents ) (background-wrappers background-forms)))

-  (defn against-background-contents-wrappers [form]
-    (filter (for-wrapping-target? :contents ) (against-background-wrappers form)))
-
-  (defn against-background-children-wrappers [form]
-    (remove (for-wrapping-target? :contents ) (against-background-wrappers form))))
+(defn against-background-children-wrappers [[_against-background_ background-forms & _]]
+  (remove (for-wrapping-target? :contents ) (background-wrappers background-forms)))

 (defn surround-with-background-fakes [forms]
   `(with-installed-fakes (background-fakes)


safety-net for database reset in tests

safety-net for database reset in tests

--- src/test/clj/chessdojo/database_test.clj
+++ src/test/clj/chessdojo/database_test.clj
@@ -1,13 +1,13 @@
 (ns chessdojo.database-test
   (:require [clojure.test :refer :all]
+            [clojure.string :as str]
             [chessdojo.database :refer :all]
             [monger.collection :as mc]))

 (defn reset-database [f]
-  ;(assert (clojure.string/includes? database "test"))
+  (assert (str/includes? database "test"))
   (mc/remove @db collection {})
-  (f)
-  )
+  (f))

 (use-fixtures :once reset-database)


Remove wiki generation code.

Remove wiki generation code.

--- src/quil/helpers/docs.clj
+++ src/quil/helpers/docs.clj
@@ -122,75 +122,3 @@
         lines (map #(apply str indent (interpose " " %)) wordss)]
     (doseq [l lines]
       (println l))))
-
-
-;;; wiki generation
-
-(defn- as-url [str]
-  (cstr/replace str " " "-"))
-
-(defn- as-filename [& path]
-  (->> path (map as-url) (cstr/join "/")))
-
-(defn- as-filename-ext [& path]
-  (str (apply as-filename path) ".md"))
-
-(defn- write-lines [file lines]
-  (io/make-parents file)
-  (spit file (cstr/join \newline lines)))
-
-(defn- link
-  ([to]
-    (link to (as-filename to)))
-  ([text to]
-    (format "[[%s|%s]]" text to)))
-
-(defn- generate-all-categories-page [fn-metas folder]
-  (let [cats (sort (fields-as-sorted-set fn-metas :category))
-        lines (map #(str "* " (link %)) cats)]
-    (write-lines (as-filename-ext folder "all_categories") lines)))
-
-(defn- generate-category-page [category folder]
-  (let [{:keys [name fns subcategories]} category
-        fn-line (fn [fn-name]
-                  (str "* " (link fn-name (as-filename name fn-name))))
-        subcat-lines (fn [subcat]
-                       (concat [""
-                                (str "## " (:name subcat))]
-                               (map fn-line (:fns subcat))
-                               []))
-        lines (flatten (concat (map fn-line fns)
-                               (map subcat-lines (vals subcategories))))]
-    (write-lines (as-filename-ext folder name) lines)))
-
-(defn- generate-function-page [fn-meta folder]
-  (let [{:keys [name arglists subcategory added doc
-                processing-name requires-bindings category]} fn-meta
-        bold #(str "**" % "**")
-        lines [(str "## " name)
-               (bold "Arguments") (map #(str "`" (pr-str %) "`  ") arglists)
-               (bold "Docstring") (str "```text\n" doc "\n```")
-               (bold "Category") (link category)
-               (if subcategory
-                 [(bold "Subcategory") "" (format "[[%s|%s#%s]]"
-                                                  subcategory
-                                                  (as-filename category)
-                                                  (as-filename subcategory))]
-                 nil)
-               (bold "Works only inside sketch functions?") (if requires-bindings "Yes" "No")
-               (bold "Original Processing method") (if processing-name
-                                                     (str "`" processing-name "`")
-                                                     "None. It is present only in Quil.")
-               (bold "Added in") added]]
-     (write-lines (as-filename-ext folder category name)
-                  (->> lines (remove nil?) (interpose "") flatten))))
-
-(defn- generate-all [fn-metas folder]
-  (generate-all-categories-page fn-metas folder)
-  (let [category-map (sorted-category-map fn-metas)]
-    (doseq [category (vals category-map)]
-      (generate-category-page category folder)))
-  (doseq [fn-meta (filter :category fn-metas)]
-    (generate-function-page fn-meta folder)))
-
-;(generate-all @(resolve 'quil.core/fn-metas) "../wiki")


Removed unused repl config

Removed unused repl config

--- dev/user.clj
+++ dev/user.clj
@@ -1,14 +0,0 @@
-(ns user
-  (:require [clojure.tools.namespace.repl :as tnr]
-            [clojure.repl]
-            [schema.core :as s]
-            [proto-repl.saved-values]))
-
-(defn start []
-  (println "Start completed"))
-
-(defn reset []
-  (tnr/refresh :after 'user/start))
-
-(println "proto-repl-demo dev/user.clj loaded.")
-(s/set-fn-validation! true)


refactor(cmd): one big fileS stream. Minor speedup

--- src/main/clojure/pdok/featured/core.clj
+++ src/main/clojure/pdok/featured/core.clj
@@ -12,7 +12,7 @@
             [clojure.tools.logging :as log])
   (:gen-class))

-(declare cli-options)
+(declare cli-options features-from-files)

 (defn execute [{:keys [json-files
                        dataset-name
@@ -28,10 +28,7 @@
         projectors (cond-> [] (not no-projectors) (conj (config/projectors persistence projection))
                            (not no-timeline) (conj (config/timeline persistence)))
         processor (processor/create persistence projectors)]
-    (doseq [json-file json-files]
-      (log/info "Processing " json-file)
-      (with-open [s (clojure.java.io/reader json-file)]
-        (dorun (consume processor (features-from-stream s :dataset dataset-name)))))
+    (dorun (consume processor (features-from-files json-files :dataset dataset-name)))
     (do (log/info "Shutting down.")
         (shutdown processor)))
   (log/info "done")
@@ -77,9 +74,34 @@

 (defn add-templates-and-create-extract [template-location dataset collection extract-type extract-version]
   (let [templates-with-metadata (template/templates-with-metadata dataset template-location)]
-    (do
-      (doseq [t templates-with-metadata]
+    (do
+      (doseq [t templates-with-metadata]
         (template/add-or-update-template t))
       (extracts/fill-extract dataset collection extract-type (read-string extract-version)))))
-
+
 ;(with-open [s (file-stream ".test-files/new-features-single-collection-100000.json")] (time (last (features-from-package-stream s))))
+
+(deftype CloseableSeq [delegate-seq close-fn]
+  clojure.lang.ISeq
+    (next [this]
+      (if-let [n (next delegate-seq)]
+        (CloseableSeq. n close-fn)
+        (.close this)))
+    (first [this] (if-let [f (first delegate-seq)] f (.close this)))
+    (more [this] (if-let [n (next this)] n '()))
+    (cons [this obj] (CloseableSeq. (cons obj delegate-seq) close-fn))
+    (count [this] (count delegate-seq))
+    (empty [this] (CloseableSeq. '() close-fn))
+    (equiv [this obj] (= delegate-seq obj))
+  clojure.lang.Seqable
+    (seq [this] this)
+  java.io.Closeable
+    (close [this] (close-fn)))
+
+(defn features-from-files [files & args]
+  (when (seq files)
+    (let [f (first files)
+          fs (clojure.java.io/reader f)]
+      (log/info "Processing " f)
+      (concat (CloseableSeq. (apply features-from-stream f args) #(.close fs))
+              (lazy-seq (apply features-from-files (rest files) args))))))


Solving 3.20

Solving 3.20

--- src/fpinscala/datastructures.clj
+++ src/fpinscala/datastructures.clj
@@ -255,4 +255,19 @@
                                       %2)))
 ;2) via mutable buffer - clojure equivalent would be via transient vector
 ;as to repeat clojure does not support transient list
+;-----------------------------------------------------------------------
+
+;3.20
+;mine
+(defn flat-map [xs f]
+  (fold-r-via-fold-l xs '() (fn [x acc]
+                              (let [tx (f x)]
+                                (if (coll? tx)
+                                  (append tx acc)
+                                  (cons tx acc))))))
+;my solution is more general though, allowing transforming function not to
+;return list
+;fpins - strictly assumes transformin function returns list thus it is simpler
+(defn flat-map-fpins [xs f]
+  (list-concat-fpins (map-fpins-1 xs f)))
 ;-----------------------------------------------------------------------


Remove abstract field from email notification scheme.

--- src/oc/storage/async/email.clj
+++ src/oc/storage/async/email.clj
@@ -23,7 +23,6 @@
    :board-name (schema/maybe schema/Str)
    :board-access (schema/maybe schema/Str)
    :headline schema/Str
-   :abstract (schema/maybe schema/Str)
    :body (schema/maybe schema/Str)
    :must-see (schema/maybe schema/Bool)
    :video-id (schema/maybe schema/Str)
@@ -50,7 +49,6 @@
    :board-name (:name board)
    :board-access (:access board)
    :headline (:headline entry)
-   :abstract (:abstract entry)
    :body (:body entry)
    :must-see (:must-see entry)
    :video-id (:video-id entry)


(PE-3868) Renamed validate-cert-extensions!

--- src/clj/puppetlabs/puppetserver/certificate_authority.clj
+++ src/clj/puppetlabs/puppetserver/certificate_authority.clj
@@ -737,7 +737,7 @@
       (utils/subtree-of? ppRegCertExt oid)
       (utils/subtree-of? ppPrivCertExt oid))))

-(schema/defn validate-cert-extensions!
+(schema/defn validate-extensions!
   "Throws an error if the extensions list contains any invalid extensions,
   according to `allowed-extension?`"
   [extensions :- (schema/pred utils/extension-list?)]
@@ -765,7 +765,7 @@
   ; if we are to behave exactly like the ruby CA.
   (let [extensions  (utils/get-extensions csr)
         csr-subject (get-csr-subject csr)]
-    (validate-cert-extensions! extensions)
+    (validate-extensions! extensions)
     (validate-subject! subject csr-subject)
     (validate-csr-signature! csr)))


Removed old reference

Removed old reference

--- src/cljs/kixi/hecuba/tabs/hierarchy/property_details.cljs
+++ src/cljs/kixi/hecuba/tabs/hierarchy/property_details.cljs
@@ -16,7 +16,6 @@
             [kixi.hecuba.tabs.hierarchy.profiles :as profiles]
             [kixi.hecuba.tabs.hierarchy.status :as status]
             [kixi.hecuba.tabs.hierarchy.tapestry :as tapestry]
-            [kixi.hecuba.tabs.hierarchy.xyplot :as xyplot]
             [kixi.hecuba.common :refer (log) :as common]
             [kixi.hecuba.tabs.hierarchy.data :refer (fetch-properties) :as data]
             [ajax.core :refer [GET PUT]]


restore all but :column-meta (#619)

restore all but :column-meta (#619)

--- src/cljs/org/broadinstitute/firecloud_ui/persistence.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/persistence.cljs
@@ -17,10 +17,8 @@
           :else @state)))

 (defn try-restore [{:keys [key initial validator]}]
-  (initial)
-  ;; FIXME: actual logic is disabled pending fix for new columns not showing up
-  #_(let [saved-state (some-> key generate-persistence-key utils/local-storage-read cljs.reader/read-string)]
+  (let [saved-state (some-> key generate-persistence-key utils/local-storage-read cljs.reader/read-string)]
     (if (and saved-state
              (or (not validator) (some-> saved-state validator)))
-      saved-state
+      (assoc saved-state :column-meta (:column-meta (initial))) ; FIXME: :column-meta is disabled pending fix for new columns not showing up
       (initial))))


Reorganize & explain update-thread-last-open!

Looks like this function, as things currently exist, can't be turned
into a single datom, and needs to be distinct transactions, due to the
way Datomic's redundancy elimination works

--- src/braid/server/db/thread.clj
+++ src/braid/server/db/thread.clj
@@ -159,7 +159,18 @@

 ;; Transactions

+(defn user-hide-thread-txn
+  [user-id thread-id]
+  [[:db/retract [:user/id user-id] :user/open-thread [:thread/id thread-id]]])
+
+(defn user-show-thread-txn
+  [user-id thread-id]
+  [[:db/add [:user/id user-id] :user/open-thread [:thread/id thread-id]]])
+
 (defn update-thread-last-open!
+  "Bump the tx time of the user opening the thread.  Needs to explicitly be two
+  separate transactions, since redundant datoms are eliminated, meaning we
+  can't have a transaction that just changes the tx"
   [thread-id user-id]
   (when (seq (d/q '[:find ?t
                     :in $ ?user-id ?thread-id
@@ -168,19 +179,8 @@
                     [?t :thread/id ?thread-id]
                     [?u :user/open-thread ?t]]
                   (db/db) user-id thread-id))
-    ; TODO: should find a better way of handling this...
-    @(d/transact db/conn
-       [[:db/retract [:user/id user-id] :user/open-thread [:thread/id thread-id]]])
-    @(d/transact db/conn
-       [[:db/add [:user/id user-id] :user/open-thread [:thread/id thread-id]]])))
-
-(defn user-hide-thread-txn
-  [user-id thread-id]
-  [[:db/retract [:user/id user-id] :user/open-thread [:thread/id thread-id]]])
-
-(defn user-show-thread-txn
-  [user-id thread-id]
-  [[:db/add [:user/id user-id] :user/open-thread [:thread/id thread-id]]])
+    (db/run-txns! (user-hide-thread-txn user-id thread-id))
+    (db/run-txns! (user-show-thread-txn user-id thread-id))))

 (defn user-unsubscribe-from-thread-txn
   [user-id thread-id]


cleanup :require

cleanup :require

--- src/brainbot/nozzle/manage.clj
+++ src/brainbot/nozzle/manage.clj
@@ -1,29 +1,19 @@
 (ns brainbot.nozzle.manage
   (:require [brainbot.nozzle.routing-key :as rk]
-            [brainbot.nozzle.misc :as misc]
-            [brainbot.nozzle.vfs :as vfs]
             [brainbot.nozzle.sys :as sys]
             [brainbot.nozzle.inihelper :as inihelper]
             [brainbot.nozzle.dynaload :as dynaload]
             [brainbot.nozzle.worker :as worker]
             [brainbot.nozzle.mqhelper :as mqhelper]
             [brainbot.nozzle.vfs :as vfs])
-  (:require [langohr.core :as rmq])
   (:require [robert.bruce :refer [try-try-again]])
   (:require [clojure.tools.logging :as logging]
             [clj-logging-config.log4j :as log-config])
   (:require [clojure.data.json :as json])
-
-  (:require [com.brainbot.iniconfig :as ini])
-
   (:require [langohr.http :as rmqapi]
             [langohr.basic :as lb]
-            [langohr.shutdown :as lshutdown]
-            [langohr.exchange  :as le]
             [langohr.core :as rmq]
-            [langohr.queue :as lq]
-            [langohr.channel :as lch]
-            [langohr.consumers :as lcons]))
+            [langohr.channel :as lch]))

 (defn filter-by-vhost


Fix broken v3 stats

Fix broken v3 stats

--- src/vip/data_processor/db/statistics.clj
+++ src/vip/data_processor/db/statistics.clj
@@ -45,7 +45,7 @@
     (into {} (map (juxt :table (partial stats-for-table ctx)) specs))))

 (defn stats-map [{:keys [import-id] :as ctx}]
-  (let [stats (stats import-id)]
+  (let [stats (stats ctx)]
     (->> stats
          (map (fn [[table {:keys [count error-count complete]}]]
                 (let [table-prefix (-> table
@@ -58,5 +58,5 @@

 (defn store-stats [{:keys [import-id] :as ctx}]
   (korma/insert psql/statistics
-    (korma/values (assoc (stats-map import-id) :results_id import-id)))
+    (korma/values (assoc (stats-map ctx) :results_id import-id)))
   ctx)


Add corpse descriptions

Add corpse descriptions

--- src/robinson/describe.clj
+++ src/robinson/describe.clj
@@ -49,8 +49,12 @@
                                                            (noun->indefinite-article (ig/id->name item-id))
                                                            num-items)
                                                          (if (= num-items 1)
-                                                           (ig/id->name item-id)
-                                                           (ig/id->name-plural item-id))]))
+                                                           (get (first (filter #(= (get % :id) item-id)
+                                                                               items))
+                                                                :name)
+                                                           (get (first (filter #(= (get % :id) item-id)
+                                                                               items))
+                                                                :name-plural))]))
                                 (frequencies (map :id items)))))
 (defn describe-cell-at-xy
   [state x y]


add call-compile test(single compiler ver)

--- test/misaki/test/core.clj
+++ test/misaki/test/core.clj
@@ -136,5 +136,11 @@
         (is (= "bar" (slurp f)))
         (.delete f)))))

-;(deftest* call-compile-test
-;  )
+
+;; call-compile
+(deftest* call-compile-test
+  (testing "single compiler"
+    (is (call-compile (template-file "index.html.clj")))
+    (let [file (public-file "index.html")]
+      (is (.exists file))
+      (.delete file))))


added locking to deal with spurious distributed exceptions

--- src/datasplash/core.clj
+++ src/datasplash/core.clj
@@ -33,44 +33,50 @@

 (defn unloaded-ns-from-ex
   [e]
-  (let [parsed (st/parse-exception e)]
-    (loop [todo parsed
-           nss (list)]
-      (if-let [{:keys [message trace-elems cause] :as current-ex} todo]
-        (if (re-find #"clojure\.lang\.Var\$Unbound|call unbound fn" message)
-          (let [[_ missing-ns] (re-find #"call unbound fn: #'([^/]+)/" message)
-                ns-to-add (->> trace-elems
-                               (filter #(:clojure %))
-                               (map :ns)
-                               (concat (list missing-ns)))]
-            (recur cause (concat ns-to-add nss)))
-          (recur cause nss))
-        (->> nss
-             (remove nil?)
-             (distinct)
-             (map symbol))))))
+  (loop [todo (st/parse-exception e)
+         nss (list)]
+    (if-let [{:keys [message trace-elems cause] :as current-ex} todo]
+      (if (re-find #"clojure\.lang\.Var\$Unbound|call unbound fn" message)
+        (let [[_ missing-ns] (re-find #"call unbound fn: #'([^/]+)/" message)
+              ns-to-add (->> trace-elems
+                             (filter #(:clojure %))
+                             (map :ns)
+                             (concat (list missing-ns)))]
+          (recur cause (concat ns-to-add nss)))
+        (recur cause nss))
+      (->> nss
+           (remove nil?)
+           (distinct)
+           (map symbol)))))

 (defmacro safe-exec
   [& body]
   `(try
      ~@body
      (catch Exception e#
-       (when-not (bound? (find-var (symbol "datasplash.core" "required-ns")))
-         (require 'datasplash.core)
-         (swap! required-ns conj 'datasplash.core))
-       (if-let [nss# (unloaded-ns-from-ex e#)]
-         (let [already-required# (deref required-ns)
-               missing# (first (remove already-required# nss#))]
-           (if missing#
-             (do
-               (require missing#)
-               (swap! required-ns conj missing#)
-               ~@body)
-             (throw (ex-info "Dynamic reloading of namespace seems not to work"
-                             {:ns-from-exception nss#
-                              :ns-load-attempted already-required#}
-                             e#))))
-         (throw e#)))))
+       ;; lock on something that should exist!
+       (locking #'locking
+         (when-not (bound? (find-var (symbol "datasplash.core" "required-ns")))
+           (require 'datasplash.core)
+           (swap! required-ns conj 'datasplash.core)))
+       (let [required-at-start# (deref required-ns)]
+         (locking required-ns
+           (if-let [nss# (unloaded-ns-from-ex e#)]
+             (let [already-required# (deref required-ns)
+                   missing# (first (remove already-required# nss#))
+                   missing-at-start# (first (remove required-at-start# nss#))]
+               (if missing#
+                 (do
+                   (require missing#)
+                   (swap! required-ns conj missing#)
+                   ~@body)
+                 (if missing-at-start#
+                   ~@body
+                   (throw (ex-info "Dynamic reloading of namespace seems not to work"
+                                   {:ns-from-exception nss#
+                                    :ns-load-attempted already-required#}
+                                   e#)))))
+             (throw e#)))))))

 (defn dofn
   ^DoFn [f & {:keys [start-bundle finish-bundle]


Added example for mappify; couple doc fixes/additions

--- src/semantic_csv/core.clj
+++ src/semantic_csv/core.clj
@@ -35,9 +35,11 @@
 ;; To start, require this namespace, as well as the namespace of your favorite CSV parser (e.g.,
 ;; [clojure-csv](https://github.com/davidsantiago/clojure-csv) or
 ;; [clojure/data.csv](https://github.com/clojure/data.csv); we'll be using the former).
+;; We'll also need `clojure.javas.io`.
 ;;
 ;;     (require '[semantic-csv.core :as sc]
-;;              '[clojure-csv :as csv])
+;;              '[clojure-csv :as csv]
+;;              '[clojure.java.io :as io])
 ;;
 ;; Now let's take a tour through some of the processing functions we have available.

@@ -63,10 +65,22 @@
   (let [header (first rows)]
     (map (partial mappify-row header) (rest rows))))

+;; Here's an example to whet our whistle:
+;;
+;;     => (with-open [in-file (io/reader "test/test.csv")]
+;;          (doall
+;;            (->>
+;;              (csv/parse-csv in-file)
+;;              mappify)))
+;;
+;;     ({:this "# some comment lines..."}
+;;      {:this "1", :that "2", :more "stuff"}
+;;      {:this "2", :that "3", :more "other yeah"})

 (defn read-csv-rows
   "Given a `lines` collection, produces a seq of maps (`colname -> val`) where the column names are
   based on the first row's values.
+
   * `:header`: bool; consume the first row as a header?
   * `:comment-re`: specify a regular expression to use for commenting out lines, or something falsey
      if this isn't desired


Nicer printing (toString) for NamedMatrix

--- src/polismath/named_matrix.clj
+++ src/polismath/named_matrix.clj
@@ -83,6 +83,13 @@

 (deftype NamedMatrix
   [row-index col-index ^java.util.Vector matrix]
+  Object
+    (toString [this]
+      (str
+        "{:rownames " (into [] (rownames this))
+        " :colnames " (into [] (colnames this))
+        " :matrix " (get-matrix this)
+        "}"))
   PNamedMatrix
     (update-nmat [this values]
       ; A bunch of profiling shit


updated tests

updated tests

--- test/selmer/core_test.clj
+++ test/selmer/core_test.clj
@@ -8,6 +8,11 @@
   (= "\n\n
\n\n\t
\n\t\n\ttest\n\t\t
\n\n\t
\n\t\n\ttest1\n\t\t
\n\n
\n\n"
     (render (parse (str path "nested-for.html"))
             {:name "Bob" :users [[{:name "test" }] [{:name "test1" }]]})))
+
+(deftest render-test
+  (= "

0

1

2

3

4

"
+     (render (parse (java.io.StringReader. "
{% for item in items %}
{{item}}
{% endfor %}
"))
+             {:items (range 5)})))

 (deftest tag-info-test
   (= {:args ["i" "in" "nums"], :tag-name :for, :tag-type :expr}
@@ -33,8 +38,6 @@
   (= "\n\n
equal!
\n\n\n
not equal
\n"
      (render (parse (str path "ifequal.html")) {:baz "fail"})))

-;(render (parse (str path "if.html")) {:foo true :range (range 4)})
-
 (deftest filter-tag-test
   (= "ok"
      ((filter-tag {:tag-value "foo.bar.baz"}) {:foo {:bar {:baz "ok"}}}))


Log errors writing from write buffer. Do not auto-reset connections for time being.

--- src/onyx/messaging/aeron/publication_manager.clj
+++ src/onyx/messaging/aeron/publication_manager.clj
@@ -1,5 +1,5 @@
 (ns onyx.messaging.aeron.publication-manager
-  (:require [taoensso.timbre :refer [fatal info] :as timbre]
+  (:require [taoensso.timbre :refer [error fatal info] :as timbre]
             [clojure.core.async :refer [chan >!! <!! close! sliding-buffer thread]])
   (:import [uk.co.real_logic.aeron Aeron Aeron$Context FragmentAssembler Publication Subscription AvailableImageHandler]
            [uk.co.real_logic.agrona ErrorHandler CloseHelper]
@@ -22,15 +22,19 @@
 (defrecord Message [buf start end])

 (defn write-from-buffer [pending-ch publication send-idle-strategy]
-  (loop []
-    (when-let [msg (<!! pending-ch)]
-      (while (if-let [pub @publication]
-               (let [result ^long (.offer pub (:buf msg) (:start msg) (:end msg))]
-                 (or (= result backpressured)
-                     (= result not-connected))))
-        ;; idle for different amounts of time depending on whether backpressuring or not?
-        (.idle ^IdleStrategy send-idle-strategy 0))
-      (recur))))
+  (try
+    (loop []
+      (when-let [msg (<!! pending-ch)]
+        (while (if-let [pub @publication]
+                 (let [result ^long (.offer pub (:buf msg) (:start msg) (:end msg))]
+                   (or (= result backpressured)
+                       (= result not-connected))))
+          ;; idle for different amounts of time depending on whether backpressuring or not?
+          (.idle ^IdleStrategy send-idle-strategy 0))
+        (recur)))
+    (catch InterruptedException e)
+    (catch Throwable t
+      (error "Aeron write from buffer error: " t))))

 (defrecord PublicationManager [send-idle-strategy channel stream-id connection publication pending-ch write-fut]
   PPublicationManager
@@ -42,7 +46,7 @@

   (write [this buf start end]
     ;; should possibly use core-async offer here and print out message if going to block
-    (>!! pending-ch (->Message buf start end)))
+    (when-not (>!! pending-ch (->Message buf start end))))

   (disconnect [this]
     (.close ^Publication @publication)
@@ -61,9 +65,8 @@
     (let [error-handler (reify ErrorHandler
                           (onError [this x]
                             (taoensso.timbre/warn "Aeron messaging publication error:" x)
-                            (taoensso.timbre/warn "Resetting Aeron publication.")
-                            (reset-connection this)))
-
+                            #_(taoensso.timbre/warn "Resetting Aeron publication.")
+                            #_(reset-connection this)))
           conn (Aeron/connect (.errorHandler (Aeron$Context.) error-handler))
           pub (.addPublication conn channel stream-id)]
       (reset! publication pub)


Removed hanging import.

Removed hanging import.

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -11,10 +11,7 @@
            [elephantdb.generated ElephantDB ElephantDB$Iface ElephantDB$Processor]
            [elephantdb Shutdownable client]
            [elephantdb.persistence LocalPersistence]
-           [elephantdb.store DomainStore])
-
-
-  (:import ))
+           [elephantdb.store DomainStore]))

 (def ^{:doc "Example, meant to be ignored."}
   example-global-conf


:EquatAsc is 'equatorial', rather than 'equal'; add comments about the less commonly used ones

--- src/clj/ephemeris_api/core.clj
+++ src/clj/ephemeris_api/core.clj
@@ -39,10 +39,10 @@
                :MC
                :ARMC
                :Vertex
-               :EqualAsc
-               :Co-Asc1
-               :Co-Asc2
-               :PolarAsc]
+               :EquatAsc ;; equatorial ascendant
+               :Co-Asc1 ;; co-ascendant (W. Koch)
+               :Co-Asc2 ;; co-ascendant (M. Munkasey)
+               :PolarAsc] ;; (M. Munkasey)
               sub)]
     (if (angles? wanted)
       (if (or (= wanted true) (not (vector? wanted)))


fix whitespace

fix whitespace

--- src/clj_money/web/accounts.clj
+++ src/clj_money/web/accounts.clj
@@ -142,19 +142,19 @@
      (let [can-delete? (->> transaction-id
                             (transactions/find-by-id (env :db))
                             transactions/can-delete?)]
-     (glyph-button :remove
-                   (-> (path "/transactions" transaction-id "delete")
-                       (query {:redirect (url-encode (format "/accounts/%s" account-id))})
-                       format-url)
-                   {:level :danger
-                    :disabled (not can-delete?)
-                    :size :extra-small
-                    :title (if can-delete?
-                             "Click here to remove this transaction."
-                             "This transaction contains reconciled items and cannot be removed.")
-                    :data-method :post
-                    :data-confirm "Are you sure you want to remove this transaction?"
-                    :method :post}))]]])
+       (glyph-button :remove
+                     (-> (path "/transactions" transaction-id "delete")
+                         (query {:redirect (url-encode (format "/accounts/%s" account-id))})
+                         format-url)
+                     {:level :danger
+                      :disabled (not can-delete?)
+                      :size :extra-small
+                      :title (if can-delete?
+                               "Click here to remove this transaction."
+                               "This transaction contains reconciled items and cannot be removed.")
+                      :data-method :post
+                      :data-confirm "Are you sure you want to remove this transaction?"
+                      :method :post}))]]])

 (defmulti ^:private show-account
   (fn [account params]


storage able to work with maps

storage able to work with maps

--- src/cljs/swarmpit/storage.cljs
+++ src/cljs/swarmpit/storage.cljs
@@ -1,18 +1,31 @@
 (ns swarmpit.storage
   (:refer-clojure :exclude [get remove])
-  (:require [swarmpit.token :as token]))
+  (:require [swarmpit.token :as token]
+            [cognitect.transit :as t]))

 (def storage (.-localStorage js/window))
+
+(def r (t/reader :json))

 (defn add
   "Add entry into browser's localStorage."
   [key val]
   (.setItem storage key val))

+(defn add-map
+  "Add map entry into browser's localStorage."
+  [key map]
+  (.setItem storage key (.stringify js/JSON (clj->js map))))
+
 (defn get
   "Get value from browser's localStorage by given `key`"
   [key]
   (.getItem storage key))
+
+(defn get-map
+  "Get map from browser's localStorage by given `key`"
+  [key]
+  (t/read r (get key)))

 (defn remove
   "Remove value from browser's localStorage by given `key`"


Make sure inputs don't lose focus

Make sure inputs don't lose focus

selectionStart/End should not be set on inputs that don't have focus
currently.

--- src/reagent/impl/template.cljs
+++ src/reagent/impl/template.cljs
@@ -105,7 +105,8 @@
              (let [node       (.' this getDOMNode)
                    node-value (.' node :value)]
                (when (not= value node-value)
-                 (if-not (has-selection-api? (.' node :type))
+                 (if-not (and (identical? node (.-activeElement js/document))
+                              (has-selection-api? (.' node :type)))
                    ; just set the value, no need to worry about a cursor
                    (.! node :value value)


add coercions for float and double

add coercions for float and double

--- src/pipeline/grafter/pipeline/types.clj
+++ src/pipeline/grafter/pipeline/types.clj
@@ -55,6 +55,12 @@
 (deftype-reader [Number String] [ov input-value]
   (edn/read-string input-value))

+(deftype-reader [Float String] [ov input-value]
+  (Float/parseFloat input-value))
+
+(deftype-reader [Double String] [ov input-value]
+  (Double/parseDouble input-value))
+
 (deftype-reader [Byte String] [_ value]
   (Byte/parseByte value))

@@ -66,7 +72,6 @@

 (deftype-reader [clojure.lang.BigInt String] [_ value]
   (Long/parseLong value))
-

 (deftype-reader [Boolean String] [_ value]
   (Boolean/parseBoolean value))


Revert "bump version"

Revert "bump version"

This reverts commit dd0090b7f3a676b6de8bcc97506d114c926a6e10.

--- backend/project.clj
+++ backend/project.clj
@@ -1,4 +1,4 @@
-(defproject lambdaui "0.1.1-SNAPSHOT"
+(defproject lambdaui "0.1.0"
   :description "LambdaCD-Plugin that provides a modern UI for your pipeline."
   :url "https://github.com/sroidl/lambda-ui"
   :license {:name "Apache License 2.0"


force side effects

force side effects

--- src/shuppet/scheduler.clj
+++ src/shuppet/scheduler.clj
@@ -30,7 +30,7 @@
   (try
     (graphite/report-time
      (str "scheduler." env ".configure_apps")
-     (core/configure-apps env))
+     (dorun (core/configure-apps env)))
     (catch Exception e
       (error (str-stacktrace e)))))


Filter non-dups and save listing

Filter non-dups and save listing

--- src/single_track/core.clj
+++ src/single_track/core.clj
@@ -98,9 +98,26 @@
   (let [af (metadata f)]
     [(af-key af) af]))

+(defn dups-desc [l k1 k2]
+  (compare [(count (get l k2)) k2] [(count (get l k1)) k1]))
+
+(defn dups [l]
+  (into (sorted-map-by (partial dups-desc l))
+        (filter #(vector? (second %)) l)))
+
+(defn af-listing
+  ([dir] (af-listing dir Integer/MAX_VALUE))
+  ([dir n]
+   (reduce put {} (map af-entry (take n (filtered dir))))))
+
+(defn save [f c]
+  (with-open [w (io/writer f)]
+    (binding [*out* w] (pprint c))))
+
 (defn -main
   ([] (-main "."))
   ([dir]
-   (pprint (reduce put {} (map af-entry (filtered dir))))))
+   (let [listing (af-listing dir)]
+     (save "target/dups.edn" (dups listing)))))

 #_(-main)


Reformulated geometry example.

Reformulated geometry example.

--- src/examples/geometry.clj
+++ src/examples/geometry.clj
@@ -6,7 +6,7 @@
   (:use [clojush]))

 ;;;;;;;;;;;;
-;; Multiple geometric formulae. An integer indicates the desired formula and
+;; Multiple geometric formulae. Boolean mode queries indicate the desired formula and
 ;; inputs are provided on the float stack.

 ;; Using just circle-related ones for now:
@@ -33,43 +33,52 @@

 (def fitness-cases
   (concat
-    ;0: circumference of a circle: 2 pi R
+    ;circumference of a circle: 2 pi R
     (doall (for [r (range 1 5 0.25)]
-             [0 [r 0] (* 2 Math/PI r)]))
+             [:circle-circumference [r 0] (* 2 Math/PI r)]))
     ;1: area of a circle: pi R^2
     (doall (for [r (range 1 5 0.25)]
-             [1 [r 0] (* Math/PI r r)]))
+             [:circle-area [r 0] (* Math/PI r r)]))
     ;2: volume of a cylinder: pi R^2 H
     (doall (for [r (range 1 2 0.25)
                  h (range 1 2 0.25)]
-             [2 [r h] (* Math/PI r r h)]))
+             [:cylinder-volume [r h] (* Math/PI r r h)]))
     ;3: volume of a cone: 1/3 pi R^2 H
     (doall (for [r (range 1 2 0.25)
                  h (range 1 2 0.25)]
-             [3 [r h] (* 1/3 Math/PI r r h)]))
+             [:cone-volume [r h] (* 1/3 Math/PI r r h)]))
     ;4: volume of a sphere: 4/3 pi R^3
     (doall (for [r (range 1 5 0.25)]
-             [4 [r 0] (* 4/3 Math/PI r r r)]))
+             [:sphere-volume [r 0] (* 4/3 Math/PI r r r)]))
     ))

 ;; input instructions

-(define-registered formula
-                   (fn [state] (push-item (stack-ref :auxiliary 0 state) :integer state)))
-
 (define-registered r
                    (fn [state] (push-item (first (stack-ref :auxiliary 1 state)) :float state)))

 (define-registered h
                    (fn [state] (push-item (second (stack-ref :auxiliary 1 state)) :float state)))

+(def modes (distinct (vec (map first fitness-cases))))
+
+(def mode-test-instructions (vec (map #(symbol (str (name %) "?")) modes)))
+
+(doseq [[mode instruction] (map vector modes mode-test-instructions)]
+  (register-instruction instruction)
+  (swap! instruction-table assoc instruction
+         (fn [state]
+           (push-item (if (= mode (stack-ref :auxiliary 0 state)) true false)
+                      :boolean
+                      state))))
+
 ;; error function

 (def e (fn [program]
          (doall
-           (for [[formula-number inputs target] fitness-cases]
+           (for [[mode inputs target] fitness-cases]
              (let [state (run-push program
-                                   (push-item formula-number
+                                   (push-item mode
                                               :auxiliary
                                               (push-item inputs
                                                          :auxiliary
@@ -80,29 +89,33 @@
                  1000000))))))

 ;; a solution, for testing purposes
-#_(reduce + (e '(formula 4 integer_eq exec_if
-                         (r r float_mult r float_mult 3.141592 float_mult 4.0 float_mult 3.0 float_div)
-                         (formula 0 integer_eq exec_if
-                                  (r 3.141592 float_mult 2.0 float_mult)
-                                  (formula 1 integer_eq exec_if
-                                           (r r float_mult 3.141592 float_mult)
-                                           (formula 2 integer_eq exec_if
-                                                    (r r float_mult h float_mult 3.141592 float_mult)
-                                                    (r r float_mult h float_mult 3.141592 float_mult 3.0 float_div)))))))
-
-
-
+(reduce + (e '(circle-circumference?
+                exec_if
+                (r 3.141592 float_mult 2.0 float_mult)
+                (circle-area?
+                  exec_if
+                  (r r float_mult 3.141592 float_mult)
+                  (cylinder-volume?
+                    exec_if
+                    (r r float_mult h float_mult 3.141592 float_mult)
+                    (cone-volume?
+                      exec_if
+                      (r r float_mult h float_mult 3.141592 float_mult 3.0 float_div)
+                      (r r float_mult r float_mult 3.141592 float_mult 4.0 float_mult 3.0 float_div)))))))

 (pushgp
   :atom-generators (concat (list (fn [] (lrand-int 5))
                                  (fn [] (float (lrand-int 5)))
                                  (fn [] Math/PI)
-                                 'formula
                                  'r
                                  'h
                                  (tag-instruction-erc [:exec :integer :float :boolean] 1000)
                                  (tagged-instruction-erc 1000)
                                  )
+                           (take 30 (cycle [(tag-instruction-erc [:exec :integer :float :boolean] 1000)
+                                            (tagged-instruction-erc 1000)
+                                            'exec_if]))
+                           mode-test-instructions
                            '(integer_add
                               integer_eq
                               integer_swap
@@ -242,11 +255,11 @@
   :error-function e
   :use-single-thread false
   :population-size 1000
-  :trivial-geography-radius 500
+  :trivial-geography-radius 10
   :error-threshold 0.01
   :max-generations 1001
-  :max-points 150
-  :evalpush-limit 300
+  :max-points 250
+  :evalpush-limit 500
   :evalpush-time-limit 0
   :tournament-size 7
   :reuse-errors true
@@ -265,7 +278,7 @@
   :node-selection-method :size-tournament
   :node-selection-tournament-size 2
   :node-selection-leaf-probability 0.1
-  :pop-when-tagging true
+  :pop-when-tagging false ;true
   :use-historically-assessed-hardness false
   )


Finish wiring up the reset/update password feature for #3. Still needs: -  @dbyrne to write the send-email function -  someone (@cmeier?) to add links to /login/reset and /login/update somewhere appropriate

--- src/foreclojure/login.clj
+++ src/foreclojure/login.clj
@@ -1,9 +1,10 @@
 (ns foreclojure.login
-  (:import [org.jasypt.util.password StrongPasswordEncryptor])
+  (:import org.jasypt.util.password.StrongPasswordEncryptor)
   (:use hiccup.form-helpers
         hiccup.page-helpers
         foreclojure.utils
         compojure.core
+        [amalloy.utils :only [rand-in-range]]
         somnium.congomongo)
   (:require [sandbar.stateful-session :as session]
             [ring.util.response :as response]))
@@ -43,7 +44,7 @@
         [:tr
          [:td (submit-button "Reset now")]])]]))

-(defn do-udpate-password! [old-pwd new-pwd repeat-pwd]
+(defn do-update-password! [old-pwd new-pwd repeat-pwd]
   (with-user [{:keys [user pwd]}]
     (let [encryptor (StrongPasswordEncryptor.)]
       (assuming [(= new-pwd repeat-pwd)
@@ -55,16 +56,62 @@
                    {:$set {:pwd new-pwd-hash}}
                    :upsert false)
           (html-doc
-           [:div#reset-succeeded "Password for " user " reset successfully"]))
+           [:div#update-succeeded "Password for " user " updated successfully"]))
         (flash-error why "/login/update")))))
+
+(def-page reset-password-page []
+  [:div
+   [:div#reset-help
+    [:h3 "Forgot your password?"]
+    [:div "Enter your email address and we'll send you a new password."]
+    [:div
+     [:span.error (session/flash-get :error)]
+     (form-to [:post "/login/reset"]
+       (label :email "Email")
+       (text-field :email)
+       (submit-button "Reset!"))]]])
+
+(def pw-chars "abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVWXY1234567890")
+
+(defn do-reset-password! [email]
+  (if-let [{id :_id, name :user} (fetch-one :users
+                                            :where {:email email}
+                                            :only [:_id :user])]
+    (let [pw (apply str
+                    (repeatedly 10 #(rand-nth pw-chars)))
+          pw-hash (.encryptPassword (StrongPasswordEncryptor.) pw)]
+      (update! :users
+               {:_id id}
+               {:$set {:pwd pw-hash}})
+      (let [send-email (fn [& args]
+                         (spit (str "/tmp/email" pw)
+                               args))]
+        (send-email
+         {:From "team@4clojure.com"
+          :To email
+          :Subject "Password reset"}
+         (str "The password for your 4clojure.com account "
+              name " has been reset to " pw ". Make sure to change it"
+              " soon at https://4clojure.com/login/update - pick"
+              " something you'll remember!")))
+      (flash-msg "Your password has been reset! You should receive an email soon"
+                 "/login"))
+    (flash-error "We don't know anyone with that email address!"
+                 "/login/reset")))

 (defroutes login-routes
   (GET  "/login" [] (my-login-page))
   (POST "/login" {{:strs [user pwd]} :form-params}
     (do-login user pwd))
-  (GET  "/login/update" [] (change-password-page))
+
+  (GET  "/login/update" [] (update-password-page))
   (POST "/login/update" {{:strs [old-pwd pwd repeat-pwd]} :form-params}
-    (do-change-password! old-pwd pwd repeat-pwd))
+    (do-update-password! old-pwd pwd repeat-pwd))
+
+  (GET  "/login/reset" [] (reset-password-page))
+  (POST "/login/reset" [email]
+    (do-reset-password! email))
+
   (GET "/logout" []
     (do (session/session-delete-key! :user)
         (response/redirect "/"))))