Mihir | Adding docstrings to all the methods

--- src/aggregate_query_service/core.clj
+++ src/aggregate_query_service/core.clj
@@ -6,6 +6,8 @@
 (def not-nil? (complement nil?))

 (defn is-substring-of
+  "Gives back a boolean output whether the first
+  string is a substring of the second string or not"
   [sub-string string]
   (->> sub-string
        (re-pattern)
@@ -13,17 +15,21 @@
        (not-nil?)))

 (defn read-config
+  "Reads the config file from the file path given"
   [config-file]
   (json/read-str (slurp config-file) :key-fn keyword))

 (defn get-queries
+  "Appends query group name to every query object"
   [query-group]
   (map (fn [query-map]
          (assoc query-map :queryGroupname (get query-group :queryGroupname)))
        (get query-group :queries []))
   )

-(defn replace-param [query param-value param-name]
+(defn replace-param
+  "Replace parameter name with parameter value in the SQL query."
+  [query param-value param-name]
   (let [search-param (str ":" param-name ":")
         sql-query (get query :query)]
     (if (is-substring-of search-param sql-query)
@@ -32,6 +38,8 @@
       )))

 (defn render-query
+  "Takes in a map of query parameters and replaces all the parameters if they exist in the
+  query with the appropriate value"
   [query-params-map query]
   (loop [query-params-map query-params-map
          query query]
@@ -44,17 +52,21 @@
         (recur reduced-map (replace-param query param-value param-name))))))

 (defn render-queries
+  "Calls render query on each every query from the query list"
   [query-params-map query-list]
   (map (partial render-query query-params-map) query-list))

 (defn fire-query
+  "Hits the database with SQL queries."
   [data-source query]
   (let [db-spec {:datasource data-source}
         sql-query (get query :query)]
-      (assoc query :result (jdbc/db-query-with-resultset db-spec [sql-query] identity))
+    (assoc query :result (jdbc/db-query-with-resultset db-spec [sql-query] identity))
     ))

 (defn run-queries-and-get-results
+  "Takes in the path to the configuration file, data source and a hash map of parameters for
+  the SQL to completely render it."
   [config-file data-source query-params-map]
   (->> (read-config config-file)
        (map get-queries)


- further attempts to remove underlying CAAT code

--- src/app/cljs/one/sample/animation.cljs
+++ src/app/cljs/one/sample/animation.cljs
@@ -108,11 +108,18 @@
                   ))))

 (defn scale-behavior [& {:keys [from to time]
-                             :or {from 0 to 0 time 120}}]
+                         :or {from 0 to 0 time 120}}]
   (let [[start-time time] (if (vector? time) time [0 time])]
     (doto (CAAT/ScaleBehavior.)
       (.setFrameTime start-time time)
       (.setValues from to from to))))
+
+(defn alpha-behavior [& {:keys [from to time]
+                         :or {from 0 to 0 time 120}}]
+  (let [[start-time time] (if (vector? time) time [0 time])]
+    (doto (CAAT/AlphaBehavior.)
+      (.setFrameTime start-time time)
+      (.setValues from to))))

 (defn parallel-behavior [& args]
   (let [container (doto (CAAT/ContainerBehavior.)
@@ -126,6 +133,7 @@
 (def kw->behavior-fn {:move (fn [arg] (apply move-behavior arg))
                       :rotate (fn [arg] (apply rotate-behavior arg))
                       :scale (fn [arg] (apply scale-behavior arg))
+                      :alpha (fn [arg] (apply alpha-behavior arg))
                       :parallel parallel-behavior})

 (defprotocol AAnimationSpec
@@ -495,21 +503,13 @@
     (.setDiscardable target true)
     (listen target
             :mouse-enter
-            (fn [e oldf]
-              (.addBehavior
-               target
-               (doto (CAAT/ScaleBehavior.)
-                 (.setFrameTime (.time scene) 250)
-                 (.setValues 1 1.1 1 1.1)))
+            (fn [e oldf]
+              (animate target [:scale [:from 1 :to 1.1 :time 150]])
               (oldf target e)))
     (listen target :mouse-exit
             (fn [e oldf]
               (when (not target.trashed)
-                (.addBehavior
-                 target
-                 (doto (CAAT/ScaleBehavior.)
-                   (.setFrameTime (.time scene) 250)
-                   (.setValues 1.1 1 1.1 1))))
+                (animate target [:scale [:from 1.1 :to 1 :time 150]]))
               (oldf target e)))))

 (defn make-draggable-into
@@ -672,12 +672,10 @@
     actor))

-(defn fade! [target director & {:keys [start-time duration]
-                                :or {start-time nil duration 2000}}]
+(defn fade! [target & {:keys [start-time duration director]
+                       :or {start-time nil duration 2000}}]
   (doto target
-    (.addBehavior (doto (CAAT/AlphaBehavior.)
-                    (.setFrameTime (or start-time (.time director)) duration)
-                    (.setValues 1 0)))))
+    (.addBehavior (alpha-behavior :from 1 :to 0 :time [(or start-time (.time (->director director))) duration]))))

 (let [auto-expire-listener
       (clj->js
@@ -721,38 +719,35 @@
      (.time scene)
      start-time
      (fn [scene-time timer-time timetask]
-       (on-create scene-time)
-       (dotimes [x batch-count]
-         (let [rotation-direction (if (< (Math/random) 0.5) -1 1)
-               star (doto (star :radius (rand-nth (map (comp dec dec dec) [12 14 16 18 20]))
-                                    :color (rand-nth ["yellow" "chartreuse" "orange" "red" "powderblue" "magenta" "cyan"]))
-                      (.enableEvents false)
-                      (.setLocation (+ (x-of start-position) (* x 10)) (+ (y-of start-position) (rand-int 30)))
-                      ;; (. (cacheAsBitmap))
-                      (.addBehavior
-                       (rotate-behavior :from 0 :to (* rotation-direction (+ 180 (* (* (rand-int 2) -1) (rand-int 180))))
-                                            :time [scene-time 3000]))
-                      ;; TODO: why is the following not working? (rotation stops after some seconds)
-                      ;; (animate [:rotate [:from 0 :to (+ 180 (* (* (rand-int 2) -1) (rand-int 180)))
-                      ;;                    :time [scene-time 3000]]])
-                      (fall! director :duration (+ 2000 (rand-int 1000)))
-                      (.addBehavior (doto (CAAT/AlphaBehavior.)
-                                      (.setFrameTime scene-time 500)
-                                      (.setValues 0 1))
-                                    )
-                      (fade! director
-                             :duration (+ 3000 (rand-int 1000))
-                             :start-time (+ scene-time 500)))]
-           (add! target star)
-           ;; randomize the star z
-           (.setZOrder target star (- (rand-int batch-count) (/ batch-count 2)))
-           ))
-       (repeatedly-create-stars target scene
-              :start-time repeat-interval
-              :start-position start-position
-              :batch-count batch-count
-              :repeat-interval repeat-interval
-              :on-create on-create)
+       (binding [*director* director]
+         (on-create scene-time)
+         (dotimes [x batch-count]
+           (let [rotation-direction (if (< (Math/random) 0.5) -1 1)
+                 star (doto (star :radius (rand-nth (map (comp dec dec dec) [12 14 16 18 20]))
+                                  :color (rand-nth ["yellow" "chartreuse" "orange" "red" "powderblue" "magenta" "cyan"]))
+                        (.enableEvents false)
+                        (.setLocation (+ (x-of start-position) (* x 10)) (+ (y-of start-position) (rand-int 30)))
+                        ;; (. (cacheAsBitmap))
+                        (.addBehavior
+                         (rotate-behavior :from 0 :to (* rotation-direction (+ 180 (* (* (rand-int 2) -1) (rand-int 180))))
+                                          :time [scene-time 3000]))
+                        ;; TODO: why is the following not working? (rotation stops after some seconds)
+                        ;; (animate [:rotate [:from 0 :to (+ 180 (* (* (rand-int 2) -1) (rand-int 180)))
+                        ;;                    :time [scene-time 3000]]])
+                        (fall! director :duration (+ 2000 (rand-int 1000)))
+                        (.addBehavior (alpha-behavior :from 0 :to 1 :time [scene-time 500]))
+                        (fade! :duration (+ 3000 (rand-int 1000))
+                               :start-time (+ scene-time 500)))]
+             (add! target star)
+             ;; randomize the star z
+             (.setZOrder target star (- (rand-int batch-count) (/ batch-count 2)))
+             ))
+         (repeatedly-create-stars target scene
+                                  :start-time repeat-interval
+                                  :start-position start-position
+                                  :batch-count batch-count
+                                  :repeat-interval repeat-interval
+                                  :on-create on-create))
        )
      (fn []) (fn []))))

@@ -966,5 +961,5 @@
                object
                :position [(+ (rand-int 30) (* (/ 600 (count objects)) index) 100)
                           (+ (rand-int 50) 360)])))
-          ;; (add! scene (winning-screen scene))
+          (add! scene (winning-screen scene))
           ))))))


(PDB-4308) Don't log backtrace for expected connection retries

--- src/puppetlabs/puppetdb/cli/services.clj
+++ src/puppetlabs/puppetdb/cli/services.clj
@@ -347,7 +347,8 @@
                   (initialize-schema {:datasource db-pool} config)
                   true
                   (catch java.sql.SQLTransientConnectionException e
-                    (log/error e (trs "Database initialization connection has temporarily failed (retrying)"))
+                    (log/error (str (trs "Will retry database connection after temporary failure: ")
+                                    ex))
                     false))))))

 (defn db-config->clean-request


Set cursor on button

Set cursor on button

--- src/braid/client/register/views.cljs
+++ src/braid/client/register/views.cljs
@@ -177,10 +177,12 @@
      :white-space "nowrap"
      :letter-spacing "0.05em"
      :display "inline-block"
-     :transition "background 0.25s ease-in-out"}
+     :transition "background 0.25s ease-in-out"
+     :cursor "pointer"}

     ["&[disabled]"
-     {:background "#ccc"}]
+     {:background "#ccc"
+      :cursor "not-allowed"}]

     [:&::after
      {:content "\" ▶\""}]


fix search page

fix search page

--- src/braid/ui/views/pages/search.cljs
+++ src/braid/ui/views/pages/search.cljs
@@ -29,8 +29,7 @@

             (:done-results :loading)
             (let [loaded-threads (reaction (vals (select-keys @threads (@page :thread-ids))))
-                  sorted-threads (reaction (->> @threads ; sort-by last reply, newest first
-                                               vals
+                  sorted-threads (reaction (->> @loaded-threads ; sort-by last reply, newest first
                                                 (sort-by
                                                 (comp (partial apply max)
                                                       (partial map :created-at)
@@ -72,9 +71,8 @@
                                (- (.-scrollLeft this-elt) (.-deltaY e))))))}
                   (doall
                     (for [thread @sorted-threads]
-                      (do
-                        (println thread)
-                       [thread-view thread])))]])
+                      ^{:key (:id thread)}
+                      [thread-view thread]))]])

             :done-empty
             [:div.content


correct validation message for commodity exchange

--- src/clj_money/models/commodities.clj
+++ src/clj_money/models/commodities.clj
@@ -16,7 +16,7 @@
 (s/def ::entity-id integer?)
 (s/def ::name validation/non-empty-string?)
 (s/def ::symbol validation/non-empty-string?)
-(s/def ::exchange exchanges)
+(s/def ::exchange #{:nyse :nasdaq :fund}) ; TODO need to be able to register custom interpretations to resue exchanges
 (s/def ::new-commodity (s/keys :req-un [::entity-id ::name ::symbol ::exchange]))
 (s/def ::existing-commodity (s/keys :req-un [::name ::symbol ::exchange] :opt-un [::id]))


Remove varargs from iter-entities for more speed

--- src/cljs/chocolatier/engine/ces.cljs
+++ src/cljs/chocolatier/engine/ces.cljs
@@ -52,18 +52,20 @@
 (defn iter-entities
   "Iterate over a collection of entity-ids with component functions.
    Optionally pass in additional opts hashmap that will be passed to
-   each component function"
-  [state fns entity-ids & [opts]]
-  (let [local-state (local state)
-        len-fns (count fns)
-        len-ents (count entity-ids)]
-    (forloop [[i 0] (< i len-fns) (inc i)]
-      (forloop [[j 0] (< j len-ents) (inc j)]
-               (>> local-state
-                   (if opts
-                     ((fns i) (<< local-state) (entity-ids j) opts)
-                     ((fns i) (<< local-state) (entity-ids j))))))
-    (<< local-state)))
+   each component function as the last argument"
+  ([state fns entity-ids]
+   (iter-entities state fns entity-ids nil))
+  ([state fns entity-ids opts]
+   (let [local-state (local state)
+         len-fns (count fns)
+         len-ents (count entity-ids)]
+     (forloop [[i 0] (< i len-fns) (inc i)]
+              (forloop [[j 0] (< j len-ents) (inc j)]
+                       (>> local-state
+                           (if opts
+                             ((fns i) (<< local-state) (entity-ids j) opts)
+                             ((fns i) (<< local-state) (entity-ids j))))))
+     (<< local-state))))

 (defn deep-merge
   "Recursively merges maps. If vals are not maps, the last value wins.


Implement remove all modules

Implement remove all modules

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

--- src/cljs/cljs_nusmods/timetable.cljs
+++ src/cljs/cljs_nusmods/timetable.cljs
@@ -295,6 +295,43 @@
   [day]
   (count (get-timetable-day day)))

+(def ^{:doc     "HTML string for the  elements in a
 on the Timetable
+                 Builder page"
+       :private true}
+  Timetable-Row-TD-HTML-String
+  "
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+   	")
+
 (defn- add-new-row-to-timetable-day
   "Adds a new row to the 0-indexed day in the Timetable, where 0 = Monday,
    1 = Tuesday, until 4 = Friday."
@@ -304,40 +341,7 @@
                    (fn [ttDay]
                      (conj ttDay (create-empty-timetable-row)))))
   (.append (nth HTML-Timetable day)
-           ($ "

-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
"))
+           ($ (str "
" Timetable-Row-TD-HTML-String "
")))
   ; Modify the rowspan of the  in the 0th row in the timetable
   (let [nrRows (get-nr-rows-in-timetable-day day)
         thElem (.find (nth HTML-Timetable day) "tr > th")]
@@ -1358,6 +1362,22 @@
 (defn remove-all-modules
   "Removes all modules from the timetable"
   []
-  ; !!!
-  nil
-  )
+  (.remove ($ ".lesson"))
+  (doseq [day (range 5)]
+    (let [nrRows   (get-nr-rows-in-timetable-day day)
+          $dayElem (nth HTML-Timetable day)]
+      ; Remove rows >= 2
+      (doseq [rowIdx (reverse (range 2 nrRows))]
+        (.remove (nth (children $dayElem "tr") rowIdx)))
+      ; Remove all
+      (.remove (.find $dayElem "td"))
+      ; Add clean
+      (doseq [rowIdx (range 2)]
+        (.append (nth (children $dayElem "tr") rowIdx)
+                 ($ Timetable-Row-TD-HTML-String)))
+      (attr (.find $dayElem "tr > th") "rowspan" 2)))
+  (init)
+  (set! ModulesSelected {})
+  (set! ModulesSelectedOrder [])
+  (select2/select2-box-set-val select2/$Select2-Box (array))
+  (aset (aget js/document "location") "hash" ""))


Adding :pool tag to top-most match cycle span (#2113)

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -1390,7 +1390,7 @@
         (timers/time!
           (timers/timer (metric-title "match-jobs-event" pool-name))
           (tracing/with-span [s {:name "scheduler.offer-handler.match-jobs"
-                                 :tags {:component tracing-component-tag}}]
+                                 :tags {:pool pool-name :component tracing-component-tag}}]
             (let [num-considerable @fenzo-num-considerable-atom
                   next-considerable
                   (try


Remove metatransaction filter from match. (#2143)

Co-authored-by: Scott Crosby <23e8f75489aff47cf2cd5a529e9a769a24e9501c@twosigma.com>

--- scheduler/src/cook/scheduler/scheduler.clj
+++ scheduler/src/cook/scheduler/scheduler.clj
@@ -1187,7 +1187,7 @@
         (timers/time!
           (timers/timer (metric-title "handle-resource-offer!-duration" pool-name))
           (try
-            (let [db (db conn)
+            (let [db (d/db conn)
                   pending-jobs (get @pool-name->pending-jobs-atom pool-name)
                   considerable-jobs (prom/with-duration
                                       prom/scheduler-handle-resource-offers-pending-to-considerable-duration {:pool pool-name}


Test data creator updates every second

Test data creator updates every second

10 seconds is toooo slow

--- src/brew_monitor/test_data_creator.clj
+++ src/brew_monitor/test_data_creator.clj
@@ -19,4 +19,4 @@
 (defn -main []
   (doseq [temp repeated-temps]
     (send-temp temp)
-    (Thread/sleep 10000)))
+    (Thread/sleep 1000)))


fix command sending

fix command sending

--- src/status_im/chat/handlers/console.cljs
+++ src/status_im/chat/handlers/console.cljs
@@ -24,10 +24,10 @@

 (register-handler :invoke-console-command-handler!
   (u/side-effect!
-    (fn [_ [_ {:keys [staged-command] :as parameters}]]
+    (fn [_ [_ {:keys [chat-id staged-command] :as parameters}]]
       (let [{:keys [id command params]} staged-command
             {:keys [name]} command]
-        (dispatch [:prepare-command! parameters])
+        (dispatch [:prepare-command! chat-id parameters])
         ((console-commands (keyword name)) params id)))))

 (register-handler :set-message-status


reference to Craig Reynolds seminal paper

--- src/cljs/infinitelives/utils/boid.cljs
+++ src/cljs/infinitelives/utils/boid.cljs
@@ -2,6 +2,9 @@
   (:require [infinitelives.utils.vec2 :as vec2]
             [infinitelives.utils.math :as math]
             [infinitelives.utils.console :refer [log]]))
+
+;; as described in Reynolds 1999
+;; http://www.red3d.com/cwr/steer/gdc99/

 (def example
   {:mass 10.0


proper tos text url

proper tos text url

--- src/cljs/main/broadfcui/endpoints.cljs
+++ src/cljs/main/broadfcui/endpoints.cljs
@@ -564,10 +564,9 @@
   {:path "/profile/importstatus"
    :method :get})

-;; TODO: change to actual url, e.g. /register/tos, once that is available
 (defn tos-get-text [on-done]
   (ajax/call-sam
-   (str "/version")
+   (str "/tos/text")
    {:on-done on-done}
    :service-prefix ""))


Added a newline

Added a newline

--- src/pamela/utils.clj
+++ src/pamela/utils.clj
@@ -42,6 +42,30 @@

 (defn get-cwd []
   @cwd)
+
+(defn encode-ir-tokens-as-strings
+  "Encode string/symbol/keyword distinction as strings that can re reversed simply after reading"
+  [ir]
+  (cond (string? ir) (str "\"" ir "\"")
+        (keyword? ir) (str ir)
+        (symbol? ir) ir
+        ;; Recursive data structures
+        (list? ir) (map (fn [sir] (encode-ir-tokens-as-strings sir)) ir)
+        (vector? ir) (seq (map (fn [sir] (encode-ir-tokens-as-strings sir)) ir))
+        (set? ir) (set (map (fn [sir] (encode-ir-tokens-as-strings sir)) ir))
+        (map? ir) (into {} (map (fn [[key val]] {(encode-ir-tokens-as-strings key) (encode-ir-tokens-as-strings val)}) ir))
+        :else ir))                                ; All other cases remain unchanged.
+
+(defn unencode-ir-strings
+  "Unencode string/symbol/keyword encoded as readable strings"
+  [ir]
+  (cond (string? ir) (read-string ir)
+        ;; Recursive data structures
+        (list? ir) (map (fn [sir] (unencode-ir-strings sir)) ir)
+        (vector? ir) (seq (map (fn [sir] (unencode-ir-strings sir)) ir))
+        (set? ir) (set (map (fn [sir] (unencode-ir-strings sir)) ir))
+        (map? ir) (into {} (map (fn [[key val]] {(unencode-ir-strings key) (unencode-ir-strings val)}) ir))
+        :else ir))                                ; All other cases remain unchanged.

 ;; file-format's supported: edn edn-mixed json string
 ;; if input is a map, sort it as a homogeneous key map
@@ -56,6 +80,7 @@
                             (if (fs/absolute? filename)
                               (fs/file filename)
                               (fs/file (get-cwd) filename)))
+          data (encode-ir-tokens-as-strings data)
           data (if (map? data)
                  ;; (if (= file-format "edn-mixed")
                  ;;   (sort-mixed-map data)
@@ -244,4 +269,4 @@
           rv (if (and (= lb 0) (= ub :infinity))
                nil ;; do NOT explicitly return default bounds
                [lb ub])]
-      rv)))+      rv)))


Add Election validations to v5 validations

--- src/vip/data_processor/validation/v5.clj
+++ src/vip/data_processor/validation/v5.clj
@@ -3,7 +3,8 @@
             [vip.data-processor.validation.v5.email :as email]
             [vip.data-processor.validation.v5.id :as id]
             [vip.data-processor.validation.v5.precinct :as precinct]
-            [vip.data-processor.validation.v5.retention-contest :as retention-contest]))
+            [vip.data-processor.validation.v5.retention-contest :as retention-contest]
+            [vip.data-processor.validation.v5.election :as election]))

 (def validations
   [candidate/validate-no-missing-ballot-names
@@ -14,4 +15,7 @@
    id/validate-no-missing-ids
    precinct/validate-no-missing-names
    precinct/validate-no-missing-locality-ids
-   retention-contest/validate-no-missing-candidate-ids])
+   retention-contest/validate-no-missing-candidate-ids
+   election/validate-one-election
+   election/validate-date
+   election/validate-state-id])


removed unused libraries from core file

removed unused libraries from core file

--- src/penjat/core.cljs
+++ src/penjat/core.cljs
@@ -1,14 +1,9 @@
 (ns penjat.core
-  (:require-macros [secretary.core :refer [defroute]])
-  (:require [goog.events :as events]
-            [reagent.core :as reagent :refer [atom]]
+  (:require [reagent.core :as reagent :refer [atom]]
             [re-frame.core :refer [dispatch dispatch-sync]]
-            [secretary.core :as secretary]
             [penjat.handlers]
             [penjat.subs]
-            [penjat.views])
-  (:import [goog History]
-           [goog.history EventType]))
+            [penjat.views]))

 (enable-console-print!)


Automatically add boolean ephemeral random constant generator when :autoconstructive is true.

--- src/clojush/args.clj
+++ src/clojush/args.clj
@@ -468,6 +468,8 @@
            :atom-generators (conj (:atom-generators @push-argmap) (fn [] (lrand))))
     (swap! push-argmap assoc
            :atom-generators (conj (:atom-generators @push-argmap) (fn [] (lrand-int 100))))
+    (swap! push-argmap assoc
+           :atom-generators (conj (:atom-generators @push-argmap) (fn [] (lrand-nth [true false]))))
     (dotimes [n (:autoconstructive-integer-rand-enrichment @push-argmap)]
       (swap! push-argmap assoc
              :atom-generators (conj (:atom-generators @push-argmap) 'autoconstructive_integer_rand)))
@@ -497,3 +499,4 @@
    (load-push-argmap argmap)
    (reset-globals)))

+


Resume using cached next-transition

Resume using cached next-transition

--- src/player/core.cljs
+++ src/player/core.cljs
@@ -220,8 +220,9 @@

 (defn next-transition [has ha then inputs]
   (let [; by definition req is after then, so it doesn't need to be filtered or checked
-        ;req (:next-required-transition ha)
-        req (first (transition-intervals has ha then (required-transitions ha)))
+        req (:next-required-transition ha)
+        ;non-cached version:
+        ; req (first (transition-intervals has ha then (required-transitions ha)))
         req-t (first (:interval req))
         ; opts on the other hand must be filtered and sliced into range
         [min-opt-t opts] (reduce (fn [[min-t trs] {[start end] :interval :as trans}]


Fix docstring. Thanks Eastwood!

Fix docstring. Thanks Eastwood!

--- src/posthere/app.clj
+++ src/posthere/app.clj
@@ -18,8 +18,9 @@
 (defn- strip-prefix-slash [relative-url]
   (s/replace relative-url #"^\/" ""))

-(defn- uuid-for [request]
+(defn- uuid-for
   "Extract everything after the initial / in the request URL as the UUID, not including the /."
+  [request]
   (strip-prefix-slash (get-in request [:route-params :*])))

 (defroutes approutes


adaptive axis ticks

adaptive axis ticks

--- src/prais2/data.cljs
+++ src/prais2/data.cljs
@@ -212,59 +212,79 @@
     (r/with-key (bar slider (- 100 (:outer-high row)) (:high colour-map)) :bar5)
     (r/with-key (dot slider 10 (:survival-rate row)) :dot)]])

+
+(r/defc tick < r/static [baseline value]
+  (let [percent (* 100 (/ (- value baseline) (- 100 baseline)))]
+    [:.tick
+     {:style {:left (pc percent)}}
+     [:span.tick-label (pc value)]]))
+
+(r/defc ticks < r/static [slider-axis-value tick-count]
+  (let [baseline (* min-outer-low slider-axis-value)
+        best-interval (/ (- 100 baseline) (inc tick-count))
+        interval (cond
+                   (> best-interval 50) 100
+                   (> best-interval 20) 50
+                   (> best-interval 10) 20
+                   (> best-interval 5) 10
+                   (> best-interval 2) 5
+                   (> best-interval 1) 2
+                   :else 1
+                   )
+        tick-values (range 100 (dec baseline) (- interval))]
+    [:div
+     (for [value tick-values]
+       (tick baseline value))]
+    )
+  )
+
 (r/defc table-head < r/static
   [app ap headers column-keys event-bus slider-axis-value]
-  [:thead {:key :thead}
-   [:tr
-    (for [column-key column-keys :when (-> headers column-key :shown)]
-      (let [header (column-key headers)
-            sortable (:sortable header)]
-        [:th {:key [column-key "head"]
-              :on-click (when sortable #(handle-sort % app column-key))
-              :style {:width (px (:width header))
-                      :vertical-align "top"
-                      :cursor "pointer"
-                      :background-color (str (:outer-low colour-map) "!important")
-                      :color "#ffffff !important"
-                      }}
-         (when sortable [:i {:key :icon
-                             :class (str  "right fa fa-sort"
-                                          (if (= column-key (:sort-by ap))
-                                            (if (:sort-ascending ap) "-asc" "-desc") ""))
-                             :style {:pointer-events "none"}}])
-         (let [title (:title header)]
-           [:span {:key :text
-                   :style {:pointer-events "none"}}
-            title
-            [:span.right
-             (if (>=  (.indexOf title "%") 0) (dot nil 10 0 true))]
-            ])]))
-    [:th
-     {:style {:width "auto"
-              :background-color (str (:outer-low colour-map) "!important")
-              :color "#ffffff !important"
-              }}
-     [:.slider-container
-      {:key :axis
-       :style {:height (px (:height (:observed headers)))
-               }}
-      [:p (:title (:observed headers))]
-      [:.slider-label
-       [:span.left [:i.fa.fa-long-arrow-left] " full range"]
-       [:span.right "full detail " [:i.fa.fa-long-arrow-right]]]
-      (slider-control event-bus slider-axis-value 0 1 0.001)
-      [:.axis-container
-       {:style {:margin-left (px axis-margin)
-                :width (str "calc(100% - " (px (+ extra-right axis-margin)) ")")}}
-       [:.tick
-        {:style {:left (pc 0)}}
-        [:span.tick-label (pc (Math.round (* min-outer-low slider-axis-value)))]]
-       [:.tick
-        {:style {:left (pc 50)}}
-        [:span.tick-label (pc (.toFixed (- 100 (/ (- 100 (Math.round (* min-outer-low slider-axis-value))) 2)) 1) )]]
-       [:.tick
-        {:style {:left (pc 100)}}
-        [:span.tick-label (pc 100)]]]]]]])
+
+  (let [baseline (Math.round (* min-outer-low slider-axis-value))]
+    [:thead {:key :thead}
+     [:tr
+      (for [column-key column-keys :when (-> headers column-key :shown)]
+        (let [header (column-key headers)
+              sortable (:sortable header)]
+          [:th {:key [column-key "head"]
+                :on-click (when sortable #(handle-sort % app column-key))
+                :style {:width (px (:width header))
+                        :vertical-align "top"
+                        :cursor "pointer"
+                        :background-color (str (:outer-low colour-map) "!important")
+                        :color "#ffffff !important"
+                        }}
+           (when sortable [:i {:key :icon
+                               :class (str  "right fa fa-sort"
+                                            (if (= column-key (:sort-by ap))
+                                              (if (:sort-ascending ap) "-asc" "-desc") ""))
+                               :style {:pointer-events "none"}}])
+           (let [title (:title header)]
+             [:span {:key :text
+                     :style {:pointer-events "none"}}
+              title
+              [:span.right
+               (if (>=  (.indexOf title "%") 0) (dot nil 10 0 true))]
+              ])]))
+      [:th
+       {:style {:width "auto"
+                :background-color (str (:outer-low colour-map) "!important")
+                :color "#ffffff !important"
+                }}
+       [:.slider-container
+        {:key :axis
+         :style {:height (px (:height (:observed headers)))
+                 }}
+        [:p (:title (:observed headers))]
+        [:.slider-label
+         [:span.left [:i.fa.fa-long-arrow-left] " full range"]
+         [:span.right "full detail " [:i.fa.fa-long-arrow-right]]]
+        (slider-control event-bus slider-axis-value 0 1 0.001)
+        [:.axis-container
+         {:style {:margin-left (px axis-margin)
+                  :width (str "calc(100% - " (px (+ extra-right axis-margin)) ")")}}
+         (ticks slider-axis-value 3)]]]]]))

 (r/defc table1 < r/reactive [app data event-bus]
   (let [ap (r/react app)


A woman is not dead while her name is still spoken.

--- src/pronouns/web.clj
+++ src/pronouns/web.clj
@@ -47,6 +47,11 @@
   (ANY "*" []
        (route/not-found (slurp (io/resource "404.html")))))

+(defn wrap-gnu-natalie-nguyen [handler]
+  (fn [req]
+    (when-let [resp (handler req)]
+      (assoc-in resp [:headers "X-Clacks-Overhead"] "GNU Natalie Nguyen"))))
+
 (defn wrap-error-page [handler]
   (fn [req]
     (try (handler req)
@@ -60,6 +65,7 @@
   (-> app-routes
       logger/wrap-with-logger
       wrap-error-page
+      wrap-gnu-natalie-nguyen
       trace/wrap-stacktrace
       params/wrap-params))


Implemented 5/8 cases.

Implemented 5/8 cases.


Removed poor test

Removed poor test

--- collectors/jenkins/test/jenkins_collector/jenkins_test.clj
+++ collectors/jenkins/test/jenkins_collector/jenkins_test.clj
@@ -81,17 +81,6 @@

-(future-facts "about reading from Jenkins"
-       (let [metrics (collect-metrics stubbed-connection "http://jenkins.com/" "localhost")
-             metric  (first metrics)]
-         (fact "details the collector"        (-> metric :build :collector) => {:name :kuona-jenkins-collector, :version "0.0.1"})
-         (fact "includes name"                (-> metric :build :name) => "intercept")
-         (fact "includes build system type"   (-> metric :build :system) => :jenkins)
-         (fact "metric include URL"           (-> metric :build :url) => "http://jenkins.com/job/intercept/6/")
-         (fact "extracts the build number"    (-> metric :build :number) => 4)
-         (fact "extractst the build duration" (-> metric :build :duration) => 33835)
-         (fact "extracts the build result"    (-> metric :build :result) => "SUCCESS")))
-
 (facts "about put-build!"
        (fact "posts build to api"
              (put-build! {} "http://server.com") => "worked"


Remove hard-coded job name from wf run page

--- src-cljs/frontend/components/pages/run.cljs
+++ src-cljs/frontend/components/pages/run.cljs
@@ -121,7 +121,8 @@
                         ;; but this is the fast way to get something on the
                         ;; screen for a prototype.
                         (into (om-next/get-query workflow-page/RunRow)
-                              [{:run/jobs (into [:job/build]
+                              [{:run/jobs (into [:job/build
+                                                 :job/name]
                                                 (om-next/get-query Job))}])}]}])
   ;; TODO: Add the correct analytics properties.
   #_analytics/Properties
@@ -141,7 +142,9 @@
         :main-content
         (element :main-content
           (let [run (get-in (om-next/props this) [:app/route-data :route-data/run])
-                first-job-build (not-empty (get-in run [:run/jobs 0 :job/build]))]
+                first-job (-> run :run/jobs first)
+                first-job-build (:job/build first-job)
+                first-job-name (:job/name first-job)]
             (html
              [:div
               (when-not (empty? run)
@@ -155,16 +158,19 @@
                  (map job (:run/jobs run)))]
                [:.output
                 [:div.output-header
-                  [:.output-title
-                   [:span "job-name #1234"]]
-                  (button/icon {:label "Retry job-name"
-                                :disabled? true}
-                               (icon/rebuild))
-
-                  #_(button/button {:kind :primary
-                                  :size :medium
-                                  :label "Retry job-name"}
-                                 [:span.iconed-button (icon/rebuild) "Retry"])]
+                 [:.output-title
+                  [:span (gstring/format "%s #%s"
+                                         first-job-name
+                                         (:build/number first-job-build))]]
+                 (button/icon {:label (gstring/format "Retry %s"
+                                                      first-job-name)
+                               :disabled? true}
+                              (icon/rebuild))
+                 #_(button/button {:kind :primary
+                                 :size :medium
+                                 :label (gstring/format "Retry %s"
+                                                        first-job-name)}
+                                [:span.iconed-button (icon/rebuild) "Retry"])]
                 (when first-job-build
                   (build-legacy build-page (assoc (:legacy/state (om-next/props this))
                                                   :job-build


delete old unused code for build-output

delete old unused code for build-output

--- src-cljs/frontend/components/pages/run.cljs
+++ src-cljs/frontend/components/pages/run.cljs
@@ -89,69 +89,6 @@
                    "-")]]]]])))))))

 (def job (om-next/factory Job {:keyfn :job/id}))
-
-(defn- fetch-build [owner
-                    {:keys [:build/vcs-type :build/org :build/repo :build/number]}]
-  (let [build-url (gstring/format "/api/v1.1/project/%s/%s/%s/%s"
-                                  (name vcs-type)
-                                  org
-                                  repo
-                                  number)]
-    (ajax/ajax :get build-url
-               :build-fetch
-               (om/get-shared owner [:comms :api])
-               :context {:project-name (gstring/format "%s/%s" org repo)
-                         :build-num number})))
-
-(defn- build-matches-spec?
-  "Returns whether a build (using legacy attributes) matches the :build/*
-  attributes of a build spec."
-  [spec build]
-  (let [mapping {:vcs_type :build/vcs-type
-                 :username :build/org
-                 :reponame :build/repo
-                 :build_num :build/number}]
-    (= spec (-> build
-                (select-keys (keys mapping))
-                (set/rename-keys mapping)
-                (update :build/vcs-type keyword)))))
-
-(defn- build-page [{:keys [app job-build current-tab tab-href]} owner]
-  (reify
-    om/IWillMount
-    (will-mount [_]
-      (when job-build
-        (fetch-build owner job-build)))
-    om/IWillUpdate
-    (will-update [this next-props _next-state]
-      (let [previous-build-spec (-> owner om/get-props :job-build)
-            current-build-spec (:job-build next-props)]
-        (when (not= previous-build-spec current-build-spec)
-         (fetch-build owner current-build-spec))))
-    om/IRender
-    (render [_]
-      (let [app
-            ;; Strip build data from legacy app state if it doesn't match the
-            ;; build spec we're currently after. This happens when old build
-            ;; data is present and new build data hasn't loaded yet.
-            (update-in app state/build-data-path
-                       #(when (build-matches-spec? job-build (:build %)) %))]
-        (html
-         [:div
-          [:div.job-output-tabs (let [build-data (dissoc (get-in app state/build-data-path) :container-data)]
-                                  (om/build old-build-head/build-sub-head
-                                            {:build-data build-data
-                                             :current-tab current-tab
-                                             :project-data (get-in app state/project-data-path)
-                                             :user (get-in app state/user-path)
-                                             :projects (get-in app state/projects-path)
-                                             :scopes (get-in app state/project-scopes-path)
-                                             :ssh-available? false
-                                             :tab-href tab-href}))]
-          [:div.card (om/build build-steps/container-build-steps
-                               (assoc (get-in app state/container-data-path)
-                                      :selected-container-id (state/current-container-id app))
-                               {:key :selected-container-id})]])))))

 (defn job-cards-row
   "A set of cards to layout together"


Remove :container-selected post-nav control-event

--- src-cljs/frontend/controllers/controls.cljs
+++ src-cljs/frontend/controllers/controls.cljs
@@ -319,39 +319,6 @@
   [target message {:keys [container-id]} state]
   (assoc-in state state/current-container-path container-id))

-(defmethod post-control-event! :container-selected
-  [target message {:keys [container-id animate?] :or {animate? true}} previous-state current-state comms]
-  (let [previous-container-id (state/current-container-id previous-state)]
-    ; this function also gets called when the window is resized, the when check is to prevent the component
-    ; from updating in such case.
-    (when (not= previous-container-id container-id)
-      (when-let [parent (goog.dom/getElement "container_parent")]
-        (let [container (goog.dom/getElement (str "container_" container-id))
-              body (.-body js/document)
-              current-scroll-top (.-scrollTop parent)
-              body-scroll-top (.-scrollTop body)
-              current-scroll-left (.-scrollLeft parent)
-              new-scroll-left (int (.-x (goog.style.getContainerOffsetToScrollInto container parent)))]
-          (let [scroller (or (.-scroll_handler parent)
-                             (set! (.-scroll_handler parent)
-                                   ;; Store this on the parent so that we
-                                   ;; don't handle parent scroll while the
-                                   ;; animation is playing
-                                   (goog.fx.dom.Scroll. parent
-                                                        #js [0 0]
-                                                        #js [0 0]
-                                                        (if animate? 250 0))))
-                onEnd (.-onEnd scroller)]
-            (set! (.-startPoint scroller) #js [current-scroll-left 0])
-            (set! (.-endPoint scroller) #js [new-scroll-left 0])
-            ;; Browser find can scroll an absolutely positioned container into view,
-            ;; causing the parent to scroll. But then we set it to relative and there
-            ;; is no longer any overflow, so we need to scroll app-main instead.
-            (set! (.-onEnd scroller) #(do (.call onEnd scroller)
-                                          (set! (.-scrollTop body)
-                                                (+ body-scroll-top current-scroll-top))))
-            (.play scroller)))))))
-
 (defmethod control-event :container-paging-offset-changed
   [target message {:keys [paging-offset]} state]
   (assoc-in state state/container-paging-offset-path paging-offset))


Fix add-watch impl on cljs ROFocus type.


threading macro

threading macro

--- test/clj/just_married/api_test.clj
+++ test/clj/just_married/api_test.clj
@@ -14,6 +14,5 @@

     (t/testing "Homepage contains some valid content"
       (t/is (true? (includes?
-                    (slurp
-                     (.toString (:body resp)))
+                    (-> resp :body .toString slurp)
                     "Andrea"))))))


heroku deploy

heroku deploy


A bit more name generation and printing for sectors

--- src/hphelper/sectorgen/generator.clj
+++ src/hphelper/sectorgen/generator.clj
@@ -1,5 +1,6 @@
 (ns hphelper.sectorgen.generator
   (:require [hphelper.shared.sql :as sql]
+            [hiccup.core :refer :all]
             ))

 (defn create-service-group
@@ -14,4 +15,28 @@
                     (map (comp create-service-group :sg_id)
                          (sql/query "SELECT * FROM sg;")))
    :hps (reduce conj [] (repeatedly 6 (partial sql/get-random-name "U")))
+   :zone (sql/create-random-zone-name)
    })
+
+(defn print-sg-head
+  "Prints the sg head in a nice format"
+  [[k v :as sgh]]
+  (str (sql/get-sg-by-id k) ": " v))
+
+(defn html-print-sector
+  "Prints a single sector in a nice format"
+  [sec]
+  (html [:div
+         [:b "Zone:" (sec :zone) [:br]]
+         [:b "High Programmers:"] [:br]
+         (interpose [:br] (sort (sec :hps)))
+         [:br]
+         [:b "SG Heads"] [:br]
+         (interpose [:br] (sort (map print-sg-head (sec :sgheads))))
+         ]))
+
+(defn html-print-neighbours
+  "Prints a number of neighbouring randomly generated neighbours"
+  [n]
+  (html (map html-print-sector
+             (repeatedly n create-sector))))


insights: fix tests - unexterned .innerTickSize()

--- src-cljs/frontend/components/insights.cljs
+++ src-cljs/frontend/components/insights.cljs
@@ -73,8 +73,7 @@
                                       (.orient "left")
                                       (.tickValues (clj->js tick-values))
                                       (.tickFormat #(first (datetime/millis-to-float-duration % {:decimals 0})))
-                                      (.innerTickSize 0)
-                                      (.outerTickSize 0)
+                                      (.tickSize 0 0)
                                       (.tickPadding 3)))
         scale-filler (->> (list (:max-bars plot-info) (count builds))
                           (apply -)


Improve build timing rendering somewhat

Improve build timing rendering somewhat

--- src-cljs/frontend/visualization/build.cljs
+++ src-cljs/frontend/visualization/build.cljs
@@ -1,10 +1,18 @@
-(ns frontend.visualization.build)
+(ns frontend.visualization.build
+  (:require [frontend.models.feature :as feature]))

 (defn status->color [status]
-  (cond
-   (= status "success") "#292"
-   (= status "failed") "#c13737"
-   :else "rgb(128,128,128)"))
+  (let [is-v2? (feature/enabled? :ui-v2)
+        is-success? (= status "success")
+        is-failed? (= status "failed")]
+    (cond
+      (and is-v2? is-success?) "#42c88a"
+      (and is-v2? is-failed?) "#ed5c5c"
+      is-success? "#292"
+      is-failed? "#c13737"
+      ; grey for v2
+      is-v2? "#2c2f33"
+      :else "rgb(128,128,128)")))

 (defn millis->min-secs [millis]
   (let [total-secs (/ millis 1000.0)
@@ -34,8 +42,8 @@
     (> step-pixels cut-off)))

 (defn chart-build [svg scale build]
-  (let [bar-height 6
-        bar-pad 2
+  (let [bar-height 10
+        bar-pad 5
         text-height 16
         step-count (-> build (:steps) (count))
         chart-height (* (-> build (:parallel))
@@ -62,15 +70,19 @@
                          "width" #(- (scale (js/Date. (aget % "end_time"))) (scale (js/Date. (aget % "start_time"))))
                          "height" bar-height
                          "fill" #(status->color (aget % "status"))}))
-         ;; the start tick
-         (-> group
-             (.append "rect")
-             (.attr #js {"x" #(scale (js/Date. (aget % "start_time")))
-                         "y" #(* (+ bar-height bar-pad) (aget % "index"))
-                         "width" 0.1
-                         "height" (+ 1 bar-height)
-                         "stroke" "black"
-                         "stroke-width" 0.5})))))
+
+         (let [x #(scale (js/Date. (aget % "start_time")))
+               y1 #(* (+ bar-height bar-pad) (aget % "index"))
+               y2 #(+ bar-height (* (+ bar-height bar-pad) (aget % "index")))]
+           ;; the start tick
+           (-> group
+               (.append "line")
+               (.attr #js {"x1" x
+                           "x2" x
+                           "y1" y1
+                           "y2" y2
+                           "stroke" "black"
+                           "stroke-width" 0.75}))))))

     (-> svg (.selectAll "text") (.data (clj->js long-actions)) (.enter) (.append "text")
         (.text #(str (aget % "name") " (" (millis->min-secs (max-action-run-time-millis %)) ")"))
@@ -88,7 +100,7 @@
         d0 (js/Date. (:start_time build))
         d1 (js/Date. (:stop_time build))
         scale (-> js/d3 (.-time) (.scale))]
-    (.attr svg "width" svg-width)
+    (.attr svg "width" "100%")
     (-> scale (.domain #js [d0, d1]) (.range #js [0, (* 0.8 svg-width)]))
     (println "scale maps [" d0 ", " d1 "] -> [" (scale d0) ", " (scale d1) "]")


Put debug message in better place.

Put debug message in better place.

--- src/hxgm30/event/components/pubsub.clj
+++ src/hxgm30/event/components/pubsub.clj
@@ -150,7 +150,6 @@
 (defn start
   [this]
   (log/info "Starting pub-sub component ...")
-  (log/debug "Started pub-sub component.")
   (let [dataflow (pubsub/create-dataflow-pubsub
                   (config/event-system-type this))
         world (pubsub/create-world-pubsub
@@ -159,6 +158,7 @@
                               :world world)]
     (log/info "Adding subscribers ...")
     (subscribe-all component (:subscribers this))
+    (log/debug "Started pub-sub component.")
     component))

 (defn stop


test for basic enqueing, mass tests for track forwarding

--- test/western_music/lib/ui_test.clj
+++ test/western_music/lib/ui_test.clj
@@ -18,15 +18,67 @@
 (defn enqueue-tracks-directly [data tracks]
   (update-in data ui/player-path #(reduce ui/player-enqueue-track % tracks)))

-(deftest test-play
+(deftest enqueue-track-order
+  (testing "player-enqueue-track enqueues tracks in expected order"
+    (let [player (get-in @sample-data ui/player-path)
+          queue (:player/queue (reduce ui/player-enqueue-track player @sample-tracks))]
+      (is (= (map :track/id @sample-tracks)
+             (map :track/id queue))))))
+
+(deftest test-player-controls
   (testing "Nothing Enqueued"
     (let [player (get-in @sample-data ui/player-path)]
       (is (= {:db player} (ui/player-play player)))))
+
   (testing "With Enqueued"
-    (let [tracks (into [] (take 5) @sample-tracks)
+    (let [tracks (take 5 @sample-tracks)
           with-enqueued (enqueue-tracks-directly @sample-data tracks)
           player (get-in with-enqueued ui/player-path)
-          with-playing (ui/player-play player)]
-      (is (= (first tracks) (:player/playing (:db with-playing))))
+          playing-fx (ui/player-play player)]
+      (is (= (first tracks) (:player/playing (:db playing-fx))))
+      (is (false? (:player/paused (:db playing-fx))))
       (is (= [:new-track-playing (first tracks) false]
-             (:dispatch with-playing))))))
+             (:dispatch playing-fx)))
+
+      (testing "Pause, then play again"
+        (let [paused-fx (ui/player-pause (:db playing-fx))
+              playing-fx (ui/player-play (:db paused-fx))]
+          (is (= [:current-track-paused] (:dispatch paused-fx)))
+          (is (true? (:player/paused (:db paused-fx))))
+
+          (is (= [:current-track-playing] (:dispatch playing-fx)))
+          (is (false? (:player/paused (:db playing-fx))))
+          (is (= (first tracks) (:player/playing (:db playing-fx)))
+              "Currently playing didn't change at all")))
+
+      (testing "Forward and Backwards"
+        (testing "forward while playing"
+          (let [forwards (rest (reductions (fn [{player :db} _] (ui/player-forward player))
+                                           playing-fx
+                                           (:player/queue (:db playing-fx))))]
+            (doseq [[expected-track fx index] (map vector (rest tracks) (drop-last forwards) (range))]
+              (testing (str "call number " (inc index))
+                (is (= expected-track (:player/playing (:db fx))))
+                (is (false? (:player/paused (:db fx))))
+                (is (= :queue (:player/selected-tab (:db fx))))
+                (is (= [:new-track-playing expected-track false] (:dispatch fx)))))
+            (is (= 1 (count (last forwards)))
+                "No extra effects on last call")
+            (is (= (:db (last forwards)) (:db (last (drop-last forwards))))
+                "Forwarding when on last track doesn't change player state")))
+
+        (testing "forward while paused"
+          (let [paused-fx (ui/player-pause (:db playing-fx))
+                forwards (rest (reductions (fn [{player :db} _] (ui/player-forward player))
+                                           paused-fx
+                                           (:player/queue (:db paused-fx))))]
+            (doseq [[expected-track fx index] (map vector (rest tracks) (drop-last forwards) (range))]
+              (testing (str "call number " (inc index))
+                (is (= expected-track (:player/playing (:db fx))))
+                (is (true? (:player/paused (:db fx))))
+                (is (= :queue (:player/selected-tab (:db fx))))
+                (is (= [:new-track-playing expected-track true] (:dispatch fx)))))
+            (is (= 1 (count (last forwards)))
+                "No extra effects on last call")
+            (is (= (:db (last forwards)) (:db (last (drop-last forwards))))
+                "Forwarding when on last track doesn't change player state")))))))


Rebind clojure.test/*test-out* in the repl

Fixes #55

--- src/main/clojure/vimclojure/repl.clj
+++ src/main/clojure/vimclojure/repl.clj
@@ -21,6 +21,8 @@
 ; THE SOFTWARE.

 (ns vimclojure.repl
+  (:require
+    clojure.test)
   (:use
      [vimclojure.util :only (stream->seq pretty-print pretty-print-causetrace)])
   (:import
@@ -51,7 +53,8 @@
   invokations. The members correspond to the Vars as bound be with-binding."}
   repl
   :id :ns :warn-on-reflection :print-meta :print-length :print-level
-  :compile-path :command-line-args :expr1 :expr2 :expr3 :exception :line)
+  :compile-path :command-line-args :expr1 :expr2 :expr3 :exception :test-out
+  :line)

 (defn make-repl
   "Create a new Repl."
@@ -73,6 +76,7 @@
                :expr3              nil
                :exception          nil
                :print-pretty       vimclojure.repl/*print-pretty*
+               :test-out           nil
                :line               0)))

 (defn start
@@ -137,7 +141,10 @@
        #'*2                   (the-repl :expr2)
        #'*3                   (the-repl :expr3)
        #'*e                   (the-repl :exception)
-       #'vimclojure.repl/*print-pretty* (the-repl :print-pretty)}
+       #'vimclojure.repl/*print-pretty* (the-repl :print-pretty)
+       #'clojure.test/*test-out* (if-let [test-out (the-repl :test-out)]
+                                   test-out
+                                   *out*)}
       (try
         (thunk)
         (finally
@@ -158,6 +165,9 @@
                      :expr3              *3
                      :exception          *e
                      :print-pretty       vimclojure.repl/*print-pretty*
+                     :test-out           (let [test-out clojure.test/*test-out*]
+                                           (when-not (identical? test-out *out*)
+                                             test-out))
                      :line               (dec (.getLineNumber *in*))))))))))

 (defmacro with-repl


Specify empty digest string size

Specify empty digest string size

--- test/caesium/crypto/generichash_test.clj
+++ test/caesium/crypto/generichash_test.clj
@@ -72,5 +72,6 @@

 (deftest blake2b-empty-args-variations-tests
   (doseq [args blake2b-empty-args-variations]
-    (is (array-eq (apply g/blake2b args) (blake2b-vector "digest-empty-string"))
+    (is (array-eq (apply g/blake2b args)
+                  (blake2b-vector "digest-empty-string-32"))
         (str "args: " args))))


removing old tests

removing old tests

--- test/vignette/api/legacy/routes_test.clj
+++ test/vignette/api/legacy/routes_test.clj
@@ -68,30 +68,3 @@
          (:original map) => "Flag_of_Europe.svg"
          (:revision map) => "latest"
          (:lang (:options map)) => "fr"))
-
-;(facts :image-thumbnail-width
-;  (let [rt (routes/add-request-type {} :image-thumbnail)]
-;    (routes/request-map-add-width
-;       (merge rt {:thumbnail "130px-102,382,0,247-Brain_Attack.PNG"} ))  => (contains {:width "130px"})
-;    (routes/request-map-add-width
-;       (merge rt {:thumbnail "10x10-102,382,0,247-Brain_Attack.PNG"} ))  => (contains {:width "10x10"})
-;    (routes/request-map-add-width
-;       (merge rt {:thumbnail "10x10x10-102,382,0,247-Brain_Attack.PNG"} ))  => (contains {:width "10x10x10"})
-;    (routes/request-map-add-width
-;       {:thumbnail "10x10x10-102,382,0,247-Brain_Attack.PNG"})  => (contains {:width ""})))
-;
-;(facts :coordinates
-;  (routes/thumbnail-path->coordinates "") => falsey
-;  (routes/thumbnail-path->coordinates "0,0,0") => falsey
-;  (routes/thumbnail-path->coordinates "0,0,0,0") => (contains {:x1 0 :x2 0 :y1 0 :y2 0})
-;  (routes/thumbnail-path->coordinates "1,2,3,4") => (contains {:x1 1 :x2 2 :y1 3 :y2 4}))
-;
-;(facts :dimensions
-;  (routes/thumbnail-path->dimensions "") => falsey
-;  (routes/thumbnail-path->dimensions "foobar.png") => falsey
-;  (routes/thumbnail-path->dimensions "123px-foobar.png") => truthy
-;  (routes/thumbnail-path->dimensions "123px-foobar.png") => [:width '(123)]
-;  (routes/thumbnail-path->dimensions "123x123-foobar.png") => [:width-height '(123 123)])
-
-; this is specific to the no-extension request type
-; (routes/thumbnail-path->dimensions "123x124x10-foobar") => [:width-height-scale '(123 124 10)]


preserve old cljs.analyze.api/analyze behavior

--- src/main/clojure/cljs/analyzer/api.clj
+++ src/main/clojure/cljs/analyzer/api.clj
@@ -69,7 +69,10 @@
   ([env form name] (analyze env form name nil))
   ([env form name opts] (analyze env/*compiler* env form name opts))
   ([state env form name opts]
-   (env/with-compiler-env state
+   (if state
+     (env/with-compiler-env state
+       (binding [ana/*cljs-warning-handlers* (:warning-handlers opts ana/*cljs-warning-handlers*)]
+         (ana/analyze env form name opts)))
      (binding [ana/*cljs-warning-handlers* (:warning-handlers opts ana/*cljs-warning-handlers*)]
        (ana/analyze env form name opts)))))


[PDOK-2044] flush records to database on exception (shutdown processor on exception)

--- src/main/clojure/pdok/featured/api.clj
+++ src/main/clojure/pdok/featured/api.clj
@@ -86,7 +86,8 @@
              (swap! stats assoc-in [:processing] nil)
              (stats-on-callback callback-chan request run-stats)))
          (catch Exception e
-           (let [error-stats (assoc request :error (str e))]
+           (let [processor (shutdown processor)
+                 error-stats (assoc request :error (str e))]
              (log/warn error-stats)
              (swap! stats update-in [:errored] #(conj % error-stats))
              (swap! stats assoc-in [:processing] nil)
@@ -112,7 +113,7 @@
                                           (:collection request)
                                           (:extractType request)
                                           (read-string (:extractVersion request)))
-          _ (println "response: " response)
+          _ (log/info "response: " response)
           extract-stats (assoc request :response response)]
        (stats-on-callback callback-chan request extract-stats))
     (catch Exception e


basic optimizations to rendering and is now much more performant.

--- src/pixel_perversion_engine/main.clj
+++ src/pixel_perversion_engine/main.clj
@@ -128,6 +128,7 @@
   ;BOOKMARK println fps
   ;(println (.getFramesPerSecond Gdx/graphics))
   ;BOOKMARK render fps
+  ;kek
   (.begin (get-in @root-atomic [:sprite-batch]))
   (render-text @root-atomic (str (.getFramesPerSecond Gdx/graphics)) 200 200)
   (.end (get-in @root-atomic [:sprite-batch]))


ported anna's om-data-vis example

ported anna's om-data-vis example

--- ui/ringo/client.cljs
+++ ui/ringo/client.cljs
@@ -1,8 +1,8 @@
 (ns ringo.client
   (:require-macros [cljs.core.async.macros :refer [go]])
-  (:require [ajax.core :refer [GET POST]
+  (:require [ajax.core :refer [GET POST]]
             [cljs.core.async :refer [<!]]
-            [ringo.utils :refer :all]))
+            [ringo.utils :refer [log guid debug]]))

 (def host "http://localhost:3000" )


Determine derived stub from context

Determine derived stub from context

--- src/angelic/search/implicit/dash_astar.clj
+++ src/angelic/search/implicit/dash_astar.clj
@@ -167,27 +167,22 @@
 ;; TODO: efficiency?
 (defn- set-stub-output! [stb sp]
   (assert (empty? (get-outputs stb)))
-  (assert (identical? (stub sp) stb))
-  (let [b  (summaries/get-bound stb)
-        ts (tree-summarizer stb)]
-    (summaries/summary-changed-local! stb)
-    (summaries/connect-subsumed! ts sp)
-    (connect-and-watch! ts sp
-       (fn [child-sp]
-         (let [child-ts (sp-ts child-sp)]
-           (assert (tree-summarizer? child-ts))
-           (summaries/connect! ts child-ts)
-           (summaries/connect-subsumed! ts child-ts)
-           (summaries/summary-changed! ts))))
-;    (println "SO" stb b (summary/max-reward (summaries/summary sp)))
-    (summaries/add-bound! ts b) ;; TODO: ???
-    (summaries/summary-changed! ts)
-    (add-output! stb sp)))
-
-(defn- set-derived-stub-output! [stub sp]
-  (assert (empty? (get-outputs stub)))
-  (summaries/summary-changed-local! stub)
-  (add-output! stub sp))
+  (assert (identical? (stub sp) stb))
+  (summaries/summary-changed-local! stb)
+  (when (identical? stb (ts-stub (tree-summarizer stb)))
+    (let [b  (summaries/get-bound stb)
+          ts (tree-summarizer stb)]
+      (summaries/connect-subsumed! ts sp)
+      (connect-and-watch! ts sp
+        (fn [child-sp]
+          (let [child-ts (sp-ts child-sp)]
+            (assert (tree-summarizer? child-ts))
+            (summaries/connect! ts child-ts)
+            (summaries/connect-subsumed! ts child-ts)
+            (summaries/summary-changed! ts))))
+      (summaries/add-bound! ts b) ;; TODO: ???
+      (summaries/summary-changed! ts)))
+  (add-output! stb sp))

 (defn- get-stub-output  [s] (first (get-outputs s)))
 (defn- get-stub-output! [s] (util/safe-singleton (get-outputs s)))
@@ -223,7 +218,7 @@
               Stub (stub-name       [s] nm)
                    (input-set       [s] in-set)
                    (tree-summarizer [s] (tree-summarizer inner-stub)))]
-    (connect-and-watch-stub! ret inner-stub false #(set-derived-stub-output! ret (sp-fn ret %)))
+    (connect-and-watch-stub! ret inner-stub false #(set-stub-output! ret (sp-fn ret %)))
     ret))


Added some subproject path expansion. ~ expands properly and projects.directory can be set to the root where all subprojects are stored.

--- src/cake/deps.clj
+++ src/cake/deps.clj
@@ -6,7 +6,8 @@
         [clojure.java.shell :only [sh]]
         [clojure.string :only [split join]]
         [useful.map :only [into-map map-to map-vals]]
-        [useful.fn :only [all any !]])
+        [useful.fn :only [all any !]]
+        [useful.experimental :only [cond-let]])
   (:require depot.maven
             [depot.deps :as depot])
   (:import [org.apache.tools.ant.taskdefs Copy Delete]))
@@ -26,14 +27,21 @@

 (defn subproject-path [dep]
   (when *config*
-    (or (get *config* (str "subproject." (namespace dep) "." (name dep)))
-        (get *config* (str "subproject." (name dep))))))
+    (or (get *config* (str "subproject." (namespace dep) "." (name dep))
+        (get *config* (str "subproject." (name dep)))))))
+
+(defn expand-subproject [path]
+  (when path
+    (if-let [default (*config* "projects.directory")]
+      (file default path)
+      (file path))))

 (defn install-subprojects! []
   (doseq [dep (keys (:dependencies *project*))]
-    (when-let [path (subproject-path dep)]
-      (with-root path
-        (cake-exec "install")))))
+      (when-let [path (expand-subproject (subproject-path dep))]
+        (prn path)
+        (with-root path
+          (cake-exec "install")))))

 (defn extract-native! [dest]
   (doseq [jars (vals @dep-jars), jar jars]


Allow override of logback config file.

Allow override of logback config file.

--- src/cavm/core.clj
+++ src/cavm/core.clj
@@ -192,16 +192,19 @@
     (str database ";" default-h2-opts)
     database))

-(defn- logback-config [filename]
-  (System/setProperty "log_file" filename)
-  (let [context (LoggerFactory/getILoggerFactory)
-        configurator (JoranConfigurator.)]
-    (try
-      (.setContext configurator context)
-      (.reset context)
-      (.doConfigure configurator (io/resource "logback_config.xml"))
-      (catch Exception e))
-    (StatusPrinter/printInCaseOfErrorsOrWarnings context)))
+(defn- logback-config
+  ([filename]
+   (logback-config filename "logback_config.xml"))
+  ([filename config]
+   (System/setProperty "log_file" filename)
+   (let [context (LoggerFactory/getILoggerFactory)
+         configurator (JoranConfigurator.)]
+     (try
+       (.setContext configurator context)
+       (.reset context)
+       (.doConfigure configurator (io/resource config))
+       (catch Exception e))
+     (StatusPrinter/printInCaseOfErrorsOrWarnings context))))

 (defn- log-config [filename]
   (logback-config filename)


inline reduce - phase 2

inline reduce - phase 2

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -13,7 +13,7 @@
   [body]
   `(let [result# ~body]
      (println (expension-report ~body) "=>" result#)
-     ))
+     result#))

 (defmacro constexpr
   [fct & args]
@@ -260,12 +260,22 @@

 ;; --------------------------------------------------------
 ;; Example 5: Generating some code based on data structure
+;; - Go iteratively?
 ;; - Show the example of efficient loop generation
 ;; --------------------------------------------------------

-#_(inline-reduce +
-    [[:map #(* % %)] [:filter #(> % 1)] [:map #(* % 2)]]
-    coll)
+#_(defmacro inline-reduce
+    [reducer initial transforms coll]
+    `(reduce ~reducer ~initial ~coll))
+
+(defmacro inline-reduce
+  [reducer initial transforms coll]
+  `(loop [h# (first ~coll)
+          t# (rest ~coll)
+          r# ~initial]
+     (if h#
+       (recur (first t#) (rest t#) (~reducer r# h#))
+       r#)))

 #_(loop [h (first coll)
          t (rest coll)
@@ -278,6 +288,16 @@
         (recur ...)                                         ;; no accumulation
         )))

+(defn test-inline-reduce
+  []
+  (let [coll (into [] (range 10))]
+    (report (inline-reduce
+              +
+              0
+              [[:filter odd] [:map #(* 2 %)]]
+              coll
+              ))))
+

 ;; --------------------------------------------------------
 ;; Example 6: DFS to do a topological sort


Group items in trolley

Group items in trolley

--- src/cljs/ikea_clojure_cup/select_items.cljs
+++ src/cljs/ikea_clojure_cup/select_items.cljs
@@ -64,9 +64,9 @@

 (defn package-total-overlay
   [packages]
-  [bootstrap/pop-over {:id "package-popover" :title (str (count packages) " packages")
+  [bootstrap/pop-over {:id "package-popover" :title (str (count packages) " flatpacks")
                        :placement :bottom}
-   "This product comes in " (count packages) " packages"])
+   "This product is packaged in " (count packages) " flatpacks or boxes."])

 (defn package-total-view
   [item-container packages]
@@ -75,19 +75,19 @@
       (let [package-count (count packages)]
         (if (zero? package-count)
           [bootstrap/label {:bs-style :warning}
-           [bootstrap/glyph {:glyph :warning}] "No packages found!"]
+           [bootstrap/glyph {:glyph :warning}] "No flatpacks found!"]

           [:div
            [bootstrap/label {:on-mouse-over #(reset! show-popover true)
                              :on-mouse-leave #(reset! show-popover false)}
-            package-count " package" (when (< 1 package-count) "s")
+            package-count " flatpack" (when (< 1 package-count) "s")
             [bootstrap/overlay {:show @show-popover
                                 :container (reagent/current-component)}
              [package-total-overlay packages]]]])))))

 (defn trolley-item
-  [idx {:keys [desc name image-src packages id]} remove-fn add-another-fn]
-  [bootstrap/list-group-item {:key idx :list-item true}
+  [{:keys [desc name image-src packages id count]} remove-fn add-another-fn]
+  [bootstrap/list-group-item {:key id :list-item true}
    [:div
     [:div.contents
      [:div
@@ -103,15 +103,33 @@
                            :bs-style :danger
                            :on-click remove-fn}
          [bootstrap/glyph {:glyph :remove}] " Remove"]]]]
-     [:div [package-total-view (reagent/current-component) packages]]]
+     [:div
+      [package-total-view (reagent/current-component) packages]
+      (when-not (and count (>= 1 count))
+        [:h2 "⨉" count])]]
     [:div.preview
      [bootstrap/thumbnail {:src image-src :responsive true}]]]])

+(defn- remove-first
+  "remove the first item in the coll where the value of k matches v"
+  [coll k v]
+  (let [first-part (take-while #(not= (k %) v) coll)]
+    (concat
+     first-part
+     (take-last (dec (- (count coll) (count first-part))) coll))))
+
 (defn- remove-item-from-trolley
-  [trolley-state idx]
+  [trolley-state id]
   (let [items (:items @trolley-state)]
-    (swap! trolley-state assoc-in [:items]
-           (concat (take idx items) (last (split-at (inc idx) items))))))
+    (swap! trolley-state update-in [:items]
+           remove-first :id id)))
+
+(defn- group-items
+  [items]
+  (let [grouped (group-by :id items)]
+    (map (fn [[id items]]
+           (assoc (first items) :count (count items)))
+         grouped)))

 (defn trolley-list-contents
   [trolley-state]
@@ -120,13 +138,13 @@
     (if (empty? (:items @trolley-state))
       [bootstrap/list-group-item {:key 0 :list-item true}
        [:em "Nothing in your trolley, yet!"]]
-      (map-indexed
-       (fn [idx item]
-         ^{:key idx}
-         [trolley-item idx item
-          (partial remove-item-from-trolley trolley-state idx)
+      (map
+       (fn [item]
+         ^{:key (:id item)}
+         [trolley-item item
+          (partial remove-item-from-trolley trolley-state (:id item))
           #(swap! trolley-state update-in [:items] conj item)])
-       (:items @trolley-state)))]])
+       (group-items (:items @trolley-state))))]])

 (defn select-items-view
   [trolley-state progress-fn]


docstrings

docstrings

--- src/cljs/infinitelives/utils/resources.cljs
+++ src/cljs/infinitelives/utils/resources.cljs
@@ -5,6 +5,10 @@

 (defmulti load
+  "a multimethod to load a resource by url and
+  return a channel, down which will be sent [url object]
+  apon successful load and [url nil] on an error.
+  "
   (fn [url] (string/get-extension url)))

 (defmethod load "png" [url]
@@ -16,16 +20,22 @@
     (set! (.-src i) url)
     c))

-(defmulti register
+(defmulti register!
+  "a multimethod that will register a loaded
+  resource to the subsystem that handles it.
+  It will be passed two arguments, the url
+  and the object. register! returns immediately"
   (fn [url obj] (string/get-extension url)))

-(defmethod register "png" [url img]
+(defmethod register! "png" [url img]
   (register-texture! url img))

 (defn load-url
+  "load-url takes a url and returns a channel
+  that after load and registration will"
   [url]
   (go
-    (apply register (<! (load url)))))
+    (apply register! (<! (load url)))))

 (defn load-urls
   "loads each url in the passed in list. Updates the progress as it goes with


List group expenses in debug

List group expenses in debug

--- src/clojurescript/skuld/show_group/app.cljs
+++ src/clojurescript/skuld/show_group/app.cljs
@@ -24,6 +24,7 @@
                     (assoc-in [:expense-form :shared-with]
                               (into {} (map #(vec [% true]) (:members value))))
                     (assoc-in [:expense-form :payed-by] (first (:members value))))
+    :group-expenses (assoc state :group-expenses value)
     :shared-with (update-in state [:expense-form :shared-with value] not)
     :change-amount (assoc-in state [:expense-form :amount] value)
     :change-payed-by (assoc-in state [:expense-form :payed-by] value)
@@ -117,10 +118,46 @@
                                 :on-click submit-expense-form}
         "Add expense"]])))

+(defn tab-header [tabs]
+  (let [list-item (fn [{:keys [tab-id title active]}]
+                    [:li {:role "presentation"
+                          :class (if active "active" "")}
+                     [:a {:href (str "#" tab-id)
+                          :aria-controls tab-id
+                          :role "tab"
+                          :data-toggle "tab"}
+                      title]])]
+    (->> tabs
+         (map list-item)
+         (into [:ul {:class "nav nav-tabs" :roles "tablist"}]))))
+
+(defn tab-panes [contents]
+  (let [pane (fn [{:keys [tab-id content active]}]
+               [:div {:role "tabpanel"
+                      :class (if active "tab-pane active" "tab-pane")
+                      :id tab-id}
+                content])]
+    (->> contents
+         (map pane)
+         (into [:div {:class "tab-content"}]))))
+
+(defn tabbed []
+  (let [tabs [["home" "Home" "HOME"]
+              ["thing" "Stuff" "aslkjda sldkja lksdjlka jsdlkaj slkdjalskdj alkjsd"]]
+        tabs (->> tabs
+                  (map (partial cons false))
+                  (#(cons (cons true (rest (first %))) (rest %)))
+                  (map (partial zipmap [:active :tab-id :title :content])))]
+    [:div
+     [tab-header tabs]
+     [tab-panes tabs]]))
+
 (defn app []
   [:div
    [show-group]
-   [expense-form]])
+   [expense-form]
+   [tabbed]
+   ])

 (defn get-group-info []
   (GET (str "/api/v1/groups/" group-id)
@@ -129,6 +166,14 @@
         :response-format :json
         :keywords? true}))

+(defn get-group-expenses []
+  (GET (str "/api/v1/groups/" group-id "/expenses")
+       {:handler #(dispatch [:group-expenses %])
+        :error #(.log js/console %)
+        :response-format :json
+        :keywords? true}))
+
 (defn ^:export init []
   (get-group-info)
+  (get-group-expenses)
   (r/render [app] (get-element "app")))


Remove nil value from assign-task-resources

--- src/onyx/messaging/aeron/messenger.clj
+++ src/onyx/messaging/aeron/messenger.clj
@@ -23,7 +23,7 @@
 ;; TODO, make sure no stream-id collision issues
 (defmethod m/assign-task-resources :aeron
   [replica peer-id job-id task-id peer-site peer-sites]
-  {:aeron/peer-task-id nil})
+  {})

 (defmethod m/get-peer-site :aeron
   [peer-config]


(PE-962) remove unnecessary extra index on primary key

Because the `node` column of the new `latest_reports` table is already marked as the `PRIMARY KEY`, we don't need to explicitly create an index on it.

--- src/com/puppetlabs/puppetdb/scf/migrate.clj
+++ src/com/puppetlabs/puppetdb/scf/migrate.clj
@@ -329,7 +329,6 @@
     ["node" "TEXT" "NOT NULL" "PRIMARY KEY" "REFERENCES certnames(name)" "ON DELETE CASCADE"]
     ["report" "VARCHAR(40)" "NOT NULL" "REFERENCES reports(hash)" "ON DELETE CASCADE"])
   (sql/do-commands
-    "CREATE INDEX idx_latest_reports_node ON latest_reports(node)"
     "CREATE INDEX idx_latest_reports_report ON latest_reports(report)")
   (sql/do-commands
     "INSERT INTO latest_reports (node, report)


atom-context filenames

atom-context filenames

--- src/atom_finder/questions/atom_context.clj
+++ src/atom_finder/questions/atom_context.clj
@@ -44,8 +44,8 @@
        ))

 (defn main-atom-context []
-  (let [edn-file "tmp/atom-context_2018-10-12_parent-type.edn"
-        csv-file "src/analysis/data/atom-context_2018-10-12_parent-type.csv"]
+  (let [edn-file "tmp/atom-context_2018-10-25_disambiguate-minus-arity.edn"
+        csv-file "src/analysis/data/atom-context_2018-10-25_disambiguate-minus-arity.csv"]
     (atom-context edn-file)
     (csv-atom-context edn-file csv-file)
     ))


+'del' => 'di il'

+'del' => 'di il'

--- src/babel/italiano/morphology/articles.clj
+++ src/babel/italiano/morphology/articles.clj
@@ -1,14 +1,23 @@
 (ns babel.italiano.morphology.articles)

+;; TODO: unify with (babel.italiano.morphology/conjugate-italian-prep)
 (def l-apostrophe
-  {#"^l$"
+  {
+
+   #"^del$"
+   {:replace-with "di il"
+    :unify-with :top}
+
+   #"^l$"
    {:replace-with "la"
     :unify-with :top}
-
-  #"^gli$"
+
+   #"^gli$"
    {:replace-with "i"
     :unify-with :top}
-   })
+
+   }
+  )


Develop further the notion of a channel of time ranges.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -4,7 +4,7 @@
   (:require [reagent.core :as reagent]
             [ajax.core :as ajax]
             [cljs.reader :as reader]
-            [cljs.core.async :refer [put! close! chan <! dropping-buffer alts!]]
+            [cljs.core.async :refer [put! close! chan <! dropping-buffer alts! pipeline]]
             [cljs-time.core :as time]
             [cljs-time.coerce :as time-coerce]
             [metlog-client.tsplot :as tsplot]))
@@ -45,25 +45,25 @@

 (defn periodic-event-channel [ interval-ms ]
   (let [ channel (chan (dropping-buffer 1)) ]
-    (js/setInterval #(put! channel (time/now)) interval-ms)
+    (js/setInterval #(put! channel (time/now))
+                    interval-ms)
     channel))
+
+(defn range-ending-at [ end-t ]
+  (let [begin-t (time/minus end-t (time/seconds @query-window-secs))]
+    {:begin-t begin-t :end-t end-t}))

 (defn query-range-channel [ periodic-event-channel ]
   (let [ channel (chan) ]
-    (go-loop [end-t (<! periodic-event-channel)]
-      (when end-t
-        (watch end-t)
-        (let [begin-t (time/minus end-t (time/seconds @query-window-secs))]
-          (put! channel {:begin-t begin-t
-                         :end-t end-t}))))
+    (pipeline 1 channel (map range-ending-at) periodic-event-channel)
     channel))

-(defn channel-test []
-  (go
-    (let [ channel (query-range-channel (periodic-event-channel 5000))]
-      (go-loop [range (<! channel)]
+#_(let [ channel (query-range-channel (periodic-event-channel 5000))]
+    (go-loop []
+      (let [range (<! channel)]
         (when range
-          (watch range))))))
+          (watch range)
+          (recur)))))

 (defn series-tsplot [ series qws-arg ]
   (let [dom-node (reagent/atom nil)


Collapse tsplot and canvas components into a single level.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -56,38 +56,28 @@
   (let [ ctx (.getContext canvas "2d")]
     (tsplot/draw ctx (dom-node-width canvas) (dom-node-height canvas) series-data)))

-(defn series-tsplot-plot-canvas [ series ]
-  (let [ series-state (reagent/atom { }) ]
+(defn series-tsplot [ series ]
+  (let [dom-node (reagent/atom nil)
+        series-state (reagent/atom {})]
     (reagent/create-class
      {:display-name (str "series-tsplot-" series)
       :component-did-update
       (fn [ this ]
-        (tsplot-draw (reagent/dom-node this) (:series-data @series-state)))
-
+        (tsplot-draw (.-firstChild (reagent/dom-node this)) (:series-data @series-state)))
+
       :component-did-mount
       (fn [ this ]
+        (reset! dom-node (reagent/dom-node this))
         (go
           (swap! series-state assoc :series-data (<! (<<< fetch-series-data series @query-window-secs)))))

       :reagent-render
-      (fn [ series width height ]
-        @series-state
-        [:canvas {:width width :height height}])})))
-
-(defn series-tsplot [ series ]
-  (let [ dom-node (reagent/atom nil)]
-    (reagent/create-class
-     {:component-did-mount
-      (fn [ this ]
-        (reset! dom-node (reagent/dom-node this)))
-
-      :reagent-render
       (fn [ ]
         @window-width
+        @series-state
         [:div
-         [series-tsplot-plot-canvas series
-          (dom-node-width @dom-node default-tsplot-width)
-          (dom-node-height @dom-node default-tsplot-height)]])})))
+         [:canvas {:width (dom-node-width @dom-node default-tsplot-width)
+                   :height (dom-node-height @dom-node default-tsplot-height)}]])})))

 (defn series-pane [ series ]
   [:div.series-pane


(PDB-5168) Log PQL long parsing time

(PDB-5168) Log PQL long parsing time

--- src/puppetlabs/puppetdb/http/query.clj
+++ src/puppetlabs/puppetdb/http/query.clj
@@ -6,6 +6,7 @@
   (:require [puppetlabs.puppetdb.cheshire :as json]
             [clojure.java.io]
             [clojure.core.match :as cm]
+            [clojure.tools.logging :as log]
             [clojure.walk :refer [keywordize-keys stringify-keys]]
             [puppetlabs.puppetdb.query-eng :as qeng]
             [clojure.set :as set]
@@ -304,13 +305,26 @@
                      others parsed))))
       parsed)))

+(defn time-and-parse-pql
+  "Time how long it takes to transform a PQL query to AST, if the time
+   is greater than 1s, a warning is logged. Returns the transformed
+   query."
+  [query]
+  (let [start (System/nanoTime)
+        result (pql/parse-pql-query query)
+        elapsed (/ (- (System/nanoTime) start) 1000000.0)
+        max-pql-limit 1000]
+    (when (> elapsed max-pql-limit)
+      (log/warn (trs "Parsing PQL took {0} ms: {1}" elapsed (pr-str query))))
+    result))
+
 (defn parse-json-or-pql-to-ast
   "Parse a query string either as JSON or PQL to transform it to AST"
   [query]
   (when query
     (if (re-find #"^\s*\[" query)
       (parse-json-query query)
-      (pql/parse-pql-query query))))
+      (time-and-parse-pql query))))

 (defn get-req->query
   "Converts parameters of a GET request to a pdb query map"


"load" files by creating a bidi route matcher

--- src/doctopus/storage/impls/permanent_fs.clj
+++ src/doctopus/storage/impls/permanent_fs.clj
@@ -1,9 +1,10 @@
 (ns doctopus.storage.impls.permanent-fs
-  (:require [doctopus
+  (:require [bidi.ring :as bidi-ring]
+            [doctopus
              [configuration :refer [server-config]]
              [files :as files]]
-            [me.raynes.fs :as fs]
-            [doctopus.storage.impls.fs-impl :refer [save-html-file] :as fs-impl]))
+            [doctopus.storage.impls.fs-impl :refer [save-html-file] :as fs-impl]
+            [me.raynes.fs :as fs]))

 ;; TODO: this does not actually work the way we need it to! Neat! --RMD

@@ -20,16 +21,21 @@
       (and (fs/exists? result)
            (fs/readable? result)))))

+;; This might be totally deprecated.
+;; (defn load-fn
+;;   "Uh."
+;;   [key]
+;;   (binding [fs/*cwd* root]
+;;     (let [dir (fs/file key)
+;;           rel-path-html-pairs (files/read-html dir)]
+;;       (into [] (map (fn [[rel-path html]] [rel-path (fn [_] html)]) rel-path-html-pairs)))))
+
 (defn load-fn
-  "This is as Version 1 a way of doing this as I can think of:
-
-  1. We load html
-  2. We wrap that html in a function that returns itself, so we can Bidi"
+  "Returns the routes this serves"
   [key]
-  (binding [fs/*cwd* root]
-    (let [dir (fs/file key)
-          rel-path-html-pairs (files/read-html dir)]
-      (into [] (map (fn [[rel-path html]] [rel-path (fn [_] html)]) rel-path-html-pairs)))))
+  (let [file-handle (binding [fs/*cwd* root] (fs/file key))
+        file-name (.getPath file-handle)]
+   [key (bidi-ring/->Files file-name)]))

 (defn remove-fn
   [key]


Use `p/do*` for session storage impl of async methods.

--- src/clojure/catacumba/handlers/session.clj
+++ src/clojure/catacumba/handlers/session.clj
@@ -152,16 +152,14 @@
                  (resolve [key data])))))))

       (-write [_ key data]
-        (p/promise
-         (fn [resolve reject]
-           (swap! internalstore assoc key data)
-           (resolve key))))
+        (p/do*
+         (swap! internalstore assoc key data)
+         key))

       (-delete [_ key]
-        (p/promise
-         (fn [resolve reject]
-           (swap! internalstore dissoc key)
-           (resolve key)))))))
+        (p/do*
+         (swap! internalstore dissoc key)
+         key)))))

 (defn signed-cookie
   [& {:keys [key] :as opts}]
@@ -178,14 +176,11 @@
                  (resolve [(jwt/sign {} pkey opts) {}])))))))

       (-write [_ key data]
-        (p/promise
-         (fn [resolve reject]
-           (resolve (jwt/sign data pkey opts)))))
+        (p/do*
+         (jwt/sign data pkey opts)))

       (-delete [_ key]
-        (p/promise
-         (fn [resolve reject]
-           (resolve key)))))))
+        (p/do* key)))))

 (defn lookup-storage
   "A helper for create session storages with


Renamed keys in the json that will be returned when composing the specification.

--- src/clj_formal_specifications_app/core.clj
+++ src/clj_formal_specifications_app/core.clj
@@ -46,13 +46,13 @@

 (defn conj-actions
   [actions action-entry]
-  (conj actions {:id (key action-entry)
+  (conj actions {:name (key action-entry)
                  :arglist (first (:arglists (meta (val action-entry))))}))

 (defn conj-spec-refs
   [spec-refs spec-ref-entry]
-  (conj spec-refs {:id (key spec-ref-entry)
-                   :data @(var-get (val spec-ref-entry))}))
+  (conj spec-refs {:name (key spec-ref-entry)
+                   :contents @(var-get (val spec-ref-entry))}))

 (defn assoc-to-spec
  [spec map-entry]


Fixed shadow-root problem

Fixed shadow-root problem

--- src/cljs/ghoul/components/feeds_panel.cljs
+++ src/cljs/ghoul/components/feeds_panel.cljs
@@ -8,13 +8,13 @@
 (defn feed-description [data owner]
   (let [set-description-dom!
         (fn []
-          (-> owner
-              .getDOMNode
-              .createShadowRoot
-              .-innerHTML
-              (set! (-> data
-                        utils/restore-tags
-                        utils/remove-unallowed-tags))))]
+          (let [shadow-root (-> owner .getDOMNode .-shadowRoot)
+                description (-> data
+                                utils/restore-tags
+                                utils/remove-unallowed-tags)]
+            (if (nil? shadow-root)
+              (-> owner .getDOMNode .createShadowRoot .-innerHTML (set! description))
+              (-> shadow-root .-innerHTML (set! description)))))]
     (reify
       om/IDidMount
       (did-mount [this] (set-description-dom!))


fix out-of-order defs, improve reducep docstring, clean up some protocols

--- src/cljx/jamesmacaulay/zelkova/signal.cljx
+++ src/cljx/jamesmacaulay/zelkova/signal.cljx
@@ -21,24 +21,38 @@
             [alandipert.kahn :as kahn])
   (:require-macros [cljs.core.async.macros :refer [go go-loop]]))

-; Events come in from "the outside world" and get transformed into Messages by input signal nodes
-(defrecord Event
-  [topic value])
-
-(defprotocol Message
+(defprotocol BoxedValueProtocol
+  (value [boxed]))
+
+(defprotocol EventProtocol
+  "Events come in from \"the outside world\" and get transformed into Messages by input signal nodes"
+  (topic [event]))
+
+(defprotocol MessageProtocol
   "Messages are propagated through the signal graph, and can either be \"fresh\" or \"cached\"."
   (fresh? [msg] "returns `true` if the message represents a fresh value, `false` otherwise"))

-; a box for a "fresh" value
+(defrecord Event
+  [topic value]
+  BoxedValueProtocol
+  (value [_] value)
+  EventProtocol
+  (topic [_] topic))
+
+; a message representing a "fresh" signal value
 (defrecord Fresh
   [value]
-  Message
+  BoxedValueProtocol
+  (value [_] value)
+  MessageProtocol
   (fresh? [_] true))

-; a box for a "cached" value
+; a message representing a "cached" signal value
 (defrecord Cached
   [value]
-  Message
+  BoxedValueProtocol
+  (value [_] value)
+  MessageProtocol
   (fresh? [_] false))

 (defprotocol SignalProtocol
@@ -63,7 +77,7 @@
      :relayed-event-topics topics
      :msg-fn (fn [prev [event]]
                (when (contains? topics (:topic event))
-                 (->Fresh (:value event))))}))
+                 (->Fresh (value event))))}))

 (defrecord Signal
   [init message-emitter deps event-sources]
@@ -144,7 +158,7 @@
   be used as a fallback, and then two more values will be dropped before fresh
   values start being emitted."
   [xform base sig]
-  (let [reducer ((comp (core/map :value)
+  (let [reducer ((comp (core/map value)
                        xform
                        (core/map ->Fresh))
                  conj)
@@ -154,7 +168,7 @@
         pipelined-init-msg (->> (:init sig) ->Fresh vector (msg-fn nil) last)
         init-val (if (nil? pipelined-init-msg)
                    base
-                   (:value pipelined-init-msg))]
+                   (value pipelined-init-msg))]
     (map->Signal {:init init-val
                   :message-emitter {:sources [sig]
                                     :msg-fn msg-fn}})))
@@ -168,11 +182,11 @@
     (let [sources (vec sources)
           emit-message (fn [prev messages]
                          (when (some fresh? messages)
-                           (->Fresh (apply f (mapv :value messages)))))]
+                           (->Fresh (apply f (mapv value messages)))))]
       (map->Signal {:init (->> sources
                                (mapv (comp ->Fresh :init))
                                (emit-message nil)
-                               :value)
+                               value)
                     :message-emitter {:sources sources
                                       :msg-fn emit-message}}))))

@@ -203,25 +217,8 @@
                 :message-emitter {:sources [source]
                                   :msg-fn (fn [acc [message]]
                                             (when (fresh? message)
-                                              (->Fresh (f (:value message)
-                                                          (:value acc)))))}}))
-
-(defn reducep
-  "Create a past-dependent signal like `foldp`, but calls `f` with the arguments
-  reversed to align with Clojure's `reduce`: the first argument is the accumulator,
-  and the second is the current value of `source`. If `init` is omitted, the initial
-  value of the new signal will be obtained by calling `f` with no arguments."
-  ([f source] (reducep f (f) source))
-  ([f init source]
-   (->> source
-        (foldp (fn [val acc] (f acc val)) init)
-        drop-repeats)))
-
-(defn transducep
-  "Like `reducep`, but transforms the reducing function `f` with transducer `xform`."
-  ([xform f source] (reducep (xform f) (f) source))
-  ([xform f init source]
-   (reducep (xform f) init source)))
+                                              (->Fresh (f (value message)
+                                                          (value acc)))))}}))

 (defn drop-repeats
   "Returns a signal which relays values of `sig`, but drops repeated equal values."
@@ -230,8 +227,27 @@
                 :message-emitter {:sources [sig]
                                   :msg-fn (fn [prev [msg]]
                                             (when (and (fresh? msg)
-                                                       (not= (:value msg) (:value prev)))
+                                                       (not= (value msg) (value prev)))
                                               msg))}}))
+
+(defn reducep
+  "Create a past-dependent signal like `foldp`, with a few differences:
+    * calls `f` with the arguments reversed to align with Clojure's `reduce`:
+    the first argument is the accumulator, the second is the current value of `source`.
+    * if `init` is omitted, the initial value of the new signal will be obtained by
+    calling `f` with no arguments.
+    * successive equal values of the returned signal are dropped with `drop-repeats`"
+  ([f source] (reducep f (f) source))
+  ([f init source]
+   (->> source
+        (foldp (fn [val acc] (f acc val)) init)
+        drop-repeats)))
+
+(defn transducep
+  "Like `reducep`, but transforms the reducing function `f` with transducer `xform`."
+  ([xform f source] (reducep (xform f) (f) source))
+  ([xform f init source]
+   (reducep (xform f) init source)))

 (defn async
   "Returns an \"asynchronous\" version of `source`, splitting off a new subgraph which
@@ -244,7 +260,7 @@
         msgs->events (comp cat
                            (filter fresh?)
                            (core/map (fn [msg]
-                                       (->Event topic (:value msg)))))
+                                       (->Event topic (value msg)))))
         events-channel-fn (fn [live-graph _]
                             (async/tap (get (:mult-map live-graph) source)
                                        (chan 1 msgs->events)))]
@@ -289,7 +305,7 @@
                 :message-emitter {:sources [sampler-sig value-sig]
                                   :msg-fn (fn [prev [sampler-msg value-msg]]
                                             (when (fresh? sampler-msg)
-                                              (->Fresh (:value value-msg))))}}))
+                                              (->Fresh (value value-msg))))}}))

 (defn count
   "Returns a signal whose values are the number of fresh values emitted so far from
@@ -320,8 +336,8 @@
                 :message-emitter {:sources [sig]
                                   :msg-fn (fn [prev [msg]]
                                             (when (and (fresh? msg)
-                                                       (pred (:value msg)))
-                                              (->Fresh (:value msg))))}}))
+                                                       (pred (value msg)))
+                                              (->Fresh (value msg))))}}))

 (defn drop-if
   "Like `keep-if`, but drops values which match the predicate."
@@ -353,7 +369,7 @@
   fresh-values
   (comp cat
         (filter fresh?)
-        (core/map :value)))
+        (core/map value)))

 ; compiling graphs:

@@ -429,7 +445,7 @@
     msg-batches
     (let [max-count (reduce max (core/map core/count msg-batches))
           pad (fn [msgs]
-                (->> [msgs (-> msgs last :value ->Cached repeat)]
+                (->> [msgs (-> msgs last value ->Cached repeat)]
                      (into [] (comp cat (take max-count)))))]
       (core/map pad msg-batches))))

@@ -455,7 +471,7 @@
                                (reductions msg-fn prev)
                                (into [] (comp cat (drop 1))))]
         (if (empty? output-series)
-          [(->Cached (:value prev))]
+          [(->Cached (value prev))]
           output-series)))))

 ; wiring up channels:


Skynet - virus solved and somewhat simplified

--- src/clojureplayground/codingame_helper.clj
+++ src/clojureplayground/codingame_helper.clj
@@ -42,32 +42,33 @@

 (def s->i #(Integer/parseInt %))
 (def spws #(clojure.string/split % #"\s"))
-(defn find-node-by [aloc f]
+(defn find-node-by [aloc pred]
   (fn [node]
-    (let [{:keys [from to severed] :as n} node]
-      (f n from to severed aloc))))
+    (let [{:keys [f t] :as n} node]
+      (pred n aloc f t))))
 (defn node-to-cut [aloc links egs]
-  (if-let [fc (some (find-node-by aloc #(when (and (= %2 %5) (egs %3) (false? %4))
-                                         %)) links)]
+  (if-let [fc (some (find-node-by aloc #(when (or
+                                                (and (= %2 %3) (egs %4))
+                                                (and (= %2 %4) (egs %3))) %)) links)]
     fc
-    (first (filter #(let [{:keys [f t severed]} %]
-                     (and (or (egs f) (egs t)) (false? severed))) links))))
-
-(let [[_ L E] (map s->i (spws (read-line)))
-      [links egws] (split-at (* 2 L) (mapcat #(map s->i (spws %)) (repeatedly (+ E L) read-line)))
-      lks (vec
-            (map-indexed
-              #(let [[from to] %2]
-                {:i % :f from :t to :severed false})
-              (partition 2 links)))
-      egs (set egws)]
-  (loop [lks0 lks]
-    (let [SI (read) {:keys [i f t]} (node-to-cut SI lks0 egs)]
-      (println f t)
-      (recur (update-in lks0 [i :severed] #(identity %2) true)))))
+    (first (filter (find-node-by aloc #(or (egs %4) (egs %3))) links))))
+(defn skynet-virus [& args]
+  (let [[_ L E] (map s->i (spws (read-line)))
+        [links egws] (split-at (* 2 L) (mapcat #(map s->i (spws %)) (repeatedly (+ E L) read-line)))
+        lks (vec
+              (map-indexed
+                #(let [[from to] %2]
+                  {:i % :f from :t to})
+                (partition 2 links)))
+        egs (set egws)]
+    (reduce (fn [ls si]
+              (let [{:keys [i f t]} (node-to-cut si ls egs)]
+                (println f t)ls))
+            lks
+            (repeatedly read))))

 ;(println (mapcat #(clojure.string/split % #"\s") (repeatedly 3 read-line)))
-[{:i 0, :f 11, :t 6, :severed false}
+#_[{:i 0, :f 11, :t 6, :severed false}
  {:i 1, :f 0, :t 9, :severed false}
  {:i 2, :f 1, :t 2, :severed false}
  {:i 3, :f 0, :t 1, :severed false}


(PDB-762) Fix broken export

(PDB-762) Fix broken export

This pull request fixes a malformed post-assertion in the events-for-report-hash
function that caused exports to fail on unchanged reports. Inserting proper
parentheses made it apparent that a seq, rather than a vector, should be the
expected return type.

--- src/com/puppetlabs/puppetdb/cli/export.clj
+++ src/com/puppetlabs/puppetdb/cli/export.clj
@@ -118,12 +118,12 @@
      {:pre  [(string? host)
              (integer? port)
              (string? report-hash)]
-      :post [vector? %]}
-     (when-let [body (parse-response
-                      (client/get
-                       (format
-                        "http://%s:%s/%s/events?query=%s"
-                        host port (name version) (url-encode (format "[\"=\",\"report\",\"%s\"]" report-hash)))))]
+      :post [(seq? %)]}
+     (let [body (parse-response
+                  (client/get
+                    (format
+                      "http://%s:%s/%s/events?query=%s"
+                      host port (name version) (url-encode (format "[\"=\",\"report\",\"%s\"]" report-hash)))))]
        (sort-by
         #(mapv % [:timestamp :resource-type :resource-title :property])
         (map


Message queue: expand worker `try` block to cover loop control for extra safety

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -308,8 +308,8 @@
             qk (partial qkey qname)
             start-polling-loop!
             (fn []
-              (while @running?
-                (try
+              (try
+                (while @running?
                   (let [[poll-reply ndruns mid-circle-size]
                         (wcar conn (dequeue qname opts)
                                    (car/get  (qk :ndry-runs))
@@ -323,9 +323,8 @@
                       (Thread/sleep (max (wcar conn (car/pttl (qk :eoq-backoff?)))
                                          10))
                       (handle1 conn qname handler poll-reply)))
-
-                  (catch Throwable t (timbre/fatalf t "Worker error!") (throw t)))
-                (when throttle-ms (Thread/sleep throttle-ms))))]
+                  (when throttle-ms (Thread/sleep throttle-ms)))
+                (catch Throwable t (timbre/fatalf t "Worker error!") (throw t))))]
         (dorun (repeatedly nthreads (fn [] (future (start-polling-loop!))))))
       true)))


Adding parsing UUIDs from backend as cljs/uuid

The change is required for compatibility with Prismatic/Schema

--- src/untangled/client/impl/network.cljs
+++ src/untangled/client/impl/network.cljs
@@ -25,7 +25,9 @@
   (response-error [this xhrio err-cb] "Called by XhrIo on ERROR"))

 (defn parse-response [xhr-io]
-  (ct/read (t/reader {:handlers {"f" (fn [v] (js/parseFloat v))}}) (.getResponseText xhr-io)))
+  (ct/read (t/reader {:handlers {"f" (fn [v] (js/parseFloat v))
+                                 "u" cljs.core/uuid}})
+           (.getResponseText xhr-io)))

 (defrecord Network [url request-transform global-error-callback complete-app]
   IXhrIOCallbacks


Add missing vendor field.

Add missing vendor field.

--- src/fhofherr/clj_db_util/core/database.clj
+++ src/fhofherr/clj_db_util/core/database.clj
@@ -6,6 +6,7 @@
 (defrecord Database [^DataSource datasource
                      ^String db-resource-path
                      ^String schema
+                     ^String vendor
                      ^Flyway migrator])

 (alter-meta! #'->Database assoc :no-doc true)