Resolves provide-skin issues

Resolves provide-skin issues

--- src/lt/objs/style.cljs
+++ src/lt/objs/style.cljs
@@ -10,7 +10,8 @@
             [lt.objs.files :as files]
             [lt.objs.deploy :as deploy]
             [lt.util.dom :as dom]
-            [crate.binding :refer [bound subatom]])
+            [lt.util.load :as load]
+            [crate.binding :refer [bound -value subatom]])
   (:require-macros [lt.macros :refer [behavior defui]]))

 (defn css-expr [k v]
@@ -28,19 +29,16 @@
             (when (:font-size settings)
               (css-expr :font-size (str (:font-size settings) "pt")))))

-(defui skin-style [this]
-  [:link {:rel "stylesheet"
-          :type "text/css"
-          :id "skin-style"
-          :href (bound (subatom this [:skin])
-                       #(-> (object/raise-reduce app/app :skins+ {})
-                            (get % "/core/css/skins/dark.css")
-                            (plugins/adjust-path)))}])
+(defn load-skin [skin]
+  (let [skins (object/raise-reduce app/app :skins+ {})
+        path (get skins skin (plugins/adjust-path "css/skins/new-dark.css"))]
+    (load/css path)))

 (object/object* ::styles
                 :init (fn [this]
                         [:div
-                         (skin-style this)
+                         (bound (subatom this :skin)
+                                load-skin)
                          [:style {:type "text/css"}
                           (bound this ->css)
                           ]]))
@@ -84,7 +82,7 @@
                   :type :user
                   :params [{:label "name"} {:label "path"}]
                   :reaction (fn [this skins name path]
-                              (assoc skins name path)
+                              (assoc skins name (plugins/adjust-path path))
                               ))

 (defn get-skins []


Make test results parse errors box red

Make test results parse errors box red

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -484,9 +484,9 @@
             [:div.loading-spinner common/spinner]
             (list
              (when (> (count exceptions) 0)
-               [:div.alert.iconified {:class "alert-info" }
+               [:div.alert.iconified {:class "alert-danger" }
                 [:div [:img.alert-icon {:src (common/icon-path
-                                              (if build-succeeded? "Info-Info" "Info-Error"))}]]
+                                              "Info-Error")}]]
                 (om/build parse-errors exceptions)])
              (cond
                (seq failed-sources) (om/build-all build-tests-source-block failed-sources)


TaggedImage poison

TaggedImage poison

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -21,7 +21,7 @@
         [org.micromanager.sequence-generator :only [generate-acq-sequence]])
   (:import [org.micromanager AcqControlDlg]
            [org.micromanager.api AcquisitionEngine]
-           [org.micromanager.acquisition AcquisitionWrapperEngine LiveAcqDisplay]
+           [org.micromanager.acquisition AcquisitionWrapperEngine LiveAcqDisplay TaggedImageQueue]
            [org.micromanager.acquisition.engine SequenceSettings]
            [org.micromanager.navigation MultiStagePosition StagePosition]
            [mmcorej TaggedImage Configuration]
@@ -304,6 +304,7 @@
 			 (def acq-sequence acq-seq)
 			 (def last-state state)
 			 (execute (mapcat #(make-event-fns % out-queue) acq-seq))
+			 (.put out-queue TaggedImageQueue/POISON)
 			 (cleanup)
 			 )))

@@ -337,6 +338,7 @@
   [[] (atom {:running false :stop false})])

 (defn -run [this settings acq-eng]
+  (def last-acq this)
   (load-mm)
   (create-device-agents)
 	(let [out-queue (GentleLinkedBlockingQueue.)


Clean up buffer / spacing

Clean up buffer / spacing

--- src/clj/collect_earth_online/generators/clj_point.clj
+++ src/clj/collect_earth_online/generators/clj_point.clj
@@ -41,15 +41,15 @@
         y-steps   (Math/floor (/ y-range spacing))
         x-padding (/ (- x-range (* x-steps spacing)) 2.0)
         y-padding (/ (- y-range (* y-steps spacing)) 2.0)]
-    (for [x (range (+ 1 x-steps))
-          y (range (+ 1 y-steps))]
+    (for [x (range (inc x-steps))
+          y (range (inc y-steps))]
       [(+ (* x spacing) left x-padding) (+ (* y spacing) bottom y-padding)])))

 (defn- create-gridded-plots-in-bounds [left bottom right top spacing]
   (->> (get-all-gridded-points left bottom right top spacing)
        (map EPSG:3857->4326)))

-(defn- create-gridded-sample-set [circle? radius buffer sample-resolution center-x center-y]
+(defn- create-gridded-sample-set [circle? center-x center-y radius buffer sample-resolution]
   (let [[left bottom right top] (pad-bounds (- center-x radius)
                                             (- center-y radius)
                                             (+ center-x radius)
@@ -69,9 +69,8 @@
         theta (* (Math/random) 2 Math/PI)]
     [(+ center-x (* r (Math/cos theta))) (+ center-y (* r (Math/sin theta)))]))

-(defn- gen-random-points [num-plots buffer & opts]
-  (let [{:keys [left bottom right top center-x center-y radius circle?]} opts
-        max-iterations (* 2 num-plots)]
+(defn- gen-random-points [num-plots spacing point-gen-fn]
+  (let [max-iterations (* 2 num-plots)]
     (loop [points     []
            iterations 0]
       (cond
@@ -82,13 +81,11 @@
         (init-throw "Unable to generate random plots.  Try a lower number of plots, smaller plot size, or bigger area.")

         :else
-        (let [test-point (if circle?
-                           (random-point-in-circle center-x center-y radius)
-                           (random-point-in-bounds left bottom right top))]
+        (let [test-point (point-gen-fn)]
           (recur (if (some (fn [[x1 y1]]
                              (let [[x2 y2] test-point
                                    dist (distance x1 y1 x2 y2)]
-                               (< dist buffer)))
+                               (< dist spacing)))
                            points)
                    points
                    (conj points test-point))
@@ -97,24 +94,21 @@
 (defn- create-random-plots-in-bounds [left bottom right top plot-size num-plots]
   (->> (gen-random-points num-plots
                           (* 2.0 plot-size)
-                          :left left
-                          :bottom bottom
-                          :right right
-                          :top top)
+                          #(random-point-in-bounds left bottom right top))
        (map EPSG:3857->4326)))

-(defn- create-random-sample-set [circle? radius buffer samples-per-plot center-x center-y]
-  (->> (gen-random-points samples-per-plot
-                          buffer
-                          :circle? circle?
-                          :left (- center-x radius)
-                          :bottom (- center-y radius)
-                          :right (+ center-x radius)
-                          :top (+ center-y radius)
-                          :center-x center-x
-                          :center-y center-y
-                          :radius (- radius buffer))
-       (map EPSG:3857->4326)))
+(defn- create-random-sample-set [circle? center-x center-y radius spacing samples-per-plot]
+  (let [[left bottom right top] (pad-bounds (- center-x radius)
+                                            (- center-y radius)
+                                            (+ center-x radius)
+                                            (+ center-y radius)
+                                            spacing)] ; Add buffer = spacing
+    (->> (gen-random-points samples-per-plot
+                            spacing
+                            (if circle?
+                              #(random-point-in-circle center-x center-y (- radius spacing)) ; Add buffer = spacing
+                              #(random-point-in-bounds left bottom right top)))
+         (map EPSG:3857->4326))))

 (defn generate-point-samples [plots
                               plot-count
@@ -131,11 +125,11 @@
         samples-per-plot (case sample-distribution
                            "gridded" (count (create-gridded-sample-set
                                              circle?
+                                             45
+                                             45
                                              radius
                                              buffer
-                                             sample-resolution
-                                             45
-                                             45))
+                                             sample-resolution))
                            "random"  samples-per-plot
                            "center"  1.0
                            "none"    1.0)]
@@ -156,11 +150,11 @@
                                center?
                                [[lon lat]]

+                               (= "gridded" sample-distribution)
+                               (create-gridded-sample-set circle? center-x center-y radius buffer sample-resolution)
+
                                (= "random" sample-distribution)
-                               (create-random-sample-set circle? radius buffer samples-per-plot center-x center-y)
-
-                               (= "gridded" sample-distribution)
-                               (create-gridded-sample-set circle? radius buffer sample-resolution center-x center-y)
+                               (create-random-sample-set circle? center-x center-y radius buffer samples-per-plot)

                                :else []))))
             plots)))
@@ -177,7 +171,7 @@
   (let [[[left bottom] [right top]] (EPSG:4326->3857 [lon-min lat-min] [lon-max lat-max])
         [left bottom right top]     (pad-bounds left bottom right top (/ plot-size 2.0))]
     (check-plot-limits (if (= "gridded" plot-distribution)
-                         (count-gridded-points left bottom right top (* 2.0 plot-size))
+                         (count-gridded-points left bottom right top plot-spacing)
                          num-plots)
                        5000.0)
     (map-indexed (fn [idx [lon lat]]


Add write-time

Add write-time

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -111,10 +111,15 @@
 ;; Columns
 ;;

+(defn write-time
+  [column]
+  (fn writetime-query [query-builder]
+    (.writeTime query-builder (name column))))
+
 (defn ttl
   [column]
   (fn ttl-query [query-builder]
-    (.ttl query-builder column)))
+    (.ttl query-builder (name column))))

 (defn distinct*
   [column]
@@ -219,11 +224,8 @@
 ;; Truncate truncate(String keyspace, String table)
 ;; Truncate truncate(TableMetadata table)
 ;; String quote(String columnName)
-
 ;; Using timestamp(long timestamp)
 ;; Using timestamp(BindMarker marker)
-;; Using ttl(int ttl)
-;; Using ttl(BindMarker marker)
 ;; Assignment set(String name, Object value)
 ;; Assignment incr(String name)
 ;; Assignment incr(String name, long value)


Implement ordering, limit and filtering

Implement ordering, limit and filtering

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -97,26 +97,26 @@

 (defn asc
   [^String column-name]
-  (QueryBuilder/asc column-name))
+  (QueryBuilder/asc (name column-name)))

 (defn desc
   [^String column-name]
   (QueryBuilder/desc column-name))

 (defn order-by
-  [& orderings]
-  [3 (fn order-by-query [^Select query-builder]
-       (.orderBy query-builder orderings))])
+  [orderings]
+  [2 (fn order-by-query [^Select query-builder]
+       (.orderBy query-builder (into-array orderings)))])

 (defn limit
-  [m]
-  [3 (fn order-by-query [^Select  query-builder]
-       )])
+  [lim]
+  [2 (fn order-by-query [^Select  query-builder]
+       (.limit query-builder (int lim)))])

 (defn allow-filtering
-  [m]
-  [3 (fn order-by-query [^Select  query-builder]
-       )])
+  []
+  [2 (fn order-by-query [^Select  query-builder]
+       (.allowFiltering query-builder))])
    ;; public Select orderBy(Ordering... orderings) {
    ;;  public Select limit(int limit) {
    ;;  public Select limit(BindMarker marker) {
@@ -129,7 +129,7 @@
        ;; (map println)
        (map second)
        (reduce (fn [builder statement]
-                 ;; (println builder statement)
+                 (println builder statement)
                  (statement builder))
                (QueryBuilder/select)
                )


Recognize both User ports on Windows.

Recognize both User ports on Windows.

--- src/afterglow/controllers/ableton_push_2.clj
+++ src/afterglow/controllers/ableton_push_2.clj
@@ -2862,7 +2862,7 @@
   differently on your operating system, you may need to change
   this (and please open a Pull Request); this filter seems to work for
   Mac OS X and Windows."
-  #".*(User|MIDIIN2).*")
+  #".*(User|MIDI(IN|OUT)2).*")

 (defn- recognize
   "Returns the controller's device ID if `message` is a response


Support touch strip for BPM changes.

Support touch strip for BPM changes.

--- src/afterglow/controllers/ableton_push_2.clj
+++ src/afterglow/controllers/ableton_push_2.clj
@@ -821,6 +821,7 @@
     (let [graphics (create-graphics controller)
           bpm (double (:bpm snapshot))
           bpm-string (format "%.1f" bpm)
+          bpm-range (- controllers/maximum-bpm controllers/minimum-bpm)
           label (java.text.AttributedString. bpm-string)]
       (set-graphics-color graphics metronome-background)
       (.fillRect graphics button-cell-width 21 button-cell-width 20)
@@ -832,7 +833,9 @@
                        (dec (count bpm-string)) (count bpm-string)))
       (draw-attributed-variable-value controller 1 1 label metronome-content)
       (draw-gauge controller 1 1 bpm :lowest controllers/minimum-bpm :highest controllers/maximum-bpm
-                  :track-color metronome-content :active-color white-color))
+                  :track-color metronome-content :active-color white-color)
+      (reset! (:next-touch-strip controller) [(math/round (* 16383 (/ (- bpm controllers/minimum-bpm) bpm-range)))
+                                              touch-strip-mode-level]))

     ;; Display the sync mode in red to explain why we are not adjusting it.
     (let [graphics (create-graphics controller)]
@@ -883,7 +886,15 @@
                      ;; They released us, end the overlay.
                      :done))
                  (handle-aftertouch [this message])
-                 (handle-pitch-bend [this message]))))
+                 (handle-pitch-bend [this message]
+                   (let [full-range (- controllers/maximum-bpm controllers/minimum-bpm)
+                         fraction (/ (+ (* (:data2 message) 128) (:data1 message)) 16383)
+                         adjusted (double (+ controllers/minimum-bpm (* fraction full-range)))
+                         resolution 0.1
+                         normalized (double (* (Math/round (/ adjusted resolution)) resolution))]
+                     (with-show (:show controller)
+                       (when (= (:type (show/sync-status)) :manual)
+                         (rhythm/metro-bpm (:metronome (:show controller)) normalized))))))))

 (defn- beat-adjusting-interface
   "Brighten the section of the beat which is being adjusted."
@@ -2101,8 +2112,7 @@
   "Handle a pitch bend change while an encoder associated with a
   variable is being adjusted in the effect list."
   [controller message cue v effect-id]
-  (let [value (or (cues/get-cue-variable cue v :show (:show controller) :when-id effect-id) 0)
-        full-range (- (:max v) (:min v))
+  (let [full-range (- (:max v) (:min v))
         fraction (/ (+ (* (:data2 message) 128) (:data1 message)) 16383)
         adjusted (double (+ (:min v) (* fraction full-range)))
         raw-resolution (/ full-range 200)


added some test.check tests

added some test.check tests

--- test/complex/root_test.cljc
+++ test/complex/root_test.cljc
@@ -19,42 +19,6 @@
   (in-ns 'complex.root-test)
   )

-;; lets generate some random roots
-(def gen-root-base (gen/tuple (gen/return :root) gen/pos-int))
-
-(def gen-root-base-mult (gen/tuple (gen/return :root) gen/pos-int gen/ratio))
-
-(def gen-root (gen/one-of [gen-root-base gen-root-base-mult]))
-
-(def gen-non-zero-root
-  (gen/such-that #(not (r/my-zero? %)) gen-root))
-
-(def root-property
-  (prop/for-all [r gen-root]
-                (r/root-number? r)))
-
-(comment
-  (tc/quick-check 1000 root-property)
-  ;;=> {:result true, :num-tests 1000, :seed 1439589243655}
-  )
-
-(def additive-inverse-prop
-  (prop/for-all [r gen-root]
-                (r/my-zero? (r/add-root r (r/minus r)))))
-
-(def multiplicative-inverse-prop
-  (prop/for-all [r gen-non-zero-root]
-                (r/one? (r/mult-root r (r/invert-root r)))))
-
-(comment
-  (tc/quick-check 1000 additive-inverse-prop)
-  ;;=> {:result true, :num-tests 1000, :seed 1439621296097}
-
-  (tc/quick-check 1000 multiplicative-inverse-prop)
-  ;;=> {:result true, :num-tests 1000, :seed 1439622599384}
-
-  )
-
 (deftest is-zero
   (testing "zero values"
     (is (r/my-zero? 0))
@@ -73,3 +37,35 @@
     (is (r/one? [:number 1 [:root 0]]))
     (is (r/one? (r/collect-terms [:number 1 [:root 2] [:root 2 -1]])))
     (is (r/one? [:rect 1 0]))))
+
+;; lets generate some random roots
+(def gen-root-base (gen/tuple (gen/return :root) gen/pos-int))
+
+(def gen-root-base-mult (gen/tuple (gen/return :root) gen/pos-int gen/ratio))
+
+(def gen-root (gen/one-of [gen-root-base gen-root-base-mult]))
+
+(def gen-non-zero-root
+  (gen/such-that #(not (r/my-zero? %)) gen-root))
+
+(def root-property
+  (prop/for-all [r gen-root]
+                (r/root-number? r)))
+
+(def additive-inverse-prop
+  (prop/for-all [r gen-root]
+                (r/my-zero? (r/add-root r (r/minus r)))))
+
+(def multiplicative-inverse-prop
+  (prop/for-all [r gen-non-zero-root]
+                (r/one? (r/mult-root r (r/invert-root r)))))
+
+(defspec is-root root-property)
+(defspec additive-inverse additive-inverse-prop)
+(defspec multiplicative-inverse multiplicative-inverse-prop)
+
+(comment
+  (tc/quick-check 1000 root-property)
+  (tc/quick-check 1000 additive-inverse-prop)
+  (tc/quick-check 1000 multiplicative-inverse-prop)
+  )


Refactor module generator

Refactor module generator

--- test/cortex/module_test.clj
+++ test/cortex/module_test.clj
@@ -15,9 +15,10 @@
                   (gen/return (layers/logistic [3]))])

-(defspec test-module-parameter-lengths
-         100
-         (prop/for-all [m (gen/one-of MODULE-GENS)]
+(def MODULE-GEN (gen/one-of MODULE-GENS))
+
+(defspec test-module-parameter-lengths 100
+         (prop/for-all [m MODULE-GEN]
            (let [params (parameters m)
                  grad (gradient m)]
              (= (m/ecount params) (m/ecount grad) (parameter-count m)))))


Stack answers for free text

Stack answers for free text

--- src/clj/collect_earth_online/db/projects.clj
+++ src/clj/collect_earth_online/db/projects.clj
@@ -764,21 +764,29 @@
                  answers))
           survey-questions))

-(defn- count-answer [sample-size question-answers]
-  (u/mapm (fn [[question answers]]
-            [question (* 100.0 (count answers) (/ sample-size))])
-          (group-by str question-answers)))
-
 (defn- get-value-distribution
   "Count the answers given, and return a map of {'question:answers' count}"
   [survey-questions samples]
-  (count-answer (count samples)
-                (mapcat (fn [sample]
-                          (map (fn [[question-id {:keys [answerId]}]]
-                                 (let [{:keys [question answers]} (get survey-questions question-id)]
-                                   (str question ":" (get-in answers [(str answerId) :answer]))))
-                               (:saved_answers sample)))
-                        samples)))
+  (let [inverse-samples (/ (count samples))]
+    (->> samples
+         ;; Flatten answers from multiple samples into a single sequence.
+         (mapcat (fn [sample]
+                   (map (fn [[question-id {:keys [answerId answer]}]]
+                          {:question-id question-id
+                           :answer-id answerId
+                           :answer-text answer})
+                        (:saved_answers sample))))
+         (group-by (juxt :question-id :answer-id))
+         ;; Count number of answers in each group, or join free text answers.
+         (u/mapm (fn [[[question-id answer-id] answer-group]]
+                   (let [{:keys [question answers componentType]} (get survey-questions question-id)]
+                     [(str question ":" (get-in answers [(str answer-id) :answer]))
+                      (if (= "input" componentType)
+                        (->> answer-group
+                             (map :answer-text)
+                             (distinct)
+                             (str/join "\n"))
+                        (format "%.2f" (* 100.0 (count answer-group) inverse-samples)))]))))))

 (def plot-base-headers [:plotid
                         :center_lon


Don't need pin implementation stuff for bbb

--- src/clj_bots/pin_ctrl_bbb/implementation.clj
+++ src/clj_bots/pin_ctrl_bbb/implementation.clj
@@ -4,9 +4,6 @@
              [protocols :as pcp]
              [implementation :as impl]]
             [clojure.java.io :as io]))
-
-
-(declare new-pin)

 (defrecord Board [pin-mapping config]
@@ -36,10 +33,6 @@
   (Board. (get-pin-mappings) config))

-;(defrecord BBBPin
-  ;[board oin-n mode]
-  ;(
-
 (def implementation
   (reify
     Object


add not-yet-functional edit button to elections list table

--- src/cljs/early_vote_site/election/views.cljs
+++ src/cljs/early_vote_site/election/views.cljs
@@ -55,7 +55,9 @@
   [election]
   [:tr {:key (:id election)}
    [:td {:name "election-state"} (-> election :state-fips format-fips)]
-   [:td {:name "election-date"} (-> election :election-date format-date)]])
+   [:td {:name "election-date"} (-> election :election-date format-date)]
+   [:td
+    [:button.button "edit"]]])

 (defn election-table []
   (let [election-list-items @(re-frame/subscribe [:elections/list])]


fix am/pm in time widgets

fix am/pm in time widgets

--- src/cljs/re_form/inputs/date_input_impl.cljs
+++ src/cljs/re_form/inputs/date_input_impl.cljs
@@ -284,7 +284,10 @@
   (when x
     (if (= fmt "12h")
       (when-let [[_ hp mp noonp] (re-matches #"(\d?\d):(\d\d) (\wM)" (str/upper-case x))]
-        (let [h (+ (js/parseInt hp) (if (= noonp "PM") 12 0))
+        (let [h (as-> hp $
+                  (js/parseInt $)
+                  (if (= $ 12) 0 $)
+                  (+ $ (if (= noonp "PM") 12 0)))
               m (js/parseInt mp)]
           (when (and (< h 24) (< m 60) (some #(= % noonp) ["AM" "PM"]))
             (str (gstring/format "%02d" h) ":" (gstring/format "%02d" m)))))
@@ -296,7 +299,10 @@
   (when-let [x (str/join (take 5 inp-x))]
     (if (= fmt "12h")
       (when-let [[_ hp m] (re-matches #"(\d\d):(\d\d)" x)]
-        (let [[h noon] (if (> hp 12) [(- hp 12) "PM"] [hp "AM"])]
+        (let [hp (js/parseInt hp)
+              m (js/parseInt m)
+              [h noon] (if (>= hp 12) [(- hp 12) "PM"] [hp "AM"])
+              h (if (= 0 h) 12 h)]
           (str (gstring/format "%02d" h) ":" (gstring/format "%02d" m) " " noon)))
       x)))


Decode image as bitmap.

Decode image as bitmap.

--- src/clojure/com/dankee/camera_spike/main.clj
+++ src/clojure/com/dankee/camera_spike/main.clj
@@ -4,10 +4,16 @@
         [neko.ui :only [make-ui]])
   (:require [com.dankee.camera_spike.saving-media :refer [get-output-image-uri]])
   (:import [android.app Activity]
+           [android.graphics BitmapFactory]
            [android.provider MediaStore]
+           [android.util Log]
            [android.widget Toast]) )

 (def capture-image-activity-request-code 100)
+
+(defn debug-tap [label object]
+  (Log/d "Camera Spike" (str label ": " object))
+  object )

 (defn show-toast [activity text]
   (.show (Toast/makeText activity text Toast/LENGTH_LONG)) )
@@ -32,7 +38,13 @@

       (if (= request-code capture-image-activity-request-code)
         (condp = result-code
-          Activity/RESULT_OK       (show-toast activity (str "Image saved to:\n" (.toString @file-uri)))
+
+          Activity/RESULT_OK
+          (let [bitmap (BitmapFactory/decodeFile (.getPath @file-uri))
+                width (.getWidth bitmap)
+                height (.getHeight bitmap) ]
+            (show-toast activity (str width " x " height " image saved.")) )
+
           Activity/RESULT_CANCELED (show-toast activity "Cancelled :-(")
           (show-toast activity "Failure! >:-(") ) ) ) ) )


with-check now accepts custom error function.

--- src/clojure/uncomplicate/clojurecl/utils.clj
+++ src/clojure/uncomplicate/clojurecl/utils.clj
@@ -80,8 +80,8 @@
   with richer, user-friendly information.

   Accepts a long `err-code` that should be one of the codes defined in
-  OpenCL standard, and an optional `details` argument that could be anything that you
-  think is informative.
+  OpenCL standard, and an optional `details` argument that could be
+  anything that you think is informative.

   See the available codes in the source of [[constants/dec-error]].
   Also see the discussion about
@@ -109,10 +109,12 @@

       (with-check (some-jocl-call-that-returns-error-code) result)
   "
-  [err-code form]
-  `(if (= 0 ~err-code)
-     ~form
-     (throw (error ~err-code))))
+  ([error-fn err-code form]
+   `(if (= 0 ~err-code)
+      ~form
+      (throw (~error-fn ~err-code ~(pr-str form)))))
+  ([err-code form]
+   `(with-check error ~err-code ~form)))

 (defmacro with-check-arr
   "Evaluates `form` if the integer in the `err-code` primitive int array is `0`,


sample page for when request is pending

sample page for when request is pending

--- src/pc/http/routes.clj
+++ src/pc/http/routes.clj
@@ -66,10 +66,19 @@

             (and (auth/logged-in? req)
                  (:team req)
+                 (not (auth/has-team-permission? db (:team req) (:auth req) :admin))
+                 (seq (access-request-model/find-by-team-and-cust (pcd/default-db) (:team req) (get-in req [:auth :cust]))))
+
+            {:status 200
+             :body "Thanks for requesting access, we'll send you an email when your request is granted."}
+
+            (and (auth/logged-in? req)
+                 (:team req)
                  (not (auth/has-team-permission? db (:team req) (:auth req) :admin)))

             {:status 200
-             :body (hiccup.page/html5 {}
+             :body (hiccup.page/html5
+                    {}
                     [:html
                      [:body
                       [:form {:action "/request-team-permission" :method "post"}


Straighten out pepa.processor a bit

Straighten out pepa.processor a bit

--- src/pepa/processor.clj
+++ src/pepa/processor.clj
@@ -3,36 +3,40 @@
             [pepa.db :as db]
             [pepa.bus :as bus]))

-(defrecord Processor [control-chan notify-topic worker])
+(defrecord Processor [notify-topic notify-chan control-chan worker])

 (defprotocol IProcessor
   (next-item [this])
   (process-item [this item]))

-(defn ^:private next-item* [component topic]
+(defn ^:private next-item* [component processor]
   (db/with-transaction [db (:db component)]
-    (db/advisory-xact-lock! db topic)
+    (db/advisory-xact-lock! db (:notify-topic processor))
     (db/query db (next-item component) :result-set-fn first)))

+(defn ^:private process-next [component processor]
+  (let [{:keys [notify-chan control-chan]} processor]
+    (if-let [item (next-item* component processor)]
+      (do (process-item component item)
+          (async/alts!! [control-chan] :default :continue))
+      (async/alts!! [notify-chan control-chan]))))
+
 (defn start [component notify-topic]
-  (let [control-chan (async/chan)
-        notify-chan (bus/subscribe (:bus component) notify-topic (async/sliding-buffer 1))
-        ;; TODO: Turn into a thread-pool?
+  (let [notify-chan (bus/subscribe (:bus component) notify-topic (async/sliding-buffer 1))
+        control-chan (async/chan)
+        processor (->Processor notify-topic notify-chan control-chan nil)
         worker (async/thread
                  (loop []
-                   (let [action (if-let [item (next-item* component notify-topic)]
-                                  (do (process-item component item)
-                                      (async/alts!! [control-chan] :default :continue))
-                                  (async/alts!! [notify-chan control-chan]))]
-                     (case (first action)
-                       (:stop nil) :done
-                       (recur)))))]
-    (->Processor control-chan notify-chan worker)))
+                   (case (first (process-next component processor))
+                     (:stop nil) :done
+                     (recur))))]
+    (assoc processor
+           :worker worker)))

 (defn stop [processor]
   (let [{:keys [notify-chan control-chan worker]} processor]
+    (when notify-chan
+      (async/close! notify-chan))
     (when control-chan
       (async/close! control-chan))
-    (when notify-chan
-      (async/close! notify-chan))
     (<!! worker)))


First interactive version of concept approximation exploration

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

--- src/conexp/contrib/concept_approximation.clj
+++ src/conexp/contrib/concept_approximation.clj
@@ -13,21 +13,47 @@

 ;;;

+(defn- apprx-handler
+  "Special handler for concept approximation exploration."
+  [ctx new-impl new-objs new-handler]
+  (let [[result new-col] (default-handler ctx new-impl)]
+    (if result
+      [result new-col]
+      (let [new-att  (first new-col),
+            att-objs (ask (str "Which of the objs " new-objs " definitively has the attribute " new-att "? ")
+                          #(read-string (str "#{" (read-line) "}"))
+                          #(subset? % new-objs)
+                          "Please only enter objects mentioned.")]
+        (new-handler (map #(vector % new-att) att-objs))
+        [result new-col]))))
+
 (defn explore-approximations
   "Performs concept approximation exploration and returns the final
   context."
   [context]
-  (let [att-explored-ctx (:context (explore-attributes context)),
+  (let [_                (println "Starting attribute exploration")
+        att-explored-ctx (:context (explore-attributes context)),
+
+        _                (println "Starting object exploration")
+        new-objects      (difference (objects att-explored-ctx)
+                                     (objects context)),
+        known-crosses    (atom #{}),
+        handler          (fn [ctx impl]
+                           (apprx-handler ctx impl new-objects
+                                          #(swap! known-crosses into %))),
         obj-explored-ctx (dual-context
                           (:context (explore-attributes
-                                     (dual-context context))))]
+                                     (dual-context context)
+                                     #{}
+                                     handler)))]
     (context-subposition
      (context-apposition context obj-explored-ctx)
      (context-apposition att-explored-ctx
                          (smallest-bond att-explored-ctx
                                         obj-explored-ctx
                                         (union (incidence att-explored-ctx)
-                                               (incidence obj-explored-ctx)))))))
+                                               (incidence obj-explored-ctx)
+                                               @known-crosses))))))

 ;;;


Refactor

Refactor

--- backend/src/akvo/lumen/component/keycloak.clj
+++ backend/src/akvo/lumen/component/keycloak.clj
@@ -34,10 +34,10 @@
    (let [params (merge {:grant_type "client_credentials"}
                        credentials)
          resp (client/post (get openid-config "token_endpoint")
-                           {:form-params params})
-         access-token (-> resp :body json/decode (get "access_token"))]
-     {"Authorization" (str "bearer " access-token)
-      "Content-Type" "application/json"}))
+                           {:form-params params})]
+     (when-let [access-token (-> resp :body json/decode (get "access_token"))]
+       {"Authorization" (str "bearer " access-token)
+        "Content-Type" "application/json"})))
   ([{:keys [openid-config credentials connection-manager]}
     {:keys [timeout] :as req-opts}]
    (let [params (merge {:grant_type "client_credentials"}
@@ -46,10 +46,10 @@
          req-opts (-> req-opts
                       (select-keys [:timeout])
                       (assoc :form-params params))]
-     (when-some [access-token (-> (client/post url (assoc req-opts :connection-manager connection-manager))
-                                :body
-                                json/decode
-                                (get "access_token"))]
+     (when-let [access-token (-> (client/post url (assoc req-opts :connection-manager connection-manager))
+                                 :body
+                                 json/decode
+                                 (get "access_token"))]
        {"Authorization" (str "bearer " access-token)
         "Content-Type" "application/json"}))))

@@ -258,11 +258,11 @@

 (defn- lookup-user-id
   "Lookup email -> Keycloak user-id, via cached Keycloak API."
-  [connection-manager req-opts api-root user-id-cache email]
+  [req-opts api-root user-id-cache email]
   (if-some [user-id (get-user-id user-id-cache email)]
     user-id
     (let [url (format "%s/users/?email=%s" api-root email)]
-      (let [users (-> (client/get url (assoc req-opts :connection-manager connection-manager)) :body json/decode)]
+      (let [users (-> (client/get url req-opts) :body json/decode)]
         (when-some [user-id (active-user users email)]
           (-> user-id-cache
               (swap! assoc email user-id)
@@ -279,16 +279,15 @@
   ([{:keys [api-root http-timeout user-id-cache connection-manager] :as keycloak} email
     {:keys [timeout] :or {timeout http-timeout}}]
    (let [bare-req-opts {:timeout timeout}]
-     (when-some [headers (request-headers keycloak bare-req-opts)]
-       (let [req-opts (assoc bare-req-opts :headers headers)]
-         (when-let [user-id (lookup-user-id connection-manager req-opts api-root user-id-cache email)]
-           (when-let [allowed-paths
-                    (-> (client/get (format "%s/users/%s/groups" api-root user-id)
-                                    (assoc req-opts :connection-manager connection-manager)) :body json/decode)]
-             (reduce (fn [paths {:strs [path]}]
-                       (conj paths (subs path 12)))
-                     #{}
-                     allowed-paths))))))))
+     (when-let [headers (request-headers keycloak bare-req-opts)]
+       (let [req-opts (assoc bare-req-opts :headers headers :connection-manager connection-manager)]
+         (when-let [user-id (lookup-user-id req-opts api-root user-id-cache email)]
+           (->> (client/get (format "%s/users/%s/groups" api-root user-id) req-opts )
+                :body
+                json/decode
+                (reduce (fn [paths {:strs [path]}]
+                          (conj paths (subs path 12)))
+                        #{}))))))))

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


Add a TODO

Add a TODO

--- src/qu/query/where.clj
+++ src/qu/query/where.clj
@@ -93,8 +93,9 @@
    (has-key? ast :not)
    (mongo-eval-not (:not ast))

+   ;; TODO explain this nonsense
    (has-key? ast :op)
-   (let [{:keys [op left right]} ast
+   (let [{:keys [op left right]} ast
          operand-eval (fn operand-eval [operand]
                         (if (= op (:op operand))
                           (mapcat operand-eval ((juxt :left :right) operand))


Make sure setter can override values in Reaction

Also assert that cursor src isn't a vector.

And a little cleanup.

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -137,7 +137,7 @@

   IPrintWithWriter
   (-pr-writer [a writer opts]
-    (-write writer "#<Cursor: ")
+    (-write writer (str "#<Cursor: " path " "))
     (pr-writer (._peek a) writer opts)
     (-write writer ">"))

@@ -163,8 +163,9 @@
       (RCursor. path src nil))
     (do
       (assert (or (satisfies? IDeref src)
-                  (ifn? src))
-              "src must be an atom or a function")
+                  (and (ifn? src)
+                       (not (vector? src))))
+              (str "src must be an atom or a function, not " src))
       (RCursor. src path nil))))

 (defprotocol IDisposable
@@ -176,12 +177,6 @@
 (defprotocol IComputedImpl
   (-update-watching [this derefed])
   (-handle-change [k sender oldval newval]))
-
-(defn- call-watches [obs watches oldval newval]
-  (reduce-kv (fn [_ key f]
-               (f key obs oldval newval)
-               nil)
-             nil watches))

 (deftype Reaction [f ^:mutable state ^:mutable dirty? ^:mutable active?
                    ^:mutable watching ^:mutable watches
@@ -190,9 +185,10 @@

   IWatchable
   (-notify-watches [this oldval newval]
-    (when on-set
-      (on-set oldval newval))
-    (call-watches this watches oldval newval))
+    (reduce-kv (fn [_ key f]
+                 (f key this oldval newval)
+                 nil)
+               nil watches))

   (-add-watch [this k wf]
     (set! watches (assoc watches k wf)))
@@ -203,11 +199,14 @@
       (dispose! this)))

   IReset
-  (-reset! [a new-value]
-    (let [old-value state]
-      (set! state new-value)
-      (-notify-watches a old-value new-value)
-      new-value))
+  (-reset! [a newval]
+    (let [oldval state]
+      (set! state newval)
+      (when on-set
+        (set! dirty? true)
+        (on-set oldval newval))
+      (-notify-watches a oldval newval)
+      newval))

   ISwap
   (-swap! [a f]
@@ -246,7 +245,7 @@
         (set! active? true))
       (set! dirty? false)
       (set! state res)
-      (call-watches this watches oldstate state)
+      (-notify-watches this oldstate state)
       res))

   IDeref
@@ -257,7 +256,7 @@
           (let [oldstate state]
             (set! state (f))
             (when-not (identical? oldstate state)
-              (call-watches this watches oldstate state))))
+              (-notify-watches this oldstate state))))
         state)
       (do
         (notify-deref-watcher! this)


Fix tests.

Fix tests.

--- test/catacumba/sse_tests.clj
+++ test/catacumba/sse_tests.clj
@@ -29,8 +29,8 @@
                     "data: 2\n\n"
                     "event: foobar\n\n"
                     "id: foobar\n\n"
-                    "data: 3\n"
-                    "id: foobar\n\n")))))))
+                    "id: foobar\n"
+                    "data: 3\n\n")))))))

 (deftest sse-specific-handler
   (letfn [(sse-handler [context out]
@@ -51,5 +51,5 @@
                     "data: 2\n\n"
                     "event: foobar\n\n"
                     "id: foobar\n\n"
-                    "data: 3\n"
-                    "id: foobar\n\n")))))))
+                    "id: foobar\n"
+                    "data: 3\n\n")))))))


using use

using use

--- src/vc/validations.clj
+++ src/vc/validations.clj
@@ -13,6 +13,7 @@
   (:use
     [vc.vijava :only (disk-format-types)]
     [clojure.core.strint :only (<<)]
+    [celestial.validations :only (validate!)]
     [bouncer [core :as b] [validators :as v :only (defvalidatorset)]])
   (:require
     [celestial.validations :as cv]))
@@ -57,7 +58,7 @@
   )

 (defn provider-validation [allocation machine]
-  (cv/validate! ::invalid-vm {:allocation allocation :machine machine} vcenter-provider))
+  (validate! ::invalid-vm {:allocation allocation :machine machine} vcenter-provider))

 (defvalidatorset vcenter-entity
@@ -76,6 +77,6 @@
 (defn validate-entity
  "vcenter based system entity validation for persistence layer"
   [vcenter]
-   (cv/validate! ::invalid-system vcenter entity-validation)
+   (validate! ::invalid-system vcenter entity-validation)
   )


Clean up tests

Clean up tests

--- test/expound/alpha_test.cljc
+++ test/expound/alpha_test.cljc
@@ -841,10 +841,10 @@

 -------------------------
 Detected 3 errors\n")
-         (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-           (s/explain-str :keys-spec/map-spec-1 {:foo 1.2
-                                                 :bar 123
-                                                 :baz true}))))
+         (expound/expound-str :keys-spec/map-spec-1 {:foo 1.2
+                                                     :bar 123
+                                                     :baz true}
+                              {:print-specs? false})))
   (is (= (pf
           "-- Spec failed --------------------

@@ -879,10 +879,10 @@

 -------------------------
 Detected 3 errors\n")
-         (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-           (s/explain-str :keys-spec/map-spec-2 {:foo 1.2
-                                                 :bar 123
-                                                 :qux false}))))
+         (expound/expound-str :keys-spec/map-spec-2 {:foo 1.2
+                                                     :bar 123
+                                                     :qux false}
+                              {:print-specs? false})))

   (is (=
        "-- Spec failed --------------------
@@ -931,11 +931,11 @@

 -------------------------
 Detected 4 errors\n"
-       (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-         (s/explain-str :keys-spec/map-spec-3 {:foo 1.2
-                                               :child-2 {:bar 123
-                                                         :child-1 {:baz true
-                                                                   :qux false}}})))))
+       (expound/expound-str :keys-spec/map-spec-3 {:foo 1.2
+                                                   :child-2 {:bar 123
+                                                             :child-1 {:baz true
+                                                                       :qux false}}}
+                            {:print-specs? false}))))

 (s/def :multi-spec/value string?)
 (s/def :multi-spec/children vector?)
@@ -1092,13 +1092,13 @@

 -------------------------
 Detected 1 error\n")
-           (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-             (s/explain-str
-              :recursive-spec/el
-              {:tag :group
-               :children [{:tag :group
-                           :children [{:tag :group
-                                       :props {:on-tap {}}}]}]})))))
+           (expound/expound-str
+            :recursive-spec/el
+            {:tag :group
+             :children [{:tag :group
+                         :children [{:tag :group
+                                     :props {:on-tap {}}}]}]}
+            {:print-specs? false}))))
   (testing "test that our new recursive spec grouping function works with
            alternative paths"
     (is (= (pf
@@ -1136,13 +1136,13 @@

 -------------------------
 Detected 1 error\n")
-           (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-             (s/explain-str
-              :recursive-spec/el-2
-              {:tag-2 :group
-               :children-2 [{:tag-2 :group
-                             :children-2 [{:tag-2 :group
-                                           :props-2 {:on-tap-2 {}}}]}]}))))))
+           (expound/expound-str
+            :recursive-spec/el-2
+            {:tag-2 :group
+             :children-2 [{:tag-2 :group
+                           :children-2 [{:tag-2 :group
+                                         :props-2 {:on-tap-2 {}}}]}]}
+            {:print-specs? false})))))

 (s/def :cat-wrapped-in-or-spec/kv (s/and
                                    sequential?
@@ -2520,8 +2520,7 @@
                     :clj "(fn
    [%]
    (< (-> % :x) (-> % :y)))"))
-             (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-               (s/explain-str :conformers-test/sorted-pair [1 0]))))
+             (expound/expound-str :conformers-test/sorted-pair [1 0] {:print-specs? false})))
       (is (= (pf "-- Spec failed --------------------

   [... [1 0]]
@@ -2541,8 +2540,7 @@
                     :clj "(fn
    [%]
    (< (-> % :x) (-> % :y)))"))
-             (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-               (s/explain-str (s/coll-of :conformers-test/sorted-pair) [[0 1] [1 0]]))))
+             (expound/expound-str (s/coll-of :conformers-test/sorted-pair) [[0 1] [1 0]] {:print-specs? false})))
       (is (= (pf "-- Spec failed --------------------

   {:a [1 0]}
@@ -2562,8 +2560,7 @@
                     :clj "(fn
    [%]
    (< (-> % :x) (-> % :y)))"))
-             (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-               (s/explain-str (s/map-of keyword? :conformers-test/sorted-pair) {:a [1 0]}))))
+             (expound/expound-str (s/map-of keyword? :conformers-test/sorted-pair) {:a [1 0]} {:print-specs? false})))
       (is (= (pf "-- Spec failed --------------------

   [... \"a\"]
@@ -2575,8 +2572,7 @@

 -------------------------
 Detected 1 error\n")
-             (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-               (s/explain-str :conformers-test/sorted-pair [1 "a"])))))
+             (expound/expound-str :conformers-test/sorted-pair [1 "a"] {:print-specs? false}))))
     (testing "conformers that modify path of values"
       (s/def :conformers-test/vals (s/coll-of (s/and string?
                                                      #(re-matches #"[A-G]+" %))))
@@ -2599,8 +2595,7 @@

 -------------------------
 Detected 1 error\n"
-             (binding [s/*explain-out* (expound/custom-printer {:print-specs? false})]
-               (s/explain-str :conformers-test/csv "abc,def,ghi")))))
+             (expound/expound-str :conformers-test/csv "abc,def,ghi" {:print-specs? false}))))

     ;; this is NOT recommended!
     ;; so I'm not inclined to make this much nicer than
@@ -3618,8 +3613,7 @@
 -------------------------
 Detected 1 error
 ")
-         (binding [s/*explain-out* (expound/custom-printer {:theme :none})]
-           (s/explain-str :colorized-output/strings ["" :a ""]))))
+         (expound/expound-str :colorized-output/strings ["" :a ""] {:theme :none})))
   (is (= (pf "<NONE><NONE><CYAN>-- Spec failed --------------------<NONE>

   [... <RED>:a<NONE> ...]
@@ -3637,8 +3631,7 @@
 <CYAN>-------------------------<NONE>
 <CYAN>Detected<NONE> <CYAN>1<NONE> <CYAN>error<NONE>
 ")
-         (binding [s/*explain-out* (expound/custom-printer {:theme :figwheel-theme})]
-           (readable-ansi (s/explain-str :colorized-output/strings ["" :a ""]))))))
+         (readable-ansi (expound/expound-str :colorized-output/strings ["" :a ""] {:theme :figwheel-theme})))))

 (s/def ::spec-name (s/with-gen
                      qualified-keyword?


Use symbols inside ns macro

Use symbols inside ns macro

--- test/io/aviso/twixt_test.clj
+++ test/io/aviso/twixt_test.clj
@@ -1,9 +1,9 @@
 (ns io.aviso.twixt-test
-  (:use clojure.test
-        io.aviso.twixt
-        io.aviso.twixt.streamable
-        clojure.tools.logging)
-  (:require [clojure.java.io :as io]))
+  (use clojure.test
+       io.aviso.twixt
+       io.aviso.twixt.streamable
+       clojure.tools.logging)
+  (require [clojure.java.io :as io]))

 (defn next-handler [req] :next-handler)


Clean up element tests

Clean up element tests

--- test/om_tools/dom_test.cljs
+++ test/om_tools/dom_test.cljs
@@ -44,12 +44,16 @@
   (testing "simple element"
     (is=el (dom/element js/React.DOM.a {:href "/"} ["foo" "bar"])
            (om-dom/a #js {:href "/"} "foo" "bar")))
+
   (testing "opt formatting"
     (is=el (dom/element js/React.DOM.a {:on-click println} "foo")
            (om-dom/a #js {:onClick println} "foo")))
-  (testing "opt alias"
+
+  (testing "class -> className"
     (is=el (dom/element js/React.DOM.a {:class "bar"} "foo")
-           (om-dom/a #js {:className "bar"} "foo"))
+           (om-dom/a #js {:className "bar"} "foo")))
+
+  (testing "for -> htmlFor"
     (is=el (dom/element js/React.DOM.label {:for "bar"} "foo")
            (om-dom/label #js {:htmlFor "bar"} "foo"))))


Remove to-destroy after destroying tile

Remove to-destroy after destroying tile

--- super-koalio/desktop/src-common/super_koalio/core.clj
+++ super-koalio/desktop/src-common/super_koalio/core.clj
@@ -15,7 +15,7 @@
     (when-let [[tile-x tile-y] to-destroy]
       (tiled-map-layer! (tiled-map-layer screen "walls")
                         :set-cell tile-x tile-y nil)))
-  entities)
+  (map #(dissoc % :to-destroy) entities))

 (defscreen main-screen
   :on-show


added tests for new data functions

added tests for new data functions

--- test/staircase/test/data.clj
+++ test/staircase/test/data.clj
@@ -41,6 +41,7 @@
                 id-b (create histories {:title "My new history B" :description nil})]
         (create steps {:title "foo" :history_id id-a})
         (create steps {:title "bar" :history_id id-a})
+        (create steps {:title "baz" :history_id id-a})
         (create steps {:title "can't be found"
                        :history_id (create histories {:title "History C"})})
         (f)))))
@@ -57,18 +58,30 @@
 (deftest test-get-steps-of
   (let [a-steps (get-steps-of {:db db} id-a)]
     (testing "history A has two steps"
-      (is (= 2 (count a-steps))))
+      (is (= 3 (count a-steps))))
     (testing "steps come out oldest -> newest"
-      (is (= (list "foo" "bar") (map :title a-steps)))))
+      (is (= (list "foo" "bar" "baz") (map :title a-steps)))))
   (let [b-steps (get-steps-of {:db db} id-b)]
     (testing "we only get steps of the history we asked for"
       (is (empty? b-steps)))))
+
+(deftest test-get-history-steps-of
+  (let [links (get-history-steps-of {:db db} id-a 2)]
+    (is (= 2 (count links)))
+    (is (= id-a (:history_id (first links))))))
+
+(deftest test-add-all-steps
+  (let [links (get-history-steps-of {:db db} id-a 2)]
+    (add-all-steps {:db db} id-b links)
+    (let [steps (get-steps-of {:db db} id-b)]
+      (is (= 2 (count steps)))
+      (is (= (list "foo" "bar") (map :title steps))))))

 (deftest test-get-steps-of-security
   (testing "only the owner can access the histories, even if the id is leaked"
     (binding [staircase.resources/context context]
       (let [a-steps (get-steps-of {:db db} id-a)]
-        (is (= 2 (count a-steps)))))
+        (is (= 3 (count a-steps)))))
     (binding [staircase.resources/context {:user "blackhat@pirates.r.us"}]
       (let [a-steps (get-steps-of {:db db} id-a)]
         (is (empty? a-steps))))))


Removed unused import

Removed unused import

--- test/puppetlabs/master/certificate_authority_test.clj
+++ test/puppetlabs/master/certificate_authority_test.clj
@@ -1,6 +1,5 @@
 (ns puppetlabs.master.certificate-authority-test
-  (:import (java.io StringReader ByteArrayInputStream)
-           (java.security MessageDigest))
+  (:import (java.io StringReader ByteArrayInputStream))
   (:require [puppetlabs.master.certificate-authority :refer :all]
             [puppetlabs.trapperkeeper.testutils.logging :as logutils]
             [puppetlabs.certificate-authority.core :as utils]


add functional labels for checkboxes

add functional labels for checkboxes

--- src-cljs/kixi/hecuba/web/chart.cljs
+++ src-cljs/kixi/hecuba/web/chart.cljs
@@ -97,8 +97,10 @@
       (dom/form
        #js {:className "chartForm" :onSubmit #(handle-submit % app)}
        (.log js/console "I'm rendering chart form.")
-       (dom/input #js {:type "checkbox" :value "external_temp" :ref "external_temp"})
-       (dom/input #js {:type "checkbox" :value "external_humidity" :ref "external_humidity"})
+       (dom/input #js {:id "external_temp" :type "checkbox" :ref "external_temp" :value "external_temp" :name "external_temp"})
+       (dom/label #js {:htmlFor "external_temp" } "External Temp")
+       (dom/input #js {:id "external_humidity" :type "checkbox" :value "external_humidity" :name "external_humidity" :ref "external_humidity"})
+       (dom/label #js {:htmlFor "external_humidity"} "External Humidity")
        (dom/input #js {:type "submit" :value "Update"})))))

 (defn chart-component [app opts]


Fix typo.

Fix typo.

Fixes #1.

--- src-cljs/pepa/workflows/upload.cljs
+++ src-cljs/pepa/workflows/upload.cljs
@@ -43,7 +43,7 @@
         (finally
           (om/update! row :working? false))))))

-(defn ^:provate progress-bar [progress]
+(defn ^:private progress-bar [progress]
   (om/component
    (html
     [:.progress


Comment in element convenience funcs

Comment in element convenience funcs

--- src/blue_salamander/r3elements.cljs
+++ src/blue_salamander/r3elements.cljs
@@ -2,6 +2,19 @@
   (:require-macros [blue-salamander.r3elements :as abbrev])
   (:require [goog.events :as events]
             [clojure.string :as string]))
+
+;;
+;; provides convenient definitions for threejs nodes. Instead of going:
+;;
+;; (js/React.createElement (js/ReactTHREE.Scene #js {} ....))
+;;
+;; you go:
+;;
+;; < require this ns as 'r3' >
+;;
+;; (r3/scene {} ...)
+;;
+

 (defn element-args [opts children]
   (cond


:bug: Fix image flickering on shape movement.

--- frontend/src/uxbox/main/ui/shapes/frame.cljs
+++ frontend/src/uxbox/main/ui/shapes/frame.cljs
@@ -61,15 +61,19 @@
     (let [selected-iref (-> (mf/deps (:id shape))
                             (mf/use-memo #(refs/make-selected (:id shape))))
           selected? (mf/deref selected-iref)
-          zoom (mf/deref refs/selected-zoom)]
+          zoom (mf/deref refs/selected-zoom)
+          frame-shape (mf/use-memo #(frame-shape shape-wrapper))]
       (when (and shape (not (:hidden shape)))
         (let [on-mouse-down #(common/on-mouse-down % shape)
               on-context-menu #(common/on-context-menu % shape)
               shape (merge frame-default-props shape)
+
               {:keys [x y width height]} shape
+
               inv-zoom (/ 1 zoom)
               childs (mapv #(get objects %) (:shapes shape))
               ds-modifier (:displacement-modifier shape)
+
               label-pos (cond-> (gpt/point x (- y 10))
                           (gmt/matrix? ds-modifier) (gpt/transform ds-modifier))

@@ -95,8 +99,8 @@
                    ;; User may also select the frame with single click in the label
                    :on-click on-double-click}
             (:name shape)]
-           [:& (frame-shape shape-wrapper) {:shape shape
-                                            :childs childs}]])))))
+           [:& frame-shape {:shape shape
+                            :childs childs}]])))))

 (defn frame-shape
   [shape-wrapper]


[#4535] decode browser's uri

[#4535] decode browser's uri

Signed-off-by: Pedro Pombeiro <f8c34e1c5d363d76a4b9e8313641f62c1029c3e7@users.noreply.github.com>

--- src/status_im/ui/screens/browser/events.cljs
+++ src/status_im/ui/screens/browser/events.cljs
@@ -23,7 +23,7 @@
     (not (:name browser))
     (assoc :name (i18n/label :t/browser))
     (:url browser)
-    (update :url http/normalize-url)))
+    (update :url (comp js/decodeURI http/normalize-url))))

 (defn add-browser-fx [{:keys [db now]} browser]
   (let [new-browser (get-new-browser browser now)]


add test for reflexives

add test for reflexives

--- test/babel/test/fr.clj
+++ test/babel/test/fr.clj
@@ -174,3 +174,12 @@
   (let [result (expression {:synsem {:sem {:pred :have-fun}}})]
     (is (= (get-in result [:synsem :sem :pred]) :have-fun))))

+(deftest vp-aux-reflexive
+  (let [result
+        (expression
+         {:synsem {:subcat '() :sem {:subj {:pred :lei}
+                                     :pred :have-fun :tense :past}}})]
+    (is (= (fo result) "elle l'est amusée"))))
+
+
+


make release task more general and customizable with :release key in project.clj

--- src/cake/tasks/release.clj
+++ src/cake/tasks/release.clj
@@ -139,21 +139,23 @@
               (send-ack out)
               (wait-for-ack in)))))))

-(defn upload-to-clojars [jarfile]
-  (log "Releasing jar:" jarfile)
-  (ssh-session {:host "clojars.org" :username "clojars"}
-    (upload ["pom.xml" jarfile])))
-
-(deftask release #{jar}
-  "Release project jar to clojars."
-  (upload-to-clojars (jarfile)))
-
 (defn- lookup-file [file]
   (case file
     :jar     (jarfile)
     :uberjar (uberjarfile)
     :war     (warfile)
     file))
+
+(deftask release #{jar}
+  "Release project jar (to clojars by default)."
+  (let [release  (:release *project*)
+        files    (or (:files    release) [:jar "pom.xml"])
+        host     (or (:host     release) "clojars.org")
+        username (or (:username release) "clojars")
+        dest     (or (:dest     release) ".")]
+    (when (#{"y" "Y"} (prompt-read (format "Are you sure you want to release to %s? [y/N]" host)))
+      (ssh-session {:host host :username username}
+        (upload (map lookup-file files) dest)))))

 (deftask deploy
   "Deploy project to a group of servers."


Handle links with empty content

Handle links with empty content

in md links are atomaticaly recognized. Such links will have an empty
content.

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -391,7 +391,10 @@

 (defmulti to-fop (fn [{:keys [tag attrs content]}] tag))
 (defmethod to-fop :p [{content :content}] (block {:space-before "17pt"} content))
-(defmethod to-fop :a [{content :content {href :href} :attrs}] (apply #(external-link href %) content))
+(defmethod to-fop :a [{content :content {href :href} :attrs}]
+  (if (not-empty content)
+    (apply #(external-link href %) content)
+    (external-link href href)))
 (defmethod to-fop :h1 [{content :content}] [:fo:block (style :h1) content])
 (defmethod to-fop :h2 [{content :content}] [:fo:block (style :h2) content])
 (defmethod to-fop :h3 [{content :content}] [:fo:block (style :h3) content])


geo parameter data validation

geo parameter data validation

--- src/clj/ephemeris/core.clj
+++ src/clj/ephemeris/core.clj
@@ -9,6 +9,16 @@
                :bodies []
                :angles []
                :houses \O})
+
+(defn- valid-geo? [geo]
+  (if (and
+        (map? geo)
+        (contains? geo :lat)
+        (contains? geo :lon)
+        (number? (:lat geo))
+        (number? (:lon geo)))
+    true
+    false))

 (defn calc [stuff]
   (let [want (merge defaults stuff)
@@ -31,7 +41,7 @@
               {(lookup what) {:lon (aget res 0)
                               :lat (aget res 1)
                               :sdd (aget res 3)}})))}
-      (if (not (empty? (:angles want)))
+      (if (valid-geo? (:geo want))
         (let [cusps (double-array 13)
               ascmc (double-array 10)
               rc (.swe_houses sw


Simplify server stream implementation.

Simplify server stream implementation.

--- src/clj/fleetdb/server.clj
+++ src/clj/fleetdb/server.clj
@@ -6,8 +6,8 @@
   (:import  (java.net ServerSocket Socket InetAddress)
             (java.io PushbackReader BufferedReader InputStreamReader
                      PrintWriter    BufferedWriter OutputStreamWriter
-                     DataInputStream  BufferedInputStream
-                     DataOutputStream BufferedOutputStream)
+                     DataInputStream  BufferedInputStream  InputStream
+                     DataOutputStream BufferedOutputStream OutputStream)
             (joptsimple OptionParser OptionSet OptionException))
   (:gen-class))

@@ -31,8 +31,8 @@
   (fn [dba #^Socket socket]
     (try
       (with-open [socket socket
-                  out    (init-out socket)
-                  in     (init-in  socket)]
+                  out    (init-out (.getOutputStream socket))
+                  in     (init-in  (.getInputStream socket))]
         (.setKeepAlive socket true)
         (loop []
           (if (try
@@ -55,8 +55,8 @@

 (def- text-handler
   (generic-handler
-    (fn [#^Socket socket] (PrintWriter. (BufferedWriter. (OutputStreamWriter. (.getOutputStream socket)))))
-    (fn [#^Socket socket] (PushbackReader. (BufferedReader. (InputStreamReader. (.getInputStream  socket)))))
+    (fn [#^OutputStream os] (PrintWriter. (BufferedWriter. (OutputStreamWriter. os))))
+    (fn [#^InputStream is] (PushbackReader. (BufferedReader. (InputStreamReader. is))))
     (fn [#^PushbackReader in eof-val] (read in false eof-val))
     (fn [#^PrintWriter out [resp-code resp-val :as resp]]
       (if (#{0 1} resp-code)
@@ -67,15 +67,15 @@

 (def- binary-handler
   (generic-handler
-    (fn [#^Socket socket] (DataOutputStream. (BufferedOutputStream. (.getOutputStream socket))))
-    (fn [#^Socket socket] (DataInputStream.  (BufferedInputStream.  (.getInputStream  socket))))
+    (fn [#^OutputStream os] (DataOutputStream. (BufferedOutputStream. os)))
+    (fn [#^InputStream is] (DataInputStream.  (BufferedInputStream. is)))
     (fn [#^DataInputStream in eof-val] (io/dis-deserialize in io/eof))
     (fn [#^DataOutputStream out resp]  (io/dos-serialize out resp))))

 (def- bert-handler
   (generic-handler
-    (fn [#^Socket socket] (DataOutputStream. (BufferedOutputStream. (.getOutputStream socket))))
-    (fn [#^Socket socket] (DataInputStream.  (BufferedInputStream.  (.getInputStream  socket))))
+    (fn [#^OutputStream os] (DataOutputStream. (BufferedOutputStream. os)))
+    (fn [#^InputStream is] (DataInputStream.  (BufferedInputStream.  is)))
     (fn [#^DataInputStream in eof-val] (io/dis-berp-decode in io/eof))
     (fn [#^DataOutputStream out resp]  (io/dos-berp-encode out resp))))


test in-memory datomic first

test in-memory datomic first

--- src/clj/lesezeichen/db.clj
+++ src/clj/lesezeichen/db.clj
@@ -6,7 +6,7 @@
             [lesezeichen.io :refer [transact-all]]))

-(def db-uri-base "datomic:free://bookie.polyc0l0r.net:4334")
+(def db-uri-base "datomic:mem://")

 (defn- scratch-conn


Switched 'set!' to binding for instr.

Switched 'set!' to binding for instr.

--- src/clj/minijava/munch.clj
+++ src/clj/minijava/munch.clj
@@ -6,14 +6,14 @@
 (= (type x) t)
 )

-(def instr '())
+(def *instr* '())

 (defn emit [x]
 ;;I'm not sure what the best way to implement this is yet. But emit just appends x to the end of a list, so theres not too much to it.
 ;;emit should return nil.
 	(do
-			(set! instr (cons x instr))
+			(binding [*instr* (cons x *instr*)])
 	nil)
 )

@@ -28,9 +28,9 @@
 ;;Entry function to maximal munch.
 (defn select [irtree]
 	(do
-		(set! instr '()) ;;reset instr to empty list
+		(binding [*instr* '()]) ;;reset instr to empty list
 		(munch irtree)
-		 instr))
+		 *instr*))

 (defmethod munch  [:default]
 	[x]


Crude handling of rate limit errors

Crude handling of rate limit errors

--- src/clj/skytwit/server.clj
+++ src/clj/skytwit/server.clj
@@ -18,7 +18,8 @@
             [taoensso.sente.server-adapters.http-kit
              :refer [sente-web-server-adapter]]
             [clojure.core.async :as async :refer [go go-loop >! <!]])
-  (:import (twitter.callbacks.protocols AsyncStreamingCallback))
+  (:import (twitter.callbacks.protocols AsyncStreamingCallback
+                                        SyncSingleCallback))
   (:gen-class))

 (defn get-credentials-from-env
@@ -100,17 +101,57 @@

 (defn get-tweets-before-tweet-id
   [creds screen-name id]
-  (let [tweets (->> (tr/statuses-user-timeline :oauth-creds creds
-                                               :params {:screen-name screen-name
-                                                        :max-id id
-                                                        :trim-user true
-                                                        :exclude-replies true
-                                                        :count 200})
-                    :body (map (juxt :id (comp (partial mapv :text)
-                                               :hashtags :entities))))]
-    (if (= id (ffirst tweets))
+  (let [get-raw-tweets
+        (fn rec []
+          (tr/statuses-user-timeline
+            :oauth-creds creds
+            :params {:screen-name screen-name
+                     :max-id id
+                     :trim-user true
+                     :exclude-replies true
+                     :count 200}
+            :callbacks (SyncSingleCallback.
+                         twh/response-return-body
+                         (fn [resp]
+                           ;; TODO: Proper logging
+                           (.. System out
+                               (println (pr-str [:failure resp])))
+                           (if (twh/rate-limit-error? @(:status resp))
+                             (do (Thread/sleep (20 * 1000))
+                                 (rec))
+                             (twh/response-throw-error resp)))
+                         twh/exception-rethrow)))
+        tweets (->> (get-raw-tweets)
+                    (map (fn [m]
+                           {:id (:id m)
+                            :tags (->> m :entities :hashtags
+                                       (mapv :text))})))]
+    (if (= id (:id (first tweets)))
       (rest tweets)
       tweets)))
+
+(defn put-all-tweets-on-channel
+  [creds screen-name chan]
+  (let [max-id (-> (get-user-profile creds screen-name) :last-tweet-id inc)]
+    (go-loop [last-id max-id]
+             (let [next-batch (get-tweets-before-tweet-id creds screen-name last-id)]
+               (when (seq next-batch)
+                 (>! chan next-batch)
+                 (recur (:id (last next-batch))))))))
+
+(comment
+  (def creds (get-credentials-from-env))
+  (def a (atom []))
+
+  (let [ch (async/chan)]
+    (put-all-tweets-on-channel creds "_toch" ch)
+    (go-loop []
+             (when-let [v (<! ch)]
+               (swap! a concat v)
+               (recur))))
+
+  (-> a deref count)
+  )

 (defroutes routes
   (GET "/" _


fix: don't remove network while autoredeploy (network fetching via separate API)

#102

--- src/clj/swarmpit/agent.clj
+++ src/clj/swarmpit/agent.clj
@@ -18,7 +18,8 @@
           (let [latest-image-id (api/service-image-id service true)]
             (when (not= current-image-id
                         latest-image-id)
-              (api/update-service id service true)
+              (api/update-service id (-> service
+                                         (assoc-in [:networks] (api/service-networks id))) true)
               (log/info "Service" id "has been redeployed! [" current-image-id "] -> [" latest-image-id "]")))
           (catch ExceptionInfo e
             (log/error "Service" id "autoredeploy failed! " (ex-data e))))))))


add test for architect untrashability scenarios

--- src/clj/test/cards-ice.clj
+++ src/clj/test/cards-ice.clj
@@ -14,3 +14,21 @@
       (card-ability state :corp iwall 0)
       (is (not (:run @state)) "Run is ended")
       (is (get-in @state [:runner :register :unsuccessful-run]) "Run was unsuccessful"))))
+
+(deftest architect-untrashable
+  "Architect is untrashable while installed and rezzed, but trashable if derezzed or from HQ"
+  (do-game
+    (new-game (default-corp [(qty "Architect" 3)])
+              (default-runner))
+    (play-from-hand state :corp "Architect" "HQ")
+    (let [architect (get-in @state [:corp :servers :hq :ices 0])]
+      (core/rez state :corp architect)
+      (core/trash state :corp (refresh architect))
+      (is (not= nil (get-in @state [:corp :servers :hq :ices 0])) "Architect was trashed, but should be untrashable")
+      (core/derez state :corp (refresh architect))
+      (core/trash state :corp (refresh architect))
+      (is (= nil (get-in @state [:corp :servers :hq :ices 0])) "Architect was not trashed, but should be trashable")
+      (core/trash state :corp (get-in @state [:corp :hand 0]))
+      (is (= (get-in @state [:corp :discard 0 :title]) "Architect"))
+      (is (= (get-in @state [:corp :discard 1 :title]) "Architect"))
+      )))


Computation module can be disabled via ini file

--- src/clj_mrazik/irc_bot.clj
+++ src/clj_mrazik/irc_bot.clj
@@ -134,6 +134,8 @@
     [incomming-message nick input-text]
     (try
     (let [in-channel? (message-to-channel? incomming-message)
+          modules     (-> @dyncfg/configuration :modules)
+          number-cruncher? (:number-cruncher modules)
           input       (if in-channel?
                           (subs input-text (+ 2 (count @dyncfg/bot-nick)))
                           input-text)
@@ -149,9 +151,9 @@
                           "Good bot" "I know"
                           "Good bot." "I know"
                           (cond
-                              (is-number? input)               (print-prime-factors input)
-                              (is-two-numbers? input)          (print-gcd input)
-                              (is-factorial? input)            (print-factorial input)
+                              (and number-cruncher? (is-number? input))        (print-prime-factors input)
+                              (and number-cruncher? (is-two-numbers? input))   (print-gcd input)
+                              (and number-cruncher? (is-factorial? input))     (print-factorial input)
                               (is-s-expression? input)         (s-expression input)
                               (is-word-from-dictionary? input) (return-words-from-dictionary input)
                               :else                            (random-message)))]


string split fix

string split fix

--- src/cljs/unfolds/core.cljs
+++ src/cljs/unfolds/core.cljs
@@ -1,6 +1,7 @@
 (ns unfolds.core
   (:require-macros [cljs.core.async.macros :refer [go]])
   (:require [clojure.set :refer [union]]
+            [clojure.string :refer [split]]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
             [cljs.core.async :refer [put! chan <!]]))
@@ -26,6 +27,8 @@
   "true if seq contains elm"
   [seq elm]
   (some #(= elm %) seq))
+
+(defn split-words [s] (split s #"\s+"))

 ;; Let's just start with all the words. Leaving freqs in.
 (defn make-word-map [[id str]]
@@ -65,7 +68,6 @@
 (defn link? [s] (if (re-find link-re s) true false))
 (defn get-href [s] (str (nth (re-find link-re s) 1)))
 (defn get-title [s] (str (nth (re-find link-re s) 2)))
-(defn split-words [s] (clojure.string/split s #"\s+"))

 (defn str-or-link [x]
   (if (link? x)


Undo replacement of :buildable-at with :can-build in unit defs

--- src/cljs/zetawar/data.cljs
+++ src/cljs/zetawar/data.cljs
@@ -76,51 +76,27 @@

     :terrains
     {:plains        {:description "Plains"
-                     :image "tilesets/elite-command/terrains/plains.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/plains.png"}
      :mountains     {:description "Mountains"
-                     :image "tilesets/elite-command/terrains/mountains.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/mountains.png"}
      :woods         {:description "Woods"
-                     :image "tilesets/elite-command/terrains/woods.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/woods.png"}
      :desert        {:description "Desert"
-                     :image "tilesets/elite-command/terrains/desert.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/desert.png"}
      :tundra        {:description "Tundra"
-                     :image "tilesets/elite-command/terrains/tundra.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/tundra.png"}
      :swamp         {:description "Swamp"
-                     :image "tilesets/elite-command/terrains/swamp.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/swamp.png"}
      :ford          {:description "Ford"
-                     :image "tilesets/elite-command/terrains/ford.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/ford.png"}
      :shallow-water {:description "Shallow Water"
-                     :image "tilesets/elite-command/terrains/shallow-water.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/shallow-water.png"}
      :deep-water    {:description "Deep Water"
-                     :image "tilesets/elite-command/terrains/deep-water.png"
-                     :can-build []}
+                     :image "tilesets/elite-command/terrains/deep-water.png"}
      :base          {:description "Base"
-                     :image "tilesets/elite-command/terrains/base-COLOR.png"
-                     :can-build [:infantry
-                                 :grenadier
-                                 :mortar
-                                 :ranger
-                                 :sniper
-                                 :medic
-                                 :engineer
-                                 :humvee
-                                 :tank
-                                 :heavy-tank
-                                 :artillery
-                                 :heavy-artillery]}
+                     :image "tilesets/elite-command/terrains/base-COLOR.png"}
      :seaport       {:description "Seaport"
-                     :image "tilesets/elite-command/terrains/seaport-COLOR.png"
-                     :can-build [:frigate
-                                 :destroyer
-                                 :cruiser]}}
+                     :image "tilesets/elite-command/terrains/seaport-COLOR.png"}}

     :unit-state-maps
     {:move-attack-once
@@ -223,6 +199,7 @@
                 :movement 9
                 :can-capture true
                 :can-repair #{}
+                :buildable-at #{:base}
                 :min-range 1
                 :max-range 1
                 :armor-type :personnel
@@ -252,6 +229,7 @@
                  :movement 9
                  :can-capture true
                  :can-repair #{}
+                 :buildable-at #{:base}
                  :min-range 1
                  :max-range 2
                  :armor-type :personnel
@@ -281,6 +259,7 @@
               :movement 9
               :can-capture true
               :can-repair #{}
+              :buildable-at #{:base}
               :min-range 2
               :max-range 3
               :armor-type :personnel
@@ -308,6 +287,7 @@
               :movement 9
               :can-capture true
               :can-repair #{}
+              :buildable-at #{:base}
               :min-range 1
               :max-range 1
               :armor-type :personnel
@@ -338,6 +318,7 @@
               :movement 9
               :can-capture true
               :can-repair #{}
+              :buildable-at #{:base}
               :min-range 2
               :max-range 4
               :armor-type :personnel
@@ -365,6 +346,7 @@
              :movement 9
              :can-capture true
              :can-repair #{:personnel}
+             :buildable-at #{:base}
              :min-range 1
              :max-range 1
              :armor-type :personnel
@@ -394,6 +376,7 @@
                :movement 9
                :can-capture true
                :can-repair #{:armored}
+               :buildable-at #{:base}
                :min-range 1
                :max-range 1
                :armor-type :personnel
@@ -425,6 +408,7 @@
               :movement 15
               :can-capture false
               :can-repair #{}
+              :buildable-at #{:base}
               :min-range 1
               :max-range 1
               :armor-type :armored
@@ -452,6 +436,7 @@
             :movement 12
             :can-capture false
             :can-repair #{}
+            :buildable-at #{:base}
             :min-range 1
             :max-range 1
             :armor-type :armored
@@ -479,6 +464,7 @@
                   :movement 12
                   :can-capture false
                   :can-repair #{}
+                  :buildable-at #{:base}
                   :min-range 1
                   :max-range 1
                   :armor-type :armored
@@ -506,6 +492,7 @@
                  :movement 8
                  :can-capture false
                  :can-repair #{}
+                 :buildable-at #{:base}
                  :min-range 3
                  :max-range 4
                  :armor-type :armored
@@ -531,6 +518,7 @@
                        :movement 2
                        :can-capture false
                        :can-repair #{}
+                       :buildable-at #{:base}
                        :min-range 4
                        :max-range 6
                        :armor-type :armored
@@ -557,6 +545,7 @@
                :movement 8
                :can-capture false
                :can-repair #{}
+               :buildable-at #{:seaport}
                :min-range 1
                :max-range 1
                :armor-type :naval
@@ -579,6 +568,7 @@
                  :movement 5
                  :can-capture false
                  :can-repair #{}
+                 :buildable-at #{:seaport}
                  :min-range 1
                  :max-range 4
                  :armor-type :naval
@@ -600,6 +590,7 @@
                :movement 4
                :can-capture false
                :can-repair #{}
+               :buildable-at #{:seaport}
                :min-range 1
                :max-range 3
                :armor-type :naval


correct cljsdoc files to use transformed properties

--- src/cljs_api_gen/write.clj
+++ src/cljs_api_gen/write.clj
@@ -35,10 +35,10 @@
        (cljsdoc-section "Return Type" (:return-type item))
        (cljsdoc-section "Clojure" (:clj-symbol item))
        (cljsdoc-section "Docstring" (:docstring item))
-       (cljsdoc-section "Signature" (join "\n" (:signatures item)))
-       (cljsdoc-section "Filename" (:filename item))
+       (cljsdoc-section "Signature" (join "\n" (:signature item)))
+       (cljsdoc-section "Filename" (:source-filename item))
        (cljsdoc-section "Source" (:source item))
-       (cljsdoc-section "Github" (:github-link item))
+       (cljsdoc-section "Github" (:source-link item))
        (cljsdoc-section "History" (join "\n" (map make-history-text (:history item))))
        ""])))


Fix pileup command

Fix pileup command

--- src/clojure/cljam/core.clj
+++ src/clojure/cljam/core.clj
@@ -45,6 +45,16 @@
 (defmethod read-alignments cljam.bam.reader.BAMReader
   [rdr]
   (io/read-alignments rdr {}))
+
+(defmulti read-refs type)
+
+(defmethod read-refs cljam.sam.reader.SAMReader
+  [rdr]
+  (io/read-refs rdr))
+
+(defmethod read-refs cljam.bam.reader.BAMReader
+  [rdr]
+  (io/read-refs rdr))

 (defn- slurp
   [f]
@@ -140,13 +150,12 @@
       (println help)
       (System/exit 0))
     (with-open [r (bam/reader f)]
-      (let [sam {:header (io/read-header r)
-                 :alignments (io/read-alignments r {})}]
-        (when-not (sorter/sorted? sam)
-          (println "Not sorted")
-          (System/exit 1))
-        (doseq [p (plp/pileup sam)]
-          (println p))))))
+      (when-not (sorter/sorted? r)
+        (println "Not sorted")
+        (System/exit 1))
+      (doseq [ref (map :name (read-refs r))
+              p (plp/pileup r ref)]
+        (println p)))))

 (defn faidx [& args]
   (let [[opt [f _] help] (cli args
@@ -169,7 +178,7 @@

 (defn -main [& args]
   (do-sub-command args
-                  "Usage: cljam {view,convert,sort,index,idxstats,merge,pileup,faidx} ..."
+                  "Usage: cljam {view,convert,sort,index,pileup,faidx} ..."
                   [:view     cljam.core/view     "Extract/print all or sub alignments in SAM or BAM format."]
                   [:convert  cljam.core/convert  "Convert SAM to BAM or BAM to SAM."]
                   [:sort     cljam.core/sort     "Sort alignments by leftmost coordinates."]


add 'normalize' command #16

add 'normalize' command #16

--- src/clojure/cljam/core.clj
+++ src/clojure/cljam/core.clj
@@ -7,6 +7,7 @@
                    [io :as io]
                    [bam :as bam]
                    [bam-indexer :as bai]
+                   [normal :as normal]
                    [sorter :as sorter]
                    [fasta :as fa]
                    [fasta-indexer :as fai]
@@ -105,6 +106,32 @@
               (io/write-alignments wtr alns hdr)))))))
   nil)

+;;; normalize command
+
+(def ^:private normalize-cli-options
+  [["-h" "--help"]])
+
+(defn- normalize-usage [options-summary]
+  (->> ["Normalize references of alignments"
+        ""
+        "Usage: cljam normalize <in.bam|sam> <out.bam|sam>"
+        ""
+        "Options:"
+        options-summary]
+       (str/join \newline)))
+
+(defn normalize [args]
+  (let [{:keys [options arguments errors summary]} (parse-opts args normalize-cli-options)]
+    (cond
+     (:help options) (exit 0 (normalize-usage summary))
+     (not= (count arguments) 2) (exit 1 (normalize-usage summary))
+     errors (exit 1 (error-msg errors)))
+    (let [[in out] arguments
+          r (reader in)
+          w (writer out)]
+      (normal/normalize r w)))
+  nil)
+
 ;;; sort command

 (def ^:private sort-cli-options
@@ -264,6 +291,7 @@
                                           :options  [["-h" "--help" "Show help" :default false :flag true]]
                                           :commands [["view"    "Extract/print all or sub alignments in SAM or BAM format."]
                                                      ["convert" "Convert SAM to BAM or BAM to SAM."]
+                                                     ["normalize" "Normalize references of alignments"]
                                                      ["sort"    "Sort alignments by leftmost coordinates."]
                                                      ["index"   "Index sorted alignment for fast random access."]
                                                      ["pileup"  "Generate pileup for the BAM file."]
@@ -274,6 +302,7 @@
     (case cmd
       :view    (view args)
       :convert (convert args)
+      :normalize (normalize args)
       :sort    (sort args)
       :index   (index args)
       :pileup  (pileup args)


Add log when POSTing an event

Add log when POSTing an event

--- ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/resources/event.clj
+++ ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/resources/event.clj
@@ -62,6 +62,7 @@

 (defmethod crud/add resource-name
            [request]
+  (log/info resource-uri ": will add " (:body request))
   (add-impl request))

 (def retrieve-impl (std-crud/retrieve-fn resource-name))


Move columns

Move columns

--- src/airhead_frontend/components.cljs
+++ src/airhead_frontend/components.cljs
@@ -173,11 +173,11 @@
 ;; Main

 (defn page-component []
-  [:main.pure-g
+  [:main
+   [header]
+   [player-section]
+   [upload-section]
    [:div.pure-u-1.pure-u-md-1-2
-    [header]
-    [player-section]
-    [upload-section]
     [playlist-section]]
    [:div.pure-u-1.pure-u-md-1-2
     [library-section]]])


Honor exclusive_resources constraint when dispatching

--- src/cider_ci/dispatcher/dispatch.clj
+++ src/cider_ci/dispatcher/dispatch.clj
@@ -135,6 +135,11 @@
                                         (hh/merge-where [:= :enabled true])
                                         (hh/merge-where (hc/raw "(tasks.traits <@ executors_with_load.traits)"))
                                         (hh/merge-where (hc/raw "(last_ping_at > (now() - interval '1 Minutes'))")))])
+          (hh/merge-where [ "NOT EXISTS" (-> (hh/select 1)
+                                             (hh/from [:trials :active_trials])
+                                             (hh/merge-join [:tasks :active_tasks] [:= :active_tasks.id :active_trials.task_id])
+                                             (hh/merge-where [:in :active_trials.state  ["executing","dispatching"]])
+                                             (hh/merge-where (hc/raw "active_tasks.exclusive_resources && tasks.exclusive_resources")))])
           (hh/merge-join :tasks [:= :tasks.id :trials.task_id])
           (hh/merge-join :executions [:= :executions.id :tasks.execution_id])
           (hh/order-by [:executions.priority :desc]
@@ -146,7 +151,6 @@
           hc/format)
       (#(jdbc/query (rdbms/get-ds) %))
       first))
-

 (defn- issues-count [trial]
   (-> (jdbc/query (rdbms/get-ds)


assume prices descend by date

assume prices descend by date

--- src/clj/clj_money/import/gnucash.clj
+++ src/clj/clj_money/import/gnucash.clj
@@ -313,11 +313,12 @@
   [record filter-state]
   (let [trade-date (-> record :time :date parse-date)
         trade-date-key ((juxt :space :id) (:commodity record))
+        interval (t/weeks 1)
         last-trade-date (get-in @filter-state
                                 [:trade-dates trade-date-key]
-                                (t/local-date 1900 1 1))
-        cut-off (t/plus last-trade-date (t/months 1))]
-    (when (t/after? trade-date cut-off)
+                                (t/plus (t/today) interval))
+        cut-off (t/minus last-trade-date interval)]
+    (when (t/before? trade-date cut-off)
       (swap! filter-state #(assoc-in % [:trade-dates trade-date-key] trade-date))
       true)))


Launch updater.

Launch updater.

--- src/clj/elephantdb/common/thrift.clj
+++ src/clj/elephantdb/common/thrift.clj
@@ -111,9 +111,11 @@
   "Accepts a function that takes in a service and returns a processor,
   a thrift IFace implementation, a port and an updater interval."
   [processor-fn service port interval]
-  (let [server (thrift-server (processor-fn service) port)]
+  (let [server  (thrift-server (processor-fn service) port)]
     (u/register-shutdown-hook #(.stop server))
     (log/info "Preparing database...")
-    (db/prepare service)
+    (doto service
+      (db/prepare)
+      (db/launch-updater!))
     (log/info "Starting ElephantDB server...")
     (.serve server)))


Shift position of `is-module-selected?` function

So that it is directly below the definition of the `ModulesSelected`
global.

Signed-off-by: Pang Yan Han <22594c345857f664c61cd411f607c4d40a9d4af9@gmail.com>

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -197,15 +197,20 @@
   }
   ModulesSelected {})

+(defn is-module-selected?
+  "Determines if a module has been selected"
+  [moduleCode]
+  (contains? ModulesSelected moduleCode))
+
+(defn get-nr-modules-selected
+  "Return the number of modules selected by the user"
+  []
+  (count ModulesSelected))
+
 (def ^{:doc     "Vector containing module code strings in the order the modules
                  were added."
        :private true}
   ModulesSelectedOrder [])
-
-(defn get-nr-modules-selected
-  "Return the number of modules selected by the user"
-  []
-  (count ModulesSelected))

 (defn get-selected-module-codes-as-js-array
   "Returns a JavaScript Array of Strings, where each String is the module code
@@ -222,11 +227,6 @@
   "Appends a module to `ModulesSelectedOrder`"
   [moduleCode]
   (set! ModulesSelectedOrder (conj ModulesSelectedOrder moduleCode)))
-
-(defn is-module-selected?
-  "Determines if a module has been selected"
-  [moduleCode]
-  (contains? ModulesSelected moduleCode))

 (def ^{:doc     "Converts a short form lesson type string to its long form"
        :private true}


tweaked query to accept multiple identifiers

--- src/cljs/gointermod/utils/comms.cljs
+++ src/cljs/gointermod/utils/comms.cljs
@@ -15,15 +15,20 @@
 (clj->js organism)))

-(defn make-base-query [identifier]
-  (str "<query model=\"genomic\" view=\"Gene.symbol Gene.secondaryIdentifier Gene.primaryIdentifier Gene.organism.name Gene.organism.taxonId Gene.homologues.homologue.primaryIdentifier Gene.homologues.homologue.secondaryIdentifier Gene.homologues.homologue.symbol Gene.homologues.homologue.organism.name Gene.homologues.homologue.organism.taxonId Gene.homologues.dataSets.name Gene.homologues.dataSets.url Gene.goAnnotation.evidence.code.code Gene.goAnnotation.evidence.publications.pubMedId Gene.goAnnotation.evidence.publications.title Gene.goAnnotation.ontologyTerm.identifier Gene.goAnnotation.ontologyTerm.name Gene.goAnnotation.ontologyTerm.namespace\" sortOrder=\"Gene.symbol ASC\" constraintLogic=\"B and C and A\" name=\"intermod_go\" > <constraint path=\"Gene.goAnnotation.qualifier\" op=\"IS NULL\" code=\"B\" />  <constraint path=\"Gene.goAnnotation.ontologyTerm.obsolete\" op=\"=\" value=\"false\" code=\"C\" />
-<constraint path=\"Gene.homologues.homologue.symbol\" op=\"=\" value=\"" identifier "\" code=\"A\" /></query>"))
+(defn make-base-query [identifier organism]
+  (str "<query model=\"genomic\" view=\"Gene.symbol Gene.secondaryIdentifier Gene.primaryIdentifier Gene.organism.name Gene.organism.taxonId Gene.homologues.homologue.primaryIdentifier Gene.homologues.homologue.secondaryIdentifier Gene.homologues.homologue.symbol Gene.homologues.homologue.organism.name Gene.homologues.homologue.organism.taxonId Gene.homologues.dataSets.name Gene.homologues.dataSets.url Gene.goAnnotation.evidence.code.code Gene.goAnnotation.evidence.publications.pubMedId Gene.goAnnotation.evidence.publications.title Gene.goAnnotation.ontologyTerm.identifier Gene.goAnnotation.ontologyTerm.name Gene.goAnnotation.ontologyTerm.namespace\" sortOrder=\"Gene.symbol ASC\" constraintLogic=\"B and C and D and  A\" name=\"intermod_go\" >
+    <constraint path=\"Gene.goAnnotation.qualifier\" op=\"IS NULL\" code=\"B\" />
+    <constraint path=\"Gene.goAnnotation.ontologyTerm.obsolete\" op=\"=\" value=\"false\" code=\"C\" />
+    <constraint path=\"Gene.homologues.homologue.organism.shortName\" code=\"D\" op=\"=\" value=\"" organism "\"/>
+    <constraint path=\"Gene\" code=\"A\" op=\"LOOKUP\" value=\"" identifier "\" extraValue=\"H. sapiens\"/>
+</query>"))

 (defn go-query
   "Get the results of GO term query for specified symbol/identifier"
   [organism identifier]
-  (let [service (get-service organism)
-        query (make-base-query identifier)]
+  (let [
+        service (get-service organism)
+        query (make-base-query identifier (get-abbrev :mouse))]
     (go (let [response (<! (http/post (str "http://" (.-root service) "/service/query/results")
        {:with-credentials? false
         :keywordize-keys? true


change popover icon

change popover icon

--- src/cljs/salava/core/ui/popover.cljs
+++ src/cljs/salava/core/ui/popover.cljs
@@ -10,6 +10,6 @@
                                         :data-trigger "focus"
                                         :data-content content
                                         :data-placement placement
-                                        :href "#"} [:i.fa.fa-info-circle.fa-sm]])
+                                        :href "#"} [:i.fa.fa-question-circle.fa-sm]])
                  :component-did-mount (fn []
                                         (.getScript (js* "$") "/js/pop-over.js"))}))


ws-show-traced

ws-show-traced

--- src/com/billpiel/mem_tracer/core.clj
+++ src/com/billpiel/mem_tracer/core.clj
@@ -99,6 +99,10 @@
               slot
               force))

+(defn ws-show-traced
+  [& [ws]]
+  (:traced (or ws
+               (ws-get-current!))))

 ;; === END Workspace functions


remove debugging

remove debugging

--- src/com/billpiel/mem_tracer/core.clj
+++ src/com/billpiel/mem_tracer/core.clj
@@ -31,10 +31,10 @@
   "Traces a single call to a function f with args. 'name' is the
 symbol name of the function."
   [root name f args]
-  (let [parent (or #spy/d *trace-log-parent*
-                   #spy/d root)
-        _ #spy/d parent
-        this ^::entry {:id #spy/d (str (gensym ""))
+  (let [parent (or *trace-log-parent*
+                   root)
+        _ parent
+        this ^::entry {:id (str (gensym ""))
                        :parent-id (:id parent)
                        :depth (-> parent :depth inc)
                        :name name


Add scaling layer

Add scaling layer

--- src/cortex/impl/layers.clj
+++ src/cortex/impl/layers.clj
@@ -38,6 +38,36 @@
       input-gradient))

+;; LOGISTIC
+;; Module implementing a Logistic activation function over a numerical array
+(defrecord Logistic [output input-gradient]
+  cp/PModule
+    (calc [this input]
+      (m/assign! output input)
+      (m/logistic! output)
+      this)
+
+    (output [this]
+      (:output this))
+
+  cp/PNeuralTraining
+    (forward [this input]
+      (cp/calc this input))
+
+    (backward [this input output-gradient]
+      (let []
+        ;; input gradient = output * (1 - output) * output-gradient
+        (m/assign! input-gradient 1.0)
+        (m/sub! input-gradient output)
+        (m/mul! input-gradient output output-gradient)
+
+        ;; finally return this, input-gradient has been updated in-place
+        this))
+
+    (input-gradient [this]
+      input-gradient))
+
+
 ;; DROPOUT
 ;; Module implementing "dropout" functionality when training
 ;; Works as a identity function otherwise
@@ -63,6 +93,35 @@
         (m/assign! input-gradient output-gradient)
         (m/mul! input-gradient dropout)
         (m/scale! input-gradient (/ 1.0 probability))
+        this))
+
+    (input-gradient [this]
+      input-gradient))
+
+
+;; SCALE
+;; Module implementing simple scaling functionality
+;; Scale factor of 1.0 works as identity layer
+(defrecord Scale [output input-gradient ^double factor]
+  cp/PModule
+    (calc [this input]
+      (m/assign! output input)
+      (when (not= factor 1.0) (m/scale! output factor))
+      this)
+
+    (output [this]
+      (:output this))
+
+  cp/PNeuralTraining
+    (forward [this input]
+      (m/assign! output input)
+      (when (not= factor 1.0) (m/scale! output factor))
+      this)
+
+    (backward [this input output-gradient]
+      (let []
+        (m/assign! input-gradient output-gradient)
+        (when (not= factor 1.0) (m/scale! input-gradient factor))
         this))

     (input-gradient [this]


unused file

unused file

--- src/crawler/page_utils.clj
+++ src/crawler/page_utils.clj
@@ -1,16 +0,0 @@
-;;;; Soli Deo Gloria
-;;;; Author: spalakod@cs.cmu.edu
-
-(ns crawler.page-utils
-  (:require [net.cgrand.enlive-html :as html]))
-
-(defn get-links-out
-  [page-body]
-  (map
-   #(-> %
-       :attrs
-       :href)
-   (html/select
-    (html/html-resource
-     (java.io.StringReader. page-body))
-    [:a])))


Remove debug print

Remove debug print

--- src/cljs/asciinema_player/core.cljs
+++ src/cljs/asciinema_player/core.cljs
@@ -148,9 +148,7 @@
                                 (do
                                   (dispatch [:update-state #(-> % (update-screen v) reset-blink)])
                                   (recur (make-cursor-blink-chan)))
-                                (do
-                                  (dispatch [:finished])
-                                  (print (str "finished in " (elapsed-time-since start)))))
+                                (dispatch [:finished]))
             stop-playback-chan nil))) ; do nothing, break the loop
       (dispatch [:update-state reset-blink]))
     (-> state


Remove logging from image component

Remove logging from image component

--- src/cljs/comic_reader/ui/image.cljs
+++ src/cljs/comic_reader/ui/image.cljs
@@ -37,14 +37,10 @@
     (let [node (reagent/dom-node this)
           wp-down (make-waypoint {:element node
                                   :handler #(when (= % "down")
-                                              (.log js/console "down wp called")
-                                              (.log js/console %)
                                               (set-current-comic))})
           wp-up (make-waypoint {:element node
                                 :offset "bottom-in-view"
                                 :handler #(when (= % "up")
-                                            (.log js/console "up wp called")
-                                            (.log js/console %)
                                             (set-current-comic))})]
       (set-waypoints! [wp-up wp-down]))))


clear lookup field when ending deck edition

--- src/cljs/netrunner/deckbuilder.cljs
+++ src/cljs/netrunner/deckbuilder.cljs
@@ -72,6 +72,7 @@

 (defn end-edit [owner]
   (om/set-state! owner :edit false)
+  (om/set-state! owner :query "")
   (-> owner (om/get-node "viewport") js/$ (.removeClass "edit")))

 (defn save-deck [cursor owner]


Remove nonworking default route

Remove nonworking default route

--- src/cljs/salava/core/ui/routes.cljs
+++ src/cljs/salava/core/ui/routes.cljs
@@ -7,8 +7,7 @@
     #(layout/default site-navi content)))

 (defn ^:export routes [context]
-  {"/" [["" my/handler]
-        [true (placeholder (constantly [:p "404 Not Found"]))]]})
+  {"/" [["" my/handler]]})

 (defn ^:export navi [context] {})


fix failing oidc test (#1034)

fix failing oidc test (#1034)

--- ssclj/jar/test/com/sixsq/slipstream/ssclj/resources/session_oidc_lifecycle_test.clj
+++ ssclj/jar/test/com/sixsq/slipstream/ssclj/resources/session_oidc_lifecycle_test.clj
@@ -241,7 +241,7 @@
                     (request (str validate-url "?code=BAD")
                              :request-method :get)
                     (ltu/body->edn)
-                    (ltu/message-matches #".*unable to retrieve or decrypt OIDC user information.*")
+                    (ltu/message-matches #".*OIDC token is missing name/preferred_name.*")
                     (ltu/is-status 400))

                 (let [ring-info (-> session-anon


Add SVG reset from Chrome

Add SVG reset from Chrome

--- src/day8/re_frame/trace/styles.cljs
+++ src/day8/re_frame/trace/styles.cljs
@@ -117,7 +117,28 @@
    [:thead {:display "table-header-group"}]
    [:tbody {:display "table-row-group"}]
    [:th :td {:display "table-cell"}]
-   [:tr {:display "table-row"}]])
+   [:tr {:display "table-row"}]
+
+   ;; SVG Reset
+   ;; From https://chromium.googlesource.com/chromium/blink/+/master/Source/core/css/svg.css
+   ["svg:not(:root), symbol, image, marker, pattern, foreignObject"
+    {:overflow "hidden"}]
+   ["svg:root"
+    {:width "100%"
+     :height "100%"}]
+   ["text, foreignObject"
+    {:display "block"}]
+   ["text"
+    {:white-space "nowrap"}]
+   ["tspan, textPath"
+    {:white-space "inherit"}]
+   ;; No :focus
+   ["*"
+    {:transform-origin "0px 0px 0px"}]
+   ["html|* > svg"
+    {:transform-origin "50% 50%"}]
+
+   ])

 (def label-mixin {:color      text-color
                   :background background-gray-hint


~model: use a cache rather than simply a map

--- src/babel/italiano/grammar.cljc
+++ src/babel/italiano/grammar.cljc
@@ -763,7 +763,7 @@
       :morph (fn [expression & {:keys [from-language show-notes]}] (fo expression))
       :morph-ps fo-ps
       :rules rules
-      :rules-for-spec (atom {})
+      :rules-for-spec (atom (cache/fifo-cache-factory {} :threshold 1024))
       :rule-map (zipmap rules grammar)
       :tenses tenses}
      ((fn [model]