add tap gesture to go to next slide

add tap gesture to go to next slide

--- src/solar_system_of_js/core.cljs
+++ src/solar_system_of_js/core.cljs
@@ -951,6 +951,7 @@
 (defn on-swipe!
   [type-]
   (case type-
+    "tap" (next-slide!)
     "swipeleft" (next-slide!)
     "swiperight" (prev-slide!)
     nil))
@@ -958,7 +959,7 @@
 (defn init-touch!
   []
   (doto (js/Hammer. canvas)
-    (.on "swipeleft swiperight"
+    (.on "swipeleft swiperight tap"
       #(on-swipe! (aget % "type")))))

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


add closure to static-sphere and add more slide captions

--- src/solar_system_of_js/core.cljs
+++ src/solar_system_of_js/core.cljs
@@ -65,6 +65,7 @@
                      :angle 0}
             :typescript {:alpha 0}
             :soundscript {:alpha 0}
+            :closure {:alpha 0}
             :flow {:alpha 0}}
    :coffeescript {:alpha 0
                   :size 50
@@ -382,11 +383,15 @@

 (defn draw-typescript!
   [opts]
-  (draw-static-text! opts "TYPESCRIPT" 0))
+  (draw-static-text! opts "TYPESCRIPT" -100))

 (defn draw-flow!
   [opts]
-  (draw-static-text! opts "FLOW" 100))
+  (draw-static-text! opts "FLOW" 0))
+
+(defn draw-closure!
+  [opts]
+  (draw-static-text! opts "CLOSURE" 100))

 (defn draw-soundscript!
   [opts]
@@ -404,30 +409,32 @@

     ;; draw the arc
     (let [a (/ PI 2)
-          da (/ (* 2 PI) 3)
-          start-a (+ a da)]
+          num-arcs 4
+          da (/ (* 2 PI) num-arcs)
+          start-a (+ a (* 2 da))]

       (draw-static-arc! start-a (+ start-a angle) "#FFF")

       ;; hack to grey out previously visited arcs
       (let [second-a (cond
+                       (> angle (* 3 da)) (* 3 da)
                        (> angle (* 2 da)) (* 2 da)
                        (> angle da) da)]
-        (draw-static-arc! start-a (+ start-a second-a) "#CDD")))
-
-    ;; draw dividers
-    (when (= 1 alpha)
-      (line-width! 24)
-      (stroke-style! "#BCC")
-      (let [r (-> @state :static :sphere :r)]
-        (dotimes [i 3]
-          (stroke-line! 0 0 0 r)
-          (rotate! (/ (* 2 PI) 3)))))
+        (draw-static-arc! start-a (+ start-a second-a) "#CDD"))
+
+      ;; draw dividers
+      (when (= 1 alpha)
+        (line-width! 24)
+        (stroke-style! "#BCC")
+        (let [r (-> @state :static :sphere :r)]
+          (dotimes [i num-arcs]
+            (stroke-line! 0 0 0 r)
+            (rotate! da)))))
     )
   (restore!))

 (defn draw-static!
-  [{:keys [title sphere angle typescript soundscript flow]}]
+  [{:keys [title sphere angle typescript soundscript flow closure]}]
   (when-not (zero? (:alpha sphere))
     (save!)

@@ -444,6 +451,7 @@
     (draw-typescript! typescript)
     (draw-soundscript! soundscript)
     (draw-flow! flow)
+    (draw-closure! closure)

     (restore!)))

@@ -796,7 +804,7 @@
      #(go
         (swap! state assoc :caption
                (html [:div
-                      "We can't use all current & future JS features yet, but "
+                      "But current/future JS features are not yet available. "
                       [:a {:href "https://babeljs.io/"
                            :target "_blank"}
                        "Babel"]
@@ -804,7 +812,7 @@
                       [:a {:href "https://github.com/google/traceur-compiler"
                            :target "_blank"}
                        "Traceur"]
-                      " help alleviate this delay by transpiling to ES5."]))
+                      " help alleviate this by transpiling to ES5."]))
         (swap! state assoc-in [:transpiler :highlight] true)
         (let [chans [(multi-animate!
                        {:a :_ :b 0 :duration 0.01} [:es-captions :es8 :alpha]
@@ -826,7 +834,7 @@
      #(go
         (swap! state assoc :caption
                (html [:div
-                      "To catch common JS gotchas or code convention deviations, we rely on linters like "
+                      "Also, to catch common JS language gotchas in our code, we rely on linters like "
                       [:a {:href "http://jshint.com/"
                            :target "_blank"}
                        "JSHint"]
@@ -846,7 +854,7 @@
      #(go
         (swap! state assoc :caption
                (html [:div
-                      "For proper dependency loading, we need extra module tools like "
+                      "And for proper dependency loading, we need extra module tools like "
                       [:a {:href "http://browserify.org/"
                            :target "_blank"}
                        "Browserify"]
@@ -866,7 +874,7 @@
      #(go
         (swap! state assoc :caption
                (html [:div
-                      "Thus, modern JS has become married to a changing amalgam of tools required for its effective usage."
+                      "Thus, the modern view of JS development must include these tools as an effective foundation."
                       ]))
         (swap! state assoc-in [:modulesys :highlight] false)
         (let [t 2]
@@ -890,7 +898,7 @@
      #(go
         (swap! state assoc :caption
                (html [:div
-                      "(to be continued...)"
+                      "There are even several attempts to extend JS for extra type safety and optimization."
                       ]))
         (<! (multi-animate!
               {:a :_ :b 0 :duration 1} [:transpiler :alpha]
@@ -905,10 +913,19 @@
               {:a :_ :b 400 :duration 1} [:static :sphere :r])))

      ;; show static language titles
-     (let [angle (/ (* 2 PI) 3) ;; arc angle
-           low 0.2]             ;; alpha of faded out title
+     (let [num-arcs 4
+           angle (/ (* 2 PI) num-arcs) ;; arc angle
+           low 0.2]                    ;; alpha of faded out title
        [;; show typescript
         #(go
+           (swap! state assoc :caption
+                  (html [:div
+                         "Microsoft's "
+                         [:a {:href "http://www.typescriptlang.org/"
+                              :target "_blank"}
+                          "TypeScript"]
+                         " extends ES6 with optional type annotation syntax and interfaces."
+                         ]))
            (<! (multi-animate!
                  {:a :_ :b 300 :duration 1} [:cam :x]
                  {:a :_ :b 1 :duration 1} [:static :typescript :alpha]
@@ -917,31 +934,68 @@

         ;; show flow
         #(go
+           (swap! state assoc :caption
+                  (html [:div
+                         "Facebook's "
+                         [:a {:href "http://flowtype.org/"
+                              :target "_blank"}
+                          "Flow"]
+                         " will check for type safety as well, but even without type annotations."
+                         ]))
            (swap! state assoc-in [:static :typescript :alpha] low)
            (<! (multi-animate!
                  {:a :_ :b 1 :duration 1} [:static :flow :alpha]
                  {:a :_ :b (* 2 angle) :duration 1} [:static :sphere :angle]
                  )))

+        ;; show closure
+        #(go
+           (swap! state assoc :caption
+                  (html [:div
+                         "Google uses its own "
+                         [:a {:href "https://developers.google.com/closure/"
+                              :target "_blank"}
+                          "Closure Tools"]
+                         " to support "
+                         [:a {:href "https://developers.google.com/closure/compiler/docs/js-for-compiler"
+                              :target "_blank"}
+                          "jsdoc tags"]
+                         " for aggressive type optimization."
+                         ]))
+           (swap! state assoc-in [:static :flow :alpha] low)
+           (<! (multi-animate!
+                 {:a :_ :b 1 :duration 1} [:static :closure :alpha]
+                 {:a :_ :b (* 3 angle) :duration 1} [:static :sphere :angle]
+                 )))
+
         ;; show soundscript
         #(go
-           (swap! state assoc-in [:static :flow :alpha] low)
+           (swap! state assoc :caption
+                  (html [:div
+                         "Google is also experimenting with "
+                         [:a {:href "https://developers.google.com/v8/experiments"
+                              :target "_blank"}
+                          "SoundScript"]
+                         ", a new \"use stricter+types\" mode for VM-level optimizations."
+                         ]))
+           (swap! state assoc-in [:static :closure :alpha] low)
            (<! (multi-animate!
                  {:a :_ :b 1 :duration 1} [:static :soundscript :alpha]
-                 {:a :_ :b (* 3 angle) :duration 1} [:static :sphere :angle]
+                 {:a :_ :b (* 4 angle) :duration 1} [:static :sphere :angle]
+                 )))
+
+        ;; fade out staticsphere details
+        #(go
+           (<! (multi-animate!
+                 {:a :_ :b 0 :duration 1} [:static :typescript :alpha]
+                 {:a :_ :b 0 :duration 1} [:static :flow :alpha]
+                 {:a :_ :b 0 :duration 1} [:static :closure :alpha]
+                 {:a low :b 0 :duration 1} [:static :soundscript :alpha]
+                 {:a :_ :b 0 :duration 1} [:cam :x]
+                 {:a :_ :b 0 :duration 1} [:static :sphere :angle]
+                 {:a :_ :b 0 :duration 1} [:static :title :alpha]
+                 {:a :_ :b 0.2 :duration 2} [:cam :zoom]
                  )))])
-
-     ;; fade out staticsphere details
-     #(go
-        (<! (multi-animate!
-              {:a :_ :b 0 :duration 1} [:static :typescript :alpha]
-              {:a :_ :b 0 :duration 1} [:static :flow :alpha]
-              {:a :_ :b 0 :duration 1} [:static :soundscript :alpha]
-              {:a :_ :b 0 :duration 1} [:cam :x]
-              {:a :_ :b 0 :duration 1} [:static :sphere :angle]
-              {:a :_ :b 0 :duration 1} [:static :title :alpha]
-              {:a :_ :b 0.2 :duration 2} [:cam :zoom]
-              )))

      ;; show coffeescript
      #(go


simple fix

simple fix

Signed-off-by: Yen-Chin Lee <082d453d72dce940e12089a4ad48b97cfe1f3ec4@gmail.com>

--- src/clj/brains_brain/core.clj
+++ src/clj/brains_brain/core.clj
@@ -43,7 +43,7 @@
     (draw g
           (rect xb yb cell-size)
           (style :background (case cell
-                               :on :red
+                               1 :red
                                :white) ; default (:off)
                  :foreground :black ; broader
                  ))))


fully implement Toshiyuki Sakai

fully implement Toshiyuki Sakai

--- src/clj/game/cards-assets.clj
+++ src/clj/game/cards-assets.clj
@@ -660,7 +660,33 @@
                  :effect (effect (gain :credit (* 2 (get card :advance-counter 0))) (trash card))}]}

    "Toshiyuki Sakai"
-   {:advanceable :always}
+   (advance-ambush 0
+    {:effect (effect (resolve-ability
+                       {:prompt "Choose an asset or agenda in HQ"
+                        :choices {:req #(and (or (is-type? % "Agenda")
+                                                 (is-type? % "Asset"))
+                                             (in-hand? %))}
+                        :msg "swap it for an asset or agenda from HQ"
+                        :effect (req (let [tidx (ice-index state card)
+                                           srvcont (get-in @state (cons :corp (:zone card)))
+                                           c (get card :advance-counter 0)
+                                           newcard (assoc target :zone (:zone card) :advance-counter c)
+                                           newcont (apply conj (subvec srvcont 0 tidx) newcard (subvec srvcont tidx))]
+                                       (resolve-ability state side
+                                         {:effect (req (swap! state assoc-in (cons :corp (:zone card)) newcont)
+                                                       (swap! state update-in [:corp :hand]
+                                                         (fn [coll] (remove-once #(not= (:cid %) (:cid newcard)) coll)))
+                                                       (trigger-event state side :corp-install newcard)
+                                                       (move state side card :hand))} card nil)
+                                       (resolve-prompt state :runner {:choice "No"})
+                                       ; gets rid of prompt to trash Toshiyuki since it's back in HQ now
+                                       (resolve-ability state :runner
+                                         {:optional
+                                          {:prompt "Access the newly installed card?" :player :runner
+                                           :priority true
+                                           :yes-ability {:effect (effect (handle-access [newcard]))}}} card nil)))}
+                      card nil))}
+    "Swap Toshiyuki Sakai with an agenda or asset from HQ?")

    "Turtlebacks"
    {:events {:server-created {:msg "gain 1 [Credits]" :effect (effect (gain :credit 1))}}}


implement Showing Off

implement Showing Off

--- src/clj/game/cards-events.clj
+++ src/clj/game/cards-events.clj
@@ -111,7 +111,7 @@
    "Escher"
    (let [ice-index (fn [state i] (first (keep-indexed #(when (= (:cid %2) (:cid i)) %1)
                                                       (get-in @state (cons :corp (:zone i))))))
-         eshelp (fn es [] {:prompt "Select two pieces of ice to swap positions"
+         eshelp (fn es [] {:prompt "Select two pieces of ICE to swap positions"
                            :choices {:req #(and (= (first (:zone %)) :servers) (= (:type %) "ICE")) :max 2}
                            :effect (req (if (= (count targets) 2)
                                           (let [fndx (ice-index state (first targets))
@@ -125,7 +125,7 @@
                                             (update-ice-strength state side fnew)
                                             (update-ice-strength state side snew)
                                             (resolve-ability state side (es) card nil))
-                                          (system-msg state side "has finished rearranging ice")))})]
+                                          (system-msg state side "has finished rearranging ICE")))})]
      {:effect (effect (run :hq {:replace-access {:msg "rearrange installed ice"
                                                  :effect (effect (resolve-ability (eshelp) card nil))}} card))})

@@ -453,6 +453,16 @@
                                      :effect (effect (ice-strength-bonus -2))}
                   :pass-ice sc :run-ends sc})}

+   "Showing Off"
+   {:effect (effect (run :rd
+                      {:replace-access
+                       {:msg "access cards from the bottom of R&D"
+                        :effect (req (swap! state assoc-in [:corp :deck]
+                                            (rseq (into [] (get-in @state [:corp :deck]))))
+                                     (do-access state side (:server run))
+                                     (swap! state assoc-in [:corp :deck]
+                                            (rseq (into [] (get-in @state [:corp :deck])))))}} card))}
+
    "Singularity"
    {:prompt "Choose a server" :choices (req remotes)
     :effect (effect (run target


Fix TZ issues in solver

Fix TZ issues in solver

--- src/clj/herder/solver/run.clj
+++ src/clj/herder/solver/run.clj
@@ -49,8 +49,9 @@
           (.solve solver configured)
           (d/delete db/schedule (d/where {:convention_id id}))
           (doseq [event (.getEvents (.getBestSolution solver))
-                  :let [slottime (.getStart (.getSlot event))
-                        day (t/date-time (t/year slottime) (t/month slottime) (t/day slottime))
+                  :let [slottime (c/to-date-time (.getStart (.getSlot event)))
+                        slotoffset (t/millis (.getOffset (t/default-time-zone) slottime)) ; needed to fix TZ fun
+                        day (t/minus (t/date-time (t/year slottime) (t/month slottime) (t/day slottime)) slotoffset)
                         values {:id (uuid/v1)
                                 :date (c/to-sql-date slottime)
                                 :slot_id (:id (first (filter #(t/equal? slottime (t/plus day (t/minutes (:start-minutes %)))) slots)))


Prevent sql injections

Prevent sql injections

--- src/clj/salava/gallery/db.clj
+++ src/clj/salava/gallery/db.clj
@@ -68,9 +68,7 @@
     (select-gallery-tags {:badge_ids badge_ids} (get-db ctx))))

 (defn str-ids [ids]
-  (if (empty? ids)
-      "()"
-      (str "(" (reduce (fn [x y] (str x ",'" y "'"  )) (str "'"(first ids)"'") (rest ids)) ")")))
+    (str "('" (apply str (interpose "','" (map #(string/replace % #"\W" "") ids))) "')"))

 (defn badge-count [search page_count]
   (let [limit 48


IRC text reset is not function

IRC text reset is not function

--- src/clj_mrazik/dictionary.clj
+++ src/clj_mrazik/dictionary.clj
@@ -36,8 +36,7 @@
     [string]
     (str (char 2) string (char 15)))

-(defn reset
-    []
+(def reset
     (str (char 15)))

 (defn yes-no-with-caution
@@ -49,7 +48,7 @@

 (defn incorrect-forms
     [w]
-    (str (reset)
+    (str reset
          (bold "class: ")           (:class w) " "
          (bold "use it: ")          (yes-no-with-caution w :use) " "
          (bold "description: ")     (:description w) " "
@@ -60,7 +59,7 @@

 (defn correct-forms
     [w]
-    (str (reset)
+    (str reset
          (bold "class: ")           (:class w) " "
          (bold "use it: ")          (yes-no-with-caution w :use) " "
          (bold "description: ")     (:description w) " "
@@ -71,7 +70,7 @@

 (defn preferred-forms
     [w]
-    (str (reset)
+    (str reset
          (bold "class: ")           (:class w) " "
          (bold "use it: ")          (yes-no-with-caution w :use) " "
          (bold "description: ")     (:description w) " "


Just ignore abort requests when we aren't in a server exchange.

--- src/clojure/picard/server.clj
+++ src/clojure/picard/server.clj
@@ -172,7 +172,7 @@
     (let [current-state @state]
       (when-not (.aborting? current-state)

-        (when-not (.upstream current-state)
+        (when-not (or (= :abort evt) (.upstream current-state))
           (throw (Exception. "Not callable until request is sent.")))

         (cond


fix bug in msg trimming code

fix bug in msg trimming code

--- src/closerve_example/core.clj
+++ src/closerve_example/core.clj
@@ -28,7 +28,8 @@
  (let [chat-msg (cmd "chatmsg")]
    (if (string? chat-msg)
      (do
-       (swap! chat-msgs #(apply vector (take 10 (conj %1 %2))) chat-msg)
+       (swap! chat-msgs #(apply vector (drop (- (count %1) 9)
+                                             (conj %1 %2))) chat-msg)
        (send-cmd-to-page (:page-id context)
                          {:act :reset
                           :selector


CMR-377: Adding function to find the coordinate system of a shape.

--- src/cmr/spatial/relations.clj
+++ src/cmr/spatial/relations.clj
@@ -20,6 +20,11 @@
 (defprotocol SpatialRelations
   "Defines functions for determining relations between different spatial areas."

+  (coordinate-system
+    [shape]
+    "Returns the coordinate system of a shape if it has one. Points do not occupy
+    a set coordinate system.")
+
   (mbr [shape] "Returns the minimum bounding rectangle of the shape")

   (contains-north-pole? [shape] "Returns true if the shape contains the north pole")
@@ -40,6 +45,11 @@
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   cmr.spatial.point.Point

+  (coordinate-system
+    [point]
+    ;; Points don't have a specific coordinate system
+    nil)
+
   (mbr
     [point]
     (m/point->mbr point))
@@ -78,6 +88,10 @@
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   cmr.spatial.line_string.LineString

+  (coordinate-system
+    [line]
+    (:coordinate-system line))
+
   (mbr
     [line]
     (:mbr line))
@@ -114,6 +128,10 @@

   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   cmr.spatial.mbr.Mbr
+
+  (coordinate-system
+    [_]
+    :cartesian)

   (mbr [br] br)

@@ -152,6 +170,10 @@
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   cmr.spatial.geodetic_ring.GeodeticRing

+  (coordinate-system
+    [_]
+    :geodetic)
+
   (mbr
     [ring]
     (:mbr ring))
@@ -191,6 +213,10 @@
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   cmr.spatial.cartesian_ring.CartesianRing

+  (coordinate-system
+    [_]
+    :cartesian)
+
   (mbr
     [ring]
     (:mbr ring))
@@ -229,6 +255,10 @@

   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   cmr.spatial.polygon.Polygon
+
+  (coordinate-system
+    [polygon]
+    (:coordinate-system polygon))

   (mbr
     [polygon]


Make ns macro happy

Make ns macro happy

--- src/clj/shale/ext/ResumableRemoteWebDriver.clj
+++ src/clj/shale/ext/ResumableRemoteWebDriver.clj
@@ -17,7 +17,7 @@
                     org.openqa.selenium.Capabilities]}
     :post-init resume
     :extends clj_webdriver.ext.remote.RemoteWebDriverExt
-    :prefix -))
+    :prefix "-"))

 (defn -url-init
   [^URL node-url ^String session-id]


GAWB-2533: Shift-drag to resize and distribute width to next resizable column (#923)

* initial pass

* do this a better way, and enforce minimum column widths

* ensure order

--- src/cljs/main/broadfcui/common/table/body.cljs
+++ src/cljs/main/broadfcui/common/table/body.cljs
@@ -16,6 +16,7 @@

 (def ^:private column-drag-margin 11)
+(def ^:private minimum-column-size 16)

 (defn- header [{:keys [joined-columns sort-column sort-order set-sort style
@@ -99,8 +100,14 @@
                                           :column-display (:column-display props)
                                           :table-behavior (:behavior props)})
             start-column-drag
-            (fn [{:keys [e width index]}]
-              (swap! locals assoc :start-mouse-x (.-clientX e) :start-width width)
+            (fn [{:keys [e index]}]
+              (swap! locals assoc
+                     :next-column-index (when (.-shiftKey e)
+                                          (some->> (map vector (range) joined-columns)
+                                                   (drop (inc index))
+                                                   (filter (comp :resizable? val))
+                                                   first key))
+                     :mouse-x (.-clientX e))
               (swap! state assoc
                      :dragging? true :drag-column index
                      :saved-user-select-state (common/disable-text-selection)))
@@ -117,10 +124,22 @@
       (when (:dragging? @state)
         (let [{:keys [update-column-display column-display]} props
               {:keys [drag-column]} @state
-              {:keys [start-mouse-x start-width]} @locals
-              delta-x (- (.-clientX e) start-mouse-x)
-              new-width (max (+ start-width delta-x) 10)]
-          (update-column-display (assoc-in column-display [drag-column :width] new-width)))))}
+              {:keys [next-column-index mouse-x]} @locals
+              new-x (.-clientX e)
+              delta-x (- new-x mouse-x)
+              new-this-width (+ (get-in column-display [drag-column :width]) delta-x)
+              new-next-width (when next-column-index
+                               (- (get-in column-display [next-column-index :width]) delta-x))]
+          (when (and (not (zero? delta-x))
+                     (> new-this-width minimum-column-size)
+                     (or (not next-column-index)
+                         (> new-next-width minimum-column-size)))
+            (swap! locals assoc :mouse-x new-x)
+            (if next-column-index
+              (update-column-display (-> column-display
+                                         (assoc-in [drag-column :width] new-this-width)
+                                         (assoc-in [next-column-index :width] new-next-width)))
+              (update-column-display (assoc-in column-display [drag-column :width] new-this-width)))))))}
    (utils/with-window-listeners
     {"mousemove"
      (fn [{:keys [this]} e]


Add proper async support without intrusion and dereferecing without asking

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -28,7 +28,7 @@
             Cluster$Builder SimpleStatement PreparedStatement BoundStatement HostDistance PoolingOptions
             SSLOptions ProtocolOptions$Compression]
            [com.datastax.driver.auth DseAuthProvider]
-           [com.google.common.util.concurrent Futures FutureCallback]
+           [com.google.common.util.concurrent ListenableFuture Futures FutureCallback]
            java.net.URI
            [javax.net.ssl TrustManagerFactory KeyManagerFactory SSLContext]
            [java.security KeyStore SecureRandom]
@@ -247,6 +247,23 @@
   (build-statement [s]
     s))

+(defprotocol Listenable
+  (add-listener [_ runnable executor]))
+(deftype AsyncResult [fut]
+  clojure.lang.IDeref
+  (deref [_]
+    (conv/to-clj @fut))
+
+  clojure.lang.IBlockingDeref
+  (deref [_ time-period time-unit]
+    (conv/to-clj (deref fut time-period time-unit)))
+
+  Listenable
+  (add-listener [_ runnable executor]
+    (.addListener fut runnable executor)
+    )
+  )
+
 (defn execute
   [^Session session query]
   (if hayt/*prepared-statement*
@@ -254,16 +271,7 @@
       (.prepare session q))
     (let [^Statement built-statement (build-statement query)]
       (if *async*
-        (let [async-result (.executeAsync session built-statement)]
-          (proxy [clojure.lang.IDeref
-                  clojure.lang.IBlockingDeref] []
-            (deref
-              ([]
-                 (conv/to-clj @async-result))
-              ([time-period time-unit]
-                 (conv/to-clj (deref async-result time-period time-unit))))
-            ))
-
+        (AsyncResult. (.executeAsync session built-statement))
         (-> (.execute session built-statement)
             (conv/to-clj))
         ))))
@@ -294,27 +302,3 @@
 ;; defn get-keyspace
 ;; defn get-keyspaces
 ;; defn rebuild-schema
-
-;;
-;; Result Handling
-;;
-
-(defn set-callbacks
-  "Set callbacks on a result future"
-  [^ResultSetFuture fut {:keys [success failure]}]
-  {:pre [(not (nil? success))]}
-  (future (when-let [res @fut]
-            (if (= (type res) Exception)
-              (if (nil? failure)
-                (throw res)
-                (failure res))
-              (success res))))
-  fut)
-
-(defn get-result
-  "Get result from Future. Optional `timeout-ms` should be specified in milliseconds."
-  ([^ResultSetFuture future]
-     (conv/to-clj (.get future)))
-  ([^ResultSetFuture future ^long timeout-ms]
-     (conv/to-clj (.get future timeout-ms
-                        java.util.concurrent.TimeUnit/MILLISECONDS))))


fix env for tests

fix env for tests

--- test/ci3/agent/core_test.clj
+++ test/ci3/agent/core_test.clj
@@ -3,7 +3,9 @@
    [ci3.agent.core :as sut]
    [matcho.core :refer [match]]
    [unifn.core :as u]
+   [unifn.env :as e]
    [ci3.k8s :as k8s]
+   [clojure.tools.logging :as log]
    [clojure.test :refer :all]))

 (def bid "build-112233")
@@ -78,10 +80,28 @@

 (use-fixtures :once agent-fixture)

+
+(defn run [& [arg]]
+  (log/info "Run agent")
+  (u/*apply
+   [::sut/get-build
+    ::sut/get-repository
+    ::sut/workspace
+    ::sut/checkout-project
+    ::sut/get-build-config
+    ::sut/run-build
+    ::sut/catch-errors {::u/intercept :all}]
+   arg))
+
+
+(defn arg [a]
+  (merge-with merge (u/*apply [::e/env ::e/raw-env] {}) a))
+
 (deftest agent-get-build
   (match
-   (sut/run {:k8s cfg
-             :env {:build-id bid :BUILD_ID bid}})
+   (run (arg
+         {:k8s cfg
+          :env {:build-id bid :BUILD_ID bid}}))
    {::sut/build  {:metadata {:name bid}
                   :repository rid}
     :ci3.repo.core/repository {:metadata {:name rid}}
@@ -89,7 +109,7 @@
     ::sut/build-config {:description "build in root"}})

   (match
-   (sut/run {:k8s cfg
+   (run {:k8s cfg
              :env {:build-id bid-src :BUILD_ID bid-src}})
    {::sut/build  {:metadata {:name bid-src}
                   :repository rid-src}
@@ -98,7 +118,7 @@
     ::sut/build-config {:description "build in src"}})

   (match
-   (sut/run {:k8s cfg
+   (run {:k8s cfg
              :env {:build-id ghbid :BUILD_ID ghbid}})
    {::sut/build  {:metadata {:name ghbid}
                   :repository ghrid}


Exclude spec

Exclude spec

--- test/expound/alpha_test.cljc
+++ test/expound/alpha_test.cljc
@@ -2280,12 +2280,16 @@
       ;; because the algorithm to fix up the 'in' paths depends
       ;; on the non-conforming value existing somewhere within
       ;; the top-level form
-      (when-not (some
-                 #{"clojure.spec.alpha/fspec"}
-                 (->> spec
-                      inline-specs
-                      (tree-seq coll? identity)
-                      (map str)))
+      (when-not
+          ;; a conformer generally won't work against any arbitrary value
+          ;; e.g. we can't conform 0 with the conformer 'seq'
+       (or (contains? #{:conformers-test/string-AB} spec)
+           (some
+            #{"clojure.spec.alpha/fspec"}
+            (->> spec
+                 inline-specs
+                 (tree-seq coll? identity)
+                 (map str))))
         (is (string? (expound/expound-str spec form)))))))

 #?(:clj


Add instrumentation to queues

Add instrumentation to queues

--- src/io/cyanite/engine/queue.clj
+++ src/io/cyanite/engine/queue.clj
@@ -6,13 +6,16 @@
            com.lmax.disruptor.dsl.Disruptor
            com.lmax.disruptor.EventFactory
            com.lmax.disruptor.EventTranslatorOneArg
+           com.lmax.disruptor.ExceptionHandler
            com.lmax.disruptor.EventHandler)
   (:require [com.stuartsierra.component :as component]
-            [clojure.tools.logging      :refer [warn]]
+            [clojure.tools.logging      :refer [warn error]]
             [metrics.counters           :refer [defcounter inc! dec!]]))

-(defcounter cnt-queue)
-(defcounter cnt-errors)
+(defcounter cnt-ingestq)
+(defcounter cnt-writeq)
+(defcounter cnt-errors-ingestq)
+(defcounter cnt-errors-writeq)

 (defonce default-poolsize 4)
 (defonce default-capacity (int 1024))
@@ -48,28 +51,49 @@
     (onEvent [this event sequence eob]
       (f @event))))

-(defrecord DisruptorQueue [disruptor translator]
+(defn exception-handler
+  [f]
+  (reify ExceptionHandler
+    (handleEventException [this ex sequence event]
+      (f [ex event]))
+    (handleOnShutdownException [this ex]
+      ;; no-op
+      )
+    (handleOnStartException [this ex]
+      ;; no-op
+      )))
+
+(defrecord DisruptorQueue [disruptor translator cnt error-cnt]
   QueueEngine
   (shutdown! [this]
     (.shutdown disruptor))
   (add! [this e]
     (.publishEvent disruptor translator e))
   (consume! [this f]
-    (.handleEventsWith disruptor (into-array EventHandler [(event-handler f)]))
+    (.handleEventsWith disruptor (into-array EventHandler [(event-handler (fn [e]
+                                                                            (inc! cnt)
+                                                                            (f e)))]))
+    (.handleExceptionsWith disruptor (exception-handler (fn [[ex event]]
+                                                          (inc! error-cnt)
+                                                          (error ex "could not handle an event"))))
     (.start disruptor)))

 (defn make-queue
-  [defaults]
+  [defaults cnt error-cnt]
   (let [capacity (or (:queue-capacity defaults) default-capacity)
         pool     (threadpool (or (:pool-size defaults) default-poolsize))
         factory  (make-event-factory #(volatile! nil))]
     (DisruptorQueue. (disruptor factory capacity pool)
-                     (make-translator vreset!))))
+                     (make-translator vreset!)
+                     cnt
+                     error-cnt)))

 (defrecord BlockingMemoryQueue [ingestq writeq defaults]
   component/Lifecycle
   (start [this]
-    (assoc this :ingestq (make-queue defaults) :writeq  (make-queue defaults)))
+    (assoc this
+           :ingestq (make-queue defaults cnt-ingestq cnt-errors-ingestq)
+           :writeq  (make-queue defaults cnt-writeq cnt-errors-writeq)))
   (stop [this]
     (shutdown! ingestq)
     (shutdown! writeq)


Add type hints to avoid reflection

Add type hints to avoid reflection

--- src/main/clojure/hawk/watcher.clj
+++ src/main/clojure/hawk/watcher.clj
@@ -2,7 +2,8 @@
   (:require [clojure.java.io :as io]
             [clojure.set :refer [map-invert]])
   (:import (hawk SensitivityWatchEventModifier)
-           (java.nio.file FileSystems Path Paths StandardWatchEventKinds WatchEvent$Modifier)
+           java.io.File
+           (java.nio.file FileSystems Path Paths StandardWatchEventKinds WatchEvent WatchEvent$Modifier WatchKey WatchService)
            (com.barbarysoftware.watchservice StandardWatchEventKind WatchableFile)))

 (def barbary-watch-event-kinds
@@ -25,47 +26,49 @@
   (take! [this])
   (stop! [this]))

-(defn- take-events [watcher normalize]
-  (when-let [watch-key (try
-                         (.take watcher)
-                         (catch InterruptedException _ _ nil))]
-    (let [events (for [event (.pollEvents watch-key)
+(defn- take-events [^WatchService watcher normalize]
+  (when-let [^WatchKey watch-key (try
+                                   (.take watcher)
+                                   (catch InterruptedException _ _ nil))]
+    (let [events (for [^WatchEvent event (.pollEvents watch-key)
                        :let [kind (.kind event)
                              context (.context event)]]
                    (normalize watch-key kind context))]
       (.reset watch-key)
       events)))

-(defn- recursive-register! [this path events f]
+(defn- recursive-register! [this ^Path path events f]
   (let [events (into-array (map standard-watch-event-kinds events))]
-    (.reset (f events)))
-  (doseq [dir (-> path .toFile .listFiles)]
+    (.reset ^WatchKey (f events)))
+  (doseq [^File dir (-> path .toFile .listFiles)]
     (when (.isDirectory dir)
       (register! this (.toPath dir) events))))

 (def java-watcher-impl
-  {:register! (fn [this path events]
+  {:register! (fn [this ^Path path events]
                 (recursive-register! this path events
                   #(.register path this %)))
    :take! (fn [this]
             (try (take-events
                    this
-                   (fn [watch-key kind context]
-                     {:file (-> (.watchable watch-key)
-                              (.resolve context) .toFile .getCanonicalFile)
+                   (fn [^WatchKey watch-key kind ^Path context]
+                     {:file (.. ^Path (.watchable watch-key)
+                                (resolve context)
+                                toFile
+                                getCanonicalFile)
                       :kind ((map-invert standard-watch-event-kinds) kind)}))
                  (catch java.nio.file.ClosedWatchServiceException _ _ nil)))
-   :stop! (fn [this]
-            (doto this .close))})
+   :stop! (fn [^WatchService this]
+            (.close this))})

 (def polling-watcher-impl
   (assoc java-watcher-impl
-    :register! (fn [this path events]
+    :register! (fn [^hawk.PollingWatchService this path events]
                  (recursive-register! this path events
                    #(.register this path % (into-array WatchEvent$Modifier []))))))

 (def barbary-watcher-impl
-  {:register! (fn [this path events]
+  {:register! (fn [this ^Path path events]
                 (let [file (-> path .toFile WatchableFile.)
                       events (into-array (map barbary-watch-event-kinds events))]
                   (.register file this events)))
@@ -76,8 +79,8 @@
                      {:file (-> context str io/file .getCanonicalFile)
                       :kind ((map-invert barbary-watch-event-kinds) kind)}))
                  (catch com.barbarysoftware.watchservice.ClosedWatchServiceException _ _ nil)))
-   :stop! (fn [this]
-            (doto this .close))})
+   :stop! (fn [^WatchService this]
+            (.close this))})

 (extend java.nio.file.WatchService Watcher java-watcher-impl)
 (extend hawk.PollingWatchService Watcher polling-watcher-impl)


cjl - Some clear rows tests

cjl - Some clear rows tests

--- test/icfp2015/board_test.clj
+++ test/icfp2015/board_test.clj
@@ -72,3 +72,21 @@
                            :current-unit nil }
           actual-board (lock-current-unit board)]
       (is (= expected-board actual-board)))))
+
+(deftest clear-rows-test
+  (testing "no rows cleared if no full rows"
+    (let [board { :width 5
+                  :height 5
+                  :filled #{ [0 0] [1 1] [2 2] [3 3] [4 4] } }
+          actual-board (clear-rows board)
+          expected-board board]
+      (is (= expected-board actual-board))))
+  (testing "rows cleared if full rows"
+    (let [board { :width 5
+                  :height 5
+                  :filled #{ [4 0] [4 1] [4 2] [4 3] [4 4] } }
+          actual-board (clear-rows board)
+          expected-board { :width 5
+                           :height 5
+                           :filled #{} } ]
+      (is (= expected-board actual-board)))))


Whitespace

Whitespace

--- test/oxcart/pattern_test.clj
+++ test/oxcart/pattern_test.clj
@@ -9,34 +9,41 @@
    (defn foo [x]
      (inc x))))

+
 (def bar
   (ast
    (def bar
      (fn [x] (dec x)))))

+
 (def fail
   (ast
    (fn [] 1)))
+

 (deftest def?-tests
   (is (p/def? foo))
   (is (p/def? bar))
   (is-not (p/def? fail)))

+
 (deftest def->symbol-tests
   (is (= 'foo (p/def->symbol foo)))
   (is (= 'bar (p/def->symbol bar)))
   (is (nil? (p/def->symbol fail))))
+

 (def private-defn
   (ast
    (defn ^:private baz [x]
      (* x x))))

+
 (def private-def
   (ast
    (def ^:private quxx
      (fn [x] (mod x 2)))))
+

 (deftest public?-tests
   (is (p/public? foo))
@@ -44,20 +51,24 @@
   (is-not (p/public? fail))
   (is-not (p/public? private-defn)))

+
 (deftest private?-tests
   (is (p/private? private-defn))
   (is (p/private? private-def))
   (is-not (p/private? foo))
   (is-not (p/private? bar)))

+
 (def dynamic-defn
   (ast
    (defn ^:dynamic fred [x]
      (rand-int (mod x 4)))))

+
 (def dynamic-def
   (ast
    (def ^:dynamic *foo* nil)))
+

 (deftest dynamic?-test
   (is (p/dynamic? dynamic-defn))
@@ -68,15 +79,18 @@
   (is-not (p/dynamic? bar))
   (is-not (p/dynamic? fail)))

+
 (def const-defn
   (ast
    (defn ^:const corge [x]
      (/ x x))))

+
 (def const-def
   (ast
    (def ^:const grault
      (fn [x] (- x 2)))))
+

 (deftest const?-tests
   (is (p/const? const-defn))


CLI script should use version from config if set

--- src/main/shadow/cljs/npm/cli.cljs
+++ src/main/shadow/cljs/npm/cli.cljs
@@ -102,7 +102,7 @@
         (not= (:dependencies cp) (:dependencies config))
         )))

-(defn get-classpath [project-root {:keys [cache-root] :as config}]
+(defn get-classpath [project-root {:keys [cache-root version] :as config}]
   (let [cp-file (path/resolve project-root cache-root "classpath.edn")]

     ;; only need to rebuild the classpath if :dependencies
@@ -112,7 +112,7 @@

       ;; re-create classpath by running the java helper
       (let [jar (js/require "shadow-cljs-jar/path")]
-        (run-java project-root ["-jar" jar jar-version (path/resolve project-root "shadow-cljs.edn")])))
+        (run-java project-root ["-jar" jar version (path/resolve project-root "shadow-cljs.edn")])))

     ;; only return :files since the rest is just cache info
     (-> (util/slurp cp-file)
@@ -123,12 +123,12 @@
 ;; FIXME: windows uses ;
 (def cp-seperator ":")

-(defn aot-compile [project-root aot-path classpath]
+(defn aot-compile [project-root {:keys [version] :as config} aot-path classpath]
   (let [version-file (path/resolve aot-path "version")]

     ;; FIXME: is it enough to AOT only when versions change?
     (when (or (not (fs/existsSync version-file))
-              (not= jar-version (util/slurp version-file)))
+              (not= version (util/slurp version-file)))

       (mkdirp/sync aot-path)

@@ -142,7 +142,7 @@
          "clojure.main"
          "-e" "(run! compile '[shadow.cljs.devtools.api shadow.cljs.devtools.server shadow.cljs.devtools.cli])"])

-      (fs/writeFileSync version-file jar-version)
+      (fs/writeFileSync version-file version)
       )))

 (defn run-standalone
@@ -159,7 +159,7 @@
         cli-args
         (into ["-cp" classpath "shadow.cljs.devtools.cli" "--npm"] args)]

-    (aot-compile project-root aot-path classpath)
+    (aot-compile project-root config aot-path classpath)

     (println "shadow-cljs - starting ...")
     (run-java project-root cli-args)
@@ -172,7 +172,7 @@

 (defn main [args]
   (when-let [config-path (ensure-config)]
-    (println "shadow-cljs -" jar-version "using" config-path)
+    (println "shadow-cljs - using" config-path)

     (let [project-root
           (path/dirname config-path)


don't write out site data yet

don't write out site data yet

--- src/main/cljs_api_gen/write.clj
+++ src/main/cljs_api_gen/write.clj
@@ -383,7 +383,7 @@
     (mkdirs (parent site-filename))

     (spit gh-filename (render-template "var.md" data))
-    (spit site-filename
+    #_(spit site-filename
       (yaml/generate-string
         {:sectionid "docs"
          :layout "var"
@@ -701,8 +701,8 @@
     (doseq [item (vals (:symbols result))]
       (dump-var-file! item))

-    (println "writing var data for site...")
-    (spit (str *output-dir* "/" site-dir "/vars.yaml")
+    #_(println "writing var data for site...")
+    #_(spit (str *output-dir* "/" site-dir "/vars.yaml")
           (binding [*doclink-prefix* site-docs-root
                     *doclink-ext* ".html"]
             (let [vars (map var-file-data (vals (:symbols result)))


Pluralize characters

Pluralize characters

--- src/discuss/translations.cljs
+++ src/discuss/translations.cljs
@@ -83,7 +83,7 @@
                      :author           "Author"
                      :back             "Back"
                      :because          "because"
-                     :chars-remaining  "add at least %d more characters"
+                     :chars-remaining  "add at least %d more character(s)"
                      :close            "Close"
                      :delete           "Delete"
                      :hello            "Hello"


make osc-validator check for actual types not the 'fuzzy' types Clojure uses

--- src/overtone/sc/osc_validator.clj
+++ src/overtone/sc/osc_validator.clj
@@ -14,51 +14,51 @@
                       :validator (fn [val] true)}

    :int              {:desc "an integer"
-                      :validator (fn [val] (integer? val))}
+                      :validator (fn [val] (instance? Integer val))}

    :sample-idx       {:desc "an integer 0 or greater representing the index of a sample"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>= val 0)))}

    :sample-val       {:desc "a float representing the value of a sample"
-                      :validator (fn [val] (float? val))}
+                      :validator (fn [val] (instance? Float val))}

    :frame-start      {:desc "an integer 0 or greater representing the starting frame"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>=  val 0)))}

    :chan-idx         {:desc "an integer 0 or greater representing a channel index"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>=  val 0)))}

    :num-frames       {:desc "an integer -1 or greater representing the number of frames"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>=  val -1)))}

    :buf-num          {:desc "an integer representing a buffer number"
-                      :validator (fn [val] (integer? val))}
+                      :validator (fn [val] (instance? Integer val))}

    :ugen-idx         {:desc "an integer representing the index of a ugen"
-                      :validator (fn [val] (integer? val))}
+                      :validator (fn [val] (instance? Integer val))}

    :count            {:desc "a positive integer representing the cardinality of elements"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (> val 0)))}

    :node-id          {:desc "an integer (-1 upwards) representing a node id."
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>= val -1)))}

    :group-id          {:desc "an integer (-1 upwards) representing a group id."
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>= val -1)))}

    :synth-id         {:desc "an integer (-1 upwards) representing a synth id."
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>= val -1)))}

    :ctl-val          {:desc "a float representing a control value"
-                      :validator (fn [val] (float? val ))}
+                      :validator (fn [val] (instance? Float val ))}

    :string           {:desc "a string"
                       :validator (fn [val] (string? val))}
@@ -67,11 +67,11 @@
                       :validator (fn [val] (string? val))}

    :ctl-handle       {:desc "an integer or a string representing a control"
-                      :validator (fn [val] (or (integer? val)
+                      :validator (fn [val] (or (instance? Integer val)
                                               (string? val)))}

    :ctl-bus-idx      {:desc "an integer (-1 or greater) representing a control bus index"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>= val -1)))}

    :pathname         {:desc "a string representing a pathname"
@@ -84,17 +84,17 @@
                       :validator (fn [val] (= (type (byte-array 0)) (type val)))}

    :zero-to-three    {:desc "an integer in the range 0 -> 3 inclusive"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>= val 0)
                                                (<= val 3)))}

    :zero-to-four     {:desc "an integer in the range 0 -> 4 inclusive"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>= val 0)
                                                (<= val 4)))}

    :minus-two-to-one {:desc "an integer in the range -2 -> 1 inclusive"
-                      :validator (fn [val] (and (integer? val)
+                      :validator (fn [val] (and (instance? Integer val)
                                                (>= val -2)
                                                (<= val 1)))}


make pen tool default

make pen tool default

--- src-cljs/frontend/state.cljs
+++ src-cljs/frontend/state.cljs
@@ -12,7 +12,7 @@
    :environment     "development"
    :settings        {:browser-settings {:show-grid?  true
                                         :night-mode? true
-                                        :current-tool :rect
+                                        :current-tool :pen
                                         :aside-menu-opened false
                                         :chat-mobile-opened true
                                         :right-click-learned false}}


switch out tests

switch out tests

--- src-cljs/frontend/state.cljs
+++ src-cljs/frontend/state.cljs
@@ -8,7 +8,7 @@
    ;; 3. Record your tests here: https://docs.google.com/a/circleci.com/spreadsheet/ccc?key=0AiVfWAkOq5p2dE1MNEU3Vkw0Rk9RQkJNVXIzWTAzUHc&usp=sharing
    :ab-test-definitions {:a_is_a [true false]
                          :split_form [true false]
-                         :parallelism_button [true false]
+                         :parallelism_button_design [true false]
                          :pricing_button_green [true false]
                          :pay_now_button [true false]
                          :follow_notice [true false]}


Rename Changelings to Shapeshifters

Rename Changelings to Shapeshifters

Not sure how I got this wrong originally.

--- src/timer_mystica/components.cljs
+++ src/timer_mystica/components.cljs
@@ -17,7 +17,7 @@
   [:auren :witches :alchemists :darklings :halflings :cultists
    :engineers :dwarves :mermaids :swarmlings :chaos-magicians :giants
    :fakirs :nomads :ice-maidens :yetis :dragonlords :acolytes
-   :changelings :riverwalkers])
+   :shapeshifters :riverwalkers])

 (def faction-color-class
   {:auren           :green
@@ -38,7 +38,7 @@
    :yetis           :white
    :dragonlords     :orange
    :acolytes        :orange
-   :changelings     :variable
+   :shapeshifters   :variable
    :riverwalkers    :variable})

 (defn faction-text-color [faction]


use threading macro (->>) to improve readability

--- src/babel/espanol/writer.clj
+++ src/babel/espanol/writer.clj
@@ -71,8 +71,8 @@
                    (.size root-verb-array)))

     (.size
-     (-> root-verb-array
-         (use-map-fn
+     (->> root-verb-array
+          (use-map-fn
           (fn [verb]
             (log/debug (str "verb: " (strip-refs verb)))
             (let [root-form (get-in verb [:espanol :espanol])]
@@ -80,12 +80,12 @@
               (doall (use-map-fn
                       (fn [tense]
                         (let [debug (log/debug (str "{:root {:espanol {:espanol " root-form))
-                              spec (unify/unify {:root {:espanol {:espanol root-form}}}
+                              spec (unify/unifyc {:root {:espanol {:espanol root-form}}}
                                                 tense)]
                           (doall
                            (use-map-fn
                             (fn [gender]
-                              (let [spec (unify/unify spec
+                              (let [spec (unify/unifyc spec
                                                       {:comp {:synsem {:agr gender}}})]
                                   (log/debug (str "generating from gender: " gender " with spec: " spec))
                                   (doall


doc string change broke test

doc string change broke test

--- test/such/clojure/f_core.clj
+++ test/such/clojure/f_core.clj
@@ -14,7 +14,7 @@
     (find-var 'such.clojure.f-core/this-var-has-no-value-and-is-used-in-testing) => nil))

 (fact "metadata is stored appropriately"
-  (meta #'third) => (contains {:doc #"Return the third element"
+  (meta #'third) => (contains {:doc #"the third element"
                                :ns (find-ns 'such.clojure.core)}))

 (fact "selected vars can be immigrated"


Minor changes on tests.

Minor changes on tests.

--- test/suricatta/core_test.clj
+++ test/suricatta/core_test.clj
@@ -15,27 +15,27 @@
     (let [ctx (context conn)]
       (testing "Simple string constructor using query function"
         (let [q (query ctx "select 1")]
-          (is (= (get-sql q) "select 1"))))
+          (is (= (fmt/get-sql q) "select 1"))))

       (testing "Simple sqlvec constructor with binds using query function"
         (let [q (query ctx ["select ?" 1])]
-          (is (= (get-bind-values q) [1]))
+          (is (= (fmt/get-bind-values q) [1]))
           ;; query instances always renders inlined
-          (is (= (get-sql q) "select 1"))))
+          (is (= (fmt/get-sql q) "select 1"))))

       (testing "Simple string constructor using result-query function"
         (let [q (result-query ctx "select 1")]
-          (is (= (get-sql q) "select 1"))))
+          (is (= (fmt/get-sql q) "select 1"))))

       (testing "Simple sqlvec constructor with binds using result-query function"
         (let [q (result-query ctx ["select ?" 1])]
-          (is (= (get-bind-values q) [1]))
+          (is (= (fmt/get-bind-values q) [1]))
           ;; query instances always renders indexed
-          (is (= (get-sql q) "select ?"))))
+          (is (= (fmt/get-sql q) "select ?"))))

       (testing "Simple sqlvec constructor and getter"
         (let [q (query ctx ["select ?" 1])]
-          (is (= (sqlvec q) ["select ?" 1]))))
+          (is (= (fmt/sqlvec q) ["select ?" 1]))))
 )))

 (deftest basic-query-executor


too much bold

too much bold

--- src/clj/just_married/css.clj
+++ src/clj/just_married/css.clj
@@ -98,7 +98,7 @@
    [:.countdown {:grid-column 1
                  :grid-row 1
                  ;; :color (:marsala COLOR-PALLETTE)
-                 :font-weight "bold"
+                 ;:font-weight "bold"
                  ;; might be nice to shrink this in theory??
                  ;; :width "50%"
                  ;;:font-family (:alex-brush FONT-FAMILIES)


add shared/select-field

add shared/select-field

--- src/clj_money/web/shared.clj
+++ src/clj_money/web/shared.clj
@@ -193,3 +193,10 @@
   ([model attribute] (password-input-field model attribute {}))
   ([model attribute options]
    (input-field model attribute (merge options {:type :password}))))
+
+(defn select-field
+  [model attribute options]
+  [:div.form-group
+   [:label {:for attribute} (humanize attribute)]
+   [:select.form-control {:id attribute}
+    (map #(vector :option {:value (:value %)} (:caption %)) options)]])


comnfirm

comnfirm

--- src/cljs/geoforms/forms.cljs
+++ src/cljs/geoforms/forms.cljs
@@ -361,9 +361,9 @@
               (seq @db/ideas))
      [:div
       [step-1]
-      (when (seq (selected-districts))
-        (if (completed?)
-          [completed-view]
+      (if (completed?)
+        [completed-view]
+        (when (seq (selected-districts))
           [:div
            [step-2]
            (when @db/selected-district


cli: exec using map

cli: exec using map

Instead of using a conditional list, use a map to call functions.

--- src/com/okl/tokenmgr/cli.clj
+++ src/com/okl/tokenmgr/cli.clj
@@ -177,14 +177,17 @@
       (export-single-app (second parsed-args) (second (rest parsed-args))
                          (:delimiter (:options parsed-opts))))))

+(defn exec [cmd opts]
+  "Execute a single command or print usage."
+  (let [cmds {"filter" do-filter
+              "export" do-export
+              "import" do-import}]
+    ((get cmds cmd #(usage %)) opts)))
+
 (defn -main  [& args]
   (let [parsed-opts (parse-opts args cli-opts)
         parsed-args (:arguments parsed-opts)]
     (log/debug parsed-opts)
     (if (:errors parsed-opts)
-      (usage parsed-opts))
-    (cond
-     (= (first parsed-args) "filter") (do-filter parsed-opts)
-     (= (first parsed-args) "export") (do-export parsed-opts)
-     (= (first parsed-args) "import") (do-import parsed-opts)
-     :else (usage parsed-opts))))
+      (usage parsed-opts)
+      (exec (first parsed-args) parsed-opts))))


fix :karma target not picking up new/removed tests

--- src/main/shadow/test/karma.cljs
+++ src/main/shadow/test/karma.cljs
@@ -1,4 +1,5 @@
 (ns shadow.test.karma
+  {:dev/always true}
   (:require [shadow.test :as st]
             [shadow.test.env :as env]
             [fipp.clojure :refer (pprint)]


Move split-n into the IRandom protocol

Move split-n into the IRandom protocol

It definitely belongs there. Just had to clarify the warning messages in
the docstrings to apply to any two of its functions.

--- src/main/clojure/clojure/test/check/random.clj
+++ src/main/clojure/clojure/test/check/random.clj
@@ -14,17 +14,23 @@

 (defprotocol IRandom
+  (rand-long [rng]
+    "Returns a random long based on the given immutable RNG.
+
+  Note: to maintain independence you should not call more than one
+  function in the IRandom protocol with the same argument")
   (split [rng]
     "Returns two new RNGs [rng1 rng2], which should generate
   sufficiently independent random data.

-  Note: to maintain independence you should not call split and rand-long
-  with the same argument.")
-  (rand-long [rng]
-    "Returns a random long based on the given immutable RNG.
+  Note: to maintain independence you should not call more than one
+  function in the IRandom protocol with the same argument")
+  (split-n [rng n]
+    "Returns a collection of `n` RNGs, which should generate
+  sufficiently independent random data.

-  Note: to maintain independence you should not call split and rand-long
-  with the same argument"))
+  Note: to maintain independence you should not call more than one
+  function in the IRandom protocol with the same argument"))

 ;; Immutable version of Java 8's java.util.SplittableRandom
@@ -123,25 +129,27 @@
           state'' (+ gamma state')
           gamma' (mix-gamma state'')]
       [(JavaUtilSplittableRandom. gamma state'')
-       (JavaUtilSplittableRandom. gamma' (mix-64 state'))])))
+       (JavaUtilSplittableRandom. gamma' (mix-64 state'))]))
+  (split-n [this n]
+    ;; immitates a particular series of 2-way splits, but avoids the
+    ;; intermediate allocation. See the `split-n-spec` for a test of
+    ;; the equivalence to 2-way splits.
+    (case (long n)
+      0 []
+      1 [this]
+      (let [n-dec (dec n)]
+        (loop [state state
+               ret (transient [])]
+          (if (= n-dec (count ret))
+            (-> ret
+                (conj! (JavaUtilSplittableRandom. gamma state))
+                (persistent!))
+            (let [state' (+ gamma state)
+                  state'' (+ gamma state')
+                  gamma' (mix-gamma state'')
+                  new-rng (JavaUtilSplittableRandom. gamma' (mix-64 state'))]
+              (recur state'' (conj! ret new-rng)))))))))

-(defn split-n
-  "Returns a collection of n RNGs."
-  [^JavaUtilSplittableRandom rng n]
-  (case (long n)
-    0 []
-    1 [rng]
-    (let [gamma (.gamma rng)
-          n-dec (dec n)]
-      (loop [state (.state rng)
-             ret (transient [])]
-        (if (= n-dec (count ret))
-          (-> ret (conj! (JavaUtilSplittableRandom. gamma state)) (persistent!))
-          (let [state' (+ gamma state)
-                state'' (+ gamma state')
-                gamma' (mix-gamma state'')]
-            (recur state''
-                   (conj! ret (JavaUtilSplittableRandom. gamma' (mix-64 state'))))))))))
 (def ^:private golden-gamma
   (longify 0x9e3779b97f4a7c15))


Fix '--stop-on-error' for 'remove-obsolete-data'

--- src/cyanite_remover/core.clj
+++ src/cyanite_remover/core.clj
@@ -385,9 +385,8 @@
                       "path: " path ", "
                       "rollup: " rollup ", "
                       "period: " period)))
-    (let [data (mstore/fetch mstore tenant rollup period path from nil 1)
-          obsolete? (not (seq data))]
-      (if obsolete?
+    (let [data (mstore/fetch mstore tenant rollup period path from nil 1)]
+      (if (and (not= data :mstore-error) (not (seq data)))
         (do
           (log/debug (str "Metrics on path '" path "' are obsolete"))
           [path rollup-def])


Refactor startup into progressive augmentations of req map, most using the patience utility for retries.

--- src/acyclic/awstools/core.clj
+++ src/acyclic/awstools/core.clj
@@ -1,60 +1,52 @@
 (ns acyclic.awstools.core
   (:use [amazonica.core]
-        [amazonica.aws.ec2])
+        [amazonica.aws.ec2]
+        acyclic.utils.pinhole)
   (:require [clj-ssh.ssh :as ssh]
+            [taoensso.timbre :as timbre]
             [ clojure.core.async :as async
              :refer [<! >! <!! >!! timeout chan alt!! go close!]]))
+(timbre/refer-timbre)

 (def cred (read-string (slurp "AWS.clj")))

 (apply defcredential (map cred [:access-key :secret-key :endpoint]))

-;(describe-images :owners ["self"])
-;aws ec2 request-spot-instances --spot-price 0.005 --instance-count 1 --type "one-time" --launch-specification '{"ImageId" : "ami-a048bec8", "InstanceType" : "t1.micro", "Placement" : { "AvailabilityZone" : "us-east-1c"}, "KeyName" : "telekhine", "SecurityGroupIds" : ["sg-149f3c7e"]}'
-; "IamInstanceProfile" : {"Arn" : "arn:aws:iam::633840533036:instance-profile/datomic-aws-peer" }
-
-
-(def my-subnets {"us-east-1c"  "subnet-08eff44e"
-                 "us-east-1a"  "subnet-f290abda"
-                 "us-east-1b"  "subnet-572dd420"})
-
-(defn request-spots [n & {:keys [zone itype price]}]
-  (let [zone   (or zone "us-east-1c")
-        itype  (or itype "t1.micro")
-        price  (str (or price "0.005"))
-        req    [:spot-price 			price
-                :instance-count 		n
-                :type 			"one-time"
-                :launch-specification
-                {:image-id 			"ami-5cd51634" ;"ami-a048bec8"
-                 :instance-type 		itype
-                 :placement      {:availability-zone      zone}
-                 :key-name			"telekhine"
-                 :security-groups-ids	["sg-78deaf1d"]
-                 :subnet-id                  (get my-subnets zone)
-                 :iam-instance-profile       {:arn "arn:aws:iam::633840533036:instance-profile/girder-peer"}}]
-        r (apply request-spot-instances req)]
-    (println req)
-    (map :spot-instance-request-id  (:spot-instance-requests r))))
-
+
+
+(def ^{:private true} paths {:zone  [:launch-specification :placement :availability-zone]
+                             :itype  [:launch-specification :instance-type]
+                             :price [:spot-price]
+                             :n     [:instance-count]})
+
+(defmacro go-try [& forms]
+  `(go (try (do ~@forms)
+            (catch Exception e#
+              (do (debug "Caught exception" e#) nil)))))

 (defn patience
-  "Invoke (genfn) every msec until predicate returns true or timeout channel is closed."
-  [pred genfn msec tout]
-  (let [c    (chan)]
-    (close! (async/go-loop []
-               (let [r (genfn)]
-                 (if (or (pred r) (not (first (async/alts! [tout] :default true))))
-                   (do (println "Returning" r)
-                       (>! c r) (close! c))
-                   (do
-                     (println "Got" r "...waiting" msec)
-                     (<! (timeout msec))
-                     (recur))))))
-    c))
-
-(defn patience-every [pred collfn msec tout]
-  (patience #(every? pred %) collfn msec tout))
+  "Invoke (genfn) every time-wait sec until predicate returns true or time-limit sec has passed.
+Returns result of genfn, or nil in the case of timeout."
+  [genfn pred failure time-limit time-wait]
+  (let [t1     (timeout (* 1000 time-limit))
+        out    (chan)]
+    (async/go-loop []
+      (let [rc     (go-try (genfn))
+            [v c]  (async/alts! [rc t1 out])]
+        (cond
+         (= c out)                    (do (debug "Canceled")
+                                          (when failure (failure)))
+         (= c t1)                     (do (debug time-limit "sec expired")
+                                          (when failure (failure))
+                                          (close! out))
+         (and (= c rc) v (pred v))    (do (debug "Returning" v)
+                                          (>! out v))
+         :else                        (do (debug "Still" v "Waiting" time-wait)
+                                          (<! (timeout (* 1000 time-wait)))
+                                          (recur)))))
+    out))
+
+

 (defn pluck [c]
   (let [a (atom nil)]
@@ -62,15 +54,211 @@
                   (reset! a x))))
     a))

+
+(defn request-spots [req]
+  (let [req    (apply concat (seq req))
+        _      (debug req)
+        rs     (apply request-spot-instances req)]
+    (map :spot-instance-request-id  (:spot-instance-requests rs))))
+
+(defn cmd-timeout [sec cmd & args]
+  (let [cc (go (apply cmd args))
+        to (timeout (* 1000 sec))
+        [v c]     (async/alts!! [cc to])]
+    (if (= c cc) v
+      (do (debug "cmd" args "timed out after" sec) nil))))
+
 (defn request-status [rs]
-  (let [d (describe-spot-instance-requests :spot-instance-request-ids rs)]
-    (map :state (:spot-instance-requests d))))
+  (let [d    (cmd-timeout 5 describe-spot-instance-requests :spot-instance-request-ids rs)
+        sirs (:spot-instance-requests d)
+        _    (debug "Request statuses" rs d sirs)]
+    (map :state sirs)))
+
+
+(defn good-strings [vs]
+  (and (sequential?  vs)
+       (every? string? vs)
+       (every? pos? (map count vs))))

 (defn request-instances [rs]
   (let [d (describe-spot-instance-requests :spot-instance-request-ids rs)]
     (map :instance-id (:spot-instance-requests d))))

-(defn dns-names [is]
+(defn cancel [rs]
+  (let [c (:cancelled-spot-instance-requests
+        (cancel-spot-instance-requests :spot-instance-request-ids rs))]
+    (debug c)
+    c))
+
+(defn terminate [is]
+  (let [t (terminate-instances :instance-ids is)]
+    (debug t)
+    t))
+
+(defn- give-up-and-cancel [req & [msg]]
+  (when msg (debug msg))
+  (some-> req :is terminate)
+  (some-> req :rs cancel))
+
+(defn request-spots [req]
+  (let [args    (apply concat (seq req))
+        rs     (apply request-spot-instances args)]
+    (debug "Spot request" args "->" rs)
+    (map :spot-instance-request-id  (:spot-instance-requests rs))))
+
+(defn- add-requests [req]
+  (let [req (assoc req :rs (request-spots (:req req)))]
+    (patience
+     #(assoc req :req-status (cmd-timeout 5 request-status (:rs req)))
+     (fn [req] (let [rss (:req-status req)]
+                 (and (seq rss) (every? #(= "active" %) rss))))
+   #(give-up-and-cancel req "Failed to fulfill spot requests")
+   600 60)))
+
+(defn- add-instances [req]
+  (patience
+   #(assoc req :is (request-instances (:rs req)))
+   #(good-strings (:is %))
+   #(give-up-and-cancel req "Failed to get instance ids")
+   10 1))
+
+
+(defn- add-hosts [req]
+  (patience
+   (fn [] (assoc req :hosts (->> (:is req)
+                                 (describe-instances :instance-ids)
+                                 :reservations
+                                 (map #(get-in % [:instances 0 :public-dns-name])))))
+   #(good-strings (:hosts %))
+   #(give-up-and-cancel req "Failed to get hosts.")
+   10 1))
+
+
+(defn- add-ips [req]
+  (patience
+   (fn [] (assoc req :ips (->> (:is req)
+                                 (describe-instances :instance-ids)
+                                 :reservations
+                                 (map #(get-in % [:instances 0 :private-ip-address])))))
+   #(good-strings (:ips %))
+   #(give-up-and-cancel req "Failed to get IPs")
+   10 1))
+
+(def ag (ssh/ssh-agent {}))
+
+(defn ssh-sessions [hosts]
+  (let [sess (map #(ssh/session ag % {:strict-host-key-checking :no
+                                      :username "ec2-user"})
+                  hosts)]
+    (loop [n 10]
+           (let [o (map #(or (ssh/connected? %) (ssh/connect %)) sess)]
+             (if (or (every? o)
+                     (zero? n)) sess
+                 (do
+                   (Thread/sleep 1000)
+                   (recur (dec n))))))))
+
+
+
+
+(defn- add-sessions [req]
+  (let [sess (map #(ssh/session ag % {:strict-host-key-checking :no
+                                      :username "ec2-user"})
+                  (:hosts req))]
+    (patience
+     (fn [] (let [sbad (filter #(not (ssh/connected? %)) sess)]
+               (doseq [s sbad] (ssh/connect s))
+               (assoc req :sessions sess)))
+     #(every? ssh/connected? (:sessions %1))
+     #(give-up-and-cancel req "Failed to add sesions")
+     60 10
+     )))
+
+(defn chain-some
+  "Each cfn must be a function of one parameter, returning a channel that will deliver
+its non-nil result, or nil on failure.  Non-nil return values will be progressively passed
+to each cfn in order.  Returns a channel that will contain the result of the final
+cfn or nil, if one of them failed along the way."
+  [x & cfns]
+  (let [out (chan)]
+    (async/go-loop [[f & fs] cfns
+                    x        x]
+      (if-not f
+        (do (debug "Finished" cfns)
+            (>! out x))
+        (let [y (<! (f x))]
+          (if-not y
+            (do (debug "Failed at" f)
+                (close! out))
+            (recur fs y)))))
+    out))
+
+
+(defn bring-up-aws
+  "Bring up n AWS t1.micro instances and return channel that will contain a single map
+of {:instance ids :hosts names and :sessions objects}, with appropriate timeouts.
+Returns a channel that will contain a map of :hosts, :sessions, etc or nil."
+  [reqmap nmin & opts]
+  (let [req (apply ph-assoc reqmap paths opts)
+        req (assoc req :nmin nmin)
+        n    (ph-get reqmap paths :n)
+        req (if (<= nmin n) req (ph-assoc reqmap paths :n nmin))]
+    (chain-some {:req req} add-requests add-instances add-ips  add-sessions)))
+
+
+(defn EDNify
+"EDN-ify an arbitrary object, leaving it alone if it's an innocuous string."
+  [x]
+  (let [x (if (string? x) x (pr-str x))
+        x (if (re-matches #"[0-9a-zA-z-_\.]+" x) x (pr-str x))]
+    x))
+
+
+(defn commandify
+  "If cmd is a sequence, convert it into a space-delimited string, EDNifying as necessary."
+  [cmd]
+  (cond (string? cmd) cmd
+        (seq cmd) (clojure.string/join " " (map EDNify cmd))))
+
+(defn ex
+  "Make sure the session is connected and run the command remotely via
+ssh-exec, yielding a map of :exit code, :out string and :err string."
+  [sess cmd]
+  (or (ssh/connected? sess) (ssh/connect sess))
+  (ssh/ssh-exec sess (commandify cmd) "" "" {}))
+
+(defn ex-async [sess cmd]
+  "As ex, but returns a channel that will contain the map."
+  (or (ssh/connected? sess) (ssh/connect sess))
+  (let [c (chan)]
+    (go (let [cmd (commandify cmd)
+              _   (debug "Running in" sess cmd)
+              req (ssh/ssh-exec sess cmd "" "" {})]
+          (debug "Returning from" sess req)
+          (>! c req) (close! c)))
+    c))
+
+(comment
+(def my-subnets {"us-east-1c"  "subnet-08eff44e"
+                 "us-east-1a"  "subnet-f290abda"
+                 "us-east-1b"  "subnet-572dd420"})
+(def my-zone    "us-east-1a")
+(def my-req {:spot-price 		0.01
+             :instance-count 		1
+             :type 			"one-time"
+             :launch-specification     {:image-id 	       "ami-5cd51634"
+                                        :instance-type 	       "t1.micro"
+                                        :placement             {:availability-zone my-zone}
+                                        :key-name	       "telekhine"
+                                        :security-groups-ids   ["sg-78deaf1d"]
+                                        :subnet-id             (get my-subnets my-zone)
+                                        :iam-instance-profile  {:arn "arn:aws:iam::633840533036:instance-profile/girder-peer"}}})
+
+
+)
+
+
+#_(defn dns-names [is]
   (loop [n 5]
     (let [ds    (:reservations (describe-instances :instance-ids is))
           names (map #(get-in % [:instances 0 :public-dns-name]) ds)]
@@ -85,88 +273,94 @@
         :else
         (do
           (Thread/sleep 10000)
-          (recur (dec n)))))))r
-
-(defn internal-ips [is]
-(let [ds (:reservations (describe-instances :instance-ids is))]
-    (map #(get-in % [:instances 0 :private-ip-address]) ds)))
-
-(defn terminate [is]
-  (terminate-instances :instance-ids is))
-
-(defn cancel [rs]
-  (:cancelled-spot-instance-requests
-   (cancel-spot-instance-requests :spot-instance-request-ids rs)))
-
-(def ag (ssh/ssh-agent {}))
-
-(defn ssh-sessions [hosts]
-  (let [sess (map #(ssh/session ag % {:strict-host-key-checking :no
-                                      :username "ec2-user"})
-                  hosts)]
-    (loop [n 10]
-           (let [o (map #(or (ssh/connected? %) (ssh/connect %)) sess)]
-             (if (or (every? o)
-                     (zero? n)) sess
-                 (do
-                   (Thread/sleep 1000)
-                   (recur (dec n))))))))
-
-
-(defn bring-up-aws
-  "Bring up n AWS t1.micro instances and return channel that will contain a single map
-of {:instance ids :hosts names and :sessions objects}."
-  [n & opts]
-  (let [c    (chan)
-        tout (timeout (* 60 1000 10))]
+          (recur (dec n)))))))
+
+#_(defn request-spots [n & {:keys [zone itype price image key profile group subnet]}]
+  (let [zone   (or zone "us-east-1c")
+        itype  (or itype "t1.micro")
+        price  (str (or price "0.005"))
+        image  (or image "BLEH")
+        sgs    (if (seq sg) sg [sg])
+        req    [:spot-price 			price
+                :instance-count 		n
+                :type 			"one-time"
+                :launch-specification
+                {:image-id 			image
+                 :instance-type 		itype
+                 :placement {:availability-zone      zone}
+                 :key-name			key
+                 :security-groups-ids	     sgs
+                 :subnet-id                  (get my-subnets zone)
+                 :iam-instance-profile       {:arn "arn:aws:iam::633840533036:instance-profile/girder-peer"}}]
+        (apply request-spot-instances req)]
+    (println req)
+    (map :spot-instance-request-id  (:spot-instance-requests r))))
+
+#_(defn patience
+  "Invoke (genfn) every time-wait sec until predicate returns true or time-limit sec has passed.
+Returns result of genfn, or nil in the case of timeout."
+  [pred genfn time-limit time-wait]
+  (let [t1     (if (number? time-limit) (timeout (* 1000 time-limit)) time-limit)
+        out    (chan)]
+    (async/go-loop []
+      (let [r   (genfn)
+            p   (pred r)]
+        (if p
+         (do (debug "Returning" r)
+              (>! out r) (close! r))
+         (let [t2     (timeout (* 1000  time-wait))
+               _      (debug "Still" r "Waiting" time-wait "sec")
+               [v c] (async/alts! [t1 t2])]
+           (if (= c t1)
+             (do
+               (debug time-limit "seconds expired.  Returning nil.")
+               (close! out))
+             (recur))))))
+    out))
+
+
+#_(defn patience-every [pred collfn time-limit time-wait]
+  (patience #(every? pred %) collfn time-limit time-wait))
+
+
+#_(defn- add-sessions [res]
+  (let [out   (chan)
+        tout  (timeout 60000)
+        rs    (:rs res)
+        hosts (:hosts res)
+        sess  (map #(ssh/session ag % {:strict-host-key-checking :no
+                                                  :username "ec2-user"})
+                   hosts)]
+    (async/go-loop []
+      (if (every? ssh/connected? sess)
+        (do (debug "All connected.  Returning.")
+            (>! out (assoc res :sessions sess)))
+        (let
+          (if (= c tout)
+            (do
+              (debug "Failed to establish connections after timeout.  Terminating.")
+              (cancel rs)
+              (close! out))
+            (if #(every? ssh/connected? sess)
+              (do (debug "Returning connected" sess)
+                  (>! out (assoc res :sessions sess)))
+              (do
+                (debug "Waiting 10 sec")
+                (<! (timeout 10000))
+                (recur)))))))
+    out))
+
+
+#_(defn- add-requests [res]
+  (let [req (:req res)
+        out (chan)]
     (go
-      (let [_        (println opts)
-            rs       (apply request-spots n opts)
-            _        (println "requests" rs)
-            _        (<! (timeout 1000))
-            ss       (<! (patience-every #(= "active" %) #(request-status rs) 60000 tout))
-            _        (println "Requesting instances for" rs)
-            is       (request-instances rs)
-            _        (println "instances" is)
-            hosts    (dns-names is)
-            ips      (internal-ips is)
-            _        (println "hosts" hosts)
-            sessions (ssh-sessions hosts)
-            opn      (map #(or (ssh/connected? %) (ssh/connect %)) sessions)
-
-            _        (println "Done!")]
-        (>! c {:instances is :hosts hosts :sessions sessions :ips ips :rs requests}) (close! c)))
-    [c tout]))
-
-
-(defn EDNify
-"EDN-ify an arbitrary object, leaving it alone if its an innocuous string."
-  [x]
-  (let [x (if (string? x) x (pr-str x))
-        x (if (re-matches #"[0-9a-zA-z-_\.]+" x) x (pr-str x))]
-    x))
-
-
-(defn commandify
-  "If cmd is a sequence, convert it into a space-delimited string, EDNifying as necessary."
-  [cmd]
-  (cond (string? cmd) cmd
-        (seq cmd) (clojure.string/join " " (map EDNify cmd))))
-
-(defn ex
-  "Make sure the session is connected and run the command remotely via
-ssh-exec, yielding a map of :exit code, :out string and :err string."
-  [sess cmd]
-  (or (ssh/connected? sess) (ssh/connect sess))
-  (ssh/ssh-exec sess (commandify cmd) "" "" {}))
-
-(defn ex-async [sess cmd]
-  "As ex, but returns a channel that will contain the map."
-  (or (ssh/connected? sess) (ssh/connect sess))
-  (let [c (chan)]
-    (go (let [cmd (commandify cmd)
-              _   (println "Running in" sess cmd)
-              res (ssh/ssh-exec sess cmd "" "" {})]
-          (println "Returning from" sess res)
-          (>! c res) (close! c)))
-    c))
+      (let [rs  (request-spots req)]
+        (debug "waiting for" rs "to be active")
+        (<! (timeout 1000))
+        (if (<! (patience-every #(= "active" %) #(request-status rs) 600 60))
+          (do (debug "All instances active! Returning" (assoc res :rs rs))
+              (>! out (assoc res :rs rs)))
+          (give-up-and-cancel res out "Requests failed.")
+)))
+    out))


Added docstrings to all functions in the core module

--- src/emender_jenkins/core.clj
+++ src/emender_jenkins/core.clj
@@ -93,11 +93,13 @@
         ;cors-handler))

 (defn start-server-on-regular-machine
+    "Start the service on regular machine."
     [ring-app port]
     (println "Starting the server at the port: " port)
     (jetty/run-jetty ring-app {:port (read-string port)}))

 (defn start-server-on-openshift
+    "Start the service on OpenShift machine."
     [ring-app port host]
     (println "Starting the server on openshift at the port: " port " and host: " host)
     (jetty/run-jetty ring-app {:port (read-string port) :host host}))
@@ -132,11 +134,13 @@
         (get-and-check-port specified-port)))

 (defn show-help
+    "Show help and all supported CLI flags."
     [summary]
     (println "Usage:")
     (println summary))

 (defn print-environment-configuration
+    "Print environment confuguration to the standard output."
     []
     (let [properties (process-info/read-properties)]
         (println "Environment configuration")
@@ -153,12 +157,14 @@
         (println)))

 (defn fetch-jobs-only
+    "Dummy function that will be used just to fetch job data and exports them."
     [options]
     (println "Generating data2.edn")
     ;(job-data-fetcher/try-to-fetch-and-export-data)
     (println "Done"))

 (defn show-config
+    "Show the current configuration on the standard output."
     [options]
     (let [port                (options :port)
           jenkins-url         (options :jenkins-url)
@@ -173,6 +179,7 @@
         (println "Finished")))

 (defn run-app
+    "Starts application on any supported configuration: regular machine or OpenStack VM."
     [options]
     (let [port                (options :port)
           jenkins-url         (options :jenkins-url)


invalidate cache if dependencies are added through real eval

--- support/src/figwheel/client.cljs
+++ support/src/figwheel/client.cljs
@@ -97,12 +97,17 @@
   (string/join "\n" (take-while #(not (re-matches #".*eval_javascript_STAR__STAR_.*" %))
                                 (string/split-lines stack-str))))

+(defn alters-dependencies? [code]
+  (re-matches  #"([\n\r]|.)*addDependency([\n\r]|.)*" code))
+
 (defn eval-javascript** [code result-handler]
   (try
     (binding [*print-fn* (fn [& args]
                            (-> args
                              console-print
                              figwheel-repl-print))]
+      (when (alters-dependencies? code)
+        (reloading/invalidate-dependency-cache!))
       (result-handler
        {:status :success,
         :value (str (js* "eval(~{code})"))}))


Played with the stepinator a bit.

Played with the stepinator a bit.

Cleaned up some unneeded interop
Made number of slices configurable
Optional :stepper function parameter. When present, a trigger button is
  shown which will call the func. Makes playing with settings a little
  easier.
Added docstring.
Added extended example to comment.

--- src/overtone/gui/stepinator.clj
+++ src/overtone/gui/stepinator.clj
@@ -32,13 +32,12 @@
     :background (theme-color :background-fill)
     :stroke 1.0))

-(def ^{:private true} NUM_SLICES 20)
-
 (defn- create-init-state
   "create the intitial state with the number of possible steps, width and height of the widget"
-  [num-steps width height]
+  [num-steps num-slices width height]
   {:steps      (vec (repeat num-steps 0))
    :num-steps  num-steps
+   :num-slices num-slices
    :width      width
    :height     height})

@@ -50,13 +49,13 @@
         x-res         (:num-steps state)
         step-width    (/ w (:num-steps state))
         y             (/ h 2)
-        tick-height   (/ h NUM_SLICES)
+        tick-height   (/ h (:num-slices state))
         num-steps    (:num-steps state)
         line-padding  0]

     (draw g (rect 0 0 w h) background-fill)

-    (dotimes [i 20]
+    (dotimes [i (:num-slices state)]
       (draw g (line 0 (* i tick-height) w (* i tick-height)) background-stroke))

     (dotimes [i num-steps]
@@ -78,11 +77,12 @@

 (defn- on-press-drag
   [state e]
-  (let [
-        x-cell        (int (/ (.getX e) (/ (.getWidth (.getComponent e)) (:num-steps state))))
-        y-cell        (int (/ (.getY e) (/ (.getHeight (.getComponent e)) 2)))
-        tick-height  (/ (.getHeight (.getComponent e)) NUM_SLICES)
-        current-value (- (int (/ (.getY e) tick-height)) 10)]
+  (let [x (.getX e)
+        y (.getY e)
+        x-cell        (quot x (quot (width e) (:num-steps state)))
+        y-cell        (quot y (quot (height e) 2))
+        tick-height   (quot (height e) (:num-slices state))
+        current-value (- (quot y tick-height) (quot (:num-slices state) 2))]
     (assoc (assoc-in state [:steps x-cell] current-value)
            :current-value current-value)))

@@ -99,19 +99,42 @@
     c))

 (defn stepinator
-  [& {:keys [steps width height]
-      :or {steps 16 width 300 height 150}}]
+  "Creates a simple UI for building a sequence of step values.
+
+  A grid is displayed which is :steps columns wide and :slices rows tall.
+  Click and drag on the ui to change the value at each step. The range of
+  values is [-slices/2, slices/2] with 0 at the center, vertically of the
+  window.
+
+  Returns a map with keys:
+
+    :frame The ui frame
+    :state The state *atom* which is a map with a :steps entry which is a
+      vector of step values
+
+  The optional :stepper parameter is a function which takes a vector of
+  step values. If present, a 'Stepinate' button will be creates on the ui
+  which, when clicked, will invoke the function with the curent state of
+  stepinator.
+  "
+  [& {:keys [steps slices width height stepper]
+      :or {steps 16 slices 20 width 300 height 150}}]
   (invoke-now
     (with-error-log "stepinator"
-                    (let [state-atom    (atom (create-init-state steps width height))
+                    (let [state-atom    (atom (create-init-state steps slices width height))
                           stepinator    (stepinator-panel state-atom)
                           f             (frame :title    "Stepinator"
                                                :content  (border-panel
+                                                           :id :content
                                                            :size [width :by height]
                                                            :center stepinator))
                           state-bindable (bind/bind state-atom
                                                     (bind/transform #(:current-value %)))
                           ]
+                      (if stepper
+                        (config! (select f [:#content])
+                                 :south (action :name "Stepinate"
+                                                :handler (fn [_] (stepper (:steps @state-atom))))))
                       (bind/bind state-atom (bind/b-do [_] (repaint! stepinator)))
                       (adjustment-popup :widget f :label "Value:" :bindable state-bindable)
                       (with-meta {:frame (-> f pack! show!)
@@ -128,4 +151,19 @@
                    (dseq (map #(+ 60 %) (:steps @(:state pstep)))))
         src (saw (midicps note))]
     (* [0.2 0.2] src)))
+
+; Or give the stepinator a func to call and it will show a Stepinate button
+(stepinator
+  :steps   32
+  :slices  50
+  :width   640
+  :height  480
+  :stepper (fn [steps]
+             (demo 5
+                   (let [note (duty (dseq [0.2 0.1] INF)
+                                    0
+                                    (dseq (map #(+ 60 %) steps)))
+                         a (saw (midicps note))
+                         b (sin-osc (midicps (+ note 7)))]
+                     [(* 0.2 a) (* 0.2 b)]))))
 )


Note that lein needs the new ssl cert when the test timebombs

--- test/clojars/test/unit/certs.clj
+++ test/clojars/test/unit/certs.clj
@@ -13,4 +13,5 @@
   (let [expire-date #inst "2018-06-18T00:00:00.000-00:00"]
     (is (< (System/currentTimeMillis)
           (- (.getTime expire-date) sixty-days))
-      (format "clojars.org TLS cert expires on %s" expire-date))))
+      (format "clojars.org TLS cert expires on %s.\nBe sure to give lein a copy of the new one: %s"
+        expire-date "https://github.com/technomancy/leiningen/blob/master/leiningen-core/resources/clojars.pem"))))


Expand test case to include required and input-type-fields

--- test/graphql_clj/parser_test.clj
+++ test/graphql_clj/parser_test.clj
@@ -432,24 +432,36 @@

 (def type-fields-kv-example
   "type Hello {
-     world(flag: Boolean = true): String
+     world(flag: Boolean = true): String!
+     this: Int
+   }")
+
+(def input-type-fields-kv-example
+  "input Hello {
+    world: String!
+    this: Int
    }")

 (def variable-kv-example
   "query WithDefaultValues(
      $a: Int = 1,
-     $b: String = \"ok\",
+     $b: String! = \"ok\",
      $c: ComplexInput = { requiredField: true, intField: 3 }) {
        dog { name }
      }")

 (deftest kv-pairs
   (testing "we can convert type-fields to a map"
-    (is (= (-> (parse type-fields-kv-example) :type-system-definitions first :type-fields nu/tapd)
+    (is (= (-> (parse type-fields-kv-example) :type-system-definitions first :type-fields)
            {"world" {:arguments  {"flag" {:default-value true :type-name "Boolean"}}
-                     :type-name "String"}})))
+                     :type-name "String" :required true}
+            "this" {:type-name "Int"}})))
+  (testing "we can convert input-type-fields to a map"
+    (is (= (-> (parse input-type-fields-kv-example) :type-system-definitions first :input-type-fields)
+           {"world" {:type-name "String" :required true}
+            "this"  {:type-name "Int"}})))
   (testing "we can convert variables to a map"
     (is (= (-> (parse variable-kv-example) :operation-definitions first :variable-definitions)
            {"a" {:default-value 1 :type-name "Int"}
-            "b" {:default-value "ok" :type-name "String"}
+            "b" {:default-value "ok" :type-name "String" :required true}
             "c" {:default-value {"requiredField" true "intField" 3} :type-name "ComplexInput"}}))))


Add failing test for #3867

Add failing test for #3867

--- test/metabase/api/table_test.clj
+++ test/metabase/api/table_test.clj
@@ -325,6 +325,25 @@
                             "Szymon Theutrich"]}
             :created_at   $}))
   ((user->client :rasta) :get 200 (format "table/%d/query_metadata" (id :users))))
+
+;; Check that FK fields belonging to Tables we don't have permissions for don't come back as hydrated `:target`(#3867)
+(expect
+  #{{:name "id", :target false}
+    {:name "fk", :target false}}
+  ;; create a temp DB with two tables; table-2 has an FK to table-1
+  (tu/with-temp* [Database [db]
+                  Table    [table-1    {:db_id (u/get-id db)}]
+                  Table    [table-2    {:db_id (u/get-id db)}]
+                  Field    [table-1-id {:table_id (u/get-id table-1), :name "id", :base_type :type/Integer, :special_type :type/PK}]
+                  Field    [table-2-id {:table_id (u/get-id table-2), :name "id", :base_type :type/Integer, :special_type :type/PK}]
+                  Field    [table-2-fk {:table_id (u/get-id table-2), :name "fk", :base_type :type/Integer, :special_type :type/FK, :fk_target_field_id (u/get-id table-1-id)}]]
+    ;; grant permissions only to table-2
+    (perms/revoke-permissions! (perms-group/all-users) (u/get-id db))
+    (perms/grant-permissions! (perms-group/all-users) (u/get-id db) (:schema table-2) (u/get-id table-2))
+    ;; metadata for table-2 should show all fields for table-2, but the FK target info shouldn't be hydrated
+    (set (for [field (:fields ((user->client :rasta) :get 200 (format "table/%d/query_metadata" (u/get-id table-2))))]
+           (-> (select-keys field [:name :target])
+               (update :target boolean))))))

 ;; ## PUT /api/table/:id


minor require cleanup

minor require cleanup

--- src/main/shadow/cljs/devtools/server/nrepl.clj
+++ src/main/shadow/cljs/devtools/server/nrepl.clj
@@ -1,23 +1,18 @@
 (ns shadow.cljs.devtools.server.nrepl
   (:refer-clojure :exclude (send select))
-  (:require [clojure.pprint :refer (pprint)]
-            [clojure.tools.nrepl.middleware :as middleware]
-            [clojure.tools.nrepl.middleware.session :as nrepl-session]
-            [clojure.tools.nrepl.transport :as transport]
-            [clojure.tools.nrepl.misc :as misc]
-            [clojure.tools.nrepl.server :as server]
-            [clojure.edn :as edn]
-            [shadow.cljs.devtools.config :as config]
-            [shadow.cljs.devtools.api :as api]
-            [clojure.tools.logging :as log]
-            [shadow.cljs.devtools.server.worker :as worker]
-            [shadow.cljs.repl :as repl]
-            [shadow.cljs.devtools.server.repl-impl :as repl-impl]
-            [shadow.cljs.devtools.fake-piggieback :as fake-piggieback]
-            [clojure.java.io :as io]
-            [shadow.cljs.devtools.errors :as errors]
-            [clojure.core.async :as async :refer (go <! >!)]
-            [shadow.build.log :as build-log])
+  (:require
+    [clojure.pprint :refer (pprint)]
+    [clojure.core.async :as async :refer (go <! >!)]
+    [clojure.tools.nrepl.middleware :as middleware]
+    [clojure.tools.nrepl.transport :as transport]
+    [clojure.tools.nrepl.server :as server]
+    [clojure.tools.logging :as log]
+    [shadow.cljs.repl :as repl]
+    [shadow.cljs.devtools.fake-piggieback :as fake-piggieback]
+    [shadow.cljs.devtools.api :as api]
+    [shadow.cljs.devtools.server.worker :as worker]
+    [shadow.cljs.devtools.server.repl-impl :as repl-impl]
+    [shadow.cljs.devtools.errors :as errors])
   (:import (java.io StringReader)))

 (defn send [{:keys [transport session id] :as req} {:keys [status] :as msg}]


Add some more generators

Add some more generators

A couple of these I wasn't sure how to port directly from Haskell, need
to figure out how to do some more monadic stuff like `sequence`.
Further, needing to wrap things in lambdas can then call them can be a
bit awkward compared to Haskell.

--- src/simple_check/generators.clj
+++ src/simple_check/generators.clj
@@ -1,7 +1,7 @@
 (ns simple-check.generators
   (:require [simple-check.util :as util])
   (:import java.util.Random)
-  (:refer-clojure :exclude [int vector map]))
+  (:refer-clojure :exclude [int vector map keyword char]))

 (defn random
   ([] (java.util.Random.))
@@ -21,7 +21,33 @@
     (let [value (gen rand-seed size)]
       ((k value) rand-seed size))))

-(defn diff
+;; Combinators
+;; ---------------------------------------------------------------------------
+
+(declare choose)
+
+(defn one-of
+  [generators]
+  (bind (choose 0 (dec (count generators)))
+        #(nth generators %)))
+
+(defn elements
+  [coll]
+  (fmap #(nth coll %)
+        (choose 0 (dec (count coll)))))
+
+(defn such-that
+  [gen f]
+  (fn [rand-seed size]
+    (let [value (gen rand-seed size)]
+      (if (f value)
+        value
+        (recur rand-seed size)))))
+
+;; Generators
+;; ---------------------------------------------------------------------------
+
+(defn- diff
   [min-range max-range]
   (case [(neg? min-range) (neg? max-range)]
     [true true] (Math/abs (- max-range min-range))
@@ -36,6 +62,12 @@
         min-range
         (+ (.nextInt rand-seed (inc diff)) min-range)))))

+(defn pair
+  [a b]
+  (fn [rand-seed size]
+    [(a rand-seed size)
+     (b rand-seed size)]))
+
 (defn sample
   ([generator]
    (repeatedly #(util/nullary-apply generator)))
@@ -49,7 +81,7 @@
 (defn tuple
   [generators]
   (fn [rand-seed size]
-    (vec (clojure.core/map util/nullary-apply generators))))
+    (vec (clojure.core/map #(% rand-seed size) generators))))

 (defn shrink-tuple
   [value]
@@ -86,36 +118,39 @@
     (let [num-elements (Math/abs (int rand-seed size))]
       (vec (repeatedly num-elements #(gen rand-seed size))))))

-(defn shrink-vector
-  [value]
-  (clojure.core/map vec (shrink-seq value)))
-
 (defn map
   [key-gen val-gen]
   (fn [rand-seed size]
-    (into {} (repeatedly (rand-int size)
-                         (fn [] [(util/nullary-apply key-gen)
-                                 (util/nullary-apply val-gen)])))))
+    (let [map-size ((choose 0 size) rand-seed size)
+          pair (pair key-gen val-gen)]
+      (into {} (repeatedly map-size #(pair rand-seed size))))))
+
+(def char (fmap clojure.core/char (choose 0 255)))
+
+(def char-ascii (fmap clojure.core/char (choose 32 126)))
+
+(def char-alpha-numeric (fmap clojure.core/char
+                              (one-of [(choose 48 57)
+                                      (choose 65 90)
+                                      (choose 97 122)])))
+
+(defn string
+  [rand-seed size]
+  (apply str (repeatedly size #(char rand-seed size))))
+
+(defn string-ascii
+  [rand-seed size]
+  (apply str (repeatedly size #(char-ascii rand-seed size))))
+
+(defn string-alpha-numeric
+  [rand-seed size]
+  (apply str (repeatedly size #(char-alpha-numeric rand-seed size))))
+
+(def keyword (fmap clojure.core/keyword string-alpha-numeric))

 (defn shrink-map
   [value]
   [])
-
-;; Combinators
-;; ---------------------------------------------------------------------------
-
-(defn one-of
-  [generators]
-  (bind (choose 0 (dec (count generators)))
-        #(nth generators %)))
-
-(defn such-that
-  [gen f]
-  (fn [rand-seed size]
-    (let [value (gen rand-seed size)]
-      (if (f value)
-        value
-        (recur rand-seed size)))))

 ;; Instances
 ;; ---------------------------------------------------------------------------
@@ -140,6 +175,4 @@

 (extend clojure.lang.IPersistentMap
   Shrink
-  ;; TODO:
-  ;; this shrink goes into an infinite loop with floats
   {:shrink shrink-map})


Do not preload sounds in audio-player

Do not preload sounds in audio-player

--- src/sinusoides/views/think.cljs
+++ src/sinusoides/views/think.cljs
@@ -103,7 +103,8 @@

        :reagent-render
        (fn []
-         [:audio {:src @source}])})))
+         [:audio {:preload "none"
+                  :src @source}])})))

 (defn audio-player-view [source]
   (r/with-let [command-ch (async/chan)


Remove debugging.

Remove debugging.

--- src/forces_assemble/auth.clj
+++ src/forces_assemble/auth.clj
@@ -34,8 +34,8 @@
                                      (.getBytes)
                                      (io/input-stream))))))

-(defonce testing (let [b (auth-config)]
-                   (throw (Exception. (str "BUILD: " b)))))
+(comment (defonce testing (let [b (auth-config)]
+                    (throw (Exception. (str "BUILD: " b))))))

 (defonce fbapp (FirebaseApp/initializeApp (create-firebase-options)))


Problem added - Intro to Destructuring

Problem added - Intro to Destructuring


Stop repeating the ' character

Stop repeating the ' character

--- src/foreclojure/problems.clj
+++ src/foreclojure/problems.clj
@@ -43,7 +43,7 @@
     (session/session-put! :code [id code])
     (flash-msg (str message " " gist-link) "/problems")))

-(def restricted-list ['use 'require 'in-ns 'future 'agent 'send 'send-off 'pmap 'pcalls])
+(def restricted-list '[use require in-ns future agent send send-off pmap pcalls])

 (defn get-tester [restricted]
   (into secure-tester (concat restricted-list (map symbol restricted))))


Update template.clj

Update template.clj

--- src/foreclojure/template.clj
+++ src/foreclojure/template.clj
@@ -50,8 +50,8 @@
          [:div#user-info
           (if user
             [:div
-             [:span#username (str "Logged in as")]
-             [:a#login (make-user-url user) user]
+             [:span#username (str "Logged in as")
+             [:a (make-user-url user) user]]
              [:a#logout {:href "/logout"} "Logout"]]
             [:div
              [:a#login {:href (login-url)} "Login"]
@@ -87,7 +87,7 @@
           })();"
          )]]])))

-;; Content templates
+;; Content templateslo
 (defn content-page [{:keys [heading heading-note sub-heading main]}]
   (let [flash-message (session/flash-get :message)
         flash-error   (session/flash-get :error)]


feat(webgl): fix #51, re-add CORS support for load-texture

--- src/thi/ng/geom/gl/buffers.cljc
+++ src/thi/ng/geom/gl/buffers.cljc
@@ -186,6 +186,8 @@
                (when-let [cb (get opts :callback)] (cb tex img))))
        (when-let [ecb (:error-callback opts)]
          (set! (.-onerror img) ecb))
+       (when-let [cors (:cors opts)]
+         (set! (.-crossOrigin img) cors))
        (set! (.-src img) (get opts :src))
        tex)))