First janky version of scrolling

First janky version of scrolling

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -19,11 +19,6 @@
 (defn piano-key-width
   [{piano-keys :piano-keys w :w}]
   (.round js/Math (/ w (count piano-keys))))
-
-(defn latest-note
-  [instrument freq]
-  (some (fn [note] (and (= freq (-> note :freq)) note))
-        (-> instrument :notes)))

 (defn t->px
   [{start :start px-per-ms :px-per-ms} t]
@@ -108,8 +103,9 @@
      :notes ()
      :w 0 :h 0 :sound-ready false
      :px-per-ms 0.04
+     :cur-touches {}
+     :scrolling? false
      :start start
-     :previous-time start
      :playhead start}))

 (defn add-synths-to-instrument
@@ -119,58 +115,34 @@
                  (-> instrument :piano-keys keys))
     :sound-ready true))

+(defn play-piano-key
+  [instrument freq]
+  (println "play")
+  (.play (.bang (get-in instrument [:piano-keys freq :synth])))
+  (assoc-in instrument [:piano-keys freq :on?] true))
+
+(defn stop-piano-key
+  [instrument freq]
+  (if (get-in instrument [:piano-keys freq :on?])
+    (do
+      (println "stop" (get-in instrument [:piano-keys freq :synth]))
+      (.release (get-in instrument [:piano-keys freq :synth]))
+      (assoc-in instrument [:piano-keys freq :on?] false))
+    instrument))
+
 (defn touch-data->touches [touch-data]
   (let [event (.-event_ touch-data)
         touches (js->clj (.-changedTouches event) :keywordize-keys true)]
     (map (fn [x] {:type (.-type event)
                   :touch-id (:identifier x)
-                  :clientX (:clientX x)
+                  :position {:x (:clientX x) :y (:clientY x)}
                   :time (.-timeStamp event)})
          (for [x (range (:length touches))] ((keyword (str x)) touches)))))

 (defn touch->freq
   [instrument touch]
-  (touch->note (get touch :clientX)
+  (touch->note (get-in touch [:position :x])
                instrument))
-
-(def instrument-fns
-  {"touchstart" (fn
-                  [instrument {touch-id :touch-id time :time :as event}]
-                  (let [freq (touch->freq instrument event)
-                        piano-key (get-in instrument [:piano-keys freq])]
-                    (if-not (:on? piano-key)
-                      (do
-                        ;; (println "play")
-                        (.play (.bang (:synth piano-key)))
-                        (-> instrument
-                            (assoc :notes (conj (get instrument :notes)
-                                                {:freq freq :on time :off nil :touch-id touch-id}))
-                            (assoc-in [:piano-keys freq :on?] true))))))
-   "touchend" (fn
-                [{piano-keys :piano-keys :as instrument}
-                 {touch-id :touch-id time :time :as event}]
-                (let [freqs-on (atom [])
-                      instrument (assoc instrument :notes
-                                        (doall
-                                         (map (fn [{freq :freq :as note}]
-                                                (if (= touch-id (note :touch-id))
-                                                  (do
-                                                    (swap! freqs-on conj freq)
-                                                    ;; (println "release")
-                                                    (.release ((get piano-keys freq) :synth))
-                                                    (assoc note :off time))
-                                                  note))
-                                              (-> instrument :notes))))]
-                  (reduce (fn [inst freq]
-                            (assoc-in inst [:piano-keys freq :on?] false))
-                          instrument
-                          @freqs-on)))})
-
-(defn fire-event-on-instrument
-  [instrument event]
-  (let [f-instrument (get instrument-fns (:type event))]
-    (or (and f-instrument (f-instrument instrument event))
-        instrument)))

 (defn maybe-init-synths
   [instrument]
@@ -178,11 +150,101 @@
     instrument
     (add-synths-to-instrument instrument)))

+(defn filter-type
+  [type touches]
+  (filter (fn [t] (= (t :type) type)) touches))
+
+(defn reduce-val->>
+  [f coll val]
+  (reduce f val coll))
+
+(defn touches->notes
+  [{playhead :playhead :as instrument} touches]
+  (->> touches
+       (map (fn [t] (assoc t :freq (touch->freq instrument t))))
+       (remove (fn [t] (get-in instrument [:piano-keys (t :freq) :on?])))
+       (map (fn [t] {:freq (t :freq)
+                     :on playhead
+                     :off nil
+                     :touch-id (t :touch-id)}))))
+
+(defn start-notes
+  [touches {notes :notes :as instrument}]
+  (let [new-notes (touches->notes instrument (filter-type "touchstart" touches))]
+    (reduce play-piano-key
+            (assoc instrument :notes (concat new-notes notes))
+            (map (fn [n] (n :freq)) new-notes))))
+
+(defn end-notes
+  [touches {notes :notes playhead :playhead :as instrument}]
+  (let [off-touch-ids (->> (filter-type "touchend" touches)
+                           (map :touch-id)
+                           set)
+        off-freqs (->> notes
+                       (filter (fn [n] (contains? off-touch-ids (n :touch-id))))
+                       (map :freq))]
+    (-> instrument
+        (assoc :notes (map (fn [{touch-id :touch-id :as n}]
+                             (if (contains? off-touch-ids touch-id)
+                               (assoc n :off playhead)
+                               n))
+                           notes))
+        (->> (reduce-val->> stop-piano-key off-freqs)))))
+
+(defn max-scroll-distance
+  [touches instrument]
+  (let [distances (map (fn [t]
+                         (- (get-in instrument [:cur-touches (t :touch-id) :position :y])
+                            (-> t :position :y)))
+                       (filter-type "touchmove" touches))]
+    (first (sort (fn [a b] (max (.abs js/Math a) (.abs js/Math b))) distances))))
+
+(defn record-touches
+  [touches instrument]
+  (let [starts (filter-type "touchstart" touches)
+        moves (filter-type "touchmove" touches)
+        ends (filter-type "touchend" touches)]
+    (-> instrument
+        (update-in [:cur-touches] into (map vector (map :touch-id starts) starts))
+        (update-in [:cur-touches] into (map vector (map :touch-id moves) moves))
+        (update-in [:cur-touches] (fn [c] (apply dissoc c (map :touch-id ends)))))))
+
+(defn scroll
+  [touches {playhead :playhead :as instrument}]
+  (if-let [scroll-distance (max-scroll-distance touches instrument)]
+    (let [delta-y (/ scroll-distance (instrument :px-per-ms))]
+      (-> instrument
+          (assoc :scrolling? true)
+          (assoc :playhead (+ playhead delta-y))))
+    (assoc instrument :scrolling? false)))
+
+(defn delete-scrolled-notes
+  [touches {notes :notes :as instrument}]
+  (let [touchmoves (filter-type "touchmove" touches)
+        scroll-touch-ids (set (map :touch-id touchmoves))
+        scroll-touch-freqs (map (partial touch->freq instrument) touchmoves)]
+    (-> instrument
+        (assoc :notes (remove (fn [t]
+                                (and (nil? (t :off))
+                                     (contains? scroll-touch-ids (t :touch-id))))
+                              notes))
+        (->> (reduce-val->> stop-piano-key scroll-touch-freqs)))))
+
+(defn handle-scrolling
+  [touches instrument]
+  (->> instrument
+       (scroll touches)
+       (record-touches touches)
+       (delete-scrolled-notes touches)))
+
 (defn fire-touch-data-on-instrument
   [instrument data]
-  (reduce fire-event-on-instrument
-          (maybe-init-synths instrument)
-          (touch-data->touches data)))
+  (let [touches (touch-data->touches data)]
+    (->> instrument
+         maybe-init-synths
+         (start-notes touches)
+         (end-notes touches)
+         (handle-scrolling touches))))

 (defn update-size [instrument canvas-id]
   (let [{w :w h :h :as window-size} (util/get-window-size)]
@@ -193,30 +255,31 @@
 (defn create-touch-input-channel
   [canvas-id]
   (async/merge [(util/listen (dom/getElement canvas-id) :touchstart)
-                (util/listen (dom/getElement canvas-id) :touchend)]))
+                (util/listen (dom/getElement canvas-id) :touchend)
+                (util/listen (dom/getElement canvas-id) :touchmove)]))
+
 (defn step-time
-  [instrument]
-  (let [now (.getTime (js/Date.))]
-    (-> instrument
-        (assoc :playhead (+ (instrument :playhead)
-                            (- now (instrument :previous-time))))
-        (assoc :previous-time now))))
+  [instrument delta]
+  (if (not (instrument :scrolling?))
+    (assoc instrument :playhead (+ (instrument :playhead) delta))
+    instrument))

 (let [canvas-id "canvas"
-      c-instrument (chan)
+      c-instrument (chan (sliding-buffer 1))
       c-orientation-change (util/listen js/window :orientation-change)
       c-touch (create-touch-input-channel canvas-id)
-      frame-delay 30]
+      frame-delay 16]

   (go
    (let [draw-ctx (util/get-ctx canvas-id)]
      (util/set-canvas-size! canvas-id (util/get-window-size))
-     (loop [instrument (<! c-instrument)]
-       (let [[data c] (alts! [c-instrument (timeout frame-delay)])]
+     (loop [instrument (<! c-instrument)
+            timer (timeout frame-delay)]
+       (let [[data c] (alts! [c-instrument timer])]
          (condp = c
-           c-instrument (recur data)
+           c-instrument (recur data timer)
            (do (draw-instrument draw-ctx instrument)
-               (recur instrument)))))))
+               (recur instrument (timeout frame-delay))))))))

   (go
    (loop [instrument (update-size (create-instrument (scales/c-minor)) canvas-id)]
@@ -225,5 +288,4 @@
        (condp = c
          c-orientation-change (recur (update-size instrument canvas-id))
          c-touch (recur (fire-touch-data-on-instrument instrument data))
-         (recur (step-time instrument))))))
-  )
+         (recur (step-time instrument frame-delay)))))))


Mark view functions with isView

Mark view functions with isView

--- src/re_view/core.cljs
+++ src/re_view/core.cljs
@@ -224,7 +224,6 @@
        (update-keys #(get kmap % (camelCase (name %))))))

 (defn specify-protocols [o]
-  (set! (.-isView o) true)
   (specify! o
     ILookup
     (-lookup
@@ -247,20 +246,21 @@

 (defn factory
   [class]
-  (fn [props & children]
-    (let [props (js->clj props)
-          props? (or (nil? props) (map? props))
-          children (if props? children (cons props children))
-          {:keys [ref key] :as props} (when props? props)]
-      (js/React.createElement
-        class
-        #js {:key           (or key
-                                (if-let [keyfn (aget class "prototype" "reactKey")]
-                                  (if (string? keyfn) keyfn (keyfn props)) key)
-                                (.-displayName class))
-             :ref           ref
-             :cljs$props    (dissoc props :keyfn :ref :key)
-             :cljs$children (when (not= '(nil) children) children)}))))
+  (doto (fn [props & children]
+          (let [props (js->clj props)
+                props? (or (nil? props) (map? props))
+                children (if props? children (cons props children))
+                {:keys [ref key] :as props} (when props? props)]
+            (js/React.createElement
+              class
+              #js {:key           (or key
+                                      (if-let [keyfn (aget class "prototype" "reactKey")]
+                                        (if (string? keyfn) keyfn (keyfn props)) key)
+                                      (.-displayName class))
+                   :ref           ref
+                   :cljs$props    (dissoc props :keyfn :ref :key)
+                   :cljs$children (when (not= '(nil) children) children)})))
+    (aset "isView" true)))

 (defn extends [child parent]
   (let [ReactView (aget child "constructor")]


formatting

formatting

--- src/selmer/parser.clj
+++ src/selmer/parser.clj
@@ -196,8 +196,8 @@
 ;; Primary compile-time parse routine. Work we don't want happening after
 ;; first template render. Vector output from parse* gets memoized by render-file.

-(defn parse [file & [{:keys [tag-open tag-close filter-open
-             filter-close tag-second custom-tags custom-filters]}]]
+(defn parse [file &
+             [{:keys [tag-open tag-close filter-open filter-close tag-second custom-tags custom-filters]}]]
   (binding [*tag-open*     (or tag-open *tag-open*)
             *tag-close*    (or tag-close *tag-close*)
             *filter-open*  (or filter-open *filter-open*)


Allow rerunning a selection without changing

--- src/snergly/core.cljs
+++ src/snergly/core.cljs
@@ -88,11 +88,7 @@
 (defn ready-to-go [{:keys [algorithm rows columns grid] :as maze}]
   (and (not= "" algorithm)
        (and (integer? rows) (> rows 1) (< rows 100))
-       (and (integer? columns) (> columns 1) (< columns 100))
-       (or (nil? grid)
-           (not= algorithm (:algorithm-name grid))
-           (not= rows (:rows grid))
-           (not= columns (:columns grid)))))
+       (and (integer? columns) (> columns 1) (< columns 100))))

 (defn animate-if-active [{:keys [active animator grid cell-size]}]
   (when active (protocols/animate-frame animator grid cell-size @thecanvas)))


Adding dial to synth controller gui.

Adding dial to synth controller gui.

--- src/overtone/gui/control.clj
+++ src/overtone/gui/control.clj
@@ -1,5 +1,6 @@
 (ns overtone.gui.control
-  (:use [seesaw core mig])
+  (:use [overtone.gui dial]
+        [seesaw core mig])
   (:require [seesaw.bind :as bind]))

 (native!)
@@ -14,7 +15,8 @@
         scaled-init (* (/ (- init-val min-val)
                           (double (- max-val min-val)))
                        SLIDER-MAX)
-        slider (slider :value scaled-init :min 0 :max SLIDER-MAX :orientation :horizontal)
+        slider (slider :id (keyword name) :class :synth-control-slider
+                       :value scaled-init :min 0 :max SLIDER-MAX :orientation :horizontal)
         label  (label name)
         items  [[label "width 80:80:100"]
                 [spinner "width 80:80:80"]
@@ -32,6 +34,30 @@
     (bind/bind val-atom spinner)
     items))

+(defn- control-dial
+  [name init-val min-val max-val step val-atom]
+  (let [spin-model (spinner-model (double init-val)
+                                  :from (double min-val) :to (double max-val) :by (double step))
+        spinner (spinner :model spin-model)
+        dial (dial :id (keyword name) :class :synth-control-dial
+                        :value init-val :min 0 :max SLIDER-MAX :orientation :horizontal)
+        label  (label name)
+        items  [[label "width 80:80:100"]
+                [spinner "width 80:80:80"]
+                [dial "wrap"]]]
+    (bind/bind dial
+               (comment bind/transform (fn [v]
+                                 (let [val (+ min-val (* (- max-val min-val)
+                                                         (/ v (double SLIDER-MAX))))]
+                                   val)))
+               val-atom)
+    (bind/bind val-atom
+               ;(bind/transform #(* (/ (- % min-val) (- max-val min-val)) SLIDER-MAX))
+               dial)
+    (bind/bind spinner val-atom)
+    (bind/bind val-atom spinner)
+    items))
+
 (defn synth-controller
   "Create a GUI for the given synth or instrument.  Requires sufficient parameter metadata in the synthdef.

@@ -44,22 +70,23 @@
   (reset-synth-defaults foo)
   "
   [synth]
-  (assert (every? (fn [{:keys [name default min max step value]}]
-                    (and name default min max step value))
-                  (:params synth))
-          "Not all synth params have the required metadata: :default, :min, :max, :step
-Example:
-          (defsynth foo [freq {:default 440 :min 10 :max 10000 :step 1}] ...)
-")
   (invoke-now
-    (let [control-panes (mapcat
-                          (fn [{:keys [name default min max step value]}]
-                            (control-slider name default min max step value))
-                          (:params synth))
-          pane (mig-panel :constraints ["" "[right][center][center]" ""]
-                          :items control-panes)
-          frame (frame :title (:name synth)
-                       :content pane
-                       :on-close :dispose)]
-      (-> frame pack! show!))))
+    (let [full-params (filter #(not (or (= :none (:type %))
+                                        (nil? (:min %))
+                                        (nil? (:max %))
+                                        (nil? (:step %))))
+                              (:params synth))]
+      (if (zero? (count full-params))
+        (alert (str "The " (:name synth) " synth or instrument does not have any parameters
+with the required meta-data.  (e.g.  [freq {:default 80 :min 40 :max 880 :step 1}])"))
+        (let [control-panes (mapcat
+                              (fn [{:keys [name default min max step value]}]
+                                (control-slider name default min max step value))
+                              full-params)
+              pane (mig-panel :constraints ["" "[right][center][center]" ""]
+                              :items control-panes)
+              frame (frame :title (:name synth)
+                           :content pane
+                           :on-close :dispose)]
+          (-> frame pack! show!))))))


improve envelope docstring

improve envelope docstring

--- src/overtone/sc/envelope.clj
+++ src/overtone/sc/envelope.clj
@@ -70,32 +70,34 @@

 (defn envelope
   "Create an envelope curve description array suitable for the env-gen ugen.
-   Requires a list of levels (the points that the envelope will pass through
-   and a list of durations (the duration in time of the lines between each
-   point).
+   Requires a list of levels (the points that the envelope will pass
+   through and a list of durations (the duration in time of the lines
+   between each point).

    Optionally a curve may be specified. This may be one of:
    * :step              - flat segments
    * :linear            - linear segments, the default
-   * :exponential       - natural exponential growth and decay. In this case,
-                          the levels must all be nonzero and the have the same
-                          sign.
+   * :exponential       - natural exponential growth and decay. In this
+                          case, the levels must all be nonzero and the have
+                          the same sign.
    * :sine              - sinusoidal S shaped segments.
-   * :welch             - sinusoidal segments shaped like the sides of a Welch
-                          window.
+   * :welch             - sinusoidal segments shaped like the sides of a
+                          Welch window.
    * a Float            - a curvature value to be repeated for all segments.
    * an Array of Floats - individual curvature values for each segment.
+                          Positive numbers curve the segment up whilst
+                          negative numbers curve the segment down.

    If a release-node is specified (an integer index) the envelope will sustain
    at the release node until released which occurs when the gate input of the
    env-gen is set to zero.

-   If a loop-node is specified (an integer index) the output will loop through
-   those nodes starting at the loop node to the node immediately preceeding the
-   release node, before back to the loop node, and so on. Note that the envelope
-   only transitions to the release node when released. The loop is escaped when
-   a gate signal is sent, which results with the the output transitioning to the
-   release node."
+   If a loop-node is specified (an integer index) the output will loop
+   through those nodes starting at the loop node to the node immediately
+   preceeding the release node, before back to the loop node, and so
+   on. Note that the envelope only transitions to the release node when
+   released. The loop is escaped when a gate signal is sent, which
+   results with the the output transitioning to the release node."

   ;;See prAsArray in supercollider/SCClassLibrary/Common/Audio/Env.sc
   [levels durations & [curve release-node loop-node]]


implementation change of rm

implementation change of rm

--- exercises/dominoes/src/example.clj
+++ exercises/dominoes/src/example.clj
@@ -1,10 +1,8 @@
 (ns dominoes)

 (defn rm [xs x]
-  (loop [xs xs, ac []]
-    (cond (empty? xs)      ac
-          (= x (first xs)) (reduce conj ac (rest xs))
-          :else            (recur (rest xs) (conj ac (first xs))))))
+  (let [i (.indexOf xs x)]
+    (if (= -1 i) xs (vec (concat (take i xs) (drop (inc i) xs))))))

 (defn connects [[a b] [c d]]
   (cond (= b c) [c d]


Add retag command

Add retag command

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -364,6 +364,13 @@
     (when (seq tags)
       (apply git {:gitdir gitdir} "tag" "--delete" tags)
       nil)))
+
+(defn retag
+  "Clear and retag all repos in .voom-repos"
+  [project & args]
+  (doseq [gitdir (all-repos-dirs)]
+    (clear-voom-tags gitdir)
+    (tag-repo-projects gitdir)))

 (defn parse-tag
   [tag]
@@ -530,6 +537,7 @@
   {"build-deps" build-deps
    "freshen" freshen
    "box-add" box-add
+   "retag" retag
    "new-task" nope})

 (defn ^:no-project-needed voom


Implement bottom half of box-add functionallity; finding projects.

Project name will match as subtring of all available projects across
all repos and all repo path locations. If the matching set across all
of these is more than one match, print an error.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -514,20 +514,30 @@
                            :desired-new-deps desired-new-deps
                            :tmp-file-name (str tmp-file)})))))))

-(defn repo-project-files
-  [gitdir]
-  (->
-   (git {:gitdir gitdir} "ls-files" "project.clj" "**/project.clj")
-   :lines))
+(defn resolve-short-proj
+  [dep]
+  (let [proj-set
+        , (into #{}
+                (flatten
+                 (for [g (all-repos-dirs)]
+                   (map #(s/replace (second (s/split % #"--")) #"%" "/")
+                        (:lines (git {:gitdir g} "tag" "--list" "voom--*"))))))]
+    (for [proj proj-set
+          :when (.contains proj dep) ]
+      proj)))

 (defn box-add
-  [proj & args]
-  (let [res (for [rdir (all-repos-dirs)
-                  pfile (repo-project-files rdir)]
-              [rdir pfile])]
-    (doseq [[^File r p] res]
-      (let [pf (str (.getParent r) "/" p)]
-        (prn (.getParent r) p (select-keys (project/read pf) [:group :name]))))))
+  [proj & deps]
+  (doseq [dep deps]
+    (let [full-projs (resolve-short-proj (name dep))
+          full-projs (map symbol full-projs)
+          repo-infos (mapcat #(newest-voom-ver-by-spec % "" {}) full-projs)]
+      (if (< 1 (count repo-infos))
+        (do
+          (println "Multiple projects / locations match" (str \" dep \"\:))
+          (doseq [r repo-infos]
+            (prn r)))
+        (prn "Found:" (first repo-infos))))))

 ;; === lein entrypoint ===


x coordinates

x coordinates

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -58,10 +58,10 @@
       ;;       to something descriptive and in your own style:
       (show/show :universes [1] :description "Deepower"))))

-  (show/patch-fixture! :rgbw-1 (my-rgbw) 1 1)
-  (show/patch-fixture! :rgbw-2 (my-rgbw) 1 5)
-  (show/patch-fixture! :rgbw-3 (my-rgbw) 1 9)
-  (show/patch-fixture! :rgb-1 (my-rgb) 1 13)
+  (show/patch-fixture! :rgbw-1 (my-rgbw) 1 1 :x 1)
+  (show/patch-fixture! :rgbw-2 (my-rgbw) 1 5 :x 2)
+  (show/patch-fixture! :rgbw-3 (my-rgbw) 1 9 :x 3)
+  (show/patch-fixture! :rgb-1 (my-rgb) 1 13  :x 3.5)

   ;; Return the show's symbol, rather than the actual map, which gets huge with
   ;; all the expanded, patched fixtures in it.


or-min or-max

or-min or-max

--- src/useful.clj
+++ src/useful.clj
@@ -20,6 +20,16 @@
        (if kvs
          (recur map (first kvs) (second kvs) (nnext kvs))
          map))))
+
+(defn or-min
+  "The minimium value of a and b, or whichever is not nil."
+  [a b]
+  (min (or a b) (or b a)))
+
+(defn or-max
+  "The maximum value of a and b, or whichever is not nil."
+  [a b]
+  (max (or a b) (or b a)))

 (defn conj-vec
   "Conj onto collection ensuring it is a vector."


Check for terminal nodes and refactor

Check for terminal nodes and refactor

--- src/ulam/connect4.clj
+++ src/ulam/connect4.clj
@@ -61,6 +61,11 @@
                             (check-nw pos board)))
                       board)))

+(defn check-terminal [state]
+  (cond (check-win (:p1 state)) 1
+        (check-win (:p2 state)) -1
+        (empty? (valid-moves state)) 0))
+
 #_(crit/quick-bench (check-win #{1 3 4 12 20 23}))

 (defn format-stats [stats]
@@ -76,7 +81,9 @@

 (defn add-node [move state]
-  {:state state :unvisited (set (valid-moves state)) :action move :visited 0 :score 0 :children {}}
+  (if-let [result (check-terminal state)]
+    {:state state :terminal true :visited 0 :score 0 :result result}
+    {:state state :unvisited (set (valid-moves state)) :action move :visited 0 :score 0 :children {}})
   )

 (add-node nil (init))
@@ -120,42 +127,39 @@
 (defn best-child [node]
   (last (sort-by #(uct (second %) (:visited node)) (:children node))))

-(def a [1 2 3])
-(first a)
-(first (concat a [:b]))
-(concat a [:b])

 (defn simulate-game [state]
-  (cond (check-win (:p1 state)) 1
-        (check-win (:p2 state)) -1
-        (empty? (valid-moves state)) 0
-        :else (let [move (rand-nth (valid-moves state))]
-                (recur (perform-move state move)))))
+  (if-let [result (check-terminal state)]
+    result
+    (let [move (rand-nth (valid-moves state))]
+      (recur (perform-move state move)))))

 (defn process [mtcs path]
-  (if false #_(> (:visited mtcs) 10000)
+  (if #_false (> (:visited mtcs) 100000)
     (best-child mtcs)
     (let [node (traverse mtcs path)
           child-path (interleave (repeat :children) path)]
-      (cond (not (empty? (:unvisited node)))
-            (let [move (rand-nth (seq (:unvisited node)))
-                  new-state (perform-move (:state node) move)
-                  new-node (add-node move new-state)
-                  result (simulate-game new-state)]
-              (recur (-> mtcs
-                         (update-in (concat child-path [:unvisited]) disj move)
-                         (assoc-in (concat child-path [:children move]) new-node)
-                         (backprop (concat path [move]) result)
-                         ) []))
+      (cond
+        (:terminal node)
+        (recur (backprop mtcs path (:result node)) [])

-            (empty? (:children node))
-            (println "terminal")
-            :else (let [[child-n _] (best-child node)]
-                    (recur mtcs (conj path child-n)))))))
+        (not (empty? (:unvisited node)))
+        (let [move (rand-nth (seq (:unvisited node)))
+              new-state (perform-move (:state node) move)
+              new-node (add-node move new-state)
+              result (simulate-game new-state)]
+          (recur (-> mtcs
+                     (update-in (concat child-path [:unvisited]) disj move)
+                     (assoc-in (concat child-path [:children move]) new-node)
+                     (backprop (concat path [move]) result)
+                     ) []))

-(loop [root (add-node :root (init))]
-  (println (process root []))
-  #_(recur root))
+        :else (let [[child-n _] (best-child node)]
+                (recur mtcs (conj path child-n)))))))
+
+(time (loop [root (add-node :root (init))]
+   (process root [])
+   #_(recur root)))


We no longer need this hack.

We no longer need this hack.

--- modules/core/src/main/clojure/immutant/runtime/bootstrap.clj
+++ modules/core/src/main/clojure/immutant/runtime/bootstrap.clj
@@ -28,11 +28,6 @@
   (:import [java.io File FilenameFilter]
            java.util.ArrayList
            org.sonatype.aether.resolution.DependencyResolutionException))
-
-(extend-type org.jboss.modules.ModuleClassLoader
-  pomegranate/URLClasspath
-  (can-modify? [this] false)
-  (add-url [this _]))

 (defn ^{:private true} stringify-symbol
   "Turns a symbol into a namspace/name string."


Add default error handler for watch and update events on rstore.

--- src/uxbox/rstore.cljs
+++ src/uxbox/rstore.cljs
@@ -86,6 +86,12 @@

 (enable-console-print!)

+(defn- on-error
+  "A default error handler."
+  [e]
+  (println "Unexpected error: " e)
+  (rx/empty))
+
 (defn init
   "Initializes the stream event loop and
   return a stream with model changes."
@@ -95,6 +101,7 @@
         update-s (rx/filter update? stream)
         state-s (->> update-s
                      (rx/scan #(-apply-update %2 %1) state)
+                     (rx/catch on-error)
                      (rx/share))]

     ;; Process event sources: combine with the latest model and the result will be
@@ -102,6 +109,7 @@
     (as-> watch-s $
       (rx/with-latest-from vector state-s $)
       (rx/flat-map (fn [[event model]] (-apply-watch event model stream)) $)
+      (rx/catch on-error $)
       (rx/on-value $ emit!))

     ;; Process effects: combine with the latest model to process the new effect


modify behavior to consider cursor coordinates to prevent interference with editing

--- src/parinfer/core.cljs
+++ src/parinfer/core.cljs
@@ -254,7 +254,6 @@
                        (update-in [:lines line-no] remove-str-range start end)
                        (assoc :backup backup :stack stack))

-
             insert-line? (= (:line-no insert) line-no)
             result (cond-> result
                      insert-line? (update-in [:insert :x-pos] min start))]
@@ -263,7 +262,7 @@

 (defn process-char
   "Update the given result by processing the given character and its position."
-  [{:keys [stack line-no track-indent?] :as result} [x-pos ch]]
+  [{:keys [stack line-no track-indent? cursor-x cursor-line] :as result} [x-pos ch]]

   (let [result (process-delim-trail result [x-pos ch])
         backup (:backup result)
@@ -279,16 +278,24 @@
                    (assoc :backup backup)
                    (update-in [:lines line-no] str ch))

+        insert-at-cursor? (and (not track-indent?)
+                               (= x-pos (dec cursor-x))
+                               (= line-no cursor-line)
+                               (in-code? stack)
+                               (whitespace? ch))
+
+        closing-delim? (isa? char-hierarchy ch :close)
+
+        insert-at-char? (and (not= "" ch)
+                             (not (whitespace? ch))
+                             (or (and (= line-no cursor-line)
+                                      closing-delim?)
+                                 (not closing-delim?))
+                             (in-code? stack))
+
         ;; Add potential insert point for closing delimiters if required.
-        insert (when (and (not= "" ch)
-
-                          ;; only allow whitespace as an insert if we have already found the indentation point
-                          ;; (i.e. a whitespace-only line)
-                          (or (and (not track-indent?) (whitespace? ch))
-                              (not (whitespace? ch)))
-                          (not (isa? char-hierarchy ch :close))
-                          (seq stack)
-                          (in-code? stack))
+        insert (when (or insert-at-cursor?
+                         insert-at-char?)
                  {:line-no line-no
                   :x-pos (inc x-pos)})
         result (cond-> result insert (assoc :insert insert))]
@@ -317,47 +324,51 @@
 (defn process-line
   "Update the given result by processing the given line of text."
   ([line] (process-line empty-result line))
-  ([{:keys [stack lines line-no] :as result} line]
-   (let [result (assoc result
+  ([{:keys [stack lines line-no cursor-line] :as result} line]
+   (let [line-no (inc line-no)
+         result (assoc result
                   :backup []
                   :delim-trail {:start nil :end nil}
                   :track-indent? (and (seq stack) (not (in-str? stack)))
                   :lines (conj lines "")
-                  :line-no (inc line-no))
+                  :line-no line-no)
          result (reduce pre-process-char result (str line "\n"))
-         result (remove-delim-trail result)
+         result (cond-> result
+                  (not= line-no cursor-line) remove-delim-trail)
          ]
      result)))

 (defn process-text
   "Update the given result by processing the given text."
-  ([text] (process-text empty-result text))
-  ([result text]
-   (let [result (reduce process-line result (split-lines text))
-         result (cond-> result (seq (:stack result)) close-delims)]
-     result)))
+  [result text & {:keys [cursor-line cursor-x]}]
+  (let [result (assoc result
+                      :cursor-line cursor-line
+                      :cursor-x cursor-x)
+        result (reduce process-line result (split-lines text))
+        result (cond-> result (seq (:stack result)) close-delims)]
+    result))

 ;;------------------------------------------------------------------------
 ;; Editor
 ;;------------------------------------------------------------------------
-
-;; EVENTS: TODO:
-;; when editing current line, prevent invalid closers
-;; when leaving current line, remove trailing closers
-;; when edited, updated paren overlay
-
-(defn remove-trailing-closers
-  [line]
-  (string/replace line #"[\]})]+\s*$" ""))
-
-;; VIEW

 (defn update-text!
   [cursor-index text]
-  (let [{:keys [stack lines]} (process-text text)]
+  (let [lines (split-lines (subs text 0 cursor-index))
+        cursor-x (count (last lines))
+        cursor-line (dec (count lines))
+        {:keys [stack lines]} (process-text empty-result text
+                                :cursor-line cursor-line
+                                :cursor-x cursor-x)]
     (swap! app-state assoc :stack stack)
     (swap! app-state assoc :text text)
     (swap! app-state assoc :full-text (join "\n" lines))))
+
+(defn trigger-change!
+  "should be called when text or cursor position changes."
+  [evt]
+  (let [target (.-target evt)]
+    (update-text! (.-selectionStart target) (.-value target))))

 (defn root-comp
   [data owner]
@@ -367,9 +378,7 @@
       (html
         [:div
          [:textarea
-          {:on-change (fn [evt]
-                        (let [target (.-target evt)]
-                          (update-text! (.-selectionStart target) (.-value target))))}]
+          {:on-change trigger-change!}]
          [:pre.computed (:full-text data)]]))))

 ;; hack to initialize the state on first load (not when reloading)


add arrows for next/prev month

add arrows for next/prev month

--- src/yablog/server.clj
+++ src/yablog/server.clj
@@ -67,13 +67,24 @@
         (map hic/hiccup-entry (page/recent-pages 5 (:pages req)))))

 (defn entries-for-month [req]
-  (let [p (:route-params req)]
+  (let [p (:route-params req)
+        y (Integer. (:year p))
+        m (Integer. (:month p))
+        next-month (time/plus (time/date-time y m) (time/months 1))
+        prev-month (time/minus (time/date-time y m) (time/months 1))]
     ;; XXX would be neat if it included "older" and "newer" links
-    (into [:article]
-          (map hic/hiccup-entry
-               (page/pages-in-month (Integer. (:year p))
-                                    (Integer. (:month p))
-                                    (:pages req))))))
+    (conj
+     (into [:article]
+           (map hic/hiccup-entry
+                (page/pages-in-month y m (:pages req))))
+     [:div {:class "nav"}
+      [:a {:href (ftime/unparse (ftime/formatter "/yyyy/M/") prev-month)}
+       "⟪" (ftime/unparse (ftime/formatter "MMM yyyy") prev-month)]
+      " "
+      [:a {:href (ftime/unparse (ftime/formatter "/yyyy/M/") next-month)}
+       (ftime/unparse (ftime/formatter "MMM yyyy") next-month)   "⟫"]
+      ])))
+

 (defn entry-by-y-m-slug [y m slug request]
   (let [p (page/find-page (Integer. y) (Integer. m)


Implementing call a system process

Implementing call a system process

--- src/power/py_relay.clj
+++ src/power/py_relay.clj
@@ -4,23 +4,41 @@
   (:import (power.device Device)))

 (def ^:private python-path "/usr/bin/python")
-(def ^:private python-file "relay.py")
+(def ^:private device-resource "relay.py")
+(def ^:private destination-resource-dir "/tmp/rpi/devices/")

 (def ^:private commands {:on  :high
-                         :off :low
-                         :close :close})
+                         :off :low})
+
+(defn- resource-content
+  [resource]
+  (slurp (io/resource resource)))
+
+(defn- create-temp-file
+  [dest-file content]
+  (let [temp-file (io/file (str destination-resource-dir dest-file))]
+    (do
+      (io/make-parents temp-file)
+      (spit temp-file content)
+      temp-file)))
+
+(defn- cleanup-resource-file
+  [resource-file]
+  (io/delete-file resource-file true))

 (defn- do-command
-  [command]
+  [driver-file command]
   (let [option (-> commands command name .toUpperCase)
-        py-resource (-> python-file io/resource .getPath)]
+        py-resource (-> driver-file io/file .getPath)]
     (sh python-path py-resource option)))

-(deftype Relay []
+(deftype Relay [driver-file]
   Device
-  (close [this] (do-command :close))
-  (transmit [this command] (do-command command)))
+  (close [this] (cleanup-resource-file driver-file))
+  (transmit [this command] (do-command driver-file command)))

 (defn make-relay-device
   []
-  (Relay.))
+  (if-let [dev-resource-content (resource-content device-resource)]
+    (let [driver-file (create-temp-file device-resource dev-resource-content)]
+      (Relay. driver-file))))


Slightly more efficient

Slightly more efficient

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -51,7 +51,7 @@
   (set-path! code))

 (defn title-from-html []
-  (val ($ ".title")))
+  (val (find $header ".title")))

 (defn wishes-from-html []
   (for [el ($ wish-li)]


Remove hashing order dependency in tests

--- test/clj/com/palletops/api_builder/stage/log_test.clj
+++ test/clj/com/palletops/api_builder/stage/log_test.clj
@@ -12,7 +12,7 @@

 (defn format-with-domain-context-tags
   [{:keys [domain context tags]} & _]
-  (str (pr-str domain) (pr-str context) (pr-str tags)))
+  (str (pr-str domain) (pr-str context) (pr-str (sort tags))))

 (def-log-scope-fn scope
   {:context {:a 1}
@@ -32,7 +32,7 @@
   [] 1)

 (deftest log-scope-test
-  (is (= ":d{:a 1}#{:t1 :t2}\n" (with-out-str (scope)))))
+  (is (= ":d{:a 1}(:t1 :t2)\n" (with-out-str (scope)))))

 (deftest log-entry-test
   (set-level! :trace)


Test fix for BigQuery SQL params [ci drivers]

--- test/metabase/query_processor/sql_parameters_test.clj
+++ test/metabase/query_processor/sql_parameters_test.clj
@@ -12,7 +12,8 @@
             [metabase.test.data.datasets :as datasets]
             [metabase.test.data.generic-sql :as generic-sql]
             [metabase.test.util :as tu]
-            [metabase.test.data.generic-sql :as generic]))
+            [metabase.test.data.generic-sql :as generic]
+            [metabase.util :as u]))

 ;;; ------------------------------------------------------------ simple substitution -- {{x}} ------------------------------------------------------------
@@ -351,12 +352,15 @@
   (generic-sql/quote-name datasets/*driver* identifier))

 (defn- checkins-identifier []
-  (let [{table-name :name, schema :schema} (db/select-one ['Table :name :schema], :id (data/id :checkins))]
-    (str (when (seq schema)
-           (str (quote-name schema) \.))
-         (quote-name table-name))))
-
-;; as with the MBQL parameters tests redshift and crate fail for unknown reasons; disable their tests for now
+  ;; HACK ! I don't have all day to write protocol methods to make this work the "right" way so for BigQuery we will just hackily return the correct identifier here
+  (if (= datasets/*engine* :bigquery)
+    "[test_data.checkins]"
+    (let [{table-name :name, schema :schema} (db/select-one ['Table :name :schema], :id (data/id :checkins))]
+      (str (when (seq schema)
+             (str (quote-name schema) \.))
+           (quote-name table-name)))))
+
+;; as with the MBQL parameters tests Redshift and Crate fail for unknown reasons; disable their tests for now
 (def ^:private ^:const sql-parameters-engines
   (set/difference (engines-that-support :native-parameters) #{:redshift :crate}))


fix rr range

fix rr range

--- src/shared/client.cljs
+++ src/shared/client.cljs
@@ -64,8 +64,8 @@
                   :icon            make-valid-icon
                   :subjects        identity
                   :exposure        identity
-                  :baseline-risk   #(in-range (make-valid-float %) 0)
-                  :relative-risk   #(in-range (make-valid-float %) 0 1)
+                  :baseline-risk   #(in-range (make-valid-float %) 0 1)
+                  :relative-risk   #(in-range (make-valid-float %) 0)
                   :outcome-verb    identity
                   :outcome         identity
                   :evidence-source identity


drop the reload, use \ef for that

drop the reload, use \ef for that

--- src/smallblog/core.clj
+++ src/smallblog/core.clj
@@ -5,7 +5,6 @@
 				[ring.middleware.json-params]
 				[ring.middleware.params]
 				[ring.middleware.multipart-params]
-				[ring.middleware.reload]
 				[ring.middleware.stacktrace]
 				[sandbar stateful-session auth validation])
 	(:require	[compojure.route :as route]
@@ -205,10 +204,6 @@
 		(with-security security-config authorize)
 		wrap-stateful-session

-		; XXX not for production
-		(wrap-reload '(smallblog.templates smallblog.data)) ;, smallblog.core, smallblog.util,
-									 ;))
-
 		(wrap-stacktrace)
 		(wrap-params)
 		(wrap-json-params)))


Remove unused import.

Remove unused import.

--- src/suricatta/impl.clj
+++ src/suricatta/impl.clj
@@ -37,7 +37,6 @@
            org.jooq.Query
            org.jooq.Field
            org.jooq.Result
-           org.jooq.VisitContext
            org.jooq.RenderContext
            org.jooq.BindContext
            org.jooq.Configuration


adding some legacy routes tests

adding some legacy routes tests

--- test/vignette/api/legacy/routes_test.clj
+++ test/vignette/api/legacy/routes_test.clj
@@ -124,6 +124,16 @@
     (:top-dir matched) => "4"
     (:middle-dir matched) => "40"
     (:original matched) => "JohnvanBruggen.jpg"
+    (:width matched) => "200")
+  (let [matched (route-matches alr/thumbnail-route
+                               (request :get "/muppet/images/thumb/temp/4/40/JohnvanBruggen.jpg/200px-JohnvanBruggen.jpg"))
+        matched (alr/route->thumb-map matched)]
+    (:thumbnail-mode matched) => "scale-to-width"
+    (alr/zone matched) => "temp"
+    (:wikia matched) => "muppet"
+    (:top-dir matched) => "4"
+    (:middle-dir matched) => "40"
+    (:original matched) => "JohnvanBruggen.jpg"
     (:width matched) => "200"))

 (facts :original-route
@@ -146,6 +156,17 @@
          (:middle-dir map) => "b7"
          (:original map) => "Flag_of_Europe.svg"
          (:revision map) => "latest"
+         (:path-prefix (:options map)) => "fr")
+       (let [map (alr/route->original-map
+                   (route-matches alr/original-route
+                                  (request :get "/aigles-et-lys/fr/images/temp/b/b7/Flag_of_Europe.svg")))]
+         (:request-type map) => :original
+         (:wikia map) => "aigles-et-lys"
+         (alr/zone map) => "temp"
+         (:top-dir map) => "b"
+         (:middle-dir map) => "b7"
+         (:original map) => "Flag_of_Europe.svg"
+         (:revision map) => "latest"
          (:path-prefix (:options map)) => "fr"))

 (facts :timeline-route


GAWB-1821: oops

GAWB-1821: oops

--- src/cljs/main/broadfcui/page/method_repo/method_config_importer.cljs
+++ src/cljs/main/broadfcui/page/method_repo/method_config_importer.cljs
@@ -181,7 +181,7 @@
           {:label "Configuration Name" :key "name"}
           {:label "Root Entity Type" :key "rootEntityType" :type "identity-select" :options root-entity-types}])

-       (:error @state) (style/create-server-error-message (:error @state))`
+       (:error @state) (style/create-server-error-message (:error @state))
        :else [comps/Spinner {:text "Creating template..."}]))
    :perform-copy
    (fn [{:keys [props state refs]}]


CMR-1386: Reset file name in visualization output

--- system-int-test/test/cmr/system_int_test/search/granule_orbit_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/granule_orbit_search_test.clj
@@ -488,7 +488,7 @@
   ;; 3. Evaluate a block like this to save the mbrs to kml and open in google earth.
   ;; Google Earth will open when you evaluate it. (as long as you've installed it)
   ;; You can give different tests unique names. Otherwise it will overwrite the file.
-  (ge-helper/display-shapes "start_circ_pos_501.kml" @matching-mbrs)
+  (ge-helper/display-shapes "start_circ_pos_50.kml" @matching-mbrs)

   (ge-helper/display-shapes "start_circ_pos_50_poly.kml" @matching-polys)


lose println

lose println

--- dada-core/src/main/clojure/org/dada/web.clj
+++ dada-core/src/main/clojure/org/dada/web.clj
@@ -1,6 +1,7 @@
 (ns
  #^{:author "Jules Gosnell" :doc "HTTP Class Server for DADA"}
  org.dada.web
+ (:use clojure.contrib.logging)
  (:use [org.dada.core])
  ;; (:import [org.eclipse.jetty.server
  ;; 	   Request Server]
@@ -36,8 +37,8 @@
 ;; 				 (.setContentType response "application/binary")
 ;; 				 (.setContentLength response (count bytes))
 ;; 				 (.setStatus response 200)
-;; 				 (println "Serving" request)
-;; 				 (println "Serving" name "=" bytes)
+;; 				 (info (str "Serving " request))
+;; 				 (info (str "Serving " name " = " bytes))
 ;; 				 (.write stream bytes)
 ;; 				 (.close stream))
 ;; 			       (.setHandled request true)))]


work around the fact that we are hacking clojure's ClassLoader

--- dada-core/src/main/clojure/org/dada/web.clj
+++ dada-core/src/main/clojure/org/dada/web.clj
@@ -1,15 +1,13 @@
-(ns
- #^{:author "Jules Gosnell" :doc "HTTP Class Server for DADA"}
- org.dada.web
- (:use clojure.tools.logging)
- (:use [org.dada.core])
- (:import
-  [clojure.lang DynamicClassLoader]
-  [org.eclipse.jetty.server Request Server]
-  [org.eclipse.jetty.server.handler AbstractHandler]
-  [java.io InputStream OutputStream ByteArrayOutputStream]
-  [javax.servlet.http HttpServletResponse])
- )
+(ns ^{:author "Jules Gosnell" :doc "HTTP Class Server for DADA"} org.dada.web
+    (:use clojure.tools.logging)
+    (:use [org.dada.core])
+    (:import
+     [clojure.lang DynamicClassLoader]
+     [org.eclipse.jetty.server Request Server]
+     [org.eclipse.jetty.server.handler AbstractHandler]
+     [java.io InputStream OutputStream ByteArrayOutputStream]
+     [javax.servlet.http HttpServletResponse])
+    )

 ;; TODO: we should use a package name filter to avoid serving homonyms with different content...

@@ -31,9 +29,14 @@
 	  (.close is)
 	  (.close os))))))

+;; delay evaluation of DynamicClassLoader/byteCodeForName until runtime, when our hacks will be in place...
+(def byteCodeForName
+     (delay (eval '(fn [name] (DynamicClassLoader/byteCodeForName name)))))
+
 (defn dynamic-class-bytes [^String path-info]
-  (if-let [bytes (DynamicClassLoader/byteCodeForName (.replace (.substring path-info 0 (- (.length path-info) 6)) \/ \.))]
+  (if-let [bytes (@byteCodeForName (.replace (.substring path-info 0 (- (.length path-info) 6)) \/ \.))]
       ["dynamic class" bytes]))
+

 ;; only works when URLClassLoader has been given a URL ending in '/'
 (defn handle-request [^String target ^Request base-request ^Request request ^HttpServletResponse response]


expose check on utils class through the linter

--- src/app/linter.clj
+++ src/app/linter.clj
@@ -21,7 +21,9 @@
   [(Check. classesWithManyConstructorsOp {:threshold 4}
      "This class has too many constructors (#1#). Consider using static factory methods or the Builder pattern")
    (Check. constructorsWithManyParametersOp {:threshold 6}
-     "This constructor has too many parameters (#1#). Consider using the Builder pattern")])
+     "This constructor has too many parameters (#1#). Consider using the Builder pattern")
+   (Check. utilsClassesOp {:onlyIncorrect true}
+     "This is a utils class and it should have exactly one private constructor taking no params")])

 (defn replaceParamsInMessage [message result]
   (clojure.string/replace message "#1#" (toString (nth result 1))))
@@ -32,8 +34,8 @@
 (defn executeCheck [check cus]
   (let [operation (.operation check)
         params (.params check)
-        threshold (:threshold params)
-        results ((.query operation) {:cus cus :threshold threshold})
+        queryParams (assoc params :cus cus)
+        results ((.query operation) queryParams)
         message (.message check)]
     (doseq [r results]
       (printCheckResult r message))))


kicking off a travis-ci build demo

kicking off a travis-ci build demo

--- src/aspire/web.clj
+++ src/aspire/web.clj
@@ -29,7 +29,7 @@
 (defresource resource-base
   :available-media-types ["text/html"]
   :handle-ok (fn [_]
-               (a-tpl/render (a-tpl/index "hi"))))
+               (a-tpl/render (a-tpl/index "hiya"))))

 (defroutes app-routes
   (ANY "/" [] resource-base))


Add `(go)` to named cljs-repl arity

Add `(go)` to named cljs-repl arity

This path also requires that the server is started before running.

--- lib/edge.app.dev/src/dev_extras.clj
+++ lib/edge.app.dev/src/dev_extras.clj
@@ -103,6 +103,8 @@
               (throw (ex-info "A build must be specified, please call with an argument"
                               {:builds builds#}))))))))
   ([build-id]
+   ;; Register build with figwheel
+   (go)
    ;; Assume figwheel main
    (eval
      `(do


Modify victorian_spec to use victorian terms.

--- spec/manners/victorian_spec.clj
+++ spec/manners/victorian_spec.clj
@@ -1,46 +1,46 @@
 (ns manners.victorian-spec
   (:require [manners.victorian :refer :all]
-            [speclj.victorian :refer :all]))
+            [speclj.core :refer :all]))

 (describe "manners"
-  (with nil-faults (manners [[odd? "it should be odd"]
-                             [number? "it should be a number"]]))
+  (with nil-coach (coach [[odd? "it should be odd"]
+                           [number? "it should be a number"]]))
   (it "Always returns a sequence"
-    (should (sequential? (@nil-faults nil)))
-    (should (sequential? (@nil-faults 3737))))
+    (should (sequential? (@nil-coach nil)))
+    (should (sequential? (@nil-coach 3737))))
   (it "is empty when all predicates pass"
-    (should (empty? (@nil-faults 3))))
+    (should (empty? (@nil-coach 3))))
   (it "is a sequence of error messages if it does not pass."
-    (should= (list "it should be odd") (@nil-faults 2))
-    (should-contain "it should be a number" (@nil-faults nil))))
+    (should= (list "it should be odd") (@nil-coach 2))
+    (should-contain "it should be a number" (@nil-coach nil))))

-(describe "faults"
+(describe "bad-manners"
   (with validations [[odd? "it should be odd"]
                      [number? "it should be a number"]])
-  (it "finds faults"
+  (it "finds bad-manners"
     (should= (list "it should be odd" "it should be a number")
-             (faults @validations nil))
-    (should= (list "it should be odd") (faults @validations 2))
-    (should= (list) (faults @validations 3))))
+             (bad-manners @validations nil))
+    (should= (list "it should be odd") (bad-manners @validations 2))
+    (should= (list) (bad-manners @validations 3))))

-(describe "faulty? and faultless?"
+(describe "rude? and proper?"
   (with validations [[odd? "it should be odd"]
                      [number? "it should be a number"]])
   (it "complements"
-    (should (faulty? @validations 2))
-    (should-not (faultless? @validations 2))
-    (should-not (faulty? @validations 1))
-    (should (faultless? @validations 1))))
+    (should (rude? @validations 2))
+    (should-not (proper? @validations 2))
+    (should-not (rude? @validations 1))
+    (should (proper? @validations 1))))

-(describe "faultless!"
+(describe "avow!"
   (with validations [[odd? "it should be odd"]
                      [number? "it should be a number"]])
-  (it "throws an error when faults are found"
+  (it "throws an error when bad manners are found"
     (should-throw AssertionError "it should be odd, it should be a number"
-                  (faultless! @validations nil))
+                  (avow! @validations nil))
     (should-throw AssertionError "Invalid odd-number: it should be odd"
-                  (faultless! 'odd-number @validations 2)))
-  (it "does nothing when no faults are found"
-    (should-not-throw (faultless! @validations 3))))
+                  (avow! 'odd-number @validations 2)))
+  (it "does nothing when no bad manners are found"
+    (should-not-throw (avow! @validations 3))))

 (run-specs)


Add more test cases for insert

Add more test cases for insert

--- test/clj/libx/util_test.cljc
+++ test/clj/libx/util_test.cljc
@@ -5,7 +5,7 @@
               [clara.tools.tracing :as trace]
               [libx.util :refer :all]
               [clojure.spec :as s]
-              [clara.rules :refer [query defquery] :as cr]
+              [clara.rules :refer [query defquery fire-rules] :as cr]
               [clara.tools.tracing :as trace]))

 (defquery find-all []
@@ -45,16 +45,47 @@
     (is (every? is-tuple? (insertable (insertable m-facts))))))

 (deftest insert-test
-  (let [session @(def-tuple-session mysess)
-        numfacts 5
-        m-fact  #(todo-tx (java.util.UUID/randomUUID) "Hi" :tag)
-        m-facts (into [] (repeatedly numfacts m-fact))
-        trace (trace/get-trace (-> session
-                                (trace/with-tracing)
-                                (insert-fire m-facts)))]
-    (is (= :add-facts (:type (first trace))))
-    (is (= (count (:facts (first trace)))
-           (* numfacts (dec (count (keys (m-fact)))))))))
+  (testing "Insert single tuple"
+    (let [session @(def-tuple-session mysess)
+          fact [-1 :foo "bar"]
+          trace (trace/get-trace (-> session
+                                   (trace/with-tracing)
+                                   (insert fact)
+                                   (fire-rules)))]
+      (is (= :add-facts (:type (first trace))))
+      (is (= 1 (count (:facts (first trace)))))))
+  (testing "Insert tuples"
+    (let [session @(def-tuple-session mysess)
+          facts [[-1 :foo "bar"]
+                 [-1 :bar "baz"]
+                 [-2 :foo "baz"]]
+          trace (trace/get-trace (-> session
+                                   (trace/with-tracing)
+                                   (insert facts)
+                                   (fire-rules)))]
+      (is (= :add-facts (:type (first trace))))
+      (is (= (count facts) (count (:facts (first trace)))))))
+  (testing "Insert single map"
+    (let [session @(def-tuple-session mysess)
+          fact  (todo-tx (java.util.UUID/randomUUID) "Hi" :tag)
+          trace (trace/get-trace (-> session
+                                   (trace/with-tracing)
+                                   (insert fact)
+                                   (fire-rules)))]
+      (is (= :add-facts (:type (first trace))))
+      (is (= (dec (count (keys fact))) (count (:facts (first trace)))))))
+
+  (testing "Insert vector of maps"
+    (let [session @(def-tuple-session mysess)
+          numfacts 5
+          m-fact  #(todo-tx (java.util.UUID/randomUUID) "Hi" :tag)
+          m-facts (into [] (repeatedly numfacts m-fact))
+          trace (trace/get-trace (-> session
+                                  (trace/with-tracing)
+                                  (insert-fire m-facts)))]
+      (is (= :add-facts (:type (first trace))))
+      (is (= (count (:facts (first trace)))
+             (* numfacts (dec (count (keys (m-fact))))))))))

 (deftest with-changes-test
   (let [changes-added (with-changes {:db/id 1 :foo "bar"})


Fix compojure.core-test

Fix compojure.core-test

Signed-off-by: weavejester <9dadf8ecafa226c8f7c16002bdcb090267879343@weavejester.com>

--- test/compojure/core_test.clj
+++ test/compojure/core_test.clj
@@ -11,7 +11,7 @@
      nil)
    {:request-method :get
     :uri "/foo"
-    :params {:x "bar", :y "baz"}}))
+    :params {"x" "bar", "y" "baz"}}))

 (deftest route-with-map-arguments
   ((GET "/foo" {params :params}
@@ -19,4 +19,4 @@
      nil)
    {:request-method :get
     :uri "/foo"
-    :params {:x "a", :y "b"}}))
+    :params {"x" "a", "y" "b"}}))


Affirm not only the receive but that the message is gone from the queue

--- integration-tests/src/test/clojure/immutant/integs/msg/selector.clj
+++ integration-tests/src/test/clojure/immutant/integs/msg/selector.clj
@@ -31,7 +31,8 @@
   (publish queue 1 :properties {:prop 5} :priority :high)
   (publish queue 2 :properties {:prop 3} :priority :low)
   (is (= 2 (receive queue :selector "prop < 5")))
-  (is (= 1 (receive queue))))
+  (is (= 1 (receive queue)))
+  (is (nil? (receive queue :timeout 1000))))

 (deftest various-selectors
   (let [selectors ["prop = true"


(maint) add/fix some schema return types

--- src/puppetlabs/trapperkeeper/services/status/status_core.clj
+++ src/puppetlabs/trapperkeeper/services/status/status_core.clj
@@ -70,10 +70,10 @@
     (validation-error-explain schema-failure)
     schema-failure))

-(schema/defn check-timeout
+(schema/defn check-timeout :- schema/Int
   "Given a status level keyword, returns a number of seconds to use as a timeout
   when calling a status function."
-  [level :- ServiceStatusDetailLevel] :- schema/Int
+  [level :- ServiceStatusDetailLevel]
   (case level
     :critical 5
     :info 60
@@ -101,11 +101,11 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public

-(schema/defn ^:always-validate nominal?
+(schema/defn ^:always-validate nominal? :- schema/Bool
   [status :- ServiceStatus]
   (= (:state status) :running))

-(schema/defn ^:always-validate all-nominal?
+(schema/defn ^:always-validate all-nominal? :- schema/Bool
   [statuses :- ServicesStatus]
   (every? nominal? (vals statuses)))

@@ -162,7 +162,7 @@
   (let [status-map (service-status-map svc-version status-version status-fn)]
     (swap! status-fns-atom update-in [svc-name] conj status-map)))

-(schema/defn ^:always-validate guarded-status-fn-call
+(schema/defn ^:always-validate guarded-status-fn-call :- StatusCallbackResponse
   "Given a status check function, a status detail level, and a timeout in
   seconds, this function calls the status function and handles three types of
   errors:
@@ -175,7 +175,7 @@
   string describing the error."
   [status-fn :- StatusFn
    level :- ServiceStatusDetailLevel
-   timeout :- schema/Int] :- StatusCallbackResponse
+   timeout :- schema/Int]
    (let [unknown-response (fn [status] {:state :unknown
                                         :status status})
          timeout-response (unknown-response (format "Status check timed out after %s seconds" timeout))]
@@ -264,11 +264,11 @@
                :message (str "Invalid service_status_version. Should be an "
                           "integer but was " level)}))))

-(schema/defn ^:always-validate summarize-states
+(schema/defn ^:always-validate summarize-states :- State
   "Given a map of service statuses:
    * if all of the statuses have the same :state, returns that :state
    * if not all of the statuses are the same, returns :unknown"
-  [statuses :- ServicesStatus] :- State
+  [statuses :- ServicesStatus]
   (let [state-set (->> statuses
                        vals
                        (map :state)
@@ -282,12 +282,12 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Compojure App

-(schema/defn ^:always-validate status->code
+(schema/defn ^:always-validate status->code :- schema/Int
   "Given a service status, returns an appropriate HTTP status code"
-  [status :- ServiceStatus] :- schema/Int
+  [status :- ServiceStatus]
   (if (nominal? status) 200 503))

-(schema/defn ^:always-validate statuses->code
+(schema/defn ^:always-validate statuses->code :- schema/Int
   "Given a map of service statuses, returns an appropriate HTTP status code."
   [statuses :- ServicesStatus]
   (if (all-nominal? statuses) 200 503))


Renamed want-chs to wait-chs.

Renamed want-chs to wait-chs.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -45,7 +45,7 @@
    {:beg (fn [vis actx args]
            (let [[child-actx] args]
              (swap! vis #(assoc-in % [:actxs child-actx]
-                                   {:children {} :want-chs {}}))
+                                   {:children {} :wait-chs {}}))
              (swap! vis #(assoc-in % [:actxs actx :children child-actx]
                                    true))))
     :end (fn [vis actx args]
@@ -60,17 +60,17 @@
    "atake"
    {:beg (fn [vis actx args]
            (let [[ch] args]
-             (swap! vis #(assoc-in % [:actxs actx :want-chs ch] :take))))
+             (swap! vis #(assoc-in % [:actxs actx :wait-chs ch] :take))))
     :end (fn [vis actx args]
            (let [[ch result] args]
-             (swap! vis #(dissoc-in % [:actxs actx :want-chs ch]))))}
+             (swap! vis #(dissoc-in % [:actxs actx :wait-chs ch]))))}
    "aput"
    {:beg (fn [vis actx args]
            (let [[ch msg] args]
-             (swap! vis #(assoc-in % [:actxs actx :want-chs ch] :put))))
+             (swap! vis #(assoc-in % [:actxs actx :wait-chs ch] :put))))
     :end (fn [vis actx args]
            (let [[ch msg result] args]
-             (swap! vis #(dissoc-in % [:actxs actx :want-chs ch]))))}
+             (swap! vis #(dissoc-in % [:actxs actx :wait-chs ch]))))}
    "aalts"
    {:beg (fn [vis actx args]
            (let [[chs] args] 1))
@@ -81,7 +81,7 @@
   (if actx
     (let [d (get-in vis [:actxs actx])
           children (:children d)
-          want-chs (:want-chs d)]
+          wait-chs (:wait-chs d)]
       ["
" (string/join ":" (last actx))
        "
"
        (if (not-empty children)
@@ -89,9 +89,9 @@
           (map (fn [kv] ["
" (vis-html vis (first kv)) "
"]) children)
           "

"]
          [])
-       (if (not-empty want-chs)
+       (if (not-empty wait-chs)
          ["
waiting...
"
-          (map (fn [kv] ["
" (second kv) "
"]) want-chs)
+          (map (fn [kv] ["
" (second kv) "
"]) wait-chs)
           "

"]
          [])
        "
"
@@ -99,7 +99,7 @@
     "no actx"))

 (defn vis-init [cmds cmd-handlers]
-  (let [vis (atom {:actxs {}}) ; [actx -> {:children {}, :want-chs {}}].
+  (let [vis (atom {:actxs {}}) ; [actx -> {:children {}, :wait-chs {}}].
         max-inflight (atom 10)
         event-delay (atom 0)
         event-ch (chan)


Renamed in/out to in-ch/out-ch.

Renamed in/out to in-ch/out-ch.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -307,18 +307,18 @@
         (recur (inc num-events) @vis @vis-positions)))
     (ago world w
          (reset! root-actx world)
-         (let [in (achan-buf world 100)
-               out (achan-buf world 0)]
+         (let [in-ch (achan-buf world 100)
+               out-ch (achan-buf world 0)]
            (ago-loop user-in world [num-ins 0]
                      (let [cmd (<! cmds)
                            cmd-handler ((get cmd-handlers (:op cmd)) cmd)]
-                       (aput user-in in cmd-handler)
+                       (aput user-in in-ch cmd-handler)
                        (recur (inc num-ins))))
            (ago-loop user-out world [num-outs 0]
-                     (let [result (atake user-out out)]
+                     (let [result (atake user-out out-ch)]
                        (set-el-innerHTML "output" result)
                        (recur (inc num-outs))))
-           (make-fenced-pump world in out @max-inflight)))
+           (make-fenced-pump world in-ch out-ch @max-inflight)))
     (vis-run-controls event-delay step-ch)))

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


a little more towards pde -> quil version

--- dmmproj/src/dmm/examples/self_ref_grid.cljs
+++ dmmproj/src/dmm/examples/self_ref_grid.cljs
@@ -33,14 +33,17 @@

 (defn setup []
-  (q/frame-rate (@app-state :frame-rate)))
+  (q/frame-rate (@app-state :frame-rate))
+  (q/background 127)
+  (q/color-mode :rgb 2.0)
+  {:hor-board-size })

 (defn update-state [state]
   (q/frame-rate (@app-state :frame-rate))
   :do-state-updates)

 (defn draw-state [state]
-  (q/background 127))
+  )

 (q/defsketch selfie


[#123] Deleting the old tmp dir after 60 secs

Not the most robust way but the data is just 1 mb and in any case a pod
restart will clean up.


CMR-1922: Uncommented a test which was commented for testing

--- system-int-test/test/cmr/system_int_test/virtual_product_test.clj
+++ system-int-test/test/cmr/system_int_test/virtual_product_test.clj
@@ -105,7 +105,7 @@
       (testing "Find no granules"
         (is (= 0 (:hits (search/find-refs :granule {}))))))

-    #_(testing "Recreate source granule"
+    (testing "Recreate source granule"
       (let [ast-l1a-gran-r4 (vp/ingest-source-granule "LPDAAC_ECS"
                                                      (dissoc ast-l1a-gran :revision-id :concept-id))]
         (index/wait-until-indexed)


repl states

repl states

--- examples/storyboard/page.cljs
+++ examples/storyboard/page.cljs
@@ -21,14 +21,14 @@
          {:title "Thinking Clojurescript"
           :issue "Issue No #1"
           :publisher "The Facjure Review"
-          :logo "/img/logo.png"
+          :logo ""
           :editorial "Object Oriented programming as a paradigm has many real
                    benefits but one of the worst plagues it has inflicted on
                    programming culture is obscuring data. Functional programming
                    is not a silver bullet but its emphasis on unadorned data is
                    a guiding light. No models."
           :interviews ["David Nolen, " "Bruce Hoffman, " "Joel Holdbrooks"]
-          :developer-pic "/img/cljs.png"
+          :developer-pic ""
           :essays ["“A meditation in Edn” by Priyatam Mudivarti"]
           :quotes {:nolen-tweet "“We create things with our tools, and
                     our tools have consequences”"
@@ -84,7 +84,7 @@

 (add-watch app-state :history
            (fn [_ _ old new]
-             (println old new history)
+             #_(println old new history)
              (when-not (= (last @history) new)
                (swap! history conj new))))

@@ -129,11 +129,12 @@
      [:h5 "Essays"]
      [:p (map str essays)]]]
    [:div {:class "grid"}
-    [:div {:class "unit half" }
-     [:blockquote.oval-quotes
+    [:div {:class "unit one-third" }
+     [:blockquote.oval-quotes' ;; oval-thought-border
       [:p (get-in content [:quotes :dev-quote])]]]
-    [:div {:class "unit one-third photo"} ]]
+    [:div {:class "unit two-thirds"} ]]
    [:div {:class "grid"}
+    #_[:div {:class "unit golden-small"}]
     [:div {:class "unit golden-large photo-medium"} [:img {:src developer-pic}]
      [:p (get-in content [:quotes :dev-quote])]]]])

@@ -142,6 +143,7 @@
     om/IWillMount
     (will-mount [_]
       (println "widget mounting")
+      ;; Insert fine-grain component styles
       (insert-styles styles/page-styles))
     om/IRenderState
     (render-state [_ {:keys [count]}]
@@ -173,10 +175,16 @@

 (mount component "storyboard")

+
+;; Demos
+
 #_(unmount "storyboard")

-#_(swap! app-state assoc-in [:content :quotes :nolen-tweet] "Clojure West 2015")
+#_(swap! app-state assoc-in [:content :logo] "/img/logo.png")
+#_(swap! app-state assoc-in [:content :developer-pic] "/img/cljs.png")
+
+#_(swap! app-state assoc-in [:content :quotes :nolen-tweet]
+         "Clojurescript, Lisp's revenge")

 #_(reset! app-state new-state)
-
 #_(undo!)


CMR-2894 Refactors access-control-service to use shared function

--- access-control-app/src/cmr/access_control/services/acl_service.clj
+++ access-control-app/src/cmr/access_control/services/acl_service.clj
@@ -23,7 +23,8 @@
             [cmr.acl.core :as acl]
             [cmr.umm.acl-matchers :as acl-matchers]
             [cmr.common.util :as util]
-            [cmr.common.date-time-parser :as dtp]))
+            [cmr.common.date-time-parser :as dtp]
+            [cmr.access-control.data.access-control-index :as index]))

 (def acl-provider-id
   "The provider ID for all ACLs. Since ACLs are not owned by individual
@@ -75,13 +76,6 @@
                                             :items
                                             (map :concept_id)))))

-(defn acl-target-provider-id
-  "Returns the provider ID which the ACL targets through its catalog item identity
-   or provider identity, if applicable."
-  [acl]
-  (or (get-in acl [:provider-identity :provider-id])
-      (get-in acl [:catalog-item-identity :provider-id])))
-
 (defn- acl->base-concept
   "Returns a basic concept map for the given request context and ACL map."
   [context acl]
@@ -92,7 +86,7 @@
    :user-id (tokens/get-user-id context (:token context))
    ;; ACL-specific fields
    :extra-fields {:acl-identity (acl-identity acl)
-                  :target-provider-id (acl-target-provider-id acl)}})
+                  :target-provider-id (index/acl->provider-id acl)}})

 (defn create-acl
   "Save a new ACL to Metadata DB. Returns map with concept and revision id of created acl."


CMR-4657: Added indexer-level int test for all-revisions false.

--- indexer-app/int-test/cmr/indexer/test/services/index_fields/services.clj
+++ indexer-app/int-test/cmr/indexer/test/services/index_fields/services.clj
@@ -102,3 +102,17 @@
   (delete-service "S1234-PROV1" 2 {:all-revisions-index? true})
   (assert-delete-svc "S1234-PROV1")
   (assert-not-match-in-svc "S1234-PROV1,2" [:keyword] "keyword"))
+
+(deftest save-service-all-revisions-false-test
+  (save-service (es-doc-svc-rev-1) "S1234-PROV1" 1 {:all-revisions-index? false})
+  (assert-match-in-svc "S1234-PROV1" [:keyword] "kw")
+  (assert-match-in-svc "S1234-PROV1" [:keyword] "kw3")
+  (assert-not-match-in-svc "S1234-PROV1" [:keyword] "keyword")
+  (save-service (es-doc-svc-rev-2) "S1234-PROV1" 2 {:all-revisions-index? false})
+  (assert-match-in-svc "S1234-PROV1" [:keyword] "keyword")
+  (assert-match-in-svc "S1234-PROV1" [:keyword] "keyword3")
+  (assert-not-match-in-svc "S1234-PROV1" [:keyword] "kw")
+  (delete-service "S1234-PROV1" 2 {:all-revisions-index? false})
+  (assert-delete-svc "S1234-PROV1")
+  (assert-not-match-in-svc "S1234-PROV1" [:keyword] "keyword")
+  (assert-not-match-in-svc "S1234-PROV1" [:keyword] "kw"))


Add tid import

Add tid import

--- src/clj/cglossa/data_import.clj
+++ src/clj/cglossa/data_import.clj
@@ -63,6 +63,7 @@
                   {:edge
                    {:class                "HasMetadataValue",
                     :lookup               "MetadataCategory.corpus_cat",
+                    :direction            "in"
                     :joinValue            :WILL-BE-REPLACED
                     :unresolvedLinkAction "ERROR"}}],
    :loader       {:orientdb
@@ -115,6 +116,18 @@
                         (assoc-in [:transformers 2 :edge :joinValue] corpus)
                         (cheshire/generate-string {:pretty true}))))

+(defn- create-tid-tsv! [corpus tsv-path]
+  (let [orig-tsv-path (-> (str "data/metadata_values/" corpus ".tsv")
+                          io/resource
+                          .getPath)]
+    (with-open [orig-tsv-file (io/reader orig-tsv-path)
+                tsv-file      (io/writer tsv-path)]
+      (let [[headers & rows] (read-csv orig-tsv-file)
+            tid-header (first headers)]
+        (assert (= "tid" tid-header)
+                (str "Format error: Expected first line to contain column headers "
+                     "with 'tid' (text ID) as the first header."))
+        (write-csv tsv-file (cons ["value"] (map #(subvec % 0 1) rows)))))))

 (defn- modify-tid-config! [corpus config-path tsv-path]
   (spit config-path (-> tids-config-template
@@ -145,8 +158,7 @@
         other-tsv-path    (.getPath (fs/temp-file "metadata_vals"))
         tid-config-path   (.getPath (fs/temp-file "tid_config"))
         other-config-path (.getPath (fs/temp-file "metadata_val_config"))]
-    (println tid-config-path)
-    #_(create-tid-tsv! corpus tid-tsv-path)
+    (create-tid-tsv! corpus tid-tsv-path)
     (modify-tid-config! corpus tid-config-path tid-tsv-path)
     #_(modify-metadata-values-tsv! corpus tsv-path)
-    #_(run-etl config-path)))
+    (run-etl tid-config-path)))


fix Expert Schedule Analyzer

fix Expert Schedule Analyzer

--- src/clj/game/cards-programs.clj
+++ src/clj/game/cards-programs.clj
@@ -154,7 +154,8 @@
     [{:cost [:click 1] :msg "make a run on HQ"
       :effect (effect (run :hq {:req (req (= target :hq))
                                 :replace-access
-                                {:msg (msg "reveal cards in HQ: " (map :title (:hand corp)))}} card))}]}
+                                {:msg (msg "reveal cards in HQ: "
+                                           (join ", " (map :title (:hand corp))))}} card))}]}

    "False Echo"
    {:abilities [{:req (req (and (:run @state)


[REFACTOR] Replace js `ActiveTab` global with cljs var

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

--- src/cljs/cljs_nusmods/main.cljs
+++ src/cljs/cljs_nusmods/main.cljs
@@ -225,6 +225,11 @@
        :private true}
   TIMETABLE-TAB-INDEX 1)

+(def ^{:doc     "index for the active tab; one of `MODULE-FINDER-TAB-INDEX` or
+                 `TIMETABLE-TAB-INDEX`"
+       :private true}
+  ACTIVE-TAB)
+
 (def ^{:doc     "Whether we started downloading JavaScript files for
                  Module Finder page"
        :private true}
@@ -254,14 +259,14 @@
   (show ($ :#timetable-builder))
   (select2/shift-select2-container-to "module-finder-sidebar"
                                       "timetable-builder-controls")
-  (aset js/window "ActiveTab" TIMETABLE-TAB-INDEX))
+  (set! ACTIVE-TAB TIMETABLE-TAB-INDEX))

 (defn- initialize-exhibit3 [MODULES AUXMODULES]
   "Initialize Exhibit3 database and UI for Module Finder page"
   (if (and (not EXHIBIT3-INITIALIZED?)
            EXHIBIT3-LOADED?
            MODULE-FINDER-SCRIPTS-DLED?
-           (= (aget js/window "ActiveTab") MODULEFINDER-TAB-INDEX))
+           (= ACTIVE-TAB MODULEFINDER-TAB-INDEX))
     (let [$timetable-builder-tab-link ($ :#timetable-builder-tab-link)]
       (set! EXHIBIT3-INITIALIZED? true)
       ; Unbind the click event handler for `Timetable Builder` tab link so
@@ -586,7 +591,7 @@
         (.on js/Pace "done" (fn []
                               (fade-out ($ ".overlay"))))

-        (aset js/window "ActiveTab" TIMETABLE-TAB-INDEX)
+        (set! ACTIVE-TAB TIMETABLE-TAB-INDEX)
         (aset js/window "ModulesMap" (build-timetable-module-map MODULES))

         ; initialize `WEEK-TEXT-ARRAY`
@@ -640,7 +645,7 @@
                   (show ($ :#module-finder))
                   (.removeClass (parent ($ :#timetable-builder-tab-link)) "active")
                   (.addClass (parent ($ :#module-finder-tab-link)) "active")
-                  (aset js/window "ActiveTab" MODULEFINDER-TAB-INDEX)
+                  (set! ACTIVE-TAB MODULEFINDER-TAB-INDEX)
                   (select2/shift-select2-container-to "timetable-builder-controls"
                                                       "module-finder-sidebar")))


Start and stop the beep over and over again.

--- src/cljs/leipzig_live/core.cljs
+++ src/cljs/leipzig_live/core.cljs
@@ -9,7 +9,7 @@
 ;; Model
 (defonce state
   (atom {:music ""
-         :playing? false}))
+         :playing nil}))

 ;; -------------------------
 ;; Behaviour
@@ -29,25 +29,23 @@
       #(:value %)))

 (defonce context (js/window.AudioContext.))
-(defonce oscillator
+(defn beep []
   (let [oscillator (.createOscillator context)]
     (.connect oscillator (.-destination context))
-    oscillator))
-
-(defn beep []
-  (.start oscillator 0))
+    (.start oscillator 0)
+    (swap! state assoc-in [:playing] oscillator)))

 (defn kill []
-  (.stop oscillator 0))
+  (.stop (:playing @state) 0)
+  (swap! state assoc-in [:playing] nil))

 (defn handle [expr-str]
   (swap! state assoc-in [:music] expr-str))

 (defn toggle []
-  (swap! state update-in [:playing?] not)
-  (if (:playing? @state)
-    (beep)
-    (kill)))
+  (if (:playing @state)
+    (kill)
+    (beep)))

 ;; -------------------------
 ;; Views


Simplified bind-handler & bind-handlers macros.

--- src/cljs/quil/helpers/tools.clj
+++ src/cljs/quil/helpers/tools.clj
@@ -2,7 +2,7 @@
   (:require [clojure.string :as string]))

-(defn bind-handler [prc processing-name handler]
+(defn bind-handler [prc [processing-name handler]]
   `(set!
     (~processing-name ~prc)
     (fn []
@@ -11,9 +11,7 @@

 (defmacro bind-handlers [prc & opts]
-  (map
-   #(apply bind-handler (concat (list prc) %))
-   (partition 2 opts)))
+  (map #(bind-handler prc %) (partition 2 opts)))

 (defmacro with-shape [mode & body]


Fix bug where changing AI would start AI regardless of current faction

--- src/cljs/zetawar/events/ui.cljs
+++ src/cljs/zetawar/events/ui.cljs
@@ -281,7 +281,7 @@
 (defmethod router/handle-event ::set-faction-player-type
   [{:as handler-ctx :keys [ev-chan conn db players]} [_ faction player-type-id]]
   (let [{:as app :keys [ai-turn-stepping]} (app/root db)
-        {:keys [game/factions]} (app/current-game db)
+        {:keys [game/factions game/current-faction]} (app/current-game db)
         {:keys [faction/color]} faction
         other-factions (remove #(= (e faction) (e %)) factions)
         {:keys [ai]} (players/player-types-by-id player-type-id)
@@ -290,7 +290,8 @@
              :faction/player-type player-type-id}]
         cur-player (color @players)
         new-player (players/new-player handler-ctx player-type-id color)
-        notify (when ai [[:zetawar.players/start-turn color]])]
+        notify (when (and ai (= (e faction) (e current-faction)))
+                 [[:zetawar.players/start-turn color]])]
     (players/stop cur-player)
     (players/start new-player)
     (swap! players assoc color new-player)


Added call to enqueue-fn to projection fn's.

--- src/clojure/freactive/core.cljc
+++ src/clojure/freactive/core.cljc
@@ -899,12 +899,14 @@
          (-proj-clear target)
          (.onUpdates this (for [k (cursor-keyset cur)] [k (get cur k)])))
        (updateSortBy [this new-sort-by]
-         (when (or (not (identical? new-sort-by sort-by)) (nil? avl-set))
-           (set! sort-by new-sort-by)
-           (set! avl-set
-                 (if sort-by
-                   (avl/sorted-set-by sort-by)
-                   (avl/sorted-set)))))
+         (enqueue-fn
+          (fn []
+            (when (or (not (identical? new-sort-by sort-by)) (nil? avl-set))
+              (set! sort-by new-sort-by)
+              (set! avl-set
+                    (if sort-by
+                      (avl/sorted-set-by sort-by)
+                      (avl/sorted-set)))))))
        (updateFilter [this new-filter])
        (updateOffset [this new-offset])
        (updateLimit [this new-limit])
@@ -921,20 +923,22 @@
                  idx)))))
        (onUpdates [this updates]
          ;; (println "updates" updates)
-         (doseq [[k v :as update] updates]
-           (if-let [cur-idx (.rankOf this k)]
-             (if (or (= (count update) 1) (not (filter update)))
-               (do
-                 (set! avl-set (disj avl-set k))
-                 (-proj-remove-elem target cur-idx))
-               (do
-                 (set! avl-set (conj avl-set k))
-                 (let [new-idx (.rankOf this k)]
-                   (when-not (identical? cur-idx new-idx)
-                     (-proj-move-elem target cur-idx new-idx)))))
-             (when (filter update)
-               (set! avl-set (conj avl-set k))
-               (-proj-insert-elem target (rx* (fn [] (proj-fn (cursor cur k)))) (.rankOf this k))))))
+         (enqueue-fn
+          (fn []
+            (doseq [[k v :as update] updates]
+              (if-let [cur-idx (.rankOf this k)]
+                (if (or (= (count update) 1) (not (filter update)))
+                  (do
+                    (set! avl-set (disj avl-set k))
+                    (-proj-remove-elem target cur-idx))
+                  (do
+                    (set! avl-set (conj avl-set k))
+                    (let [new-idx (.rankOf this k)]
+                      (when-not (identical? cur-idx new-idx)
+                        (-proj-move-elem target cur-idx new-idx)))))
+                (when (filter update)
+                  (set! avl-set (conj avl-set k))
+                  (-proj-insert-elem target (rx* (fn [] (proj-fn (cursor cur k)))) (.rankOf this k))))))))

        IReactiveProjection
        (-project-elements [this proj-target enqueue]


UID verb set up and ready to be extended.

--- src/clojure/neveragain/imap.clj
+++ src/clojure/neveragain/imap.clj
@@ -415,6 +415,24 @@
                                   cur-num)}
                (recur remaining (conj response resp)))))))))))

+(defn uid-fetch [] nil)
+
+(def uid-handler-map
+  {"FETCH" uid-fetch})
+
+(defn uid-mux
+  "Technically an IMAP verb, only exists to delegate to the UID forms of other
+  verbs."
+  ([args session]
+   (uid-mux args session settings/db))
+  ([args session db]
+   (let [[_ d-verb d-args] (re-matches #"(?i)(FETCH) +(.+)$" args)]
+     (if-not d-verb
+       {:session session
+        :response "BAD Nay knave! Thine query possesseth not the UID aspect!"}
+       ((uid-handler-map d-verb) d-verb d-args db)))))
+
+
 (def select-mailbox-sql
   "SELECT * FROM platonic_tags WHERE owner_id = ? AND name = ?;")

@@ -472,7 +490,8 @@
                   "DELETE" (wrap-pure-imap-verb delete)
                   "SUBSCRIBE" (wrap-pure-imap-verb subscribe)
                   "FETCH" (wrap-pure-imap-verb fetch)
-                  "LOGOUT" (wrap-pure-imap-verb logout)})
+                  "LOGOUT" (wrap-pure-imap-verb logout)
+                  "UID" (wrap-pure-imap-verb uid-mux)})

 (defn connection-handler
   [r-chan w-chan]


Tests for substring function

Tests for substring function

--- test/zg/utils_test.clj
+++ test/zg/utils_test.clj
@@ -148,4 +148,30 @@
         (are [x y] (= x y)
             nil (third nil))))

+(deftest test-substring-1
+    "Check the function emender-jenkins.utils/substring."
+    (testing "the function emender-jenkins.utils/substring."
+        (are [x y] (= x y)
+            "H"      (substring "Hello world!" 0 1)
+            "He"     (substring "Hello world!" 0 2)
+            "Hello"  (substring "Hello world!" 0 5)
+            "Hello " (substring "Hello world!" 0 6))))

+(deftest test-substring-2
+    "Check the function emender-jenkins.utils/substring."
+    (testing "the function emender-jenkins.utils/substring."
+        (are [x y] (= x y)
+            "w"      (substring "Hello world!" 6 7)
+            "wo"     (substring "Hello world!" 6 8)
+            "world"  (substring "Hello world!" 6 11)
+            "world!" (substring "Hello world!" 6 12))))
+
+(deftest test-substring-empty-result
+    "Check the function emender-jenkins.utils/substring."
+    (testing "the function emender-jenkins.utils/substring."
+        (are [x y] (= x y)
+            "" (substring "Hello world!" 0 0)
+            "" (substring "Hello world!" 1 1)
+            "" (substring "Hello world!" 2 2)
+            "" (substring "Hello world!" 10 10))))
+


Refactor async-pipeline-go scenario.

Refactor async-pipeline-go scenario.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -239,14 +239,15 @@
                                    (fn []
                                      (async/<!! out-chan)
                                      (.inc out-cntr))))
-          async-count-channel (if
+          async-count-channel (when
                                 (and
                                   (.endsWith scenario "-async-pipeline-go")
                                   (not (nil? in-data)))
+                                (println "Starting async-pipeline-go counting.")
                                 (async/go
                                   (loop []
                                     (async/<! out-chan)
-                                    (.inc out-cntr)
+                                    (.inc ^Counter out-cntr)
                                     (recur))))
           async-pipeline (if
                            (and
@@ -302,10 +303,11 @@
         (fn [] (System/exit 0)) 120000)
       (if (.endsWith scenario "-async-pipeline-go")
         (do
+          (println "Starting async-pipeline-go input creation.")
           (async/go
             (loop []
               (async/>! in-chan in-data)
-              (.inc in-cntr)
+              (.inc ^Counter in-cntr)
               (recur)))
           (sleep 130000))
         (.start in-loop))


timeouts added

timeouts added

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -1933,6 +1933,68 @@
   "Sends Enter button value to an element found with query."
   [driver q]
   (fill driver q keys/enter))
+
+;;
+;; timeouts
+;; https://github.com/SeleniumHQ/selenium/blob/bc19742bb0256c0cb73a47eec5361aa7a5743723/py/selenium/webdriver/remote/webdriver.py#L674
+;; https://searchfox.org/mozilla-central/source/testing/webdriver/src/command.rs#529
+
+(defn sec-to-ms [sec]
+  (int (* sec 1000)))
+
+(defmulti set-timeout*
+  "Basic method to set a specific timeout."
+  {:arglists '([driver type sec])}
+  dispatch-driver)
+
+(defmethod set-timeout*
+  :default
+  [driver type sec]
+  (with-resp driver :post
+    [:session (:session @driver) :timeouts]
+    {type (sec-to-ms sec)} _))
+
+(defmethod set-timeout*
+  :chrome
+  [driver type sec]
+  (with-resp driver :post
+    [:session (:session @driver) :timeouts]
+    {:type type :ms (sec-to-ms sec)} _))
+
+(defmulti set-script-timeout
+  "Sets timeout for executing JS sctipts."
+  {:arglists '([driver sec])}
+  dispatch-driver)
+
+(defmethod set-script-timeout
+  :default
+  [driver sec]
+  (set-timeout* driver :script sec))
+
+(defmulti set-page-load-timeout
+  "Sets timeout for loading pages."
+  {:arglists '([driver sec])}
+  dispatch-driver)
+
+(defmethod set-page-load-timeout
+  :default
+  [driver sec]
+  (set-timeout* driver :pageLoad sec))
+
+(defmethod set-page-load-timeout
+  :chrome
+  [driver sec]
+  (set-timeout* driver "page load" sec))
+
+(defmulti set-implicit-timeout
+  "Sets timeout that is used when finding elements on the page."
+  {:arglists '([driver sec])}
+  dispatch-driver)
+
+(defmethod set-implicit-timeout
+  :default
+  [driver sec]
+  (set-timeout* driver :implicit sec))

 ;;
 ;; screenshot


Cleaner playoff series wins parsing using 'cond'

--- src/nhl_score_api/fetchers/mlbam/game_scores.clj
+++ src/nhl_score_api/fetchers/mlbam/game_scores.clj
@@ -172,20 +172,24 @@
   (let [away-team (:away teams)
         home-team (:home teams)
         series-summary-description (:series-status-short (:series-summary api-game))
-        series-tied-match (re-find #"Tied (\d)-\d" series-summary-description)]
-    (if series-tied-match
+        series-tied-match (re-find #"Tied (\d)-\d" series-summary-description)
+        team-leads-match (re-find #"(\w+) (?:leads|wins) (\d)-(\d)" series-summary-description)]
+    (cond
+      series-tied-match
       (let [win-count (read-string (nth series-tied-match 1))]
         {away-team win-count
          home-team win-count})
-      (let [team-leads-match (re-find #"(\w+) (?:leads|wins) (\d)-(\d)" series-summary-description)]
-        (if team-leads-match
-          (let [leading-team (nth team-leads-match 1)
-                leading-team-win-count (read-string (nth team-leads-match 2))
-                trailing-team-win-count (read-string (nth team-leads-match 3))]
-            {away-team (if (= away-team leading-team) leading-team-win-count trailing-team-win-count)
-             home-team (if (= home-team leading-team) leading-team-win-count trailing-team-win-count)})
-          {away-team 0
-           home-team 0})))))
+
+      team-leads-match
+      (let [leading-team (nth team-leads-match 1)
+            leading-team-win-count (read-string (nth team-leads-match 2))
+            trailing-team-win-count (read-string (nth team-leads-match 3))]
+        {away-team (if (= away-team leading-team) leading-team-win-count trailing-team-win-count)
+         home-team (if (= home-team leading-team) leading-team-win-count trailing-team-win-count)})
+
+      :else
+      {away-team 0
+       home-team 0})))

 (defn- get-winning-team [game-details]
   (let [away-team (:away (:teams game-details))


Remove remaining http2 mentions.

Remove remaining http2 mentions.

--- src/org/zalando/stups/friboo/system/new_http.clj
+++ src/org/zalando/stups/friboo/system/new_http.clj
@@ -92,19 +92,19 @@
                  :httpd   (jetty/run-jetty handler (merge configuration {:join? false}))})))

 (defn stop-component
-  "Stops the Http2 component."
+  "Stops the Http component."
   [{:as this :keys [handler httpd]}]
   (if-not handler
     (do
-      (log/debug "Skipping stop of Http2 because it's not running.")
+      (log/debug "Skipping stop of Http because it's not running.")
       this)
     (do
-      (log/info "Stopping Http2.")
+      (log/info "Stopping Http.")
       (when httpd
         (.stop httpd))
       (dissoc this :handler :httpd))))

-(defrecord Http [;; parameters (filled in by make-http2 on creation)
+(defrecord Http [;; parameters (filled in by make-http on creation)
                   api-resource
                   configuration
                   security-handlers
@@ -267,7 +267,7 @@
                            :executor   {}})

 (defn make-http
-  "Creates Http2 component using mostly default parameters."
+  "Creates Http component using mostly default parameters."
   [api-resource configuration]
   (map->Http {:api-resource   api-resource
                :configuration configuration


Add unlogged batch

Add unlogged batch

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -428,24 +428,29 @@
                   (doseq [[key value] m]
                     (.using query-builder ((get with-values key) value)))
                   query-builder)}]
-  (defn batch
-    [& statements]
+  (defn- generic-batch
+    [batch-type statements]
     (->> statements
          (sort-by #(get order (first %)))
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
-                 (QueryBuilder/batch
-                  (make-array RegularStatement 0)))
-         (maybe-stringify))))
+                 batch-type)
+         (maybe-stringify)))
+
+  (defn batch
+    [& statements]
+    (generic-batch (QueryBuilder/batch
+                    (make-array RegularStatement 0))
+                   statements))
+
+  (defn unlogged-batch
+    [& statements]
+    (generic-batch (QueryBuilder/unloggedBatch
+                    (make-array RegularStatement 0))
+                   statements)))

 ;; Batch batch(RegularStatement... statements)
 ;; Batch unloggedBatch(RegularStatement... statements)
-;; Truncate truncate(String table)
-;; Truncate truncate(String keyspace, String table)
-;; Truncate truncate(TableMetadata table)
 ;; String quote(String columnName)
-;; Assignment set(String name, Object value)
-
-;; Object raw(String str)
-;;
-;;
+;;
+;;


Changing hiccup element processing to a composed list of functions

Need to a processor which applies to _all_ elements, since any random
one could have a 'style' that is a string.  This lets me just treat
all elements the same way without getting an ever-growing condp, and
is useful in case we get another filter that needs to be generally
applied.

--- src-cljs/tropology/core.cljs
+++ src-cljs/tropology/core.cljs
@@ -155,22 +155,33 @@
       (recur (rest remaining)
              (conj acc ^{:key (hash (first remaining))} (first remaining))))))

-(defn process-element [element extra-params]
+
+(defn process-a [element extra-params]
+  (if (= :a (first element))
+    (into [] (map #(replace-link-for-dispatch % extra-params) element))
+    element))
+
+(defn process-ul [element _]
+  (if (= :ul (first element))
+    (into [:ul] (add-key-meta (rest element)))
+    element))
+
+
+(def element-processor (apply comp [process-a process-ul]))
+
+(defn process-element [processor element extra-params]
   "Receives an element as a hiccup structure. If it's a link, then the link
    is replaced for an action dispatch; for a :ul, it adds a key as meta to all
    the nested elements; otherwise we return the same structure."
   (if (vector? element)
-    (condp = (first element)
-      :a (into [] (map #(replace-link-for-dispatch % extra-params) element))
-      :ul (into [:ul] (add-key-meta (rest element)))
-      element)
+    (processor element extra-params)
     element
     ))

 (defn process-trope
   "Receives the hiccup data for a trope and processes it before display"
   [coll extra-params]
-  (clojure.walk/prewalk #(process-element % extra-params) coll))
+  (clojure.walk/prewalk #(process-element element-processor % extra-params) coll))

 ;


this is kinda broken still. where's my second set of eyes?

--- plugins/matross/tasks/temp_file.clj
+++ plugins/matross/tasks/temp_file.clj
@@ -11,10 +11,9 @@
                  (assoc (:data temp-result) :path temp-file))))

 (defmacro with-temp-files
-  "Evaluate the body with the names bound to temp files on the given connection,                                                                                cleaning them up after execution."
+  "Evaluate the body with the names bound to temp files on the given connection,
+cleaning them up after execution."
   [conn bindings & body]
   `(let [~@(interleave bindings
-                       (map (fn [b#] '(get-in (run-task conn {:type :temp-file}) [:data :path])) bindings))
-         r# '(do ~@body)]
-     '(map (fn [b] (run-task conn {:type :command :command (str "rm -f" b)})) ~bindings)
-     r#))
+                       (map (fn [b#] '(get-in (run-task conn {:type :temp-file}) [:data :path])) bindings))]
+     ~@body))


Added collection acl tests for direct transformer queries and DIF collections.

--- test/cmr/system_int_test/search/acls/collection_acl_search_test.clj
+++ test/cmr/system_int_test/search/acls/collection_acl_search_test.clj
@@ -13,6 +13,16 @@

 (use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1" "provguid2" "PROV2"} false))

+(comment
+  (ingest/reset)
+  (ingest/create-provider "PROV1")
+  (ingest/create-provider "PROV2")
+  (e/create-providers {"provguid1" "PROV1" "provguid2" "PROV2"})
+
+)
+
+;; TODO add caching of sids information from token
+
 ;; TODO add test for searching with an invalid security token.

 (deftest collection-search-with-acls-test
@@ -25,9 +35,9 @@
   (e/grant-guest (e/coll-catalog-item-id "provguid2"))
   ;; grant registered users permission to coll2 and coll4
   (e/grant-registered-users (e/coll-catalog-item-id "provguid1" ["coll2" "coll4"]))
-  ;; grant specific group permission to coll3 and coll6
+  ;; grant specific group permission to coll3, coll6, and coll8
   (e/grant-group "group-guid1" (e/coll-catalog-item-id "provguid1" ["coll3"]))
-  (e/grant-group "group-guid2" (e/coll-catalog-item-id "provguid2" ["coll6"]))
+  (e/grant-group "group-guid2" (e/coll-catalog-item-id "provguid2" ["coll6" "coll8"]))

   (let [coll1 (d/ingest "PROV1" (dc/collection {:entry-title "coll1"}))
@@ -41,7 +51,14 @@
         ;; PROV2
         coll6 (d/ingest "PROV2" (dc/collection {:entry-title "coll6"}))
         coll7 (d/ingest "PROV2" (dc/collection {:entry-title "coll7"}))
+        ;; A dif collection
+        coll8 (d/ingest "PROV2" (dc/collection {:entry-title "coll8"
+                                                :entry-id "S8"
+                                                :short-name "S8"
+                                                :version-id "V8"
+                                                :long-name "coll8"}) :dif)

+        all-colls [coll1 coll2 coll3 coll4 coll5 coll6 coll7 coll8]
         guest-token (e/login-guest)
         user1-token (e/login "user1")
         user2-token (e/login "user2" ["group-guid1"])
@@ -50,21 +67,21 @@
     (index/refresh-elastic-index)

     (testing "parameter search acl enforcement"
-     (are [token items]
-             (d/refs-match? items (search/find-refs :collection (when token {:token token})))
+      (are [token items]
+           (d/refs-match? items (search/find-refs :collection (when token {:token token})))

-             ;; not logged in should be guest
-             nil [coll1 coll4 coll6 coll7]
+           ;; not logged in should be guest
+           nil [coll1 coll4 coll6 coll7 coll8]

-             ;; login and use guest token
-             guest-token [coll1 coll4 coll6 coll7]
+           ;; login and use guest token
+           guest-token [coll1 coll4 coll6 coll7 coll8]

-             ;; test searching as a user
-             user1-token [coll2 coll4]
+           ;; test searching as a user
+           user1-token [coll2 coll4]

-             ;; Test searching with users in groups
-             user2-token [coll2 coll4 coll3]
-             user3-token [coll2 coll4 coll3 coll6]))
+           ;; Test searching with users in groups
+           user2-token [coll2 coll4 coll3]
+           user3-token [coll2 coll4 coll3 coll6 coll8]))
     (testing "token can be sent through a header"
       (is (d/refs-match? [coll2 coll4]
                          (search/find-refs :collection {} {:headers {"Echo-Token" user1-token}}))))
@@ -75,9 +92,22 @@
       ;; TODO test that we can retrieve the items directly and ACLs are enforced
       )
     (testing "Direct transformer retrieval acl enforcement"
-      ;; TODO test that the transformer type queries will enforce ACLs
-      ;; TODO ingest some diff collections above so we can test it with them
-      )))
+      (testing "registered user"
+        (d/assert-metadata-results-match
+          :echo10 [coll2 coll4]
+          (search/find-metadata :collection :echo10 {:token user1-token
+                                                     :concept-id (conj (map :concept-id all-colls)
+                                                                       "C9999-PROV1")})))
+      (testing "guest access"
+        (d/assert-metadata-results-match
+          :echo10 [coll1 coll4 coll6 coll7 coll8]
+          (search/find-metadata :collection :echo10 {:token guest-token
+                                                     :concept-id (map :concept-id all-colls)})))
+      (testing "user in groups"
+        (d/assert-metadata-results-match
+          :echo10 [coll4 coll6 coll3 coll8 coll2]
+          (search/find-metadata :collection :echo10 {:token user3-token
+                                                     :concept-id (map :concept-id all-colls)}))))))

 ;; This tests that when acls change after collections have been indexed that collections will be


[#1117] Update copyright header

[#1117] Update copyright header

--- Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/core.cljs
+++ Dashboard/app/cljs/src/org/akvo/flow/dashboard/users/core.cljs
@@ -1,4 +1,4 @@
-;; Copyright (C) 2014 Stichting Akvo (Akvo Foundation)
+;; Copyright (C) 2014-2015 Stichting Akvo (Akvo Foundation)
 ;;
 ;; This file is part of Akvo FLOW.
 ;;