add test and fix io ops

add test and fix io ops

--- src/neuseg/train.clj
+++ src/neuseg/train.clj
@@ -37,12 +37,13 @@
                           (partition 2 (tagging text)))))

 (defn gen-train [file-corpus file-output]
-  (with-open [wrtr (writer file-output {:encoding "utf-8"})]
-    (with-open [rdr (reader file-corpus {:encoding "utf-8"})]
+  (with-open [wrtr (writer file-output  :encoding "utf-8")]
+    (with-open [rdr (reader file-corpus :encoding "utf-8")]
       (let [text (clojure.string/join "" (line-seq rdr))]
         (.write wrtr (str (count text) " 32 2\n"))
         (.write wrtr (gen-cases text))))))

 (defn prepare []
-  (gen-train "data/corpus/corpus" "data/trains/train"))
+  (gen-train "data/corpus/corpus" "data/trains/train")
+  (gen-train "data/corpus/tests" "data/trains/tests"))


CMR-5081: Change metadata preview commit.

--- collection-renderer-lib/project.clj
+++ collection-renderer-lib/project.clj
@@ -14,7 +14,7 @@
    the hardcoded commit id during dev integration with cmr_metadata_preview project.
    The hardcoded commit id should be updated when MMT releases a new version of the gem."
   (or (System/getenv "CMR_METADATA_PREVIEW_COMMIT")
-      "acffcfadc5e"))
+      "64ae79b9895"))

 (def gem-install-path
   "The directory within this library where Ruby gems are installed."


expose add book

expose add book

--- src/osmium/index.clj
+++ src/osmium/index.clj
@@ -5,6 +5,11 @@

 (defn logged-in? [session]
   (not (empty? (:user session))))
+
+(defn- footer-link [link title]
+  (html
+   [:li.navbar-item {}
+    [:a.navbar-link {:href link} title]]))

 (defn layout [session title & content]
   (page/html5
@@ -21,17 +26,13 @@
         (let [email (get-in session [:user :user/email])]
           [:div.container {}
            [:ul.navbar-list {}
-            [:li.navbar-item {}
-             [:a.navbar-link {:href (format "/user/%s" email)}
-              email]]
-            [:li.navbar-item {}
-             [:a.navbar-link {:href "/logout"} "Log out"]]]])
+            (footer-link (format "/user/%s" email) email)
+            (footer-link "/logout" "Log out")
+            (footer-link "/book" "Add Book")]])
         [:div.container {}
          [:ul.navbar-list {}
-          [:li.navbar-item {}
-           [:a.navbar-link {:href "/login"} "Login"]]
-          [:li.navbar-item {}
-           [:a.navbar-link {:href "/signup"} "Sign up"]]]])]]]))
+          (footer-link "/login" "Login")
+          (footer-link "/signup" "Sign up")]])]]]))

 (def title-row
   [:tr


WIP on slurpage continues

WIP on slurpage continues

--- src/paredit/core.clj
+++ src/paredit/core.clj
@@ -747,46 +747,44 @@
   ;; (with-important-memoized)
   (if-let [rloc (-?> parse-tree (parsed-root-loc true))]
     (let [[l r] (normalized-selection rloc offset length)
+          ;; TODO need a big conditional for if we are in a string (still slurp, but move end-quote)
           starting-loc (if (*tag-closing-brackets* (loc-tag l))  ;; if on closing punct, must select parent differently
                          (loc-for-offset rloc offset)
                          (if-let [nl (z/up (parse-node l))]
                            nl l))]
-      (if-let [first-not-rightmost (up-to-right-sibling starting-loc)]
-        (let [slurpees (reverse (non-puncts-to-right (z/right first-not-rightmost)))
-              parent (parse-node starting-loc)
+      (if-let [loc-with-right-sibling (up-to-right-sibling starting-loc)]
+        (let [slurpees (non-puncts-to-right (z/right loc-with-right-sibling))
+              slurp-text (apply str (map loc-text (reverse slurpees)))
+              slurp-to-loc (first slurpees)
+              slurp-to-eo (end-offset slurp-to-loc)
+              parent-loc loc-with-right-sibling ;; (z/up loc-with-right-sibling)
+              parent (parse-node parent-loc)
               parent-so (start-offset parent)
               parent-eo (end-offset parent)
-              replace-offset parent-so
-              text-to-replace (.substring text parent-so parent-eo)
-
-              grandparent (z/up parent)
-              grandparent-so (start-offset grandparent)
-              grandparent-eo (end-offset grandparent)
-              grandparent-text (.substring text grandparent-so grandparent-eo)
-
-              parent-removed (z/remove starting-loc)
-              text-sans-removed (loc-text (z/up (z/up parent-removed))) ;; (node-text (z/root parent-removed))
-              ;; replace-length (.length text-to-replace)
-
-              ;; [inner-so inner-eo] (let [pl (-> parent z/down z/right)
-              ;;                           pr (-> pl z/rightmost z/left)]
-              ;;                       [(start-offset pl) (end-offset pr)]) ;; all-children-but-punct
+              ;; text-to-replace (.substring text parent-so parent-eo)
+              replace-offset (dec parent-eo)
+              text-to-replace (.substring text replace-offset slurp-to-eo)
+
+              close-punct (*tag-closing-brackets* (loc-tag parent-loc))
+              replace-text (str slurp-text close-punct)
+
+              replace-length (.length text-to-replace)
+

               ;; new-offset (- offset (- inner-so parent-so))
               ;; replace-text (.substring text inner-so inner-eo)

-              ret t]
+              ret (-> t
+                    (assoc-in [:text] (t/str-replace text replace-offset replace-length replace-text))
+                    (update-in [:modifs] conj {:offset replace-offset :length replace-length :text replace-text}))]
           (printf "text-to-replace: '%s'
-grandparent-text: '%s'
-removed: '%s'
-first-not-rightmost: '%s'
-slurpees (%s): '%s'"
+replace-text: '%s'
+slurp-text: '%s'
+close-punct: '%s'"
                       text-to-replace
-                      grandparent-text
-                      text-sans-removed
-                      (loc-text first-not-rightmost)
-                      (apply str (map loc-tag slurpees))
-                      (apply str (map loc-text slurpees)))
+                      replace-text
+                      slurp-text
+                      close-punct)
               ret)
         t))
     t))


Added test for multi-get for non-existent keys.

--- src/cbfg/test/kvs.cljs
+++ src/cbfg/test/kvs.cljs
@@ -208,6 +208,28 @@
                                              (dissoc (merge m7 {:status :ok})
                                                      :keys)
                                              (atake tkvs res-ch7)))))))))
+                           (let [res-ch8 (achan tkvs)
+                                 m8 {:opaque @n
+                                     :res-ch res-ch8
+                                     :op :multi-get
+                                     :kvs-ident (:kvs-ident open)
+                                     :keys [:does-not-exist :not-there]}]
+                             (aput tkvs cmd-ch m8)
+                             (and
+                              (e n (atake tkvs res-ch8)
+                                 (dissoc (merge m8 {:partial :not-found
+                                                    :key :does-not-exist})
+                                         :keys)
+                                 nil)
+                              (e n (atake tkvs res-ch8)
+                                 (dissoc (merge m8 {:partial :not-found
+                                                    :key :not-there})
+                                         :keys)
+                                 nil)
+                              (e n (atake tkvs res-ch8)
+                                 (dissoc (merge m8 {:status :ok})
+                                         :keys)
+                                 (atake tkvs res-ch8))))
                            ))))
            "pass"
            (str "FAIL: on test-lane #" @n)))))


Converted to prog-history / prog-events.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -15,44 +15,21 @@

 ;; TODO: How to assign locations to world entities before rendering?

-(def prog-world (atom {})) ; { :world => world-actx
-                           ;   :net-listen-ch => ch
-                           ;   :net-connect-ch => ch
-                           ;   :servers => { server-addr => ports }
-                           ;   :clients => { client-addr => client-info }
-                           ;   :res-ch => ch }
-
-(def run-history
+(def prog-history
   (atom {:snapshots {0 {}
                      10 {:a 1 :b 2 :c 3 :d 4}
                      20 {:a 11 :b 22 :c 33 :d 44}}
-         :events [[0 :snapshot]
-                  [1 :event [:a 1]]
-                  [2 :event [:b 2]]
-                  [3 :event [:c 3]]
-                  [4 :event [:d 4]]
-                  [10 :snapshot]
-                  [11 :event [:a 11]]
-                  [12 :event [:b 22]]
-                  [13 :event [:c 33]]
-                  [14 :event [:d 44]]
-                  [20 :snapshot]
-                  [21 :event [:a 21]]
-                  [22 :event [:b 22]]
-
-                  [0 :snapshot]
-                  [1 :event [:a 1]]
-                  [2 :event [:b 2]]
-                  [3 :event [:c 3]]
-                  [4 :event [:d 4]]
-                  [10 :snapshot]
-                  [11 :event [:a 11]]
-                  [12 :event [:b 22]]
-                  [13 :event [:c 33]]
-                  [14 :event [:d 44]]
-                  [20 :snapshot]
-                  [21 :event [:a 21]]
-                  [22 :event [:b 22]]]}))
+         :prog-world {} ; { :world => world-actx
+                        ;   :net-listen-ch => ch
+                        ;   :net-connect-ch => ch
+                        ;   :servers => { server-addr => ports }
+                        ;   :clients => { client-addr => client-info }
+                        ;   :res-ch => ch }
+         :prog-events [[0 :snapshot]
+                       [1 :event [:a 1]]
+                       [2 :event [:b 2]]
+                       [3 :event [:c 3]]
+                       [4 :event [:d 4]]]}))

 (def run-world       (atom {:a 10}))
 (def run-world-hover (atom nil))
@@ -64,7 +41,7 @@
          (map (fn [[k v]] (dom/li nil (str k ":" v))) app)))

 (defn on-event-focus [snapshot-ts event-ts]
-  (when-let [ss (get-in @run-history [:snapshots snapshot-ts])]
+  (when-let [ss (get-in @prog-history [:snapshots snapshot-ts])]
     (reset! run-world-hover ss)
     (.add gdom/classes (gdom/getElement "world-container") "hover")))

@@ -91,13 +68,13 @@
                                    #(on-event-blur last-snapshot-ts ts)}
                               (str ts (pr-str args))))]))
            [nil []]
-           (:events app)))))
+           (:prog-events app)))))

 (defn render-clients [app owner]
   (apply dom/select #js {:id "client"}
          (map (fn [client-addr]
                 (dom/option #js {:value client-addr} (str client-addr)))
-              (keys (:clients app)))))
+              (keys (:clients (:prog-world app))))))

 (defn init-roots []
   (om/root render-world run-world
@@ -108,9 +85,9 @@
            {:target (. js/document (getElementById "world-hover"))})
   (om/root render-world run-world-hover
            {:target (. js/document (getElementById "world-map-hover"))})
-  (om/root render-events run-history
+  (om/root render-events prog-history
            {:target (. js/document (getElementById "events"))})
-  (om/root render-clients prog-world
+  (om/root render-clients prog-history
            {:target (. js/document (getElementById "controls-clients"))}))

 ; ------------------------------------------------
@@ -146,21 +123,20 @@
                   :gen-id gen-id})
             delayed-event-cb (fn [vis-next]
                                (println :on-delayed-event-cb @last-id))]
-        (reset! prog-world {:world world
-                            :net-listen-ch (achan-buf world 10)
-                            :net-connect-ch (achan-buf world 10)
-                            :servers {}
-                            :clients {}
-                            :res-ch (achan-buf world 10)})
+        (swap! prog-history
+               #(assoc % :prog-world
+                       {:world world
+                        :net-listen-ch (achan-buf world 10)
+                        :net-connect-ch (achan-buf world 10)
+                        :servers {}
+                        :clients {}
+                        :res-ch (achan-buf world 10)}))
         (cbfg.vis/process-events vis event-delay cbfg.vis/vis-event-handlers
                                  event-ch step-ch event-run-ch)
         (cbfg.vis/process-render el-prefix world event-run-ch delayed-event-cb)
-        ;;; (go-loop [vis-ts]
-        ;;; (when-let [[vis-next deltas after event-str] (<! event-run-ch)]
-        ;;; (recur (inc vis-ts))))
         (make-net world
-                  (:net-listen-ch @prog-world)
-                  (:net-connect-ch @prog-world))
+                  (:net-listen-ch (:prog-world @prog-history))
+                  (:net-connect-ch (:prog-world @prog-history)))
         (let [vis-chs {}
               req-ch (achan world)
               cmd-ch (map< (fn [ev] {:op (.-id (.-target ev))
@@ -179,12 +155,13 @@
               prog-js (str "with (cbfg.world.t1) {" prog "}")
               prog-res (try (js/eval prog-js) (catch js/Object ex ex))]
           (world-cmd-loop world cbfg.world.lane/cmd-handlers cmd-ch
-                          req-ch (:res-ch @prog-world)
+                          req-ch (:res-ch (:prog-world @prog-history))
                           vis-chs world-vis-init el-prefix)
           (act-loop cmd-dispatch-loop world [num-dispatches 0]
                     (when-let [msg (atake cmd-dispatch-loop req-ch)]
                       (when-let [client-req-ch
-                                 (get-in @prog-world [:clients (:client msg) :req-ch])]
+                                 (get-in @prog-history
+                                         [:prog-world :clients (:client msg) :req-ch])]
                         (aput cmd-dispatch-loop client-req-ch msg))
                       (recur (inc num-dispatches))))
           (println :prog-res prog-res)
@@ -215,30 +192,43 @@
 ; --------------------------------------------

 (defn kv-server [server-addr & ports]
-  (let [world (:world @prog-world)
+  (let [prog-world (:prog-world @prog-history)
+        world (:world prog-world)
         done (atom false)]
     (act server-init world
          (doseq [port ports]
            (when-let [listen-result-ch (achan server-init)]
-             (aput server-init (:net-listen-ch @prog-world)
+             (aput server-init (:net-listen-ch prog-world)
                    [server-addr port listen-result-ch])
              (when-let [[accept-ch close-accept-ch] (atake server-init listen-result-ch)]
                (cbfg.world.net/server-accept-loop world accept-ch close-accept-ch)
-               (swap! prog-world #(update-in % [:servers server-addr] conj port)))))
+               (swap! prog-history
+                      #(let [ph (update-in % [:prog-world :servers server-addr]
+                                           conj port)]
+                         (update-in ph [:prog-events] conj
+                                    [(count (:prog-events ph))
+                                     :event
+                                     (:prog-world ph)]))))))
          (reset! done true))
     (wait-done done)))

 (defn kv-client [client-addr server-addr server-port]
-  (let [world (:world @prog-world)
+  (let [prog-world (:prog-world @prog-history)
+        world (:world prog-world)
         done (atom false)]
     (act client-init world
-         (let [req-ch (cbfg.world.net/client-loop world (:net-connect-ch @prog-world)
+         (let [req-ch (cbfg.world.net/client-loop world (:net-connect-ch prog-world)
                                                   server-addr server-port
-                                                  client-addr (:res-ch @prog-world))]
-           (swap! prog-world #(assoc-in % [:clients client-addr]
-                                        {:client-addr client-addr
-                                         :server-addr server-addr
-                                         :server-port server-port
-                                         :req-ch req-ch}))
-           (reset! done true)))
+                                                  client-addr (:res-ch prog-world))]
+           (swap! prog-history
+                  #(let [ph (assoc-in % [:prog-world :clients client-addr]
+                                      {:client-addr client-addr
+                                       :server-addr server-addr
+                                       :server-port server-port
+                                       :req-ch req-ch})]
+                     (update-in ph [:prog-events] conj
+                                [(count (:prog-events ph))
+                                 :event
+                                 (:prog-world ph)]))))
+           (reset! done true))
     (wait-done done)))


fix d/pull to take the correct argument

fix d/pull to take the correct argument

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -569,7 +569,8 @@
     ; ...or they're already subscribed to the thread...
     (contains? (set (get-users-subscribed-to-thread thread-id)) user-id)
     ; ...or they're mentioned in the thread
-    (contains? (-> (d/pull *conn* [:thread/mentioned] [:thread/id thread-id])
+    ; TODO: is it possible for them to be mentioned but not subscribed?
+    (contains? (-> (d/pull (d/db *conn*) [:thread/mentioned] [:thread/id thread-id])
                    :thread/mentioned set)
                user-id)
     ; ...or they are in the group of any tags on the thread


Slightly refactor scrolling world widget and parameterize a bit more.

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -230,17 +230,19 @@
                                    (+ (:entry-time prev) heval/time-unit)
                                    (min (iv/end (:interval trans))
                                         (:t opt)))
-                            _ (soft-assert (= (get-in prev [:objects (:id opt) :state])
-                                              (:state opt))
-                                           "not="
+                            _ (assert (= (get-in prev [:objects (:id opt) :state])
+                                         (:state opt))
+                                      (str "not="
                                            (get-in prev [:objects (:id opt) :state])
-                                           (:state opt))
+                                           (:state opt)
+                                           "The state of the object in the previous state should be consistent with the from-state of the option."))
                             succ (roll/follow-transition ha-defs prev trans time)
-                            _ (soft-assert (= (get-in succ [:objects (:id opt) :state])
-                                              (:target opt))
-                                           "not="
+                            _ (assert (= (get-in succ [:objects (:id opt) :state])
+                                         (:target opt))
+                                      (str "not="
                                            (get-in succ [:objects (:id opt) :state])
-                                           (:target opt))
+                                           (:target opt)
+                                           "The state of the object in the successor state should be consistent with the to-state of the option."))
                             [rolled seen] (roll/inert-playout ha-defs succ explore-roll-limit seen)]
                         [(conj ps (concat (conj next-path succ) rolled))
                          (conj
@@ -544,22 +546,27 @@
                [:span {:style {:backgroundColor "lightgrey"}} (str (:now wld))]])))

 (def world-widget
-  (let [c
+  (let [props (fn [this] (aget (.-props this) "args"))
+        rescroll (fn [_ _]
+                   (this-as this
+                     (let [n (.getDOMNode this)
+                           wld @(get (props this) :world)]
+                       (set! (.-scrollLeft n) (:scroll-x wld))
+                       (set! (.-scrollTop n) (- (:height wld) (:scroll-y wld))))))
+        c
         (.createClass js/React
-                      #js {#_:getInitialState
-                           #_(fn [] (atom {}))
-                           :shouldComponentUpdate
+                      #js {:shouldComponentUpdate
                            (fn [next-props next-state]
                              (this-as this
-                               (or (not= next-props (.-props this))
+                               (or (not= next-props (props this))
                                    (not= @next-state @(.-state this)))))
                            :render
                            (fn []
                              (this-as this
-                               (let [props (.-props this)
-                                     world (aget props "world")
-                                     container-w (aget props "width")
-                                     container-h (aget props "height")
+                               (let [props (props this)
+                                     world (get props :world)
+                                     container-w (get props :width)
+                                     container-h (get props :height)
                                      _ (assert (instance? Atom world) "world should be atom?")
                                      wld @world
                                      world-w (:width wld)
@@ -588,45 +595,33 @@
                                                    :style   {:position "absolute"}
                                                    :viewBox (str "0 0 " world-w " " world-h)}
                                              (seen-viz/seen-viz world-h polys)
-                                             (map (fn [[x y w h]]
-                                                    [:rect {:x     x :y (- world-h h y)
-                                                            :width w :height h
-                                                            :fill  "white"}])
-                                                  (:walls wld))
+                                             [:g {}
+                                              (map (fn [[x y w h]]
+                                                     [:rect {:x     x :y (- world-h h y)
+                                                             :width w :height h
+                                                             :fill  "white"
+                                                             :key   (str x "@" y "," w "@" h)}])
+                                                   (:walls wld))]
                                              (map (fn [{{x :x y :y w :w h :h} :v0 id :id :as ha}]
                                                     [:g {:key id}
                                                      [:rect {:x     x :y (- world-h h y)
                                                              :width w :height h
-                                                             :fill  "brown"}]
+                                                             :fill  "brown"
+                                                             :key   "sprite"}]
                                                      [:text {:width    200 :x x :y (- world-h y 5)
                                                              :fontSize 8
-                                                             :fill     "lightgrey"}
+                                                             :fill     "lightgrey"
+                                                             :key      "name"}
                                                       (str id " " (:state ha))]])
-                                                  (map #(ha/extrapolate (get ha-defs (:id %)) % (:now wld)) (vals has)))]
+                                                  (map #(ha/extrapolate (get ha-defs (:id %)) % (:now wld))
+                                                       (vals has)))]
                                             (button-bar world)]))))
-                           :componentWillUpdate
-                           (fn [_ _]
-                             (this-as this
-                               (let [n (.getDOMNode this)]
-                                 ;...
-                                 true
-                                 )))
                            :componentDidUpdate
-                           (fn [_ _]
-                             (this-as this
-                               (let [n (.getDOMNode this)
-                                     wld @(aget (.-props this) "world")]
-                                 (set! (.-scrollLeft n) (:scroll-x wld))
-                                 (set! (.-scrollTop n) (- (:height wld) (:scroll-y wld))))))
+                           rescroll
                            :componentDidMount
-                           (fn [_ _]
-                             (this-as this
-                               (let [n (.getDOMNode this)
-                                     wld @(aget (.-props this) "world")]
-                                 (set! (.-scrollLeft n) (:scroll-x wld))
-                                 (set! (.-scrollTop n) (- (:height wld) (:scroll-y wld))))))})
+                           rescroll})
         f (.createFactory js/React c)]
-    (fn [arg] (f arg))))
+    f))

 (defn rererender [target]
   (let [w @world]
@@ -642,7 +637,7 @@
               (not= (:now w)
                     (:now last-world)))
       (set! last-world @world)
-      (js/React.render (world-widget #js {"world" world
-                                          "width" 640
-                                          "height" 240}) target)))
+      (js/React.render (world-widget #js {"args" {:world  world
+                                                  :width  640
+                                                  :height 240}}) target)))
   (.requestAnimationFrame js/window #(rererender target)))


Cards affecting agenda advancement costs. SanSan City Grid, NAPD Contract, Medical Breakthrough, Traffic Jam, Chakana, The Source.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -297,6 +297,15 @@
     :leave-play (effect (gain :runner :max-hand-size 2))
     :trash-effect {:req (req (:access @state))
                    :effect (effect (move :runner card :scored) (gain :runner :agenda-point 2))}}
+
+   "Chakana"
+   {:leave-play (effect (update-all-advancement-costs))
+    :events {:successful-run {:effect (effect (add-prop card :counter 1)) :req (req (= target :rd))}
+             :pre-advancement-cost {:req (req (>= (get-virus-counters state side card) 3))
+                               :effect (effect (advancement-cost-bonus 1))}
+             :counter-added
+             {:req (req (or (= (:title target) "Hivemind") (= (:cid target) (:cid card))))
+              :effect (effect (update-all-advancement-costs))}}}

    "Chaos Theory: Wünderkind"
    {:effect (effect (gain :memory 1))}
@@ -1313,6 +1322,12 @@
    {:events {:runner-turn-begins {:msg "trash the top 2 cards from Stack and draw 1 card"
                                   :effect (effect (mill 2) (draw))}}}

+   "Medical Breakthrough"
+   {:effect (effect (update-all-advancement-costs))
+    :stolen (effect (update-all-advancement-costs))
+    :advancement-cost-bonus (req (- (count (filter #(= (:title %) "Medical Breakthrough")
+                                                (concat (:scored corp) (:scored runner))))))}
+
    "Medical Research Fundraiser"
    {:effect (effect (gain :credit 8) (gain :runner :credit 3))}

@@ -1385,7 +1400,8 @@
     :effect (effect (corp-install (assoc target :advance-counter 3) "New remote"))}

    "NAPD Contract"
-   {:steal-cost [:credit 4]}
+   {:steal-cost [:credit 4]
+    :advancement-cost-bonus (req (:bad-publicity corp))}

    "NBN: Making News"
    {:recurring 2}
@@ -1896,6 +1912,14 @@
                  :choices (req (filter #(and (has? % :type "Event")
                                              (<= (:cost %) (:credit runner))) (:discard runner)))
                  :effect (effect (trash card) (play-instant target))}]}
+
+   "SanSan City Grid"
+   {:effect (req (when-let [agenda (some #(when (= (:type %) "Agenda") %) (:content (card->server state card)))]
+                   (update-advancement-cost state side agenda)))
+    :events {:corp-install {:req (req (and (= (:type target) "Agenda") (= (:zone card) (:zone target))))
+                            :effect (effect (update-advancement-cost target))}
+             :pre-advancement-cost {:req (req (= (:zone card) (:zone target)))
+                               :effect (effect (advancement-cost-bonus -1))}}}

    "Satellite Uplink"
    {:req (req tagged) :msg (msg "expose " (join ", " (map :title targets)))
@@ -2349,6 +2373,13 @@
    "Traffic Accident"
    {:req (req (>= (:tag runner) 2)) :effect (effect (damage :meat 2 {:card card}))}

+   "Traffic Jam"
+   {:effect (effect (update-all-advancement-costs))
+    :leave-play (effect (update-all-advancement-costs))
+    :events {:pre-advancement-cost
+             {:effect (req (advancement-cost-bonus
+                             state side (count (filter #(= (:title %) (:title target)) (:scored corp)))))}}}
+
    "Tri-maf Contact"
    {:abilities [{:cost [:click 1] :msg "gain 2 [Credits]" :once :per-turn
                  :effect (effect (gain :credit 2))}]
@@ -3383,9 +3414,6 @@
    "Bad Times"
    {:req (req tagged)}

-   "Chakana"
-   {:events {:successful-run {:effect (effect (add-prop card :counter 1)) :req (req (= target :rd))}}}
-
    "Exile: Streethawk"
    {:effect (effect (gain :link 1))}

@@ -3433,4 +3461,7 @@
                                             (has? target :subtype "Gray Ops")))}}}

    "The Source"
-   {:events {:agenda-scored (effect (trash card)) :agenda-stolen (effect (trash card))}}})
+   {:effect (effect (update-all-advancement-costs))
+    :leave-play (effect (update-all-advancement-costs))
+    :events {:agenda-scored (effect (trash card)) :agenda-stolen (effect (trash card))
+             :pre-advancement-cost {:effect (effect (advancement-cost-bonus 1))}}}})


Fix --help: color is available in standalone mode.

(The only difference compared to nREPL mode is that stderr output
in the standalone REPL is not yet highlighted red.)

--- src/clj/reply/main.clj
+++ src/clj/reply/main.clj
@@ -26,7 +26,7 @@
             :parse-fn initialization/formify-file]
            ["--standalone" "Launch standalone mode instead of the default nREPL"
             :flag true]
-           ["--color" "Use color; currently only available with nREPL"
+           ["--color" "Use color"
             :flag true]
            ["--skip-default-init" "Skip the default initialization code"
             :flag true]


CLJS-1162: Failure to printStackTrace when REPL initialized

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -24,7 +24,7 @@
             [cljs.tagged-literals :as tags]
             [cljs.closure :as cljsc]
             [cljs.source-map :as sm])
-  (:import [java.io File PushbackReader FileWriter]
+  (:import [java.io File PushbackReader FileWriter PrintWriter]
            [java.net URL]
            [javax.xml.bind DatatypeConverter]
            [clojure.lang IExceptionInfo]
@@ -729,7 +729,10 @@
                :source-map-inline source-map-inline})))
         done? (atom false)]
     (env/with-compiler-env (or compiler-env (env/default-compiler-env opts))
-     (binding [*err* (if bind-err *out* *err*)
+     (binding [*err* (if bind-err
+                       (cond-> *out*
+                         (not (instance? PrintWriter *out*)) (PrintWriter.))
+                       *err*)
                ana/*cljs-ns* ana/*cljs-ns*
                *cljs-verbose* repl-verbose
                ana/*cljs-warnings*


formatting + space for improv

formatting + space for improv

--- src/codemash/core.clj
+++ src/codemash/core.clj
@@ -29,9 +29,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;     Waves           ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;
-(do
-  (voice/waves)
-  (println art/waves))
+(do (voice/waves) (println art/waves))

 (demo (sin-osc))
 (demo (lf-saw))
@@ -48,7 +46,6 @@
 ;; * Additive                       ;;
 ;; * Subtractive                    ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (do (voice/synthesis))

 (defsynth wallop [])
@@ -66,10 +63,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; * Cheat sheet:
 ;;     - https://github.com/overtone/overtone/raw/master/docs/cheatsheet/overtone-cheat-sheet.pdf
-
-(do
-  (voice/ugens)
-  (println art/sweet-shop))
+(do (voice/ugens) (println art/sweet-shop))

 (defsynth woody-beep [freq 300 out-bus 0 dur 0.4]
   (let [tri (* 0.5 (lf-tri:ar freq))
@@ -104,10 +98,7 @@
 ;;;;;;;;;;;
 ;;Samples;;
 ;;;;;;;;;;;
-
-(do
-  (println art/samples)
-  (voice/samples))
+(do (println art/samples) (voice/samples))

 (def clap (freesound-sample 48310))
 (def clap2 (freesound-sample 132676))
@@ -120,10 +111,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;Busses - Wiring synths ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(do
-  (println art/busses)
-  (voice/busses))
+(do (println art/busses) (voice/busses))

 ;;Audio busses are just ids preallocated at boot.
 (defonce tri-bus (audio-bus "triangle bus"))
@@ -157,10 +145,7 @@
 ;;;;;;;;;;;;;;;
 ;;Instruments;;
 ;;;;;;;;;;;;;;;
-
-(do
-  (println art/instrument)
-  (voice/instruments))
+(do (println art/instrument) (voice/instruments))

 ;;Sampled
 (comment (require '[overtone.inst.sampled-piano :as s-piano]))
@@ -180,10 +165,7 @@
 ;;;;;;;;;;
 ;;Timing;;
 ;;;;;;;;;;
-
-(do
-  (voice/timing)
-  (println art/time))
+(do (voice/timing) (println art/time))

 (defonce timing-g (group "codemash timing" :tgt (foundation-safe-pre-default-group)))

@@ -228,9 +210,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;Building Sequencer with buffers;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(do
-  (voice/buffers)
-  (println art/buffers))
+(do (voice/buffers) (println art/buffers))

 (def sample-root "~/Workspace/music/samples/sliced-p5/")
 (def beats-g (group "beats"))
@@ -263,7 +243,6 @@
                      :sequencer kick-sequencer-buffer))))

 (buffer-write! kick-sequencer-buffer [1 0 0 0 0 1 0 0])
-(buffer-write! kick-sequencer-buffer [1 0 0 0 0 1 1 0])

 (defonce tom-sequencer-buffer (buffer 8))
 (defonce tom-s (load-sample (str sample-root "tom.aif")))
@@ -306,20 +285,17 @@
    (for [x (range 8)] (mono-sequencer [:tail beats-g] :buf shake1-s :beat-num x
                      :sequencer shake1-sequencer-buffer))))

-(buffer-write! kick-sequencer-buffer    [1 0 0 0 0 1 0 0])
-(buffer-write! tom-sequencer-buffer     [0 0 1 0 0 0 1 0])
-(buffer-write! shake-sequencer-buffer   [0 1 0 0 0 0 0 0])
+(buffer-write! kick-sequencer-buffer    [0 0 0 0 0 0 0 0])
+(buffer-write! tom-sequencer-buffer     [0 0 0 0 0 0 0 0])
+(buffer-write! shake-sequencer-buffer   [0 0 0 0 0 0 0 0])
 (buffer-write! shake2-sequencer-buffer  [0 0 0 0 0 0 0 0])
-(buffer-write! shake2d-sequencer-buffer [0 0 0 0 0 0 0 1])
-(buffer-write! shake1-sequencer-buffer  [0 0 0 0 1 0 0 0])
+(buffer-write! shake1-sequencer-buffer  [0 0 0 0 0 0 0 0])
+(buffer-write! shake2d-sequencer-buffer [0 0 0 0 0 0 0 0])

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;Playing notes with buffers ;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(do
-  (println art/notes)
-  (voice/notes-buffers))
+(do (println art/notes) (voice/notes-buffers))

 (defonce score-b         (buffer 128))
 (defonce duration-b      (buffer 128))
@@ -381,13 +357,6 @@

 (def duration   [1/7])

-(def score (concat
-            (map #(+ -5  (note %)) score)
-            (map #(+ -5  (note %)) score)
-            (map #(+ -10 (note %)) score)
-            (map #(+ -5  (note %)) score)
-            (map #(+ -1  (note %)) score)))
-
 (buffer-write! bass-duration-b (take 128 (cycle [(/ 1 3.5)])))
 (buffer-write! bass-notes-b    (take 128 (cycle (map note bass-score))))
 (buffer-write! bass-notes-b    (take 128 (cycle (map #(+ -12 (note %)) score))))
@@ -401,10 +370,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;Hardware (External devices);;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(do
-  (println art/hardware)
-  (voice/hardware))
+(do (println art/hardware) (voice/hardware))

 (midi-connected-devices)

@@ -433,25 +399,6 @@
 (spacey)
 (kill spacey)

-;; Improv
-
-(defonce clap-sequencer-buffer (buffer 8))
-(def claps
-  (doall
-   (for [x (range 8)] (mono-sequencer [:tail beats-g] :buf clap2 :beat-num x
-                                      :sequencer clap-sequencer-buffer))))
-
-(buffer-write! clap-sequencer-buffer [1 0 0 0 0 0 0 0])
-
-(defonce clap1-sequencer-buffer (buffer 8))
-(def claps
-  (doall
-   (for [x (range 8)] (mono-sequencer [:tail beats-g] :buf clap :beat-num x
-                                      :sequencer clap1-sequencer-buffer))))
-
-(buffer-write! clap1-sequencer-buffer [0 0 0 0 0 0 0 1])
-
-
 ;(stop)

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


Fix nil map for deep-merge

Fix nil map for deep-merge

--- src/runbld/build.clj
+++ src/runbld/build.clj
@@ -34,26 +34,25 @@

 (defn wrap-merge-profile [proc]
   (fn [opts]
-    (let [profile (keyword (get-in opts [:build :profile-name]))]
-      (proc
-       (assoc opts
-              :opts (deep-merge-with
-                     deep-merge
-                     (:opts opts)
-                     (get-in opts [:opts :profiles profile])))))))
+    (let [profile-name (keyword (get-in opts [:build :profile-name]))
+          profile (or (get-in opts [:opts :profiles profile-name]) {})
+          opts* (assoc opts
+                       :opts (deep-merge-with deep-merge (:opts opts) profile))]
+      (proc opts*))))

 (defn wrap-build-meta [proc]
   (fn [opts]
-    (proc
-     (assoc opts
-            :build (merge
-                    {:id (make-id)
-                     :url (get-in opts [:env "BUILD_URL"])
-                     :jenkins-number (get-in opts [:env "BUILD_NUMBER"])
-                     :node-executor (get-in opts [:env "EXECUTOR_NUMBER"])
-                     :host (get-in opts [:env "NODE_NAME"])
-                     :labels (get-in opts [:env "NODE_LABELS"])
-                     :workspace (get-in opts [:env "WORKSPACE"])}
-                    (inherited-build-info
-                     (or (get-in opts [:env "JOB_NAME"])
-                         (get-in opts [:opts :default-job-name]))))))))
+    (let [opts* (assoc
+                 opts
+                 :build (merge
+                         {:id (make-id)
+                          :url (get-in opts [:env "BUILD_URL"])
+                          :jenkins-number (get-in opts [:env "BUILD_NUMBER"])
+                          :node-executor (get-in opts [:env "EXECUTOR_NUMBER"])
+                          :host (get-in opts [:env "NODE_NAME"])
+                          :labels (get-in opts [:env "NODE_LABELS"])
+                          :workspace (get-in opts [:env "WORKSPACE"])}
+                         (inherited-build-info
+                          (or (get-in opts [:env "JOB_NAME"])
+                              (get-in opts [:opts :default-job-name])))))]
+      (proc opts*))))


#[672] WIP Updated doc strings. Refactored get-column-ids.

--- backend/src/akvo/lumen/import/csv.clj
+++ backend/src/akvo/lumen/import/csv.clj
@@ -3,30 +3,31 @@
             [clojure.java.io :as io]
             [clojure.java.jdbc :as jdbc]
             [clojure.string :as s]
-            [incanter.core :as incanter]
-            [incanter.io :refer [read-dataset]])
-  (:import [com.ibm.icu.text CharsetDetector]))
+            [incanter.core :refer [$ $map ncol to-vect]]
+            [incanter.io :refer [read-dataset]]))

 (defn- get-column-ids
-  "Returns a seq of generic, alphanumeric column names
-  of the form c1, c2, c3, ... for the given number of columns"
+  "Returns a seq of alphanumeric column names of the form
+  c1, c2, c3, ... for the given number of columns"
   [num-cols]
-  (map #(str "c" %) (range 1 (inc num-cols))))
+  (let [nums (range 1 (inc num-cols))]
+    (->> (map vector (repeat "c") nums)
+         (map s/join))))

 (defn get-type
-  "Determines the client and PostgreSQL type of the given value.
-  Defaults to 'text'."
+  "Returns a keyword representing the type of the given value.
+  Defaults to `:text`."
   [value]
   (condp #(%1 %2) value
-    ;; date-string? :date
+    ;; TODO date-string? :date
     nil? :nil
     number? :number
     :text))

 (defn all-of-type?
-  "Determines if all types in the given column are unified"
-  [type-kw coll]
+  "Determines if all types in the given column are the same or `:nil`"
+  [coll type-kw]
   {:pre [(contains? #{:date :number :text} type-kw)]}
   (every? true? (map #(contains? #{:nil type-kw} %) coll)))

@@ -34,20 +35,20 @@
   "Determines the common type of the given coll of types.
   Defaults to 'text' if types cannot be unified."
   [coll]
-  (condp #(all-of-type? %1 %2) coll
+  (condp #(all-of-type? %2 %1) coll
     :date {:client "date" :psql "timestamptz"}
     :number {:client "number" :psql "double precision"}
     :text {:client "text" :psql "text"}
     {:client "text" :psql "text"}))

-(defn get-column-types
+(defn get-dataset-types
   "Returns a seq of the common types of each column in the given dataset"
   [{:keys [column-names] :as dataset}]
-  (->> (map #(incanter/$map get-type % dataset) column-names)
+  (->> (map #($map get-type % dataset) column-names)
        (map get-common-type)))

 (defn get-column-tuples
-  "Returns a sequence of maps containing column names, titles & types
+  "Returns a vector of maps containing column names, titles & types
   for consumption by the client.

   Example output:
@@ -55,33 +56,20 @@
   [{:column-name \"c1\" :title \"Title\" :type \"text\"} ...]
   "
   [column-ids column-names column-types]
-  (mapv #(into {} {:column-name %1 :title %2 :type %3})
+  (mapv #(zipmap [:column-name :title :type] [%1 %2 %3])
         column-ids column-names column-types))
-
-(defn get-encoding
-  "Returns the character encoding reading some bytes from the given CSV file
-  using ICU's `CharsetDetector`"
-  [path]
-  (let [detector (CharsetDetector.)
-        ;; 100kb
-        ba (byte-array 100000)]
-    (with-open [input-stream (io/input-stream path)]
-      (.read input-stream ba))
-    (-> (.setText detector ba)
-        (.detect)
-        (.getName))))

 (defn- load-csv!
   "Imports the given CSV data into a PostgreSQL table"
-  [tenant-conn table-name path encoding headers?]
+  [tenant-conn table-name path headers?]
   (try
     (let [{:keys [column-names] :as dataset} (read-dataset path :header headers?)
-          column-ids (get-column-ids (incanter/ncol dataset))
+          column-ids (get-column-ids (ncol dataset))
           column-titles (if headers? (map name column-names) column-ids)
-          column-types (get-column-types dataset)
+          column-types (get-dataset-types dataset)
           client-types (mapv :client column-types)
           psql-types (mapv :psql column-types)
-          rows (incanter/to-vect (incanter/$ :all dataset))]
+          rows (to-vect ($ :all dataset))]
       (jdbc/db-do-commands tenant-conn
         (jdbc/create-table-ddl
           table-name
@@ -120,6 +108,5 @@
 (defmethod import/make-dataset-data-table "CSV"
   [tenant-conn {:keys [file-upload-path]} table-name spec]
   (let [path (get-path spec file-upload-path)
-        headers? (boolean (get spec "hasColumnHeaders"))
-        encoding (get-encoding path)]
-      (load-csv! tenant-conn table-name path encoding headers?)))
+        headers? (boolean (get spec "hasColumnHeaders"))]
+      (load-csv! tenant-conn table-name path headers?)))


Checking in a bunch of crypto work.

Checking in a bunch of crypto work.

--- src/vault/crypto.clj
+++ src/vault/crypto.clj
@@ -6,92 +6,145 @@
     (org.bouncycastle.jce.provider BouncyCastleProvider)
     (org.bouncycastle.openpgp PGPUtil
                               PGPPublicKey
-                              PGPPublicKeyRing
                               PGPPublicKeyRingCollection
-                              PGPSecretKeyRingCollection)))
+                              PGPSecretKey
+                              PGPSecretKeyRingCollection
+                              PGPSignature
+                              PGPSignatureGenerator
+                              )))

+; Install the BouncyCastle security provider.
 (Security/addProvider (new BouncyCastleProvider))

-(def ^:private public-key-algorithms
-  "Map of numeric codes to public-key algorithm names."
-  (->> (.getFields org.bouncycastle.bcpg.PublicKeyAlgorithmTags)
-       (map #(vector (.getInt % nil) (.getName %)))
+
+;; CONSTANTS
+
+(def ^:private security-provider "BC")
+
+
+(def ^:dynamic *hash-algorithm*
+  "Digest algorithm used for creating signatures."
+  "SHA1")
+
+
+(def hash-algorithms
+  "Map of numeric codes to available hash algorithm names."
+  (->> (.getFields org.bouncycastle.bcpg.HashAlgorithmTags)
+       (map #(vector (.getName %) (.getInt % nil)))
        (into {})))

-
-;; KEY FUNCTIONS
-
-(defn key-algorithm
-  "Returns the standard algorithm name for the key."
-  [k]
-  (.getAlgorithm k))
+(def public-key-algorithms
+  "Map of numeric codes to available public-key algorithm names."
+  (->> (.getFields org.bouncycastle.bcpg.PublicKeyAlgorithmTags)
+       (map #(vector (.getName %) (.getInt % nil)))
+       (into {})))

-(defn key-format
-  "Returns the name of the primary encoding format of the key."
-  [k]
-  (.getFormat k))
-
-
-(defn encode-key
-  "Returns the key in its primary encoding format."
-  [k]
-  (.getEncoded k))
-
-
-(defn private-key
-  "Converts the argument to a private key."
-  [k]
-  (cond (instance? PrivateKey k) k
-        (instance? KeyPair k) (.getPrivate k)
-        :else (throw (IllegalArgumentException.
-                       (str "Unknown private-key type: " k)))))
-
-
-(defn public-key
-  "Converts the argument to a public key."
-  [k]
-  (cond (instance? PublicKey k) k
-        (instance? KeyPair k) (.getPublic k)
-        :else (throw (IllegalArgumentException.
-                       (str "Unknown public-key type: " k)))))
+(defn- algorithm-name
+  "Look up the name of an algorithm given the numeric code."
+  [codes code]
+  (some (fn [[k i]] (if (= i code) k)) codes))

 ;; TEST FUNCTIONALITY

-(defn load-public-keys
-  "Loads the public keys present in the keyring file named by the path."
-  [path]
-  (with-open [input (PGPUtil/getDecoderStream
-                      (io/input-stream path))]
-    (->> input
-         (new PGPPublicKeyRingCollection)
-         .getKeyRings
-         iterator-seq
-         (mapcat #(iterator-seq (.getPublicKeys %))))))
+(defn key-id
+  "Coerce argument into a PGP key identifier."
+  [x]
+  (cond (integer? x) x
+        (string? x) (Long/parseLong x 16)
+        (instance? PGPPublicKey x) (.getKeyID x)
+        (instance? PGPSecretKey x) (.getKeyID x)
+        :else (throw (IllegalArgumentException.
+                       (str "Don't know how to make key id from: " x)))))

-(defn load-secret-keys
-  "Loads the private keyrings present in the keyring file named by the path."
-  [path]
+(defn- key-algorithm-code
+  "Returns numeric algorithm code from key argument."
+  [k]
+  (cond (instance? PGPPublicKey k) (.getAlgorithm k)
+        (instance? PGPSecretKey k) (.getAlgorithm (.getPublicKey k))
+        :else (throw (IllegalArgumentException.
+                       (str "Don't know how to get key algorithm from: " k)))))
+
+(defn key-algorithm
+  "Returns the name of the algorithm used by the given key."
+  [k]
+  (algorithm-name public-key-algorithms (key-algorithm-code k)))
+
+
+(defn signing-key? [k]
+  (.isSigningKey k))
+
+
+(defn load-secret-key
+  "Loads a secret key from the given keyring file."
+  [keyring-file id]
   (with-open [input (PGPUtil/getDecoderStream
-                      (io/input-stream path))]
-    (->> input
-         (new PGPSecretKeyRingCollection)
-         .getKeyRings
-         iterator-seq
-         (mapcat #(iterator-seq (.getSecretKeys %))))))
+                      (io/input-stream keyring-file))]
+    (-> (PGPSecretKeyRingCollection. input)
+        (.getSecretKey (key-id id)))))
+
+
+(defn- generate-signature
+  [data-source
+   hash-algorithm-code
+   key-algorithm-code
+   private-key]
+  (let [generator (PGPSignatureGenerator.
+                    key-algorithm-code
+                    hash-algorithm-code
+                    security-provider)]
+    (.init generator PGPSignature/BINARY_DOCUMENT private-key)
+    (with-open [data (io/input-stream data-source)]
+      (let [buffer (byte-array 256)]
+        (loop [n (.read data buffer)]
+          (when (> n 0)
+            (.update generator buffer 0 n)
+            (recur (.read data buffer))))))
+    (.generate generator)))
+
+
+(defn sign
+  [data-source secret-key passphrase]
+  (let [private-key (.extractPrivateKey
+                      secret-key
+                      passphrase
+                      security-provider)]
+    (generate-signature
+      data-source
+      (hash-algorithms *hash-algorithm*)
+      (key-algorithm-code secret-key)
+      private-key)))

 (defn print-key-info
   "Prints information about the given key."
   [k]
-  (println "Key id:" (Long/toHexString (.getKeyID k)))
-  (println "        Algorithm:" (public-key-algorithms (.getAlgorithm k) "UNKNOWN"))
-  (println "        Fingerprint:" (->> (.getFingerprint k)
-                                       (map (partial format "%02X"))
-                                       string/join)))
+  (println "Key id:" (Long/toHexString (key-id k))
+           (if (.isMasterKey k) "(master key)" "(subkey)"))
+  (when (instance? PGPSecretKey k)
+    (if (.isPrivateKeyEmpty k)
+      (println "    Private key is not available.")
+      (if (.isSigningKey k)
+        (println "    Private key is available for decryption and signing.")
+        (println "    Private key is available for decryption."))))
+  (let [public-key (if (instance? PGPSecretKey k) (.getPublicKey k) k)
+        strength (.getBitStrength public-key)
+        algorithm (or (key-algorithm public-key) "UNKNOWN")
+        fingerprint (->> (.getFingerprint public-key)
+                         (map (partial format "%02X"))
+                         string/join)]
+    (if (.isEncryptionKey public-key)
+      (println "    Public key is available for encryption.")
+      (println "    Public key is available."))
+    (println "    Algorithm:" algorithm (str \( strength " bits)"))
+    (println "    Fingerprint:"
+             (str (subs fingerprint 0 (- (count fingerprint) 8)) \/
+                  (subs fingerprint (- (count fingerprint) 8))))
+    (doseq [uid (.getUserIDs public-key)]
+      (println "    User ID:" uid))))


Require path to configuration file as argument

--- src/whitman/core.clj
+++ src/whitman/core.clj
@@ -1,5 +1,12 @@
 (ns whitman.core
   (:gen-class))

+(defn exit [code msg]
+  (binding [*out* *err*]
+    (do (println msg)
+        (System/exit code))))
+
 (defn -main [& args]
-  (println "Hello, world!"))
+  (if (< (count args) 1)
+      (exit 1 "No configuration file specified")
+      (println "Hello, world!")))


Short circuit db pred on instance check in clj

--- src/datascript/db.cljc
+++ src/datascript/db.cljc
@@ -621,9 +621,19 @@
     (diff-sorted (:eavt a) (:eavt b) cmp-datoms-eav-quick)))

 (defn db? [x]
-  (and (satisfies? ISearch x)
-       (satisfies? IIndexAccess x)
-       (satisfies? IDB x)))
+  #?(:clj
+     (or
+      (and x
+           (instance? datascript.db.ISearch x)
+           (instance? datascript.db.IIndexAccess x)
+           (instance? datascript.db.IDB x))
+      (and (satisfies? ISearch x)
+           (satisfies? IIndexAccess x)
+           (satisfies? IDB x)))
+     :cljs
+     (and (satisfies? ISearch x)
+          (satisfies? IIndexAccess x)
+          (satisfies? IDB x))))

 ;; ----------------------------------------------------------------------------
 (defrecord-updatable FilteredDB [unfiltered-db pred hash]


More refinement of error handling

More refinement of error handling

--- src/depends/reader.clj
+++ src/depends/reader.clj
@@ -373,7 +373,10 @@
   (let [tfile-or-directory (net.java.truevfs.access.TFile. file-or-directory)
         is-directory?      (.isDirectory tfile-or-directory)]
     (if is-directory?
-      (let [listing             (doall (file-seq tfile-or-directory))  ; Note: this handles recursion into sub-archives / sub-sub-archives etc. for us
+      (let [listing             (try
+                                  (doall (file-seq tfile-or-directory))  ; Note: this handles recursion into sub-archives / sub-sub-archives etc. for us
+                                  (catch Exception e
+                                    (throw (Exception. (str "Unexpected exception while scanning " file-or-directory ". Possibly a corrupted archive?") e))))
             class-files         (filter #(and (.canRead ^java.io.File %)
                                               (.isFile ^java.io.File %)
                                               (.endsWith ^String (.getName ^java.io.File %) ".class"))


cleanup

cleanup

--- ccw.core/src/ccw/debug/serverrepl.clj
+++ ccw.core/src/ccw/debug/serverrepl.clj
@@ -108,13 +108,9 @@
         [:children
          (apply vector (sort-by :name (map #(var-info (second %)) (ns-interns n))))]))))

-(def ns-info-cache (atom nil))
-
 (defn namespaces-info []
-  (let [info
-        {:name "namespaces" :type "namespaces"
-         :children (apply vector (sort-by :name (map ns-info (all-ns))))}]
-    (reset! ns-info-cache info) info))
+  {:name "namespaces" :type "namespaces"
+   :children (apply vector (sort-by :name (map ns-info (all-ns))))})

 ; The following function (splitted-match) taken from vimClojure with the permission of the author.
 ; Please look for vimClojure license for more detail


Add degree to radian conversion to run-constants

--- src/hydrofoil/core.clj
+++ src/hydrofoil/core.clj
@@ -13,7 +13,8 @@
   [dencity velocity angle-of-attack]
   (hash-map :dencity dencity
             :velocity velocity
-            :angle-of-attack angle-of-attack))
+            :angle-of-attack angle-of-attack
+            :angle-of-attack-radiants (*(/ (Math/Pi) 180)) angle-of-attack))

 (defn -main [& args]
   (new-indv(NACA-design 50 50 50)))


remove css dirs from figwheel

remove css dirs from figwheel

--- script/figwheel.clj
+++ script/figwheel.clj
@@ -3,8 +3,7 @@

 (ra/start-figwheel!

-  {:figwheel-options {:css-dirs ["resources/public/css"]
-                      :server-port 3559}
+  {:figwheel-options {:server-port 3559}
    :build-ids ["dev"]
    :all-builds
    [{:id "dev"


Update ClojureScript dependency to 0.0-2644.

This version contains new cljs.repl.node.

--- src/leiningen/new/chestnut/project.clj
+++ src/leiningen/new/chestnut/project.clj
@@ -9,7 +9,7 @@
   :test-paths ["spec/clj"]

   :dependencies [[org.clojure/clojure "1.6.0"]
-                 [org.clojure/clojurescript "0.0-2496" :scope "provided"]
+                 [org.clojure/clojurescript "0.0-2644" :scope "provided"]
                  [ring "1.3.2"]
                  [ring/ring-defaults "0.1.2"]
                  [compojure "1.3.1"]


Pause if MIDI just opened to watch for clocks

--- src/afterglow/midi.clj
+++ src/afterglow/midi.clj
@@ -276,24 +276,28 @@
   Returns the opened inputs."
   []
   (swap! midi-transfer-thread start-handoff-thread)
-  (let [port-filter (create-midi-port-filter)
+  (let [old-inputs @midi-inputs
+        port-filter (create-midi-port-filter)
         result (swap! midi-inputs #(if (empty? %)
                                      (map connect-midi-in
                                           (filter port-filter (midi/midi-sources)))
                                      %))]
-    (doseq [_ result])  ;; Make it actually happen now
+    (when (empty? old-inputs)
+      (doseq [_ result]))  ;; Walk the mapped sequence to make the calls actually happen now
     result))

 (defn open-outputs-if-needed!
   "Make sure the MIDI output ports are open and ready to receive events.
   Returns the opened outputs."
   []
-  (let [port-filter (create-midi-port-filter)
+  (let [old-outputs @midi-outputs
+        port-filter (create-midi-port-filter)
         result (swap! midi-outputs #(if (empty? %)
                                       (map connect-midi-out
                                            (filter port-filter (midi/midi-sinks)))
                                       %))]
-    (doseq [_ result])  ;; Make it actually happen now
+    (when (empty? old-outputs)
+      (doseq [_ result])) ;; Walk the mapped sequence to make the calls actually happen now
     result))

 ;; Appears to be unsafe, we need to just keep them open
@@ -539,7 +543,9 @@
   ([]
    (sync-to-midi-clock nil))
   ([name-filter]
-   (open-inputs-if-needed!)
+   (let [old-inputs @midi-inputs]
+     (open-inputs-if-needed!)
+     (when (empty? old-inputs) (Thread/sleep 300)))  ; Give the clock watcher a chance to spot messages
    (let [result (filter-devices (current-clock-sources) name-filter)]
      (case (count result)
        0 (throw (IllegalArgumentException. (str "No MIDI clock sources " (describe-name-filter name-filter)


Renaming the parse functions

Renaming the parse functions

--- src/app/javaparser.clj
+++ src/app/javaparser.clj
@@ -11,7 +11,9 @@
 ; Parsing
 ; ============================================

-(defn parseFile [file]
+(defn parseFile
+  "Parse a file, and return nil if the file cannot be loaded"
+  [file]
   (try
     (JavaParser/parse file)
     (catch Exception e nil)))
@@ -22,14 +24,14 @@
       (JavaParser/parse reader false)
       (catch Exception e nil))))

-(defn parse [filename]
+(defn parseFileByName [filename]
   (parseFile (new java.io.File filename)))

-(defn parseAllFiles [files]
+(defn parseFiles [files]
   (map (fn [f] {:file f :cu (parseFile f)}) files))

-(defn parseDir [dirname]
-  (parseAllFiles (java-files dirname)))
+(defn parseDirByName [dirname]
+  (parseFiles (java-files dirname)))

 ; ============================================
 ; Model
@@ -133,7 +135,7 @@

 ; Get tuples of [filename cu]
 (defn cusTuples [dirname]
-  (filter not-nil? (parseDir dirname)))
+  (filter not-nil? (parseDirByName dirname)))

 (defn cus [dirname]
   (map (fn [cuTuple] (:cu cuTuple)) (cusTuples dirname)))


Using the constructor prototype to distinguish constructors

--- src/app/javaparser.clj
+++ src/app/javaparser.clj
@@ -178,7 +178,7 @@
 (extend-protocol Named
   ConstructorDeclaration
   (getName [this]
-    (.getName this))
+    (.getDeclarationAsString this false false false))
   (getQName [this]
     (let [pn (.getParentNode this)]
       (str (getQName pn) "." (getName this)))))


Use namespaces when importing

Use namespaces when importing

--- src/bookshelf/core.clj
+++ src/bookshelf/core.clj
@@ -1,8 +1,8 @@
 (ns bookshelf.core
   (:gen-class)
-  (:use ring.adapter.jetty)
-  (:use ring.middleware.reload)
-  (:use ring.middleware.stacktrace))
+  (:use [ring.adapter.jetty :as jetty])
+  (:use [ring.middleware.reload :as reload])
+  (:use [ring.middleware.stacktrace :as stacktrace]))

 (defn handler [request]
   {:status 200
@@ -11,8 +11,8 @@

 (def app
   (-> #'handler
-      (wrap-reload '(bookshelf.core))
-      (wrap-stacktrace)))
+      (reload/wrap-reload '(bookshelf.core))
+      (stacktrace/wrap-stacktrace)))

 (defn run []
-  (run-jetty #'app {:port 3000}))
+  (jetty/run-jetty #'app {:port 3000}))


Reusing vis/process-render.

Reusing vis/process-render.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -140,9 +140,7 @@
 (defn world-vis-init [el-prefix init-event-delay]
   (init-roots)
   (let [prog-ch (listen-el (gdom/getElement "prog-go") "click")
-        step-ch (chan (dropping-buffer 1))
-        render-ch (chan)]
-    (process-render render-ch)
+        step-ch (chan (dropping-buffer 1))]
     (go-loop [num-worlds 0]
       (let [last-id (atom 0)
             gen-id #(swap! last-id inc)
@@ -165,13 +163,15 @@
                                  }}
                   :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
                           ;         :first-taker-actx actx-or-nil}}.
-                  :gen-id gen-id})]
+                  :gen-id gen-id})
+            render-ch (chan)]
         (reset! curr-world {:world world
                             :net-listen-ch (achan-buf world 10)
                             :net-connect-ch (achan-buf world 10)
                             :servers {}
                             :clients {}})
         (cbfg.vis/process-events vis event-delay event-ch step-ch render-ch)
+        (cbfg.vis/process-render el-prefix world render-ch nil)
         (make-net world
                   (:net-listen-ch @curr-world)
                   (:net-connect-ch @curr-world))
@@ -182,6 +182,7 @@
           (println :curr-world @curr-world)
           (<! prog-ch)
           (close! event-ch)
+          (close! render-ch)
           (recur (inc num-worlds)))))))

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


Commented out incomplete wrapped-pca implementation

--- src/pca.clj
+++ src/pca.clj
@@ -100,10 +100,10 @@
             (recur data' n-comps' pcs (rest start-vectors))))))))

-(defn wrapped-pca [data n-comps & {:keys [iters start-vectors] :as kwargs}]
-  (let [[row-cnt col-cnt] (dim data)]
-    (case [(> row-cnt 1) (> col-cnt 1)]
-      [true true] (apply powerit-pca data n-comps kwargs)
+;(defn wrapped-pca [data n-comps & {:keys [iters start-vectors] :as kwargs}]
+  ;(let [[row-cnt col-cnt] (dim data)]
+    ;(case [(> row-cnt 1) (> col-cnt 1)]
+      ;[true true] (apply powerit-pca data n-comps kwargs)

 (defn pca-project [data pcs]


whitespace on the compare link

whitespace on the compare link

--- frontend/components/build_head.cljs
+++ frontend/components/build_head.cljs
@@ -86,7 +86,7 @@
            [:strong "Commit Log"]
            (when (:compare build)
              [:a.compare {:href (:compare build)}
-              "compare"
+              "compare "
               [:i.fa.fa-github]])
            (when (< 3 (count (:all_commit_details build)))
              [:a {:role "button"


Adding count-by-key to api

Adding count-by-key to api

--- src/clj/flambo/api.clj
+++ src/clj/flambo/api.clj
@@ -116,6 +116,13 @@
       .groupByKey
       (.map (function untuple))))

+(defn count-by-key [rdd]
+  "Only available on RDDs of type (K, V).
+  Returns a `Map` of (K, Int) pairs with the count of each key."
+  (-> rdd
+      (.map (pair-function identity))
+      .countByKey))
+
 (defn combine-by-key [rdd create-combiner merge-value merge-combiners]
   (-> rdd
       (.map (pair-function identity))


changes to The Underway cards

changes to The Underway cards

Final cards in English have been revealed:  http://imgur.com/a/14LON

Changes Hyperconductor to Hyperdriver, fix typo in Faust, add Marcus Batty. Moves Spike and Shiv to the icebreakers section.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -1156,8 +1156,8 @@
    "HQ Interface"
    {:effect (effect (gain :hq-access 1)) :leave-play (effect (lose :hq-access 1))}

-   "Hyperconductor"
-   {:abilities [{:label "Remove Hyperconductor from the game to gain [Click] [Click] [Click]"
+   "Hyperdriver"
+   {:abilities [{:label "Remove Hyperdriver from the game to gain [Click] [Click] [Click]"
                  :effect (effect (move card :rfg) (gain :memory 3 :click 3))
                  :msg "gain [Click] [Click] [Click]"}]}

@@ -1457,6 +1457,13 @@
    "Manhunt"
    {:events {:successful-run {:once :per-turn :trace {:base 2 :msg "give the Runner 1 tag"
                                                       :effect (effect (gain :runner :tag 1))}}}}
+
+   "Marcus Batty"
+   {:abilities [{:msg "start a Psi game"
+                 :psi {:not-equal {:req (req this-server)
+                                   :choices {:req #(and (has? % :type "ICE") (:rezzed %))}
+                                   :msg (msg "resolve a subroutine on " (:title target))
+                                   :effect (effect (trash card {:cause :ability-cost}))}}}]}

    "Mark Yale"
    {:events {:agenda-counter-spent {:effect (effect (gain :credit 1))
@@ -2352,9 +2359,6 @@
     :req (req tagged)
     :effect (req (doseq [t targets] (rez state side t {:no-cost true})))}

-   "Shiv"
-   {:abilities [{:msg "break up to 3 sentry subroutines" :effect (effect (trash card))}]}
-
    "Silencer"
    {:recurring 1}

@@ -2427,9 +2431,6 @@
     :effect (effect (system-msg (str "adds " (:title target) " to his Grip and shuffles his Stack"))
                     (move target :hand) (shuffle! :deck))
     :choices (req (filter #(has? % :subtype "Icebreaker") (:deck runner)))}
-
-   "Spike"
-   {:abilities [{:msg "break up to 3 barrier subroutines" :effect (effect (trash card {:cause :ability-cost}))}]}

    "Spinal Modem"
    {:effect (effect (gain :memory 1)) :leave-play (effect (lose :memory 1)) :recurring 2
@@ -2913,7 +2914,7 @@
                  :prompt "Choose a card to trash for Faust" :choices (req (:hand runner))
                  :msg (msg "trash " (:title target) " and break 1 subroutine")
                  :effect (effect (trash target))}
-                {:label "Trasg 1 card from Grip to add 2 strength"
+                {:label "Trash 1 card from Grip to add 2 strength"
                  :prompt "Choose a card to trash for Faust" :choices (req (:hand runner))
                  :msg (msg "trash " (:title target) " and add 2 strength")
                  :effect (effect (trash target) (pump card 2))}]}
@@ -3011,6 +3012,12 @@
    "Sharpshooter"
    {:abilities [{:msg "break any number of destroyer subroutines" :effect (effect (trash card {:cause :ability-cost}))}
                 {:cost [:credit 1] :msg "add 2 strength" :effect (effect (pump card 2))}]}
+
+   "Shiv"
+   {:abilities [{:msg "break up to 3 sentry subroutines" :effect (effect (trash card))}]}
+
+   "Spike"
+   {:abilities [{:msg "break up to 3 barrier subroutines" :effect (effect (trash card {:cause :ability-cost}))}]}

    "Study Guide"
    {:abilities [{:cost [:credit 1] :msg "break 1 code gate subroutine"}


Alpha re-order for readability

Alpha re-order for readability

--- src/clojars/system.clj
+++ src/clojars/system.clj
@@ -60,25 +60,26 @@
   (let [config (meta-merge base-env config)]
     (-> (component/system-map
          :app               (handler-component (:app config))
-         :http              (jetty-server (:http config))
+         :clojars-app       (endpoint-component web/handler-optioned)
          :db                (hikaricp (:db config))
-         :stats-bucket      (s3-bucket (:s3 config) :stats-bucket)
-         :repo-bucket       (s3-bucket (:s3 config) :repo-bucket)
-         :stats             (artifact-stats)
-         :index-factory     #(clucy/disk-index (:index-path config))
-         :search            (lucene-component)
-         :mailer            (simple-mailer (:mail config))
-         :notifications     (notifications/notification-component)
-         :storage           (storage-component (:repo config) (:cdn-token config) (:cdn-url config))
          :github            (github/new-github-service (:github-oauth-client-id config)
                                                        (:github-oauth-client-secret config)
                                                        (:github-oauth-callback-uri config))
-         :clojars-app       (endpoint-component web/handler-optioned))
+         :http              (jetty-server (:http config))
+         :index-factory     #(clucy/disk-index (:index-path config))
+         :mailer            (simple-mailer (:mail config))
+         :notifications     (notifications/notification-component)
+         :repo-bucket       (s3-bucket (:s3 config) :repo-bucket)
+         :search            (lucene-component)
+         :stats             (artifact-stats)
+         :stats-bucket      (s3-bucket (:s3 config) :stats-bucket)
+         :storage           (storage-component (:repo config) (:cdn-token config) (:cdn-url config))
+         )
         (component/system-using
-         {:http              [:app]
-          :app               [:clojars-app]
+         {:app               [:clojars-app]
+          :clojars-app       [:storage :db :error-reporter :stats :search :mailer :github]
+          :http              [:app]
           :notifications     [:db :mailer]
+          :search            [:index-factory :stats]
           :stats             [:stats-bucket]
-          :search            [:index-factory :stats]
-          :storage           [:repo-bucket]
-          :clojars-app       [:storage :db :error-reporter :stats :search :mailer :github]}))))
+          :storage           [:repo-bucket]}))))


Simplified implementation of aggregatrion function

--- src/cloogling/core.clj
+++ src/cloogling/core.clj
@@ -80,7 +80,7 @@

   (concat one
           (for [item two
-                :when (not-any? (fn [x] (= (:url item) x )) (get-common-urls one two) )]
+                :when (not-any? (fn [x] (= (:url item) (:url x) )) one )]
             item )
           )
   )


(SERVER-797) Added comment to create-mock-pool about peer in jruby-utils

This commit adds a comment to the `create-mock-pool` function about how
it is based on the implementation of the `prime-pool!` function in the
jruby-utils library.

--- test/unit/puppetlabs/services/jruby/jruby_puppet_testutils.clj
+++ test/unit/puppetlabs/services/jruby/jruby_puppet_testutils.clj
@@ -272,6 +272,9 @@
    pool and is expected to return an object of type 'JRubyPuppet'."
   [jruby-config :- jruby-schemas/JRubyConfig
    mock-jruby-puppet-fn :- IFn]
+  ;; The implementation of this function is based on and very similar to
+  ;; `prime-pool!` in `puppetlabs.services.jruby-pool-manager.impl.jruby-agents`
+  ;; from the jruby-utils library.
   (let [pool-context (jruby-pool-manager-core/create-pool-context jruby-config)
         pool (jruby-internal/get-pool pool-context)
         count (.remainingCapacity pool)]


Default description for custom topics.

Default description for custom topics.

--- src/open_company/resources/section.clj
+++ src/open_company/resources/section.clj
@@ -22,7 +22,7 @@
 (def initial-custom-properties
   "Custom sections don't get initialized from a template, so need blank initial data."
   {
-    :description ""
+    :description "Custom topic"
     :headline ""
     :snippet custom-topic-placeholder-snippet
     :body ""


Update core.clj

Update core.clj

--- src/jarkeeper/core.clj
+++ src/jarkeeper/core.clj
@@ -19,7 +19,6 @@

 (defn- starting-num? [string]
   (number? (read-string (str (first (name string))))))
-

 (defn read-project-clj [repo-owner repo-name]
   (let [url (str "https://raw.github.com/" repo-owner "/" repo-name "/master/project.clj")]


Corrected docstring for `after?`

Corrected docstring for `after?`

--- src/java_time/core.clj
+++ src/java_time/core.clj
@@ -171,7 +171,7 @@
      false)))

 (defn after?
-  "Returns non-nil if time entities are ordered from the earliest to the latest
+  "Returns non-nil if time entities are ordered from the latest to the earliest
   (same semantics as `>`):

     (after? (local-date 2011) (local-date 2010) (local-date 2009))


Factor out form-for-testing-namespaces for other plugins to use.

--- src/leiningen/test.clj
+++ src/leiningen/test.clj
@@ -9,6 +9,22 @@
         [clojure.contrib.find-namespaces :only [find-namespaces-in-dir]]
         [leiningen.compile :only [eval-in-project]]))

+(defn form-for-testing-namespaces
+  "Return a form that when eval'd in the context of the project will test
+each namespace and print an overall summary."
+  [namespaces]
+  `(do (use ~''clojure.test)
+       (let [add-numbers# (fn [a# b#] (if (number? a#)
+                                        (+ a# b#) a#))
+             summary# (reduce (fn [summary# n#]
+                                (require n# :reload-all)
+                                (merge-with add-numbers#
+                                            summary# (run-tests n#)))
+                              {} '~namespaces)]
+         (with-test-out
+           (println "\n\n--------------------\nTotal:")
+           (report summary#)))))
+
 (defn test
   "Run the project's tests. Accept a list of namespaces for which to run all
 tests for. If none are given, runs them all."
@@ -16,21 +32,5 @@
   (let [namespaces (if (empty? namespaces)
                      (find-namespaces-in-dir (file (:test-path project)))
                      (map symbol namespaces))]
-    ;; It's long and a bit hairy because it has to be self-contained.
-    (eval-in-project
-     project
-     `(do (use ~''clojure.test)
-          (let [add-numbers# (fn [a# b#] (if (number? a#)
-                                           (+ a# b#) a#))
-                summary# (reduce (fn [summary# n#]
-                                   (require n#)
-                                   (merge-with add-numbers#
-                                               summary# (run-tests n#)))
-                                 {} '~namespaces)]
-            (with-test-out
-              (println "\n\n--------------------\nTotal:")
-              (report summary#)
-              (System/setProperty "leiningen.test" (str false)
-                                 ;; (successful? summary#)
-                                 )))))
+    (eval-in-project project (form-for-testing-namespaces namespaces))
     (println (System/getProperty "leiningen.test"))))


Prevent users of Clojure 1.0 from calling the test task and point them to the lein-test-is plugin. closes #21

--- src/leiningen/test.clj
+++ src/leiningen/test.clj
@@ -9,20 +9,29 @@
   "Return a form that when eval'd in the context of the project will test
 each namespace and print an overall summary."
   [namespaces]
-  `(do (use ~''clojure.test)
-       (let [add-numbers# (fn [a# b#] (if (number? a#)
+  `(do
+     (require ~''clojure.test)
+     (if (and (= 1 (:major *clojure-version*))
+              (= 0 (:minor *clojure-version*)))
+       (println "\"lein test\" is not compatible with Clojure 1.0.\n
+Please consider upgrading to a newer version of Clojure or using"
+                "the lein-test-is plugin.")
+       (let [resolver# (fn [fname#]
+                         (ns-resolve
+                          (find-ns 'clojure.test) fname#))
+             add-numbers# (fn [a# b#] (if (number? a#)
                                         (+ a# b#) a#))
              summary# (reduce (fn [summary# n#]
                                 (require n# :reload-all)
                                 (merge-with add-numbers#
                                             summary#
-                                            (clojure.test/run-tests n#)))
+                                            ((resolver# ~''run-tests) n#)))
                               {} '~namespaces)]
-         (clojure.test/with-test-out
+         ((resolver# ~''with-test-out)
            (println "\n\n--------------------\nTotal:")
-           (clojure.test/report summary#))
+           ((resolver# ~''report) summary#))
          (when-not (= "1.5" (System/getProperty "java.specification.version"))
-           (shutdown-agents)))))
+           (shutdown-agents))))))

 (defn test
   "Run the project's tests. Accept a list of namespaces for which to run all


Squash reflection in 'resolve-short-proj.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -523,7 +523,7 @@
                    (map #(s/replace (second (s/split % #"--")) #"%" "/")
                         (:lines (git {:gitdir g} "tag" "--list" "voom--*"))))))]
     (for [proj proj-set
-          :when (.contains proj dep) ]
+          :when (.contains ^String proj dep) ]
       proj)))

 (defn box-add


Store ctimes as longs (not strings)

Store ctimes as longs (not strings)

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1048,18 +1048,20 @@
 (pldb/db-rel r-commit ^:index sha ctime tree-sha)
 (pldb/db-rel r-commit-parent ^:index sha ^:index parent-sha)
 (pldb/db-rel r-tree ^:index sha ^:index name type ^:index obj-sha)
-(pldb/db-rel r-proj obj-sha ^:index proj-name vmajor vminor vinc vqual has-snaps?)
+(pldb/db-rel r-proj ^:index blob-sha ^:index proj-name vmajor vminor vinc vqual has-snaps?)

 (defn git-logic-tuples
   [gitdir]
   (let [commits (git-commits gitdir "origin/master")]
     (concat
+     ;; Graph of commits
      (mapcat seq
              (for [{:keys [sha ctime tree parents]} commits
                    :let [bsha (sha/mk sha)]]
-               (into [[r-commit bsha ctime (sha/mk tree)]]
+               (into [[r-commit bsha (Long/parseLong ctime) (sha/mk tree)]]
                      (for [p parents]
                        [r-commit-parent bsha (sha/mk p)]))))
+     ;; Trees (you know, files and directories)
      (for [tree-sha (all-git-trees gitdir)
            :let [tree-bsha (sha/mk tree-sha)]
            [fname {:keys [sha ftype]}] (git-tree gitdir tree-sha)]


(PDB-2847) i18n enable the threadpool log messages

This commit wraps the string literals from
puppetlabs.puppetdb.threadpool in the appropriate i18n system local
translation macros.

--- src/puppetlabs/puppetdb/threadpool.clj
+++ src/puppetlabs/puppetdb/threadpool.clj
@@ -5,14 +5,16 @@
             RejectedExecutionException ExecutorService]
            [org.apache.commons.lang3.concurrent BasicThreadFactory BasicThreadFactory$Builder])
   (:require [clojure.core.async :as async]
-            [clojure.tools.logging :as log]))
+            [clojure.tools.logging :as log]
+            [puppetlabs.i18n.core :as i18n]))

 (def logging-exception-handler
   "Exception handler that ensures any uncaught exception that occurs
   on this thread is logged"
   (reify Thread$UncaughtExceptionHandler
     (uncaughtException [_ thread throwable]
-      (log/error throwable "Error processing command"))))
+      (log/error throwable
+                 (i18n/trs "Error processing command")))))

 (defn thread-factory
   "Creates a command thread factory, wrapping the
@@ -30,8 +32,9 @@

 (defn shutdown
   "Shuts down the gated threadpool, ensuring in-flight work is
-  complete before tearing it down. Currently waits up to 5 minutes for
-  that work to complete"
+  complete before tearing it down. Waits up to `shutdown-timeout` (in
+  milliseconds) for that work to complete before forcibly shutting
+  down the threadpool that work to complete"
   [{:keys [^Semaphore semaphore ^ExecutorService threadpool shutdown-timeout]}]

   ;; Prevent new work from being accepted
@@ -43,12 +46,14 @@
   ;; This will block, waiting for the threadpool to shutdown
   (when-not (.awaitTermination threadpool shutdown-timeout java.util.concurrent.TimeUnit/MILLISECONDS)

-    (log/warn "Attempted to shutdown threadpool, not stopped after 5 minutes, forcibly shutting it down")
+    (log/warn
+     (i18n/trs "Threadpool not stopped after {0} milliseconds, forcibly shutting it down" shutdown-timeout))

     ;; This will force the shutdown of the threadpool and will
     ;; not allow current threads to finish
     (.shutdownNow threadpool)
-    (log/warn "Threadpool forcibly shutdown")))
+    (log/warn
+     (i18n/trs "Threadpool forcibly shutdown"))))

 (defrecord GatedThreadpool [^Semaphore semaphore ^ExecutorService threadpool shutdown-timeout]
   java.io.Closeable
@@ -90,7 +95,7 @@
                              (finally
                                (.release semaphore)))))
     (catch RejectedExecutionException e
-      (log/error e "Message not submitted to command processing threadpool")
+      (log/error e (i18n/trs "Message not submitted to command processing threadpool"))
       (.release semaphore))))

 (defn exec-from-channel


Web changes

Web changes

--- src/demogorgon/web.clj
+++ src/demogorgon/web.clj
@@ -23,7 +23,7 @@
     [:head
      [:title "un.nethack.nu"]
      [:style {:type "text/css"}
-      "body { font-family: verdana; font-size: 9px; }"
+      "body { font-family: verdana; font-size: 10px; }"
       "table { width: 100%; font-size: 11px; }"
       "th{ color: black; text-shadow:1px 1px 1px #bbb; }"
       "tr:nth-child(odd) { color: black; background-color:#eee; }"
@@ -32,7 +32,8 @@
     [:body
      [:h1 "un.nethack.nu"]
      [:div#menu
-      [:a {:href "/"} "last 25 games"] " | "
+      [:a {:href "/"} "startpage"] " | "
+      [:a {:href "/last-games"} "last 25 games"] " | "
       [:a {:href "/highscores"} "highscores"] " | "
       [:a {:href "/users"} "users"] " | "
       [:a {:href "/causes"} "causes"]]
@@ -41,6 +42,18 @@

 (defn page-not-found []
   "
Page not found
")
+
+;; (defn make-dump-link [row]
+;;   (let [base (str "/user/" (:name row) "/dumps/" (:name row ) "." (:endtime row))
+;;         file-base (str "/srv/un.nethack.nu" base)
+;;         extension (if (.exists (File. (str file-base ".txt.html")))
+;;                     ".txt.html"
+;;                     (if (.exists (File. (str file-base ".txt")))
+;;                       ".txt"
+;;                       nil))]
+;;     (if extension
+;;       [:a {:href (str base extension)} "dump #" (:id row)]
+;;       [:div "No dump file for game " (:id row)])))

 (defn make-dump-link [row]
   (let [base (str "/user/" (:name row) "/dumps/" (:name row ) "." (:endtime row))
@@ -51,17 +64,27 @@
                       ".txt"
                       nil))]
     (if extension
-      [:a {:href (str base extension)} "dump #" (:id row)]
-      [:div "No dump file for game " (:id row)])))
+      [:a {:href (str base extension)} (:id row)]
+      (:id row))))
+
+;;[:td [:a {:href (str "/game/" (:id row))} (:id row)]]
+
+(defn pretty-date [date]
+  (let [date (str date)]
+    (if (= (count date) 8)
+      (str (.substring date 0 4) "-"
+           (.substring date 4 6) "-"
+           (.substring date 6 8))
+      date)))

 (defn rs-row-to-tr [row]
   [:tr
-   [:td [:a {:href (str "/game/" (:id row))} (:id row)]]
+   [:td (make-dump-link row)]
    [:td [:a {:href (str "/user/" (:name row))} (:name row)]]
    [:td (:points row)]
    [:td (:turns row)]
-   [:td (:deathdate row)]
+   [:td (:deathdate (pretty-date row))]
    [:td [:a {:href (str "/cause/" (url-encode (:death_uniq row)))} (:death row)]]])

 (defn rs-to-table [rs]
@@ -103,16 +126,37 @@
       (layout
        (rs-to-table rs)))))

-(defn last-games
-  ([] (last-games 10))
-  ([limit]
-     (sql/with-connection db
-       (sql/with-query-results
-         rs
-         ["select * from xlogfile order by endtime desc limit ?" limit]
-         (layout
-          (rs-to-table rs))))))
-
+(defn last-games []
+  (sql/with-connection db
+    (sql/with-query-results
+      rs
+      ["select * from xlogfile order by endtime desc limit ?" 25]
+      (layout
+        (rs-to-table rs)))))
+
+(defn frontpage []
+  (sql/with-connection db
+    (sql/with-query-results
+      rs
+      ["select * from xlogfile order by endtime desc limit ?" 5]
+      (layout
+       [:div
+        [:h2 "about"]
+        [:p
+         "un.nethack.nu is a public server for " [:a {:href "http://sourceforge.net/apps/trac/unnethack/"} "UnNetHack"]
+         ". It is accessible by " [:a {:href "telnet://un.nethack.nu"} "telnet"] "."]
+        [:h2 "links"]
+        [:ul
+         [:li [:a {:href "/default-unnethackrc"} "default rc-file"]]
+         [:li [:a {:href "/logs"} "logfiles"]]]
+        [:h2 "last 5 deaths"]
+        (rs-to-table rs)]))))
+
+;; [:div
+;;         "links"
+;;         [:ul
+;;          [:li [:a {:href "/default-unnethackrc"} "default rcfile"]]
+;;          [:li [:a {:href "/logs"} "logfiles"]]]
 (defn user [name]
   (sql/with-connection db
     (sql/with-query-results
@@ -132,7 +176,7 @@
             [:br]
             (sql/with-query-results
               rs2
-              ["select * from xlogfile where name = ? order by endtime desc limit 50" name]
+              ["select * from xlogfile where name = ? order by endtime desc limit 100" name]
               (doall rs2)
               (rs-to-table rs2))]))))))

@@ -161,7 +205,8 @@
              rs)))))

 (defroutes main-routes
-  (GET "/" [] (last-games 25))
+  (GET "/last-games" [] (last-games))
+  (GET "/" [] (frontpage))
   (GET "/highscores" [] (highscores 25))
   (GET "/game/:id" [id] (game id))
   (GET "/user/:name" [name] (user name))


Minor

Minor

--- src/discuss/views.cljs
+++ src/discuss/views.cljs
@@ -30,7 +30,7 @@
                    " "
                    (vlib/fa-icon (str (lib/prefix-name "control-buttons") " fa-angle-left fa-border") history/back!)
                    " "
-                   (vlib/fa-icon (str (lib/prefix-name "control-buttons") " fa fa-angle-right fa-border pointer")))))
+                   (vlib/fa-icon (str (lib/prefix-name "control-buttons") " fa-angle-right fa-border pointer")))))

 (defn avatar-view
   "Get the user's avatar and add login + logout functions to it."


Parse charanams of lyrics into a vector.

--- src/kosha/db/kriti.clj
+++ src/kosha/db/kriti.clj
@@ -13,21 +13,41 @@

 (defn rename-stanza-keys
   "Renames keys of stanzas to replace spaces in them, if the lyrics has named stanzas."
-  [{:keys [content has-named-stanzas] :as lyrics}]
+  [content]
   (let [lyrics-map   (hs/from-hstore content)
         stanza-keys  (keys lyrics-map)
         new-names    (into {} (map (juxt identity to-kebab-case) stanza-keys))]
-    (if has-named-stanzas
-      (assoc lyrics :content (set/rename-keys (hs/from-hstore content) new-names))
-      lyrics)))
+    (set/rename-keys (hs/from-hstore content) new-names)))
+
+(defn remove-keys
+  "Removes all keys in the given collection from the given map."
+  [map keys-coll]
+  (apply dissoc map keys-coll))
+
+(defn parse-charanams
+  "Parses charanams into a vector under :charanams key if the lyrics has named stanzas"
+  [content]
+  (let [max-charanams          (count (keys content))
+        charanam-key-names     (map #(str "caraNam-" %) (range 1 max-charanams))
+        possible-charanam-keys (concat [:caraNam] (map keyword charanam-key-names))
+        charanams              (into [] (vals (select-keys content possible-charanam-keys)))]
+    (-> content
+        (assoc :charanams charanams)
+        (remove-keys possible-charanam-keys))))

 (defn parse-lyrics
   "Parses lyrics of a kriti into a clojure map if it has named stanzas."
   [lyrics]
-  (-> lyrics
-      (hs/from-hstore)
-      (update :has-named-stanzas (partial = "true"))
-      (rename-stanza-keys)))
+  (as-> lyrics lyr
+    (when lyr
+      (-> lyr
+          (hs/from-hstore)
+          (update :has-named-stanzas (partial = "true"))))
+    (if (:has-named-stanzas lyr)
+      (-> lyr
+          (update :content rename-stanza-keys)
+          (update :content parse-charanams))
+      lyr)))

 (defn kriti
   "Retrieve details of a kriti given it's kriti_id."


Make repl task listen on a repl socket.

Make repl task listen on a repl socket.

--- src/leiningen/repl.clj
+++ src/leiningen/repl.clj
@@ -5,7 +5,7 @@
   (:import [java.net Socket]
            [java.io OutputStreamWriter InputStreamReader File]))

-(defn repl-server [project port]
+(defn repl-server [project host port]
   (let [init-form [:init `#(let [is# ~(:repl-init-script project)
                                  mn# '~(:main project)]
                              (when (and is# (.exists (File. str)))
@@ -18,16 +18,30 @@
                     [java.io ~'InputStreamReader ~'OutputStream
                      ~'OutputStreamWriter ~'PrintWriter]
                     [clojure.lang ~'LineNumberingPushbackReader]))
-         (let [server# (ServerSocket. ~port)
-               socket# (.accept server#)
-               ins# (.getInputStream socket#)
-               outs# (.getOutputStream socket#)]
-           (binding [*in* (-> ins# InputStreamReader.
-                              LineNumberingPushbackReader.)
-                     *out* (OutputStreamWriter. outs#)
-                     *err* (PrintWriter. outs# true)]
-             (clojure.main/repl ~@init-form))
-           (.close server#)))))
+         (let [server# (ServerSocket. ~port 0 (~'InetAddress/getByName ~host))
+               acc# (fn [s#]
+                      (let [ins# (.getInputStream s#)
+                            outs# (.getOutputStream s#)]
+                        (doto (Thread.
+                               #(binding [*in* (-> ins# InputStreamReader.
+                                                   LineNumberingPushbackReader.)
+                                          *out* (OutputStreamWriter. outs#)
+                                          *err* (PrintWriter. outs# true)]
+                                  (try
+                                    (clojure.main/repl ~@init-form)
+                                    (catch ~'SocketException _#
+                                      (doto s#
+                                        .shutdownInput
+                                        .shutdownOutput
+                                        .close)))))
+                          .start)))]
+           (doto (Thread. #(when-not (.isClosed server#)
+                             (try
+                               (acc# (.accept server#))
+                               (catch ~'SocketException _#))
+                             (recur)))
+             .start)
+           (format "REPL started; server listening on %s:%s." ~host ~port)))))

 (defn copy-out [reader]
   (Thread/sleep 100)
@@ -58,8 +72,10 @@
 (defn repl
   "Start a repl session for the current project."
   [project]
-  (let [port (dec (+ 1024 (rand-int 64512)))
-        server-form (repl-server project port)
+  (let [host (or (System/getenv "LEIN_REPL_HOST") "localhost")
+        port (Integer. (or (System/getenv "LEIN_REPL_PORT")
+                           (dec (+ 1024 (rand-int 64512)))))
+        server-form (repl-server project host port)
         server-thread (Thread. #(try (eval-in-project project server-form)
                                      (catch Exception _)))]
     (.start server-thread)


Replace duplicate code with 'contains-sha? call.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -384,7 +384,7 @@
         branch (map #(re-find #"[^/]*/+[^/]*$" (str %))
                     (glob (str gitdir "/refs/remotes/*/*")))
         :let [neg-tags (map #(str "^" % "^") tags)
-              neg-tags (filter #(= 0 (:exit (git {:gitdir gitdir :ok-statuses #{0 1}} "rev-parse" "--verify" "--quiet" (str %)))) neg-tags)
+              neg-tags (filter (partial contains-sha? gitdir) neg-tags)
               commits
               , (map
                  parse-sha-refs


Add new repo tag schema to include snapshot dependency flagging.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -408,7 +408,7 @@
        (keep second)
        (filter :ops)))

-(def repo-tag-version "0")
+(def repo-tag-version "1")

 (defn get-repo-tag-version
   [gitdir]
@@ -447,15 +447,17 @@
       (when-let [p (if (= "D" op)
                      {:root (str (.getParent (io/file path)))}
                      (robust-read-project gitdir sha path))]
-        (let [tag (s/join "--" (-> ["voom"
+        (let [snaps (some #(.contains ^String % "-SNAPSHOT")
+                         (map second (:dependencies p)))
+              tag (s/join "--" (-> ["voom"
                                     (str (:group p)
                                          (when (:group p) "%")
                                          (:name p))
                                     (:version p)
                                     (s/replace (:root p) #"/" "%")
-                                    (subs sha 0 7)]
-                                   (cond-> (empty? parents)
-                                     (conj "no-parent"))))]
+                                    (subs sha 0 7)
+                                    (and snaps "snaps")
+                                    (and (empty? parents) "no-parent")]))]
           (git {:gitdir gitdir} "tag" "-f" tag sha))))

     ;; TODO: clean up abandoned voom-- and voom-branch-- tags
@@ -478,7 +480,7 @@
 (defn parse-tag
   [tag]
   (->
-   (zipmap [:prefix :proj :version :path :sha :no-parent] (s/split tag #"--"))
+   (zipmap [:prefix :proj :version :path :sha :snaps :no-parent] (s/split tag #"--"))
    (update-in [:path] (fnil #(s/replace % #"%" "/") :NOT_FOUND))
    (update-in [:proj] (fnil #(s/replace % #"%" "/") :NOT_FOUND))))


Fix nil project names (from new version of lein?)

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -465,7 +465,7 @@
 (defn patch-fn
   [f default-val]
   (fn [filename & args]
-    (if (re-find #"\.lein|project[^/]*\.clj$" filename)
+    (if (re-find #"\.lein|project[^/]*\.clj$" (str filename))
       (apply f filename args)
       default-val)))