adds the clear text from chat input on submit, can now submit hitting Enter

--- src/client/chat/core.cljs
+++ src/client/chat/core.cljs
@@ -30,13 +30,26 @@
   ([user color msg] (let [chat (.getElementById js/document "chat-messages")]
                 (.append ($ chat) (chat-msg-html user color msg)))))

+(defn clear-message
+  "Clear the current message in the input field"
+  []
+  (let [input (.getElementById js/document "msg")]
+    (aset input "value" "")))
+
+(defn submit-message
+  "adds a message, sends it and then removes it"
+  []
+  (add-message (get-username) (get-color) (get-message))
+  (send-message)
+  (clear-message))
+
 (defn init
   "Starts the chat page"
   []
   ;; Add listeners
-  (.click ($ "#submit") #(do (add-message (get-username) (get-color) (get-message))
-                             (send-message)))
-
+  (.click ($ "#submit") submit-message)
+  (.keyup ($ "#msg") #(if (= (.-keyCode %) 13) (submit-message)))
+
   ;; Server messages
   (.on @socket "new-message" #(add-message (read-string %))))


adds the theme save/load functionality

adds the theme save/load functionality

--- src/client/game/core.cljs
+++ src/client/game/core.cljs
@@ -317,6 +317,22 @@
     (swap! state assoc :position [x ny])
     (lock-piece!)))

+(defn change-theme!
+  "Changes the boards theme"
+  [theme year platform event]
+  (.preventDefault event)
+  (swap! state assoc :theme theme)
+  (.html ($ "#theme") year)
+  (.html ($ "#theme-details") platform)
+  (aset js/localStorage "theme" theme))
+
+(defn load-theme!
+  "Loads a theme if theres one saved in localStorage"
+  []
+  (if-let [theme (aget js/localStorage "theme")]
+    (swap! state assoc :theme theme)
+    ""))
+
 (defn add-key-events
   "Add all the key inputs."
   []
@@ -341,57 +357,16 @@
         key-name #(-> % .-keyCode key-names)
         key-down (fn [e]
                    (case (key-name e)
-                     :one (do
-                            (swap! state assoc :theme 0)
-                            (.preventDefault e)
-                            (.html ($ "#theme") "1984")
-                            (.html ($ "#theme-details") "Electronika 60"))
-                     :two (do
-                            (swap! state assoc :theme 1)
-                            (.preventDefault e)
-                            (.html ($ "#theme") "1986")
-                            (.html ($ "#theme-details") "MS DOS"))
-                     :three (do
-                              (swap! state assoc :theme 2)
-                              (.preventDefault e)
-                              (.html ($ "#theme") "1986")
-                              (.html ($ "#theme-details") "Tengen/Atari Arcade"))
-                     :four (do
-                             (swap! state assoc :theme 3)
-                             (.preventDefault e)
-                             (.html ($ "#theme") "1989")
-                             (.html ($ "#theme-details") "Gameboy"))
-                     :five (do
-                             (swap! state assoc :theme 4)
-                             (.preventDefault e)
-                             (.html ($ "#theme") "1989")
-                             (.html ($ "#theme-details") "NES"))
-                     :six (do
-                            (swap! state assoc :theme 5)
-                            (.preventDefault e)
-                            (.html ($ "#theme") "1989")
-                            (.html ($ "#theme-details") "Sega Genesis"))
-                     :seven (do
-                              (swap! state assoc :theme 6)
-                              (.preventDefault e)
-                              (.html ($ "#theme") "1998")
-                              (.html ($ "#theme-details") "Gameboy color"))
-                     ;; TODO: Reorder themes here
-                     :eight (do
-                              (swap! state assoc :theme 7)
-                              (.preventDefault e)
-                              (.html ($ "#theme") "2000")
-                              (.html ($ "#theme-details") "TI-83"))
-                     :nine (do
-                             (swap! state assoc :theme 8)
-                             (.preventDefault e)
-                             (.html ($ "#theme") "2002")
-                             (.html ($ "#theme-details") "Flash"))
-                     :zero (do
-                             (swap! state assoc :theme 9)
-                             (.preventDefault e)
-                             (.html ($ "#theme") "2012")
-                             (.html ($ "#theme-details") "Facebook"))
+                     :one   (change-theme! 0 "1984" "Electronika 60" e)
+                     :two   (change-theme! 1 "1986" "MS DOS" e)
+                     :three (change-theme! 2 "1986" "Tengen/Atari Arcade" e)
+                     :four  (change-theme! 3 "1989" "Gameboy" e)
+                     :five  (change-theme! 4 "1989" "NES" e)
+                     :six   (change-theme! 5 "1989" "Sega Genesis" e)
+                     :seven (change-theme! 6 "1998" "Gameboy color" e)
+                     :eight (change-theme! 7 "2000" "TI-83" e)
+                     :nine  (change-theme! 8 "2002" "Flash" e)
+                     :zero  (change-theme! 9 "2012" "Facebook" e)
                      nil)
                    (if (:piece @state)
                      (case (key-name e)
@@ -450,7 +425,8 @@
 (defn init []

   (init-state!)
-
+  (load-theme!)
+
   (size-canvas! "game-canvas" empty-board cell-size rows-cutoff)
   (size-canvas! "next-canvas" (next-piece-board) cell-size)


change cljs.analyzer/analyze-file internally to return the ns of the analyzed file as a local in a let, prep to write out the analysis cache file.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -1640,9 +1640,15 @@
              (binding [*cljs-ns* 'cljs.user
                        *cljs-file* path
                        reader/*alias-map* (or reader/*alias-map* {})]
-               (let [env (empty-env)]
-                 (doseq [form (seq (forms-seq res))]
-                   (let [env (assoc env :ns (get-namespace *cljs-ns*))]
-                     (analyze env form nil opts)))))
-             (swap! env/*compiler* assoc-in [::analyzed-cljs path] true)))))))
-
+               (let [env (empty-env)
+                     ns  (loop [ns nil forms (seq (forms-seq res))]
+                           (if forms
+                             (let [form (first forms)
+                                   env  (assoc env :ns (get-namespace *cljs-ns*))
+                                   ast  (analyze env form)]
+                               (if (= (:op ast) :ns)
+                                 (recur (:name ast) (next forms))
+                                 (recur ns (next forms))))
+                             ns))]
+                 (swap! env/*compiler* assoc-in [::analyzed-cljs path] true)))))))))
+


Broke out the set.

Broke out the set.

--- src/clj/forma/testing.clj
+++ src/clj/forma/testing.clj
@@ -43,13 +43,12 @@

 ;; ### Midje Testing

-(def prereq-keywords
-  #{'provided
-    'against-background})
+(defn  first-elem?  [elem x]
+  (and (coll? x)
+       (#{elem} (first x))))

-(defn  prereq?  [x]
-  (or (not (coll? x))
-      ((complement prereq-keywords) (first x))))
+(def background? (partial first-elem? 'against-background))
+(def provided? (partial first-elem? 'provided))

 (defn- reformat
   "deal with the fact that the first item might be a logging level
@@ -60,7 +59,8 @@
                          [nil bindings])
         [pre bindings] (->> bindings
                             (remove string?)
-                            ((juxt remove filter) prereq?))]
+                            ((juxt filter remove) #(or (background? %)
+                                                       (provided? %))))]
     [kwd bindings pre]))

 (defn process-results


Make `reference-repo` an optional setting.

--- src/clj/runbld/schema.clj
+++ src/clj/runbld/schema.clj
@@ -89,7 +89,7 @@
 (def OptsScm
   {:clone s/Bool
    :url s/Str
-   :reference-repo s/Str})
+   (s/optional-key :reference-repo) s/Str

 (def Opts
   {:job-name   s/Str


Note about default board

Note about default board

--- src/clj_bots/pin_ctrl.clj
+++ src/clj_bots/pin_ctrl.clj
@@ -72,6 +72,9 @@
   [pin]
   (board-apply available-pin-modes pin))

+;; I'm actually not sure if this is a good idea or not.
+;; Given how much other dispatching there is going on, this would complicate things, and it would also make
+;; basically every function in the api a defmethod, which is a little annoying for docstrings.

 (defn set-default-board!
   "Set the default board implementation"


remove deprecated class usage in conn-mgr namespace

--- src/clj_http/conn_mgr.clj
+++ src/clj_http/conn_mgr.clj
@@ -4,23 +4,16 @@
             [clojure.java.io :as io])
   (:import (java.net Socket Proxy Proxy$Type InetSocketAddress)
            (java.security KeyStore)
-           (java.security.cert X509Certificate)
-           (javax.net.ssl SSLSession SSLSocket)
            (org.apache.http.config RegistryBuilder Registry)
            (org.apache.http.conn HttpClientConnectionManager)
-           (org.apache.http.conn.ssl SSLSocketFactory)
-           (org.apache.http.conn.scheme PlainSocketFactory
-                                        SchemeRegistry Scheme)
+           (org.apache.http.conn.ssl DefaultHostnameVerifier
+                                     NoopHostnameVerifier
+                                     SSLConnectionSocketFactory
+                                     SSLContexts
+                                     TrustStrategy)
            (org.apache.http.conn.socket PlainConnectionSocketFactory)
-           (org.apache.http.impl.conn PoolingClientConnectionManager)
            (org.apache.http.impl.conn BasicHttpClientConnectionManager
-                                      PoolingHttpClientConnectionManager)
-           (org.apache.http.conn.ssl SSLConnectionSocketFactory
-                                     DefaultHostnameVerifier
-                                     NoopHostnameVerifier
-                                     TrustStrategy)
-           (org.apache.http.ssl SSLContexts)
-           (org.apache.http.pool ConnPoolControl)))
+                                      PoolingHttpClientConnectionManager)))

 (def ^SSLConnectionSocketFactory insecure-socket-factory
   (SSLConnectionSocketFactory.
@@ -33,23 +26,22 @@
 (def ^SSLConnectionSocketFactory secure-ssl-socket-factory
   (SSLConnectionSocketFactory/getSocketFactory))

-;; New Generic Socket Factories that can support socks proxy
-(defn ^SSLSocketFactory SSLGenericSocketFactory
-  "Given a function that returns a new socket, create an SSLSocketFactory that
-  will use that socket."
+(defn ^SSLConnectionSocketFactory SSLGenericSocketFactory
+  "Given a function that returns a new socket, create an
+  SSLConnectionSocketFactory that will use that socket."
   [socket-factory]
-  (proxy [SSLSocketFactory] [(SSLContexts/createDefault)]
-    (connectSocket [socket remoteAddress localAddress params]
-      (let [^SSLSocketFactory this this] ;; avoid reflection
-        (proxy-super connectSocket (socket-factory)
-                     remoteAddress localAddress params)))))
+  (proxy [SSLConnectionSocketFactory] [(SSLContexts/createDefault)]
+    (connectSocket [timeout socket host remoteAddress localAddress context]
+      (let [^SSLConnectionSocketFactory this this] ;; avoid reflection
+        (proxy-super connectSocket timeout (socket-factory) remoteAddress
+                     localAddress context)))))

-(defn ^PlainSocketFactory PlainGenericSocketFactory
-  "Given a Function that returns a new socket, create a PlainSocketFactory that
-  will use that socket."
+(defn ^PlainConnectionSocketFactory PlainGenericSocketFactory
+  "Given a Function that returns a new socket, create a
+  PlainConnectionSocketFactory that will use that socket."
   [socket-factory]
-  (proxy [PlainSocketFactory] []
-    (createSocket [params]
+  (proxy [PlainConnectionSocketFactory] []
+    (createSocket [context]
       (socket-factory))))

 (defn socks-proxied-socket
@@ -62,12 +54,11 @@
   proxied using a SOCKS proxy."
   [^String hostname ^Integer port]
   (let [socket-factory #(socks-proxied-socket hostname port)
-        reg (doto (SchemeRegistry.)
-              (.register
-               (Scheme. "https" 443 (SSLGenericSocketFactory socket-factory)))
-              (.register
-               (Scheme. "http" 80 (PlainGenericSocketFactory socket-factory))))]
-    (PoolingClientConnectionManager. reg)))
+        reg (-> (RegistryBuilder/create)
+                (.register "http" (PlainGenericSocketFactory socket-factory))
+                (.register "https" (SSLGenericSocketFactory socket-factory))
+                (.build))]
+    (PoolingHttpClientConnectionManager. reg)))

 (def insecure-scheme-registry
   (-> (RegistryBuilder/create)


collection readers

collection readers

--- src/cljs/cljs/reader.cljs
+++ src/cljs/cljs/reader.cljs
@@ -20,7 +20,7 @@
 (deftype StringPushbackReader [state]
   PushbackReader
   (read-char [reader] (let [original @state]
-                      (reset! state (subs 1 original))
+                      (reset! state (subs original 1))
                       (first original)))
   (unread [reader ch] (reset! state (str ch @state))))

@@ -28,7 +28,9 @@
   "Creates a StringPushbackReader from a given string"
   (StringPushbackReader. (atom s)))

-;; Helper functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; predicates
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn- whitespace?
   "Checks whether a given character is whitespace"
@@ -60,17 +62,24 @@

 (defn- list-prefix?
   "Checks whether the char is the start of a list literal"
-  [ch])
+  [ch]
+  (= ch "("))

 (defn- vector-prefix?
   "Checks whether the char is the start of a vector literal"
-  [ch])
+  [ch]
+  (= ch "["))

-(defn- map-literal?
+(defn- map-prefix?
   "Checks whether the char is the start of a map literal"
-  [ch])
+  [ch]
+  (= ch "{"))

-(declare read)
+(declare read rmacros)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; read helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn- skip-line
   "Advances the reader to the end of a line. Returns the reader"
@@ -80,45 +89,83 @@
       reader
       (recur reader))))

+(defn read-past
+  "Read until first character that doesn't match pred, returning
+   char."
+  [pred rdr]
+  (loop [ch (read-char rdr)]
+    (if (pred ch)
+      (recur (read-char rdr))
+      ch)))
+
+(defn read-delimited-list
+  [delim rdr recursive?]
+  (loop [a ()]
+    (let [ch (read-past whitespace? rdr)]
+      (when-not ch (throw "EOF"))
+      (if (= delim ch)
+        a
+        (if-let [macrofn (get rmacros ch)]
+          (let [mret (macrofn rdr ch)]
+            (recur (if (= mret rdr) a (conj a mret))))
+          (do
+            (unread rdr ch)
+            (let [o (read rdr true nil recursive?)]
+              (recur (if (= o rdr) a (conj a o))))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; data structure readers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn read-list
+  [rdr _]
+  (read-delimited-list ")" rdr true))
+
+(defn read-vector
+  [rdr _]
+  (vec (read-delimited-list "]" rdr true)))
+
+(defn read-map
+  [rdr _]
+  (let [l (read-delimited-list "}" rdr true)]
+    (when (odd? (count l))
+      (throw "Map literal must contain an even number of forms"))
+    (apply hash-map l)))
+
+(defn read-set
+  [rdr _]
+  (set (read-delimited-list "}" rdr true)))
+
+(def rmacros
+  {"{" read-set})
+
 (defn read-number
   [reader initch])

 (defn read-string
   [reader initch])

-
-(defn read-list
-  [reader initch is-recursive])
-
-(defn read-vector
-  [reader initch is-recursive])
-
-(defn read-map
-  [reader initch is-recursive])
-
 (defn read-symbol
   [reader initch is-recursive])
-

 (defn read
   "Reads the first object from a PushbackReader. Returns the object read.
 Returns sentinel if the reader did not contain any forms."
   [reader eof-is-error sentinel is-recursive]
-  (let [ch read-char]
-    (if (not (nil? ch))
-      (cond
-       (whitespace? ch) (recur reader)
-       (comment-prefix? ch) (recur (skip-line reader))
-       (number-literal? reader) (read-number reader ch)
-       (string-prefix? ch) (read-string reader ch)
-       (list-prefix? ch) (read-list reader ch is-recursive)
-       (vector-prefix? ch) (read-vector reader ch is-recursive)
-       (map-prefix? ch) (read-map reader ch is-recursive)
-       :default (read-symbol reader ch)))
-    sentinel))
+  (let [ch (read-char reader)]
+    (cond
+     (nil? ch) sentinel
+     (whitespace? ch) (recur reader eof-is-error sentinel is-recursive)
+     (comment-prefix? ch) (recur (skip-line reader) eof-is-error sentinel is-recursive)
+     (number-literal? reader) (read-number reader ch)
+     (string-prefix? ch) (read-string reader ch)
+     (list-prefix? ch) (read-list reader ch)
+     (vector-prefix? ch) (read-vector reader ch)
+     (map-prefix? ch) (read-map reader ch)
+     :default (read-symbol reader ch))))

 (defn read-all
   "Reads a lazy sequence of objects from a reader."
   [reader]
-  (lazy-seq (cons (read reader) (read-all reader))))+  (lazy-seq (cons (read reader) (read-all reader))))


Non-firebase districts and translated categories

--- src/cljs/geoforms/db.cljs
+++ src/cljs/geoforms/db.cljs
@@ -1,4 +1,5 @@
 (ns geoforms.db
+  (:require-macros [reagent.ratom :refer [reaction]])
   (:require [clojure.string :as str]
             [matchbox.core :as m]
             [matchbox.atom :as ma]
@@ -88,6 +89,21 @@
    :80-84
    :85+])

+(def category-translations
+  (atom {:en ["Greening"
+              "Mobility"
+              "Infrastructure"
+              "Shops"
+              "Activities"
+              "Habitation"
+              "Other"]
+         :fr ["Verdissement"
+              "Mobilité"
+              "Infrastructure"
+              "Commerces"
+              "Activités"
+              "Habitations"
+              "Autre"]}))

 ;; atoms

@@ -95,9 +111,22 @@

 (def ideas (mr/sync-r ideas-ref (comp ->id-vec sort)))

-(def categories (mr/sync-list categories-ref))
-
-(def districts (mr/sync-list districts-ref))
+(def categories (reaction (get @category-translations @language)))
+
+(def districts
+  (atom ["Beauport"
+         "Charlesbourg"
+         "Lairet"
+         "Maizerets"
+         "Méandres"
+         "Montcalm"
+         "Saint-Jean-Baptiste"
+         "Saint-Roch"
+         "Saint-Sauveur"
+         "Sainte-Foy"
+         "Sillery"
+         "Vieux-Limoilou"
+         "Autre"]))

 (def supported-ideas (atom #{}))


Format code.

Format code.

--- src/cljs/tunnit/core.cljs
+++ src/cljs/tunnit/core.cljs
@@ -51,41 +51,42 @@
   (map-kv day-map count-date))

 (defcomponent project-entries [app]
-              (render [this]
-                      (ot/div
-                        (map (fn [project]
-                               (ot/div {:class "project-row"}
-                               (for [day (range 1 8)]
-                                 (let [hours
-                                       (get-in project [:entries day :hours])]
-                                   (println "day: " day "hours: " hours)
-                                   (ot/input {:class "hour-entry" :value hours})
-                                   )
-                                 )))
-                               (:projects app)
-                             ))
-                      ))
+  (render [this]
+    (ot/div
+      (map (fn [project]
+             (ot/div {:class "project-row"}
+
+                     (for [day (range 1 8)]
+                       (let [hours
+                             (get-in project [:entries day :hours])]
+                         (println "day: " day "hours: " hours)
+                         (ot/input {:class "hour-entry" :value hours})
+                         )
+                       )))
+           (:projects app)
+           ))
+    ))

 (defcomponent week-view [app]
-              (render [this]
-                      (ot/div {:class "week-row"}
-                              (map (fn [[key day]]
-                                     (ot/div {:class "day-col"}
-                                             (ot/output {:class "day-label"}
-                                                        (str (:name day) " " (unparse-date (:date day))))
-                                             ))
-                                   (week-dates))
-                              )))
+  (render [this]
+    (ot/div {:class "week-row"}
+            (map (fn [[key day]]
+                   (ot/div {:class "day-col"}
+                           (ot/output {:class "day-label"}
+                                      (str (:name day) " " (unparse-date (:date day))))
+                           ))
+                 (week-dates))
+            )))

 (defcomponent app-view [app owner]
-              (render [this]
-                      (print (f/show-formatters))
-                      (ot/div {:class "column-main"}
-                              (dom/h1 nil (str (:text app) " " (:date app)))
-                              (om/build week-view app)
-                              (om/build project-entries app)
-                              )
-                      ))
+  (render [this]
+    (print (f/show-formatters))
+    (ot/div {:class "column-main"}
+            (dom/h1 nil (str (:text app) " " (:date app)))
+            (om/build week-view app)
+            (om/build project-entries app)
+            )
+    ))

 (defn main []
   (om/root


Delay between frames is optional

Delay between frames is optional

--- src/clojure/gift/core.clj
+++ src/clojure/gift/core.clj
@@ -13,12 +13,21 @@

 Usage: (make-gif \"move.gif\" [\"person1.jpg\" \"person2.jpg\"])

+Additional properties:\n
+  :delay - time in milliseconds between frames (default 200)
+
 "
-  [output-path images]
+  [output-path images
+   & {:keys [delay]
+      :or {delay 200}}]
   (let [encoder (-> (doto (gift.AnimatedGifEncoder. )
                       (.start output-path)
-                      (.setDelay 200) ;; milliseconds
-                      (.setRepeat 0)))]
+                      (.setRepeat 0)
+                      (.setDelay delay) ;; milliseconds
+                      ))]
     (doseq [i images]
       (.addFrame encoder (read-image i)))
     (.finish encoder)))
+
+;; TODO iterations does not work?
+;; TODO gif quality


send request emails to the owner

send request emails to the owner

--- src/pc/email.clj
+++ src/pc/email.clj
@@ -170,7 +170,7 @@
         doc-id (:db/id doc)
         doc-owner (cust-model/find-by-id db (:document/creator doc))]
     (mailgun/send-message {:from "Precursor <joinme@prcrsr.com>"
-                           :to (:cust/email requester)
+                           :to (:cust/email doc-owner)
                            :subject (str (format-requester requester)
                                          " wants access to your document on Precursor")
                            :text (str "Hey there,\nSomeone wants access to your document on Precursor: https://prcrsr.com/document" doc-id
@@ -179,7 +179,7 @@
                            :o:tracking "yes"
                            :o:tracking-opens "yes"
                            :o:tracking-clicks "no"
-                           :o:campaign "access_grant_invites"})))
+                           :o:campaign "access_request"})))

 (defn send-entity-email-dispatch-fn [db email-enum eid] email-enum)


Improve docstring

Improve docstring

--- src/overtone/sc/machinery/ugen/fn_gen.clj
+++ src/overtone/sc/machinery/ugen/fn_gen.clj
@@ -99,7 +99,9 @@
     (mk-scugen spec rate special args)))

 (defn- make-ugen
-  "Create a callable map representing a ugen."
+  "Create a callable map representing a ugen spec and fn for creating a
+   sc-ugen (a datastructure representing a specific instantiation of a
+   ugen given a set of arguments)."
   [spec rate ugen-fn]
   (callable-map {:name       (overtone-ugen-name (:name spec))
                  :summary    (:summary spec)


fixed typo in forma.ops.classify

fixed typo in forma.ops.classify

--- src/clj/forma/ops/classify.clj
+++ src/clj/forma/ops/classify.clj
@@ -11,7 +11,7 @@
   building the vector for the logistic classifier.  The `[1]`
   indicates the mandatory intercept in the logistic regression."
   [forma-val neighbor-val]
-  {:pre [(instance? forma.schema.FormaValueforma-val)
+  {:pre [(instance? forma.schema.FormaValue forma-val)
          (instance? forma.schema.NeighborValue neighbor-val)]}
   (let [[fire short long t-stat break] (thrift/unpack forma-val)
         fire-seq (thrift/unpack fire)


Fix: type on .numQuerySplits

Fix: type on .numQuerySplits

Closes #35.

Signed-off-by: Baptiste Fontaine <b5165a7b35036554758540da420ba755bd52cdab@oscaro.com>

--- src/clj/datasplash/datastore.clj
+++ src/clj/datasplash/datastore.clj
@@ -27,7 +27,7 @@
                    (.withProjectId project-id)
                    (cond-> query (.withQuery query))
                    (cond-> namespace (.withNamespace namespace))
-                   (cond-> num-query-split (.withNumQuerySplit num-query-split)))]
+                   (cond-> num-query-split (.withNumQuerySplits num-query-split)))]
     (apply-transform pcoll ptrans named-schema opts)))

 (declare value->clj)


update Award Bait and Hollywood Renovation messages

--- src/clj/game/cards-agendas.clj
+++ src/clj/game/cards-agendas.clj
@@ -39,7 +39,7 @@
                              {:choices {:req #(or (= (:advanceable %) "always")
                                                   (and (= (:advanceable %) "while-rezzed") (:rezzed %))
                                                   (= (:type %) "Agenda"))}
-                              :msg (msg "add " c " advancement tokens on a card")
+                              :msg (msg "place " c " advancement tokens on " (if (:rezzed target) (:title target) "a card"))
                               :effect (effect (add-prop :corp target :advance-counter c {:placed true}))} card nil)))}}

    "Bifrost Array"
@@ -227,7 +227,7 @@
                                                     (or (= (:advanceable %) "always")
                                                         (and (= (:advanceable %) "while-rezzed") (:rezzed %))
                                                         (= (:type %) "Agenda")))}
-                               :msg (msg "add " n " advancement tokens on "
+                               :msg (msg "place " n " advancement tokens on "
                                          (if (:rezzed target) (:title target) "a card"))
                                :effect (effect (add-prop :corp target :advance-counter n {:placed true}))} card nil)))}}}


Export using the base hyphenation dictionaries

--- src/clj/hyphen_keeper/export.clj
+++ src/clj/hyphen_keeper/export.clj
@@ -39,7 +39,7 @@
    ;; filter the ones that aren't hyphenated correctly
    (remove
     (fn [{:keys [word hyphenation]}]
-      (= (hyphenate/hyphenate word spelling) hyphenation)))
+      (= (hyphenate/hyphenate-against-base word spelling) hyphenation)))
    (map :hyphenation)
    (remove string/blank?) ; drop empty ones
    (filter #(string/includes? % "-")) ; drop hyphenations w/o a hyphen


Use mapcat instead of apply concat map (more idiomatic)

--- src/clj_gatling/simulation.clj
+++ src/clj_gatling/simulation.clj
@@ -128,7 +128,7 @@
 (defn run-scenarios [timeout scenarios]
   (let [results (map (fn [scenario] (thread (run-scenario timeout scenario)))
                      scenarios)]
-    (apply concat (map #(<!! %) results))))
+    (mapcat #(<!! %) results)))

 (defn run-simulation [scenarios users & [options]]
   (let [requests (or (:requests options) (* users (distinct-request-count scenarios)))


Removing unused memento.misc.convert namespace

I’d created it at some point into the past to bootstrap test data,
when I didn’t have the Clojure code to do it. It’s outdated and
unnecessary.

--- src/clj/memento/misc/convert.clj
+++ src/clj/memento/misc/convert.clj
@@ -1,17 +0,0 @@
-(ns memento.misc.convert)
-
-(defn str->sql
-  "Loads a file, and returns a collection of SQL lines necessary to insert
-  them into the database as thoughts."
-  [filename]
-  (let [contents (slurp filename)
-        lines    (clojure.string/split-lines contents)]
-    (->> lines
-         (map read-string)
-         (map #(format "INSERT INTO thoughts (created, username, thought) values ('%s', '%s', '%s');"
-                       (:date %)
-                       (:username %)
-                       (clojure.string/replace (:thought %) "'" "''")
-                       ))
-         )
-    ))


Max dots to 400

Max dots to 400

--- src/cljs/times_tables/app.cljs
+++ src/cljs/times_tables/app.cljs
@@ -2,7 +2,7 @@
   (:require [times-tables.util :as u]))

 (def min-dots 2)
-(def max-dots 200)
+(def max-dots 400)
 (def increment-dots 1)
 (def min-times 2)
 (def max-times 102)


Migrator fix

Migrator fix

--- src/clj/salava/core/migrator.clj
+++ src/clj/salava/core/migrator.clj
@@ -95,7 +95,7 @@

 (defn run-test-reset []
-  (doseq [plugin plugins]
+  (doseq [plugin (plugins)]
     (run-reset (test-ds) plugin)))

@@ -108,7 +108,7 @@

 (defn migrate [& args]
-  (doseq [plugin (or args plugins)]
+  (doseq [plugin (or args (plugins))]
     (log/info "running migrations for plugin" (name plugin))
     (migratus/migrate (migratus-config (dev-ds) plugin)))
   (System/exit 0))
@@ -126,11 +126,11 @@
   (System/exit 0))

 (defn seed [& args]
-  (doseq [plugin (or args plugins)]
+  (doseq [plugin (or args (plugins))]
     (run-seed (dev-ds) plugin))
   (System/exit 0))

 (defn reset [& args]
-  (doseq [plugin (or args plugins)]
+  (doseq [plugin (or args (plugins))]
     (run-reset (dev-ds) plugin))
   (System/exit 0))


add angular logic for user page

add angular logic for user page

--- src/cljs/traveler/ng/core.cljs
+++ src/cljs/traveler/ng/core.cljs
@@ -105,3 +105,21 @@

   ;;Run the search to populate the table
   ($scope.search))
+
+(def.controller traveler.user-ctrl [$scope $http]
+  (! $scope.userFound "loading")
+  (! $scope.user "")
+
+  (! $scope.setUserId (fn [userId]
+                        (! $scope.userId userId)
+                        ($scope.getUser)))
+
+  (! $scope.getUser (fn []
+                      (-> $http
+                          (.get (str "/api/user/" $scope.userId))
+                          (.success (fn [data]
+                                      (! $scope.user (aget data "user"))
+                                      (if (aget data "user" "username")
+                                        (! $scope.userFound "yes")
+                                        (! $scope.userFound "no"))))
+                          (.error (fn [] (! $scope.userFound "error")))))))


Don't allow home action when at home screen

--- src/clojure/nightmod/screens.clj
+++ src/clojure/nightmod/screens.clj
@@ -160,15 +160,16 @@

 (defn home!
   []
-  (s/invoke-later
-    (editors/remove-editors! @u/project-dir)
-    (reset! ui/tree-selection nil)
-    (u/toggle-editor! false))
-  (on-gl
-    (asset-manager! manager :clear)
-    (set-screen! nightmod main-screen)
-    (set-cursor-image! nil)
-    (manager/clean!)))
+  (when @ui/tree-selection
+    (s/invoke-later
+      (editors/remove-editors! @u/project-dir)
+      (reset! ui/tree-selection nil)
+      (u/toggle-editor! false))
+    (on-gl
+      (asset-manager! manager :clear)
+      (set-screen! nightmod main-screen)
+      (set-cursor-image! nil)
+      (manager/clean!))))

 (defn restart!
   []


Disable full screen mode

Disable full screen mode

--- src/clojure/nightcode/core.clj
+++ src/clojure/nightcode/core.clj
@@ -52,7 +52,7 @@
                  :icon "logo_launcher.png"
                  :on-close :nothing)
     ; set various window properties
-    window/enable-full-screen!
+    ;window/enable-full-screen!
     window/add-listener!))

 (defn -main


Use KeyEventDispatcher instead of KeyListener

--- src/clojure/nightmod/input.clj
+++ src/clojure/nightmod/input.clj
@@ -1,6 +1,10 @@
 (ns nightmod.input
-  (:require [play-clj.core :as play-clj])
-  (:import [java.awt.event ComponentAdapter KeyListener]
+  (: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]
            [nightmod KeyCodeConverter]
            [org.lwjgl.input Keyboard]
@@ -27,28 +31,51 @@
         impl (proxy [InputImplementation] []
                (pollKeyboard [bb])
                (readKeyboard [bb]))]
-    (.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)
-          (.put key-buf (awt->lwjgl (.getKeyCode e)) (byte 8))
-          (-> game
-              .getInput
-              .getInputProcessor
-              (.keyDown (awt->libgdx (.getKeyCode e)))
-              play-clj/on-gl))))))
+    (.addKeyEventDispatcher
+      (KeyboardFocusManager/getCurrentKeyboardFocusManager)
+      (proxy [KeyEventDispatcher] []
+        (dispatchKeyEvent [^KeyEvent e]
+          (cond
+            ; a key was released in a game
+            (and @ui/tree-selection
+                 (shortcuts/focused-window? window)
+                 (u/editor-hidden?)
+                 (= (.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)
+                 (u/editor-hidden?)
+                 (= (.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)
+                 (u/editor-hidden?)
+                 (= (.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))))))


Use name as default js key transform

Use name as default js key transform

--- src/com/wsscode/pathom/core.cljc
+++ src/com/wsscode/pathom/core.cljc
@@ -135,7 +135,7 @@
                          ::keys [js-key-transform js-value-transform
                                  entity-key]
                          :as    env
-                         :or    {js-key-transform   identity
+                         :or    {js-key-transform   name
                                  js-value-transform identity}}]
      (let [js-key (js-key-transform (:key ast))
            entity (entity env)]


make histogram buckets configurable and provide better defaults for microservice APIs

--- src/prometheus/core.clj
+++ src/prometheus/core.clj
@@ -3,6 +3,9 @@
     (java.io StringWriter)
     (io.prometheus.client.exporter.common TextFormat)
     (io.prometheus.client Counter Histogram CollectorRegistry)))
+
+; more useful set of buckets for microservice APIs than the defaults provided by the Histogram class
+(def histogram-buckets (atom [0.001, 0.002, 0.005, 0.010, 0.025, 0.050, 0.100, 0.250, 0.500, 0.750, 1.0]))

 (defn- make-request-counter [app-name registry]
   (-> (Counter/build)
@@ -18,6 +21,7 @@
       (.name "http_request_latency_seconds")
       (.labelNames (into-array String ["method" "status" "path"]))
       (.help "A histogram of the response latency for HTTP requests in seconds.")
+      (.buckets (double-array @histogram-buckets))
       (.register registry)))

 (defn- record-request-metric [counter histogram request-method response-status request-time response-path]


Fixed animation usage.

Fixed animation usage.

--- src/stash_bot/core.cljs
+++ src/stash_bot/core.cljs
@@ -29,14 +29,14 @@
 (def root-dir (.resolve path "."))
 (def led nil)
 (def servo nil)
-(def bell-animation)
-(def animation-config {:duration 2000
-                       :cuePoints [0, 0.25, 0.5, 0.75, 1.0]
-                       :keyFrames [{:degrees 0}
-                                   {:degrees 135}
-                                   {:degrees 45}
-                                   {:degrees 180}
-                                   {:degrees 0}]})
+(def animation-config
+  (clj->js {:duration 2000
+            :cuePoints [0, 0.25, 0.5, 0.75, 1.0]
+            :keyFrames [{:degrees 0}
+                        {:degrees 135}
+                        {:degrees 45}
+                        {:degrees 180}
+                        {:degrees 0}]}))

 (defn- read-config []
   (->> (.readFileSync fs (str root-dir "/config.clj"))
@@ -86,7 +86,8 @@
 (defn- ring-bell! []
   (println "Ringing the bell!")
   (when io-enabled?
-    (.play bell-animation)))
+    (-> (js/five.Animation servo)
+        (.enqueue animation-config))))

 (defn- remove-content-encoding
   "Stash sends an invalid content-encoding header. Remove it from the request object if detected"
@@ -158,9 +159,6 @@
         (set! led (js/five.Led. "GPIO16"))
         (set! servo
           (js/five.Servo (clj->js {:pin "GPIO18"})))
-        (set! bell-animation
-          (doto (js/five.Animation servo)
-                (.enqueue (clj->js animation-config))))
         (next-fn)))))

 (defn- init-web-server []


Make view compatible to new API

Make view compatible to new API

--- src/discuss/references/main.cljs
+++ src/discuss/references/main.cljs
@@ -26,7 +26,7 @@
    (s/keys :req-un [::id ::comlib/text ::comlib/url])))

 ;;;; Handlers & Queries
-(defn reference-usage-handler
+(defn- reference-usage-handler
   "Handler to process information about the reference. Store results and change
   view."
   [response]
@@ -112,7 +112,7 @@
                         [:div
                          [:hr]
                          [:p.text-center (t :references :usages/list) "."]
-                         (map reference-usages-for-arguments usages)])]
+                         (reference-usages-for-arguments usages)])]
                      [:div.text-center
                       (vlib/view-header (t :references :usages/not-found-lead))
                       [:p (t :references :usages/not-found-body) "."]])]))))


Refactoring - REST API calls for create-job and update-job

--- src/emender_jenkins/rest_api.clj
+++ src/emender_jenkins/rest_api.clj
@@ -153,6 +153,11 @@
 (defn send-job-not-specified-response
     [request command]
     (-> (create-bad-request-response (get commands command) "job name is not specified")
+        (send-error-response request :bad-request)))
+
+(defn send-job-invalid-metadata-response
+    [request command message]
+    (-> (create-bad-request-response (get commands command) message)
         (send-error-response request :bad-request)))

 (defn reload-all-results
@@ -203,6 +208,10 @@
         (nil? branch)   "invalid input: branch not specified"
         :else           "other error"))

+(defn job-metadata-ok?
+    [job-name git-repo branch]
+    (and job-name git-repo branch))
+
 (defn create-job
     [request]
     (try
@@ -215,19 +224,38 @@
             (if (results/job-exists? job-name)
                 (-> (job-already-exist-response job-name create-job-command)
                     (send-error-response request :bad-request))
-                (if (and job-name git-repo branch)
+                (if (job-metadata-ok? job-name git-repo branch)
                     (-> (jenkins-api/create-job (config/get-jenkins-url request)
                                                 (config/get-jenkins-auth request)
                                                 (config/include-jenkins-reply? request)
                                                 job-name git-repo branch metadata)
                         (reload-job-list request)
                         (send-response request))
-                    (-> (create-error-response (or job-name "not set!") create-job-command
-                                               (job-invalid-input job-name git-repo branch))
-                        (send-error-response request :bad-request)))))
+                    (send-job-invalid-metadata-response request :create-job (job-invalid-input job-name git-repo branch)))))
         (catch Exception e
-                (-> (create-error-response "not set!" create-job-command "invalid input")
-                    (send-error-response request :bad-request)))))
+            (send-job-invalid-metadata-response request :create-job "invalid or missing input"))))
+
+(defn update-job
+    [request]
+    (try
+        (let [input-data (-> (read-request-body request)
+                             body->job-info)
+              job-name   (get input-data :name)
+              git-repo   (get input-data :ssh_url_to_repo)
+              branch     (get input-data :branch)
+              metadata   (get input-data :metadata)]
+            (if (results/job-exists? job-name)
+                (if (job-metadata-ok? job-name git-repo branch)
+                    (-> (jenkins-api/update-job (config/get-jenkins-url request)
+                                                (config/get-jenkins-auth request)
+                                                (config/include-jenkins-reply? request)
+                                                job-name git-repo branch metadata)
+                        ;(reload-job-list request)
+                        (send-response request))
+                    (send-job-invalid-metadata-response request :update-job (job-invalid-input job-name git-repo branch)))
+                (send-job-does-not-exist-response request job-name :update-job)))
+        (catch Exception e
+            (send-job-invalid-metadata-response request :update-job "invalid or missing input"))))

 (defn uri->job-name
     [uri prefix]
@@ -253,32 +281,6 @@
             (-> (job-does-not-exist-response job-name "get-job")
                 (send-error-response request :bad-request)))))

-(defn update-job
-    [request]
-    (try
-        (let [input-data (-> (read-request-body request)
-                             body->job-info)
-              job-name   (get input-data :name)
-              git-repo   (get input-data :ssh_url_to_repo)
-              branch     (get input-data :branch)
-              metadata   (get input-data :metadata)]
-            (if (results/job-exists? job-name)
-                (if (and job-name git-repo branch)
-                    (-> (jenkins-api/update-job (config/get-jenkins-url request)
-                                                (config/get-jenkins-auth request)
-                                                (config/include-jenkins-reply? request)
-                                                job-name git-repo branch metadata)
-                        ;(reload-job-list request)
-                        (send-response request))
-                    (-> (create-error-response (or job-name "not set!") update-job-command
-                                               (job-invalid-input job-name git-repo branch))
-                        (send-error-response request :bad-request)))
-                (-> (job-does-not-exist-response job-name update-job-command)
-                    (send-error-response request :not-found))))
-        (catch Exception e
-                (-> (create-error-response "not set!" update-job-command "invalid input")
-                    (send-error-response request :bad-request)))))
-
 (defn get-jobs
     [request]
     (let [params  (:params request)


New functions: run-emend, create-tests+paths, repo-clone-failed etc.

--- src/emender_service/rest_api.clj
+++ src/emender_service/rest_api.clj
@@ -19,6 +19,9 @@
 (require '[emender-service.file-utils   :as file-utils])
 (require '[emender-service.results      :as results])
 (require '[emender-service.db-interface :as db-interface])
+(require '[emender-service.git-utils    :as git-utils])
+(require '[emender-service.config       :as config])
+(require '[emender-service.exec         :as exec])

 (defn read-request-body
     [request]
@@ -30,7 +33,7 @@

 (defn body->test-info
     [body]
-    (json/read-str body))
+    (json/read-str body :key-fn clojure.core/keyword))

 (defn read-job-name-from-uri
     [uri]
@@ -55,6 +58,7 @@

 (defn unknown-call-handler
     [uri method]
+    (db-interface/log-error "Unknown API call" (str "URI: " uri "  method: " method))
     (let [response {:status :error
                     :error "Unknown API call"
                     :uri uri
@@ -94,11 +98,43 @@
               (send-response names)
               (send-response []))))

+(defn repo-clone-failed
+    [clone-results job-name repo-url branch]
+    (let [message (str "Problem cloning repository '" repo-url "' and/or checkout branch '" branch "'")]
+        (println message)
+        (db-interface/log-error job-name repo-url branch message (:message clone-results)))
+    (send-response {:status :repo-clone-failed}))
+
+(defn create-tests+paths
+    [path-to-tests tests]
+    (map #(str path-to-tests "/" % ".lua") tests))
+
+(defn run-emend
+    [path-to-emender path-to-tests tests book-directory]
+    (println "Starting Emend against the book directory" book-directory)
+    (let [tests+paths (create-tests+paths path-to-tests tests)]
+        (apply exec/exec "scripts/start_proceed" path-to-emender path-to-tests book-directory tests+paths))
+    (send-response {:status :ok}))
+
 (defn run-test-handler
     [request]
-    (let [job-name  (read-job-name-from-request request)
-          test-info (-> (read-request-body request) body->test-info)]
+    (let [job-name      (read-job-name-from-request request)
+          path-to-emend (file-utils/>abs-path (config/path-to-emender request))
+          path-to-tests (file-utils/>abs-path (config/path-to-tests request))
+          test-info     (-> (read-request-body request) body->test-info)
+          repo-url      (-> test-info :repository :url)
+          branch        (-> test-info :repository :branch)
+          tests         (-> test-info :tests)]
         (println "job name " job-name)
-        (println "test info" test-info)
-        (send-response {:status :ok})))
+        (println "test dir " path-to-tests)
+        (println "repo URL " repo-url)
+        (println "branch   " branch)
+        (println "Emender  " path-to-emend)
+        (println "tests    " tests)
+        (let [;clone-results {:directory (new java.io.File "/tmp/emender-service-1460557400756/")}]
+              clone-results (git-utils/clone-remote-repository repo-url branch)]
+             (if (:directory clone-results)
+                 (run-emend path-to-emend path-to-tests tests
+                            (.getAbsolutePath (:directory clone-results)))
+                 (repo-clone-failed (:message clone-results) job-name repo-url branch)))))


fixed minor bugs

fixed minor bugs

--- main/src/dda/pallet/dda_managed_ide/infra/basics.clj
+++ main/src/dda/pallet/dda_managed_ide/infra/basics.clj
@@ -72,9 +72,6 @@
   (let [{:keys [version]} config]
     (actions/as-action
       (logging/info (str facility "configure system: install-argouml")))
-    ; (actions/as-action
-    ;   (logging/info (str "http://argouml-downloads.tigris.org/nonav/argouml-"
-    ;                   version "/ArgoUML-" version ".tar.gz")))
     (actions/remote-directory
       "/opt/argouml"
       :owner "root"
@@ -121,7 +118,7 @@
    config :- Dbvis]
   (let [{:keys [version]} config]
     (actions/as-action
-      (logging/info (str facility "configure system: install-yed")))
+      (logging/info (str facility "configure system: install-dbvis")))
     (actions/remote-directory
       "/opt/dbvis"
       :owner "root"
@@ -129,7 +126,7 @@
       :recursive true
       :unpack :tar
       :url (str "http://www.dbvis.com/product_download/dbvis-" version
-                "/media/dbvis_unix_" (string/replace version #"." "_") ".tar.gz"))
+                "/media/dbvis_unix_" (string/replace version #"\." "_") ".tar.gz"))
     (actions/remote-file
       "/etc/profile.d/dbvis.sh"
       :literal true


+constraints on argument of {:cat :prep}

--- src/babel/italiano/pos.cljc
+++ src/babel/italiano/pos.cljc
@@ -140,7 +140,9 @@
   (let [shared (atom :top)]
     {:synsem {:cat :prep
               :sem {:obj shared}
-              :subcat {:1 {:sem shared}}}}))
+              :subcat {:1 {:cat :noun
+                           :subcat '()
+                           :sem shared}}}}))

 (def reflexive
   (let [subject-semantics (atom {:animate true})


Update buffer docstrings.

Update buffer docstrings.

--- src/blocks/store/buffer.clj
+++ src/blocks/store/buffer.clj
@@ -22,11 +22,11 @@
     [this]
     (when-not (satisfies? store/BlockStore primary)
       (throw (IllegalStateException.
-               (str "Buffer block store cannot start without a primary block store: "
+               (str "Cannot start buffer block store without a backing primary store: "
                     (pr-str primary)))))
     (when-not (satisfies? store/BlockStore buffer)
       (throw (IllegalStateException.
-               (str "Buffer block store cannot start without a buffer block store: "
+               (str "Cannot start buffer block store without a backing buffer store: "
                     (pr-str buffer)))))
     this)

@@ -79,7 +79,8 @@

 (defn clear!
-  "Removes all blocks from the buffer. Returns a summary of the deleted blocks."
+  "Remove all blocks from the buffer. Returns a deferred which yields a summary
+  of the deleted blocks."
   [store]
   (d/chain
     (s/reduce
@@ -94,8 +95,8 @@

 (defn flush!
-  "Flushes the store, writing all buffered blocks to the backing store. Returns
-  a summary of the flushed blocks."
+  "Flush the store, writing all buffered blocks to the primary store. Returns a
+  deferred which yields a summary of the flushed blocks."
   [store]
   (->>
     (block/list (:buffer store))
@@ -119,7 +120,7 @@

 (defn buffer-block-store
-  "Creates a new buffering block store.
+  "Create a new buffering block store.

   - `:buffer`
     Block store to use for new writes.


Returning CAS during storage-set.

Returning CAS during storage-set.

--- src/cbfg/world-storage.cljs
+++ src/cbfg/world-storage.cljs
@@ -18,15 +18,17 @@
        :key key :sq sq :cas (:cas change) :val (:val change)}
       {:opaque-id opaque-id :status :not-found})))

-(defn storage-set [storage opaque-id key prev-sq val]
-  (let [storage2 (swap! storage
+(defn storage-set [storage opaque-id key val]
+  (let [cas (gen-cas)
+        storage2 (swap! storage
                         #(-> %
                              (dissoc-in [:changes (get-in % [:keys key :sq])])
                              (assoc-in [:keys key] (:next-sq %))
                              (assoc-in [:changes (:next-sq %)]
-                                       {:key key :sq (:next-sq %) :cas (gen-cas) :val val})
+                                       {:key key :sq (:next-sq %) :cas cas :val val})
                              (update-in [:next-sq] inc)))]
-    {:opaque-id opaque-id :status :ok :key key :sq (dec (:next-sq storage2))}))
+    {:opaque-id opaque-id :status :ok
+     :key key :sq (dec (:next-sq storage2)) :cas cas}))

 (defn make-storage-cmd-handlers [storage]
   {"get" [["key"]


fix map key typo

fix map key typo

--- src/clj/cljs/source_map.clj
+++ src/clj/cljs/source_map.clj
@@ -99,7 +99,7 @@
             (conj seg (peek prev-seg))
             seg)
           (conj cols-segs (base64-vlq/encode relseg))))
-      {:col-segs cols-segs
+      {:cols-segs cols-segs
        :prev-seg prev-seg})))

 (defn encode-source [lines segs prev-seg source-idx names->idx name-idx]
@@ -110,9 +110,9 @@
             (loop [cols (seq cols) segs segs prev-seg prev-seg]
               (if cols
                 (let [[col vs] (first cols)
-                      {:keys [col-segs prev-seg]}
+                      {:keys [cols-segs prev-seg]}
                       (encode-cols vs prev-seg source-idx line col names->idx name-idx)]
-                  (recur (next cols) (conj segs col-segs) prev-seg))
+                  (recur (next cols) (conj segs cols-segs) prev-seg))
                 {:segs segs :prev-seg prev-seg}))]
         (recur (next lines) segs prev-seg))
       {:segs segs :prev-seg prev-seg})))


val coerce to clojure value

val coerce to clojure value

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -42,16 +42,20 @@

 (def required-ns (atom #{}))

-(defn kv->clj
-  "Coerce from KV to Clojure MapEntry"
+(defn val->clj
   [^KV kv]
   (let [v (.getValue kv)]
     (if (and
          (instance? Iterable v)
          (not (instance? java.util.Set v))
          (not (instance? java.util.Map v)))
-      (MapEntry. (.getKey kv) (seq v))
-      (MapEntry. (.getKey kv) v))))
+      (seq v)
+      v)))
+
+(defn kv->clj
+  "Coerce from KV to Clojure MapEntry"
+  [^KV kv]
+  (MapEntry. (.getKey kv) (val->clj kv)))

 (defmethod print-method KV [kv ^java.io.Writer w]
   (.write w (pr-str (kv->clj kv))))
@@ -183,8 +187,7 @@
    :added "0.1.0"}
   [elt]
   (if (instance? KV elt)
-    (let [^KV kv elt]
-      (.getValue elt))
+    (val->clj ^KV elt)
     (val elt)))

 (def ^{:dynamic true :no-doc true} *coerce-to-clj* true)


Add card-flag-fn?, two small utilities.

Add card-flag-fn?, two small utilities.

--- src/clj/game/core-flags.clj
+++ src/clj/game/core-flags.clj
@@ -8,6 +8,14 @@
   [card flag-key value]
   (let [cdef (card-def card)]
     (= value (get-in cdef [:flags flag-key]))))
+
+(defn card-flag-fn?
+  "Checks the card to see if it has a :flags entry of the given flag-key, whose value is a four-argument
+  function that returns the given value"
+  [state side card flag-key value]
+  (let [cdef (card-def card)
+        func (get-in cdef [:flags flag-key])]
+    (and func (= (func state side card nil) value))))

 (defn is-tagged?
   "Returns true if the runner is tagged."
@@ -98,10 +106,20 @@

 ;;; Small utilities for card properties.
+(defn in-server?
+  "Checks if the specified card is installed in -- and not PROTECTING -- a server"
+  [card]
+  (= (last (:zone card)) :content))
+
 (defn in-hand?
   "Checks if the specified card is in the hand."
   [card]
   (= (:zone card) [:hand]))
+
+(defn is-scored?
+  "Checks if the specified card is in the scored area of the specified player."
+  [state side card]
+  (some #(= (:cid %) (:cid card)) (get-in @state [side :scored])))

 (defn in-deck?
   "Checks if the specified card is in the draw deck."


Temp fix for oauth registration

Temp fix for oauth registration

--- src/clj/salava/oauth/db.clj
+++ src/clj/salava/oauth/db.clj
@@ -71,7 +71,7 @@
           new-user-id (:generated_key (insert-user<! new-user (get-db ctx)))
           _ (insert-user-email! {:email (:email oauth-user) :user_id new-user-id} (get-db ctx))
           _ (add-oauth-user ctx new-user-id (:oauth_user_id oauth-user) service)
-          _ (insert-user-terms ctx new-user-id "accepted")
+          ;_ (insert-user-terms ctx new-user-id "accepted")
           ]
       new-user-id)
     (catch Object _


Simplify benchmarks ns

Simplify benchmarks ns

--- src/clj/seria/benchmark.clj
+++ src/clj/seria/benchmark.clj
@@ -62,23 +62,13 @@
        (first)
        (* 1000)))

-(defn measure-methods [methods data stats]
+(defn measure-methods [& {:keys [methods stats data]}]
   (->> (for [stat stats]
          [stat (->> (for [[method-name fns] methods]
                       (do (println "Measuring " method-name stat)
                           [method-name (measure-stat stat fns data)]))
                     (into {}))])
        (into {})))
-
-(defn run-benchmarks [& {:keys [stats]}]
-  (measure-methods {:seria [#(pack :snapshot %) unpack]
-                    :java  [java-serialize java-deserialize]
-                    :kryo  [kryo-serialize kryo-deserialize]
-                    :nippy [nippy/freeze nippy/thaw]
-                    :json  [cheshire/generate-string cheshire/parse-string]
-                    :smile [cheshire/generate-smile cheshire/parse-smile]}
-                   (repeatedly 1000 #(gen :snapshot))
-                   stats))

 (defn visualize-results [results]
   (let [stats      (-> results (keys) (sort))
@@ -96,35 +86,15 @@

 (comment
   (visualize-results
-    (run-benchmarks :stats [:size :serialize-speed :roundtrip-speed]))
+    (measure-methods :methods {:seria [#(pack :snapshot %) unpack]
+                               :java  [java-serialize java-deserialize]
+                               :kryo  [kryo-serialize kryo-deserialize]
+                               :nippy [nippy/freeze nippy/thaw]
+                               :json  [cheshire/generate-string cheshire/parse-string]
+                               :smile [cheshire/generate-smile cheshire/parse-smile]}
+                     :stats   [:size :serialize-speed :roundtrip-speed]
+                     :data    (repeatedly 1000 #(gen :snapshot))))
   nil)
-
-(def results
-  '[:proto-repl-code-execution-extension
-    "proto-repl-charts"
-    {:name "Benchmarks",
-     :type "chart",
-     :data {:axis {:x {:type "category",
-                       :categories ("roundtrip-speed"
-                                    "serialize-speed"
-                                    "size",)}}
-            :data {:type "bar",
-                   :json {:nippy [35.51072945787636
-                                  54.249653456539136
-                                  14.57736740286537,]
-                          :java [100 100 100],
-                          :smile [27.583548945570033
-                                  43.78076706942772
-                                  23.128091751022712,]
-                          :seria [8.502563595875728
-                                  11.274565521893088
-                                  7.390651649796993,]
-                          :kryo [31.973661501951366
-                                 46.315971057037345
-                                 23.7524082061801,]
-                          :json [56.87289864382199
-                                 72.31563457982426
-                                 43.72929004153248]}}}}])

 ;; 1
 [8.502563595875728


Remove profiling output for finalize-deploy

We no longer need to collect that information, since it was used to fix
issues with delays uploading to cloudfiles.

--- src/clojars/routes/repo.clj
+++ src/clojars/routes/repo.clj
@@ -361,11 +361,8 @@
                   (let [file (io/file upload-dir group artifact file)]
                     (try-save-to-file file body)
                     (try
-                      (profile {:group groupname
-                                :artifact artifact
-                                :context 'finalize-deploy}
-                        (finalize-deploy storage db reporter search
-                          account upload-dir))
+                      (finalize-deploy storage db reporter search
+                        account upload-dir)
                       (catch Exception e
                         (rethrow-forbidden e
                           {:account account


Enable to read seq

Enable to read seq

--- src/clojure/cljam/tabix.clj
+++ src/clojure/cljam/tabix.clj
@@ -4,8 +4,6 @@
   (:import java.util.Arrays
            [java.io DataInputStream IOException]
            bgzf4j.BGZFInputStream))
-
-(set! *warn-on-reflection* true)

 (def tabix-magic "TBI\1")

@@ -15,9 +13,22 @@

 (def ^:private tad-lidx-shift 14)

+(defn- read-seq
+  [buf len]
+  (loop [i 0, j 0, seq* []]
+    (if (< i len)
+     (if (zero? (nth buf i))
+       (let [ba-len (- i j)
+             ba (byte-array ba-len)]
+         (System/arraycopy buf j ba 0 ba-len)
+         (recur (inc i) (inc i) (conj seq* (String. ba))))
+       (recur (inc i) j seq*))
+     seq*)))
+
 (defn- read-chunk
   [^DataInputStream rdr]
-  [(lsb/read-long rdr) (lsb/read-long rdr)])
+  {:beg (lsb/read-long rdr)
+   :end (lsb/read-long rdr)})

 (defn- read-bin
   [^DataInputStream rdr]
@@ -39,6 +50,7 @@
         skip   (lsb/read-int rdr)
         len    (lsb/read-int rdr)
         buf    (lsb/read-bytes rdr len)
+        seq    (read-seq buf len)
         index  (loop [i 0
                       bin-index []
                       linear-index []]
@@ -52,17 +64,9 @@
                             (conj linear-index new-linear-index)))
                    [bin-index linear-index]))]
     {:n-seq n-seq, :preset preset, :sc sc, :bc bc, :ec ec, :meta meta,
-     :skip skip, :bin-index (first index), :linear-index (last index)}
-    ))
-
-(deftype TABIXReader [f ^DataInputStream reader]
-  java.io.Closeable
-  (close [this]
-    (.close ^DataInputStream (.reader this))))
+     :skip skip, :seq seq ,:bin-index (first index), :linear-index (last index)}))

 (defn read-index
-  [^TABIXReader rdr]
-  (read-index* (.reader rdr)))
-
-(defn reader [f]
-  (->TABIXReader f (DataInputStream. (BGZFInputStream. (io/file f)))))
+  [f]
+  (with-open [r (DataInputStream. (BGZFInputStream. (io/file f)))]
+    (read-index* r)))


Changing internals for lattices

Changing internals for lattices

i.e. every lattice now has inf and sup (constructed if neccessary) and
an order-function (not relation) taking two arguments. This is however
not visible from the outside world.

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

--- src/conexp/fca/lattices.clj
+++ src/conexp/fca/lattices.clj
@@ -16,17 +16,18 @@

 (declare order)

-(deftype Lattice [base-set order-relation inf sup]
+(deftype Lattice [base-set order-function inf sup]
   Object
   (equals [this other]
     (and (= (class this) (class other))
          (= (.base-set this) (.base-set ^Lattice other))
          (let [order-this (order this),
                order-other (order other)]
-           (forall [x (.base-set this)
-                    y (.base-set this)]
-             (<=> (order-this [x y])
-                  (order-other [x y]))))))
+           (or (= order-this order-other)
+               (forall [x (.base-set this)
+                        y (.base-set this)]
+                 (<=> (order-this x y)
+                      (order-other x y)))))))
   (hashCode [this]
     (hash-combine-hash Lattice base-set)))

@@ -40,47 +41,23 @@
   relation. If called with one argument it is assumed that this
   argument is a pair of elements."
   [^Lattice lattice]
-  (if-let [order-relation (.order-relation lattice)]
+  (let [order-function (.order-function lattice)]
     (fn order-fn
-      ([pair] (order-relation pair))
-      ([x y] (order-relation [x y])))
-    (let [sup (.sup lattice)]
-      (fn order-fn
-        ([[x y]] (= y (sup x y)))
-        ([x y] (= y (sup x y)))))))
+      ([pair] (order-function (first pair) (second pair)))
+      ([x y] (order-function x y)))))

 (defn inf
   "Returns a function computing the infimum in lattice."
   [^Lattice lattice]
-  (or (.inf lattice)
-      (let [order (order lattice)
-            base  (base-set lattice)]
-        (memo-fn _ [x y]
-          (first (for [z base
-                       :when (and (order [z x])
-                                  (order [z y])
-                                  (forall [a base]
-                                          (=> (and (order [a x]) (order [a y]))
-                                              (order [a z]))))]
-                   z))))))
+  (.inf lattice))

 (defn sup
   "Returns a function computing the supremum in lattice."
   [^Lattice lattice]
-  (or (.sup lattice)
-      (let [order (order lattice)
-            base  (base-set lattice)]
-        (memo-fn _ [x y]
-          (first (for [z base
-                       :when (and (order [x z])
-                                  (order [y z])
-                                  (forall [a base]
-                                          (=> (and (order [x a]) (order [y a]))
-                                              (order [z a]))))]
-                   z))))))
-
-(defmethod print-method Lattice [^Lattice lattice out]
-  (.write ^java.io.Writer out
+  (.sup lattice))
+
+(defmethod print-method Lattice [^Lattice lattice, ^java.io.Writer out]
+  (.write out
           ^String (str "Lattice on " (count (base-set lattice)) " elements.")))

@@ -89,17 +66,37 @@
 (defmulti make-lattice-nc
   "Creates a new lattice from the given arguments, without any
   checks. Use with care."
-  {:arglists '([base-set order-relation] [base-set inf sup])}
+  {:arglists '([base-set order-function] [base-set inf sup])}
   (fn [& args] (vec (map clojure-type args))))

 (defmethod make-lattice-nc [clojure-coll clojure-coll] [base-set order]
-  (Lattice. (set base-set) (set order) nil nil))
+  (let [order (set order)]
+    (make-lattice-nc (set base-set) (fn [x y] (contains? order [x y])))))

 (defmethod make-lattice-nc [clojure-coll clojure-fn] [base-set order]
-  (Lattice. (set base-set) (fn [[x y]] (order x y)) nil nil))
+  (let [inf (memoize (fn inf [x y]
+                       (first (for [z base-set
+                                    :when (and (order [z x])
+                                               (order [z y])
+                                               (forall [a base-set]
+                                                 (=> (and (order [a x]) (order [a y]))
+                                                     (order [a z]))))]
+                                z)))),
+        sup (memoize (fn sup [x y]
+                       (first (for [z base-set
+                                    :when (and (order [x z])
+                                               (order [y z])
+                                               (forall [a base-set]
+                                                 (=> (and (order [x a]) (order [y a]))
+                                                     (order [z a]))))]
+                                z))))]
+    (Lattice. (set base-set) order inf sup)))

 (defmethod make-lattice-nc [clojure-coll clojure-fn clojure-fn] [base-set inf sup]
-  (Lattice. (set base-set) nil inf sup))
+  (Lattice. (set base-set)
+            (fn [x y] (= y (sup x y)))
+            inf
+            sup))

 (defmethod make-lattice-nc :default [& args]
   (illegal-argument "The arguments " args " are not valid for a Lattice."))


Fixed bug in computing equals for Lattice

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

--- src/conexp/fca/lattices.clj
+++ src/conexp/fca/lattices.clj
@@ -12,28 +12,18 @@

 ;;; Datastructure

-(deftype Lattice [base-set order inf sup]
+(deftype Lattice [base-set order-relation inf sup]
   :as this
   Object
   (equals [other]
     (and (= ::Lattice (type other))
-	 (= (base-set this) (base-set other))
-	 (let [order-this (order this)
+     	 (= (:base-set this) (:base-set other))
+	 (let [order-this (order this),
 	       order-other (order other)]
-	   (or (= order-this order-other)
-	       (forall [pair (cross-product (base-set this) (base-set this))]
-		       (<=> (order-this pair) (order-other pair)))))))
-  (hashCode []
-    ;; this is not correct
-    (let [base-set (base-set this)
-	  order    (order this)
-	  inf      (inf this)
-	  sup      (sup this)]
-      (bit-xor (hash base-set)
-	       (if order
-		 (hash order)
-		 (bit-xor (hash inf)
-			  (hash sup)))))))
+	   (forall [x (:base-set this)
+		    y (:base-set this)]
+	     (<=> (order-this [x y])
+		  (order-other [x y])))))))

 (defn base-set
   "Returns the base set of lattice."
@@ -43,7 +33,7 @@
 (defn order
   "Returns a set of pairs representing the order relation on lattice."
   [lattice]
-  (or (:order lattice)
+  (or (:order-relation lattice)
       (let [sup (:sup lattice)]
 	(fn [[x y]] (= y (sup x y))))))


Add TODO

Add TODO

--- src/main/clojure/pigpen/oven.clj
+++ src/main/clojure/pigpen/oven.clj
@@ -121,6 +121,7 @@
   "Gets any references required for a command"
   [command]
   (case (:type command)
+    ;; TODO make this name dynamic
     :code ["pigpen.jar"]
     :bind ["pigpen.jar"]
     :storage (:references command)


Implemented restcall-options-handler and restcall-head-handler

--- src/emender_jenkins/server.clj
+++ src/emender_jenkins/server.clj
@@ -72,6 +72,18 @@
             [:post "job_results"]         (rest-api/job-results           request)
                                           (rest-api/unknown-call-handler uri method))))

+(defn restcall-options-handler
+    []
+    (println "Method:  OPTIONS")
+    (-> (http-response/response "")
+        (http-response/content-type "application/json")))
+
+(defn restcall-head-handler
+    []
+    (println "Method:  HEAD")
+    (-> (http-response/response "")
+        (http-response/content-type "application/json")))
+
 (defn non-api-call-handler
     [request uri]
     (condp = uri
@@ -83,9 +95,12 @@
     [request]
     (if (config/verbose? request)
         (pprint/pprint request))
-    (let [uri    (:uri request)
-          method (:request-method request)]
-         (if (.startsWith uri (config/get-api-prefix request))
-             (api-call-handler     request uri method)
-             (non-api-call-handler request uri))))
+    (cond (= (:request-method request) :options) (restcall-options-handler)
+          (= (:request-method request) :head)    (restcall-head-handler)
+          :else
+        (let [uri    (:uri request)
+              method (:request-method request)]
+             (if (.startsWith uri (config/get-api-prefix request))
+                 (api-call-handler     request uri method)
+                 (non-api-call-handler request uri)))))


Added untangled-spec.reporters.terminal/merge-cfg!

No arguments will print the valid keys, and if you pass it a map it will
verify that you are only modifying existing key-value pairs.

--- src/untangled_spec/reporters/terminal.clj
+++ src/untangled_spec/reporters/terminal.clj
@@ -9,24 +9,36 @@
             [io.aviso.exception :as pretty]
             [clojure.pprint :refer [pprint]]))

-(def env (let [COLOR       (System/getenv "US_DIFF_HL")
-               DIFF_MODE   (System/getenv "US_DIFF_MODE")
-               DIFF        (System/getenv "US_DIFF")
-               NUM_DIFFS   (System/getenv "US_NUM_DIFFS")
-               FRAME_LIMIT (System/getenv "US_FRAME_LIMIT")
-               QUICK_FAIL  (System/getenv "US_QUICK_FAIL")
-               FAIL_ONLY   (System/getenv "US_FAIL_ONLY")]
-           {:fail-only?      (#{"1" "true"} FAIL_ONLY)
-            :color?          (#{"1" "true"}  COLOR)
-            :diff-hl?        (#{"hl" "all"}  DIFF_MODE)
-            :diff-list? (not (#{"hl"}        DIFF_MODE))
-            :diff?      (not (#{"0" "false"} DIFF))
-            :frame-limit (read-string (or FRAME_LIMIT "10"))
-            :num-diffs  (read-string (or NUM_DIFFS "1"))
-            :quick-fail? (not (#{"0" "false"} QUICK_FAIL))}))
+(def cfg
+  (atom
+    (let [COLOR       (System/getenv "US_DIFF_HL")
+          DIFF_MODE   (System/getenv "US_DIFF_MODE")
+          DIFF        (System/getenv "US_DIFF")
+          NUM_DIFFS   (System/getenv "US_NUM_DIFFS")
+          FRAME_LIMIT (System/getenv "US_FRAME_LIMIT")
+          QUICK_FAIL  (System/getenv "US_QUICK_FAIL")
+          FAIL_ONLY   (System/getenv "US_FAIL_ONLY")]
+      {:fail-only?      (#{"1" "true"}  FAIL_ONLY)
+       :color?          (#{"1" "true"}  COLOR)
+       :diff-hl?        (#{"hl" "all"}  DIFF_MODE)
+       :diff-list? (not (#{"hl"}        DIFF_MODE))
+       :diff?      (not (#{"0" "false"} DIFF))
+       :frame-limit (read-string (or FRAME_LIMIT "10"))
+       :num-diffs  (read-string (or NUM_DIFFS "1"))
+       :quick-fail? (not (#{"0" "false"} QUICK_FAIL))})))
+(defn env [k] (get @cfg k))
+(defn merge-cfg!
+  "For use in the test-refresh repl to change configuration on the fly.
+  Single arity will show you the possible keys you can use."
+  ([] (println "Valid cfg keys: " (set (keys @cfg))))
+  ([new-cfg]
+   (doseq [[k v] new-cfg]
+     (assert (contains? @cfg k)
+             (str "Invalid key '" k "', try one of these " (set (keys @cfg)))))
+   (swap! cfg merge new-cfg)))

 (defn color-str [status & strings]
-  (let [color? (:color? env)
+  (let [color? (env :color?)
         status->color (cond-> {:passed c/green
                                :failed c/red
                                :error  c/red
@@ -45,7 +57,7 @@
   (pad " " (* 2 level)))

 (defn print-throwable [e]
-  (print (pretty/format-exception e {:frame-limit (:frame-limit env)}))
+  (print (pretty/format-exception e {:frame-limit (env :frame-limit)}))
   (some-> (.getCause e) print-throwable))

 (defmethod print-method Throwable [e w]


Optimise routing function for ring modules in Containium with macros.

--- src/containium/http_kit.clj
+++ src/containium/http_kit.clj
@@ -34,36 +34,45 @@
        reverse))

-(defn- request-matches
-  [{:keys [host-regex context-path] :as ring-conf} request]
-  (and (or (not host-regex)
-           (re-matches host-regex))
-       (or (not context-path)
-           (.startsWith (:uri request) (if (= (last context-path) \/)
-                                         context-path
-                                         (str context-path "/"))))))
-
-
-(defn- handle-request
-  [request app]
-  (when (request-matches (:ring-conf app) request)
-    (boxure/call-in-box (:box app) (:handler-fn app) request)))
+(defmacro matcher
+  [{:keys [host-regex context-path]} uri-sym server-name-sym]
+  (cond (and host-regex context-path) `(and (re-matches ~host-regex ~server-name-sym)
+                                            (.startsWith ~uri-sym ~context-path))
+        host-regex  `(re-matches ~host-regex ~server-name-sym)
+        context-path `(.startsWith ~uri-sym ~context-path)
+        :else true))

 (defn- make-app
   []
   (let [handler (if-let [apps (seq (vals @apps))]
-                  (let [sorted (sort-apps apps)]
-                    (fn [request] (some (partial handle-request request) sorted)))
+                  (let [sorted (sort-apps apps)
+                        fn-form `(fn [~'request]
+                                   (let [~'uri (:uri ~'request)
+                                         ~'server-name (:server-name ~'request)]
+                                     (or ~@(for [app sorted]
+                                             `(when (matcher ~(:ring-conf app) ~'uri ~'server-name)
+                                                (boxure/call-in-box ~(:box app)
+                                                                    ~(:handler-fn app)
+                                                                    ~'request))))))]
+                    (eval fn-form))
                   (constantly {:status 503 :body "no apps loaded"}))]
     (alter-var-root #'app (constantly handler))))

 ;;; Ring app registration.

+(defn- clean-ring-conf
+  [ring-conf]
+  (if-let [context-path (:context-path ring-conf)]
+    (assoc ring-conf :context-path
+           (if (= (last context-path) \/) context-path (str context-path "/")))
+    ring-conf))
+
+
 (defn upstart-box
   [{:keys [name project] :as box}]
-  (let [ring-conf (-> project :boxure :ring)
+  (let [ring-conf (clean-ring-conf (-> project :boxure :ring))
         handler-fn (boxure/eval box (:handler-sym ring-conf))]
     (swap! apps assoc name (App. box handler-fn ring-conf))
     (make-app)))


Bugfixes und API-Verbesserungen

Bugfixes und API-Verbesserungen

--- src/excellence/spreadsheet.clj
+++ src/excellence/spreadsheet.clj
@@ -43,14 +43,14 @@
  add-sheet! delete-sheet! get-sheet get-sheet-name sheet-seq set-sheet-name!
  update-formulas!
  ;; Funktionen fuer Excel-Zeilen (rows)
- add-row-after-last! delete-all-rows! delete-row! get-create-row! get-last-row-num
- get-row insert-row-after! insert-row-before! row-seq
+ add-row-after-last! delete-all-rows! delete-row! get-create-next-row!
+ get-create-row! get-last-row-num get-row insert-row-after! insert-row-before! row-seq
 ;; Funktionen fuer Excel-Zellen (cells)
  add-db-values-seq! add-value-rows! add-values! all->varchar apply-date-format!
  cell-iterator cell-reference cell-seq column-types create-cell!
  data-row-seq db-values-seq
- get-cell-formula-value get-cell-value get-create-cell! get-last-column-num
- get-transformed-cell-value
+ get-cell-formula-value get-cell-value get-create-next-cell! get-create-cell!
+ get-last-column-num get-transformed-cell-value
  indexed-cell-map indexed-value-map insert-db-values! into-seq
  last-day-in-month
  set-cell-value!
@@ -234,14 +234,18 @@
 (defn get-create-row!
   "liefert ein Row-Objekt - wenn diese Zeile noch nicht existiert, wird sie angelegt"
   [^Sheet sheet row-index]
-  (let [row (get-row sheet row-index)]
+  (let [row (get-row sheet (int row-index))]
     (if (nil? row)
-      (let [new-row (add-row-after-last! sheet)]
-        (loop [new-row new-row]
-            (if (= (.getRowNum new-row) row-index)
-              new-row
-              (recur (add-row-after-last! sheet)))))
-        row)))
+      (.createRow sheet (int row-index))
+      row)))
+
+(defn get-create-next-row!
+ "Liefert die auf aktuelle Zeile folgende Zeile. Wenn diese noch nicht
+existiert, wird diese neu erzeugt (z.B. wenn die aktuelle Zeile
+die letzte des Blattes ist."
+ [^Row row]
+ (get-create-row! (.getSheet row)
+                  (+ (.getRowNum row) 1)))

 (defn delete-row!
   "Loescht eine Tabellenzeile eines Blattes"
@@ -616,7 +620,7 @@
        (catch Exception e (prn "Index existiert nicht"))))

-(defn- get-create-cell!
+(defn get-create-cell!
  "Liefert eine Referenz auf ein 'Cell'-Objekt, das durch die Angaben
   Reihe 'r' und Zellennummer 'i' bestimmt wird. Wenn die Zelle nicht besteht
   wird eine neue angelegt."
@@ -627,6 +631,13 @@
       (.createCell r (int i))
       cell)))

+(defn get-create-next-cell!
+ "Liefert die auf aktuelle Zelle folgende Zelle. Wenn diese noch nicht
+existiert, wird diese neu erzeugt (z.B. wenn die aktuelle Zelle
+die letzte der Zeile ist."
+ [^Cell cell]
+ (get-create-cell! (.getRow cell)
+                   (+ (.getColumnIndex cell) 1)))

 ;;; ---------------------------------------------------------------------------
 ;;; Umwandlungsfunktionen


Add a bit more commentary.

Add a bit more commentary.

--- examples/nesting.clj
+++ examples/nesting.clj
@@ -7,18 +7,22 @@
 (namespace-state-changes (before :facts (accumulator/reset!)))

 ;; Use of [:key1 :key2 ...] paths
+;; Each path to a key is explicitly described.
 (def path-style-type-structural
   (-> accumulator/type-repo
       (type/named :sample-type [:color [:point :x] [:point :y]])))

-;; Adding value descriptions
+;; Adding value descriptions by adding a map with paths to keys.
 (def path-style-type-values
   (-> accumulator/type-repo
       (type/named :sample-type [:color [:point :x] [:point :y]]
          {[:point :x] #'integer?
           [:point :y] #'integer?})))

-;; Use of paths that embrace nesting: [:key1 [:key2-1 :key2-2]]
+
+;; The above is inconvenient when multiple nested maps should be of the same type.
+;; Use of paths that embrace nesting: [:key1 [:key2-1 :key2-2]], where the nested
+;; sequence will come from an independent map.

 (def point-type {:x #'integer? :y #'integer?})

@@ -32,7 +36,11 @@
       (type/named :sample-type [:color :point] ; contents of point are optional
                   {:point point-type})))

-;;;;;;; Tests
+
+
+
+
+;;;;;;; Tests of the above

 (fact path-style-type-structural


support for anonymous volume #356

support for anonymous volume
#356

--- src/cljs/swarmpit/component/service/info/mounts.cljs
+++ src/cljs/swarmpit/component/service/info/mounts.cljs
@@ -43,16 +43,24 @@
       bind
       nil)))

-(rum/defc form-volume < rum/static [volume]
+(rum/defc form-named-volume < rum/static [volume]
   (when (not-empty volume)
     (list/responsive
       render-volume-metadata
       volume
       onclick-volume-handler)))

+(rum/defc form-anonymous-volume < rum/static [volume]
+  (when (not-empty volume)
+    (list/responsive
+      render-volume-metadata
+      volume
+      nil)))
+
 (rum/defc form < rum/static [mounts service-id]
   (let [bind (filter #(= "bind" (:type %)) mounts)
-        volume (filter #(= "volume" (:type %)) mounts)]
+        named-volume (filter #(and (= "volume" (:type %)) (some? (:host %))) mounts)
+        anonymous-volume (filter #(and (= "volume" (:type %)) (nil? (:host %))) mounts)]
     (comp/card
       {:className "Swarmpit-card"}
       (comp/card-header
@@ -73,4 +81,5 @@
         (comp/card-content
           {:className "Swarmpit-table-card-content"}
           (form-bind bind)
-          (form-volume volume))))))+          (form-named-volume named-volume)
+          (form-anonymous-volume anonymous-volume))))))


improve order

improve order

--- src/desdemona/ui/table.cljs
+++ src/desdemona/ui/table.cljs
@@ -34,25 +34,6 @@
                    :on-click #(session/update! session-entry toggle-key k)}
                (wd/describe-key k)]]))]))

-(defn sticky-table-header
-  "Repeats sorted-table headers for headers affix showing up on scroll."
-  [ks]
-  (let [state-deref @session/state]
-    [:table {:class "table table-sticky"
-             :id "table-sticky"}
-     [:thead
-      [:tr
-       (map-indexed
-        (fn [i k]
-          ^{:key (wd/describe-key k)}
-          [:th {:class (when (= k (sort-key-id state-deref))
-                         (name (sort-order-id state-deref)))
-                :on-click (fn []
-                            (let [ths (sel [:.table-sorted :th])]
-                              (.click (nth ths i))))}
-           (wd/describe-key k)])
-        ks)]]]))
-
 (defn set-sticky-table-widths
   "Sets table/ths widths on sticky-table to match those of sorted-table."
   []
@@ -86,6 +67,25 @@
                          "px"))
       (.requestAnimationFrame js/window set-sticky-table-widths))))

+(defn sticky-table-header
+  "Repeats sorted-table headers for headers affix showing up on scroll."
+  [ks]
+  (let [state-deref @session/state]
+    [:table {:class "table table-sticky"
+             :id "table-sticky"}
+     [:thead
+      [:tr
+       (map-indexed
+        (fn [i k]
+          ^{:key (wd/describe-key k)}
+          [:th {:class (when (= k (sort-key-id state-deref))
+                         (name (sort-order-id state-deref)))
+                :on-click (fn []
+                            (let [ths (sel [:.table-sorted :th])]
+                              (.click (nth ths i))))}
+           (wd/describe-key k)])
+        ks)]]]))
+
 (def sticky-header-component
   (with-meta sticky-table-header
     {:component-did-mount (fn [this]


rule: trim down resolution to precision and period

--- src/io/cyanite/engine/rule.clj
+++ src/io/cyanite/engine/rule.clj
@@ -17,17 +17,16 @@
       "y" (* 365 24 60 60 quantity)
       (throw (ex-info (str "unknown unit: " unit) {})))))

-(defrecord Resolution [precision points period id])
+(defrecord Resolution [precision period])

 (defn fit?
   [resolution oldest ts]
-  (and (<= (- ts (:period resolution))
-           oldest)
-       (:id resolution)))
+  (when (<= (- ts (:period resolution)) oldest)
+    resolution))

 (def default-resolution
   "By default, keep a 1 minute resolution for a day"
-  (Resolution. 60 1440 86400 "60:86400"))
+  (Resolution. 60 86400))

 (defn ->resolution
   "Converts an individual resolution to a description map"
@@ -36,20 +35,13 @@
     (string? res-def)
     (let [[precision-string period-string] (split res-def #":" 2)
           precision-secs (->seconds precision-string)
-          period-secs    (->seconds period-string)
-          points-secs    (/ period-secs precision-secs)]
-      (Resolution. precision-secs
-                   points-secs
-                   period-secs
-                   (format "%s:%s" precision-secs period-secs)))
+          period-secs    (->seconds period-string)]
+      (Resolution. precision-secs period-secs))

     (map? res-def)
     (-> res-def
         (update :precision ->seconds)
         (update :period    ->seconds)
-        (as-> x (assoc x
-                       :points (/ (:period x) (:precision x))
-                       :id     (format "%s:%s" (:precision x) (:period x))))
         (map->Resolution))

     :else


Add email address to the Contact Us text

--- src/foreclojure/utils.clj
+++ src/foreclojure/utils.clj
@@ -117,10 +117,10 @@

 (defn html-doc [& body]
   (let [user (session/session-get :user)]
-    (html
+    (html
      (doctype :html5)
-     [:html
-      [:head
+     [:html
+      [:head
        [:title "4Clojure"]
        [:link {:rel "alternate" :type "application/atom+xml" :title "Atom" :href "http://4clojure.com/problems/rss"}]
        [:link {:rel "shortcut icon" :href "/favicon.ico"}]
@@ -171,7 +171,10 @@
         [:div#content_body body]
         [:div#footer
          "The content on 4clojure.com is available under the EPL v 1.0 license."
-         [:a#contact {:href "mailto:team@4clojure.com"} "Contact us!"]]
+         (let [email "team@4clojure.com"]
+           [:span
+            [:a#contact {:href (str "mailto:" email)} "Contact us"]
+            (str `(~email))])]
         (javascript-tag
          " var _gaq = _gaq || [];
         _gaq.push(['_setAccount', 'UA-22844856-1']);


Include processor stack in pipeline. Also, fix #473.

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -22,7 +22,7 @@
   (:import [org.micromanager AcqControlDlg]
            [org.micromanager.api AcquisitionEngine]
            [org.micromanager.acquisition AcquisitionWrapperEngine LiveAcqDisplay TaggedImageQueue]
-           [org.micromanager.acquisition.engine SequenceSettings]
+           [org.micromanager.acquisition.engine SequenceSettings ProcessorStack]
            [org.micromanager.navigation MultiStagePosition StagePosition]
            [mmcorej TaggedImage Configuration]
            [java.util.prefs Preferences]
@@ -262,8 +262,8 @@
        (or (:slice event) 0)
        (if (:relative-z event)
          (or (get-z-position (:position event) z-drive)
-             (@state :init-z-position)))
-         0)))
+             (@state :init-z-position))
+         0))))

 (defn make-event-fns [event out-queue]
   (list
@@ -368,7 +368,9 @@
   (let [out-queue (GentleLinkedBlockingQueue.)
         acq-thread (Thread. #(run-acquisition this
           (convert-settings settings) out-queue))
-        display (LiveAcqDisplay. mmc out-queue settings (.channels settings)
+        processors (ProcessorStack. out-queue (.getTaggedImageProcessors acq-eng))
+        out-queue-2 (.begin processors)
+        display (LiveAcqDisplay. mmc out-queue-2 settings (.channels settings)
           (.save settings) acq-eng)]
     (def outq out-queue)
     (.start acq-thread)


fix typo

fix typo

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -436,7 +436,7 @@
         default-xy-stage (core getXYStageDevice)
         z (get-z-stage-position default-z-drive)
         xy (get-xy-stage-position default-xy-stage)
-        exposure-m (core getExposure)]
+        exposure (core getExposure)]
     (swap! (.state this) assoc
       :pause false
       :stop false


use the snapshot with the highest version number within release

--- src/wb_es/web/setup.clj
+++ src/wb_es/web/setup.clj
@@ -42,14 +42,17 @@
 (defn get-snapshot-id
   []
   (let [response (http/get (format "%s/_cat/snapshots/s3_repository?format=json" es-base-url))
-        all-snapshots (json/parse-string (:body response) true)]
+        all-snapshots (json/parse-string (:body response) true)
+        id-pattern (re-pattern (format "snapshot_%s(_(\\d+))?" release-id))]
     (->> all-snapshots
          (filter (fn [snapshot]
                    (and
                     (= "SUCCESS" (:status snapshot))
-                    (let [id-pattern (re-pattern (format "snapshot_%s(_\\d+)?" release-id))]
-                      (re-matches id-pattern (:id snapshot))))))
-         (first)
+                    (re-matches id-pattern (:id snapshot)))))
+         (sort-by (fn [snapshot]
+                    (let [[_ _ version-id] (re-matches id-pattern (:id snapshot))]
+                      version-id)))
+         (last)
          (:id))))

 ;; (let [


Fix call to launch analysis

Fix call to launch analysis

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/launch_analysis.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/launch_analysis.cljs
@@ -12,7 +12,7 @@
     ))

-(defn- render-launch-button [state refs entity workspace-id config on-success]
+(defn- render-launch-button [state refs entity workspace-id config-id on-success]
   (when-not (:launch-result @state)
           [:div {:style {:fontSize "106%" :lineHeight 1 :textAlign "center"}}
            [:div {:style {:padding "0.7em 0" :cursor "pointer"
@@ -25,8 +25,8 @@
                   ;; TODO: diable submit button after submitting
                   :onClick (fn [e]
                              (let [expression (clojure.string/trim (-> (@refs "expressionname") .getDOMNode .-value))
-                                   payload (merge {:methodConfigurationNamespace (config "namespace")
-                                                   :methodConfigurationName (config "name")
+                                   payload (merge {:methodConfigurationNamespace (:namespace config-id)
+                                                   :methodConfigurationName (:name config-id)
                                                    :entityType (entity "entityType")
                                                    :entityName (entity "name")}
                                                   (when-not (clojure.string/blank? expression) {:expression expression}))]
@@ -65,7 +65,7 @@
                                ))} "Launch"]]))

-(defn render-launch-overlay [entities state refs workspace-id config on-success]
+(defn render-launch-overlay [entities state refs workspace-id config-id on-success]
   (let [entity-map (group-by #(% "entityType") entities)
         filter (or (:filter @state) "Sample")
         filtered-entities (entity-map filter)
@@ -110,7 +110,7 @@
                         filtered-entities)}])]
         (style/create-form-label "Define Expression")
         (style/create-text-field {:ref "expressionname" :placeholder "leave blank for default"})
-        (render-launch-button state refs selected-entity workspace-id config on-success)])]))
+        (render-launch-button state refs selected-entity workspace-id config-id on-success)])]))

 (react/defc Page


Using transients instead of atoms, as a more lightweight version. In any case, there's no required sharing, it's also impossible with binding.

--- src/clojure/clojurewerkz/cassaforte/cql/query_builder.clj
+++ src/clojure/clojurewerkz/cassaforte/cql/query_builder.clj
@@ -11,8 +11,7 @@
   [f v]
   (if *cql-stack*
     (do
-      (swap! *cql-stack* #(conj % v))
-      (println *cql-stack*)
+      (conj! *cql-stack* v)
       "?")
     (f)))

@@ -169,9 +168,9 @@
 (defn prepare-select-query
   [column-family & {:keys [columns where limit order as-prepared-statement] :as opts}]
   (if as-prepared-statement
-    (binding [*cql-stack* (atom [])]
+    (binding [*cql-stack* (transient [])]
       (let [res (apply prepare-select-query column-family (apply concat (dissoc opts :as-prepared-statement)))]
-        [@*cql-stack* res]))
+        [(persistent! *cql-stack*) res]))
     (trim
      (interpolate-kv select-query
                      {:column-family-name column-family


read-batch requires peer-replica view

read-batch requires peer-replica view

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -398,7 +398,7 @@
       (while (first (alts!! [seal-ch kill-ch] :default true))
         (->> init-event
              (inject-batch-resources compiled-before-batch-fn pipeline)
-             (read-batch task-type replica job-id pipeline)
+             (read-batch task-type replica peer-replica-view job-id pipeline)
              (tag-messages task-type replica id job-id max-acker-links)
              (add-messages-to-timeout-pool task-type state)
              (try-complete-job pipeline)


extract/cites.clj: handle null HTML in link-citations

--- src/org/altlaw/extract/cites.clj
+++ src/org/altlaw/extract/cites.clj
@@ -7,14 +7,15 @@
   (re-seq *citation-regex* text))

 (defn link-citations [html]
-  (let [buffer (StringBuffer.)
-        matcher (re-matcher *citation-regex* html)]
-    (loop []
-      (if (.find matcher)
-        (let [cite (.group matcher)
-              link (str "" cite "")]
-          (.appendReplacement matcher buffer link)
-          (recur))
-        (do (.appendTail matcher buffer)
-            (str buffer))))))
+  (when html
+    (let [buffer (StringBuffer.)
+          matcher (re-matcher *citation-regex* html)]
+      (loop []
+        (if (.find matcher)
+          (let [cite (.group matcher)
+                link (str "" cite "")]
+            (.appendReplacement matcher buffer link)
+            (recur))
+          (do (.appendTail matcher buffer)
+              (str buffer)))))))


build.boot refactor

build.boot refactor

--- build.boot
+++ build.boot
@@ -157,9 +157,10 @@
   "Runs the tests in a browser environment."
   [o opt    VAL kw "The optimization level for the cljs compiler."
    e js-env VAL kw "The js environment."]
-  (let [opt (or opt :none)]
+  (let [opt    (or opt :none)
+        js-env (or js-env :slimer)]
     (comp (testing)
-          (boot-cljs-test/test-cljs :js-env        (or js-env :slimer)
+          (boot-cljs-test/test-cljs :js-env        js-env
                                     :namespaces    cljs-test-namespaces
                                     :optimizations opt
                                     :cljs-opts     cljs-compiler-opts))))
@@ -170,10 +171,11 @@
    t target       VAL kw   "The target for the cljs compiler."
    o opt          VAL kw   "The optimization level for the cljs compiler."
    s self-hosted?     bool "True if self-hosted."]
-  (let [platform (or platform :clj)]
+  (let [platform (or platform :clj)
+        target   (or target :browser)]
     (case platform
       :clj  (test-clj)
-      :cljs (case (or target :browser)
+      :cljs (case target
               :browser (test-browser :opt    opt
                                      :js-env :slimer)
               :nodejs  (test-node :opt          opt
@@ -183,9 +185,10 @@
   "Compiles the cljs source files."
   [o opt VAL kw  "The compiler optimization level."
    i id  VAL str "The id of the build."]
-  (let [opt (or opt :none)]
+  (let [opt (or opt :none)
+        id  (or id "browser/index")]
     (boot-cljs/cljs
-      :ids              [(fix-slashes (or id "browser/index"))]
+      :ids              [(fix-slashes id)]
       :compiler-options (assoc cljs-compiler-opts :optimizations opt))))

 (deftask run-browser-repl


Use the 0.1.0 release of boot-junit

Use the 0.1.0 release of boot-junit

--- build.boot
+++ build.boot
@@ -1,6 +1,6 @@
 (set-env!
  :source-paths #{"src/main/java" "src/test/java"}
- :dependencies '[[radicalzephyr/boot-junit "0.1.0-SNAPSHOT" :scope "test"]])
+ :dependencies '[[radicalzephyr/boot-junit "0.1.0" :scope "test"]])

 (def +version+ "0.1.0")


Exclude log4j dep from ring.middleware.logger

--- build.boot
+++ build.boot
@@ -37,7 +37,8 @@
                             [http-kit "2.2.0"]
                             [compojure "1.5.2"]
                             [ring.middleware.logger "0.5.0"
-                             :exclusions [[org.slf4j/slf4j-log4j12 :extension "jar"]]]
+                             :exclusions [[log4j :extension "jar"]
+                                          [org.slf4j/slf4j-log4j12 :extension "jar"]]]
                             [fogus/ring-edn "0.3.0"]
                             [hiccup "1.0.5"]
                             [garden "1.3.2"]


Remove println

Remove println

--- build.boot
+++ build.boot
@@ -50,7 +50,6 @@
                                             (clojure.string/replace #"\." "/")
                                             (clojure.string/replace #"-" "_")
                                             (str ".clj")))]
-          (println f)
           (clojure.java.io/make-parents f)
           (spit f (format "(ns %s)\n\n(def +version+ \"%s\")" (name namespace) +version+)))
         (next-handler (-> fileset (add-resource d) commit!))))))


Use the correct print function in run-sym

--- build.boot
+++ build.boot
@@ -139,9 +139,9 @@
                          (v)
                          (util/warn "Could not find var '%s\n" s))))]
     (when (exists-but-no-ns? before)
-      (util/warn "Before symbol `%s` should be fully namespace qualified.\n" (prn-str before)))
+      (util/warn "Before symbol `%s` should be fully namespace qualified.\n" (pr-str before)))
     (when (exists-but-no-ns? after)
-      (util/warn "After symbol `%s` should be fully namespace qualified.\n" (prn-str after)))
+      (util/warn "After symbol `%s` should be fully namespace qualified.\n" (pr-str after)))
     (comp
      (if before
        (with-pass-thru _


version bump util set

version bump util set

--- build.boot
+++ build.boot
@@ -1,7 +1,7 @@
 (set-env!
   :source-paths #{"src"}
   :dependencies '[[org.clojure/clojure       "1.7.0" :scope "provided"]
-                  [degree9/boot-d9micromgmt  "0.1.1"]
+                  [degree9/boot-d9micromgmt  "0.1.2"]
                   [boot/core                 "2.1.2"]])

 (require '[degree9.boot-d9micromgmt :refer :all])


Only build snapshot/release JARs once

Only build snapshot/release JARs once

--- build.boot
+++ build.boot
@@ -144,7 +144,6 @@
   (comp
     (pom)
     (jar)
-    (build-jar)
     (push-snapshot)))

 (deftask deploy-release
@@ -152,5 +151,4 @@
   (comp
     (pom)
     (jar)
-    (build-jar)
     (push-release)))