Removed weird fn wrapper around :body in complex popover demo

--- src/re_demo/popover_dialog_demo.cljs
+++ src/re_demo/popover_dialog_demo.cljs
@@ -21,48 +21,47 @@
        :width            "400px"
        :backdrop-opacity 0.3
        :title            "This is the title"
-       :body             [(fn []  ;; NOTE: THIS IS NASTY BUT REQUIRED (OTHERWISE DIALOG WILL NOT BE UPDATED WHEN ATOMS CHANGES)
-                            [v-box
-                             :children [[label
-                                         :label "The body of a popover can act like a dialog box containing standard input controls."]
-                                        [gap :size "15px"]
-                                        [h-box
-                                         :children [[v-box
-                                                     :size "auto"
-                                                     :children [[radio-button
-                                                                 :label     "Don't show extra popover"
-                                                                 :value     "1"
-                                                                 :model     (:tooltip-state @dialog-data)
-                                                                 :on-change (fn []
-                                                                              (swap! dialog-data assoc :tooltip-state "1")
-                                                                              (reset! show-tooltip? false))]
-                                                                [radio-button
-                                                                 :label     "Show extra popover"
-                                                                 :value     "2"
-                                                                 :model     (:tooltip-state @dialog-data)
-                                                                 :on-change (fn []
-                                                                              (swap! dialog-data assoc :tooltip-state "2")
-                                                                              (reset! show-tooltip? true))]]]]]
-                                        [gap :size "20px"]
-                                        [line]
-                                        [gap :size "10px"]
-                                        [h-box
-                                         :gap      "10px"
-                                         :children [[button
-                                                     :label    [:span [:i {:class "zmdi zmdi-check" }] " Apply"]
-                                                     :on-click #(submit-dialog @dialog-data)
-                                                     :class    "btn-primary"]
-                                                    [popover-anchor-wrapper
-                                                     :showing? show-tooltip?
-                                                     :position :right-below
-                                                     :anchor   [button
-                                                                :label    [:span [:i {:class "zmdi zmdi-close" }] " Cancel"]
-                                                                :on-click cancel-dialog]
-                                                     :popover  [popover-content-wrapper ;; NOTE: didn't specify on-cancel here (handled properly)
-                                                                :width         "250px"
-                                                                :title         "This is the cancel button"
-                                                                :close-button? false
-                                                                :body          "You can even have a popover over a popover!"]]]]]])]])))
+       :body             [v-box
+                          :children [[label
+                                      :label "The body of a popover can act like a dialog box containing standard input controls."]
+                                     [gap :size "15px"]
+                                     [h-box
+                                      :children [[v-box
+                                                  :size "auto"
+                                                  :children [[radio-button
+                                                              :label     "Don't show extra popover"
+                                                              :value     "1"
+                                                              :model     (:tooltip-state @dialog-data)
+                                                              :on-change (fn []
+                                                                           (swap! dialog-data assoc :tooltip-state "1")
+                                                                           (reset! show-tooltip? false))]
+                                                             [radio-button
+                                                              :label     "Show extra popover"
+                                                              :value     "2"
+                                                              :model     (:tooltip-state @dialog-data)
+                                                              :on-change (fn []
+                                                                           (swap! dialog-data assoc :tooltip-state "2")
+                                                                           (reset! show-tooltip? true))]]]]]
+                                     [gap :size "20px"]
+                                     [line]
+                                     [gap :size "10px"]
+                                     [h-box
+                                      :gap      "10px"
+                                      :children [[button
+                                                  :label    [:span [:i {:class "zmdi zmdi-check" }] " Apply"]
+                                                  :on-click #(submit-dialog @dialog-data)
+                                                  :class    "btn-primary"]
+                                                 [popover-anchor-wrapper
+                                                  :showing? show-tooltip?
+                                                  :position :right-below
+                                                  :anchor   [button
+                                                             :label    [:span [:i {:class "zmdi zmdi-close" }] " Cancel"]
+                                                             :on-click cancel-dialog]
+                                                  :popover  [popover-content-wrapper ;; NOTE: didn't specify on-cancel here (handled properly)
+                                                             :width         "250px"
+                                                             :title         "This is the cancel button"
+                                                             :close-button? false
+                                                             :body          "You can even have a popover over a popover!"]]]]]]])))

 (defn popover-dialog-demo


Properly prune log.

Properly prune log.

--- src/replikativ/crdt/materialize.cljc
+++ src/replikativ/crdt/materialize.cljc
@@ -73,8 +73,8 @@
                                        :method :handshake
                                        :op (-handshake new-val)}
                                 :next nil}))
-               ;; prune crdt log with state
-               (<? (k/assoc-in cold-store [log-id] [:append-log new-id new-id]))
+               ;; prune crdt log with state, atomic on first run
+               (<? (k/assoc-in cold-store [[user crdt-id :log]] [:append-log new-id new-id]))
                {:crdt crdt
                 :state new-val})))))))


Make validator arglists available to codox

--- src/structural_typing/validators.clj
+++ src/structural_typing/validators.clj
@@ -3,11 +3,21 @@
    (2) the messages include the failing value."
   (:require [bouncer.validators :as v]))

-(defmacro defoptional [name doc message-format & body]
+(defmacro defoptional
+  "Define a validator for an optional argument.
+
+       (defoptional number
+         \"Validates against optional `number?`\" ; doc string
+         \"%s is `%s`, which is not a number\"
+         [maybe-a-number]
+         (number? maybe-a-number))
+"
+  [name doc message-format arglist & body]
   `(do
      (v/defvalidator ~name {:optional true
-                            :default-message-format ~message-format} ~@body)
-     (alter-meta! (var ~name) assoc :doc ~doc)))
+                            :default-message-format ~message-format} ~arglist ~@body)
+     (alter-meta! (var ~name) assoc :doc ~doc
+                                    :arglists (list '~arglist))))

 (v/defvalidator ^{:doc "Fails if key is missing or its value is `nil`."} required
   {:default-message-format "%s must be present and non-nil"}


Bugfix: React key warning in footer

Bugfix: React key warning in footer

--- src/alder/ui/components/footer.cljs
+++ src/alder/ui/components/footer.cljs
@@ -23,12 +23,13 @@
         (html
          [:div.footer
           (when (midiapi/has-midi-access)
-            [:div.footer__midi-master
-             [:span.footer__midi-master-label "MIDI Master Device"]
-             (om/build midi-device-input-component
-                       [(midiapi/get-current-midi-master-device)
-                        midiapi/set-current-midi-master-device!]
-                       {:opts {:class "footer__midi-master-dropdown"}})])
+            (html
+             [:div.footer__midi-master
+              [:span.footer__midi-master-label "MIDI Master Device"]
+              (om/build midi-device-input-component
+                        [(midiapi/get-current-midi-master-device)
+                         midiapi/set-current-midi-master-device!]
+                        {:opts {:class "footer__midi-master-dropdown"}})]))
           [:a.footer__aux-button
            {:on-click toggle-screen-keyboard
             :href "#"}


Make default can-can interestingly staggered.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -1266,7 +1266,7 @@
                              (fn [var-map] (cues/apply-merging-var-map var-map can-can))
                              :variables [{:key "bars" :name "Bars" :min 1 :max 8 :type :integer :start 1}
                                          {:key "cycles" :name "Cycles" :min 1 :max 8 :type :integer :start 1}
-                                         {:key "stagger" :name "Stagger" :min 0 :max 4 :start 0}
+                                         {:key "stagger" :name "Stagger" :min 0 :max 4 :start 0.5}
                                          {:key "spread" :name "Spread" :min -45 :max 45
                                           :centered true :resolution 0.25 :start 0}
                                          {:key "pan-min" :name "Pan min" :min -180 :max 180


Add OSC aiming demo.

Add OSC aiming demo.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -19,6 +19,7 @@
             [afterglow.show :as show]
             [afterglow.show-context :refer :all]
             [com.evocomputing.colors :refer [color-name create-color hue adjust-hue]]
+            [overtone.osc :as osc]
             [taoensso.timbre :as timbre]))

 (defn use-sample-show
@@ -171,16 +172,60 @@

 (defn add-xyz-controls
   []
-  #_(show/add-midi-control-to-var-mapping "Slider" 0 4 :x)
-  #_(show/add-midi-control-to-var-mapping "Slider" 0 5 :y)
-  #_(show/add-midi-control-to-var-mapping "Slider" 0 6 :z)
+  (show/add-midi-control-to-var-mapping "Slider" 0 4 :x)
+  (show/add-midi-control-to-var-mapping "Slider" 0 5 :y)
+  (show/add-midi-control-to-var-mapping "Slider" 0 6 :z)
   (show/add-effect! :position
                     (move/direction-effect
                      "Pointer" (params/build-direction-param :x :x :y :y :z :z) (show/all-fixtures)))
   #_(show/add-effect! :position
                     (move/aim-effect
                      "Aimer" (params/build-aim-param :x :x :y :y :z :z) (show/all-fixtures)))
-  #_(show/set-variable! :y  2.6416))  ; Approximate height of ceiling
+  (show/set-variable! :y 2.6416))  ; Approximate height of ceiling
+
+(defonce osc-server
+  (atom nil))
+
+(defn osc-demo
+  "Early experiments with using OSC to control shows. This should grow
+  into a well-defined API, with integration to show variables, cue
+  grids, and the like."
+  []
+  (swap! osc-server (fn [server] (or server (osc/osc-server 16010 "Afterglow"))))
+  (osc/osc-handle @osc-server "/aim" (fn [msg]
+                                       (let [left -2.5
+                                             right 1.65
+                                             width (- right left)
+                                             front -0.7
+                                             rear 3.1
+                                             depth (- rear front)]
+                                         (show/set-variable! :x (+ left (* width (first (:args msg)))))
+                                         (show/set-variable! :z (+ front (* depth (second (:args msg))))))
+                                       #_(timbre/info msg)))
+  (osc/osc-handle @osc-server "/sparkle" (fn [msg]
+                                       (if (pos? (first (:args msg)))
+                                         (show/add-effect! :sparkle (fun/sparkle (show/all-fixtures) :chance 0.1
+                                                                                :fade-time 100))
+                                         (show/end-effect! :sparkle))))
+  #_(osc/osc-listen @osc-server (fn [msg] (timbre/info msg)) :debug)
+  #_(osc/zero-conf-on)
+  (show/set-variable! :x 0)
+  (show/set-variable! :y 2.6416) ; Approximate height of ceiling
+  (show/set-variable! :z 0)
+  (show/add-effect! :position
+                    (move/aim-effect
+                     "Aimer" (params/build-aim-param :x :x :y :y :z :z) (show/all-fixtures))))
+
+(defn osc-shutdown
+  "Shut down osc server and clean up."
+  []
+  #_(osc/zero-conf-off)
+  (swap! osc-server (fn [server]
+                      (when server
+                        (osc/osc-rm-all-listeners server)
+                        (osc/osc-rm-all-handlers server)
+                        (osc/osc-close server)
+                        nil))))

 (defn global-color-cue
   "Create a cue-grid entry which establishes a global color effect."
@@ -277,7 +322,7 @@
                                      {:key "fade-time" :name "Fade" :min 1 :max 2000 :start 50 :type :integer}]))

     (ct/set-cue! (:cue-grid *show*) 0 6
-                 (cues/function-cue :strobe-all :strobe (show/all-fixtures)))
+                 (cues/function-cue :strobe-all :strobe (show/all-fixtures) :effect-name "Strobe"))

     (ct/set-cue! (:cue-grid *show*) 0 3


Fix typo in function name.

Fix typo in function name.

--- src/afterglow/fixtures.clj
+++ src/afterglow/fixtures.clj
@@ -62,7 +62,7 @@
          (when (:visualizer-visible % true) [%]))
       fixtures-or-heads))

-(defn generic-dimmmer
+(defn generic-dimmer
   "A fixture definition where a single channel controls the power
   level of a socket to which an incandescent light source can be
   connected. If you are using a product such as the [Chauvet


Fix schema declaration

Fix schema declaration

--- src/app/datasource/db.cljs
+++ src/app/datasource/db.cljs
@@ -1,8 +1,8 @@
 (ns app.datasource.db
   (:require [schema.core :as s :include-macros true]))

-(def schema [:title s/Str
-             :items [s/Str]])
+(def schema [{:title s/Str
+              :items [s/Str]}])

 (def default-value
   [{:title "Colors"


[fix][tests] Seems that can-pay work ok for solid events.

--- spec/tests/eventacts/solid.clj
+++ spec/tests/eventacts/solid.clj
@@ -12,15 +12,15 @@
 (spec/describe "Pay button on solid event(without parts)"
                (spec/before-all
                  (println "############################## RESET DB #######################################")
-                 (sh "bash" "-c" "./resetdb.sh test")
-                 )
-               (spec/it "is hidden, when user NOT participate event"
+                 (sh "bash" "-c" "./resetdb.sh test"))
+
+               (spec/it "is HIDDEN, when user NOT participate event"
                         (spec/should-not (dbp/can-pay? uid eid-solid)))

-               (dbp/add-participant uid eid-solid)
-               (core/start-event eid-solid)
-
-               (spec/it "is visible, when user participated and fees sum not cover party-pay"
+               (spec/it "is VISIBLE, when user participated and fees sum NOT cover party-pay"
+                        (nil? (println "Participate and start event " (db/get-event eid-solid)))
+                        (dbp/add-participant uid eid-solid)
+                        (core/start-event eid-solid)
                         (spec/should (dbp/can-pay? uid eid-solid)) )
                (dbp/create-fee uid eid-solid))


Remove login name from user area

Remove login name from user area

--- src/clj/clojuredocs/site/common.clj
+++ src/clj/clojuredocs/site/common.clj
@@ -10,7 +10,6 @@
 (defn $user-area [user]
   [:li.user-area
    [:img.avatar {:src (:avatar-url user)}]
-   [:span.login  (:login user)]
    " | "
    [:a {:href "/logout"}
     "Log Out"]])


removed old functions from code

removed old functions from code

--- src/clj/forma/classify/logistic.clj
+++ src/clj/forma/classify/logistic.clj
@@ -30,17 +30,31 @@
   (DoubleMatrix.
    (into-array (map double-array mat))))

-;; (defn logistic-prob
-;;   "returns the probability of a binary outcome given a parameter
-;;   vector `beta-seq` and a feature vector for a given observation"
-;;   [beta-seq feature-seq]
-;;   (logistic-fn (dot-product beta-seq feature-seq)))
+(defn to-double-rowmat
+  [coll]
+  (to-double-matrix [(vec coll)]))
+
+(defn copy-row
+  [^DoubleMatrix row]
+  (.copy (to-double-matrix [[]]) row))
+
+(def bm (to-double-rowmat (repeat 5 1)))
+(def ym (to-double-rowmat (interleave (repeat 10 0) (repeat 10 1))))
+(defn reshape [v c]
+  (if (= (count v) 1)
+    c
+    (recur (butlast v)
+           (partition (last v) c))))
+(def feat (reshape '(10 5) (range 100)))
+(def Xm (to-double-matrix  feat))

 (defn logistic-prob
   [^DoubleMatrix beta ^DoubleMatrix features]
   (logistic-fn
    (.dot beta features)))

+;; TODO: convert the functions that are useful but not actually used
+;; in estimation, like `log-likelihood` and `total-log-likelihood`.

 (defn log-likelihood
   "returns the log likelihood of a given pixel, conditional on its
@@ -58,16 +72,6 @@
   (reduce + (map (partial log-likelihood beta-seq)
                  label-seq
                  feature-mat)))
-
-;; (defn probability-calc
-;;   "returns a vector of probabilities for each observation"
-;;   [beta-seq feature-mat]
-;;   (map (partial logistic-prob beta-seq)
-;;        feature-mat))
-
-(defn copy-row
-  [^DoubleMatrix row]
-  (.copy (to-double-matrix [[]]) row))

 (defn in-place-apply-fn
   [f ^DoubleMatrix row-mat]
@@ -94,29 +98,6 @@
     (.mmul (.transpose feature-mat)
            (.transpose (.sub labels prob-seq)))))

-;; (defn score-seq
-;;   "returns the scores for each parameter"
-;;   [beta-seq label-seq feature-mat]
-;;   (let [prob-seq (probability-calc beta-seq feature-mat)
-;;         features (to-double-matrix feature-mat)]
-;;     (.mmul (.transpose features)
-;;            (DoubleMatrix.
-;;             (double-array
-;;              (map - label-seq prob-seq))))))
-
-(defn to-double-rowmat
-  [coll]
-  (to-double-matrix [(vec coll)]))
-
-(def bm (to-double-rowmat (repeat 5 1)))
-(def ym (to-double-rowmat (interleave (repeat 10 0) (repeat 10 1))))
-(defn reshape [v c]
-  (if (= (count v) 1)
-    c
-    (recur (butlast v)
-           (partition (last v) c))))
-(def feat (reshape '(10 5) (range 100)))
-(def Xm (to-double-matrix  feat))
 ;; (score-seq b lab feat)
 ;; #<DoubleMatrix [-450.0; -459.9999546021313; -469.9999092042626; -479.9998638063939; -489.9998184085252]>

@@ -129,39 +110,8 @@
     (.mmul (.muliRowVector (.transpose feature-mat) transformed-row)
            feature-mat)))

-;; (defn info-matrix
-;;   "returns the square information matrix for the logistic probability
-;;   function; the dimension is given by the number of features"
-;;   [beta-seq feature-mat]
-;;   (let [mult-func (fn [x] (* x (- 1 x)))
-;;         prob-seq  (->> (probability-calc beta-seq feature-mat)
-;;                        (map mult-func))
-;;         scale-feat (multiply-rows
-;;                     prob-seq
-;;                     (transpose feature-mat))]
-;;     (.mmul (to-double-matrix scale-feat)
-;;            (to-double-matrix feature-mat))))
-
-
 ;; (info-matrix b feat)
 ;; #<DoubleMatrix [1.665334536937734E-14, 1.9984014443252805E-14, 2.3314683517128275E-14, 2.664535259100374E-14, 2.997602166487921E-14; 1.9984014443252805E-14, 4.539580775988847E-5, 9.079161549979293E-5, 1.3618742323969737E-4, 1.8158323097960185E-4; 2.331468351712827E-14, 9.079161549979293E-5, 1.8158323097627118E-4, 2.723748464527494E-4, 3.6316646192922767E-4; 2.664535259100374E-14, 1.3618742323969737E-4, 2.723748464527494E-4, 4.085622696658014E-4, 5.447496928788534E-4; 2.9976021664879214E-14, 1.8158323097960185E-4, 3.6316646192922767E-4, 5.447496928788534E-4, 7.263329238284793E-4]>
-
-;; (defn beta-update
-;;   "returns a vector of updates for the parameter vector; the
-;;   ridge-constant is a very small scalar, used to ensure that the
-;;   inverted information matrix is non-singular."
-;;   [beta-seq label-seq feature-mat rdg-cons]
-;;   (let [num-features (count beta-seq)
-;;         info-adj (.addi
-;;                   (info-matrix beta-seq feature-mat)
-;;                   (.muli (DoubleMatrix/eye (int num-features))
-;;                          (float rdg-cons)))]
-;;     (vec (.toArray
-;;           (.mmul (Solve/solve
-;;                   info-adj
-;;                   (DoubleMatrix/eye (int num-features)))
-;;                  (score-seq beta-seq label-seq feature-mat))))))
-

 (defn beta-update
   "returns a vector of updates for the parameter vector; the
@@ -200,6 +150,8 @@
            (dec iter)
            diff))))))

+
+
 (defn estimated-probabilities
   "returns the set of probabilities, after applying the parameter
   values estimated over the training data; both `label-seq` and


Final return type hints added. This works for 1.5m pixels

--- src/clj/forma/classify/logistic.clj
+++ src/clj/forma/classify/logistic.clj
@@ -27,24 +27,25 @@
         one (DoubleMatrix/ones 1)]
     (.divi exp-x (.add exp-x one))))

-(defn to-double-matrix
+(defn ^DoubleMatrix
+  to-double-matrix
   "returns a DoubleMatrix instance for use with jBLAS functions"
   [mat]
   (DoubleMatrix.
    (into-array (map double-array mat))))

-(defn to-double-rowmat
+(defn ^DoubleMatrix
+  to-double-rowmat
   [coll]
   (to-double-matrix [(vec coll)]))

-(defn
-  ^DoubleMatrix
+(defn ^DoubleMatrix
   copy-row
   [row]
   (.copy (to-double-matrix [[]]) row))

-(defn logistic-prob
-  ^DoubleMatrix
+(defn ^DoubleMatrix
+  logistic-prob
   [beta features]
   (logistic-fn
    (.dot beta features)))


still trying to get beta-dict working right

--- src/clj/forma/hadoop/jobs/forma.clj
+++ src/clj/forma/hadoop/jobs/forma.clj
@@ -158,13 +158,13 @@
   "query to end all queries: estimate the probabilities for each
   period after the training period."
   [eco-beta-src dynamic-src static-src]
-  (let [beta-dict (log/beta-dict eco-beta-src)]
+  (let [betas (log/beta-dict eco-beta-src)]
     (<- [?s-res ?mod-h ?mod-v ?s ?l ?prob-series]
         (dynamic-src ?s-res ?pd ?mod-h ?mod-v ?s ?l ?val ?neighbor-val)
         (static-src ?s-res ?mod-h ?mod-v ?s ?l _ _ ?eco _)
-        (apply-betas [beta-dict] ?eco ?val ?neighbor-val :> ?prob)
+        (apply-betas [betas] ?eco ?val ?neighbor-val :> ?prob)
         (log/mk-timeseries ?pd ?prob :> ?prob-series)
-      (:distinct false))))
+        (:distinct false))))

 (comment
   (let [m {:est-start "2005-12-31"


Change settings on created waypoints

Change settings on created waypoints

--- src/cljs/comic_reader/ui/image.cljs
+++ src/cljs/comic_reader/ui/image.cljs
@@ -36,9 +36,13 @@
   (fn [this]
     (let [node (reagent/dom-node this)
           wp-down (make-waypoint {:element node
+                                  :group "comic-image"
+                                  :continuous true
                                   :handler #(when (= % "down")
                                               (set-current-comic))})
           wp-up (make-waypoint {:element node
+                                :group "comic-image"
+                                :continuous true
                                 :offset "bottom-in-view"
                                 :handler #(when (= % "up")
                                             (set-current-comic))})]


Zap unworkable [[ ]] in define-record-type docstring.

--- src/active/clojure/record.cljc
+++ src/active/clojure/record.cljc
@@ -89,7 +89,7 @@
        (def ~(document-with-arglist ?predicate '[thing] (str "Is object a `" ?type "` record? " ?docref))
          (fn [x#]
            (instance? ~?type x#)))
-       (def ~(document ?constructor (str "Construct a [[" ?type "]]"
+       (def ~(document ?constructor (str "Construct a `" ?type "`"
                                          (name-doc ?type)
                                          " record.\n"
                                          (apply str


Fixed failure to pass through component to notify in light-monitor

--- src/strange_coop/components/light_monitor.clj
+++ src/strange_coop/components/light_monitor.clj
@@ -18,7 +18,7 @@
     :else :night))

-(defn time-sm [state day-fn! night-fn!]
+(defn time-sm [component state day-fn! night-fn!]
   (let [dusk 0.03
         dawn 0.13]
     {:state state
@@ -28,7 +28,7 @@
               (if (< brightness dusk)
                 ; state side effects
                 (do
-                  (notify ::info "Switching from day to night and running evening routine")
+                  (notify component ::info "Switching from day to night and running evening routine")
                   (night-fn!)
                   :night)
                 ; Don't change anything
@@ -38,7 +38,7 @@
               (if (> brightness dawn)
                 ; state side effects
                 (do
-                  (notify ::info "Switching from night to day and running morning routine")
+                  (notify component ::info "Switching from night to day and running morning routine")
                   (day-fn!)
                   :day)
                 ; Don't change anything
@@ -49,7 +49,6 @@
   (assoc sm :state
     (((:trans sm) (:state sm)) m)))

-
 (defrecord LightMonitor [config channels pins kill-chan]
   component/Lifecycle
   (start [component]
@@ -59,15 +58,16 @@
           polling-interval 1000]
       (go-loop [light-state-machine
                 (time-sm
+                  component
                   (init-state! floor-button roof-button light-sensor)
-                  (partial >! (:door channels) :open)
-                  (partial >! (:door channels) :close))]
+                  (partial >!! (:door channels) :open)
+                  (partial >!! (:door channels) :close))]
         (let [[message _] (async/alts! [kill-chan (async/timeout polling-interval)])]
           (if-not (= message :kill)
             (let [light-level (bb/safe-read! light-sensor)]
-              (notify ::measurement {:light-level light-level})
+              (notify component ::measurement {:light-level light-level})
               (recur (trans-sm! light-state-machine light-level)))
-            (notify ::info "LightMonitor recieved kill signal; ending polling loop.")))))
+            (notify component ::info "LightMonitor recieved kill signal; ending polling loop.")))))
     (assoc component :kill-chan kill-chan))

   (stop [component]


refactor start-server - just use start!; use action sub arg for validation

--- src/aerobio/server.clj
+++ src/aerobio/server.clj
@@ -404,7 +404,7 @@
   (let [params (msg :params)
         {:keys [ws user eid phase]} params]
     (infof "RUN: %s" params)
-    (let [vmsg (va/validate-exp eid)]
+    (let [vmsg (va/validate-exp eid phase)]
       (if (not-empty vmsg)
         (send-end-msg ws {:op :validate :payload vmsg})
         (let [{:keys [cmd eid template]} params
@@ -559,8 +559,6 @@
     (update-adb :chan ch
                 :idfn [idfn]
                 :connfn [connfn])
-    (start-job-watcher)
-    (start-tool-watcher)
     (go-loop [msg (<! ch)]
       (let [{:keys [op payload]} msg]
         (future (server-dispatch ch op payload))
@@ -572,14 +570,6 @@

 (defn connfn [data] data)
-
-#_(start-server
-   7070
-   :route-handler (aerobio-handler
-                   (aerobio-routes :index-path "public/index.html"))
-   :idfn (constantly "Aerobio")
-   :connfn connfn)
-#_(stop-server)

 (defn start! [port]
@@ -597,6 +587,9 @@
   (stop-tool-watcher)
   (stop-job-watcher)
   (stop-server))
+
+#_(start! 7070)
+#_(stop-server)


Suppress debug messages by default.

Suppress debug messages by default.

--- src/afterglow/core.clj
+++ src/afterglow/core.clj
@@ -4,6 +4,9 @@
             [taoensso.timbre :as timbre :refer [info debug]])
   (:import [com.google.protobuf ByteString])
   (:gen-class))
+
+;; Make sure the experimenter does not get blasted with a ton of debug messages
+(timbre/set-level! :info)

 (defn -main
   "Test connectivity to the OLA server by sending a few messages and pretty-printing the responses.


adding populate a single system

adding populate a single system

--- test/celestial/fixtures/populate.clj
+++ test/celestial/fixtures/populate.clj
@@ -34,8 +34,6 @@
   (doseq [s (g/sample systems-gen 100)]
     (s/add-system s)))

-
-
 (defn populate-all
    "populates all data types"
    []
@@ -44,3 +42,10 @@
    (add-types)
    (add-actions)
    (add-systems))
+
+(defn populate-system
+   "Adds single type and system"
+   [t s]
+  (clear-all)
+  (p/add-type t)
+  (s/add-system s))


Tests for function existence added into test_text_renderer

--- test/clouseau/test_text_renderer.clj
+++ test/clouseau/test_text_renderer.clj
@@ -36,7 +36,30 @@
 ;;; exception statement from your version.
 ;;;

-(ns clouseau.test-core
+(ns clouseau.test-text-renderer
   (:require [clojure.test :refer :all]
             [clouseau.text-renderer :refer :all]))

+;
+; Common functions used by tests.
+;
+
+(defn callable?
+    "Test if given function-name is bound to the real function."
+    [function-name]
+    (clojure.test/function? function-name))
+
+;
+; Tests for existence of various functions
+;
+
+(deftest test-render-front-page-existence
+    "Check that the clouseau.text-renderer/render-front-page definition exists."
+    (testing "if the clouseau.text-renderer/render-front-page definition exists."
+        (is (callable? 'clouseau.text-renderer/render-front-page))))
+
+(deftest test-render-package-descriptions-existence
+    "Check that the clouseau.text-renderer/render-package-descriptions definition exists."
+    (testing "if the clouseau.text-renderer/render-package-descriptions definition exists."
+        (is (callable? 'clouseau.text-renderer/render-package-descriptions))))
+


Added yet another five tests into config-test module

--- test/emender_jenkins/config_test.clj
+++ test/emender_jenkins/config_test.clj
@@ -57,3 +57,32 @@
         (is (callable? 'emender-jenkins.config/print-configuration))))

+(deftest test-get-api-prefix-existence
+    "Check that the emender-jenkins.config/get-api-prefix definition exists."
+    (testing "if the emender-jenkins.config/get-api-prefix definition exists."
+        (is (callable? 'emender-jenkins.config/get-api-prefix))))
+
+
+(deftest test-verbose?-existence
+    "Check that the emender-jenkins.config/verbose? definition exists."
+    (testing "if the emender-jenkins.config/verbose? definition exists."
+        (is (callable? 'emender-jenkins.config/verbose?))))
+
+
+(deftest test-get-version-existence
+    "Check that the emender-jenkins.config/get-version definition exists."
+    (testing "if the emender-jenkins.config/get-version definition exists."
+        (is (callable? 'emender-jenkins.config/get-version))))
+
+
+(deftest test-get-jenkins-url-existence
+    "Check that the emender-jenkins.config/get-jenkins-url definition exists."
+    (testing "if the emender-jenkins.config/get-jenkins-url definition exists."
+        (is (callable? 'emender-jenkins.config/get-jenkins-url))))
+
+
+(deftest test-get-jenkins-auth-existence
+    "Check that the emender-jenkins.config/get-jenkins-auth definition exists."
+    (testing "if the emender-jenkins.config/get-jenkins-auth definition exists."
+        (is (callable? 'emender-jenkins.config/get-jenkins-auth))))
+


Support for handling basic CLI options: -h, -g, -s etc.

--- src/arachnida/core.clj
+++ src/arachnida/core.clj
@@ -1,4 +1,6 @@
 (ns arachnida.core)
+
+(require '[clojure.tools.cli      :as cli])

 (require '[clojure.java.jdbc :as jdbc])

@@ -18,7 +20,36 @@
 (require '[arachnida.db-interface  :as db-interface])
 (require '[arachnida.git-data-fetcher  :as git-data-fetcher])

+(def cli-options
+  [["-h" "--help"    "help"                   :id :help]
+   ["-g" "--git"     "fetch GIT statistic"    :id :git]
+   ["-s" "--server"  "run as HTTP server"     :id :server]])
+
+(defn show-help
+    []
+    (println "Usage:")
+    (println "-h" "--help      help")
+    (println "-g" "--git       fetch GIT statistic")
+    (println "-s" "--server    run as HTTP server"))
+
+(defn show-error
+    []
+    (println "Unknown command line option!")
+    (show-help))
+
+(defn start-server
+    []
+    )
+
 (defn -main
     [& args]
-    (git-data-fetcher/process))
+    (let [all-options           (cli/parse-opts args cli-options)
+          options               (all-options :options)
+          show-help?            (options :help)
+          git?                  (options :git)
+          server?               (options :server)]
+        (cond show-help? (show-help)
+              git?       (git-data-fetcher/process)
+              server?    (start-server)
+              :else      (show-error))))


Clean up

Clean up

--- src/asteroids/core.clj
+++ src/asteroids/core.clj
@@ -117,7 +117,7 @@
    :cockpit-color          (Color. 0 0 80)

    :shots                  []
-   :shoting                false
+   :shooting?              false
    :millis-since-last-shot shot-millis

    :position               [(/ width 2) (/ height 2)]
@@ -166,34 +166,40 @@
 ; Actions
 ; ----------------------------------------------------------------------

-(defn shoot [{:keys [shooting shots millis-since-last-shot] :as ship}]
+(defn shoot [{:keys [shooting? shots millis-since-last-shot] :as ship}]
   #_(prn "shoot" position size direction speed)
   (let [millis-since-last-shot (+ turn-millis millis-since-last-shot)
-        shoots? (and shooting (>= millis-since-last-shot shot-millis))
+        shoots? (and shooting? (>= millis-since-last-shot shot-millis))
         shots (if shoots? (conj shots (create-shot ship)) shots)]
     (assoc ship :millis-since-last-shot (if shoots? 0 millis-since-last-shot)
                 :shots shots))
   )
+
 (defmulti move (fn [object & _] (:type object)))

 (defmethod move :ship [{:keys [direction rotation-speed position speed acceleration shots] :as ship}]
-  (let [new-dir (+ direction (* rotation-speed turn-millis 0.001))
-        new-speed (vec+vec speed (rotate-vec new-dir [0 (* acceleration turn-millis 0.001)]))
-        new-pos (vec+vec new-speed position)
-        moved-shots (->> shots
-                         (filter #(not (out-of-bounds? %)))
-                         (map move))]
-    (assoc ship :direction new-dir
-                :speed new-speed
-                :position new-pos
-                :shots moved-shots
+  (let [direction (+ direction (* rotation-speed turn-millis 0.001))
+        speed (vec+vec speed (rotate-vec direction [0 (* acceleration turn-millis 0.001)]))
+        position (vec+vec speed position)
+        shots (->> shots
+                   (filter #(not (out-of-bounds? %)))
+                   (map move))]
+    (assoc ship :direction direction
+                :speed speed
+                :position position
+                :shots shots
                 )))

-(defmethod move :shot [{:keys [direction position speed acceleration] :as shot}]
-  (let [new-speed (vec+vec speed (rotate-vec direction [0 (* acceleration turn-millis 0.001)]))
-        new-pos (vec+vec new-speed position)]
-    (assoc shot :speed new-speed
-                :position new-pos)))
+(defmethod move :shot [{:keys [position speed] :as shot}]
+  (let [position (vec+vec speed position)]
+    (assoc shot :position position)))
+
+; Accelerating shots - not used right now
+#_(defmethod move :shot [{:keys [position speed direction acceleration] :as shot}]
+  (let [speed (vec+vec speed (rotate-vec direction [0 (* acceleration turn-millis 0.001)]))
+        position (vec+vec speed position)]
+    (assoc shot :speed speed
+                :position position)))

 (defn turn [{:keys [rotation-speed] :as ship} rot]
   (assoc ship :rotation-speed (+ rotation-speed rot)))
@@ -201,8 +207,8 @@
 (defn accelerate [{:keys [acceleration] :as ship} acc]
   (assoc ship :acceleration (+ acceleration acc)))

-(defn toggle-shooting [ship s]
-  (assoc ship :shooting s))
+(defn toggle-shooting [ship do-shoot?]
+  (assoc ship :shooting? do-shoot?))

 ; ----------------------------------------------------------
 ; mutable model
@@ -275,12 +281,12 @@
       (.repaint this))
     (keyPressed [e]
       (do-action! ship (actions (.getKeyCode e))))
+    (keyReleased [e]
+      (do-action! ship (actions (.getKeyCode e)) -1))
+    (keyTyped [e])
     (getPreferredSize []
       (Dimension. (* (inc width) point-size)
-                  (* (inc height) point-size)))
-    (keyReleased [e]
-      (do-action! ship (actions (.getKeyCode e)) -1))
-    (keyTyped [e])))
+                  (* (inc height) point-size)))))

 (defn game []
   (let [ship (ref (create-ship))


Repo name should be queried in read-statistic-for-week

--- src/arachnida/db_interface.clj
+++ src/arachnida/db_interface.clj
@@ -118,6 +118,7 @@
 (defn read-statistic-for-week-from-db
     [first-day last-day author]
     (jdbc/query db-spec/data-db ["select repo,
+                                         (select name from repos where repos.id=commits.repo) as reponame,
                                          count(*) as commits,
                                          sum(files_changed) as files,
                                          sum(insertions) as insertions,


fix rootedness of rule "h32": should be root-is-head-root, not root-is-head

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -341,10 +341,15 @@
                                  :head {:phrasal true}
                                  :synsem {:aux false
                                           :cat :verb}})
+
+                   ;; TODO: enforce the facts that:
+                   ;; 1. {:head {:phrasal true}} => root-is-head-root
+                   ;; 2. {:head {:phrasal false}} => root-is-head
                    (unify-check h32
-                           root-is-head-root
+                           root-is-head
                            {:rule "vp32"
-                            :head {:phrasal-verb true}
+                            :head {:phrasal false
+                                   :phrasal-verb true}
                             :synsem {:aux false
                                      :cat :verb}})


Add AES Key Wrap Algorithm RFC link to the source coude.

--- src/buddy/sign/jwe.clj
+++ src/buddy/sign/jwe.clj
@@ -17,6 +17,7 @@
 ;; - http://tools.ietf.org/html/draft-ietf-jose-json-web-algorithms-40
 ;; - http://tools.ietf.org/html/draft-ietf-jose-json-web-encryption-40
 ;; - http://tools.ietf.org/html/draft-mcgrew-aead-aes-cbc-hmac-sha2-05
+;; - http://tools.ietf.org/html/rfc3394 (AES Key Wrap Algorithm)

 (ns buddy.sign.jwe
   "Json Web Encryption."


Adds update to random_point in get-phrase.

--- src/cadence/model.clj
+++ src/cadence/model.clj
@@ -104,12 +104,16 @@
   they have already done training for. If it is false find one for which the
   user is untrained."
   [user-id for-auth?]
-  (mc/find-one-as-map "phrases"
-                      (if for-auth?
-                        {:users user-id :random_point {"$near" [(rand) 0]}}
-                        {:users {$ne user-id}
-                         :random_point {"$near" [(rand) 0]}})
-                      {:phrase 1}))
+  (let [result (mc/find-one-as-map "phrases"
+                                   (if for-auth?
+                                     {:users user-id
+                                      :random_point {"$near" [(rand) 0]}}
+                                     {:users {$ne user-id}
+                                      :random_point {"$near" [(rand) 0]}})
+                                   {:phrase 1})]
+    ; Changes the random_point for increased randomlyishness.
+    (mc/update-by-id "phrases" (:_id result) {$set {:random_point [(rand) 0]}})
+    result))

 (defn store-classifier
   "Stores the given classifier with the given user/phrase pair."


Fixes arbitrary training phrase selection.

Use additional session key possible-training-phrase to store a phrase
whenever accessed by the GET route to /user/training.  When the client
accesses the POST route this key's value is copied into :training-phrase
and then removed.

--- src/cadence/views/training.clj
+++ src/cadence/views/training.clj
@@ -17,46 +17,63 @@
      [:h1 "Training"]]
     [:p "If you don't know what this is for please checkout the "
      (link-to "/#training" "blurb on the front page") "."]
-    (let [phrase-doc (model/get-phrase (:_id (model/get-auth)) false)
-          phrase (:phrase phrase-doc)]
-      (if (nil? phrase-doc)
-        ; There are no phrases for which the current user has not already done
-        ; training.
-        (common/alert :info [:h2 "You are already trained!"]
-                      (html [:p "There is a limited number of phrases and you
-                                have done the training for all of them."]
-                            [:p "Currently, there is no support for redoing your
-                                training for a given phrase, but hopefully there
-                                will be soon."]) false)
-        ; Otherwise we give the user a form to train with.
-        (do (sess/put! :training-phrase phrase-doc)
-          (html
-            [:h2 "Let's get down to business!"]
-            [:div#train_well.well.container-fluid
-             [:p.help "Simply type the following phrase in the form repeatedly
-                      until I tell you to stop."]
-             (common/phrase-fields "trainer" phrase)
-             [:div#feedback.row-fluid]
-             [:div#completion.row-fluid
-              (let [trcount (count (patrec/kept-cadences))]
-                (html
+    (if-let [phrase-doc (or (sess/get :training-phrase)
+                            (sess/put! :possible-training-phrase
+                                       (model/get-phrase (:_id (model/get-auth))
+                                                         false)))]
+      ; Found a training phrase in the session or grabbed a new one from the
+      ; database.
+      (let [phrase (:phrase phrase-doc)]
+        (html
+          [:h2 "Let's get down to business!"]
+          [:div#train_well.well.container-fluid
+           [:p.help "Simply type the following phrase in the form repeatedly
+                    until I tell you to stop."]
+           ; Show a phrase to type in and an input field to for the user to copy
+           ; it.
+           (common/phrase-fields "trainer" phrase)
+           [:div#feedback.row-fluid]
+           [:div#completion.row-fluid
+            (let [trcount (count (patrec/kept-cadences))]
+              (html

-                  [:div
-                   {:class (str "progress progress-success progress-striped span10"
-                                (when (>= trcount @patrec/training-min) " active"))}
-                   [:div.bar
-                    {:style (str "width: "
-                                 (min 100 (* 100.0 (/ trcount @patrec/training-min)))
-                                 "%;")}]]
-                  (if (>= trcount @patrec/training-min)
-                    [:div.span2 [:a.btn.btn-large.btn-success
-                                 {:href "/user/profile"} "Already done!"]]
-                    [:div.span2 [:a.btn.btn-large.disabled
-                                 {:href "#"} "Complete"]])))]]))))))
+                [:div
+                 {:class (str "progress progress-success progress-striped
+                              span10"
+                              (when (>= trcount @patrec/training-min)
+                                " active"))}
+                 [:div.bar
+                  {:style (str "width: "
+                               (min 100
+                                    (* 100.0
+                                       (/ trcount @patrec/training-min)))
+                               "%;")}]]
+                (if (>= trcount @patrec/training-min)
+                  [:div.span2 [:a.btn.btn-large.btn-success
+                               {:href "/user/profile"} "Already done!"]]
+                  [:div.span2 [:a.btn.btn-large.disabled
+                               {:href "#"} "Complete"]])))]]))
+      ; If there is no training-phrase in the session and the current user has
+      ; no untrained phrases then the user cannot do more training.
+      (common/alert :info [:h2 "You are already trained!"]
+                    (html [:p "There is a limited number of phrases and you
+                              have done the training for all of them."]
+                          [:p "Currently, there is no support for redoing your
+                              training for a given phrase, but hopefully there
+                              will be soon."]) false))))

 (defpage post-training [:post "/user/training"] {:as unkeyed-cad}
   ; I like maps with keyword keys
   (let [cadence (keywordize-keys unkeyed-cad)]
+    ; When training-phrase is unset, set it with the value of
+    ; possible-training-phrase (set when /user/training is accessed via GET). If
+    ; the client somehow manipulates this the worst case scenario is that
+    ; :training-phrase will be null wich should be caught by the cadence?
+    ; validator.
+    (when (nil? (sess/get :training-phrase))
+      (sess/put! :training-phrase (let [tp (sess/get :possible-training-phrase)]
+                                    (sess/remove! :possible-training-phrase)
+                                    tp)))
     ; Ensure that the supplied data is really what I want it to be and not some
     ; glitch or fabrication. (This uses noir.validation)
     (if (is-valid/cadence? cadence)


Handle substrings safely

Handle substrings safely

--- src/catalog/vubis.clj
+++ src/catalog/vubis.clj
@@ -172,6 +172,13 @@
       (string/replace #"[\p{Punct}]+$" "")
       (string/replace #"^[\p{Punct}]+" "")))

+(defn- trunc
+  "Get the first `n` chars of `s`. If `s` has fewer chars than `n`
+  then just return `s`."
+  ;; http://stackoverflow.com/questions/20747112/simple-way-to-truncate-a-string-in-clojure
+  [s n]
+  (subs s 0 (min (count s) n)))
+
 (defn get-personel [s]
   (-> s
       trim-punctuation
@@ -217,10 +224,9 @@
                   :source-publisher source-publisher
                   :source source
                   :language (iso-639-2-to-iso-639-1 language)
-                  :genre (or (genre-raw-to-genre (subs genre 0 1))
-                             (genre-code-to-genre (subs genre-code 0 2)))
-                  :sub-genre (and (>= (count genre) 3)
-                                  (genre-raw-to-subgenre (subs genre 0 3)))
+                  :genre (or (genre-raw-to-genre (trunc genre 1))
+                             (genre-code-to-genre (trunc genre-code 2)))
+                  :sub-genre (genre-raw-to-subgenre (trunc genre 3))
                   :genre-text genre-text
                   :format fmt
                   :producer-brief (producer-raw-to-producer (parse-int producer))


Using shorter ils.

Using shorter ils.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -239,7 +239,7 @@
                           :realm (:cur-realm ils)
                           :realm-partition (:cur-realm-partition ils)})]
            (state-loop actx :lane-state lane-handler
-                       (assoc initial-lane-state :cur-partition (:partition res))
+                       (assoc ils :cur-partition (:partition res))
                        :req-ch req-ch)))
     req-ch))


Added rev for coll-create.

Added rev for coll-create.

--- src/cbfg/world/t2.cljs
+++ src/cbfg/world/t2.cljs
@@ -41,10 +41,16 @@
 ; TODO: Split between logical schema and physical runtime objects.

 (defn make-initial-server-state [actx]
-  {:realms {"_system" {:users {"admin" {:pswd "password"}}
+  {:rev 0
+   :realms {"_system" {:rev 0
+                       :users {"admin" {:rev 0
+                                        :pswd "password"}}
                        :collsets {}}
-            "_lobby" {:users {"_anon" {:pswd ""}}
-                      :collsets {"default" {:colls {"default" {}}}}}}})
+            "_lobby" {:rev 0
+                      :users {"_anon" {:rev 0
+                                       :pswd ""}}
+                      :collsets {"default" {:rev 0
+                                            :colls {"default" {:rev 0}}}}}}})

 (def initial-lane-state
   {:cur-realm "_lobby"
@@ -53,9 +59,9 @@
    :cur-user-realm "_lobby"
    :cur-user "_anon"})

-(defn make-coll [actx m]
-  {:name (:key m)
-   :rev 0})
+(defn make-coll [actx rev m]
+  {:rev rev
+   :name (:key m)})

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

@@ -108,16 +114,23 @@

     "coll-create"
     ; TODO: Needs auth check.
-    ; TODO: Incrementing rev counter.
     (if-let [colls (get-in server-state [:realms (:cur-realm m)
                                          :collsets (:cur-realm-collset m)
                                          :colls])]
       (if (not (get (:key m) colls))
-        (let [coll (make-coll actx m)]
-          [(assoc-in server-state [:realms (:cur-realm m)
-                                   :collsets (:cur-realm-collset m)
-                                   :colls (:key m)] coll)
-           (assoc m :status :ok :rev (:rev coll))])
+        (let [nrev (inc (:rev server-state))
+              coll (make-coll actx nrev m)]
+          [(-> server-state
+               (assoc-in [:realms (:cur-realm m)
+                          :collsets (:cur-realm-collset m)
+                          :colls (:key m)] coll)
+               (assoc-in [:realms (:cur-realm m)
+                          :collsets (:cur-realm-collset m)
+                          :rev] nrev)
+               (assoc-in [:realms (:cur-realm m)
+                          :rev] nrev)
+               (assoc :rev nrev))
+           (assoc m :status :ok :rev nrev)])
         [server-state (assoc m :status :exists)])
       [server-state (assoc m :status :not-found)])


update doc

update doc

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -107,7 +107,7 @@
                  (bad-req  {:msg (<< "Cannot create machine with missing type ~(e :t)}")})))
              )))

-  (PUT- "/host/machine" [& ^:system props] {:nickname "updateHostMachine" :summary "Add Host machine"
+  (PUT- "/host/machine" [& ^:system props] {:nickname "updateHostMachine" :summary "Update Host machine"
                                             :errorResponses (errors {:conflict "Host does not exist"}) }
         (let [host (get-in props [:machine :hostname])]
           (if-not (p/host-exists? host)


fix new task to use file/cp and project/log

--- src/cake/tasks/new.clj
+++ src/cake/tasks/new.clj
@@ -1,9 +1,10 @@
 (ns cake.tasks.new
-  (:use cake cake.core cake.ant cake.file
-        [cake.project :only [group]]
+  (:use cake cake.core cake.file cake.ant
+        [cake.project :only [group log]]
         [clojure.string :only [join]]
         [cake.utils.io :only [extract-resource]])
-  (:import [org.apache.tools.ant.taskdefs Mkdir Copy]))
+  (:import [org.apache.tools.ant.taskdefs Copy]))
+

 (def default-template
 "(defproject +project+ \"0.0.1-SNAPSHOT\"
@@ -37,11 +38,11 @@
 (defn create-template [template]
   (log (str "Creating template directory: ~/.cake/templates/" template))
   (let [template (file template-dir template)]
-    (ant Mkdir {:dir template})
-    (ant Mkdir {:dir (file template "src" "+project+")})
+    (mkdir template)
+    (mkdir (file template "src" "+project+"))
     (spit (file template "src" "+project+" "core.clj") "(ns +project+.core)")
     (log "Created template file: src/+project+/core.clj")
-    (ant Mkdir {:dir (file template "test")})
+    (mkdir (file template "test"))
     (spit (file template "project.clj") default-template)
     (log "Created template file: project.clj")
     (spit (file template ".gitignore")


adding ssh port

adding ssh port

--- src/celestial/ssh.clj
+++ src/celestial/ssh.clj
@@ -9,13 +9,14 @@
     [clj-ssh.ssh :only
       (session ssh-agent with-connection sftp ssh-sftp with-channel-connection ssh)]))

-(def #^ { :doc "SSH session options"}
-  ssh-opts {:username "root" :strict-host-key-checking :no :port (config :ssh-port)})
+(defn ssh-opts
+  "SSH session options" [port]
+  {:username "root" :strict-host-key-checking :no :port port})

 (defn with-session
   "Executes f on host with an ssh session"
-  [host f]
-  (let [session (session (ssh-agent {}) host ssh-opts)]
+  [host port f]
+  (let [session (session (ssh-agent {}) host (ssh-opts port))]
     (try+
       (with-connection session (f session))
       (catch #(= (:message %) "Auth fail") e
@@ -36,14 +37,13 @@
   [out]
   (doseq [line (line-seq (clojure.java.io/reader out))] (debug line) ))

-(defn execute [{:keys [host]} & batches]
+(defn execute [{:keys [host port] :or {port 22}} & batches]
   {:pre [(every? sequential? batches)]}
   "Executes remotly using ssh for example: (execute {:host \"192.168.20.171\"} [\"ls\"])"
-  (with-session host
+  (with-session host port
     (fn [session]
       (doseq [b batches]
         (let [{:keys [channel out-stream] :as res} (ssh session {:in  (join "\n" b)  :out :stream})]
-          (println (bean channel))
           (log-output out-stream)
           (let [exit (.getExitStatus channel)]
             (when-not (= exit 0)


Add helper for building ValueJoiners

Add helper for building ValueJoiners

--- src/cddr/ksml/eval.clj
+++ src/cddr/ksml/eval.clj
@@ -66,6 +66,12 @@
     (apply [_ v]
       (map-fn v))))

+(defn value-joiner
+  [join-fn]
+  (reify ValueJoiner
+    (apply [_ left right]
+      (join-fn left right))))
+
 ;; kstream/ktable ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;
 ;; Lots of methods exist on both KStream and KTable classes. Clojure
@@ -125,9 +131,7 @@
   `(.. ~(eval left)
        ~(remove nil? (list 'join
                            (eval right)
-                           `(reify ValueJoiner
-                              (apply [_ left# right#]
-                                (~join-fn left# right#)))
+                           `(value-joiner ~join-fn)
                            args))))

 (defmethod eval-op :join-global
@@ -135,18 +139,14 @@
   `(.. ~(eval left)
        (join ~(eval right)
              `(key-value-map-fn ~map-fn)
-             `(reify ValueJoiner
-                (apply [_ left# right#]
-                  (~join-fn left# right#))))))
+             `(value-joiner ~join-fn))))

 (defmethod eval-op :left-join
   [_ join-fn left right & args]
   `(.. ~(eval left)
        ~(remove nil? (apply list 'leftJoin
                             (eval right)
-                            `(reify ValueJoiner
-                               (apply [_ left# right#]
-                                 (~join-fn left# right#)))
+                            `(value-joiner ~join-fn)
                             args))))

 (defmethod eval-op :left-join-global
@@ -154,9 +154,7 @@
   `(.. ~(eval left)
        (join ~(eval right)
              `(key-value-mapper ~map-fn)
-             `(reify ValueJoiner
-                (apply [_ left# right#]
-                  (~join-fn left# right#))))))
+             `(value-joiner ~join-fn))))

 (defmethod eval-op :map
   [_ map-fn stream]
@@ -173,9 +171,7 @@
   `(.. ~(eval left)
        ~(remove nil? (apply list 'outerJoin
                             (eval right)
-                            `(reify ValueJoiner
-                               (apply [_ left# right#]
-                                 (~join-fn left# right#)))
+                            `(value-joiner ~join-fn)
                             args))))

 (defmethod eval-op :peek


Fix the loader running out of heap space

I had to eliminate the post-condition for the join-maps function, which
was causing the evaluation to be non-lazy.

--- src/cfpb/qu/loader.clj
+++ src/cfpb/qu/loader.clj
@@ -196,14 +196,16 @@
   "Join two vectors of maps on some keys."
   [lmaps lkeys lvals rmaps rkeys rvals]
   {:pre [(= (count lkeys) (count rkeys))
-         (= (count lvals) (count rvals))]
-   :post [(= (count lmaps) (count %))]}
-  (let [joinmap (apply hash-map (apply concat (map (juxt (fn [row]
-                                                           ((apply juxt rkeys) row))
-                                                         (fn [row]
-                                                           ((apply juxt rvals) row))) rmaps)))]
-    (map (fn [row]
-           (merge row (zipmap lvals (get joinmap ((apply juxt lkeys) row))))) lmaps)))
+         (= (count lvals) (count rvals))]}
+  (let [get-lkeys (apply juxt lkeys)
+        get-rkeys (apply juxt rkeys)
+        get-rvals (apply juxt rvals)
+        joinmap (reduce (fn [m row]
+                          (assoc m (get-rkeys row) (get-rvals row)))
+                        {} rmaps)]
+    (map (fn [row]
+           (let [joindata (zipmap lvals (get joinmap (get-lkeys row)))]
+             (merge row joindata))) lmaps)))

 (defn- load-csv-file
   [file collection transform-fn]


Fixed updating in ez-load-ref-column

Fixed updating in ez-load-ref-column

--- src/cfpb/qu/loader.clj
+++ src/cfpb/qu/loader.clj
@@ -464,8 +464,9 @@
                                           [(into {}
                                                  (zipmap slice-cols
                                                          ((apply juxt concept-cols) row)))
-                                           {value (value row)}])))]
+                                           {(zipfn refcol) (value row)}])))]
              (log/info "Writing" refcol "for" dataset slice)
+             (log/info concept-data)
              (doseq [[find-map update-map] concept-data]
                (coll/update (name slice)
                             find-map


The Cleaners, start of Plascrete Carapace.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -1340,7 +1340,29 @@

    "Plascrete Carapace"
    {:data [:counter 4]
-    :abilities [{:counter-cost 1 :msg "prevent 1 meat damage"}]}
+    :events
+          {:pre-damage
+           {:req (req (and (= target :meat) (> (:counter card) 0)))
+            :effect (req (let [plasc card]
+                              (prompt! state :runner card "Use Plascrete Carapace tokens to prevent meat damage?"
+                                  (take (inc (:counter plasc)) ["0" "1" "2" "3" "4"])
+                                  {:effect (req (let [c (Integer/parseInt target)]
+                                                     (damage-bonus state side :meat (- c))
+                                                     (add-prop state :runner plasc :counter (- c))))
+                                   :msg (msg "prevent " target " meat damage")
+                                   })))
+            }}}
+                 ;(req (let [plasc card]
+                 ;             (resolve-ability
+                 ;               state :runner
+                 ;               {:prompt "Use Plascrete Carapace tokens to prevent meat damage?"
+                 ;                :choices (take (inc (:counter plasc)) ["0" "1" "2" "3" "4"])
+                 ;                :effect (req (let [c (Integer/parseInt target)]
+                 ;                                  (damage-bonus state side :meat (- c))
+                 ;                                  (add-prop state :runner plasc :counter (- c))))
+                 ;                :msg (msg "prevent " target " meat damage")
+                 ;                } card nil)))}}}
+    ;:abilities [{:counter-cost 1 :msg "prevent 1 meat damage"}]}

    "Priority Requisition"
    {:choices {:req #(and (= (:type %) "ICE") (not (:rezzed %)))}
@@ -1936,6 +1958,13 @@
                    :effect (effect (move :runner card :scored) (gain :runner :agenda-point 2))}
     :events {:agenda-stolen {:req (req (> (:agendapoints target) 0))
                              :effect (effect (lose :runner :agenda-point 1))}}}
+
+   "The Cleaners"
+   {:events
+    {:pre-damage
+     {:req (req (= target :meat))
+      :msg "to do 1 additional meat damage"
+      :effect (effect (damage-bonus :meat 1))}}}

    "The Foundry: Refining the Process"
    {:events


Add Hivemind.

Add Hivemind.

Update Medium, Nerve Agent, Gorman Drip to count Hivemind counters for their effects.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -704,8 +704,8 @@
    {:abilities [{:cost [:click 2] :effect (effect (gain :credit 3)) :msg "gain 3 [Credits]"}]}

    "Gorman Drip v1"
-   {:abilities [{:cost [:click 1] :effect (effect (gain :credit (:counter card)) (trash card))
-                 :msg (msg "gain " (:counter card) " [Credits]")}]
+   {:abilities [{:cost [:click 1] :effect (effect (gain :credit (get-virus-counters state side card)) (trash card))
+                 :msg (msg "gain " (get-virus-counters state side card) " [Credits]")}]
     :events {:corp-click-credit {:effect (effect (add-prop :runner card :counter 1))}
              :corp-click-draw {:effect (effect (add-prop :runner card :counter 1))}}}

@@ -806,6 +806,33 @@
     :abilities [{:cost [:click 1] :counter-cost 1 :msg (msg "gain" (:credit runner) " [Credits]")
                  :effect (effect (gain :credit (:credit runner)))}]}

+
+   "Hivemind"
+   {:data {:counter 1 :counter-type "Virus"}
+    :abilities [{:req (req (> (:counter card) 0))
+                 :prompt "Move a virus counter to which card?"
+                 :priority true
+                 :choices {:req #(has? % :subtype "Virus")}
+                 :effect (req (let [abilities (:abilities (card-def target)) virus target]
+                              (add-prop state :runner virus :counter 1)
+                              (add-prop state :runner card :counter -1)
+                              (if (= (count abilities) 1)
+                                ((swap! state update-in [side :prompt] rest) ; remove the Hivemind prompt so Imp works
+                                  (resolve-ability state side (first abilities) (get-card state virus) nil))
+                                (resolve-ability
+                                  state side {
+                                              :prompt "Choose an ability to trigger"
+                                              :choices (vec (map :msg abilities))
+                                              :effect (req
+                                                        (swap! state update-in [side :prompt] rest)
+                                                        (resolve-ability
+                                                             state side (first (filter #(= (:msg %) target) abilities))
+                                                             card nil))
+                                              } (get-card state virus) nil))
+                              ))
+                 :msg (msg "to trigger an ability on " (:title target))}]}
+
+
    "Hokusai Grid"
    {:events {:successful-run {:req (req this-server) :msg "do 1 net damage"
                               :effect (req (damage state side :net 1))}}}
@@ -1077,9 +1104,11 @@
    {:effect (effect (gain :credit 8) (gain :runner :credit 3))}

    "Medium"
-   {:events {:successful-run {:req (req (= target :rd))
-                              :effect (effect (access-bonus (:counter card))
-                                              (add-prop card :counter 1))}}}
+   {:events
+    {:successful-run
+     {:req (req (= target :rd))
+      :effect (effect (add-prop card :counter 1)
+                      (access-bonus (max 0 (dec (get-virus-counters state side (get-card state card))))))}}}

    "Melange Mining Corp."
    {:abilities [{:cost [:click 3] :effect (effect (gain :credit 7)) :msg "gain 7 [Credits]"}]}
@@ -1144,9 +1173,12 @@
                        :msg "gain 1 [Credits]" :effect (effect (gain :credit 1))}}}

    "Nerve Agent"
-   {:events {:successful-run {:req (req (= target :hq))
-                              :effect (effect (access-bonus (:counter card))
-                                              (add-prop card :counter 1))}}}
+   {:events
+    {:successful-run
+     {:req (req (= target :hq))
+      :effect (effect (add-prop card :counter 1)
+                      (access-bonus (max 0 (dec (get-virus-counters state side (get-card state card))))))}}}
+
    "Net Celebrity"
    {:recurring 1}

@@ -2874,7 +2906,7 @@
    "Deep Thought"
    {:events {:successful-run {:effect (effect (add-prop card :counter 1)) :req (req (= target :rd))}
              :runner-turn-begins
-             {:req (req (>= (:counter card) 3)) :msg "look at the top card of R&D"
+             {:req (req (>= (get-virus-counters state side card) 3)) :msg "look at the top card of R&D"
               :effect (effect (prompt! card (str "The top card of your R&D is "
                                                  (:title (first (:deck corp)))) ["OK"] {}))}}}


Remove old comment

Remove old comment

--- src/clj/ji/service.clj
+++ src/clj/ji/service.clj
@@ -160,13 +160,3 @@
         (->> (<! client-chan)
              (wrap-client-chan)
              (client-join game-envs)))))
-
-(comment
-  (match [conn]
-         [{:uri uri :in in :out out}]
-         (go
-           (>! in (str "Yo, " uri))
-           (loop []
-             (when-let [msg (<! out)]
-               (prn msg)
-               (recur))))))


will not shutdown for standalone server cluster

--- src/clj/neb/server.clj
+++ src/clj/neb/server.clj
@@ -8,18 +8,21 @@
             [neb.utils :refer :all]
             [neb.trunk-store :refer [init-trunks dispose-trunks start-defrag stop-defrag
                                      init-durability-client start-backup stop-backup]]
-            [neb.base :refer [schemas-lock]]))
+            [neb.base :refer [schemas-lock]]
+            [cluster-connector.sharding.DHT :as dht]))

 (def cluster-config-fields [:trunks-size])
 (def cluster-confiugres (atom nil))
 (def confiugres (atom nil))
+(def server-loaded (atom false))

 (defn shutdown []
   (let [{:keys [schema-file]} @confiugres]
     (when schema-file (s/save-schemas schema-file))))

 (defn stop-server []
-  (println "Shutdowning...")
+  (println "Shuting down...")
+  (reset! server-loaded false)
   (try-all
     (rfi/stop-server)
     (stop-backup)
@@ -51,37 +54,41 @@
       port zk meta
       :connected-fn
       (fn []
-        (let [is-first-node? (is-first-node?)
-              cluster-configs (select-keys config cluster-config-fields)
-              cluster-configs (if is-first-node?
-                                cluster-configs
-                                (or (rfi/condinated-siblings-invoke 'neb.core/get-cluster-configures)
-                                    cluster-configs))
-              {:keys [trunks-size]} cluster-configs
-              {:keys [memory-size schema-file data-path durability auto-backsync replication
-                      keep-imported-backup recover-backup-at-startup]} config
-              trunks-size (interpret-volume trunks-size)
-              memory-size (interpret-volume memory-size)
-              schemas (if is-first-node?
-                        (s/load-schemas-file schema-file)
-                        (rfi/condinated-siblings-invoke-with-lock schemas-lock 'neb.schema/get-schemas))
-              trunk-count (int (Math/floor (/ memory-size trunks-size)))]
-          (println "Loading Store...")
-          (reset! cluster-confiugres cluster-configs)
-          (reset! confiugres config)
-          (s/clear-schemas)
-          (s/load-schemas schemas)
-          (init-trunks trunk-count trunks-size (boolean durability))
-          (when data-path (dserv/prepare-backup-server data-path keep-imported-backup))
-          (start-defrag)
-          (register-as-master (* 50 trunk-count))
-          (when durability (init-durability-client (or replication 1)))
-          (when recover-backup-at-startup (dserv/recover-backup))
-          (when (and durability auto-backsync) (start-backup))
-          (rfi/start-server port)))
+        (when-not @server-loaded
+          (let [is-first-node? (is-first-node?)
+                cluster-configs (select-keys config cluster-config-fields)
+                cluster-configs (if is-first-node?
+                                  cluster-configs
+                                  (or (rfi/condinated-siblings-invoke 'neb.core/get-cluster-configures)
+                                      cluster-configs))
+                {:keys [trunks-size]} cluster-configs
+                {:keys [memory-size schema-file data-path durability auto-backsync replication
+                        keep-imported-backup recover-backup-at-startup]} config
+                trunks-size (interpret-volume trunks-size)
+                memory-size (interpret-volume memory-size)
+                schemas (if is-first-node?
+                          (s/load-schemas-file schema-file)
+                          (rfi/condinated-siblings-invoke-with-lock schemas-lock 'neb.schema/get-schemas))
+                trunk-count (int (Math/floor (/ memory-size trunks-size)))]
+            (println "Loading Store...")
+            (reset! cluster-confiugres cluster-configs)
+            (reset! confiugres config)
+            (s/clear-schemas)
+            (s/load-schemas schemas)
+            (init-trunks trunk-count trunks-size (boolean durability))
+            (when data-path (dserv/prepare-backup-server data-path keep-imported-backup))
+            (start-defrag)
+            (register-as-master (* 50 trunk-count))
+            (when durability (init-durability-client (or replication 1)))
+            (when recover-backup-at-startup (dserv/recover-backup))
+            (when (and durability auto-backsync) (start-backup))
+            (rfi/start-server port)
+            (reset! server-loaded true))))
       :expired-fn
       (fn []
-        (stop-server)))))
+        (if (> (count @dht/cluster-server-list) 1)
+          (stop-server)
+          (println "Zookeeper disconnected but it is the only server. Will not shutdown."))))))

 (defn clear-zk []
   (delete-configure :schemas)


server cleanup

server cleanup

--- src/clj/ufo/server.clj
+++ src/clj/ufo/server.clj
@@ -35,9 +35,9 @@
         dbfn (or (get-in fmap [fnkw :db])
                  (println "ERROR" fnkw "does not exist in the fmap"))
         dbfnprm (into edn-body (get-in fmap [fnkw :prm]))]
-    (let [data (dbfn dbfnprm)]
-      (end-response {:sql (:sql data)
-                     :rows (for [row (:rows data)]
+    (let [{sql :sql rows :rows} (dbfn dbfnprm)]
+      (end-response {:sql sql
+                     :rows (for [row rows]
                              (assoc row
                                     :ago
                                     (etime/tstp-modified-ago
@@ -49,11 +49,11 @@
         dbfn (or (get-in fmap [fnkw :db])
                  (println "ERROR" fnkw "does not exist in the fmap"))
         dbfnprm (into edn-body (get-in fmap [fnkw :prm]))]
-    (let [data (dbfn dbfnprm)]
+    (let [{sql :sql rows :rows} (dbfn dbfnprm)]
       (json-response
        callback
-       {:sql (:sql data)
-        :rows (for [row (:rows data)]
+       {:sql sql
+        :rows (for [row rows]
                 (assoc row
                        :ago
                        (etime/tstp-modified-ago
@@ -80,11 +80,9 @@
              callback (subs query-string (count "callback="))]
          (doreq-json callback {:edn-body edn-body})))
   (GET "/jsonreq/:search" req
-       (do
-         (println "jsonreq" req)
-         (let [query-string (:query-string req)
-               callback (subs query-string (count "callback="))]
-           (json-response callback ["joe-foo-stuff" ["foo" "joe"] [] []]))))
+       (let [query-string (:query-string req)
+             callback (subs query-string (count "callback="))]
+         (json-response callback ["joe-foo-stuff" ["foo" "joe"] [] []])))
   (route/files "/" {:root "resources/public"})
   (route/not-found "
Page not found
"))


Remove [] around authors in the search index content

--- src/clojars/search.clj
+++ src/clojars/search.clj
@@ -27,7 +27,7 @@

 (def content-fields [:artifact-id :group-id :version :description
-                     :url :authors])
+                     :url #(->> % :authors (str/join " "))])

 (def field-settings {:artifact-id {:analyzed false}
                      :group-id {:analyzed false}


exception handler removed

exception handler removed

--- src/clygments/core.clj
+++ src/clygments/core.clj
@@ -66,21 +66,17 @@
   "highlight a piece of code."
   ([code lang output] (highlight code lang output {}))
   ([code lang output opts]
-    (try
-      (let [opt-args (map->kw-args opts)]
-        ;; we give all options to both lexer and formatter, unknown ones will
-        ;; be ignored
-        (exec-code-in "_r" (format "get_lexer_by_name(\"%s\",%s)"
-                                   (keyword->langname lang) opt-args) "None")
-        (exec-code-in "_f" (format "get_formatter_by_name(\"%s\",%s)"
-                                   (keyword->langname output) opt-args) "None")
-        (if (py-true? "_r!=None" "_f!=None")
-          (do
-            (.exec python (str "_res=highlight(\"\"\"" (escape-string code)
-                               "\"\"\",_r,_f)\n"))
-            ;; This won't work with non-text formatters, such as gif, but it's
-            ;; ok since they're not supported on Jython (#2)
-            (.get python "_res" String))))
-      (catch Exception e
-        (.printStackTrace e)
-        (println (.getMessage e))))))
+    (let [opt-args (map->kw-args opts)]
+      ;; we give all options to both lexer and formatter, unknown ones will
+      ;; be ignored
+      (exec-code-in "_r" (format "get_lexer_by_name(\"%s\",%s)"
+                                 (keyword->langname lang) opt-args) "None")
+      (exec-code-in "_f" (format "get_formatter_by_name(\"%s\",%s)"
+                                 (keyword->langname output) opt-args) "None")
+      (if (py-true? "_r!=None" "_f!=None")
+        (do
+          (.exec python (str "_res=highlight(\"\"\"" (escape-string code)
+                             "\"\"\",_r,_f)\n"))
+          ;; This won't work with non-text formatters, such as gif, but it's
+          ;; ok since they're not supported on Jython (#2)
+          (.get python "_res" String))))))


remove :import dupe

remove :import dupe

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -7,7 +7,6 @@
 ;; You must not remove this notice, or any other, from this software.

 (ns cljs.repl
-  (:import (java.io PushbackReader))
   (:refer-clojure :exclude [load-file])
   (:require [clojure.java.io :as io]
             [cljs.compiler :as comp]


CLJS-1003: fix cljs.test run-tests do-report :summary issues

--- src/clj/cljs/test.clj
+++ src/clj/cljs/test.clj
@@ -259,7 +259,9 @@
                                   (concat [env-or-ns] namespaces)
                                   namespaces))])
                          :type :summary)]
+          (cljs.test/set-env! ~env)
           (do-report summary#)
+          (cljs.test/clear-env!)
           summary#)))))

 (defmacro run-all-tests


Removed prn

Removed prn

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -1296,7 +1296,6 @@
               :effect (effect (add-prop card :rec-counter -1) (gain :credit 1))}
              (get-in cdef [:abilities ability]))
         cost (:cost ab)]
-    (prn "play-ability" cost)
     (when (or (nil? cost)
               (apply can-pay? state side cost))
         (when-let [activatemsg (:activatemsg ab)] (system-msg state side activatemsg))
@@ -1723,9 +1722,6 @@
   (let [source-def (card-def source)
         source-events (if (:events source-def) (:events source-def) {})
         dest-card (merge dest {:events source-events})]
-          (prn "copy-events")
-          (prn "source-events" source-events)
-          (prn "dest-card" dest-card)
           (update! state side dest-card)
           (register-events state side (:events dest-card) dest-card)
         ))
@@ -1740,9 +1736,6 @@
                       :label (or (:label ab) (and (string? (:msg ab)) (capitalize (:msg ab))) "")
                       :dynamic :copy))
         dest-card (merge dest {:abilities source-abilities :source source})]
-          (prn "copy-abilities")
-          (prn "source-abilities" source-abilities)
-          (prn "dest-card" dest-card)
           (update! state side dest-card)
         ))

@@ -1756,14 +1749,6 @@
         (if (not (nil? source-effect)) (source-effect state side source nil))
         (update! state side dest-card))
       )))
-
-     ; (when-let [leave-effect (:leave-play (card-def card))]
-     ;   (when (or (and (= (:side card) "Runner") (:installed card))
-     ;             (:rezzed card)
-     ;             (= (first (:zone card)) :current)
-     ;             (not (empty? (filter #(= (:cid card) (:cid %)) (get-in @state [:corp :scored])))))
-     ;     (leave-effect state side card nil)))
-

 (defn fire-leave-play-effects [state side card]
   (if-let [source-leave-play (:source-leave-play card)]


added support for x509 client certificates

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -1,8 +1,9 @@
 (ns clj-http.core
   "Core HTTP request/response implementation."
   (:require [clojure.pprint])
-  (:import (java.io ByteArrayOutputStream File FilterInputStream InputStream)
+  (:import (java.io ByteArrayOutputStream File FilterInputStream InputStream FileInputStream)
            (java.net URI)
+           (java.security KeyStore)
            (org.apache.http HeaderIterator HttpRequest HttpEntity
                             HttpEntityEnclosingRequest
                             HttpResponse Header HttpHost)
@@ -23,7 +24,7 @@
            (org.apache.http.conn.scheme PlainSocketFactory
                                         SchemeRegistry Scheme)
            (org.apache.http.conn.ssl SSLSocketFactory TrustStrategy)
-           (org.apache.http.impl.conn SingleClientConnManager)
+           (org.apache.http.impl.conn SingleClientConnManager SchemeRegistryFactory)
            (org.apache.http.impl.conn.tsccm ThreadSafeClientConnManager)
            (org.apache.http.impl.client DefaultHttpClient)
            (org.apache.http.util EntityUtils)))
@@ -78,10 +79,28 @@
     (.register (Scheme. "http" 80 (PlainSocketFactory/getSocketFactory)))
     (.register (Scheme. "https" 443 (SSLSocketFactory/getSocketFactory)))))

-(defn make-regular-conn-manager ^SingleClientConnManager [& [insecure?]]
+(defn get-keystore ^KeyStore [^String keystore-file ^String keystore-pass]
+  (if (nil? keystore-file) nil
+  (let [keystore (KeyStore/getInstance (KeyStore/getDefaultType))]
+    (with-open [is (FileInputStream. keystore-file)]
+      (.load keystore is (.toCharArray keystore-pass))
+      keystore))))
+
+(defn get-keystore-scheme-registry [{:keys [keystore keystore-pass trust-store trust-store-pass]}]
+  (let [ks (get-keystore keystore keystore-pass)
+        ts (get-keystore trust-store trust-store-pass)
+        factory (SSLSocketFactory. ks keystore-pass ts)]
+    (doto (SchemeRegistryFactory/createDefault)
+      (.register (Scheme. "https" 443 factory)))))
+
+(defn make-regular-conn-manager ^SingleClientConnManager [{:keys [insecure? trust-store trust-store-pass
+                                                                  keystore keystore-pass]
+                                                           :as req}]
+  (if (or (not (nil? trust-store)) (not (nil? keystore)))
+    (SingleClientConnManager. (get-keystore-scheme-registry req))
   (if insecure?
     (SingleClientConnManager. insecure-scheme-registry)
-    (SingleClientConnManager.)))
+    (SingleClientConnManager.))))

 (defn make-reusable-conn-manager
   "Given an timeout and optional insecure? flag, create a
@@ -216,7 +235,7 @@
            headers content-type character-encoding body socket-timeout
            conn-timeout multipart debug debug-body insecure? save-request?
            proxy-host proxy-port as cookie-store retry-handler] :as req}]
-  (let [conn-mgr (or *connection-manager* (make-regular-conn-manager insecure?))
+  (let [conn-mgr (or *connection-manager* (make-regular-conn-manager req))
         http-client (DefaultHttpClient.
                       ^org.apache.http.conn.ClientConnectionManager conn-mgr)
         scheme (name scheme)]


A bit of version agnosticism.

A bit of version agnosticism.

--- src/clj_stan/core.clj
+++ src/clj_stan/core.clj
@@ -66,6 +66,12 @@
                "output" (str "file=" t "/output.csv"))
       (first (output/read-stan-output (str t "/output.csv"))))))

+(defn lib
+  [path lib-name]
+  (first (filter (fn [s]
+                   (.startsWith s (str path lib-name "_")))
+                 (map str (.listFiles (io/file path))))))
+
 (defn make
   [model]
   (let [text (slurp model)
@@ -77,7 +83,8 @@
                      (throw (Exception. "STAN_HOME environment variable is not set.
                                      See `clj-stan` documentation.")))
             model-file (str exe ".stan")
-            hpp-file (str exe ".hpp")]
+            hpp-file (str exe ".hpp")
+            lib-path (str home "/stan/lib/stan_math/lib/")]
         (spit model-file text)
         (println (format "Compiling %s to C++." model))
         (execute (str home "/bin/stanc") model-file (str "--o=" hpp-file))
@@ -86,9 +93,9 @@
                  (str "-I" home "/src")
                  (str "-I" home "/stan/src")
                  "-isystem" (str home "/stan/lib/stan_math/")
-                 "-isystem" (str home "/stan/lib/stan_math/lib/eigen_3.3.3")
-                 "-isystem" (str home "/stan/lib/stan_math/lib/boost_1.62.0")
-                 "-isystem" (str home "/stan/lib/stan_math/lib/cvodes_2.9.0/include")
+                 "-isystem" (lib lib-path "eigen")
+                 "-isystem" (lib lib-path "boost")
+                 "-isystem" (str (lib lib-path "cvodes") "/include")
                  "-Wall"
                  "-DEIGEN_NO_DEBUG" "-DBOOST_RESULT_OF_USE_TR1" "-DBOOST_NO_DECLTYPE"
                  "-DBOOST_DISABLE_ASSERTS" "-DFUSION_MAX_VECTOR_SIZE=12" "-DNO_FPRINTF_OUTPUT"
@@ -96,6 +103,6 @@
                  "-O3" "-o" exe
                  (str home "/src/cmdstan/main.cpp")
                  "-include" hpp-file
-                 (str home "/stan/lib/stan_math/lib/cvodes_2.9.0/lib/libsundials_nvecserial.a")
-                 (str home "/stan/lib/stan_math/lib/cvodes_2.9.0/lib/libsundials_cvodes.a"))))
+                 (str (lib lib-path "cvodes") "/lib/libsundials_nvecserial.a")
+                 (str (lib lib-path "cvodes") "/lib/libsundials_cvodes.a"))))
     (->CompiledModel exe)))


Remove debug logging from (unify!).

Remove debug logging from (unify!).

--- src/cljs/c2/core.cljs
+++ src/cljs/c2/core.cljs
@@ -153,14 +153,14 @@
   [container data mapping & {:keys [selector key-fn post-fn update exit enter]
                              :or {key-fn (fn [d idx] idx)
                                   enter  (fn [d idx new-node]
-                                           (p "no-op enter called")
+                                           #_(p "no-op enter called")
                                            new-node)
                                   update (fn [d idx old-node new-node]
                                            (merge-dom old-node (cannonicalize new-node))
-                                           (p "no-op update called")
+                                           #_(p "no-op update called")
                                            nil)
                                   exit   (fn [d idx old-node]
-                                           (p "default remove called"))}}]
+                                           #_(p "default remove called"))}}]

   (let [container (select container)
         ;;This logic should be abstracted out via a (unify!) multimethod, once (apply multimethod) is fixed in ClojureScript


Disable the auto-login

Disable the auto-login

--- src/cljs/ji/main.cljs
+++ src/cljs/ji/main.cljs
@@ -182,7 +182,7 @@
 (defn ^:export init []
   (let [container (sel1 :#game)
         join-submit (chan)
-        game-id (dom/attr (sel1 :#game) "data-game-id")]
+        game-id (dom/attr container "data-game-id")]
     (clear! container)
     (dom/append! container (join-tmpl game-id))
     (dom/listen-once! (sel1 :form.join-game) :submit
@@ -198,10 +198,10 @@
             (if (msg/error? result)
               (show-alert! (:message result)))))))

-  (let [dict "abcdefghijklmnopqrstuvwxyz"
-        username (apply str (for [x (range 5)] (rand-nth dict)))]
-    (go (<! (timeout 50))
-        (dom/set-value! (sel1 "input[name='player-id']") username)
-        (<! (timeout 12))
-        (dom/fire! (sel1 "input[type=submit]") :click)))
+  ;(let [dict "abcdefghijklmnopqrstuvwxyz"
+        ;username (apply str (for [x (range 5)] (rand-nth dict)))]
+    ;(go (<! (timeout 50))
+        ;(dom/set-value! (sel1 "input[name='player-id']") username)
+        ;(<! (timeout 12))
+        ;(dom/fire! (sel1 "input[type=submit]") :click)))
   )


Remove unnecessary imports from clojure game template

--- src/clojure/leiningen/new/game_clojure/core.clj
+++ src/clojure/leiningen/new/game_clojure/core.clj
@@ -1,8 +1,5 @@
 (ns {{namespace}}
-  (:require [play-clj.core :refer :all])
-  (:import [com.badlogic.gdx.graphics Color]
-           [com.badlogic.gdx.graphics.g2d BitmapFont]
-           [com.badlogic.gdx.scenes.scene2d.ui Label Label$LabelStyle]))
+  (:require [play-clj.core :refer :all]))

 (defscreen main-screen
   :on-show
@@ -12,8 +9,7 @@
   :on-render
   (fn [screen entities]
     (clear!)
-    (draw! screen entities)
-    entities))
+    (draw! screen entities)))

 (defgame {{app-name}}
   :on-create


Reformat styles

Reformat styles

--- src/day8/re_frame/trace/styles.cljs
+++ src/day8/re_frame/trace/styles.cljs
@@ -90,7 +90,7 @@
              :-webkit-font-smoothing "inherit"
              :letter-spacing         "inherit"
              :background             "none"
-            #_ #_  :cursor                 "pointer"}]
+             #_#_:cursor "pointer"}]
    [:img {:max-width (percent 100)
           :height    "auto"
           :border    "0"}]
@@ -136,9 +136,9 @@

 (def re-frame-trace-styles
   [:#--re-frame-trace--
-   {:background-color  common/background-gray
-    :font-family common/font-stack
-    :color       text-color}
+   {:background-color common/background-gray
+    :font-family      common/font-stack
+    :color            text-color}

    [:.label label-mixin]

@@ -221,7 +221,7 @@
    [:.button {:padding       "5px 5px 3px"
               :margin        "5px"
               :border-radius "2px"
-            #_ #_   :cursor        "pointer"}]
+              #_#_:cursor "pointer"}]
    [:.text-button {:border-bottom "1px dotted #888"
                    :font-weight   "normal"}]

@@ -238,14 +238,15 @@
    [:.tab
     {:background     "transparent"
      :border-radius  0
-     :margin "10px 0 0 0"
+     :margin         "10px 0 0 0"
      :font-family    common/font-stack
      :padding-bottom "4px"
-     :vertical-align "bottom"}]
+     :vertical-align "bottom"
+     :cursor         "pointer"}]

    [:.tab.active
     {:background     "transparent"
-     :color common/blue-modern-color
+     :color          common/blue-modern-color
      :border-bottom  [[(px 3) "solid" common/blue-modern-color]]
      :border-radius  0
      :padding-bottom (px 1)}]
@@ -297,15 +298,17 @@
     {:display "flex"
      :flex    "0 0 auto"}]
    [:.nav {:background common/sidebar-background-color
-           :height (px 50)
+           :height     (px 50)
            :color      "white"}
-    [:span.arrow {:color common/blue-modern-color
+    [:span.arrow {:color            common/blue-modern-color ;; Should this be a button instead of a span?
                   :background-color common/standard-background-color
-                  :padding (px 5)}]
-    [:span.event-header {:color common/text-color
+                  :padding          (px 5)
+                  :cursor           "pointer"
+                  :user-select      "none"}]
+    [:span.event-header {:color            common/text-color
                          :background-color common/standard-background-color
-                         :padding (px 5)
-                         :font-weight "600"}]
+                         :padding          (px 5)
+                         :font-weight      "600"}]
     ]
    [(s/& :.external-window) {:display "flex"
                              :height  (percent 100)


Update docstrings of macros

Update docstrings of macros

--- src/clj/chocolatier/macros.clj
+++ src/clj/chocolatier/macros.clj
@@ -16,7 +16,11 @@

 ;; state is a list of keywords
 (defmacro defcomponent
-  "Creates a component with name state and methods"
+  "Creates a component with name state and any number of methods
+
+   Example:
+   (defcomponent Moveabe [:x :y]
+     (move [this] nil))"
   [vname state & methods]
   `(do
      ;; Create the protocol with methods
@@ -31,7 +35,8 @@

 (defmacro defentity
   "A collection of components that represent all aspects of what
-   the entity can do
+   the entity can do. Component fields must be unique across all
+   components included in the entity.

    Example:
    (defentitiy Player


prototype of class adding function

prototype of class adding function

--- src/clj_hypergraph_db/core.clj
+++ src/clj_hypergraph_db/core.clj
@@ -2,13 +2,24 @@
   (:import [org.hypergraphdb HGEnvironment])
   (:gen-class :main true))

-(def db (atom nil))
+
+(def database (atom nil))
+(def classes (atom {}))
+

 (defn create-database
   ""
   [path]
   (let [dbinstance (HGEnvironment/get path)]
-        (reset! db dbinstance)))
+        (reset! database dbinstance)))
+
+
+(defn generate-handler
+  ""
+  [attribs]
+  (.add @database attribs)
+  )
+

 (defn create-class
   "
@@ -18,15 +29,18 @@
   name - name of type
   attribs - fields of type
   "
-  [name &attribs]
-  (do
-    (defn fun
-      [&key-value-attrib-list]
-      (do
-        ; todo adding object to database?
-        (apply assoc (cons (apply hash-map attribs) (filter #(contains? attribs %1) key-value-attrib-list)))))
-    fun))
+  [name & attribs]
+  (reset! classes
+          (assoc @classes
+            name
+            {:handle (generate-handler attribs)
+            :create attribs})
+  )

+
+;'(name attribs)
+
+;(apply assoc (cons (apply hash-map attribs) (filter #(contains? attribs %1) (keys key-value-attrib-list))))

 (defn -main


right-align number fields in accounts show

--- src/clj_money/web/accounts.clj
+++ src/clj_money/web/accounts.clj
@@ -100,10 +100,10 @@
            account-id
            balance] :as item}]
   [:tr
-   [:td transaction-date]
+   [:td.text-right transaction-date]
    [:td description]
-   [:td polarized-amount]
-   [:td balance]
+   [:td.text-right polarized-amount]
+   [:td.text-right balance]
    [:td
     [:span.btn-group
      (glyph-button :pencil
@@ -134,10 +134,10 @@
         [:div.col-md-6
          [:table.table.table-striped.table-hover
           [:tr
-           [:th "Date"]
+           [:th.text-right "Date"]
            [:th "Description"]
-           [:th "Amount"]
-           [:th "Balance"]
+           [:th.text-right "Amount"]
+           [:th.text-right "Balance"]
            [:th " "]]
           (map transaction-item-row
                (transactions/items-by-account (env :db) id))]]]))))


Add `merge-index` function for parallel indexing

Conflicts:
	src/cljam/bam/reader.clj

--- src/cljam/bam_index/writer.clj
+++ src/cljam/bam_index/writer.clj
@@ -5,7 +5,8 @@
             [cljam.util :refer [gen-vec]]
             [cljam.util.sam-util :as sam-util]
             [cljam.util.bgzf-util :as bgzf-util]
-            [cljam.bam-index.common :refer :all])
+            [cljam.bam-index.common :refer :all]
+            [cljam.bam-index.chunk :as chunk])
   (:import [java.io DataOutputStream FileOutputStream Closeable]))

 (defn- find-ref
@@ -149,7 +150,7 @@
       :bin-index    (update-bin-index bin-index aln)
       :linear-index (update-linear-index linear-index aln))))

-(defn- make-index!
+(defn- make-index*
   [refs alns]
   (loop [[aln & rest] alns
          ref-name (:rname aln)
@@ -177,7 +178,7 @@
                                                     (:largest-seen (:linear-index idx-status)))}
                      :no-coordinate-alns no-coordinate-alns))))

-(defn- make-index
+(defn make-index
   [refs alns]
   (merge
    (zipmap (map :name refs)
@@ -187,7 +188,51 @@
                                 :unaligned-alns 0}
                          :bins {}
                          :lidx []}) refs))
-   (make-index! refs alns)))
+   (make-index* refs alns)))
+
+;;;
+;;; Merge indices
+;;;
+
+(defn- merge-meta
+  [meta1 meta2]
+  {:first-offset (min (:first-offset meta1) (:first-offset meta2))
+   :last-offset (max (:last-offset meta1) (:last-offset meta2))
+   :aligned-alns (+ (:aligned-alns meta1) (:aligned-alns meta2))
+   :unaligned-alns (+ (:unaligned-alns meta1) (:unaligned-alns meta2))})
+
+(defn- merge-chunks
+  [chunks1 chunks2]
+  (-> (concat chunks1 chunks2)
+      (chunk/optimize-chunks 0)))
+
+(defn- merge-bins
+  [bins1 bins2]
+  (let [bins->bin-map (fn [bins]
+                        (zipmap (map :bin bins)
+                                (map :chunks bins)))
+        bin-map1 (bins->bin-map bins1)
+        bin-map2 (bins->bin-map bins2)]
+    (-> (merge-with merge-chunks bin-map1 bin-map2)
+        (finish-bin-index))))
+
+(defn- merge-lidx
+  [lidx1 lidx2]
+  (concat lidx1 lidx2))
+
+(defn merge-index
+  [& indices]
+  (reduce (fn [idx1 idx2]
+            (let [no-coordinate-alns (+ (:no-coordinate-alns idx1) (:no-coordinate-alns idx2))
+                  idx1 (dissoc idx1 :no-coordinate-alns)
+                  idx2 (dissoc idx2 :no-coordinate-alns)]
+              (assoc (merge-with (fn [v1 v2]
+                                   {:meta (merge-meta (:meta v1) (:meta v2))
+                                    :bins (merge-bins (:bins v1) (:bins v2))
+                                    :lidx (merge-lidx (:lidx v1) (:lidx v2))})
+                                 idx1 idx2)
+                :no-coordinate-alns no-coordinate-alns)))
+          indices))

 ;;;
 ;;; Write index


Don't resize bottom panes when the window resizes

--- src/clojure/nightcode/core.clj
+++ src/clojure/nightcode/core.clj
@@ -117,12 +117,12 @@
           (s/top-bottom-split (get-project-pane console console-io)
                               (get-repl-pane process console console-io)
                               :divider-location 0.8
-                              :resize-weight 0.5))
+                              :resize-weight 1))
         (one-touch!
           (s/top-bottom-split (get-editor-pane)
                               (get-builder-pane)
                               :divider-location 0.8
-                              :resize-weight 0.5))
+                              :resize-weight 1))
         :divider-location 0.35
         :resize-weight 0))))


Fix exception handling

Fix exception handling

--- src/clojure/nightcode/core.clj
+++ src/clojure/nightcode/core.clj
@@ -140,12 +140,11 @@
 (defn enable-full-screen!
   "Enables full screen mode on OS X."
   [window]
-  (try
-    (some-> (Class/forName "com.apple.eawt.FullScreenUtilities")
-            (.getMethod "setWindowCanFullScreen"
-                        (into-array Class [Window Boolean/TYPE]))
-            (.invoke nil (object-array [window true])))
-    (catch Exception _)))
+  (some-> (try (Class/forName "com.apple.eawt.FullScreenUtilities")
+            (catch Throwable _))
+          (.getMethod "setWindowCanFullScreen"
+                      (into-array Class [Window Boolean/TYPE]))
+          (.invoke nil (object-array [window true]))))

 (defn create-window
   "Creates the main window."


Added :servlet-request key to request map

--- src/compojure/http/servlet.clj
+++ src/compojure/http/servlet.clj
@@ -72,7 +72,9 @@
    :content-type       (.getContentType request)
    :content-length     (get-content-length request)
    :character-encoding (.getCharacterEncoding request)
-   :body               (.getInputStream request)})
+   :body               (.getInputStream request)
+   ;; Custom non-Ring field:
+   :servlet-request    request})

 ;; Functions to set data in the response object


just copy everything from build/native/lib/ in copy-native instead of specifying :native-libs in project.clj. this way, we can get all the version sylinks which seem to be necessary for linux.

--- src/cake/tasks/compile.clj
+++ src/cake/tasks/compile.clj
@@ -62,19 +62,10 @@
           (compile lib))))
     (bake-restart)))

-(defn add-native-libs [task dir libs]
-  (doseq [lib libs]
-    (let [libname (System/mapLibraryName (str lib))
-          libfile (file dir libname)]
-      (if (.exists libfile)
-        (add-fileset task {:file libfile})
-        (when (= "macosx" (os-name))
-          (add-fileset task {:file (file dir (.replaceAll libname "\\.jnilib" ".dylib"))}))))))
-
 (defn copy-native []
   (when-let [libs (:native-libs *project*)]
     (ant Copy {:todir (format "native/%s/%s" (os-name) (os-arch))}
-         (add-native-libs "build/native/lib" libs))))
+         (add-fileset {:dir "build/native/lib"}))))

 (deftask compile #{deps compile-native}
   "Compile all clojure and java source files. Use 'cake compile force' to recompile."


import class before referring to it

import class before referring to it

--- src/calfpath/internal.cljc
+++ src/calfpath/internal.cljc
@@ -14,6 +14,7 @@
     [clojure.string :as string])
   #?(:clj (:import
             [java.util Map Map$Entry]
+            [clojure.lang Associative]
             [calfpath Util])))

@@ -31,7 +32,7 @@
   "Direct assoc"
   [a k v]
   #?(:cljs (assoc a k v)
-     :clj (.assoc ^clojure.lang.Associative a k v)))
+      :clj (.assoc ^clojure.lang.Associative a k v)))

 (defn parse-uri-template