shorten looping-go function

shorten looping-go function

--- src/brainbot/nozzle/async_helper.clj
+++ src/brainbot/nozzle/async_helper.clj
@@ -10,6 +10,20 @@
      (when-not (or (nil? r) (nil? ch))
        (>! ch r)))))

+(defn- looping-go*
+  [ms f ctrl-ch dest-ch]
+  (go
+   (try
+     (when (<! ctrl-ch)
+       (loop []
+         (<! (call-and-put f dest-ch))
+         (async/alt!
+          ctrl-ch ([v] (when-not (nil? v) (recur)))
+          (async/timeout ms) ([v] (recur)))))
+     (finally
+       (when-not (nil? dest-ch)
+         (close! dest-ch))))))
+
 (defn looping-go
   "call f in a loop from a go block. f must return a channel, from
 which we read one message, put the result on dest-ch if given. sleep
@@ -18,17 +32,7 @@
   (assert (ifn? f) "f must be a function")
   (let [ctrl-ch (chan)
         dest-ch (chan)]
-    (go
-     (try
-       (when (<! ctrl-ch)
-         (loop []
-           (<! (call-and-put f dest-ch))
-           (async/alt!
-            ctrl-ch ([v] (when-not (nil? v) (recur)))
-            (async/timeout ms) ([v] (recur)))))
-       (finally
-         (when-not (nil? dest-ch)
-           (close! dest-ch)))))
+    (looping-go* ms f ctrl-ch dest-ch)
     (when start
       (put! ctrl-ch true))
     {::ctrl-ch ctrl-ch :dest-ch dest-ch}))


file upload content, assertion upload content

--- src/cljs/salava/badge/ui/upload.cljs
+++ src/cljs/salava/badge/ui/upload.cljs
@@ -65,10 +65,10 @@
   [:div
    [:p
     (t :badge/Uploadbadgesfrominfo1) ":"]
-   [:ol
+   [:ul
     [:li {:dangerouslySetInnerHTML
-          {:__html (t :badge/Uploadbadgesfrominfo2)}}]
-    [:li {:dangerouslySetInnerHTML
+          {:__html (str (t :badge/Uploadbadgesfrominfo2) " " (t :badge/Uploadbadgesfrominfo3))}}]
+    #_[:li {:dangerouslySetInnerHTML
           {:__html (t :badge/Uploadbadgesfrominfo3)}}]]
    [:p
     (t :badge/Uploadbagesfromresult1) " "
@@ -79,12 +79,10 @@

 (defn assertion-upload-info []
   [:div
-   [:p (t :badge/Uploadbadgesviaassertioninfo1)]
-   [:ol
+   [:p (t :badge/Importbadgesviaassertioninfo1)]
+   [:ul
     [:li {:dangerouslySetInnerHTML
-          {:__html (t :badge/Uploadbadgesviaassertioninfo2)}}]
-    [:li {:dangerouslySetInnerHTML
-          {:__html (t :badge/Uploadbadgesviaassertioninfo3)}}]]
+          {:__html (str (t :badge/Importbadgesviaassertioninfo2) " " (t :badge/Importbadgesviaassertioninfo3))}}]]
    [:p
     (t :badge/Uploadbagesfromresult1) " "
     [:a {:href (path-for "/badge/mybadges")} (t :badge/Mybadges)] " " (t :badge/page) ". "
@@ -95,7 +93,7 @@
 (defn badge-file-upload-content [state]
   (let [status  (:status @state)]
     [:div
-     [:h1.uppercase-header (t :badge/Uploadbadgesfrom)]
+     [:h1.uppercase-header (t :badge/Importbadges)]
      [upload-info]
      (cond
        (= "loading" status) [:div.ajax-message
@@ -106,13 +104,14 @@
                                       :aria-label "Choose file"
                                       :name       "file"
                                       :on-change  #(send-file state)
-                                      :accept     "image/png, image/svg+xml"}]])]))
+                                      :accept     "image/png, image/svg+xml"}]])
+     [:br]]))

 (defn assertion-url-upload-content [state]
   (let [assertion-url (cursor state [:assertion-url])
         status  (:status @state)]
     [:div
-     [:h1.uppercase-header (t :badge/Uploadbadgesviaassertion)]
+     [:h1.uppercase-header (t :badge/Importbadgesviaassertion)]
      [assertion-upload-info]
      (cond
        (= "loading" status) [:div.ajax-message
@@ -125,9 +124,10 @@
                                         :on-click #(do
                                                      (swap! state assoc :status "loading")
                                                      (send-assertion state))
-                                        } (t :file/Upload)]]])]))
+                                        } (t :badge/ImportBadge)]]])
+     [:br]]))

-(defn content [state]
+#_(defn content [state]
   (let [status  (:status @state)
         assertion-url (cursor state [:input-assertion-url])
         selection-atom (cursor state [:input-upload-method])]
@@ -153,7 +153,7 @@
           (assertion-url-upload-content state)
           (badge-file-upload-content state))]

-       #_[:div
+       [:div
           [upload-info]
           (cond
             (= "loading" status) [:div.ajax-message
@@ -166,13 +166,13 @@
                                            :on-change  #(send-file state)
                                            :accept     "image/png, image/svg+xml"}]])])]))

-(defn init-data [state]
+#_(defn init-data [state]
   (ajax/GET (path-for "/obpv1/user/public-access")
             {:handler (fn [data]
                         (swap! state assoc :permission "success"))}
             (fn [] (swap! state assoc :permission "error"))))

-(defn handler [site-navi]
+#_(defn handler [site-navi]
   (let [state (atom {:status "form"
                      :permission "initial"})]
     (init-data state)


emap: into-ds

emap: into-ds

--- src/clojure/migae/datastore/emap.clj
+++ src/clojure/migae/datastore/emap.clj
@@ -97,6 +97,7 @@
   [keychain & valmap]
   (get-ds keychain))

+;; FIXME: custom exception
 (defn into-ds
   ([keychain em]
    "non-destructively update datastore; fail if entity already exists"
@@ -105,11 +106,16 @@
      (throw (IllegalArgumentException. "keychain vector must not be empty"))
      (let [k (apply ekey/keychain-to-key keychain)
            e (try (.get (ds/datastore) k)
-                  ;; (catch EntityNotFoundException e nil)
-                  (catch DatastoreFailureException e (throw e))
-                  (catch java.lang.IllegalArgumentException e (throw e)))
+                  (catch EntityNotFoundException e nil))
+                  ;; (catch DatastoreFailureException e (throw e))
+                  ;; (catch java.lang.IllegalArgumentException e (throw e)))
            ]
-       (if (nil? e) ;; not found
+       ;; FIXME: test for exception type instead?
+       ;; (case e
+       ;;   PersistentEntityMap (throw (RuntimeException. (str "key already exists: " keychain)))
+       ;;   EntityNotFoundException ...
+       ;;   (throw ...)) ;; default case
+       (if (nil? e) ;; not found, so go ahead and construct
          (let [e (Entity. k)]
            (doseq [[k v] em]
              (.setProperty e (subs (str k) 1) (get-val-ds v)))
@@ -139,10 +145,10 @@
   ([keychain]
    (into-ds! keychain)))
 (defn emap!
+  ([keychain]
+   (into-ds! keychain))
   ([keychain em]
-   (into-ds! keychain em))
-  ([keychain]
-   (into-ds! keychain)))
+   (into-ds! keychain em)))

 (defn put-kinded-emap
   [keychain & data]


more bug fixes, still needs work

more bug fixes, still needs work

--- src/semitone/core.clj
+++ src/semitone/core.clj
@@ -1,9 +1,17 @@
 #!/usr/bin/env boot

+;; TODO:
+;;   displacement syntax < >
+;;   MPE support
+;;   :transpose
+;;   :time-signature
+
 (ns semitone.core)

-(import [javax.sound.midi
-         MidiSystem MidiMessage MetaMessage MetaEventListener
+(use '[clojure.pprint :only [pprint]])
+
+(import [javax.sound.midi
+         MidiSystem MidiMessage MetaMessage MetaEventListener
          SysexMessage ShortMessage Sequencer Sequence MidiEvent Track]
         [java.nio ByteBuffer])

@@ -13,16 +21,21 @@
     (if (map? (first notes))
       (do
         (when (contains? (first notes) :tempo)
-          (let [track (get (.getTracks (.getSequence (:sequencer state))) (:track state))]
-            (.add (:track state)
+          (let [track (aget (.getTracks (.getSequence (:sequencer state))) (:track state))]
+            (.add track
                   (MidiEvent.
                    (MetaMessage. 0x51
-                                 (.array (.putInt (ByteBuffer/allocate 3) (int (* (/ 1 (get (first notes) :tempo)) 60 1e6)))) 3)
+                                 (.array
+                                  (.put (ByteBuffer/allocate 3)
+                                        (.array (.putInt
+                                                 (ByteBuffer/allocate 4)
+                                                 (int (* (/ 1 (get (first notes) :tempo)) 60 1e6))))
+                                        1 3))
+                                 3)
                    (:position state))))
           (merge state (first notes) {:notes (rest notes)})))
       state)))

-;; TODO: displacement syntax < >
 (defn parse-length [notes state]
   (if (empty? notes)
     state
@@ -34,16 +47,16 @@
                       :length (Math/abs (* 4.0 length ppq))
                       :notes (rest notes)})
         (symbol? length)
-        (if-let [m (re-matches #"(-|)((?:[dwhqistxofjk]\.*)+)" (name length))]
-          (let [length-map {"d" 2 "w" 1 "h" 1/2 "q" 1/4 "i" 1/8 "s" 1/16 "t" 1/32
-                            "x" 1/64 "o" 1/128 "f" 1/256 "j" 1/512 "k" 1/1024}]
+        (if-let [m (re-matches #"(-|)((?:[xwhqistjlmno]\.*)+)" (name length))]
+          (let [length-map {"x" 2 "w" 1 "h" 1/2 "q" 1/4 "i" 1/8 "s" 1/16 "t" 1/32
+                            "j" 1/64 "l" 1/128 "m" 1/256 "n" 1/512 "o" 1/1024}]
             (merge state {:key (if (= "-" (get m 1)) nil (:key state))
                           :length (reduce +
                                           (map #(* 4.0
                                                    (get length-map (get % 1))
                                                    (- 2.0 (/ 1.0 (reduce * (repeat (count (get % 2)) 2))))
                                                    ppq)
-                                               (re-seq #"\G([dwhqistxofjk])(\.*)" (get m 2))))
+                                               (re-seq #"\G([xwhqistjlmno])(\.*)" (get m 2))))
                           :notes (rest notes)}))
           (if-let [m (re-matches #"([-=])[-=]*" (name length))]
             (merge state {:length (* (:length state) (count (name length)))
@@ -90,11 +103,13 @@
                             :param nil
                             :notes (rest notes)})
               ;; channel pressure, pitch bend, note on/off / key pressure by key number
-              (if-let [m (re-matches #"(&&|\^|&k|k|-k)(>+|<+|)(-?(?:[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.[0-9]*|)(?:[eE]-?[0-9]+)?)?(-|)" note)]
+              (if-let [m (re-matches #"(&&|\^|&k|k|-k)(>+|<+|)(-?(?:[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.[0-9]*)(?:[eE]-?[0-9]+)?|)(-|)" note)]
                 (let [max-value (if (= "^" (get m 1)) 16384 128)
                       value (if (re-find #"[.eE]" (get m 3))
                               (max 0 (min max-value (int (* (Double. (get m 3)) max-value))))
-                              (mod (Integer. (get m 3)) max-value))
+                              (mod (if (= "" (get m 3))
+                                     (if (= "" (get m 2)) 0 1)
+                                     (Integer. (get m 3))) max-value))
                       param ({"&&" :channel-pressure "^" :pitch-bend "&k" :key-pressure "k" :key} (get m 1))
                       old-value (get state param)
                       value (cond
@@ -134,22 +149,26 @@
     state
     (let [token (first notes)
           token (if (or (= (type token) Long) (= (type token) Double)) (str token) (name token))]
-      (if (re-matches #"((!|\?|&|)(>+|<+|)(-?(?:[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.[0-9]*|)(?:[eE]-?[0-9]+)?)?)+" token)
+      (if (re-matches #"((!|\?|&|)(>+|<+|)(-?(?:[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.[0-9]*)(?:[eE]-?[0-9]+)?|))+" token)
         (merge
          (apply merge state
-                (map #(let [param (get {"!" :attack  "?" :release "&" :key-pressure} (get % 1) (:param state))
-                            max-value (if (= param :pitch-bend) 16384 128)
-                            value (if (re-find #"[.eE]" (get % 3))
-                                    (if (= param :pitch-bend)
-                                      (max 0 (min max-value (int (* (/ (+ 1.0 (Double. (get % 3))) 2.0) max-value))))
-                                      (max 0 (min max-value (int (* (Double. (get % 3)) max-value)))))
-                                    (mod (Integer. (get % 3)) max-value))
-                            value (cond
-                                    (= \> (get (get % 2) 0)) (mod (+ (param state) (or value 0) (- (count (get % 2)) 1)) max-value)
-                                    (= \< (get (get % 2) 0)) (mod (- (param state) (or value 0) (- (count (get % 2)) 1)) max-value)
-                                    :else value)]
-                        {param value})
-                     (re-seq #"\G(!|\?|&|@|)(>+|<+|)(-?(?:[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.[0-9]*|)(?:[eE]-?[0-9]+)?)?" token)))
+                (mapcat #(if (= "" (get % 0)) []
+                             (let [param (get {"!" :attack  "?" :release "&" :key-pressure} (get % 1) (:param state))
+                                   old-value (get state param)
+                                   max-value (if (= param :pitch-bend) 16384 128)
+                                   value (if (re-find #"[.eE]" (get % 3))
+                                           (if (= param :pitch-bend)
+                                             (max 0 (min max-value (int (* (/ (+ 1.0 (Double. (get % 3))) 2.0) max-value))))
+                                             (max 0 (min max-value (int (* (Double. (get % 3)) max-value)))))
+                                           (mod (if (= "" (get % 3))
+                                                  (if (= "" (get % 2)) 0 1)
+                                                  (Integer. (get % 3))) max-value))
+                                   value (cond
+                                           (= \> (get (get % 2) 0)) (mod (+ old-value (or value 0) (- (count (get % 2)) 1)) max-value)
+                                           (= \< (get (get % 2) 0)) (mod (- old-value (or value 0) (- (count (get % 2)) 1)) max-value)
+                                           :else value)]
+                               [{param value}]))
+                     (re-seq #"\G(!|\?|&|@|)(>+|<+|)(-?(?:[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.[0-9]*)(?:[eE]-?[0-9]+)?|)" token)))
          {:notes (rest notes)})
         state))))

@@ -159,17 +178,19 @@
                       :notes notes
                       :displacement 0
                       :attack 64
-                      :release 64
+                      :release 0
                       :channel-pressure 0
                       :pitch-bend 8192
                       :key-pressure 0
                       :position (.getTickPosition sequencer)
                       :tie nil
-                      :key 0
+                      :key 60
                       :key-type ShortMessage/NOTE_ON
                       :channel 0
                       :track 0
                       :key-signature {}
+                      :time-signature [4 4]
+                      :transpose 0
                       :octave 4
                       :param :octave
                       :cc-value 0
@@ -187,19 +208,21 @@
                              {:notes (rest notes)}
                              (if (vector? notes) {:position position} {}))
                       (map? (first notes))
-                      (parse-state (first notes) state)
+                      (parse-state notes state)
+                      (keyword? (first notes))
+                      (parse-state (cons {(first notes) (first (rest notes))} (rest (rest notes))) state)
                       :else
                       (let [notes (:notes state)
+                            state (parse-param (:notes state) state)
                             state (parse-length (:notes state) state)
                             state (parse-note (:notes state) state)
-                            state (parse-param (:notes state) state)
                             value (get {ShortMessage/NOTE_ON (:attack state)
                                         ShortMessage/CHANNEL_PRESSURE (:channel-pressure state)
                                         ShortMessage/CONTROL_CHANGE (:cc-change state)
                                         ShortMessage/PITCH_BEND (:pitch-bend state)
                                         ShortMessage/POLY_PRESSURE (:key-pressure state)}
                                        (:key-type state) 0)
-                            track (get (.getTracks (.getSequence (:sequencer state))) (:track state))]
+                            track (aget (.getTracks (.getSequence (:sequencer state))) (:track state))]
                         (when (= (count notes) (count (:notes state)))
                           (throw (Exception. (format "Couldn't parse note: %s" (str (first notes))))))
                         (cond
@@ -232,20 +255,54 @@
         state))))

 (defn play [sequencer notes & [state]]
-  (compose sequencer notes state)
-  ;; wait for sequencer to finish playing
-  (.start sequencer)
-  (while (.isRunning sequencer) (Thread/sleep 250)))
+  (let [state (compose sequencer notes state)]
+    ;; wait for sequencer to finish playing
+    (.start sequencer)
+    (while (.isRunning sequencer) (Thread/sleep 100))
+    state))
+
+(defmethod print-method Sequence [sequence writer]
+  (doseq [t (range (alength (.getTracks sequence)))]
+    (let [track (aget (.getTracks sequence) t)]
+      (doseq [e (range (.size track))]
+        (let [event (.get track e)
+              tick (.getTick event)
+              message (.getMessage event)]
+          (cond
+            (= (type message) ShortMessage)
+            (print-simple (format "Track %d: tick %d: ShortMessage(channel=%d, command=%s, data1=%d, data2=%d)\n"
+                                  t tick
+                                  (.getChannel message)
+                                  (get {ShortMessage/CHANNEL_PRESSURE "CHANNEL_PRESSURE"
+                                        ShortMessage/CONTROL_CHANGE "CONTROL_CHANGE"
+                                        ShortMessage/NOTE_OFF "NOTE_OFF"
+                                        ShortMessage/NOTE_ON "NOTE_ON"
+                                        ShortMessage/PITCH_BEND "PITCH_BEND"
+                                        ShortMessage/POLY_PRESSURE "POLY_PRESSURE"
+                                        ShortMessage/PROGRAM_CHANGE "PROGRAM_CHANGE"}
+                                       (.getCommand message)
+                                       (str (.getCommand message)))
+                                  (.getData1 message)
+                                  (.getData2 message)) writer)
+            (= (type message) MetaMessage)
+            (print-simple (format "Track %d: tick %d: MetaMessage(type=%x, data=%s)\n"
+                                  t tick
+                                  (.getType message)
+                                  (clojure.string/join "," (.getData message))) writer)
+            (= (type message) SysexMessage)
+            (print-simple (format "Track %d: tick %d: SysexMessage(data=%s)\n"
+                                  t tick
+                                  (clojure.string/join "," (.getData message))) writer)
+            :else (print-simple (format "Track %d: tick %d: %s()"
+                                        t tick (type message)) writer)))))))

 (defn -main [& args]
-  (println "Try to play sequence")
-
   ;; initialize the sequencer
   (def sequencer (MidiSystem/getSequencer))
   (.addMetaEventListener sequencer
                         (reify MetaEventListener
                           (meta [meta]
-                            (.setTempoInMPQ sequencer (float (.getInt (.put (ByteBuffer/allocate 3) (.getData meta))))))))
+                            (.setTempoInMPQ sequencer (float (.getInt (.put (ByteBuffer/allocate 4) (.getData meta) 1 3)))))))
   (.setSequence sequencer (Sequence. Sequence/PPQ 256))
   (.createTrack (.getSequence sequencer))
   (.open sequencer)
@@ -255,11 +312,13 @@
   (.open synth)
   (.setReceiver (.getTransmitter sequencer) (.getReceiver synth))

-  ;; set sequncer to loop continuously
+  ;; set sequencer to loop continuously
   ;; (.setLoopStartPoint sequencer 0)
   ;; (.setLoopEndPoint sequencer -1)
   ;; (.setLoopCount sequencer Sequencer/LOOP_CONTINUOUSLY)

   ;; add some music to the sequencer and start
-  (play sequencer `(c d e f g a b)))
-
+  ;; (pprint (play sequencer `(:tempo 120 i c d e f g a b > c)))
+  (pprint (play sequencer `(=== == =)))
+  (println (.getSequence sequencer)))
+


Indentation fixes

Indentation fixes

--- src/skat/gameplay.clj
+++ src/skat/gameplay.clj
@@ -150,7 +150,7 @@

 (defn deal-end2end "Deal cards, auction and play 10 tricks" [driver bidders]
   { :pre [driver bidders] }
-  (let [auction-result (perform-auction driver bidders)
+  (let [auction-result  (perform-auction driver bidders)
         bidding         (:bidding auction-result)
         solist          (:winner bidding)
         solist-position (-> bidders sets/map-invert (find solist) (get 1))
@@ -174,11 +174,11 @@
 (defn start-game "Start game using passed driver" [driver]
   { :pre [driver] }
   (let [rounds-in-tournament 10
-        initial-bidders     (.create-players ^GameDriver driver)
-        player-1            (:front  initial-bidders)
-        player-2            (:middle initial-bidders)
-        player-3            (:rear   initial-bidders)
-        initial-points      { player-1 0, player-2 0, player-3 0 }]
+        initial-bidders      (.create-players ^GameDriver driver)
+        player-1             (:front  initial-bidders)
+        player-2             (:middle initial-bidders)
+        player-3             (:rear   initial-bidders)
+        initial-points       { player-1 0, player-2 0, player-3 0 }]
     (letfn [(rotate-bidders [b]
               (zipmap (map game/player-in-next-deal (keys b)) (vals b)))
             (update-points [points { :keys [:solist :success? :game-value] }]


Refactor stepping-static-color

Refactor stepping-static-color

--- src/sparkle/layer.clj
+++ src/sparkle/layer.clj
@@ -29,18 +29,30 @@
            (fmap #(* % brightness-factor) pixel))
           frame)))

-(defn stepping-static-color [color interval]
+(defn wrapping-march
+  "Like range, but starts counting up from 0 when it reaches wrap-point"
+  ([start n wrap-point]
+   (wrapping-march start n wrap-point 1))
+  ([start n wrap-point step]
+   (mapv (fn [pos]
+          (if (>= pos wrap-point)
+            (mod pos wrap-point)
+            pos))
+    (range start (+ (* step n) start) step))))
+
+(defn stepping-static-color [color interval width initial-offset]
   (fn
-    ([{:keys [time]} frame]
-     {:frame (assoc frame 0 color)
-      :state {:offset 0 :last-time time}})
-    ([{:keys [time]} {:keys [offset last-time] :as state} frame]
-     (if (>= (- time last-time) interval)
-       (let [new-offset (mod (inc offset) (count frame))]
-         {:frame (assoc frame new-offset color)
-          :state {:offset new-offset :last-time time}})
-       {:frame (assoc frame offset color)
-        :state  state}))))
+    ([env frame]
+     ((stepping-static-color color interval width initial-offset)
+      env {:offset initial-offset :last-time 0} frame))
+    ([{:keys [time]} {prev-offset :offset last-time :last-time :as state} frame]
+     (let [[offset last-time] (if (>= (- time last-time) interval)
+                                [(mod (inc prev-offset) (count frame)) time]
+                                [prev-offset last-time])]
+        {:frame (apply assoc frame (interleave (wrapping-march offset width (count frame))
+                                               (repeat color)))
+         :state {:offset offset :last-time last-time}}))))
+

 (defn check-frame
   "Verify that a layer didn't make an invalid change to the frame."


Don't freak out when cleaning an already-clean project.

--- src/leiningen/clean.clj
+++ src/leiningen/clean.clj
@@ -6,4 +6,4 @@
   (delete-file (str (:root project) "/" (:name project) ".jar") true)
   (doseq [d ["classes" "lib"]]
     (println "Cleaning " d) ;; TODO: use clojure.contrib.logging
-    (delete-file-recursively (file (:root project) d))))+    (delete-file-recursively (file (:root project) d) true)))


add tests for build-that-was-retriggered (#84)

--- test/clj/lambdacd/presentation/pipeline_state_test.clj
+++ test/clj/lambdacd/presentation/pipeline_state_test.clj
@@ -138,3 +138,10 @@
     (is (= after-stop-time (latest-most-recent-update {'(0) {:status :success :most-recent-update-at stop-time :first-updated-at start-time}
                                                        '(1) {:status :success :most-recent-update-at after-stop-time :first-updated-at start-time}})))))

+(deftest build-that-was-retriggered-test
+  (testing "that the retrigger-mock of the first build step indicates the build number that was retriggered for this build"
+    (is (= 3 (build-that-was-retriggered {'(2) {:status :success :most-recent-update-at stop-time :first-updated-at start-time}
+                                          '(1) {:status :success :most-recent-update-at stop-time :first-updated-at before-start-time :retrigger-mock-for-build-number 3}}))))
+  (testing "that nil is returned if the build wasn't retriggered"
+    (is (= nil (build-that-was-retriggered {'(2) {:status :success :most-recent-update-at stop-time :first-updated-at start-time}
+                                            '(1) {:status :success :most-recent-update-at stop-time :first-updated-at before-start-time}})))))


Fix docs for jdbc.internal

Fix docs for jdbc.internal

--- src/com/puppetlabs/jdbc/internal.clj
+++ src/com/puppetlabs/jdbc/internal.clj
@@ -1,6 +1,7 @@
-;; ## internal (private-ish) helper functions for com.puppetlabs.jdbc.  External
-;;  code should not call any of these functions directly, as they are subject
-;;  to change without notice.
+;; ## JDBC helper functions
+;;
+;; *External code should not call any of these functions directly, as they are*
+;; *subject to change without notice.*

 (ns com.puppetlabs.jdbc.internal
   (:use [clojure.string :only (join)])


don't reveal hidden cards during manual move

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -548,20 +548,19 @@
     (system-msg state side "advance a card")))

 (defn move-card [state side {:keys [card server]}]
-  (case server
-    ("Heap" "Archives")
-    (do (trash state side card)
-        (system-msg state side (str "trashes " (if (or (= (:side card) "Runner") (:rezzed card))
-                                                 (:title card)
-                                                 "a card"))))
-    ("HQ" "Grip")
-    (do (move state side (dissoc card :seen :rezzed) :hand)
-        (system-msg state side (str "moves " (:title card) " to " server)))
-    ("Stack" "R&D")
-    (do (move state side (dissoc card :seen :rezzed) :deck)
-        (system-msg state side (str "moves " (:title card) " to the top of " server)))
-
-    nil))
+  (let [label (if (or (= (:side card) "Runner") (:rezzed card) (:seen card))
+                (:title card) "a card")]
+    (case server
+      ("Heap" "Archives")
+      (do (trash state side card)
+          (system-msg state side (str "trashes " label)))
+      ("HQ" "Grip")
+      (do (move state side (dissoc card :seen :rezzed) :hand)
+          (system-msg state side (str "moves " label " to " server)))
+      ("Stack" "R&D")
+      (do (move state side (dissoc card :seen :rezzed) :deck)
+          (system-msg state side (str "moves " label " to the top of " server)))
+      nil)))

 (defn click-run [state side {:keys [server] :as args}]
   (when (pay state :runner :click 1)


[ref] Extract calc-money func for create-fee

--- src/ombs/db/payment.clj
+++ src/ombs/db/payment.clj
@@ -46,9 +46,15 @@
   (mapv #(first (vals %)) (sql/select participants (sql/fields :user)
                                       (sql/where {:event ename :date edate}))))

+(defn calc-fee-money [uid eid parts]
+  (if (> parts 0)
+    (parts-price eid parts)
+    (get-debt uname ename date)) )
+
 (defn create-fee [uname ename date & [parts]]
-  (sql/insert fees (sql/values {:users_id (get-uid uname) :events_id (get-eid ename date)
-                                :parts parts
-                                :money (if (> parts 0)
-                                         (parts-price (get-eid ename date) parts)
-                                         (get-debt uname ename date)) } )))
+  (let [uid (get-uid uname)
+        eid (get-eid ename date) ]
+    (sql/insert fees (sql/values {:users_id uid
+                                  :events_id eid
+                                  :parts parts
+                                  :money (calc-fee-money uid eid parts) }))))


Use error-string in view/event.

Use error-string in view/event.

--- src/ombs/view/event.clj
+++ src/ombs/view/event.clj
@@ -4,6 +4,7 @@
     [noir.session :as sess]
     [noir.validation :as vld]
     [ombs.core :as core]
+    [ombs.validate :refer [errors-string]]
     [clj-time.format :refer [formatter unparse]]
     [clj-time.local :refer [local-now]]
     [clj-time.core :refer [date-time]]
@@ -20,7 +21,7 @@
   [users]
   [:.users] (h/content ( map #(usercheckbox-elem %) users) )
   [:#edate] (h/set-attr :value (unparse (formatter "YYYY-MM-dd") (local-now) ) )
-  [:#error] (h/content (reduce str (map #(str "|" % "|") (vld/get-errors :event))))
+  [:#error] (h/content (errors-string :event))
   )

 (def event-sel [:.event])


Remove unused require of cljs.analyzer

Remove unused require of cljs.analyzer

--- src/main/clojure/clara/rules/dsl.clj
+++ src/main/clojure/clara/rules/dsl.clj
@@ -8,7 +8,6 @@
             [clara.rules.engine :as eng]
             [clara.rules.compiler :as com]
             [clara.rules.schema :as schema]
-            [cljs.analyzer :as ana] ; TODO: make CLJS dep optional?
             [schema.core :as sc]))


Be consistent with clojure convention for functions names that mutate state !

--- src/plan_schema/cli.clj
+++ src/plan_schema/cli.clj
@@ -95,7 +95,7 @@
     (string/join \newline)))

 (def test-mode false)
-(defn set-test-mode [value]
+(defn set-test-mode! [value]
   (def test-mode value))

 (defn repl?


Further work on docstrings. Also unify text fns and replace foo->bar in favour of text-type style to match other overloaded fns.

--- src/processing/core.clj
+++ src/processing/core.clj
@@ -649,11 +649,57 @@
   Math/PI*2). Values are returned in the range -1 to 1."
   [angle] (PApplet/cos (float angle)))

+(def available-fonts
+  "A sequence of strings representing the fonts on this system
+  available for use.
+
+  Because of limitations in Java, not all fonts can be used and some
+  might work with one operating system and not others. When sharing a
+  sketch with other people or posting it on the web, you may need to
+  include a .ttf or .otf version of your font in the data directory of
+  the sketch because other people might not have the font installed on
+  their computer. Only fonts that can legally be distributed should be
+  included with a sketch."
+  (seq (PFont/list)))
+
+(defn font-available?
+  "Returns true if font (specified as a string) is available on this
+  system, false otherwise"
+  [font-str]
+  (if (some #{font-str} available-fonts)
+    true
+    false))
+
 (defn create-font
-  ([name size] (.createFont *applet* name (float size)))
-  ([name size smooth] (.createFont *applet* name (float size) smooth))
+  "Dynamically converts a font to the format used by Processing (a
+  PFont) from either a font name that's installed on the computer, or
+  from a .ttf or .otf file inside the sketches 'data' folder. This
+  function is an advanced feature for precise control.
+
+  Use available-fonts to obtain the names for the fonts recognized by
+  the computer and are compatible with this function.
+
+  The size parameter states the font size you want to generate. The
+  smooth parameter specifies if the font should be antialiased or not,
+  and the charset parameter is an array of chars that specifies the
+  characters to generate.
+
+  This function creates a bitmapped version of a font It loads a font
+  by name, and converts it to a series of images based on the size of
+  the font. When possible, the text function will use a native font
+  rather than the bitmapped version created behind the scenes with
+  create-font. For instance, when using the default renderer
+  setting (JAVA2D), the actual native version of the font will be
+  employed by the sketch, improving drawing quality and
+  performance. With the P2D, P3D, and OPENGL renderer settings, the
+  bitmapped version will be used. While this can drastically improve
+  speed and appearance, results are poor when exporting if the sketch
+  does not include the .otf or .ttf file, and the requested font is
+  not available on the machine running the sketch."
+  ([name size] (.createFont *applet* (str name) (float size)))
+  ([name size smooth] (.createFont *applet* (str name) (float size) smooth))
   ([name size smooth ^chars charset]
-     (.createFont *applet* name (float size) smooth charset)))
+     (.createFont *applet* (str name) (float size) smooth charset)))

 (defn create-graphics
   ([w h renderer]
@@ -1231,7 +1277,28 @@

 (defn load-bytes [filename] (PApplet/loadBytes filename))

-(defn load-font [filename] (.loadFont *applet* filename))
+(defn load-font
+  "Loads a font into a variable of type PFont. To load correctly,
+  fonts must be located in the data directory of the current sketch.
+  To create a font to use with Processing use the create-font fn.
+
+  Like load-image and other methods that load data, the load-font fn
+  should not be used inside draw, because it will slow down the sketch
+  considerably, as the font will be re-loaded from the disk (or
+  network) on each frame.
+
+  For most renderers, Processing displays fonts using the .vlw font
+  format, which uses images for each letter, rather than defining them
+  through vector data. When hint :enable-native-fonts is used with the
+  JAVA2D renderer, the native version of a font will be used if it is
+  installed on the user's machine.
+
+  Using create-font (instead of load-font) enables vector data to be
+  used with the JAVA2D (default) renderer setting. This can be helpful
+  when many font sizes are needed, or when using any renderer based on
+  JAVA2D, such as the PDF library."
+  [filename]
+  (.loadFont *applet*  (str filename)))

 (defn load-image [filename] (.loadImage *applet* filename))

@@ -1822,43 +1889,187 @@
   [angle]
   (PApplet/tan (float angle)))

-(defn char->text
+(defn text-char
+  "Draws a char to the screen in the specified position. See text fn
+  for more details."
   ([c] (.text *applet* (char c)))
   ([c x y] (.text *applet* (char c) (float x) (float y)))
   ([c x y z] (.text *applet* (char c) (float x) (float y) (float z))))

-(defn num->text
+(defn text-num
+  "Draws a number to the screen in the specified position. See text fn
+  for more details."
   ([num x y] (.text *applet* (float num) (float x) (float y)))
   ([num x y z] (.text *applet* (float num) (float x) (float y) (float z))))

-(defn string->text
+(defn text
+  "Draws text to the screen in the position specified by the x and y
+  parameters and the optional z parameter. A default font will be used
+  unless a font is set with the text-font fn. Change the color of the
+  text with the fill fn. The text displays in relation to the
+  text-align fn, which gives the option to draw to the left, right, and
+  center of the coordinates.
+
+  The x1, y1, x2 and y2 (and optional z) parameters define a
+  rectangular area to display within and may only be used with string
+  data. For text drawn inside a rectangle, the coordinates are
+  interpreted based on the current rect-mode setting.
+
+  Use the text-mode function with the :screen parameter to display text
+  in 2D at the surface of the window."
   ([^String s] (.text *applet* s))
   ([^String s x y] (.text *applet* s (float x) (float y)))
-  ([^String s x y z] (.text *applet* s (float x) (float y) (float z))))
-
-(defn string->text-in
-  ([^String s x1 y1 x2 y2]
-     (.text *applet* s (float x1) (float y1) (float x2) (float y2)))
-  ([^String s x1 y1 x2 y2 z]
-     (.text *applet* s (float x1) (float y1) (float x2) (float y2) (float z))))
+  ([^String s x y z] (.text *applet* s (float x) (float y) (float z)))
+  ([^String s x1 y1 x2 y2] (.text *applet* s (float x1) (float y1) (float x2) (float y2)))
+  ([^String s x1 y1 x2 y2 z] (.text *applet* s (float x1) (float y1) (float x2) (float y2) (float z))))
+
+(def ^{:private true}
+  horizontal-alignment-modes {:left LEFT
+                              :center CENTER
+                              :right RIGHT})
+
+(defn ^{:private true}
+  vertical-alignment-modes {:top TOP
+                            :bottom BOTTOM
+                            :center CENTER
+                            :baseline BASELINE})
+
+(defn- resolve-horizontal-alignment-mode
+  [mode]
+  (if (keyword? mode)
+    (get horizontal-alignment-modes mode)
+    mode))
+
+(defn- resolve-vertical-alignment-mode
+  [mode]
+  (if (keyword? mode)
+    (get vertical-alignment-modes mode)
+    mode))

 (defn text-align
-  ([align] (.textAlign *applet* (int align)))
-  ([align-x align-y] (.textAlign *applet* (int align-x) (int align-y))))
-
-(defn text-ascent [] (.textAscent *applet*))
-
-(defn text-descend [] (.textDescent *applet*))
+  "Sets the current alignment for drawing text. Available modes are:
+
+  horizontal - :left, :center, and :right
+  vertical   - :top, :bottom, :center, and :baseline
+
+  An optional second parameter specifies the vertical alignment
+  mode. :baseline is the default. The :top and :center parameters are
+  straightforward. The :bottom parameter offsets the line based on the
+  current text-descent. For multiple lines, the final line will be
+  aligned to the bottom, with the previous lines appearing above it.
+
+  When using text with width and height parameters, :baseline is
+  ignored, and treated as :top. (Otherwise, text would by default draw
+  outside the box, since :baseline is the default setting. :baseline is
+  not a useful drawing mode for text drawn in a rectangle.)
+
+  The vertical alignment is based on the value of text-ascent, which
+  many fonts do not specify correctly. It may be necessary to use a
+  hack and offset by a few pixels by hand so that the offset looks
+  correct. To do this as less of a hack, use some percentage of
+  text-ascent or text-descent so that the hack works even if you
+  change the size of the font."
+  ([align]
+     (let [align (resolve-horizontal-alignment-mode align)]
+       (.textAlign *applet* (int align))))
+  ([align-x align-y]
+     (let [align-x (resolve-horizontal-alignment-mode align-x)
+           align-y (resolve-vertical-alignment-mode align-y)]
+       (.textAlign *applet* (int align-x) (int align-y)))))
+
+(defn text-ascent
+  "Returns the ascent of the current font at its current size. This
+  information is useful for determining the height of the font above
+  the baseline. For example, adding the text-ascent and text-descent
+  values will give you the total height of the line."
+  []
+  (.textAscent *applet*))
+
+(defn text-descent
+  "Returns descent of the current font at its current size. This
+  information is useful for determining the height of the font below
+  the baseline. For example, adding the text-ascent and text-descent
+  values will give you the total height of the line."
+  []
+  (.textDescent *applet*))

 (defn text-font
-  ([^PFont which] (.textFont *applet* which))
-  ([^PFont which size] (.textFont *applet* which (int size))))
-
-(defn text-leading [leading] (.textLeading *applet* (float leading)))
-
-(defn text-mode [mode] (.textMode *applet* (int mode)))
-
-(defn text-size [size] (.textSize *applet* (float size)))
+  "Sets the current font that will be drawn with the text
+  function. Fonts must be loaded with load-font before it can be
+  used. This font will be used in all subsequent calls to the text
+  function. If no size parameter is input, the font will appear at its
+  original size until it is changed with text-size.
+
+  Because fonts are usually bitmaped, you should create fonts at the
+  sizes that will be used most commonly. Using textFont without the
+  size parameter will result in the cleanest-looking text.
+
+  With the default (JAVA2D) and PDF renderers, it's also possible to
+  enable the use of native fonts via the command
+  (hint :enable-native-fonts). This will produce vector text in JAVA2D
+  sketches and PDF output in cases where the vector data is available:
+  when the font is still installed, or the font is created via the
+  create-font fn"
+  ([^PFont font] (.textFont *applet* font))
+  ([^PFont font size] (.textFont *applet* font (int size))))
+
+(defn text-leading
+  "Sets the spacing between lines of text in units of pixels. This
+  setting will be used in all subsequent calls to the text function."
+  [leading]
+  (.textLeading *applet* (float leading)))
+
+(def ^{:private true}
+  text-modes {:model PConstants/MODEL
+              :shape PConstants/SHAPE
+              :screen PConstants/SCREEN})
+
+(defn- resolve-text-mode
+  [mode]
+  (if (keyword? mode)
+    (get text-modes mode)
+    mode))
+
+(defn text-mode
+  "Sets the way text draws to the screen - available modes
+  are :model, :shape and :screen
+
+  In the default configuration (the :model mode), it's possible to
+  rotate, scale, and place letters in two and three dimensional space.
+
+  Changing to :screen mode draws letters directly to the front of the
+  window and greatly increases rendering quality and speed when used
+  with the P2D and P3D renderers. :screen with OPENGL and JAVA2D (the
+  default) renderers will generally be slower, though pixel accurate
+  with P2D and P3D. With :screen, the letters draw at the actual size
+  of the font (in pixels) and therefore calls to text-size will not
+  affect the size of the letters. To create a font at the size you
+  desire, use create-font. When using :screen, any z-coordinate passed
+  to a text command will be ignored, because your computer screen
+  is...flat!
+
+  The :shape mode draws text using the the glyph outlines of
+  individual characters rather than as textures. This mode is only
+  only supported with the PDF and OPENGL renderer settings. With the
+  PDF renderer, you must specify the :shape text-mode before any other
+  drawing occurs. If the outlines are not available, then
+  :shape will be ignored and :model will be used instead.
+
+  The :shape option in OPENGL mode can be combined with begin-raw to
+  write vector-accurate text to 2D and 3D output files, for instance
+  DXF or PDF. :shape is not currently optimized for OPENGL, so if
+  recording shape data, use :model until you're ready to capture the
+  geometry with begin-raw."
+  [mode]
+  (let [mode (resove-text-mode mode)]
+    (.textMode *applet* (int mode))))
+
+(defn text-size
+  "Sets the current font size. This size will be used in all
+  subsequent calls to the text fn. Font size is measured in
+  units of pixels."
+  [size]
+  (.textSize *applet* (float size)))

 (defn texture [^PImage img] (.texture *applet* img))


log tenancy-id with zero-peers message

log tenancy-id with zero-peers message

--- src/onyx/log/commands/submit_job.clj
+++ src/onyx/log/commands/submit_job.clj
@@ -89,8 +89,10 @@

   (let [allocations (get-in new [:allocations (:id args)])]
     (when (zero? (count (reduce into [] (vals allocations))))
-      (info (format "Job ID %s has been submitted, but received no virtual peers to start its execution.
+      (info (format "Job ID %s has been submitted with tenancy ID %s, but received no virtual peers to start its execution.
                      Tasks each require at least one peer to be started, and may require more if :onyx/n-peers or :onyx/min-peers is set.
-                     If you were expecting your job to start now, either start more virtual peers or choose a different job scheduler, or wait for existing jobs to finish." (:id args)))))
+                     If you were expecting your job to start now, either start more virtual peers or choose a different job scheduler, or wait for existing jobs to finish."
+                    (:id args)
+                    (get-in state [:opts :onyx/tenancy-id])))))

   state)


First cut at reallocation impl.

First cut at reallocation impl.

--- src/onyx/log/commands/submit_job.clj
+++ src/onyx/log/commands/submit_job.clj
@@ -39,6 +39,53 @@
             true))))
     true))

+(defn sort-jobs-by-pct [replica]
+  (let [indexed
+        (map-indexed
+         (fn [k j]
+           {:position k :job j :pct (get-in replica [:percentages j])})
+         (reverse (:jobs replica)))]
+    (reverse (sort-by (juxt :pct :position) indexed))))
+
+(defn maximum-jobs-to-use [jobs]
+  (reduce
+   (fn [all {:keys [pct] :as job}]
+     (let [sum (apply + (map :pct all))]
+       (if (<= (+ sum pct) 100)
+         (conj all job)
+         (reduced all))))
+   []
+   jobs))
+
+(defn min-allocations [jobs n-peers]
+  (mapv
+   (fn [job]
+     (let [n (int (Math/floor (* (* 0.01 (:pct job)) n-peers)))]
+       (assoc job :allocation n)))
+   jobs))
+
+(defn percentage-balanced-workload [replica]
+  (let [n-peers (count (:peers replica))
+        sorted-jobs (sort-jobs-by-pct replica)
+        jobs-to-use (maximum-jobs-to-use sorted-jobs)
+        init-allocations (min-allocations jobs-to-use n-peers)
+        init-usage (apply + (map :allocation init-allocations))
+        left-over-peers (- n-peers init-usage)]
+    (update-in init-allocations [0 :allocation] + left-over-peers)))
+
+(defmethod reallocate? :onyx.job-scheduler/percentage
+  [scheduler old new state]
+  (if-let [allocation (common/peer->allocated-job (:allocations new) (:id state))]
+    (let [balanced (percentage-balanced-workload new)
+          peer-counts (first (filter #(= (:job %) (:job allocation)) balanced))
+          peers (get (common/job->peers new) (:job allocation))]
+      (when (> (count peers) (get peer-counts (:job allocation)))
+        (let [n (- (count peers) (get peer-counts (:job allocation)))
+              peers-to-drop (common/drop-peers new (:job allocation) n)]
+          (when (some #{(:id state)} (into #{} peers-to-drop))
+            true))))
+    true))
+
 (defmethod extensions/reactions :submit-job
   [entry old new diff peer-args]
   (when (reallocate? (:job-scheduler old) old new peer-args)


Update renderer with support for more items

--- src/robinson/render.clj
+++ src/robinson/render.clj
@@ -661,34 +661,44 @@
                                     (= (cell :discovered) current-time))
                              (case (or (-> cell-items first :type)
                                        (-> cell-items first :id))
-                               :ring           ["="]
-                               :food           ["%"]
-                               :bow            [")"]
-                               :sword          [")"]
-                               :armor          ["["]
-                               :shoes          ["!"]
-                               :wand           ["/"]
-                               :spellbook      ["+"]
-                               :scroll         ["?"]
-                               :rock           ["*"]
-                               :coconut        ["*" :brown :black]
+                               :knife           [")"]
+                               :obsidian-knife  [")"]
+                               :obsidian-axe    [")"]
+                               :obsidian-spear  [")"]
+                               :sharpened-stick [")"]
+                               :plant-fiber     [","]
+                               :sword           [")"]
+                               :armor           ["["]
+                               :shoes           ["!"]
+                               :fishing-pole    ["/"]
+                               :match           ["/"]
+                               :flashlight      [","]
+                               :saw             [","]
+                               :tarp            [","]
+                               :spellbook       ["+"]
+                               :scroll          ["?"]
+                               :rock            ["*"]
+                               :obsidian        ["*"]
+                               :coconut         ["*" :brown :black]
                                :unhusked-coconut
-                                               ["*" :brown  :black]
-                               :empty-coconut  ["*" :brown  :black]
-                               :red-fruit      ["*" :red    :black]
-                               :orange-fruit   ["*" :orange :black]
-                               :yellow-fruit   ["*" :yellow :black]
-                               :green-fruit    ["*" :green  :black]
-                               :blue-fruit     ["*" :blue   :black]
-                               :purple-fruit   ["*" :purple :black]
-                               :white-fruit    ["*" :white  :black]
-                               :black-fruit    ["*" :gray   :black]
-                               :bamboo         ["/" :light-green  :black]
-                               :stick          ["/" :brown  :black]
-                               :log            ["/" :brown  :black #{:bold}]
-                               :bedroll        ["_" :white :black]
-                               :$              ["$"  :yellow :black #{:bold}]
-                               :amulet         ["\"" :blue   :black #{:bold}]
+                                                ["*" :brown  :black]
+                               :empty-coconut   ["*" :brown  :black]
+                               :red-fruit       ["*" :red    :black]
+                               :orange-fruit    ["*" :orange :black]
+                               :yellow-fruit    ["*" :yellow :black]
+                               :green-fruit     ["*" :green  :black]
+                               :blue-fruit      ["*" :blue   :black]
+                               :purple-fruit    ["*" :purple :black]
+                               :white-fruit     ["*" :white  :black]
+                               :black-fruit     ["*" :gray   :black]
+                               :bamboo          ["/" :light-green  :black]
+                               :stick           ["/" :brown  :black]
+                               :grass           ["/" :green  :black]
+                               :rope            ["," :green  :black]
+                               :log             ["/" :brown  :black #{:bold}]
+                               :bedroll         ["_" :white :black]
+                               :$               ["$"  :yellow :black #{:bold}]
+                               :amulet          ["\"" :blue   :black #{:bold}]
                                ["?"])
                              (case (cell :type)
                               :vertical-wall   ["|"]


Relax the content type restriction.

Relax the content type restriction.

--- src/shale/resources.clj
+++ src/shale/resources.clj
@@ -34,7 +34,7 @@
 (defn is-json-content? [context]
   (if (#{:put :post} (get-in context [:request :request-method]))
     (or
-     (= (get-in context [:request :headers "content-type"]) "application/json")
+     (re-matches #"application/json(?:;.*)?" (get-in context [:request :headers "content-type"]))
      [false {:message "Unsupported Content-Type"}])
     true))


Correct hashmap-destructuring examples

Correct hashmap-destructuring examples

--- src/specintro/core.cljs
+++ src/specintro/core.cljs
@@ -352,7 +352,7 @@

 This gets clumsy for long paths:
 ```
-(let [{:keys [:path.to.name.space/kw]}] kw)
+(let [{:keys [:path.to.name.space/kw]} {:path.to.name.space/kw 42}] kw)
 ```

 Fortunately, it is possible to use an alias:
@@ -360,15 +360,15 @@
 (ns whatever
   (:require [path.to.name.space :as space]))

-(let [{:keys [::space/kw]}] kw)
-```
-
-And more options are coming;
+(let [{:keys [::space/kw]} {::space/kw 42}] kw)
+```
+
+And more options are coming in 1.9.0 which allow you to put the namespace in front of `keys` like this:
 ```
 (ns whatever
   (:require [path.to.name.space :as space]))

-(let [{::space/keys [kw]}] kw)
+(let [{::space/keys [kw]} {::space/kw 42}] kw)
 (let [{:a/keys [b]} {:a/b 1}] b)
 ```
 For details see:


record support

record support

--- src/table_to_b/core.clj
+++ src/table_to_b/core.clj
@@ -16,11 +16,28 @@
  CONSTANTS {{table-name}}

  PROPERTIES
-  {{table-name}} : POW(TUPLETYPE) &
-  {{table-name}} = {
-   {{{tuples}}}
+  {{table-name}} : POW(TUPLETYPE) &
+  {{table-name}} = {
+   {{{tuples}}}
   } &
   {{{accessor-functions}}}
+END
+" (assoc data :machine name :table-name table-name)))
+
+(defn record-encoding [name table-name data]
+  (sc/render-string
+   "
+MACHINE {{machine}}
+ DEFINITIONS STRUCTTYPE == ({{struct-type}})
+ ABSTRACT_CONSTANTS {{accessor-names}}
+ CONSTANTS {{table-name}}
+
+ PROPERTIES
+  {{table-name}} : POW(STRUCTTYPE) &
+  {{table-name}} = {
+   {{{records}}}
+  } &
+  {{{struct-functions}}}
 END
 " (assoc data :machine name :table-name table-name)))

@@ -58,11 +75,20 @@
   (let [elements (map (comp pr-str :value) row)]
     (str "(" (st/join "," elements) ")")))

+(defn make-record [header row]
+  (let [elements (map (comp pr-str :value) row)]
+    (str "rec(" (st/join "," (map (fn [n v] (str n ":" v)) header elements)) ")")))
+
 (defn make-accessor [n id name]
   (let [vars (st/join "," (for [x (range n)] (str "v" x)))]
     (sc/render-string
      "{{name}} = %({{vars}}).(({{vars}}):TUPLETYPE|v{{id}})"
      {:name name :vars vars :id id})))
+
+(defn make-struct [name]
+  (sc/render-string
+   "{{name}} = %r.(r:STRUCTTYPE|r'{{name}})"
+   {:name name }))

 (defn parse-excel [filename sheetname]
   (let [workbook (dj/load-workbook filename)
@@ -80,9 +106,15 @@
      :types types
      :accessor-names (st/join "," header)
      :accessor-functions (st/join " &\n  " (map-indexed (partial make-accessor (count header)) header))
+     :struct-functions (st/join " &\n  " (map make-struct header))
      :tuple-type (st/join "*" types)
-     :tuples (st/join ",\n   " (map make-tuple table))}))
+     :struct-type (str "struct(" (st/join "," (map (fn [n t] (str n ":" t)) header types)) ")")
+     :tuples (st/join ",\n   " (map make-tuple table))
+     :records (st/join ",\n   " (map (partial make-record header) table))}))

-(defn -main
-  [xls-file sheet table-name]
-  (println (tuple-encoding (apply str (filter ascii sheet)) table-name (parse-excel xls-file sheet))))
+(defn -main [& args]
+  (let [[mode xls-file sheet table-name machine-name] args
+        data (parse-excel xls-file sheet)
+        output (cond (= mode "tuple") (tuple-encoding machine-name table-name data)
+                     (= mode "record") (record-encoding machine-name table-name data))]
+    (println output)))


clear repl

clear repl

--- env/dev/clj/devdev/repl.clj
+++ env/dev/clj/devdev/repl.clj
@@ -1,32 +0,0 @@
-(ns devdev.repl
-  (:use devdev.handler
-        ring.server.standalone
-        [ring.middleware file-info file]))
-
-(defonce server (atom nil))
-
-(defn get-handler []
-  ;; #'app expands to (var app) so that when we reload our code,
-  ;; the server is forced to re-resolve the symbol in the var
-  ;; rather than having its own copy. When the root binding
-  ;; changes, the server picks it up without having to restart.
-  (-> #'app
-      ; Makes static assets in $PROJECT_DIR/resources/public/ available.
-      (wrap-file "resources")
-      ; Content-Type, Content-Length, and Last Modified headers for files in body
-      (wrap-file-info)))
-
-(defn start-server
-  "used for starting the server in development mode from REPL"
-  [& [port]]
-  (let [port (if port (Integer/parseInt port) 3000)]
-    (reset! server
-            (serve (get-handler)
-                   {:port port
-                    :auto-reload? true
-                    :join? false}))
-    (println (str "You can view the site at http://localhost:" port))))
-
-(defn stop-server []
-  (.stop @server)
-  (reset! server nil))


Change type hint to prevent exception during shutdown phase (#1240)

> **Epic** #
> Close #
> Related #

  Example of the error

```
2022-04-05T09:38:22.373Z ERROR (async-dispatch-7) [puppetlabs.trapperkeeper.internal] - Encountered error during shutdown sequence
java.lang.ClassCastException: class io.riemann.riemann.client.RiemannBatchClient cannot be cast to class io.riemann.riemann.client.RiemannClient (io.riemann.riemann.client.RiemannBatchClient and io.riemann.riemann.client.RiemannClient are in unnamed module of loader 'app')
	at ctia.lib.riemann$stop.invokeStatic(riemann.clj:185)
	at ctia.lib.riemann$stop.invoke(riemann.clj:184)
	at ctia.lib.riemann_service$reify__25040$service_fnk__12025__auto___positional$reify__25047.stop(riemann_service.clj:15)
	at puppetlabs.trapperkeeper.services$eval11823$fn__11850$G__11815__11853.invoke(services.clj:9)
	at puppetlabs.trapperkeeper.services$eval11823$fn__11850$G__11814__11857.invoke(services.clj:9)
	at puppetlabs.trapperkeeper.internal$eval22075$run_lifecycle_fn_BANG___22082$fn__22083.invoke(internal.clj:196)
	at puppetlabs.trapperkeeper.internal$eval22075$run_lifecycle_fn_BANG___22082.invoke(internal.clj:179)
	at puppetlabs.trapperkeeper.internal$eval22645$shutdown_BANG___22650$fn__22651$shutdown_fn__22653$fn__22668.invoke(internal.clj:459)
	at puppetlabs.trapperkeeper.internal$eval22645$shutdown_BANG___22650$fn__22651$shutdown_fn__22653.invoke(internal.clj:458)
	at puppetlabs.trapperkeeper.internal$eval22149$initialize_lifecycle_worker__22160$fn__22161$fn__22312$state_machine__19342__auto____22337$fn__22340$fn__22354.invoke(internal.clj:274)
	at puppetlabs.trapperkeeper.internal$eval22149$initialize_lifecycle_worker__22160$fn__22161$fn__22312$state_machine__19342__auto____22337$fn__22340.invoke(internal.clj:258)
	at puppetlabs.trapperkeeper.internal$eval22149$initialize_lifecycle_worker__22160$fn__22161$fn__22312$state_machine__19342__auto____22337.invoke(internal.clj:249)
	at clojure.core.async.impl.ioc_macros$run_state_machine.invokeStatic(ioc_macros.clj:978)
	at clojure.core.async.impl.ioc_macros$run_state_machine.invoke(ioc_macros.clj:977)
	at clojure.core.async.impl.ioc_macros$run_state_machine_wrapped.invokeStatic(ioc_macros.clj:982)
	at clojure.core.async.impl.ioc_macros$run_state_machine_wrapped.invoke(ioc_macros.clj:980)
	at clojure.core.async$ioc_alts_BANG_$fn__19589.invoke(async.clj:421)
	at clojure.core.async$do_alts$fn__19520$fn__19523.invoke(async.clj:288)
	at clojure.core.async.impl.channels.ManyToManyChannel$fn__14093.invoke(channels.clj:135)
	at clojure.lang.AFn.run(AFn.java:22)
	at java.base/java.util.concurrent.ThreadPoolExecutor.runWorker(ThreadPoolExecutor.java:1128)
	at java.base/java.util.concurrent.ThreadPoolExecutor$Worker.run(ThreadPoolExecutor.java:628)
	at clojure.core.async.impl.concurrent$counted_thread_factory$reify__13946$fn__13947.invoke(concurrent.clj:29)
	at clojure.lang.AFn.run(AFn.java:22)
	at java.base/java.lang.Thread.run(Thread.java:834)
```

During the shutdown, RiemannService throws exception because of the wrong type hint for the stop method. TK will still continue shutdown sequence but because of the exception riemann client will not close properly. In this PR instead of RiemannClient the type hint pointing to the right RiemannBatchClient.

[§](#qa) QA
============================

1. Start CTIA
2. Shutdown CTIA
3. Check that there are no errors like the one above in the logs

[§](#squashed-commits) Squashed Commits
======================================================================

--- src/ctia/lib/riemann.clj
+++ src/ctia/lib/riemann.clj
@@ -4,7 +4,7 @@
             [riemann.client :as riemann]
             [ctia.lib.utils :as utils])
   (:import [clojure.lang ExceptionInfo]
-           [io.riemann.riemann.client RiemannClient]))
+           [io.riemann.riemann.client RiemannBatchClient]))

 ;; based on riemann-reporter.core/request-to-event
 (defn request->event
@@ -181,5 +181,5 @@
            :conn conn
            :service-prefix service-prefix)))

-(defn stop [{:keys [^RiemannClient conn]}]
+(defn stop [{:keys [^RiemannBatchClient conn]}]
   (when conn (.close conn)))


Better error message.

Better error message.

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -366,7 +366,7 @@
   (doseq [event-fn event-fns :while (not (:stop @state))]
     (try (event-fn)
          (catch java.lang.OutOfMemoryError e
-           (do (ReportingUtils/showError e)
+           (do (ReportingUtils/showError e "Acquisition interrupted.")
                (state-assoc! :stop true)))
          (catch Throwable e (ReportingUtils/logError e)))
     (await-resume)))


Make sure analytics index is lowercase

Make sure analytics index is lowercase

--- systems/ring-analytics/src/containium/systems/ring_analytics.clj
+++ systems/ring-analytics/src/containium/systems/ring_analytics.clj
@@ -15,7 +15,8 @@
             [simple-time.core :as time]
             [clj-elasticsearch.client :as elastic]
             [cheshire.core :as json]
-            [packthread.core :refer (+>)]))
+            [packthread.core :refer (+>)]
+            [clojure.string :refer (lower-case)]))

 ;;; The public system API.
@@ -31,7 +32,7 @@

 (defn- daily-index
   [app]
-  (str "log-" app "-" (time/format (time/today) :basic-date)))
+  (str "log-" (lower-case app) "-" (time/format (time/today) :basic-date)))

 (defn- store-request


Throwable is not a map

Throwable is not a map

--- systems/ring-analytics/src/containium/systems/ring_analytics.clj
+++ systems/ring-analytics/src/containium/systems/ring_analytics.clj
@@ -14,7 +14,6 @@
             [clojurewerkz.elastisch.native.document :as elastic]
             [clojurewerkz.elastisch.native.index :as esindex]
             [cheshire.core :as json]
-            [packthread.core :refer (+>)]
             [clojure.string :refer (lower-case)]))
 (refer-logging)

@@ -47,16 +46,17 @@
               response (try (handler request)
                             (catch Throwable t (ex/exit-when-fatal t) t))
               took (- (System/currentTimeMillis) started)
-              processed (+> request
+              processed (-> request
                             (dissoc :body :async-channel)
                             (assoc :started (time/format (time/datetime started)
-                                                         :date-hour-minute-second-ms)
-                                   ;; Maybe move the request parameters to a :request key as well?
-                                   :response (-> response
-                                                 (dissoc :body)
-                                                 (assoc :took took)))
-                            (when (instance? Throwable response)
-                              (assoc :failed (.getMessage ^Throwable response))))]
+                                                         :date-hour-minute-second-ms))
+                            (cond-> (instance? Throwable response)
+                                    (assoc :failed (.getMessage ^Throwable response)
+                                           :status 500)
+                                    (not (instance? Throwable response))
+                                    (assoc :response (-> response
+                                                         (dissoc :body)
+                                                         (assoc :took took)))))]
           (future (try (store-request client app-name processed)
                        (catch Throwable t
                          (ex/exit-when-fatal t)


(maint) InvalidParameterException changes message in jdk11

--- test/unit/puppetlabs/puppetserver/certificate_authority_test.clj
+++ test/unit/puppetlabs/puppetserver/certificate_authority_test.clj
@@ -813,16 +813,14 @@
     (retrieve-ca-cert! (:cacert ca-settings) (:localcacert settings))

     (testing "should throw an error message with too short keylength"
-      (is (thrown-with-msg?
-        InvalidParameterException
-        #".*RSA keys must be at least 512 bits long.*"
-          (initialize-master-ssl! (assoc settings :keylength 128) "master" ca-settings))))
+      (is (thrown?
+           InvalidParameterException
+           (initialize-master-ssl! (assoc settings :keylength 128) "master" ca-settings))))

     (testing "should throw an error message with too large keylength"
-      (is (thrown-with-msg?
-        InvalidParameterException
-        #".*RSA keys must be no longer than 16384 bits.*"
-          (initialize-master-ssl! (assoc settings :keylength 32768) "master" ca-settings))))))
+      (is (thrown?
+           InvalidParameterException
+           (initialize-master-ssl! (assoc settings :keylength 32768) "master" ca-settings))))))

 (deftest initialize-master-ssl!-test-with-keylength-settings
   (let [tmp-confdir (fs/copy-dir confdir (ks/temp-dir))


Forgot about the home page. Removed debug /test/ also.

--- src/hphelper/handler.clj
+++ src/hphelper/handler.clj
@@ -31,16 +31,16 @@
   (GET "/scen/print/" {params :params}
        ;(prn-str (keys params)))
        (sprint/html-print-optional (sl/load-scen-from-db (params :scen_id)) (keys params)))
-  (GET "/test/" stuff
-       (prn-str stuff))
+  (GET "/" {baseURL :context}
+       (html [:html
+              [:body
+               [:a {:href (str baseURL "/scen/")} "Scenario Generator"][:br]
+               [:a {:href (str baseURL "/char/")} "Character Generator"][:br]
+               [:br]
+               [:a {:href "https://github.com/lsenjov/hphelper"} "Source Code"][:br]
+               ]]))
   (route/not-found
-   (html [:html
-          [:body
-           [:a {:href "/scen/"} "Scenario Generator"][:br]
-           [:a {:href "/char/"} "Character Generator"][:br]
-           [:br]
-           [:a {:href "https://github.com/lsenjov/hphelper"} "Source Code"][:br]
-           ]]))
+    "Not Found.")
   )

 (def app


Macro for updating the view's widgets "unwired".

Prevent the transmission of widget events while updating them
programmytically.

--- src/fm/simrunner/gui/wiring.clj
+++ src/fm/simrunner/gui/wiring.clj
@@ -78,3 +78,14 @@
           (wire-inputs on-event)
           (vary-meta assoc ::wiring {:wired? wired?})))))

+(defn wiring [view]
+  (-> view meta ::wiring))
+
+(defmacro do-unwired [view & body]
+ `(let [wired?# (:wired? (wiring ~view))]
+    (reset! wired?# false)
+    (try
+      ~@body
+      (finally
+        (reset! wired?# true)))))
+


Return created object IDs in response. Hide use of :_id keys.

--- src/forces_assemble/handler.clj
+++ src/forces_assemble/handler.clj
@@ -81,19 +81,24 @@
 (defn add-event-to-channel-db
   [channel-id event]
   (let [event-id (mu/object-id)]
-    (mc/insert-and-return mongodb
-                          coll-events
-                          (assoc event :_id event-id :channel-id channel-id))))
+    (export-data (mc/insert-and-return mongodb
+                                       coll-events
+                                       (assoc event :_id event-id :channel-id channel-id)))))

 (defn get-event
   [event-id]
-  (mc/find-map-by-id mongodb
-                     coll-events
-                     (mu/object-id event-id)))
-
-(defn clean-id
+  (export-data (mc/find-map-by-id mongodb
+                                  coll-events
+                                  (mu/object-id event-id))))
+
+(defn import-data
   [data]
-  (assoc data :_id (str (:_id data))))
+  (if-let [id (:id data)]
+    (assoc (dissoc data :id) :_id id)))
+
+(defn export-data
+  [data]
+  (dissoc (assoc data :id (str (:_id data))) :_id))

 ;; HTTP
 (def firebase-send-uri "https://fcm.googleapis.com/fcm/send")
@@ -148,10 +153,13 @@
   :known-content-type? #(check-content-type % [application-json])
   :malformed? #(parse-json % ::data)
   :post! (fn [context]
-           (let [event (add-event-to-channel channel-id (::data context))]
+           (let [event (add-event-to-channel channel-id (::data context))
+                 event-id (:id event)]
             {:location (build-entry-url context
                                         "/events"
-                                        (:_id event))})))
+                                        event-id)
+             ::created {:id event-id}}))
+  :handle-created #(::created %))

 (defresource channel-subscribers [channel-id]
   :allowed-methods [:post]
@@ -168,7 +176,7 @@
              (if-let [event (get-event event-id)]
                {::data event}
                false))
-  :handle-ok #(clean-id (::data %)))
+  :handle-ok #(::data %))

 (defroutes assemble-routes
   (GET "/" [] "Hello World2")


stress tests

stress tests

--- test/acceptance/new_stress_tests.clj
+++ test/acceptance/new_stress_tests.clj
@@ -135,4 +135,4 @@
   (launch-some-workers
     my-interpreter
     sample-bindings
-    100) =not=> (throws))
+    10000) =not=> (throws))


yeah this is bad with *graph* and alter-var-root

--- src/hermes/stuff/hermesutil.clj
+++ src/hermes/stuff/hermesutil.clj
@@ -9,6 +9,10 @@
     (com.thinkaurelius.titan.graphdb.vertices   PersistStandardTitanVertex)
     (com.tinkerpop.blueprints Graph)
     )
+  )
+
+(defn getLastOpenedGraphSeenByHermes []
+  g/*graph*
   )

 (defn assumedNonNilGraph [graph]
@@ -28,7 +32,7 @@
 (defn assumeNotLeakedGraph
   []
   (q/assumedNil [
-               g/*graph*
+               (getLastOpenedGraphSeenByHermes)
                "something bad happened and the graph leaked to *graph*
 ie. it's non-nil now; so you could've just used hermes functions and that's why"] )
   )


Admin panel now sorts players alphabetically

--- src/hphelper/frontend/play.cljs
+++ src/hphelper/frontend/play.cljs
@@ -798,7 +798,7 @@
            [:tbody
             (->> @game-atom
                  :hps
-                 (sort-by first)
+                 (sort-by #(-> % val :name))
                  (map (fn [[uuid player-sheet]]
                         ^{:key uuid}
                         (admin-single-player-component player-sheet status-atom)


fix test title in git_test

fix test title in git_test

--- test/clj/lambdacd/steps/git_test.clj
+++ test/clj/lambdacd/steps/git_test.clj
@@ -67,7 +67,7 @@

 (deftest wait-for-git-test
-  (testing "that it returns immediately (since it has no last known revision), calls after that wait for the next commit independent of whether the commit occurred before or after starting to wait"
+  (testing "that it waits for a new commit to happen"
     (let [test-repo (create-test-repo)
           git-src-dir (:dir test-repo)
           original-head-commit (last (:commits test-repo))


Five tests added into test-html-renderer module

--- test/clouseau/test_html_renderer.clj
+++ test/clouseau/test_html_renderer.clj
@@ -1,7 +1,7 @@
 ;;;
 ;;;   Clouseau
 ;;;
-;;;    Copyright (C) 2015 Pavel Tisnovsky <ptisnovs@redhat.com>
+;;;    Copyright (C) 2015, 2016 Pavel Tisnovsky <ptisnovs@redhat.com>
 ;;;
 ;;; Clouseau is free software; you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published by
@@ -40,4 +40,41 @@
   (:require [clojure.test :refer :all]
             [clouseau.html-renderer :refer :all]))

+;
+; Common functions used by tests.
+;

+(defn callable?
+    "Test if given function-name is bound to the real function."
+    [function-name]
+    (clojure.test/function? function-name))
+
+;
+; Tests for various defs and functions
+;
+
+(deftest test-render-html-header-existence
+    "Check that the clouseau.html-renderer/render-html-header definition exists."
+    (testing "if the clouseau.html-renderer/render-html-header definition exists."
+        (is (callable? 'clouseau.html-renderer/render-html-header))))
+
+(deftest test-render-html-footer-existence
+    "Check that the clouseau.html-renderer/render-html-footer definition exists."
+    (testing "if the clouseau.html-renderer/render-html-footer definition exists."
+        (is (callable? 'clouseau.html-renderer/render-html-footer))))
+
+(deftest test-render-search-field-existence
+    "Check that the clouseau.html-renderer/render-search-field definition exists."
+    (testing "if the clouseau.html-renderer/render-search-field definition exists."
+        (is (callable? 'clouseau.html-renderer/render-search-field))))
+
+(deftest test-render-name-field-existence
+    "Check that the clouseau.html-renderer/render-name-field definition exists."
+    (testing "if the clouseau.html-renderer/render-name-field definition exists."
+        (is (callable? 'clouseau.html-renderer/render-name-field))))
+
+(deftest test-render-navigation-bar-section-existence
+    "Check that the clouseau.html-renderer/render-navigation-bar-section definition exists."
+    (testing "if the clouseau.html-renderer/render-navigation-bar-section definition exists."
+        (is (callable? 'clouseau.html-renderer/render-navigation-bar-section))))
+


simplify tile-grid mounting invocation

simplify tile-grid mounting invocation

--- src/tile_game/grid.cljs
+++ src/tile_game/grid.cljs
@@ -147,7 +147,7 @@
     ;; Rebind onkeydown with set! so figwheel can always update
     (set! (.-onkeydown js/window) (handle-keydown command))
     (ui-event-loop command)
-    (rdom/render [(fn [] (tile-grid command))]
+    (rdom/render [tile-grid command]
                  (.getElementById js/document "grid"))))

 (init)


refactor to use  .. interop macro

refactor to use  .. interop macro

--- examples/src/famous_examples/core.cljs
+++ examples/src/famous_examples/core.cljs
@@ -24,7 +24,7 @@
   (Modifier.
    (clj->js {"origin" [0.5 0.5]
              "align" [0.5 0.5]
-             "transform" (fn[] (.rotateY Transform (* .002 (- (.now js/Date) initialTime))))})))
+             "transform" (fn[] (.. Transform (rotateY  (* .002 (- (.now js/Date) initialTime))) ))})))

 (let [Engine         (.. js/famous -core -Engine)


let alignment.

let alignment.

--- src/kixi/hecuba/api/uploads.clj
+++ src/kixi/hecuba/api/uploads.clj
@@ -43,7 +43,7 @@

 (defn uploads-status-resource-exists? [{session :s3} ctx]
   (let [upload_id (-> ctx :request :route-params :upload_id)
-        username (-> ctx :request :route-params :user_id)
+        username  (-> ctx :request :route-params :user_id)
         s3-key    (s3/s3-key-from {:src-name "uploads" :username username :uuid upload_id})]
     (when (s3/item-exists? session s3-key)
       {::item (with-open [in (s3/get-object-by-metadata session {:key s3-key})] (slurp in))})))


Fix reply and nREPL versions

Fix reply and nREPL versions

--- cmma-clj/project.clj
+++ cmma-clj/project.clj
@@ -4,9 +4,8 @@
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
   :dependencies [[org.clojure/clojure "1.6.0"]
-                 ;; Try nrepl 0.2.5 and reply 0.3.5 - :(
-                 [org.clojure/tools.nrepl "0.2.3"]
-                 [reply "0.3.4" :exclusions [[ring/ring-core]]]
+                 [org.clojure/tools.nrepl "0.2.5"]
+                 [reply "0.3.5" :exclusions [[ring/ring-core]]]
                  [com.cemerick/pomegranate "0.3.0" :exclusions [[org.apache.httpcomponents/httpclient]
                                                                 [org.codehaus.plexus/plexus-utils]
                                                                 [commons-codec]]]


show message if all zombies are dead

show message if all zombies are dead

--- src/zombie_run/quil.clj
+++ src/zombie_run/quil.clj
@@ -61,9 +61,14 @@
     (->> (q/text (format "Health: %s" player-health)
                  (width* 5)
                  (width* 5)))
-
     (let [[center-x center-y] (z/world-center (:world-size game))]
       (q/text "You are dead!"
+              (width* center-x)
+              (width* center-y))))
+
+  (when (empty? (z/zombie-positions game))
+    (let [[center-x center-y] (z/world-center (:world-size game))]
+      (q/text "You survived!"
               (width* center-x)
               (width* center-y))))


Added hash, async commands

Added hash, async commands

--- src/kvdb/core.clj
+++ src/kvdb/core.clj
@@ -6,10 +6,10 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; Catch errors in kv_parse
-;; Metadata for assigning types to db entries
 ;; Hashmap functions https://redis.io/commands#hash
 ;; Set functions https://redis.io/commands#set
 ;; Metadata for naming databases
+;; Do values have to be returned with every command?

 ;; LATER TODO
 ;; Add radix tree?
@@ -31,11 +31,15 @@
   (atom {}))

 (defn kv-whole-map
-  "Returns a hashmap snapshot of the entire database"
+  "Returns a hashmap snapshot of the entire database
+  {k [type value] ...}"
   [db]
   (into {}
     (map
-    #((comp vec list) (first %) [(first (second %)) (deref (second (second %)))])
+    #((comp vec list)
+      (first %) ; key
+      [(first (second %)) ; type
+        (deref (second (second %)))]) ; value
     @db)))

 (defn kv-value
@@ -50,7 +54,57 @@
 ;; KV-* FUNCTIONS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+(defn kv-hset
+  "Adds a key-value pairs to a hashmap
+  Creates the map if it doesn't already exists.
+  Returns (:ok) or (:error :type-mismatch)"
+  [db k & kvs]
+  (if (contains? @db k)
+    (let [[type value-atom] (get @db k)]
+      (if (= type :hash)
+        (do (swap! value-atom #(apply assoc % kvs))
+          (list :ok))
+        (list :error :type-mismatch)))
+    (do (swap! db assoc k [:hash (atom (apply assoc {} kvs))])
+        (list :ok))))
+
+(defn kv-hget
+  "Get value for hashmap k, field hk
+  Returns (:ok value), (:error :type-mismatch), (:error :nil)"
+  [db k hk]
+  (if (contains? @db k)
+    (let [[type value-atom] (get @db k)]
+      (if (= type :hash)
+        (if-let [value (get @value-atom hk)]
+          (list :ok value)
+          (list :error :nil))
+        (list :error :type-mismatch)))
+    (list :error :nil)))
+
+(defn kv-hdel
+  "Delete keys from a hashmap
+  returns (:ok num) where num is the number of keys deleted
+  or (:error :type-mismatch).
+  If the map doesn't exist, returns (:ok 0)"
+  [db k & hks]
+  (if (contains? @db k)
+    (let [[type value-atom] (get @db k)]
+      (if (= type :hash)
+        (list :ok (reduce
+          #(+ %1 (if (contains? @value-atom %2)
+                      (do (swap! value-atom dissoc %2)
+                          1)
+                      0))
+          0
+          hks))
+        (list :error :type-mismatch)))
+    (list :ok 0)))
+
 (defn kv-assoc
+  "Returns one of the following:
+    (:new new-value)
+    (:updated new-value)
+    (:error :type-mismatch)"
   [db k v]
   (if (contains? @db k)
     (let [[type value-atom] (get @db k)]
@@ -72,12 +126,14 @@
     ks)))

 (defn kv-get
-  "Returns (:ok value)"
-  [db k]
-  (let [[type value-atom] (get @db k)]
-    (if (= type :raw)
-      (list :ok @value-atom)
-      (list :error :type-mismatch))))
+  "Returns (:ok value), (:error :type-mismatch), or (:error :nil)"
+  [db k]
+  (if (contains? @db k)
+    (let [[type value-atom] (get @db k)]
+      (if (= type :raw)
+        (list :ok @value-atom)
+        (list :error :type-mismatch)))
+    (list :error :nil)))

 (defn kv-exists
   "Returns (:ok num) where num is the number of keys that exist"
@@ -86,24 +142,41 @@
         0
         ks)))

+(defn kv-run
+  "Runs commands given as list of strings.
+  See kv-parse"
+  [db [function & operands]]
+  (case function
+      "ASYNC" (do (future (kv-run db operands)) (list :ok :async))
+      "SET" (apply kv-assoc db operands) ;; TODO turn into dispatch macro?
+      "GET" (apply kv-get db operands)
+      "DEL" (apply kv-dissoc db operands)
+      "EXISTS" (apply kv-exists db operands)
+      "HDEL" (apply kv-hdel db operands)
+      "HGET" (apply kv-hget db operands)
+      "HSET" (apply kv-hset db operands)
+      (list :nocmd db)))
+
+(defmacro repl
+  [db & forms])
+
 (defn kv-parse
-  "Parses and executes a GET, SET, DEL, or EXISTS command
-  returns same a calling appropriate kv-* function,
-  or (:nocmd db) if the command is not found.
+  "Parses and executes a command
+  return values:
+    the same as calling appropriate kv-* function,
+    (:nocmd db) if the command is not found,
+    (:ok :async) for ASYNC commands

   kv-* functions:
   - kv-assoc
   - kv-dissoc
   - kv-get
-  - kv-exists "
+  - kv-exists
+  - kv-hset
+  - kv-hget
+  - kv-hdel "
   [db string]
-  (let [[function & operands] (clojure.string/split string #" ")]
-    (case function
-        "SET" (apply kv-assoc db operands)
-        "GET" (apply kv-get db operands)
-        "DEL" (apply kv-dissoc db operands)
-        "EXISTS" (apply kv-exists db operands)
-        (list :nocmd db))))
+  (kv-run db (clojure.string/split string #" ")))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; TESTING


make collection of builds work for :figwheel :builds

:figwheel :builds should take precedence, they haven’t been for the
plugin

--- plugin/src/leiningen/figwheel.clj
+++ plugin/src/leiningen/figwheel.clj
@@ -242,8 +242,8 @@
   (map-to-vec-builds
    (let [res (if-let [data (figwheel-edn)]
                (:builds data)
-               (get-in (fuz/fuzzy-select-keys-and-fix data [:cljsbuild])
-                       [:cljsbuild :builds]))]
+               (let [cnf (fuz/fuzzy-select-keys-and-fix data [:cljsbuild :figwheel])]
+                 (or (get-in cnf [:figwheel :builds]) (get-in cnf [:cljsbuild :builds]))))]
      (if (coll? res) res []))))

 (defn figwheel-options [data]


remove some reflective calls

remove some reflective calls

--- src/main/shadow/build/npm.clj
+++ src/main/shadow/build/npm.clj
@@ -10,7 +10,10 @@
   (:import (java.io File)
            (com.google.javascript.jscomp SourceFile CompilerOptions CompilerOptions$LanguageMode)
            (com.google.javascript.jscomp.deps ModuleNames)
-           (shadow.build.closure JsInspector)))
+           (shadow.build.closure JsInspector)
+           [java.nio.file Path]))
+
+(set! *warn-on-reflection* true)

 (def NPM-TIMESTAMP
   ;; timestamp to ensure that new shadow-cljs release always invalidate caches
@@ -70,7 +73,7 @@
         content
         ))))

-(defn find-package-json [file]
+(defn find-package-json [^File file]
   (loop [root (if (.isDirectory file)
                 (.getParentFile file)
                 file)]
@@ -180,7 +183,7 @@
                  (remove nil?)
                  (into []))

-            [entry entry-file]
+            [entry ^File entry-file]
             (or (reduce
                   (fn [_ entry]
                     ;; test file exts first, so we don't pick a directory over a file
@@ -223,11 +226,11 @@
       ;; rxjs/Observable.js
       ;; must find file before dir
       :else
-      (let [file-or-dir
+      (let [^File file-or-dir
             (or (test-file-exts npm package-dir suffix)
                 (test-file package-dir suffix))

-            file
+            ^File file
             (if-not (and file-or-dir (.isDirectory file-or-dir))
               file-or-dir
               (test-file-exts npm file-or-dir "index"))]
@@ -264,7 +267,7 @@
         file
         (test-file rel-dir require)

-        file
+        ^File file
         (cond
           (not file)
           (test-file-exts npm rel-dir require)
@@ -425,18 +428,18 @@

 (defn get-file-info*
   "extract some basic information from a given file, does not resolve dependencies"
-  [{:keys [compiler node-modules-dir project-dir] :as npm} ^File file]
+  [{:keys [compiler ^File node-modules-dir ^File project-dir] :as npm} ^File file]
   {:pre [(service? npm)
          (util/is-file-instance? file)
          (.isAbsolute file)]}

-  (let [abs-path
+  (let [^Path abs-path
         (.toPath project-dir)

-        node-modules-path
+        ^Path node-modules-path
         (.toPath node-modules-dir)

-        file-path
+        ^Path file-path
         (.toPath file)

         npm-file?
@@ -612,7 +615,7 @@
          (string? require)
          (map? require-ctx)]}

-  (let [file (find-file npm require-from require)]
+  (let [^File file (find-file npm require-from require)]
     (cond
       (nil? file)
       nil
@@ -621,7 +624,7 @@
       empty-rc

       :else
-      (let [{:keys [browser-overrides package-dir] :as pkg}
+      (let [{:keys [browser-overrides ^File package-dir] :as pkg}
             (find-package-for-file npm file)

             ;; the package may have "browser":{"./a":"./b"} overrides


simplify the code a tad, by referring to the specific members of korma.core that we need

--- clojure_liberator/src/clojure_liberator/data_access.clj
+++ clojure_liberator/src/clojure_liberator/data_access.clj
@@ -1,6 +1,6 @@
 (ns clojure-liberator.data-access
   (:require [korma.db :as db]
-            [korma.core :as k]
+            [korma.core :refer [defentity select insert delete values where]]
             [clojure.java.jdbc :as jdbc]
             [clj-time.coerce :as c]
             clj-time.jdbc)
@@ -18,15 +18,15 @@

 (declare clients)

-(k/defentity clients)
+(defentity clients)

 (defn all-clients []
-  (k/select clients))
+  (select clients))

 (defn create-client [client]
-  (let [response (k/insert clients (k/values client))
+  (let [response (insert clients (values client))
         new-id (response :generated_key)]
     (assoc client :id new-id)))

 (defn delete-client [id]
-  (k/delete clients (k/where {:id id})))+  (delete clients (where {:id id})))


Minor improvements to a couple of comments.

--- src/open_company/api/common.clj
+++ src/open_company/api/common.clj
@@ -103,7 +103,7 @@

    If a valid token is supplied return a map containing :jwtoken and associated :user.
    If invalid token is supplied return {:jwtoken false}.
-   If not Authorization headers are supplied return nil."
+   If no Authorization headers are supplied return nil."
   [headers]
   (if-let [authorization (or (get headers "Authorization") (get headers "authorization"))]
     (let [jwtoken (last (s/split authorization #" "))]
@@ -113,12 +113,12 @@
         {:jwtoken false}))))

 (defn allow-anonymous
-  "Allow unless there is a JWToken provided and it's invalid"
+  "Allow unless there is a JWToken provided and it's invalid."
   [ctx]
   (boolean (or (nil? (:jwtoken ctx)) (:jwtoken ctx))))

 (defn allow-org-members
-  "Allow only if the user's JWToken indicates membership in the company's org"
+  "Allow only if there is no company, or the user's JWToken indicates membership in the company's org."
   [company-slug ctx]
   (let [user    (:user ctx)
         company (company/get-company company-slug)]


Create patterns outside of the closure

Create patterns outside of the closure

--- src/org/spootnik/fleet/http.clj
+++ src/org/spootnik/fleet/http.clj
@@ -91,8 +91,9 @@

 (defn yield-cors-match
   [{:keys [origins] :or {origins []}}]
-  (fn [origin]
-    (some #(re-find % origin) (map re-pattern origins))))
+  (let [patterns (mapv re-pattern origins)]
+    (fn [origin]
+      (some #(re-find % origin) patterns))))

 (defn start-http
   [scenarios engine opts]


[fix] Remove double checks.

[fix] Remove double checks.

--- src/ombs/handler/addevent.clj
+++ src/ombs/handler/addevent.clj
@@ -41,26 +41,18 @@
                           users :participants
                           :as params} ]
   "Add event in events table, with adding participants, and calculating debts."
-  (if (isvalid/new-event? event price date)
-    (do
-      (db/add-event event (read-string price) (sess/get :username) date)
-      (if (> (count users) 0)
-        (let [party-pay (core/party-pay (funcs/parse-int price) users)]
-          ;use 'dorun' for execute lazy function 'db/credit-payment'
-          (dorun (map #(dbpay/credit-payment (db/get-eid event date) (db/get-uid %) party-pay)
-                      (funcs/as-vec users))))) ; may have only one user, so create vec
-      true) ; all is ok
-    false)) ; validation fail
+  (db/add-event event (read-string price) (sess/get :username) date)
+  (if (> (count users) 0)
+    (let [party-pay (core/party-pay (funcs/parse-int price) users)]
+      ;use 'dorun' for execute lazy function 'db/credit-payment'
+      (dorun (map #(dbpay/credit-payment (db/get-eid event date) (db/get-uid %) party-pay)
+                  (funcs/as-vec users)))))); may have only one user, so create vec

 (defn- add-partial-event [{event :name price :price date :date parts :parts
                            users :participants
                            :as params}]
-  (if (isvalid/new-event? event price date)
-    (do
-      (db/add-event event (funcs/parse-int price) (sess/get :username) date parts)
-      (add-good params)
-      true)
-    false))
+  (db/add-event event (funcs/parse-int price) (sess/get :username) date parts)
+  (add-good params))

 (defn- add-good [ {event :name price :price date :date users :participants parts :parts :as params} ]
   (if (partial-event/add-goods event date parts)


Improve docs

Improve docs

--- src/parbench/requests_state.clj
+++ src/parbench/requests_state.clj
@@ -1,7 +1,11 @@
 (ns parbench.requests-state)

 (defn create-blank [requests concurrency url-generator]
-  "Creates a blank representation of request state"
+  "Creates a blank representation of request state.
+   This returns a hash with a few important attributes concerning
+   metadata and options, but of cheif importance is the :grid
+   item, this is a 2d vector of refs to indvidual request hashes
+   this represents the state of all open requests"
   (let [grid (for [row (range concurrency)]
                   (for [col (range requests)]
                        (ref {:y row :x col
@@ -35,4 +39,4 @@

 (defn complete? [requests-state]
   "Returns true if the requests are done running"
-  (if (:bench-ended-at @requests-state) true false))
+  (if (:bench-ended-at @requests-state) true false))


remove obsolete code

remove obsolete code

--- src/io/perun/sitemap.clj
+++ src/io/perun/sitemap.clj
@@ -3,12 +3,6 @@
             [io.perun.core   :as perun]
             [clojure.java.io :as io]
             [sitemap.core    :as sitemap-gen]))
-
-
-(def ^:private
-  +defaults+ {:filename "sitemap.xml"
-              :target "public"
-              :datafile "meta.edn"})

 (defn create-sitemap [files options]
   (map


Better separation of method dispatch on resolve-.

--- src/isla/interpreter.clj
+++ src/isla/interpreter.clj
@@ -6,7 +6,8 @@
   (:require [mrc.utils :as utils]))

 (declare run-sequence resolve- nreturn
-         friendly-class friendly-symbol assign evaluate-value)
+         friendly-class friendly-symbol assign evaluate-value
+         instantiate-type)

 (defmulti interpret (fn [& args] (:tag (first args))))

@@ -121,24 +122,34 @@
 (defn remret [env]
   (assoc env :ret nil))

+(defn dispatch-resolution [item]
+  (cond (instance? clojure.lang.PersistentHashSet item)
+        :list
+
+        (instance? java.util.Map item)
+        (if (:ref item)
+          :ref
+          :map)))
+
 ;; does not handle circular references
-(defmulti resolve- (fn [ast env] (class ast)))
+(defmulti resolve- (fn [ctx env] (dispatch-resolution ctx)))

 (defmethod resolve- :default [thing env] thing)

-(defmethod resolve- java.util.Map [ast env]
-  (if (contains? ast :ref)
-    (resolve- (get (:ctx env) (:ref ast)) env) ;; got an actual ref - resolve it
-    (reduce (fn [hash el] ;; just a hash that is not a ref - dive down
-              (merge hash el)) ast
-              (map (fn [e] {(get e 0) (resolve- (get e 1) env)}) ast))))
+(defmethod resolve- :ref [{:keys [ref]} env]
+  (resolve- (get (:ctx env) ref) env))

-(defmethod resolve- clojure.lang.PersistentHashSet [ast env]
-  (let [out (reduce (fn [set el]
-                      (conj set el))
-                    #{}
-                    (map (fn [e] (resolve- e env)) ast))]
-    out))
+(defmethod resolve- :map [map env]
+  (reduce (fn [hash el] ;; just a hash that is not a ref - dive down
+            (merge hash el))
+          map
+          (clojure.core/map (fn [[k v]] {k (resolve- v env)}) map)))
+
+(defmethod resolve- :list [list env]
+  (reduce (fn [set el]
+            (conj set el))
+          #{}
+          (map (fn [e] (resolve- e env)) list)))

 (defn friendly-class [clazz]
   (last (str/split (str clazz) #"\.")))


Less naive version of invalid content-type warning that deals with the case insensitive nature of cOnTeNt-TyPe. For real this time.

--- src/posthere/cljs/posthere.cljs
+++ src/posthere/cljs/posthere.cljs
@@ -114,11 +114,18 @@
       (string-content content result))))

 (defn- warn-of-invalid-body
-  ""
+  "If the body invalid flag is set, rewrite the content-type header value to include a warning glyph."
   [headers result]
-  (if (aget result "invalid-body")
-    (assoc headers "content-type" [:span [:span.glyphicon.glyphicon-warning-sign {:title invalid-body-warning}](get headers "content-type")])
-    headers))
+  (if (aget result "invalid-body")
+    (let [header-keys (keys headers)
+          header-map (zipmap (map lower-case header-keys) header-keys) ; mapping of lower-case header to mixed-case header
+          mixed-case-content-type (get header-map "content-type")]
+      (assoc headers mixed-case-content-type
+        [:span
+          [:span.glyphicon.glyphicon-warning-sign {:title invalid-body-warning}]
+          (get headers mixed-case-content-type)]))
+    headers)) ; the body isn't invalid, so no warning needed
+
 ;; ----- Hiccup HTML snippets for the results page -----

 (defhtml table-header


Properly use raw.

Properly use raw.

--- src/konserve/carmine.clj
+++ src/konserve/carmine.clj
@@ -18,9 +18,8 @@

-;; TODO if redis guarantees fsync in order of messages (never lose intermediary writes)
-;; then it should be possible to not force redis to fsync here
-
+;; TODO document how redis guarantees fsync in order of messages (never loses
+;; intermediary writes) on a single peer

 (defrecord CarmineStore [conn serializer read-handlers write-handlers locks]
   PEDNAsyncKeyValueStore
@@ -39,13 +38,7 @@
         (go nil)
         (let [res-ch (chan)]
           (try
-            #_(println (map byte (car/wcar conn (car/parse-raw (car/get id)))))
-            #_(println (-deserialize serializer read-handlers
-                                   (ByteArrayInputStream. (byte-array (drop 2 (car/wcar conn (car/parse-raw (car/get id))))))))
             (let [bais (ByteArrayInputStream. (car/wcar conn (car/parse-raw (car/get id))))]
-              ;; drop carmine header of 2 bytes
-              (.read bais)
-              (.read bais)
               (put! res-ch
                     (get-in
                      (second (-deserialize serializer read-handlers bais))
@@ -68,9 +61,6 @@
           (let [old-bin (car/wcar conn (car/parse-raw (car/get id)))
                 old (when old-bin
                       (let [bais (ByteArrayInputStream. (car/wcar conn (car/parse-raw (car/get id))))]
-                        ;; drop carmine header of 2 bytes
-                        (.read bais)
-                        (.read bais)
                         (second (-deserialize serializer write-handlers bais))))
                 new (if (empty? rkey)
                       (up-fn old)
@@ -78,7 +68,7 @@
             (when new
               (let [baos (ByteArrayOutputStream.)]
                 (-serialize serializer baos write-handlers [key-vec new])
-                (car/wcar conn (car/parse-raw (car/set id (.toByteArray baos))))))
+                (car/wcar conn (car/set id (car/raw (.toByteArray baos))))))
             (put! res-ch [(get-in old rkey)
                           (get-in new rkey)]))
           res-ch
@@ -100,10 +90,8 @@
           (try
             (let [bin (car/wcar conn (car/parse-raw (car/get id)))
                   bais (ByteArrayInputStream. bin)]
-              (.read bais)
-              (.read bais)
               (locked-cb {:input-stream bais
-                          :size (- (count bin) 2)}))
+                          :size (count bin)}))
             (catch Exception e
               (ex-info "Could not read key."
                        {:type :read-error
@@ -114,7 +102,8 @@
     (let [id (uuid key)]
       (go
         (try
-          (car/wcar conn (car/parse-raw (car/set id input)))
+          (car/wcar conn (car/set id (car/raw input)))
+          nil
           (catch Exception e
             (ex-info "Could not write key."
                      {:type :write-error
@@ -142,13 +131,13 @@
   (drop 2 (byte-array [1 2 3]))

-  (<!! (-exists? store "bar"))
+  (<!! (-exists? store "bars"))

-  (<!! (-update-in store ["bar"] (fn [_] 1)))
+  (<!! (-update-in store ["bars"] (fn [_] 1)))

-  (<!! (-update-in store ["bar"] inc))
+  (<!! (-update-in store ["bars"] inc))

-  (<!! (-get-in store ["bar"]))
+  (<!! (-get-in store ["bars"]))

   (<!! (-bassoc store "bbar" (byte-array (range 5))))


Update some existing tests to use default source/sink shapes.

--- test/parkour/graph_test.clj
+++ test/parkour/graph_test.clj
@@ -16,7 +16,7 @@
 (defn word-count-mapper
   [input]
   (let [wc (.getCounter mr/*context* "word-count" "words")]
-    (->> input mr/vals
+    (->> input
          (r/mapcat #(str/split % #"\s+"))
          (r/map (fn [word]
                   (returning word
@@ -24,10 +24,11 @@
          (r/map #(-> [% 1])))))

 (defn word-count-reducer
-  [input]
-  (->> input mr/keyvalgroups
-       (r/map (fn [[word counts]]
-                [word (r/reduce + 0 counts)]))))
+  {::mr/source-as :keyvalgroups}
+  [input]
+  (r/map (fn [[word counts]]
+           [word (r/reduce + 0 counts)])
+         input))

 (defn word-count
   [conf dseq dsink]
@@ -66,9 +67,10 @@

 (deftest test-word-count-mem
   (let [outpath (doto (fs/path "tmp/word-count-output") fs/path-delete)
-        dseq (mem/dseq [[nil "apple banana banana"]
-                        [nil "carrot apple"]
-                        [nil "apple"]])
+        dseq (->> [["apple banana banana"]
+                   ["carrot apple"]
+                   ["apple"]]
+                  (mem/dseq :keys))
         dsink (seqf/dsink [Text LongWritable] outpath)
         [result] (word-count (th/config) dseq dsink)]
     (is (= {"apple" 3, "banana" 2, "carrot" 1}
@@ -95,23 +97,23 @@

 (defn trivial-join-mapper
   [tag input]
-  (->> input mr/vals
-       (r/map (fn [line]
-                (let [[key val] (str/split line #"\s")]
-                  [[(Long/parseLong key) tag] val])))))
+  (r/map (fn [line]
+           (let [[key val] (str/split line #"\s")]
+             [[(Long/parseLong key) tag] val]))
+         input))

 (defn trivial-join-partitioner
   ^long [[key] _ ^long nparts]
   (-> key hash (mod nparts)))

 (defn trivial-join-reducer
-  [input]
-  (->> input mr/keyvalgroups
-       (r/mapcat (fn [[[id] vals]]
-                   (let [vals (into [] vals)
-                         left (first vals)]
-                     (r/map #(-> [id left %]) (rest vals)))))
-       (mr/sink-as :keys)))
+  {::mr/source-as :keyvalgroups}
+  [input]
+  (r/mapcat (fn [[[id] vals]]
+              (let [vals (into [] vals)
+                    left (first vals)]
+                (r/map #(-> [id left %]) (rest vals))))
+            input))

 (defn trivial-join
   [conf left right dsink]