Use the content-disposition HTTP response header

instead of the download attribute on the button. This allows to
suggest/set a download file name for all requests, even the ones were
there is now download button.

This also allows us to specify more fancy file names that contain
customer, date, etc.

Fixes #15

--- src/catalog/web/views.clj
+++ src/catalog/web/views.clj
@@ -12,7 +12,9 @@
              [obi :as layout.obi]]
             [catalog.web.layout :as layout]
             [cemerick.friend :as friend]
-            [clj-time.core :as time.core]
+            [clj-time
+             [core :as time.core]
+             [format :as time.format]]
             [clojure
              [edn :as edn]
              [string :as string]]
@@ -26,10 +28,10 @@
             [schema.core :as s]))

 (defn- download-button
-  ([href file-name]
-   (download-button href file-name "Download"))
-  ([href file-name label]
-   [:a.btn.btn-default {:href href :role "button" :download file-name :aria-label label}
+  ([href]
+   (download-button href "Download"))
+  ([href label]
+   [:a.btn.btn-default {:href href :role "button" :aria-label label}
     [:span.glyphicon {:class "glyphicon-download" :aria-hidden "true"}] (str " " label)]))

 (defn- download-url [& items]
@@ -39,7 +41,7 @@
   [title year issue file-name]
   [:div.well
    [:h2 title]
-   (download-button (download-url year issue file-name) file-name)])
+   (download-button (download-url year issue file-name))])

 (defn home
   ([request]
@@ -62,8 +64,8 @@
        [:div.col-md-6
         [:div.well
          [:h2 (translations :catalog-hörbuch)]
-         (download-button (download-url year issue "neu-als-hörbuch.pdf") "neu-als-hörbuch.pdf")
-         (download-button (download-url year issue "neu-als-hörbuch.ncc") "neu-als-hörbuch.ncc" "NCC")]]]))))
+         (download-button (download-url year issue "neu-als-hörbuch.pdf"))
+         (download-button (download-url year issue "neu-als-hörbuch.ncc") "NCC")]]]))))

 (defn full-catalogs
   [request year issue]
@@ -80,90 +82,133 @@
       [:div.col-md-6
        (download-well (translations :catalog-taktilesbuch) year nil "taktile-kinderbücher-der-sbs.pdf")]])))

+(defn- clean-string
+  "Clean a string so that it can be used to generate a file name"
+  [s]
+  (-> s
+   string/lower-case
+   (string/replace #"\s" "-")))
+
+;; FIXME: we should probably use time zone that is defined in the
+;; browser of the user. For simplicity sake we just hard code it here.
+(def ^:private local-time-zone-id "Europe/Zurich")
+
+(defn- local-time
+  "Return a string representing the local time that can be used for
+  file names."
+  []
+  (let [time-zone (time.core/time-zone-for-id local-time-zone-id)
+        formatter (time.format/formatter "yyyy-MM-dd-kk-mm-ss" time-zone)]
+    (time.format/unparse formatter (time.core/now))))
+
 (defn- file-name
-  ([k year]
-   (file-name k year nil))
-  ([k year issue]
-   (let [name (-> (k translations)
-                  string/lower-case
-                  (string/replace #"\s" "-"))]
-     (if issue
-       (format "%s-%s-%s" name year issue)
-       (format "%s-%s" name year)))))
+  "Return a file-name for a given key `k` a value `v` (usually the
+  year) and optionaly an `issue`. The key is looked up in the
+  translation map and cleaned to have a clean file name. In the case
+  of custom catalogs the date and the value (in this case the
+  customer) is added to the file name."
+  ([k v]
+   (file-name k v nil))
+  ([k v issue]
+   (let [name (clean-string (k translations))]
+     (cond
+       (= k :catalog-custom) (format "%s-%s-%s" name (clean-string v) (local-time))
+       issue (format "%s-%s-%s" name v issue)
+       :default (format "%s-%s" name v)))))
+
+(defn- content-disposition
+  "Returns an updated Ring response with the Content-Disposition
+  header set to \"attachment\" and the filename corresponding to the
+  given `filename`."
+  [resp filename]
+  (response/header resp "Content-Disposition" (format "attachment; filename=%s" filename)))
+
+(defn- pdf-response
+  "Create a response with proper content-type and content-disposition
+  for given pdf `file` and `filename`"
+  [file filename]
+  (-> file
+   response/response
+   (response/content-type "application/pdf")
+   (content-disposition (str filename ".pdf"))))
+
+(defn- xml-response
+  "Create a response with proper content-type and content-disposition
+  for given `body` and `filename`"
+  [body filename]
+  (-> body
+   response/response
+   (response/content-type "application/xml")
+   (content-disposition (str filename ".xml"))))

 (defn neu-im-sortiment [year issue]
-  (let [temp-file (java.io.File/createTempFile (file-name :catalog-all year issue) ".pdf")]
+  (let [filename (file-name :catalog-all year issue)
+        temp-file (java.io.File/createTempFile filename ".pdf")]
     (-> (db/read-catalog year issue)
         vubis/order-and-group
         (layout.fop/document :all-formats year issue nil nil)
         (layout.fop/generate-pdf! temp-file))
-    (-> temp-file
-        response/response
-        (response/content-type "application/pdf"))))
+    (pdf-response temp-file filename)))

 (defn neu-in-grossdruck [year issue]
-  (let [temp-file (java.io.File/createTempFile (file-name :catalog-grossdruck year issue) ".pdf")
+  (let [filename (file-name :catalog-grossdruck year issue)
+        temp-file (java.io.File/createTempFile filename ".pdf")
         editorial (db/read-editorial year issue :grossdruck)
         recommendation (db/read-recommendation year issue :grossdruck)]
     (-> (db/read-catalog year issue)
         vubis/order-and-group
         (layout.fop/document :grossdruck year issue editorial recommendation)
         (layout.fop/generate-pdf! temp-file))
-    (-> temp-file
-        response/response
-        (response/content-type "application/pdf"))))
+    (pdf-response temp-file filename)))

 (defn neu-in-braille [year issue]
-  (let [editorial (db/read-editorial year issue :braille)
+  (let [filename (str (file-name :catalog-braille year issue) ".xml")
+        editorial (db/read-editorial year issue :braille)
         recommendation (db/read-recommendation year issue :braille)]
     (-> (db/read-catalog year issue)
         vubis/order-and-group
         :braille
         (layout.dtbook/dtbook {:year year :issue issue
                                :editorial editorial :recommendation recommendation})
-        response/response
-        (response/content-type "application/xml"))))
+        (xml-response filename))))

 (defn neu-als-hörbuch [year issue]
-  (let [temp-file (java.io.File/createTempFile (file-name :catalog-hörbuch year issue) ".pdf")
+  (let [filename (file-name :catalog-hörbuch year issue)
+        temp-file (java.io.File/createTempFile filename ".pdf")
         editorial (db/read-editorial year issue :hörbuch)
         recommendation (db/read-recommendation year issue :hörbuch)]
     (-> (db/read-catalog year issue)
         (vubis/order-and-group vubis/get-update-keys-neu-als-hörbuch)
         (layout.fop/document :hörbuch year issue editorial recommendation)
         (layout.fop/generate-pdf! temp-file))
-    (-> temp-file
-        response/response
-        (response/content-type "application/pdf"))))
+    (pdf-response temp-file filename)))

 (defn neu-als-hörbuch-ncc [year issue]
-  (let [editorial (db/read-editorial year issue :hörbuch)
+  (let [filename (file-name :catalog-hörbuch year issue)
+        editorial (db/read-editorial year issue :hörbuch)
         recommendation (db/read-recommendation year issue :hörbuch)]
     (-> (db/read-catalog year issue)
         (vubis/order-and-group vubis/get-update-keys-neu-als-hörbuch)
         (layout.obi/dtbook year issue editorial recommendation)
-        response/response
-        (response/content-type "application/xml"))))
+        (xml-response filename))))

 (defn hörfilme [year]
-  (let [temp-file (java.io.File/createTempFile (file-name :catalog-hörfilm year) ".pdf")]
+  (let [filename (file-name :catalog-hörfilm year)
+        temp-file (java.io.File/createTempFile filename ".pdf")]
     (-> (db/read-full-catalog year :hörfilm)
         (vubis/order-and-group vubis/get-update-keys-hörfilm)
         (layout.fop/document :hörfilm year nil nil nil)
         (layout.fop/generate-pdf! temp-file))
-    (-> temp-file
-        response/response
-        (response/content-type "application/pdf"))))
+    (pdf-response temp-file filename)))

 (defn spiele [year]
-  (let [temp-file (java.io.File/createTempFile (file-name :catalog-ludo year) ".pdf")]
+  (let [filename (file-name :catalog-ludo year)
+        temp-file (java.io.File/createTempFile filename ".pdf")]
     (-> (db/read-full-catalog year :ludo)
         (vubis/order-and-group vubis/get-update-keys-ludo)
         (layout.fop/document :ludo year nil nil nil)
         (layout.fop/generate-pdf! temp-file))
-    (-> temp-file
-        response/response
-        (response/content-type "application/pdf"))))
+    (pdf-response temp-file filename)))

 (defn- upload-well
   [title url errors]
@@ -385,32 +430,29 @@
 (defmulti custom (fn [_ _ _ _ _ fmt _] fmt))

 (defmethod custom :pdf [request year issue query customer fmt items]
-  (let [temp-file (java.io.File/createTempFile "custom-catalog" ".pdf")]
+  (let [filename (file-name :catalog-custom customer)
+        temp-file (java.io.File/createTempFile filename ".pdf")]
     (-> items
         edn/read-string
         vubis/order
         (layout.fop/document :custom year issue nil nil :query query :customer customer)
         (layout.fop/generate-pdf! temp-file))
-    (-> temp-file
-        response/response
-        (response/content-type "application/pdf"))))
+    (pdf-response temp-file filename)))

 (defmethod custom :grossdruck [request year issue query customer fmt items]
-  (let [temp-file (java.io.File/createTempFile "custom-catalog" ".pdf")]
+  (let [filename (file-name :catalog-custom customer)
+        temp-file (java.io.File/createTempFile filename ".pdf")]
     (-> items
         edn/read-string
         vubis/order
         (layout.fop/document :custom-grossdruck year issue nil nil :query query :customer customer)
         (layout.fop/generate-pdf! temp-file))
-    (-> temp-file
-        response/response
-        (response/content-type "application/pdf"))))
+    (pdf-response temp-file filename)))

 (defmethod custom :braille [request year issue query customer fmt items]
   (-> items
       edn/read-string
       vubis/order
       (layout.dtbook/dtbook {:query query :customer customer})
-      response/response
-      (response/content-type "application/xml")))
-
+      (xml-response (str (file-name :catalog-custom customer) ".xml"))))
+


store messages as key-val instead of array (to be same as users)

--- src/chat/client/core.cljs
+++ src/chat/client/core.cljs
@@ -20,17 +20,19 @@
                       :icon "https://s3-us-west-2.amazonaws.com/slack-files2/avatars/2015-05-08/4801271456_41230ac0b881cdf85c28_72.jpg" }
                    2 {:id 2
                       :icon "https://s3-us-west-2.amazonaws.com/slack-files2/avatars/2015-05-09/4805955000_07dc272f0a7f9de7719e_192.jpg"}}
-           :messages [{:content "Hello?" :thread-id 123 :user-id 1}
-                      {:content "Hi!" :thread-id 123 :user-id 2}
-                      {:content "Oh, great, someone else is here." :thread-id 123 :user-id 1}
-                      {:content "Yep" :thread-id 123 :user-id 2}]}))
+           :messages {99 {:id 99 :content "Hello?" :thread-id 123 :user-id 1}
+                      98 {:id 98 :content "Hi!" :thread-id 123 :user-id 2}
+                      97 {:id 97 :content "Oh, great, someone else is here." :thread-id 123 :user-id 1}
+                      96 {:id 96 :content "Yep" :thread-id 123 :user-id 2}}}))

 (defmulti dispatch! (fn [event data] event))

 (defmethod dispatch! :new-message [_ data]
-  (transact! [:messages] #(conj % {:content (data :content)
-                                   :thread-id (or (data :thread-id) (guid))
-                                   :user-id (get-in @app-state [:session :user-id])})))
+  (transact! [:messages] #(let [id (guid)]
+                            (assoc % id {:id id
+                                         :content (data :content)
+                                         :thread-id (or (data :thread-id) (guid))
+                                         :user-id (get-in @app-state [:session :user-id])}))))

 (defn message-view [message owner]
   (reify
@@ -74,6 +76,7 @@
     om/IRender
     (render [_]
       (let [threads (->> (data :messages)
+                         vals
                          (group-by :thread-id)
                          (map (fn [[id ms]] {:id id
                                              :messages ms})))]


Remove duplication in number-dispatch.

Remove duplication in number-dispatch.

This way 1.2-compat code can't get out of sync with current code.

--- src/cheshire/generate.clj
+++ src/cheshire/generate.clj
@@ -28,34 +28,27 @@
                       (str "Cannot JSON encode object of class: "
                            (class ~obj) ": " ~obj)))))))

-(defmacro number-dispatch [^JsonGenerator jg obj ^Exception e]
-  (if (< 2 (:minor *clojure-version*))
-    `(condp instance? ~obj
-       Integer (.writeNumber ~jg (int ~obj))
-       Long (.writeNumber ~jg (long ~obj))
-       Double (.writeNumber ~jg (double ~obj))
-       Float (.writeNumber ~jg (double ~obj))
-       BigInteger (.writeNumber ~jg ~(with-meta obj {:tag `BigInteger}))
-       BigDecimal (.writeNumber ~jg ~(with-meta obj {:tag `BigDecimal}))
-       Ratio (.writeNumber ~jg (double ~obj))
-       Short (.writeNumber ~jg (int ~obj))
-       Byte (.writeNumber ~jg (int ~obj))
-       clojure.lang.BigInt (.writeNumber
-                            ~jg ^BigInteger
-                            (.toBigInteger ^clojure.lang.BigInt (bigint ~obj)))
-       (fail ~obj ~jg ~e))
-    `(let [^JsonGenerator jg# ~jg]
-       (condp instance? ~obj
-         Integer (.writeNumber jg# (int ~obj))
-         Long (.writeNumber jg# (long ~obj))
-         Double (.writeNumber jg# (double ~obj))
-         Float (.writeNumber jg# (float ~obj))
-         BigInteger (.writeNumber jg# ^BigInteger ~obj)
-         BigDecimal (.writeNumber jg# ^BigDecimal ~obj)
-         Ratio (.writeNumber jg# (double ~obj))
-         Short (.writeNumber jg# (int ~obj))
-         Byte (.writeNumber jg# (int ~obj))
-         (fail ~obj jg# ~e)))))
+(defmacro number-dispatch [jg obj e]
+  (let [g (tag (gensym 'jg))
+        o (gensym 'obj)
+        common-clauses `[Integer (.writeNumber ~g (int ~o))
+                         Long (.writeNumber ~g (long ~o))
+                         Double (.writeNumber ~g (double ~o))
+                         Float (.writeNumber ~g (double ~o))
+                         BigInteger (.writeNumber ~g ~(with-meta o {:tag `BigInteger}))
+                         BigDecimal (.writeNumber ~g ~(with-meta o {:tag `BigDecimal}))
+                         Ratio (.writeNumber ~g (double ~o))
+                         Short (.writeNumber ~g (int ~o))
+                         Byte (.writeNumber ~g (int ~o))]]
+    `(let [~g ~jg
+           ~o ~obj]
+       (condp instance? ~o
+         ~@(if (< 2 (:minor *clojure-version*))
+             `[~@common-clauses
+               clojure.lang.BigInt (.writeNumber ~g (.toBigInteger ~(vary-meta obj assoc :tag
+                                                                               `clojure.lang.BigInt)))]
+             common-clauses)
+         (fail ~o ~g ~e)))))

 (declare generate)


Remove unused query

Remove unused query

--- src/clj/forma/gfw/cdm.clj
+++ src/clj/forma/gfw/cdm.clj
@@ -179,17 +179,6 @@
       (clojure.string/replace "," " ")
       (read-string)))

-(defn agg-xyz
-  []
-  (<- [?x ?y ?z ?period ?count :> ?x2int ?y2int ?z-new ?periods ?counts]
-      (/ ?x 2 :> ?x2)
-      (/ ?y 2 :> ?y2)
-      (math/floor ?x2 :> ?x2int)
-      (math/floor ?y2 :> ?y2int)
-      (dec ?z :> ?z-new)
-      (agg-sort-by-date ?period ?count :> ?periods-counts)
-      (split-vecs ?periods-counts :> ?periods ?counts)))
-
 (defn zoom-out
   "Calculate x or y value at next zoom level."
   [n]


add traces for sleep bug

add traces for sleep bug

--- src/clj/tictag/server.clj
+++ src/clj/tictag/server.clj
@@ -96,6 +96,7 @@
 (defmulti evaluate (fn [context [v & vs]] v))

 (defmethod evaluate :CMDS [ctx [_ & vs]]
+  (timbre/trace [:evaluate :CMDS vs])
   (doseq [[cmd {:keys [saved error]}] (map (partial evaluate ctx) vs)]
     (when error (timbre/error error))))

@@ -125,11 +126,13 @@
   (flatten (map (partial evaluate ctx) tags)))

 (defmethod evaluate :SLEEP [{:keys [db user] :as ctx} _]
-  [:SAVE*
-   (map
-    (fn [ping]
-      [ping ["sleep"]])
-    (db/sleepy-pings db user))])
+  (let [sleepy-pings (db/sleepy-pings db user)]
+    (trace [:sleepy-pings (:id user) (vec sleepy-pings)])
+    [:SAVE*
+     (map
+      (fn [ping]
+        [ping ["sleep"]])
+      sleepy-pings)]))

 (defn update-pings [pings]
   (->> pings
@@ -139,6 +142,7 @@
        (remove nil?)))

 (defn save-pings [{:keys [db user thread-ts]} pings]
+  (trace [:save-pings (:id user) pings])
   (db/update-tags! db pings)
   (slack/send-messages
    user
@@ -153,6 +157,7 @@
     pings)))

 (defn save* [{:keys [db user] :as ctx} ps]
+  (trace [:save* (:id user) ps])
   (let [new (update-pings ps)]
     (try (do (save-pings ctx new)
              {:saved new})
@@ -225,9 +230,10 @@
                                     (str "<@" me ">"))
            ctx    (assoc component :user user)]
        (timbre/debug [:slack-message
-                      {:user   (:id user)
-                       :dm?    dm?
-                       :to-me? to-me?}])
+                      {:user    (:id user)
+                       :dm?     dm?
+                       :to-me?  to-me?
+                       :message (get-in params [:event :text])}])
        (when (or dm? to-me?)
          (if-let [thread-ts (some-> params :event :thread_ts)]
            (eval-command (-> ctx


un-nest helmsman

un-nest helmsman

--- src/clj/traveler/core.clj
+++ src/clj/traveler/core.clj
@@ -43,15 +43,15 @@
    ^{:name "Traveler"
      :id :traveler/root
      :main-menu true}
-   [:any "/" (:dashboard liberator-resources)
-    ^{:name "Dashboard" :id :traveler/dashboard}
-    [:any "/dashboard" (:dashboard liberator-resources)]
-    ^{:name "Manage Users" :id :traveler/users}
-    [:any "/users" (:users liberator-resources)]
-    ^{:name "Manage User" :id :traveler/user}
-    [:any "/user/:id-sk" (:user liberator-resources)]
-    ^{:name "View System" :id :traveler/system}
-    [:any "/system" (:system liberator-resources)]]
+   [:any "/" (:dashboard liberator-resources)]
+   ^{:name "Dashboard" :id :traveler/dashboard}
+   [:any "/dashboard" (:dashboard liberator-resources)]
+   ^{:name "Manage Users" :id :traveler/users}
+   [:any "/users" (:users liberator-resources)]
+   ^{:name "Manage User" :id :traveler/user}
+   [:any "/user/:id-sk" (:user liberator-resources)]
+   ^{:name "View System" :id :traveler/system}
+   [:any "/system" (:system liberator-resources)]
    (into [:context "/api"] (api-routes db-conn))
    ;;middleware
    [wrap-params]


Fix add-course

Fix add-course

--- src/cljs/kulive/view.cljs
+++ src/cljs/kulive/view.cljs
@@ -26,8 +26,7 @@
          :on-change #(re-frame/dispatch
                       [:search-input-entered (-> % .-target .-value)])
          :on-key-down #(if (= (.-which %) 13)
-                         (do (re-frame/dispatch [:course-search-entered])
-                             (.preventDefault %))
+                         add-course
                          nil)
          :placeholder "ex) \"국제관 화(5) major required\""}]
        (if (= 1 (count @displayed-courses))


Added translation from Plushi to Plush.

Added translation from Plushi to Plush.

--- src/clojush/translate.clj
+++ src/clojush/translate.clj
@@ -161,3 +161,20 @@
               pop-agents))
   (when-not use-single-thread (apply await pop-agents))) ;; SYNCHRONIZE

+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Plushi translation
+
+(defn plushi-gene-to-plush-gene
+  "Used when reducing a Plushi genome to a Plush genome. Takes the Plush
+  genome so far and the next Plushi instruction."
+  [plush instruction]
+  (if (= instruction :close)
+    (if (empty? plush)
+      plush
+      (update-in plush [(dec (count plush)) :close] inc))
+    (conj plush {:instruction instruction :close 0})))
+
+(defn translate-plushi-to-plush
+  "Translates Plushi genome into a Plush genome."
+  [{:keys [genome]} argmap]
+  (reduce plushi-gene-to-plush-gene [] genome))


Add some additional conn details to `wcar` docstring

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -25,7 +25,8 @@
                      :timeout-ms 6000
                      :db 3}}

-  For pool options, Ref. http://goo.gl/EiTbn."
+  A `nil` or `{}` `conn` or opts will use defaults. A `:none` pool can be used
+  to skip connection pooling. For other pool options, Ref. http://goo.gl/EiTbn."
   [conn & body]
   `(let [{pool-opts# :pool spec-opts# :spec} ~conn
          [pool# conn#] (conns/pooled-conn pool-opts# spec-opts#)]


Add mirror-map macro (commented inder uxbox.util.data ns).

--- src/uxbox/util/data.cljs
+++ src/uxbox/util/data.cljs
@@ -143,3 +143,9 @@
                             acc))
                         []
                         (partition 2 params))))
+
+
+;; (defmacro mirror-map [& fields]
+;;   (let [keys# (map #(keyword (name %)) fields)
+;;         vals# fields]
+;;     (apply hash-map (interleave keys# vals#))))


Remove questionable utility macros

Remove questionable utility macros

--- src/detritus/variants.clj
+++ src/detritus/variants.clj
@@ -128,70 +128,3 @@
                  (let [[_ {:keys ~members}] x#]
                    (and ~@(:pre ?pre-map))))))
          nil)))
-
-(defmacro defvariant
-  "Defines a function over an open variant and a predicate returning true if the
-  function is implemented for a given tagged value.
-
-  Ex. => (defvariant foo)
-      nil
-      => (deftag a [a b c])
-      nil
-      => (foo (a 1 2 3))
-      ;; No Such Method exception
-      => (foo? (a 1 2 3))
-      false"
-  [variant-name]
-  (let [pred-name    (symbol (str (name variant-name) "?"))
-        default-case (keyword (name (gensym)))]
-    `(do (defmulti ~pred-name first
-           :default ~default-case)
-         (defmulti ~variant-name first)
-         (alter-meta! (var ~variant-name)
-                      merge {:variants/variant true
-                             :variant/predicate (quote ~(symbol (name (ns-name *ns*))
-                                                                (name pred-name)))})
-         (defmethod ~pred-name ~default-case [& _#] false)
-         nil)))
-
-(defmacro extend-variant
-  "Extends a previously defined function over a variant adding a new method for
-  the given tag to its body and extending its predicate to indicate that the tag
-  for which support was just added is an element of the set of tags for which
-  there are dispatch values.
-
-  Ex. => (deftag a [a])
-      nil
-      => (defvariant aable)
-      nil
-      => (extend-variant aable a [{:a a-val}] (inc a-val))
-      nil
-      => (aable? (a 1))
-      true
-      => (aable (a 1))
-      2"
-  [name tag args & body]
-  (let [variant-var  (resolve name)
-        variant-meta (meta variant-var)
-        _            (assert (get variant-meta :variants/variant) "Tried to extend a non-variant!")
-        variant-pred (:variant/predicate variant-meta)
-        _            (assert variant-pred "Tried to extend a variant with no predicate!")
-        _            (resolve variant-pred)
-        tag-var      (resolve tag)
-        tag-meta     (meta tag-var)
-        _            (assert (:variants/tag tag-meta) "Tried to extend a variant on an unknown var!")
-        tag-keyword  (:tag/tag tag-meta)
-        _            (assert (keyword? tag-keyword) "Could not resolve the keyword for the given tag!")]
-    `(do (defmethod ~name         ~tag-keyword [[_# ~@args]] ~@body)
-         (defmethod ~variant-pred ~tag-keyword [& _#] true)
-         nil)))
-
-(comment
-  (do (deftag foo [a])
-      (deftag qux [b])
-      (defvariant f-of-foo)
-      (extend-variant f-of-foo foo [{:a a}] (println a))
-      (f-of-foo? (foo 1)) ;; -> true
-      (f-of-foo  (foo 1)) ;; prints 1
-      (f-of-foo? (bar 1)) ;; -> false
-      ))


parks book

parks book

--- src/house/rooms/back.cljc
+++ src/house/rooms/back.cljc
@@ -122,10 +122,9 @@
                      :take "I wasn't touching that thing, it probably had several generations of germs growing in it."
                      :use "I wasn't touching that thing, it probably had several generations of germs growing in it."))

-; TODO add the easter egg
 (def parks-book (item/make ["book" "book on the table" "book on table"] "It was open a few pages before the end."
                            :take "No need to take it."
-                           :read "TL;DR"))
+                           :read "I tasted the almost perverse pleasure of disengaging myself line by line from the things around me, and at the same time feeling my head rest comfortably on the green velvet of the chair with its high back, sensing that the cigarettes rested within reach of my hand, that beyond the great window the air of afternoon danced under the trees in the garden. Word by word, licked up by the sordid dilemma of the hero and heroine, letting myself be absorbed to the point where the images settled down and took on color and movement, I was witness to the final encounter in the mountain cabin. The woman arrived first, apprehensive; now the lover came in, his face cut by the backlash of a branch. Admirably, she stanched the blood with her kisses, but he rebuffed her caresses, he had not come to perform again the ceremonies of a secret passion, protected by a world of dry leaves and furtive paths through the forest. The dagger warmed itself against his chest, and underneath liberty pounded, hidden close. A lustful, panting dialogue raced down the pages like a rivulet of snakes, and one felt it had all been decided from eternity. Even to those caresses which writhed about the lover's body, as though wishing to keep him there, to dissuade him from it; they sketched abominably the frame of that other body it was necessary to destroy. Nothing had been forgotten: alibis, unforeseen hazards, possible mistakes. From this hour on, each instant had its use minutely assigned. The cold-blooded, twice-gone-over reexamination of the details was barely broken off so that a hand could caress a cheek. It was beginning to get dark.\n\nNot looking at one another now, rigidly fixed upon the task which awaited them, they separated at the cabin door. She was to follow the trail that led north. On the path leading in the opposite direction, he turned for a moment to watch her running, her hair loosened and flying. He ran in turn, crouching among the trees and hedges until, in the yellowish fog of dusk, he could distinguish the avenue of trees which led up to the house. The dogs were not supposed to bark, they did not bark. The estate manager would not be there at this hour, and he was not there. He went up the three porch steps and entered. The woman's words reached him over the thudding of blood in his ears: a long corridor with doors on each side, an oak door by the end, closed. The door of the library, and then, the knife in hand, the light from the great window, the high back of an armchair covered in green velvet, the head of the man in the chair reading a novel."))

 (def armchair (item/make ["armchair" "green velvet armchair" "velvet armchair"]
                          "Green velvet. It had its back toward the door, as to avoid the possibility of an interruption."


Adding RPATH to ruby build

Adding RPATH to ruby build

--- config/software/ruby.clj
+++ config/software/ruby.clj
@@ -18,5 +18,5 @@

 (software "ruby" :source "ruby-1.9.2-p0"
                  :steps [["./configure" "--prefix=/opt/opscode/embedded" "--with-opt-dir=/opt/opscode/embedded" "--enable-shared" "--disable-install-doc"]
-                         ["make"]
-                         [ "make" "install"]])
+                         ["env RPATH=/opt/opscode/embedded/lib" "make"]
+                         ["env RPATH=/opt/opscode/embedded/lib" "make" "install"]])


strip context

strip context


fix missing ns

fix missing ns

--- src/pc/http/routes.clj
+++ src/pc/http/routes.clj
@@ -40,7 +40,7 @@
         doc (doc-model/find-by-id db (Long/parseLong document-id))]
     (if doc
       (content/app (merge {:CSRFToken ring.middleware.anti-forgery/*anti-forgery-token*
-                           :google-client-id (google-client-id)
+                           :google-client-id (google-auth/google-client-id)
                            :sente-id (-> req :session :sente-id)
                            :initial-document-id (:db/id doc)}
                           ;; TODO: Uncomment this once we have a way to send just the novelty to the client.
@@ -116,7 +116,7 @@
   "Response to send for requests that the frontend will route"
   [req]
   (content/app (merge {:CSRFToken ring.middleware.anti-forgery/*anti-forgery-token*
-                       :google-client-id (google-client-id)
+                       :google-client-id (google-auth/google-client-id)
                        :sente-id (-> req :session :sente-id)}
                       (when-let [cust (-> req :auth :cust)]
                         {:cust (cust-model/read-api cust)}))))
@@ -133,7 +133,7 @@
              (merge {:document/chat-bot (rand-nth chat-bot-model/chat-bots)}
                     (when cust-uuid {:document/creator cust-uuid})))]
     (content/app (merge {:CSRFToken ring.middleware.anti-forgery/*anti-forgery-token*
-                         :google-client-id (google-client-id)
+                         :google-client-id (google-auth/google-client-id)
                          :sente-id (-> req :session :sente-id)
                          :initial-document-id (:db/id doc)}
                         (when-let [cust (-> req :auth :cust)]


Start p2 focus test

Start p2 focus test

--- test/obb_rules_api/turn_test.clj
+++ test/obb_rules_api/turn_test.clj
@@ -24,3 +24,24 @@
                                 [:attack [1 3] [1 4]]]})]
     (is (not= :deploy (get-in result [:board :state])))))

+(deftest test-focus-p2-turn
+  (let [board {:game {:state :p2
+                      :elements {[1 1] {:player :p1
+                                        :unit (unit/fetch :kamikaze)
+                                        :quantity 1
+                                        :coordinate [1 1]
+                                        :direction :south}
+                                 [4 4] {:player :p2
+                                        :unit (unit/fetch :rain)
+                                        :quantity 1
+                                        :coordinate [4 4]
+                                        :direction :east}}}}
+        direct-actions [[:move [4 4] [3 3] 1]
+                        [:move [3 3] [2 2] 1]
+                        [:move [2 2] [2 1] 1]
+                        [:rotate [2 1] :west]
+                        [:attack [2 1] [1 1]]]]
+    (testing "regular :p2"
+      (let [direct-board (assoc board :actions direct-actions)
+            [direct result response] (sim/turn-ok :p2 direct-board)]
+      ))))


logging

logging

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -47,7 +47,7 @@
            (= :top (get-in tree [:synsem :infl] :top)))))

 (defn default-fn [tree]
-  (log/debug (str "English: do-defaults (pre) on tree: " (fo tree)))
+  (log/debug (str "English: do-defaults (pre) on tree: " (parse/fo-ps tree fo)))
   (let [result
         (-> tree
             (apply-default-if


added añadir

added añadir

--- src/babel/espanol/lexicon.cljc
+++ src/babel/espanol/lexicon.cljc
@@ -93,6 +93,9 @@
    "anunciar" {:synsem {:cat :verb
                         :sem {:pred :announce}}}

+   "añadir" {:synsem {:cat :verb
+                        :sem {:pred :add}}}
+
    "apoyar" {:synsem {:cat :verb
                       :sem {:pred :support}}}


added comprendre

added comprendre

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -67,6 +67,9 @@

    "commencer" {:synsem {:cat :verb
                          :sem {:pred :begin}}}
+
+    "comprendre" {:synsem {:cat :verb
+                         :sem {:pred :understand}}}

      "ecouter" {:synsem {:cat :verb
                          :sem {:pred :listen}}}


spacing

spacing

--- src/babel/italiano/lexicon.clj
+++ src/babel/italiano/lexicon.clj
@@ -997,7 +997,7 @@
                                    :agr {:gender gender
                                          :number number}}}}}))

-           (unify essere-common {:synsem {:sem {:pred :be}}})
+         (unify essere-common {:synsem {:sem {:pred :be}}})

            ;; essere: copula ;; note that we don't enforce agreement the same here as we do in essere-adjective: TODO: try to make more consistent.
            (let [gender (ref :top)


some changes to cleanup-domains

some changes to cleanup-domains

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -119,10 +119,15 @@
       (.cleanup local-vs 1))))

 (defn cleanup-domains [domains-info local-config]
-  (doseq [domain (keys domains-info)]
-    (try
-      (cleanup-domain domain domains-info local-config)
-      (catch Throwable t (log-error t "Error when cleaning old versions of domain: " domain) (throw t)))))
+  (let [error (atom nil)]
+    (doseq [domain (keys domains-info)]
+      (try
+        (cleanup-domain domain domains-info local-config)
+        (catch Throwable t
+          (log-error t "Error when cleaning old versions of domain: " domain)
+          (reset! error t))))
+    (if @error
+      (throw @error))))

 (defn sync-updated
   "Only fetch domains from remote if a newer version is available.
@@ -199,7 +204,6 @@
     nil
     (do (if new-data
           (close-domain domain domains-info))
-        (cleanup-domain domain domains-info local-config)
         new-data)))

 (defn service-updating? [service-handler download-supervisor]
@@ -237,6 +241,10 @@
                                    local-config
                                    (use-cache-or-update domain domains-info global-config local-config true state))))
               (log-message "Finished updating all domains from remote")
+              (try
+                (log-message "Removing all old versions of domains (CLEANUP")
+                (cleanup-domains domains-info local-config)
+                (catch Throwable t (log-error t "Error when cleaning old versions")))
               (catch Throwable t (log-error t "Error when syncing data") (throw t)))))))))

 ;; 1. after *first* load finishes, right the global config with the token within


implement Director Haas' Pet Project

implement Director Haas' Pet Project

--- src/clj/game/cards-agendas.clj
+++ src/clj/game/cards-agendas.clj
@@ -76,6 +76,28 @@
     {:effect (effect (add-prop card :counter 10))
      :events {:runner-turn-begins e
               :corp-turn-begins   e}})
+
+   "Director Haas Pet Project"
+   (let [dhelper (fn dpp [n] {:prompt "Select a card to install"
+                              :show-discard true
+                              :choices {:req #(and (:side % "Corp")
+                                                   (not= (:type %) "Operation")
+                                                   (or (= (:zone %) [:hand])
+                                                       (= (:zone %) [:discard])))}
+                              :effect (req (corp-install state side target
+                                            (str "Server " (dec (count (get-in @state [:corp :servers :remote])))) {:no-install-cost true})
+                                           (when (< n 2)
+                                             (resolve-ability state side (dpp (inc n)) card nil)))})]
+     {:optional {:prompt "Create a new remote server?"
+                 :yes-ability {:prompt "Select a card to install"
+                               :show-discard true
+                               :choices {:req #(and (:side % "Corp")
+                                                    (not= (:type %) "Operation")
+                                                    (or (= (:zone %) [:hand])
+                                                        (= (:zone %) [:discard])))}
+                               :effect (req (corp-install state side target "New remote" {:no-install-cost true})
+                                            (resolve-ability state side (dhelper 1) card nil))
+                               :msg "create a new remote server, installing cards at no cost"}}})

    "Domestic Sleepers"
    {:abilities [{:cost [:click 3] :msg "place 1 agenda counter on Domestic Sleepers"


fixed pdgm language menu

fixed pdgm language menu

--- src/clj/webapp/routes/pdgm.clj
+++ src/clj/webapp/routes/pdgm.clj
@@ -29,8 +29,8 @@
               [:td [:select#language.required
                     {:title "Choose a language.", :name "language"}
                     (for [language languages]
-                      [:option  language ])
-                    ]]]
+                      (let [opts (split language #" ")]
+                        [:option {:value (first opts)} (last opts) ]))]]]
              [:tr [:td "PDGM Type: "]
               [:td [:select#pos.required
                     {:title "Choose a pdgm type.", :name "pos"}
@@ -66,8 +66,8 @@
         [:table
          [:tr [:td "PDGM Language: " ]
           [:td [:select#language.required
-                {:title "Choose a language.", :name "language"}
-                  [:option  language ]
+               {:title "Choose a language.", :name "language"}
+                [:option language]
                 ]]]
          [:tr [:td "PDGM Type: "]
           [:td [:select#pos.required


enhance searchbox implementation

enhance searchbox implementation

--- src/cljs/searchbot/search.cljs
+++ src/cljs/searchbot/search.cljs
@@ -5,7 +5,8 @@
             [sablono.core :as html :refer-macros [html]]
             [cljs-http.client :as http]
             [cljs.core.async :refer [<! >! chan]]
-            [searchbot.meta :refer [widget-wrapper detail]]))
+            [searchbot.meta :refer [widget-wrapper detail]]
+            [clojure.string :as string]))

 ;;;;;;;;;;;;;
 ;; searchbox
@@ -28,6 +29,9 @@
   [owner result]
   (om/set-state! owner :query-result result))

+(defn- join-str [& tokens]
+  (->> tokens (filter (comp not string/blank?)) (string/join "/") (str "/")))
+
 (defcomponent searchbox [cursor owner opts]
   (will-mount [_]
               (update-searchbox owner "")
@@ -37,7 +41,7 @@
                   (html [:.card
                          [:.card-content
                           [:span.card-title.black-text "searching in "
-                           [:strong (str "/" (:es-index opts) "/" (:es-type opts))]
+                           [:strong (join-str (:es-index opts) (:es-type opts))]
                            [:a.btn-floating.btn-flat.waves-effect.activator.white.right
                             [:i.mdi-action-settings.grey-text]]]
                           [:.input-field
@@ -57,13 +61,12 @@
                                                             (update-searchbox owner "")
                                                             (update-query-result owner {}))
                                                        13 (go ;; ENTER
-                                                           (let [resp (<! (es-query (str "/es/"
-                                                                                (:es-index opts) "/"
-                                                                                (:es-type opts) "/_search")
-                                                                                query))]
+                                                           (let [resp (<! (es-query
+                                                                           (join-str "es" (:es-index opts) (:es-type opts) "_search")
+                                                                           query))]
                                                              (update-query-result owner resp)))
                                                        nil)))}]
-                           [:label {:for (:id opts)} "available fields: " (interpose ", " (map :field (:header opts)))]]
+                           [:label {:for (:id opts)} "query string"]]
                           [:div "query"
                            [:pre {:style {:font-size "8pt"}}
                             [:code.json {:ref "current-query-string"} (.stringify js/JSON (clj->js query) nil 4)]]]
@@ -73,13 +76,13 @@
                             [:thead
                              [:tr
                               (for [col (:header opts)]
-                                [:th (:label col) (str " (" (:field col) ")")])]]
+                                [:th (:label col) (str " (" (string/join "/" (:field col))")")])]]
                             [:tbody
                              (let [hits (get-in query-result [:hits :hits])]
                                (for [hit hits]
                                  [:tr
                                   (for [col (:header opts)]
-                                    [:td (-> hit :_source (get (-> col :field keyword)))])]))]]]]
+                                    [:td (get-in hit (map keyword (:field col)))])]))]]]]
                          [:.card-reveal
                           [:span.card-title.grey-text.text-darken-4 "metadata"
                            [:i.mdi-navigation-close.right]


Make fn public for external macro users to work

--- src/clojure/neko/ui/traits.clj
+++ src/clojure/neko/ui/traits.clj
@@ -53,7 +53,7 @@
   (fn [trait widget attributes-map options-map]
     trait))

-(defn- add-attributes-to-meta
+(defn add-attributes-to-meta
   "Appends information about attribute to trait mapping to `meta`."
   [meta attr-list trait]
   (reduce (fn [m att]


Refactor deftrait to simplify applies? predicates

--- src/clojure/neko/ui/traits.clj
+++ src/clojure/neko/ui/traits.clj
@@ -87,14 +87,15 @@
         [param-map args] (if (map? (first args))
                            [(first args) (next args)]
                            [{} args])
+        attrs-sym (gensym "attributes")
         match-pred (cond (:applies? param-map)
                          (:applies? param-map)

                          (:attributes param-map)
-                         `(fn [kw#] (some kw# ~(:attributes param-map)))
-
-                         :else name)
-        codegen-body args
+                         `(some ~attrs-sym ~(:attributes param-map))
+
+                         :else `(~name ~attrs-sym))
+        [arglist & codegen-body] args
         dissoc-fn (if (:attributes param-map)
                     `(fn [a#] (dissoc a# ~@(:attributes param-map)))
                     `(fn [a#] (dissoc a# ~name)))]
@@ -106,15 +107,16 @@
                           (add-attributes-to-meta
                            (or ~(:attributes param-map) [~name]) ~name))))
        (defmethod apply-trait ~name
-         [trait# widget# attributes# options#]
-         (if (~match-pred attributes#)
-           (let [result# ((fn ~@codegen-body) widget# attributes# options#)
-                 attr-fn# ~dissoc-fn]
-             (if (map? result#)
-               [(:attributes-fn result# attr-fn#)
-                (:options-fn result# identity)]
-               [attr-fn# identity]))
-           [identity identity])))))
+         [trait# widget# ~attrs-sym options#]
+         (let [~arglist [widget# ~attrs-sym options#]]
+           (if ~match-pred
+             (let [result# (do ~@codegen-body)
+                   attr-fn# ~dissoc-fn]
+               (if (map? result#)
+                 [(:attributes-fn result# attr-fn#)
+                  (:options-fn result# identity)]
+                 [attr-fn# identity]))
+             [identity identity]))))))

 (alter-meta! #'deftrait
              assoc :arglists '([name docstring? match-pred? [params*] body]))


Use KeyListener again, but try to prevent unreleased key pressed

--- src/clojure/nightmod/input.clj
+++ src/clojure/nightmod/input.clj
@@ -1,11 +1,8 @@
 (ns nightmod.input
   (:require [nightcode.shortcuts :as shortcuts]
-            [nightcode.ui :as ui]
-            [nightmod.utils :as u]
             [play-clj.core :as play-clj])
-  (:import [java.awt KeyboardFocusManager KeyEventDispatcher]
-           [java.awt.event ComponentAdapter KeyEvent]
-           [com.badlogic.gdx.backends.lwjgl LwjglInput]
+  (:import [com.badlogic.gdx.backends.lwjgl LwjglInput]
+           [java.awt.event KeyListener]
            [nightmod KeyCodeConverter]
            [org.lwjgl.input Keyboard]
            [org.lwjgl.opengl InputImplementation]))
@@ -31,51 +28,29 @@
         impl (proxy [InputImplementation] []
                (pollKeyboard [bb])
                (readKeyboard [bb]))]
-    (.addKeyEventDispatcher
-      (KeyboardFocusManager/getCurrentKeyboardFocusManager)
-      (proxy [KeyEventDispatcher] []
-        (dispatchKeyEvent [^KeyEvent e]
-          (cond
-            ; a key was released in a game
-            (and @ui/tree-selection
-                 (shortcuts/focused-window? window)
-                 (not (.isVisible @u/editor))
-                 (= (.getID e) KeyEvent/KEY_RELEASED))
-            (do
-              (.set impl-field nil impl)
-              (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 0))
-              (-> game
-                  .getInput
-                  .getInputProcessor
-                  (.keyUp (awt->libgdx (.getKeyCode e)))
-                  play-clj/on-gl)
-              true)
-            ; a key was typed in a game
-            (and @ui/tree-selection
-                 (shortcuts/focused-window? window)
-                 (not (.isVisible @u/editor))
-                 (= (.getID e) KeyEvent/KEY_TYPED))
-            (do
-              (-> game
-                  .getInput
-                  .getInputProcessor
-                  (.keyTyped (.getKeyChar e))
-                  play-clj/on-gl)
-              true)
-            ; a key was pressed in a game
-            (and @ui/tree-selection
-                 (shortcuts/focused-window? window)
-                 (not (.isVisible @u/editor))
-                 (= (.getID e) KeyEvent/KEY_PRESSED))
-            (do
-              (.set impl-field nil impl)
-              (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 8))
-              (-> game
-                  .getInput
-                  .getInputProcessor
-                  (.keyDown (awt->libgdx (.getKeyCode e)))
-                  play-clj/on-gl)
-              true)
-            ; don't handle
-            :else
-            false))))))
+    (.addKeyListener
+      window
+      (reify KeyListener
+        (keyReleased [this e]
+          (.set impl-field nil impl)
+          (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 0))
+          (-> game
+              .getInput
+              .getInputProcessor
+              (.keyUp (awt->libgdx (.getKeyCode e)))
+              play-clj/on-gl))
+        (keyTyped [this e]
+          (-> game
+              .getInput
+              .getInputProcessor
+              (.keyTyped (.getKeyChar e))
+              play-clj/on-gl))
+        (keyPressed [this e]
+          (.set impl-field nil impl)
+          (when-not @shortcuts/down?
+            (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 1)))
+          (-> game
+              .getInput
+              .getInputProcessor
+              (.keyDown (awt->libgdx (.getKeyCode e)))
+              play-clj/on-gl))))))


returning a named function simplifies debugging

--- src/clojure/sparkling/core.clj
+++ src/clojure/sparkling/core.clj
@@ -221,7 +221,8 @@
   (.fold rdd zero-value (function2 f)))

 (defn tuple-by [f]
-  (fn [x] (tuple (f x) x)))
+  (fn tuple-by-fn [x]
+    (tuple (f x) x)))

 (defn key-by
   "Creates tuples of the elements in this RDD by applying `f`."


CMR Hotfix: Re-add normalization call (dropped in previous commits).

--- src/cmr/opendap/query/core.clj
+++ src/cmr/opendap/query/core.clj
@@ -45,21 +45,23 @@

 (defn create
   ([raw-params]
-    (create (cond (nil? (:collection-id raw-params)) :missing-collection-id
-                  (cmr/style? raw-params) :cmr
-                  (giovanni/style? raw-params) :giovanni
-                  (wcs/style? raw-params) :wcs
-                  (util/ambiguous-style? raw-params) :cmr
-                  :else :unknown-parameters-type)
-            raw-params))
+    (let [params (util/normalize-params raw-params)]
+      (create (cond (nil? (:collection-id params)) :missing-collection-id
+                    (cmr/style? params) :cmr
+                    (giovanni/style? params) :giovanni
+                    (wcs/style? params) :wcs
+                    (util/ambiguous-style? params) :cmr
+                    :else :unknown-parameters-type)
+              params)))
   ([params-type raw-params]
-    (case params-type
-      :wcs (wcs/create raw-params)
-      :giovanni (giovanni/create raw-params)
-      :cmr (cmr/create raw-params)
-      :missing-collection-id {:errors [errors/missing-collection-id]}
-      :unknown-parameters-type {:errors [errors/invalid-parameter
-                                         (str "Parameters: " raw-params)]})))
+    (let [params (util/normalize-params raw-params)]
+      (case params-type
+        :wcs (wcs/create raw-params)
+        :giovanni (giovanni/create raw-params)
+        :cmr (cmr/create raw-params)
+        :missing-collection-id {:errors [errors/missing-collection-id]}
+        :unknown-parameters-type {:errors [errors/invalid-parameter
+                                           (str "Parameters: " raw-params)]}))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Add test for keyed

Add test for keyed

--- test/useful/map_test.clj
+++ test/useful/map_test.clj
@@ -7,6 +7,11 @@
              (assoc-or :a 2)
              (assoc-or :b 2)
              (assoc-or :c 3)))))
+
+(deftest test-keyed
+  (let [a 1 b 2]
+    (is (= {:a 1 :b 2} (keyed [a b])))
+    (is (= '{a 1 b 2}  (keyed :syms [a b])))))

 (deftest test-into-map
   (is (= {:foo "1", :bar "2", :bang "3", :baz "4", :blah 5}


Removed *session-repo* binding

Removed *session-repo* binding

--- src/compojure/http/session.clj
+++ src/compojure/http/session.clj
@@ -16,47 +16,39 @@
   (:use compojure.crypto)
   (:use clojure.contrib.except))

-;; Global session store type
-
-(declare *session-repo*)
-
 ;; Override these mulitmethods to create your own session storage.
 ;; Uses the Compojure repository pattern.

-(defn- repository-type
-  [repository]
-  (:type repository repository))
-
 (defmulti create-session
   "Create a new session map. Should not attempt to save the session."
-  (fn [] (repository-type *session-repo*)))
+  (fn [repository] (type repository)))

 (defmulti read-session
   "Read in the session using the supplied data. Usually the data is a key used
   to find the session in a store."
-  (fn [data] (repository-type *session-repo*)))
+  (fn [repository data] (type repository)))

 (defmulti write-session
   "Write a new or existing session to the session store."
-  (fn [session] (repository-type *session-repo*)))
+  (fn [repository session] (type repository)))

 (defmulti destroy-session
   "Remove the session from the session store."
-  (fn [session] (repository-type *session-repo*)))
+  (fn [repository session] (type repository)))

 (defmulti session-cookie
   "Return the session data to be stored in the cookie. This is usually the
   session ID."
-  (fn [new? session] (repository-type *session-repo*)))
+  (fn [repository new? session] (type repository)))

 ;; Default implementations of create-session and set-session-cookie

 (defmethod create-session :default
-  []
+  [repository]
   {:id (gen-uuid)})

 (defmethod session-cookie :default
-  [new? session]
+  [repository new? session]
   (if new?
     (session :id)))

@@ -65,17 +57,17 @@
 (def memory-sessions (ref {}))

 (defmethod read-session :memory
-  [id]
+  [repository id]
   (@memory-sessions id))

 (defmethod write-session :memory
-  [session]
+  [repository session]
   (dosync
     (alter memory-sessions
       assoc (session :id) session)))

 (defmethod destroy-session :memory
-  [session]
+  [repository session]
   (dosync
     (alter memory-sessions
       dissoc (session :id))))
@@ -86,28 +78,32 @@

 (defn session-hmac
   "Calculate a HMAC for a marshalled session"
-  [cookie-data]
-  (let [secret-key (:secret-key *session-repo* *default-secret-key*)]
+  [repository cookie-data]
+  (let [secret-key (:secret-key repository *default-secret-key*)]
     (hmac secret-key "HmacSHA256" cookie-data)))

-(defmethod create-session :cookie [] {})
+(defmethod create-session :cookie
+  [repository]
+  {})

 (defmethod session-cookie :cookie
-  [new? session]
+  [repository new? session]
   (let [cookie-data (marshal session)]
     (if (> (count cookie-data) 4000)
       (throwf "Session data exceeds 4K")
-      (str cookie-data "--" (session-hmac cookie-data)))))
+      (str cookie-data "--" (session-hmac repository cookie-data)))))

 (defmethod read-session :cookie
-  [data]
+  [repository data]
   (let [[session mac] (.split data "--")]
     (if (= mac (session-hmac session))
       (unmarshal session))))

-; Do nothing for write or destroy
-(defmethod write-session :cookie [session])
-(defmethod destroy-session :cookie [session])
+(defmethod write-session :cookie
+  [repository session])
+
+(defmethod destroy-session :cookie
+  [repository session])

 ;; Session middleware

@@ -119,8 +115,8 @@
 (defn- assoc-expiry
   "Associate an :expires-at key with the session if the session repository
   contains the :expires key."
-  [session]
-  (if-let [expires (:expires *session-repo*)]
+  [repository session]
+  (if-let [expires (:expires repository)]
     (assoc session :expires-at (timestamp-after expires))
     session))

@@ -132,27 +128,28 @@

 (defn- new-request-session
   "Associates a new session with a request."
-  [request]
+  [repository request]
   (assoc request
-    :session (assoc-expiry (create-session))
+    :session (assoc-expiry (create-session repository))
     :new-session? true))

 (defn- get-request-session
   "Retrieve the session using the 'session' cookie in the request."
-  [request]
+  [repository request]
   (if-let [session-data (-> request :cookies :compojure-session)]
-    (read-session session-data)))
+    (read-session repository session-data)))

 (defn- assoc-request-session
   "Associate the session with the request."
-  [request]
-  (if-let [session (get-request-session request)]
+  [repository request]
+  (if-let [session (get-request-session repository request)]
     (if (session-expired? session)
       (do
-        (destroy-session session)
-        (new-request-session request))
-      (assoc request :session (assoc-expiry session)))
-    (new-request-session request)))
+        (destroy-session repository session)
+        (new-request-session repository request))
+      (assoc request :session
+        (assoc-expiry repository session)))
+    (new-request-session repository request)))

 (defn- assoc-request-flash
   "Associate the session flash with the request and remove it from the
@@ -165,44 +162,52 @@

 (defn- set-session-cookie
   "Set the session cookie on the response if required."
-  [request response session]
+  [repository request response session]
   (let [new?   (:new-session? request)
-        cookie (session-cookie new? session)
-        update (set-cookie :compojure-session cookie, :path "/")]
+        cookie (session-cookie repository new? session)
+        update (set-cookie :compojure-session cookie
+                           :path (repository :path "/"))]
     (if cookie
       (update-response request response update)
       response)))

 (defn- save-handler-session
   "Save the session for a handler if required."
-  [request response session]
+  [repository request response session]
   (when (and (contains? response :session)
              (nil? (response :session)))
-    (destroy-session session))
+    (destroy-session repository session))
   (when (or (:session response)
-            (contains? *session-repo* :expires)
+            (contains? repository :expires)
             (:new-session? request)
             (not-empty (:flash request)))
-    (write-session session)))
+    (write-session repository session)))
+
+(defn- keyword->repository
+  "If the argument is a keyword, expand it into a repository map."
+  [repository]
+  (if (keyword? repository)
+    {:type repository}
+    repository))

 (defn with-session
   "Wrap a handler in a session of the specified type. Session type defaults to
   :memory if not supplied."
   ([handler]
     (with-session handler :memory))
-  ([handler session-repo]
+  ([handler repository]
     (fn [request]
-      (binding [*session-repo* session-repo]
-        (let [request  (-> request assoc-cookies
-                                   assoc-request-session
-                                   assoc-request-flash)
-              response (handler request)
-              session  (or (:session response) (:session request))]
-          (when response
-            (save-handler-session request response session)
-            (set-session-cookie   request response session)))))))
-
-;; User functions for modifying the session
+      (let [repo     (keyword->repository repository)
+            request  (-> request (assoc-cookies)
+                                 (assoc-request-session repo)
+                                 (assoc-request-flash))
+            response (handler request)
+            session  (or (:session response) (:session request))]
+        (when response
+          (save-handler-session repo request response session)
+          (set-session-cookie   repo request response session))))))
+
+;; Useful functions for modifying the session

 (defn set-session
   "Return a response map with the session set."


add test case for autocomplete score for parkinson

--- test/wb_es/core_test.clj
+++ test/wb_es/core_test.clj
@@ -179,6 +179,12 @@
                           (= "X-linked dystonia-parkinsonism"
                              (get-in hit [:_source :label])))
                         hits)))
+            (testing "Parkinson's diease scores no worse than specific children terms"
+              (let [hits (autocomplete "parkinson" {:size (count disease-parks)})
+                    pd-term (has-hit hits "DOID:14330")
+                    child-term (has-hit hits "DOID:0060897")]
+                (is (>= (:_score pd-term)
+                        (:_score child-term)))))

             )))


[core] generally increase the buffer size for telemetry messages, but also make it configurable

--- core/src/gorillalabs/tesla/component/telemetry.clj
+++ core/src/gorillalabs/tesla/component/telemetry.clj
@@ -2,10 +2,11 @@
 ;;;
 ;;; Sample configuration:
 ;;;
-;;; {:telemetry {:riemann  {:host "127.0.0.2" :port 5555}
-;;;              :host     "app.eu.backend42" ;; leave out for automatic hostname detection
-;;;              :prefix   "app.backend."     ;; automatically prefix all service names
-;;;              :interval 60                 ;; seconds
+;;; {:telemetry {:riemann    {:host "127.0.0.2" :port 5555}
+;;;              :host       "app.eu.backend42" ;; leave out for automatic hostname detection
+;;;              :prefix     "app.backend."     ;; automatically prefix all service names
+;;;              :interval   60                 ;; seconds
+;;;              :queue-size 1000               ;; how many messages can be buffered
 ;;;              }}

 (ns gorillalabs.tesla.component.telemetry
@@ -79,7 +80,7 @@
 (defn- start []
   (log/info "-> starting telemetry")
   (let [config     (config/config config/configuration [:telemetry])
-        queue      (chan (sliding-buffer 100))
+        queue      (chan (sliding-buffer (:queue-size config 1000)))
         killswitch (chan)
         client     (when (:riemann config) (riemann/tcp-client (:riemann config)))]
     (worker killswitch client queue (:interval config 30))


Updated data functions for pages.

Updated data functions for pages.

--- src/clj/mx/roads/forgotten/blog/web/content/data.clj
+++ src/clj/mx/roads/forgotten/blog/web/content/data.clj
@@ -9,7 +9,6 @@
     (base {}))
   ([data]
     (merge
-      data
       {:base-path "/blog"
        :site-title (config/name)
        :site-description (config/description)
@@ -19,41 +18,64 @@
        :archives "archives"
        :categories "categories"
        :tags "tags"
-       :authors "authors"})))
+       :authors "authors"
+       :active nil}
+      data)))
+
+(def generic-page
+  {:title nil
+   :subtitle nil})

 (defn markdown-page
   [md-file]
-  {:content (->> md-file
-                 (str "markdown/")
-                 (io/resource)
-                 (slurp)
-                 (markdown/md-to-html-string))})
+  (merge
+    generic-page
+    {:body (->> md-file
+                (str "markdown/")
+                (io/resource)
+                (slurp)
+                (markdown/md-to-html-string))}))

 (defn about
   []
-  {:page-data
-    (merge
-      (base {:active "about"})
-      (markdown-page "about.md"))})
-
-(defn community
-  []
-  {:page-data (base {:active "community"})})
-
-(defn design
-  []
-  {:page-data (base {:active "design"})})
-
-(defn post
-  [data]
-  {:page-data (base {:active "archives"})
-   :post-data data
-   :tags (blog/tags [data])})
+  {:page-data (base {:active "about"})
+   :content (-> "about.md"
+                (markdown-page)
+                (assoc :title "About"))})

 (defn archives
   [data]
   {:page-data (base {:active "archives"})
-   :posts-data data})
+   :posts-data data
+   :content (assoc generic-page :title "Archives")})
+
+(defn categories
+  [data]
+  {:page-data (base {:active "categories"})
+   :posts-data data
+   :content (assoc generic-page :title "Categories")})
+
+(defn tags
+  [data]
+  {:page-data (base {:active "tags"})
+   :posts-data data
+   :content (assoc generic-page :title "Tags")})
+
+(defn authors
+  [data]
+  {:page-data (base {:active "authors"})
+   :posts-data data
+   :content (assoc generic-page :title "Authors")})
+
+(defn community
+  []
+  {:page-data (base {:active "community"})
+   :content (assoc generic-page :title "Community")})
+
+(defn design
+  []
+  {:page-data (base {:active "design"})
+   :content (assoc generic-page :title "Design")})

 (defn front-page
   [data & {post-count :post-count column-count :column-count}]
@@ -64,17 +86,8 @@
    :headliner headliner
    :posts-data posts}))

-(defn categories
+(defn post
   [data]
-  {:page-data (base {:active "categories"})
-   :posts-data data})
-
-(defn tags
-  [data]
-  {:page-data (base {:active "tags"})
-   :posts-data data})
-
-(defn authors
-  [data]
-  {:page-data (base {:active "authors"})
-   :posts-data data})
+  {:page-data (base {:active "archives"})
+   :post-data data
+   :tags (blog/tags [data])})


use dev-local

use dev-local

--- tutorial/constructor.clj
+++ tutorial/constructor.clj
@@ -9,14 +9,10 @@
 ;  NOTE: You must run an Ion deploy of the day-of-datomic-cloud project to
 ;  your Datomic system prior to running these examples.

-(require
-  '[datomic.client.api :as d]
-  '[datomic.samples.repl :as repl])
-(import '(java.util UUID))
-
-(def client-cfg (read-string (slurp "config.edn")))
-(def client (d/client client-cfg))
-(def db-name (str "scratch-" (UUID/randomUUID)))
+(require '[datomic.client.api :as d]
+         '[datomic.samples.repl :as repl])
+(def client (d/client {:server-type :dev-local :system "day-of-datomic-cloud"}))
+(def db-name "constructor")
 (d/create-database client {:db-name db-name})
 (def conn (d/connect client {:db-name db-name}))

@@ -31,21 +27,21 @@
               :db.entity/attrs [:user/name :user/email]}])
 (d/transact conn {:tx-data schema})

-(def db (d/db conn))
-
 ;; valid user
-(d/with (d/with-db conn) {:tx-data [{:user/email "jdoe@example.com"
-                                     :user/name "John Doe"
-                                     :db/ensure :user/validate}]})
+(d/transact conn {:tx-data [{:user/email "jdoe@example.com"
+                             :user/name "John Doe"
+                             :db/ensure :user/validate}]})

 ;; not valid -- no email
-(-> (d/with (d/with-db conn) {:tx-data [{:user/name "John Doe"
-                                         :db/ensure :user/validate}]})
+(-> (d/transact conn {:tx-data [{:user/name "John Doe"
+                                 :db/ensure :user/validate}]})
     repl/thrown-data)

 ;; not valid -- too long
-(-> (d/with (d/with-db conn) {:tx-data [{:user/name "This user name is too long"
-                                         :db/ensure :user/validate}]})
+(-> (d/transact conn {:tx-data [{:user/name "This user name is too long"
+                                 :db/ensure :user/validate}]})
     repl/thrown-data)

-(d/delete-database client {:db-name db-name})
+
+
+


Clean up frozen package string stuff, add frozen package string spec

--- src/degasolv/resolver_spec.clj
+++ src/degasolv/resolver_spec.clj
@@ -112,18 +112,20 @@
    str-requirement-pattern
    "$")))

-(def str-frozen-pattern
+(def str-frozen-package-pattern
   (str
     str-id-pattern
     "=="
     str-version-pattern))

-(def str-frozen-regex
+(def str-frozen-package-regex
   (re-pattern
     (str
       "^"
-      str-frozen-pattern
+      str-frozen-package-pattern
       "$")))
+(s/def ::frozen-package-string
+       #(re-matches str-frozen-package-regex %))

 (s/def ::requirement-string
        #(re-matches str-requirement-regex %))


Drop schema call for unpack functions.

Drop schema call for unpack functions.

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -1287,8 +1287,7 @@
     (apply jdbcd/do-commands feature-table)
     (apply jdbcd/do-commands code-table)
     (apply jdbcd/do-commands field-position-table)
-    (apply jdbcd/do-commands field-gene-table)
-    (apply jdbcd/do-commands unpack-aliases)))
+    (apply jdbcd/do-commands field-gene-table)))

 ;
 ; add TABLE handling for honeysql


remove fd leak from not closing the taxo reader on change

--- src/bzzz/index_directory.clj
+++ src/bzzz/index_directory.clj
@@ -276,7 +276,9 @@
       (do
         (.maybeRefresh manager)
         (if-let [changed (DirectoryTaxonomyReader/openIfChanged taxo)]
-          (swap! name->smanager-taxo* assoc-in [index 1] changed))
+          (do
+            (.close taxo)
+            (swap! name->smanager-taxo* assoc-in [index 1] changed)))
         (stat/update-took-count index "refresh-search-managers" (time-took t0)))
       (catch Throwable e
         (do


Add admin bar markup.

Add admin bar markup.

--- src/cadence/views/common.clj
+++ src/cadence/views/common.clj
@@ -3,6 +3,7 @@
             [cemerick.friend :as friend]
             [ring.util.anti-forgery :refer [anti-forgery-metas]]
             [cadence.model :as m]
+            [cadence.security :refer [admin?]]
             [noir.validation :as vali]
             [cadence.model.flash :as flash])
   (:use (hiccup core def page)))
@@ -73,6 +74,18 @@
                type) " "] message])
   ([class type message] (alert class type message true))
   ([type message] (alert type type message true)))
+
+(defhtml admin-bar
+  "A fixed bottom navbar that only appears for admins."
+  []
+  [:footer#admin-footer.footer.footer-sticky
+   [:div#navbar.navbar
+    [:div.navbar-inner
+     [:div.container
+      [:ul.nav
+       [:li.title [:a {:href "#"} [:strong "ADMIN BAR"]]]
+       [:li.divider-vertical]
+       [:li [:a {:href "/admin/migrations"} "Migrations"]]]]]]])

 (defn layout [& content]
   (base-layout
@@ -113,7 +126,8 @@
        [:a.label.label-inverse {:href "/#privacy"} "Privacy"]
        [:a.label {:href "/#security"} "Security"]
        [:a.label.label-success {:href "/#contact"} "Contact"]
-       " © 2012 Ryan McGowan"]]]))
+       " © 2012 Ryan McGowan"]
+      (when (admin?) (admin-bar))]]))

 (defn format-errors
   "Takes a collection of error messages and formats it into html."


dynamic navs automatically compile sequence returns if completely static

--- src/clj/com/rpl/specter.cljc
+++ src/clj/com/rpl/specter.cljc
@@ -114,8 +114,22 @@
                                           attr)]
          [(with-meta name attr) macro-args]))

+     (defn- static-path? [path]
+       (if (sequential? path)
+        (every? static-path? path)
+        (-> path i/dynamic-param? not)
+        ))
+
+     (defn- wrap-dynamic-nav [f]
+       (fn [& args]
+         (let [ret (apply f args)]
+           (if (and (sequential? ret) (static-path? ret))
+             (i/comp-paths* ret)
+             ret
+             ))))
+
      (defmacro dynamicnav [& args]
-       `(vary-meta (fn ~@args) assoc :dynamicnav true))
+       `(vary-meta (wrap-dynamic-nav (fn ~@args)) assoc :dynamicnav true))

      (defmacro defdynamicnav
        "Defines a function that can choose what navigator to use at runtime based on
@@ -558,13 +572,7 @@
   [navfn]
   (let [latenavfn (late-resolved-fn navfn)]
     (dynamicnav [& args]
-      (if (= 1 (count args))
-        ;; optimization if dynamicnav is used in a runtime situation (like
-        ;; via a dynamic var)
-        ;; also makes the resulting nav function semantically identical to original
-        ;; nav by returning a RichNavigator instead of a sequence
-        (latenavfn (first args))
-        (map latenavfn args)))))
+      (map latenavfn args))))

 ;; Helpers for making recursive or mutually recursive navs


Set the state to repairing before doing any actual work

--- src/clj/mdr2/repair/core.clj
+++ src/clj/mdr2/repair/core.clj
@@ -79,7 +79,8 @@
         (log/error error-msg)
         [error-msg])
       :else
-      (let [container-id (container-id production)
+      (let [production (prod/set-state! production "repairing")
+            container-id (container-id production)
             url (archive-url container-id)
             response (client/get url
                                  {:as :stream


fix string tags

fix string tags

--- src/clj/tictag/beeminder.clj
+++ src/clj/tictag/beeminder.clj
@@ -14,6 +14,10 @@
 (def or* (functionize or))

 (defmulti match? (fn [a _] (class a)))
+
+(defmethod match? java.lang.String
+  [a b]
+  (b a))

 (defmethod match? clojure.lang.Keyword
   [a b]


reset starting land vals to 0

reset starting land vals to 0

--- src/cljs/mana_calc/core.cljs
+++ src/cljs/mana_calc/core.cljs
@@ -12,11 +12,11 @@
                           :r 0
                           :g 0}
            :lands 17
-           :mana-base {:w 1
+           :mana-base {:w 0
                        :u 0
-                       :b 1
-                       :r 1
-                       :g 1}}))
+                       :b 0
+                       :r 0
+                       :g 0}}))

 (defn mana-update! [e color]
   (swap! app-state assoc-in [:mana-symbols color] (int (.-target.value e))))


refactor ai

refactor ai

--- src/cljs/triboard/ai/ai.cljs
+++ src/cljs/triboard/ai/ai.cljs
@@ -15,31 +15,36 @@
   [board player]
   {:player player})

-(defn- max-by
-  [key-fn coll]
-  (apply max-key key-fn coll))
+(defn- summarize-score
+  [ai scores]
+  (get scores (:player ai))) ;; TODO - Blue score + min-max modification for AI Aliance

 (defn- maximizing-turn?
   [ai turn]
   (= (:player ai) (:player turn)))

+;; -----------------------------------------
+
+(defn- min-max-step-by
+  [compare-key ai turn on-transition]
+  (apply
+    (if (maximizing-turn? ai turn) max-key min-key)
+    compare-key
+    (map
+      (fn [[coord transition]] (on-transition coord transition))
+      (turn/player-transitions turn))))
+
 (defn- min-max-step
   [ai turn on-transition]
-  (apply
-    (if (maximizing-turn? ai turn) max min)
-    (map
-      (fn [[_ transition]] (on-transition transition))
-      (turn/player-transitions turn))))
+  (min-max-step-by identity ai turn on-transition)) ;; TODO - avoid projection

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

 (defn- leaf-score
-  [ai turn]
+  [ai {:keys [scores] :as turn}]
   (min-max-step ai turn
-    (fn look-ahead [transition]
-      (get
-        (reduce scores/update-scores (:scores turn) transition)
-        (:player ai)) ;; TODO - Blue score + min-max modification for AI Aliance
+    (fn look-ahead [_ transition]
+      (summarize-score ai (reduce scores/update-scores scores transition))
       )))

 (defn tree-score
@@ -47,7 +52,7 @@
   (if (= 0 depth)
     (leaf-score ai turn)
     (min-max-step ai turn
-      (fn look-lower [transition]
+      (fn look-lower [_ transition]
         (tree-score ai
           (turn/apply-transition turn transition)
           (dec depth))))
@@ -66,14 +71,13 @@
   (let [turn (game/current-turn game)
         ai (make-ai (:board turn) (:player turn))]
     (:game
-      (max-by :scoring
-        (map
-          (fn [[coord _]]
-            (let [new-game (game/play-move game coord)
-                  new-turn (game/current-turn new-game)]
-              {:game new-game
-               :scoring (tree-score ai new-turn 1)}))
-          (turn/player-transitions turn)))
+      (min-max-step-by
+        :score ai turn
+        (fn [coord _]
+          (let [new-game (game/play-move game coord)
+                new-turn (game/current-turn new-game)]
+            {:game new-game                             ;; TODO - Not sure keeping game in memory is wise
+             :score (tree-score ai new-turn 1)})))
       )))


Regex problem added

Regex problem added

--- src/foreclojure/data_set.clj
+++ src/foreclojure/data_set.clj
@@ -361,4 +361,12 @@
             :tags ["elementary" "math" "syntax"]
             :tests ["(= 10 (let __ (+ x y)))"
 		    "(= 4 (let __ (+ y z)))"
-                    "(= 1 (let __ z))"]})))+                    "(= 1 (let __ z))"]})
+
+    (insert! :problems
+           {:_id 37
+            :title "Regular Expressions"
+            :times-solved 0
+            :description "Regex patterns are supported with a special reader macro."
+            :tags ["elementary" "math" "syntax"]
+            :tests ["(= __ (apply str (re-seq #\"[A-Z]+\" \"bA1B3Ce\")))"]})))


Add common plugins for leiningen project

--- clojure/profiles.clj
+++ clojure/profiles.clj
@@ -1,11 +1,17 @@
 ;; https://github.com/technomancy/leiningen/blob/stable/doc/PROFILES.md
-{:user {:plugins [[lein-pprint "1.3.2"
-                   lein-ancient "0.7.0"
-                   lein-cloverage "1.2.2"]]
-        :dependencies [[alembic "0.3.2"]
-                       [clj-kondo "RELEASE"]
-                       [antq "RELEASE"]
-                       [vvvvalvalval/scope-capture "0.3.2"]]
-        :injections [(require 'sc.api)]
-        :aliases {"clj-kondo" ["run" "-m" "clj-kondo.main"]
-                  "outdated"  ["run" "-m" "antq.core"]}}}
+{:user
+ {:plugins
+  [[cider/cider-nrepl "0.25.9"]
+   [lein-ancient "0.7.0"]
+   [lein-check-namespace-decls "1.0.4"]
+   [lein-cljfmt "0.8.0"]
+   [lein-nsorg "0.3.0"]
+   [refactor-nrepl/refactor-nrepl "3.0.0-alpha13"]]}
+  :dependencies
+   [#_[alembic "0.3.2"]
+    [clj-kondo "RELEASE"]
+    [antq "RELEASE"]
+    [vvvvalvalval/scope-capture "0.3.2"]]
+  :injections [(require 'sc.api)]
+  :aliases {"clj-kondo" ["run" "-m" "clj-kondo.main"]
+            "outdated"  ["run" "-m" "antq.core"]}}


secondary sort on date for new issues

secondary sort on date for new issues

--- src-cljs/frontend/models/issue.cljs
+++ src-cljs/frontend/models/issue.cljs
@@ -40,5 +40,9 @@

 (defn issue-comparator [cust time]
   (fn [issue-a issue-b]
-    (compare (issue-score issue-b cust time)
-             (issue-score issue-a cust time))))
+    (let [score-res (compare (issue-score issue-b cust time)
+                             (issue-score issue-a cust time))]
+      (if (zero? score-res)
+        (compare (:issue/created-at issue-b)
+                 (:issue/created-at issue-a))
+        score-res))))


create-wish-rem cljs

create-wish-rem cljs

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -81,6 +81,12 @@
     (letrem [neu (update-wishlist wishlist)]
       (fn [e] nil))))

+(defn create-wish-rem [$elem]
+  (let [wish (wish-from-elem $elem)
+        clean (dissoc wish :id)]
+    (letrem [neu (create-wish clean)]
+      (fn [e] nil))))
+

 ; DELEGATES


add method to test for hive membership

add method to test for hive membership

--- src/hivewing_core/worker.clj
+++ src/hivewing_core/worker.clj
@@ -16,7 +16,12 @@
                         (ensure-uuid hive-uuid)
                         per-page
                         (* (- page 1) per-page)])))
-
+(defn worker-in-hive?
+  "Is this worker in the given hive?"
+  [worker-uuid hive-uuid]
+  (jdbc/query sql-db ["SELECT uuid FROM workers WHERE uuid = ? AND hive_uuid ? LIMIT 1"
+                      (ensure-uuid worker-uuid)
+                      (ensure-uuid hive-uuid)] :result-set-fn first))
 (defn worker-get
   "Get the data for worker record.  You pass in the worker via the worker uuid.  Returns the data
   as a hashmap. DOES NOT return the access_token"


Refactroting: render-optional-message

Refactroting: render-optional-message

--- src/hurvinek/html_renderer.clj
+++ src/hurvinek/html_renderer.clj
@@ -76,6 +76,14 @@
         [:a {:href link} "Back"]
     ])

+(defn render-optional-message
+    [message-type message]
+    (if message
+        [:div {:class "container-fluid"}
+            [:div {:class (str "alert alert-" message-type)}
+                message
+            ]]))
+
 (defn render-front-page
     "Render front page of this application."
     [url-prefix title]
@@ -212,12 +220,7 @@
             [:div {:class "container"}
                 (render-navigation-bar-section url-prefix title)
                 (render-breadcrumb url-prefix "select-product" "Product list")
-                (if message
-                    [:div {:class "container-fluid"}
-                        [:div {:class (str "alert alert-" message-type)}
-                            message
-                        ]
-                    ])
+                (render-optional-message message-type message)
                 [:div {:class "container-fluid"}
                     [:h3 "Edit product"]
                     (form/form-to [:get "edit-product"]
@@ -244,22 +247,33 @@

 (defn render-chapter-list
     "Render chapter list for selected product."
-    [url-prefix title product-id product-name chapter-list]
+    [url-prefix title product-id product-name chapter-list & {:keys [message-type message]}]
     (page/xhtml
         (render-html-header url-prefix title)
         [:body
             [:div {:class "container"}
                 (render-navigation-bar-section url-prefix title)
                 (render-breadcrumb url-prefix "select-product" (str "Product: " product-name))
-                [:div {:class "container-fluid"}
-                [:h2 (str "Chapters for product " product-name)]
-                [:table {:style "border-collapse: separate; border-spacing: 10px;"}
-                    (for [chapter chapter-list]
-                        [:tr
-                            [:td (:name chapter)]
-                            [:td [:a {:href (str "chapter?product-id=" product-id "&chapter-id=" (:id chapter) "&action=rename-chapter")} "rename"]]
-                            [:td [:a {:href (str "chapter?product-id=" product-id "&chapter-id=" (:id chapter) "&action=grouplist")} "group list"]]])
-                ]]
+                (render-optional-message message-type message)
+                [:div {:class "container-fluid"}
+                    [:h2 (str "Chapters for product " product-name)]
+                    [:table {:style "border-collapse: separate; border-spacing: 10px;"}
+                        (for [chapter chapter-list]
+                            [:tr
+                                [:td (:name chapter)]
+                                [:td [:a {:href (str "chapter?product-id=" product-id "&chapter-id=" (:id chapter) "&action=rename-chapter")} "rename"]]
+                                [:td [:a {:href (str "chapter?product-id=" product-id "&chapter-id=" (:id chapter) "&action=grouplist")} "group list"]]])
+                    ]]
+                    [:br]
+                    [:h3 "New chapter"]
+                    (form/form-to [:get "add-new-chapter"]
+                        (form/hidden-field "product-id" product-id)
+                        [:fieldset {:class "form-group"}
+                            [:label {:for "product-name"} "Name"]
+                            [:input {:type "text" :class "form-control" :id "chapter-name" :name "chapter-name" :placeholder "chapter name"}]
+                        ]
+                        [:button {:type "submit" :class "btn btn-primary"} "Add new chapter"]
+                    )
                 (render-back-link (str url-prefix "select-product"))
                 (render-html-footer)
             ] ; </div class="container">


Avoid exceptions when return value is a list

--- src/ipython_clojure/core.clj
+++ src/ipython_clojure/core.clj
@@ -202,7 +202,7 @@
         (try
           (let [s# (new java.io.StringWriter) [output results]
               (binding [*out* s#]
-                (let [result (pr-str (eval (load-string
+                (let [result (pr-str (eval (read-string
                                             (get-in message [:content :code]))))
                       output (str s#)]
                   [output, result]))]


some useful msg when tests are failed

some useful msg when tests are failed

--- src/leiningen/namespaces.clj
+++ src/leiningen/namespaces.clj
@@ -170,7 +170,7 @@
   (let [result (apply sh/sh cmd)]
     (if (u/is-success? result)
       {:result :passed}
-      {:result :failed :cmd cmd})))
+      {:result :failed :cmd (str/join " " cmd)})))

 (defn lein-test [project]
   (m/info "\n... Executing tests of" project "on" (u/output-of (sh/sh "pwd")) "\n")
@@ -181,10 +181,10 @@
                         (first))]
     (if (empty? failed-cmd)
       (do
-        (m/info "===> All Tests of" project "are passed\n")
+        (m/info "===> All tests of" project "are passed\n")
         {:project project :result :passed})
       (do
-        (m/info "===> Some Tests of" project "are FAILED!!!\n")
+        (m/info "===> Some tests when running" (:cmd failed-cmd) project "are FAILED!!!\n")
         {:project project :result :failed}))))

 (defn reset-project! [project]


add docstring

add docstring

--- src/overtone/sc/synth.clj
+++ src/overtone/sc/synth.clj
@@ -216,7 +216,9 @@

 ; TODO: This should eventually handle optional rate specifiers, and possibly
 ; be extended with support for defining ranges of values, etc...
-(defn- control-proxies [params]
+(defn- control-proxies
+  "Converts a list of alternating param-name param-values to param-name control-proxies"
+  [params]
   (reduce (fn [mem [pname pval]]
             (concat mem [(symbol pname) `(control-proxy ~pname ~pval)]))
           []


housekeeping

housekeeping

--- src/pep_027/solution1.clj
+++ src/pep_027/solution1.clj
@@ -23,9 +23,7 @@
       (first ab-set)
       (recur
         (inc n)
-        (filter
-          (fn [[a b]]
-            (prime? (quad-prime a b n))) ab-set)))))
+        (filter (fn [[a b]] (prime? (quad-prime a b n))) ab-set)))))

 (defn solve [n]
   (let [[a b] (find-ab-max (ab-candidate n))]


click on a route deletes rendering others

--- src-cljs/flatride/frontend.cljs
+++ src-cljs/flatride/frontend.cljs
@@ -21,6 +21,7 @@
           "center" latlng))

 (def stroke-colors ["red" "green" "blue" "yellow" "purple"])
+(def *directionDisplays* (atom []))

 (defn display-routes [routes-data]
   (doseq [route (:routes-data routes-data)]
@@ -43,17 +44,22 @@
             (js-obj "polylineOptions" (js-obj "strokeColor" (stroke-colors idx))))]
       (.setMap directionsDisplay *mapInstance*)
       (.setDirections directionsDisplay (:to-display routes-data))
-      (.setRouteIndex directionsDisplay idx))))
+      (.setRouteIndex directionsDisplay idx)
+      (swap! *directionDisplays* conj {:idx idx :obj directionsDisplay}))))

-(defn select-route [evt]
-  (log evt))
+(defn select-route [idx evt]
+  (when (> (count @*directionDisplays*) 1)
+    (let [obsolete-displays (map #(:obj %) (filter #(= (:idx %) idx) @*directionDisplays*))]
+      (doseq [display obsolete-displays]
+        (.setMap display nil))
+      (swap! *directionDisplays* (partial remove #(= (:idx %) idx))))))

 (defn display-elevations [{idx :idx
                            longest-slope :longest-slope
                            steepest-slope :steepest-slope}]
   (let [div (nth (sel :div.route-data) idx)]
     (dommy/set-attr! div "id" (str "route-" idx))
-    (dommy/listen! div :click select-route))
+    (dommy/listen! div :click (partial select-route idx)))
   (let [ul (nth (sel :ul.route-card) idx)]
     (dommy/append! ul (node [:li "The longest slope is "
                                   (->> longest-slope slope-percent (gstring/format "%.2f%%"))


Validate command line arguments

Validate command line arguments

--- src/leiningen/new/chestnut.clj
+++ src/leiningen/new/chestnut.clj
@@ -19,26 +19,13 @@
 (defn indent [n list]
   (wrap-indent identity n list))

-(defn http-kit? [opts]
-  (some #{"--http-kit"} opts))
+(def valid-options
+  ["http-kit" "site-middleware" "om-tools" "cljx" "less" "sass" "speclj"])

-(defn site-middleware? [opts]
-  (some #{"--site-middleware"} opts))
-
-(defn om-tools? [opts]
-  (some #{"--om-tools"} opts))
-
-(defn cljx? [opts]
-  (some #{"--cljx"} opts))
-
-(defn less? [opts]
-  (some #{"--less"} opts))
-
-(defn sass? [opts]
-  (some #{"--sass"} opts))
-
-(defn speclj? [opts]
-  (some #{"--speclj"} opts))
+(doseq [opt valid-options]
+  (eval
+   `(defn ~(symbol (str opt "?")) [opts#]
+     (some #{~(str "--" opt)} opts#))))

 (defn server-clj-requires [opts]
   (if (http-kit? opts)
@@ -162,6 +149,10 @@
     (cons data (map render-file (files-to-render opts)))))

 (defn chestnut [name & opts]
+  (let [valid-opts (map (partial str "--") valid-options)]
+    (doseq [opt opts]
+      (if (not (some #{opt} valid-opts))
+        (apply main/abort "Unrecognized option:" opt ". Should be one of" valid-opts))))
   (main/info "Generating fresh Chestnut project.")
   (main/info "README.md contains instructions to get you started.")
   (apply ->files (format-files-args name opts)))


list will be not generated when empty

list will be not generated when empty

--- src/re_complete/core.cljs
+++ src/re_complete/core.cljs
@@ -13,13 +13,14 @@
          items-to-re-complete (subscribe [:get-items-to-complete linked-component-keyword])
          current-word (subscribe [:get-previous-input linked-component-keyword])]
      (fn []
-       (when-not (string/blank? @current-word)
-         (into [:ul.re-completion-list]
-               (map (fn [item]
-                      [:li.re-completion-item
-                       {:on-click #(do (dispatch [:add-completed-word linked-component-keyword item])
-                                       (dispatch [:clear-complete-items linked-component-keyword])
-                                       (when onclick-callback
-                                         (onclick-callback %)))}
-                       item])
-                    @items-to-re-complete)))))))
+       (when-not (empty? @items-to-re-complete)
+         (when-not (string/blank? @current-word)
+           (into [:ul.re-completion-list]
+                 (map (fn [item]
+                        [:li.re-completion-item
+                         {:on-click #(do (dispatch [:add-completed-word linked-component-keyword item])
+                                         (dispatch [:clear-complete-items linked-component-keyword])
+                                         (when onclick-callback
+                                           (onclick-callback %)))}
+                         item])
+                      @items-to-re-complete))))))))


Accessors for fact metadata

Accessors for fact metadata

--- src/midje/ideas/metadata.clj
+++ src/midje/ideas/metadata.clj
@@ -1,9 +1,22 @@
 (ns ^{:doc "Metadata is attached to facts and fact tables"}
   midje.ideas.metadata
-  (:use [midje.ideas.arrows :only [start-of-checking-arrow-sequence?]]))
+  (:use [midje.ideas.arrows :only [start-of-checking-arrow-sequence?]])
+  (:require [clojure.string :as str]))

 (def ^{:dynamic true} metadata-for-fact-group {})

+
+;;; Loaded facts are stored as functions with this metadata:
+
+(def fact-properties
+  [:midje/source :midje/file :midje/line :midje/true-name :midje/namespace
+   :midje/name :midje/description])
+
+(doall (map (fn [property]
+              (intern *ns* (symbol (str "fact-" (name property)))
+                      (fn [fact-function]
+                        (property (meta fact-function)))))
+            fact-properties))

 (defn separate-metadata [fact-form]
   (letfn [(basic-parse [metadata body]


Tweaked language a bit from read/write to input/output to better reflect semantic processing focus

--- src/semantic_csv/core.clj
+++ src/semantic_csv/core.clj
@@ -18,11 +18,12 @@
 ;; ## Structure
 ;;
 ;; Semantic CSV _emphasizes_ a number of individual processing functions which can operate on the output of a
-;; syntactic csv parser such as `clojure.data.csv` or `clojure-csv`.
+;; syntactic csv parser such as `clojure.data.csv` or `clojure-csv`, or be used as preprocessing step when
+;; writing data using these tools.
 ;; This reflects a nice decoupling of grammar and semantics, in an effort to make this library as composable
 ;; and interoperable as possible.
-;; However, as a convenience, we offer a few functions which wrap these individual steps with a set of
-;; opinionated defaults and an option map for overriding the default behaviour.
+;; However, as a convenience, we also offer a few functions wrapping these individual steps with a set of
+;; opinionated defaults which can be customized.
 ;;
 ;;

@@ -43,13 +44,13 @@
 ;;              '[clojure-csv.core :as csv]
 ;;              '[clojure.java.io :as io])
 ;;
-;; Now let's take a tour through some of the processing functions we have available, starting with the reader
-;; functions.
+;; Now let's take a tour through some of the processing functions we have available, starting with the input
+;; processing functions.
 ;;
 ;;

-;; # Reader functions
+;; # Input processing functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; Note that all of these processing functions leave the rows collection as the final argument.
@@ -253,19 +254,19 @@
 ;;                        :cast-fns {:this ->int})

-;; # Writer functions
+;; # Output processing functions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; As with the input processing functions, the output processing functions are designed to be small, modular
-;; peices you compose as you see fit.
+;; peices you compose together.
 ;; Using these it's expected that you push your data through the processing functions and into a third party
 ;; writer.
-;; But also as with the readers, we offer some higher level, default-opinionated, configurable functions that
-;; do this composing for you, while the emphasis of the library remains with the composable functions.
+;; But as with the input processing functions, we offer some higher level, opinionated but configurable functions
+;; which automate some of this for you.
 ;;
 ;; One of the first things we'll need is a function that takes a sequence of maps and turns it into a sequence
-;; of vectors given column name order:
+;; of vectors since this is what most of our csv writing/formatting libraries will want.

 ;; ## vectorize

@@ -420,8 +421,8 @@
               w)
             file)))))

-;; Like `slurp-and-process`, this is a convenience function which wraps together a set of opinionated options,
-;; ultimately writing out all data to the specified file handle or filename.
+;; Like `slurp-and-process`, this is a convenience function which wraps together a set of opinionated options
+;; writing data to the specified file handle or filename.
 ;; Note that since we use `clojure-csv` here, we offer a `:batch` option that lets you format and write small
 ;; batches of rows out at a time, to avoid contructing a massive string representation of all the data in the
 ;; case of bigger data sets.


Cleaned up comment removal flow

Cleaned up comment removal flow

--- src/semantic_csv/core.clj
+++ src/semantic_csv/core.clj
@@ -123,9 +123,9 @@
   ([rows]
    (remove-comments {:comment-re #"^\#"} rows))
   ([{:keys [comment-re comment-char]} rows]
-   (let [commented? (if comment-re
-                      (partial re-find comment-re)
-                      #(= comment-char (first %)))]
+   (let [commented? (if comment-char
+                      #(= comment-char (first %))
+                      (partial re-find comment-re))]
      (remove
        (fn [row]
          (let [x (first row)]
@@ -260,19 +260,20 @@
   * `:mappify` - bool; transform rows from vectors into maps using `mappify`.
   * `:header` - specify header to be used in mappify; as per `mappify`, first row will not be consumed as header
   * `:structs` - bool; use structs instead of array-maps or hash-maps in mappify.
-  * `:comment-re` - specify a regular expression to use for commenting out lines, or something falsey
-     if filtering out comment lines is not desired.
-  * `:remove-empty` - also remove empty rows? Defaults to true.
+  * `:remove-comments` - bool; remove comment lines, as specified by `:comment-re` or `:comment-char`. Also
+     removes empty lines. Defaults to `true`.
+  * `:comment-re` - specify a regular expression to use for commenting out lines.
+  * `:comment-char` - specify a comment character to use for filtering out comments; overrides comment-re.
   * `:cast-fns` - optional map of `colname | index -> cast-fn`; row maps will have the values as output by the
      assigned `cast-fn`."
-  ([{:keys [comment-re comment-char mappify header structs remove-empty cast-fns]
-     :or   {comment-re   #"^\#"
-            mappify      true
-            remove-empty true}
+  ([{:keys [remove-comments comment-re comment-char mappify header structs cast-fns]
+     :or   {remove-comments true
+            comment-re   #"^\#"
+            mappify      true}
      :as opts}
     rows]
    (->> rows
-        (?>> comment-re (remove-comments {:comment-re comment-re}))
+        (?>> remove-comments (semantic-csv.core/remove-comments {:comment-re comment-re :comment-char comment-char}))
         (?>> mappify (semantic-csv.core/mappify {:header header :structs structs}))
         (?>> cast-fns (cast-with cast-fns))))
   ; Use all defaults


add Get* and List* to PowerUser

add Get* and List* to PowerUser

--- src/aws_overlord/tasks/security.clj
+++ src/aws_overlord/tasks/security.clj
@@ -31,30 +31,15 @@
   {
    "Statement" [{"Effect" "Allow"
                  "Resource" "*"
-                 "Action" ["iam:CreateRole"
+                 "Action" ["iam:AddRoleToInstanceProfile"
+                           "iam:CreateRole"
                            "iam:CreateInstanceProfile"
-                           "iam:AddRoleToInstanceProfile"
+                           "iam:DeleteInstanceProfile"
+                           "iam:DeleteRole"
+                           "iam:List*"
+                           "iam:Get*"
                            "iam:PassRole"
-                           "iam:ListVirtualMFADevices"
-                           "iam:ListUsers"
-                           "iam:ListUserPolicies"
-                           "iam:ListSigningCertificates"
-                           "iam:ListServerCertificates"
-                           "iam:ListSAMLProviders"
-                           "iam:ListRoles"
-                           "iam:ListRolePolicies"
-                           "iam:ListMFADevices"
-                           "iam:ListInstanceProfilesForRole"
-                           "iam:ListInstanceProfiles"
-                           "iam:ListGroupsForUser"
-                           "iam:ListGroups"
-                           "iam:ListGroupPolicies"
-                           "iam:ListAccountAliases"
-                           "iam:ListAccessKeys"
-                           "iam:GetAccountSummary"
-                           "iam:GetInstanceProfile"
-                           "iam:GetLoginProfile"
-                           "iam:GetRolePolicy"
+                           "iam:RemoveRoleFromInstanceProfile"
                            ; FIXME: PutRolePolicy allows privilege escalation!
                            "iam:PutRolePolicy"]}
                 {"Effect" "Allow"


Fallback to created-at for sorting even in recently-published sort.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -44,12 +44,14 @@
                                            left
                                            right)))
                                        (r/default (r/fn [_err]
-                                        {"created-at" (if (r/eq (r/get-field post-row "status") "published")
+                                        {"created-at" (if (r/has-fields post-row "published-at")
                                                         (r/get-field post-row "published-at")
                                                         (r/get-field post-row "created-at"))}))
                                        (r/do (r/fn [interaction-row]
                                          (r/get-field interaction-row "created-at"))))}
-                {:last-activity-at (r/get-field post-row :published-at)})))
+                {:last-activity-at (if (r/has-fields post-row "published-at")
+                                     (r/get-field post-row "published-at")
+                                     (r/get-field post-row "created-at"))})))
             (if (sequential? allowed-boards)
               ;; Filter out entries that don't belong
               (r/filter query (r/fn [post-row]


Prevent dangling publications.

Prevent dangling publications.

[ci skip]

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -446,10 +446,15 @@
           ctx (-> (Aeron$Context.)
                   (.errorHandler error-handler))
           conn (Aeron/connect ctx)
-          pub (.addPublication conn channel stream-id)]
-      (swap! publications assoc [channel stream-id] {:conn conn
-                                                     :pub pub})
-      pub)))
+          pub (.addPublication conn channel stream-id)
+          v {:conn conn :pub pub}
+          rets (swap! publications assoc [channel stream-id] v)]
+      (if (= (get rets [channel stream-id]) v)
+        pub
+        (do (prn "Enountered a race! Closing one of them.")
+            (.close pub)
+            (.close conn)
+            (:pub (get rets [channel stream-id])))))))

 (defn write [^Publication pub ^UnsafeBuffer buf]
   ;; Needs an escape mechanism so it can break if a peer is shutdown