use keyspace at connect-time

use keyspace at connect-time

--- src/org/spootnik/cyanite/store.clj
+++ src/org/spootnik/cyanite/store.clj
@@ -130,14 +130,10 @@
     :or   {hints {:replication {:class "SimpleStrategy"
                                 :replication_factor 1}}}}]
   (info "creating cassandra metric store with in-memory path index")
-  (let [session (-> (alia/cluster cluster) (alia/connect))
+  (let [session (-> (alia/cluster cluster) (alia/connect keyspace))
         index   (search/memory-index)
         insert! (insertq session)
         fetch!  (fetchq session)]
-
-    (try (alia/execute session (useq keyspace))
-         (catch Exception e
-           (error e "could not connect to cassandra cluster")))

     (reify
       Metricstore


Spacing

Spacing

--- src/midje/checking/checkables.clj
+++ src/midje/checking/checkables.clj
@@ -30,19 +30,19 @@
 (defn- check-for-match [actual checkable-map]
   (let [expected      (:expected-result checkable-map)
         delayed-check (delay (evaluate-checking-function expected actual))]
-    (cond  (extended-= actual expected delayed-check)
-           (emit/pass)
+    (cond (extended-= actual expected delayed-check)
+          (emit/pass)

-           (has-function-checker? checkable-map)
-           (emit/fail (merge (minimal-failure-map :actual-result-did-not-match-checker
-                                                  actual checkable-map)
-                             ;; TODO: It is very lame that the
-                             ;; result-function has to be called again to
-                             ;; retrieve information that extended-=
-                             ;; knows and threw away. But it's surprisingly
-                             ;; difficult to use evaluate-checking-function
-                             ;; at the top of the cond
-                             (second @delayed-check)))
+          (has-function-checker? checkable-map)
+          (emit/fail (merge (minimal-failure-map :actual-result-did-not-match-checker
+                                                 actual checkable-map)
+                            ;; TODO: It is very lame that the
+                            ;; result-function has to be called again to
+                            ;; retrieve information that extended-=
+                            ;; knows and threw away. But it's surprisingly
+                            ;; difficult to use evaluate-checking-function
+                            ;; at the top of the cond
+                            (second @delayed-check)))

           (inherently-false-map-to-record-comparison? actual expected)
           (emit/fail (merge (minimal-failure-map :actual-result-did-not-match-expected-value actual checkable-map)


Remove hard requirement on Datomic

Remove hard requirement on Datomic

--- src/provisdom/spectomic/specs.cljc
+++ src/provisdom/spectomic/specs.cljc
@@ -18,7 +18,7 @@
     (s/or
       #?@(:clj [:dbid #(instance? datomic.db.DbId %)])
       :string (s/and string? #(not (str/starts-with? % ":"))))
-    (fn [] (gen/return (datomic.api/tempid :db.part/db)))))
+    (fn [] (gen/return ((resolve 'datomic.api/tempid) :db.part/db)))))

 (s/def :db/id
   (s/or


small organization thing.

small organization thing.

--- src/metabase/driver/generic_sql.clj
+++ src/metabase/driver/generic_sql.clj
@@ -314,10 +314,10 @@
            'metabase.driver.generic-sql.query-processor)
   (merge driver/IDriverDefaultsMixin
          {:analyze-table             analyze-table
+          :can-connect?              can-connect?
           :describe-database         describe-database
           :describe-table            describe-table
           :describe-table-fks        describe-table-fks
-          :can-connect?              can-connect?
           :features                  features
           :field-avg-length          field-avg-length
           :field-percent-urls        field-percent-urls


print ns headings that can be copied to terminal to run test on only that namespace

--- bake/bake/test.clj
+++ bake/bake/test.clj
@@ -41,7 +41,8 @@
           each-fixtures (join-fixtures (:clojure.test/each-fixtures ns-meta))]
       (binding [*test-out* (StringWriter.)
                 *report-counters* (ref *initial-report-counters*)]
-        (report {:type :begin-test-ns :ns ns})
+        (with-test-out
+          (println "\ncake test" (ns-name ns)))
         (once-fixtures
          (fn []
            (doseq [[name f] tests]


Missing bracket in default instance generator.

--- builder/src/builder/parser.clj
+++ builder/src/builder/parser.clj
@@ -48,7 +48,7 @@
         (if-let [methods (->> (get-static-methods clazz #"getDefault.*")
                               (filter #(= 0 (count (.getParameterTypes %)))))]
           (str s (join "" (map (fn [m]
-                               (format "(defn %s-%s [] (%s/%s)\r\n"
+                               (format "(defn %s-%s [] (%s/%s))\r\n"
                                        (-> (.getSimpleName clazz)
                                            (->kebab-case))
                                        (-> (.getName m)


You can push blocks and win

You can push blocks and win

--- src/sojoban/core.cljs
+++ src/sojoban/core.cljs
@@ -61,11 +61,36 @@
                (not (move-cell :wall)))
       (if-not (move-cell :block)
         (move-from board :player start-loc move-loc)
-        nil ; fixme - test block push
-        )
-      )
-    )
-  )
+
+        ; we have to push a block
+        (when (and push-cell
+                   (not (push-cell :wall))
+                   (not (push-cell :block)))
+          (-> board
+              (move-from :block move-loc push-loc)
+              (move-from :player start-loc move-loc)))))))
+
+(defn board-won? [board]
+  (->> board
+       flatten
+       (filter #(and (get % :goal)
+                     (not (get % :block))))
+       first
+       not))
+
+(defn process-move [{:keys [board won num-moves]
+                     :or {won false, num-moves 0}
+                     :as state}
+                    dir]
+  (if won
+    state  ; Don't accept moves once the level is done.
+    (if-let [new-board (try-move board dir)]
+      (assoc state :board new-board
+                   :num-moves (inc num-moves)
+                   :won (board-won? new-board))
+
+      ; Move failed; return unchanged state.
+      state)))

 (def keycode->dir
   {38 :up
@@ -76,8 +101,11 @@
 (def state (atom {:board (yoshio-levels 0)}))

 (defn process-keydown [ev]
-  (when-let [dir (keycode->dir (.-keyCode ev))]
-    (swap! state update-in [:board] #(or (try-move % dir) %))))
+  (when-not (:won @state)
+    (when-let [dir (keycode->dir (.-keyCode ev))]
+      (swap! state process-move dir)
+      (when (:won @state)
+        (js/alert (str "You win, in " (:num-moves @state) " moves!"))))))

 (defn sojoban-widget [data owner]
   (om/component


Catch exceptions in the scrape task

Catch exceptions in the scrape task

--- src/servisne_info/tasks/scrape.clj
+++ src/servisne_info/tasks/scrape.clj
@@ -1,7 +1,10 @@
 (ns servisne-info.tasks.scrape
-  (:use servisne-info.utils
+  (:use [raven-clj.core :only [capture]]
+        [raven-clj.interfaces :only [stacktrace]]
+        servisne-info.utils
         [servisne-info.scrape.common :only [html-resource]])
-  (:require [servisne-info.repository :as repo]
+  (:require [environ.core :refer [env]]
+            [servisne-info.repository :as repo]
             [servisne-info.scrape.ns-rs :as ns-scraper]))

 ; Private
@@ -32,6 +35,12 @@
        (save-news)))

 (defn -main [& args]
-  (repo/db-connect)
-  (println "Scraping new links, count='" (save-links) "'")
-  (repo/db-disconnect))
+  (try
+    (do
+      (repo/db-connect)
+      (println "Scraping new links, count='" (save-links) "'")
+      (repo/db-disconnect))
+    (catch Exception e
+      (capture (env :sentry-dsn)
+               (-> {:message (.getMessage e)}
+                   (stacktrace e))))))


comments and logging

comments and logging

--- src/babel/italiano/writer.clj
+++ src/babel/italiano/writer.clj
@@ -47,12 +47,13 @@
                        (get root-verbs key))
                      (sort (keys root-verbs))))]

+    ;; TODO: lexicon-writing should be moved out of (defn tutti []).
     (write-lexicon "it" lexicon)
     (log/info (str "done writing lexicon."))
     (log/info (str "generating examples with this many verbs:"
                    (.size tutti)))
     (.size (pmap (fn [verb]
-                   (log/debug (str "verb: " (strip-refs verb)))
+                   (log/debug (str "tutti: verb: " (strip-refs verb)))
                    (let [root-form (get-in verb [:italiano :italiano])]
                      (generate-one-verb (unify
                                          {:synsem {:sem


clearing let in the mean time

clearing let in the mean time

--- src/supernal/demo.clj
+++ src/supernal/demo.clj
@@ -7,14 +7,13 @@

 (env
   {:roles
-   {:web #{ {:host "localhost" :user "ronen"}
+    {:web #{{:host "localhost" :user "ronen"}
             {:host "192.168.5.9" :user "vagrant"}}}})

 (ns- deploy
   (task update-code
-     (let [war-url "http://..."]
        (debug "updating code on" remote)
-       #_(copy war-url "/tmp")))
+       (copy "http://dl.bintray.com/content/narkisr/boxes/redis-sandbox-0.3.4.tar.gz" "/tmp"))

   (task start
     (debug "starting service on" remote)


Distribution counts

Distribution counts

--- src/tango/domain.cljc
+++ src/tango/domain.cljc
@@ -35,4 +35,35 @@
    :activity/id id
    :activity/position position
    :activity/source-id source-id
-   :activity/time time})+   :activity/time time})
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Utils
+
+(defn distrubution-counts [c n]
+  (let [m (int (/ c n))
+        k (mod c n)
+        big-counts (repeat k (inc m))
+        small-counts (repeat (- n k) m)]
+    (vec (concat big-counts small-counts))
+    )
+  )
+
+(defn distrubution-counts [coll n]
+  ;; Distributes the elements in n vectors as evenly as possible
+  ;; Each vector will have m or m+1 elements, where m is (/ (count coll n))
+  ;; The order of the elements is preserved in each group.
+  (let [c (count coll)
+        m (int (/ c n))
+        k (mod c n)
+        big-counts (repeat k (inc m))
+        small-counts (repeat (- n k) m)]
+    (vec (concat big-counts small-counts))
+    )
+  )
+
+(int (/ 8 3))
+(mod 8 3)
+
+(distrubute [1 2 3 4 5 6 7 8] 3)
+(distrubute [1 2 3 4 5 6 7 8] 3)


Add note on protocol arg coercion timing

--- src/taoensso/carmine/protocol.clj
+++ src/taoensso/carmine/protocol.clj
@@ -21,6 +21,13 @@
 ;;   will actually be sent to server as pipeline.
 ;; * For non-listener modes, corresponding replies will then immediately be
 ;;   received, parsed, + returned.
+
+;;; TODO
+;; * Arg coercion could (& probably should) be done during request enqueuing
+;;   rather than as part of the final send job. This'd enable non-String key
+;;   Cluster slot hashing, and would allow command-wrapped thread-local
+;;   bindings to control coercion (sensible per-command Nippy control, for
+;;   example).

 ;;;; Dynamic context stuff


Housekeeping, small `send-request` perf. tweak

--- src/taoensso/carmine/protocol.clj
+++ src/taoensso/carmine/protocol.clj
@@ -72,12 +72,12 @@
                    :else                        :serialized)

         ^bytes ba (case type
-                    :string  (bytestring arg)
-                    :keyword (bytestring (name arg))
+                    :string        (bytestring arg)
+                    :keyword       (bytestring (name arg))
                     :simple-number (bytestring (str arg))
                     :bytes arg
-                    :preserved  (nippy/freeze-to-bytes (.value ^Preserved arg))
-                    :serialized (nippy/freeze-to-bytes arg))
+                    :preserved   (nippy/freeze-to-bytes (.value ^Preserved arg))
+                    :serialized  (nippy/freeze-to-bytes arg))

         payload-size (alength ba)
         marked-type? (not (or (= type :string) (= type :simple-number)))
@@ -101,7 +101,7 @@
   "Sends a command to Redis server using its byte string protocol:

       *<no. of args>     crlf
-      [ $<size of arg N> crlf
+      [$<size of arg N>  crlf
         <arg data>       crlf ...]"
   [& args]
   (let [^BufferedOutputStream out (or (:out-stream *context*)
@@ -111,7 +111,7 @@
     (.write out (bytestring (str (count args))))
     (send-crlf out)

-    (dorun (map (partial send-arg out) args))
+    (doseq [arg args] (send-arg out arg))
     (.flush out)

     (when-let [pq (:parser-queue *context*)] (swap! pq conj *parser*))))
@@ -122,8 +122,8 @@
   "BLOCKS to receive a single reply from Redis server. Applies basic parsing
   and returns the result.

-  Redis will reply to commands with different kinds of replies. It is possible
-  to check the kind of reply from the first byte sent by the server:
+  Redis will reply to commands with different kinds of replies, identified by
+  their first byte:
       * `+` for single line reply.
       * `-` for error message.
       * `:` for integer reply.


logging

logging

--- src/celestial/persistency.clj
+++ src/celestial/persistency.clj
@@ -78,6 +78,7 @@
   "Resets admin password if non is defined"
   []
   (when (empty? (get-user "admin"))
+    (info "Reseting admin password")
     (add-user {:username "admin" :password (creds/hash-bcrypt "changeme") :roles admin :envs [:dev]})))

 (defn curr-user []


Removed dupe of canone alla quarta.

Removed dupe of canone alla quarta.

--- src/overtunes/songs/variatio_12.clj
+++ src/overtunes/songs/variatio_12.clj
@@ -1,45 +0,0 @@
-(ns overtunes.songs.variatio-12
-  (:use
-    [overtone.live :only [at now]]
-    [overtone.inst.sampled-piano :only [sampled-piano] :rename {sampled-piano piano}]))
-
-(defn sum-n [series n] (reduce + (take n series)))
-(defn scale [intervals]
-  #(if (neg? %)
-     (let [downward-scale (comp - (scale (reverse intervals)))]
-       (-> % - downward-scale))
-     (sum-n (cycle intervals) %)))
-
-(defn translate [f x y] #(-> % (+ x) f (+ y)))
-(def major (scale [2 2 1 2 2 2 1]))
-(defn modulate [scale mode] (translate scale mode (- (scale mode))))
-(def g-major (translate major 0 74))
-(def scales (repeat g-major))
-
-(defn bpm [per-minute] #(-> % (/ per-minute) (* 60) (* 1000)))
-(defn syncopate [timing durations] #(->> % (sum-n durations) timing))
-(defn run [a b]
-  (if (<= a b)
-    (range a (inc b))
-    (reverse (run b a))))
-
-(def durations (flatten [(repeat 2 1/4) 1/2 (repeat 6 1/4) (repeat 8 1/4) 3/2 (repeat 10 1/4) 1/2 (repeat 2 1/4) 9/4 3/4 (repeat 12 1/4) 1/2 1 1/2 (repeat 12 1/4) 1]))
-(def pitches (flatten [0 (run -1 3) (run 2 0) 4 (run 1 8) (run 7 -1) 0 (run 0 -3) 4 4 (run 2 -3) -1 1 (run 4 6) 1 1 1 2 -1 -2 0 1 -1 -2 (run 5 0)]))
-(def bass (map #(- % 7) (flatten (map #(repeat 3 %) (concat (run 0 -3) (run -5 -3) [-7])))))
-
-(defn melody# [timing notes]
-  (let [note# #(at (timing %1) (piano ((nth scales %1) %2)))]
-    (dorun (map-indexed note# notes))))
-
-(defn play# []
-  (let [timing (-> (bpm 90) (translate 0 (now)))
-        rhythm-from #(syncopate (translate timing % 0) durations)
-        leader pitches
-        follower (->> leader (map -) (map #(- % 4)))]
-    (melody# timing bass)
-    (melody# (rhythm-from 1/2) leader)
-    (melody# (rhythm-from 7/2) follower)
-    (melody# (syncopate (translate timing 23 0) [1 1/4 1/4 1/4 1/4 1]) [-7 -7 -5 -3 -1 0])
-    ))
-
-(play#)


require aspire.model

require aspire.model

--- src/client/aspire/client.cljs
+++ src/client/aspire/client.cljs
@@ -6,17 +6,14 @@
             [dommy.core :as dommy]
             [dommy.attrs :as d-attrs]
             [goog.string :as gstring]
-            [goog.string.format :as gformat])
+            [goog.string.format :as gformat]
+            [aspire.model :as a-mdl]
+            )
   (:use-macros
    [dommy.macros :only [by-id sel1]]))

 (repl/connect "http://localhost:9000/repl")
 (def api-uri "http://localhost:4001/api")
-
-;; For now, we'll store app state in one atom.
-(def appstate (atom {:loading true}))
-(defn appstate-update! [f & args]
-  (apply swap! appstate f args))

 ;; Callbacks
 ;; --------------------------------------------------


Only use the label "Buchtipps" for Braille

in all other cases we only have one recommendation and hence the label
should be "Buchtipp" (singular)

--- src/clj/catalog/web/views.clj
+++ src/clj/catalog/web/views.clj
@@ -354,7 +354,8 @@
                         :data-hidden-buttons "cmdImage cmdCode"
                         :data-resize "vertical" :rows 30} "editorial" editorial)]
       [:div.form-group
-       (form/label "recommended" "Buchtipps:")
+       ;; all formats except for braille have only one recommendation
+       (form/label "recommended" (if (#{"braille"} fmt) "Buchtipps:" "Buchtipp:"))
        (form/text-area {:class "form-control" :data-provide "markdown"
                         :data-hidden-buttons "cmdImage cmdCode"
                         :data-resize "vertical" :rows 30} "recommended" recommendation)]


If no sysdb, don't start up the solver

If no sysdb, don't start up the solver

--- src/clj/herder/solver/run.clj
+++ src/clj/herder/solver/run.clj
@@ -95,7 +95,7 @@
       (reset! (-> system :solver :watch) :solve-watch)))
   (swap! (-> system :solver :tosolve) conj id))

-(let [sys-db (-> system :db :connection)]
+(if-let [sys-db (-> system :db :connection)]
   (kd/with-db sys-db
     (doseq [conv (d/select db/conventions)]
       (needs-solve (:id conv)))))


Use CLJ metrics

Use CLJ metrics

--- src/clojure/fault/service.clj
+++ src/clojure/fault/service.clj
@@ -44,5 +44,5 @@
 (defn service-executor [pool-size]
   (let [executor (ServiceExecutor. pool-size)]
     {:service executor
-     :metrics (.getActionMetrics executor)
+     :metrics (->CLJMetrics (.getActionMetrics executor))
      :circuit-breaker (->CLJBreaker (.getCircuitBreaker executor))}))


Don't try to close invalid file paths

Don't try to close invalid file paths

--- src/clojure/nightmod/core.clj
+++ src/clojure/nightmod/core.clj
@@ -86,7 +86,9 @@
           ; R
           82 (do (screens/restart!) true)
           ; W
-          87 (editors/close-selected-editor!)
+          87 (if (some-> @ui/tree-selection io/file .exists)
+               (editors/close-selected-editor!)
+               false)
           ; else
           false)))
     ; create the window


Remove screen validity check because it is done in play-clj now

--- src/clojure/nightmod/game.clj
+++ src/clojure/nightmod/game.clj
@@ -22,12 +22,6 @@
            ; clean up
            (asset-manager! manager/manager :clear)
            (stop-timers!)
-           ; make sure the game screens are valid
-           (doseq [screen game-screens
-                   required-key [:show :render :hide :pause :resize :resume]]
-             (when (or (not (map? screen))
-                       (not (contains? screen required-key)))
-               (throw (Exception. "Invalid screen given to set-game-screen!"))))
            ; set the supplied screen(s) with the overlay screen added at the end
            (apply set-screen!
                   screens/nightmod


Make sure screens are valid before setting them

--- src/clojure/nightmod/game.clj
+++ src/clojure/nightmod/game.clj
@@ -22,6 +22,11 @@
            ; clean up
            (asset-manager! manager/manager :clear)
            (stop-timers!)
+           ; make sure the game screens are valid
+           (doseq [screen game-screens
+                   required-key [:show :render :hide :pause :resize :resume]]
+             (when-not (contains? screen required-key)
+               (throw (Exception. "Invalid screen given to set-game-screen!"))))
            ; set the supplied screen(s) with the overlay screen added at the end
            (apply set-screen!
                   screens/nightmod


fix indentation on subtract fn

fix indentation on subtract fn

--- src/clojure/sparkling/api.clj
+++ src/clojure/sparkling/api.clj
@@ -149,7 +149,7 @@
 (defn subtract
   "Removes all elements from rdd1 that are present in rdd2."
   [rdd1 rdd2]
-   (sc/subtract rdd1 rdd2))
+  (sc/subtract rdd1 rdd2))

 (defn group-by
   "Returns an RDD of items grouped by the return value of function `f`."


sdmx prefixers

sdmx prefixers

--- src/grafter/rdf/ontologies/sdmx_attribute.clj
+++ src/grafter/rdf/ontologies/sdmx_attribute.clj
@@ -4,3 +4,4 @@
 (def sdmx-attribute (prefixer "http://purl.org/linked-data/sdmx/2009/attribute#"))

 (def sdmx-attribute:statUnit (sdmx-attribute "statUnit"))
+(def sdmx-attribute:unitMeasure (sdmx-attribute "unitMeasure"))


close script element

close script element

--- src/nodecljs/server/core.cljs
+++ src/nodecljs/server/core.cljs
@@ -18,8 +18,8 @@
            (string/join "\n")
            (#(string/join "\n" ["<!DOCTYPE html>"
                                 "<title>Jokes</title>"
-                                "" %
-                                ""]))
            (.send res)))))

 (defn server [handler port cb]


Revert "Coordinator improvements WIP"

Revert "Coordinator improvements WIP"

--- src/onyx/peer/coordinator.clj
+++ src/onyx/peer/coordinator.clj
@@ -23,8 +23,6 @@
   (:import [org.apache.zookeeper KeeperException$BadVersionException]
            [java.util.concurrent.locks LockSupport]))

-(def coordinator-log (atom []))
-
 (defn input-publications [{:keys [peer-sites message-short-ids] :as replica} peer-id job-id]
   (let [allocations (get-in replica [:allocations job-id])
         input-tasks (get-in replica [:input-tasks job-id])
@@ -52,11 +50,10 @@

 (defn offer-heartbeats
   [{:keys [messenger] :as state}]
-  (swap! coordinator-log conj :offer-heartbeats)
   (run! pub/offer-heartbeat! (m/publishers messenger))
   (assoc state :last-heartbeat-time (System/nanoTime)))

-(def coordinator-backoff-ms 500)
+(def coordinator-backoff-ms 1)

 (defn offer-barriers [{:keys [messenger barrier] :as state}]
   (if (:offering? barrier)
@@ -82,38 +79,36 @@
          (throw (Exception. "Coordinator failed to write coordinates.
                              This is likely due to the coordinator being quarantined, and another coordinator taking over.")))))

-
 (defn next-replica
   [{:keys [log job-id peer-id messenger curr-replica tenancy-id] :as state}
    barrier-period-ns
    new-replica]
-  (swap! coordinator-log conj :next-replica)
   (let [curr-version (get-in curr-replica [:allocation-version job-id])
         new-version (get-in new-replica [:allocation-version job-id])
-        job-reallocated? (not= curr-version new-version)]
-    (if job-reallocated?
-      (let [new-messenger (-> messenger
-                              (m/update-publishers (input-publications new-replica peer-id job-id))
-                              (m/set-replica-version! new-version)
-                              (m/set-epoch! 0))
-            coordinates (read-checkpoint-coordinate log tenancy-id job-id)]
-        (-> state
-            (update :job merge {:completed? false
-                                :sealing? false})
-            (update :barrier merge {:scheduled? false
-                                    :offering? true
-                                    :remaining (m/publishers new-messenger)
-                                    :opts {:recover-coordinates coordinates}})
-            (update :checkpoint merge {:initiated? false
-                                       :epoch 0})
-            (assoc :messenger new-messenger)
-            (assoc :curr-replica new-replica)))
-      (assoc state :curr-replica new-replica))))
+        reallocated? (not= curr-version new-version)]
+    (cond reallocated?
+          (let [new-messenger (-> messenger
+                                  (m/update-publishers (input-publications new-replica peer-id job-id))
+                                  (m/set-replica-version! new-version)
+                                  (m/set-epoch! 0))
+                coordinates (read-checkpoint-coordinate log tenancy-id job-id)]
+            (-> state
+                (update :job merge {:completed? false
+                                    :sealing? false})
+                (update :barrier merge {:scheduled? false
+                                        :offering? true
+                                        :remaining (m/publishers new-messenger)
+                                        :opts {:recover-coordinates coordinates}})
+                (update :checkpoint merge {:epoch 0})
+                (assoc :messenger new-messenger)
+                (assoc :curr-replica new-replica)))
+
+          :else
+          (assoc state :curr-replica new-replica))))

 (defn complete-job
   [{:keys [tenancy-id log job-id messenger checkpoint group-ch] :as state}]
   (info (format "Job %s completed, and final checkpoint has finished. Writing checkpoint coordinates." job-id))
-  (swap! coordinator-log conj :complete-job)
   (let [replica-version (m/replica-version messenger)
         epoch (m/epoch messenger)]
     (let [coordinates {:tenancy-id tenancy-id
@@ -136,7 +131,6 @@

 (defn periodic-barrier
   [{:keys [tenancy-id workflow-depth log curr-replica job-id messenger barrier checkpoint] :as state}]
-  (swap! coordinator-log conj :periodic-barrier)
   (if (:offering? barrier)
     ;; No op because hasn't finished emitting last barrier, wait again
     state
@@ -169,8 +163,6 @@
            (>= (:min-epoch status) epoch))))

 (defn completed-checkpoint [{:keys [checkpoint messenger job-id tenancy-id log] :as state}]
-
-  (swap! coordinator-log conj :completed-checkpoint)
   (let [{:keys [epoch write-version]} checkpoint
         write-coordinate? (> epoch 0)
         coordinates {:tenancy-id tenancy-id
@@ -181,13 +173,14 @@
         next-write-version (if write-coordinate?
                              (write-coordinate write-version log tenancy-id job-id coordinates)
                              write-version)]
+
+
     (-> state
         (update :barrier    merge {:scheduled? false})
         (update :checkpoint merge {:initiated? false
                                    :write-version next-write-version}))))

 (defn schedule-next-barrier [state barrier-period-ns]
-  (swap! coordinator-log conj :schedule-next-barrier)
   (update state :barrier merge {:scheduled? true
                                 :next-barrier-time (+ (System/nanoTime) barrier-period-ns)}))


Table sorting reversable fix #24

Table sorting reversable fix #24

--- frontend/src/cruncher/utils/lib.cljs
+++ frontend/src/cruncher/utils/lib.cljs
@@ -22,6 +22,7 @@
 (declare get-pokemon-by-id)
 (declare evolution-sum)

+(defonce sort-direction-asc (atom true))
 ;;;; React compatibility
 (defonce counter (atom 0))

@@ -65,8 +66,8 @@

 (defmethod mutate 'sort/pokemon
   [{:keys [state]} _ {:keys [key]}]
-  {:action (fn [] (swap! state update-in [:pokemon] (fn []
-                                                      (reverse (sort-by (juxt key :individual_percentage :cp) (:pokemon @state))))))})
+  {:action (fn [] (swap! state update-in [:pokemon] (fn [] (cond-> (sort-by (juxt key :individual_percentage :cp) (:pokemon @state))
+                                                      (swap! sort-direction-asc not) reverse))))})

 (defmethod mutate 'change/view
   [{:keys [state]} _ {:keys [view]}]


Temporary namespace for these two keywords

--- fulcro-todo/src/main/app/schema.cljs
+++ fulcro-todo/src/main/app/schema.cljs
@@ -16,8 +16,8 @@
 (spec/def ::items-by-added-at (spec/and map?
                                         (spec/map-of ::added-at ::item)))

-(spec/def :item-list (spec/coll-of ::added-at))
+(spec/def ::item-list (spec/coll-of ::added-at))

 (spec/def :item-adder/input-value string?)

-(spec/def :sort-by-desc-added-at? boolean?)
+(spec/def ::sort-by-desc-added-at? boolean?)


Filter unsanitory characters in event streams

--- src/rill/event_store/atom_store.clj
+++ src/rill/event_store/atom_store.clj
@@ -8,7 +8,8 @@
             [rill.event-store.atom-store.cursor :as cursor]
             [rill.event-store.atom-store.event :as event]
             [rill.event-stream :refer [all-events-stream-id]]
-            [rill.message :as msg]))
+            [rill.message :as msg]
+            [clojure.string :as string]))

 (defn client-opts
@@ -17,18 +18,22 @@
   (if (and user password)
     {:basic-auth [user password]}))

+(defn sanitize-stream-name
+  [stream-id]
+  (string/replace (str stream-id) #"[^a-zA-Z0-9_\-]" "_"))
+
 (deftype AtomStore [uri user password]
   EventStore
   (retrieve-events-since [_ stream-id cursor wait-for-seconds]
     (cursor/event-seq (if (= -1 cursor)
                         (cursor/first-cursor uri (if (= all-events-stream-id stream-id)
                                                    "%24all"
-                                                   stream-id)
+                                                   (sanitize-stream-name stream-id))
                                              (client-opts user password))
                         (cursor/next-cursor cursor))
                       wait-for-seconds))
   (append-events [_ stream-id from-version events]
-    (event/post uri stream-id from-version events (client-opts user password))))
+    (event/post uri (sanitize-stream-name stream-id) from-version events (client-opts user password))))

 (defn atom-event-store
   [uri & [{:keys [user password]}]]


allow global :js-package-dirs

allow global :js-package-dirs

might be something that you want applied to all builds

--- src/main/shadow/cljs/devtools/server/util.clj
+++ src/main/shadow/cljs/devtools/server/util.clj
@@ -77,7 +77,11 @@
         (config/make-cache-dir cache-root build-id mode)

         npm-config
-        (select-keys (:js-options build-config) [:js-package-dirs :node-modules-dir :entry-keys :extensions])
+        (merge
+          ;; global config so it doesn't have to be configured per build
+          (select-keys (:js-options config) [:js-package-dirs :node-modules-dir :entry-keys :extensions])
+          ;; build config supersedes global
+          (select-keys (:js-options build-config) [:js-package-dirs :node-modules-dir :entry-keys :extensions]))

         ;; don't use shared npm instance since lookups are cached and
         ;; js-package-dirs may affect what things resolve to


Safeguard accept-join-cluster: only allow if joiner returned matches

--- src/onyx/log/commands/accept_join_cluster.clj
+++ src/onyx/log/commands/accept_join_cluster.clj
@@ -14,7 +14,7 @@
   (let [{:keys [accepted-joiner accepted-observer]} args
         target (or (get-in replica [:pairs accepted-observer])
                    accepted-observer)
-        accepted? (get-in replica [:accepted accepted-observer])
+        accepted? (= accepted-joiner (get-in replica [:accepted accepted-observer]))
         already-joined? (some #{accepted-joiner} (:peers replica))
         no-observer? (not (some #{target} (:peers replica)))]
     (if (or already-joined? no-observer? (not accepted?))


Remove todo

Remove todo

--- src/yetibot/core/commands/alias.clj
+++ src/yetibot/core/commands/alias.clj
@@ -47,7 +47,6 @@
       (format "Replaced existing alias %s. Was `%s`" cmd-name (:cmd existing-alias))
       (format "%s alias created" cmd-name))))

-;; TODO next: models need a find-first and an update helper
 (defn add-alias [{:keys [cmd-name cmd user-id] :as alias-info}]
   (let [new-alias-map {:user-id user-id :cmd-name cmd-name :cmd cmd}]
     (info "adding alias with" new-alias-map)


Add type hint for Thread invocation

Add type hint for Thread invocation

--- library/src/doo/shell.clj
+++ library/src/doo/shell.clj
@@ -62,7 +62,8 @@
    (set-cleanup! process opts "Shutdown Process"))
   ([process opts msg]
    (.addShutdownHook (Runtime/getRuntime)
-     (Thread. (fn []
+     (Thread. ^Runnable
+              (fn []
                 (println msg)
                 (.destroy process))))))


update records to include namespace

update records to include namespace

--- .desc.clj
+++ .desc.clj
@@ -1,75 +1,93 @@
-[{:name "re-matcher", :desc "creates iterable regex"}
- {:name "binding", :desc "only redefines dynamic vars"}
- {:name "add-classpath",
+[{:name "clojure.core/re-matcher", :desc "creates iterable regex"}
+ {:name "clojure.core/binding", :desc "only redefines dynamic vars"}
+ {:name "clojure.core/add-classpath",
   :desc
   "like adding $:, also see https://github.com/cemerick/pomegranate"}
- {:name "ns-imports", :desc "map of import mappings"}
- {:name "ns-interns", :desc "map of ns mappings"}
- {:name "source", :desc "doesn't work for repl-defined fns"}
- {:name "pr", :desc "print readable by reader"}
- {:name "println-str", :desc "string of println"}
- {:name "with-out-str", :desc "capture *out*"}
- {:name "array-map", :desc "how is usage different than hash-map?"}
- {:name "pop", :desc "Array#slice(0..-2)"}
+ {:name "clojure.core/ns-imports", :desc "map of import mappings"}
+ {:name "clojure.core/ns-interns", :desc "map of ns mappings"}
+ {:name "clojure.repl/source",
+  :desc "doesn't work for repl-defined fns"}
+ {:name "clojure.core/pr", :desc "print readable by reader"}
+ {:name "clojure.core/println-str", :desc "string of println"}
+ {:name "clojure.core/with-out-str", :desc "capture *out*"}
+ {:name "clojure.core/array-map",
+  :desc "how is usage different than hash-map?"}
+ {:name "clojure.core/pop", :desc "Array#slice(0..-2)"}
  {:name "clojure.set/join",
   :desc "joins sets of maps by common key in maps"}
  {:name "clojure.set/project", :desc "slice map keys in arr of maps"}
  {:name "clojure.set/rename-keys", :desc "rename map keys"}
- {:name "complement", :desc "opposite of fn"}
- {:name "butlast", :desc "reverse rest"}
- {:name "doto", :desc "jqueryize"}
- {:name "ancestors", :desc "is derive-aware, while supers is not"}
- {:name "extend-type", :desc "anon include scoped to a namespace"}
- {:name "reify", :desc "creates a protocol obj"}
- {:name "for", :desc "list comprehension, cartesian product"}
- {:name "condp", :desc "generalized case where = fn can be anything"}
- {:name "doseq", :desc "can take multiple args to do nested iteration"}
- {:name "frequencies", :desc "map of # of distinct items in a vec"}
- {:name "ns-map", :desc "symbol to vars"}
- {:name "require",
+ {:name "clojure.core/complement", :desc "opposite of fn"}
+ {:name "clojure.core/butlast", :desc "reverse rest"}
+ {:name "clojure.core/doto", :desc "jqueryize"}
+ {:name "clojure.core/ancestors",
+  :desc "is derive-aware, while supers is not"}
+ {:name "clojure.core/extend-type",
+  :desc "anon include scoped to a namespace"}
+ {:name "clojure.core/reify", :desc "creates a protocol obj"}
+ {:name "clojure.core/for",
+  :desc "list comprehension, cartesian product"}
+ {:name "clojure.core/condp",
+  :desc "generalized case where = fn can be anything"}
+ {:name "clojure.core/doseq",
+  :desc "can take multiple args to do nested iteration"}
+ {:name "clojure.core/frequencies",
+  :desc "map of # of distinct items in a vec"}
+ {:name "clojure.core/ns-map", :desc "symbol to vars"}
+ {:name "clojure.core/require",
   :desc "takes a quoted list b/c it's a fn and not a macro like ns"}
- {:name "apply", :desc "last arg must be a list"}
- {:name "macroexpand-1", :desc "expands once"}
+ {:name "clojure.core/apply", :desc "last arg must be a list"}
+ {:name "clojure.core/macroexpand-1", :desc "expands once"}
  {:name "macroexpand-all", :desc "recursive expand all"}
- {:name "macroexpand", :desc "expands top level macro recursively"}
- {:name "deref", :desc "never blocks"}
- {:name "pmap",
+ {:name "clojure.core/macroexpand",
+  :desc "expands top level macro recursively"}
+ {:name "clojure.core/deref", :desc "never blocks"}
+ {:name "clojure.core/pmap",
   :desc
   "parallel map, if process time is low, chunk up processes using detection-all"}
- {:name "promise", :desc "declaratively set with deliver, blocks"}
- {:name "future",
+ {:name "clojure.core/promise",
+  :desc "declaratively set with deliver, blocks"}
+ {:name "clojure.core/future",
   :desc "Thread.new with cached result + optional timeout"}
- {:name "realized?",
+ {:name "clojure.core/realized?",
   :desc "checks on delays, promises, futures, lazyseqs"}
  {:name "clojure.zip/zipper",
   :desc "[children? children create-branch]"}
- {:name "partition", :desc "similar to enum chunking meth"}
- {:name "with-meta", :desc "replace meta"}
- {:name "vary-meta", :desc "assoc meta"}
- {:name "subseq", :desc "like find but only for keys of sorted dt"}
- {:name "comparator", :desc "converts pred fns to comparable fn"}
- {:name "juxt", :desc "((juxt a b c) x) => [(a x) (b x) (c x)]"}
- {:name "and", :desc "like joining multiple ands"}
- {:name "zipmap", :desc "like zip but produces map"}
- {:name "merge-with",
+ {:name "clojure.core/partition",
+  :desc "similar to enum chunking meth"}
+ {:name "clojure.core/with-meta", :desc "replace meta"}
+ {:name "clojure.core/vary-meta", :desc "assoc meta"}
+ {:name "clojure.core/subseq",
+  :desc "like find but only for keys of sorted dt"}
+ {:name "clojure.core/comparator",
+  :desc "converts pred fns to comparable fn"}
+ {:name "clojure.core/juxt",
+  :desc "((juxt a b c) x) => [(a x) (b x) (c x)]"}
+ {:name "clojure.core/and", :desc "like joining multiple ands"}
+ {:name "clojure.core/zipmap", :desc "like zip but produces map"}
+ {:name "clojure.core/merge-with",
   :desc "merges maps with same keys given a function to merge values"}
- {:name "update-in", :desc "updates value given map, nested keys + fn"}
- {:name "dissoc", :desc "can delete multiple keys"}
- {:name "iterate", :desc "lazy seq of x, f(x), f(f(x))"}
- {:name "list*", :desc "cons for multiple elements"}
- {:name "next",
+ {:name "clojure.core/update-in",
+  :desc "updates value given map, nested keys + fn"}
+ {:name "clojure.core/dissoc", :desc "can delete multiple keys"}
+ {:name "clojure.core/iterate", :desc "lazy seq of x, f(x), f(f(x))"}
+ {:name "clojure.core/list*", :desc "cons for multiple elements"}
+ {:name "clojure.core/next",
   :desc
   "produces nil for empty cases, less lazy as it checks head of nonempty tail"}
- {:name "rest", :desc "produces () for empty cases, max lazy"}
- {:name "conj",
+ {:name "clojure.core/rest",
+  :desc "produces () for empty cases, max lazy"}
+ {:name "clojure.core/conj",
   :desc
   "list + vector adds elements in different places b/c of efficiency"}
- {:name "->", :desc "arg gets inserted as first arg"}
- {:name "->>", :desc "arg gets inserted as last arg"}
- {:name "interpose", :desc "join(a).split(/\\s+/)"}
- {:name "comp", :desc "(comp a b c) = (a (b (c))) = opposite of ->>"}
- {:name "apply", :desc "apply(fn [args]): fn.call(*args)"}
- {:name "partial", :desc "partial(fn *args): #(apply fn *args *&)"}
- {:name "fnil",
+ {:name "clojure.core/->", :desc "arg gets inserted as first arg"}
+ {:name "clojure.core/->>", :desc "arg gets inserted as last arg"}
+ {:name "clojure.core/interpose", :desc "join(a).split(/\\s+/)"}
+ {:name "clojure.core/comp",
+  :desc "(comp a b c) = (a (b (c))) = opposite of ->>"}
+ {:name "clojure.core/apply", :desc "apply(fn [args]): fn.call(*args)"}
+ {:name "clojure.core/partial",
+  :desc "partial(fn *args): #(apply fn *args *&)"}
+ {:name "clojure.core/fnil",
   :desc
   "sets default for a function expecting non-nil args used in clojure prob 2 as (hash[:key] ||= {}) << 2"}]


adding clojure core to default functionality when decoding opts

--- src/template/core.clj
+++ src/template/core.clj
@@ -14,7 +14,7 @@
                     (reduce #(if (nil? %2) %1 (into %1 %2)) [tag] [attrs content]))
     (list? tpl) (let [[op & args] tpl]
                   (cond
-                    (map? op) (let [[col label] (first op)
+                    (map? op) (let [[label col] (first op)
                                     col (data col)
                                     results (reduce (fn [out elem]
                                                       (let [new-data (if (map? elem)
@@ -27,9 +27,12 @@
                                 results)
                     (list? op) (when (resolve-tpl op-map data [] op)
                                  (reduce (partial resolve-tpl op-map data) out-data args))
-                    (symbol? op) (let [func (op-map op)
+                    (symbol? op) (let [func (let [temp-func (resolve op)] (if-not (nil? temp-func)
+                                                                            temp-func
+                                                                            (op-map op)))
                                        params (map (partial resolve-tpl op-map data []) args)]
-                                   (apply func params))))
+                                   (apply func params))
+                    (keyword? tpl) (tpl data)))
     (keyword? tpl) (tpl data)
     :else tpl))


Fixed issue where passing in a Vector3 to position! will throw and IllegalAccess error

--- src/play_clj/core_cameras.clj
+++ src/play_clj/core_cameras.clj
@@ -165,8 +165,7 @@
   "Sets the position of `object`. If `object` is a screen, the position of the
 camera will be set."
   ([object vec-3]
-    (let [^Camera camera (u/get-obj object :camera)]
-      (set! (. camera position) vec-3)))
+    (position! object (x vec-3) (y vec-3) (z vec-3)))
   ([object x-val y-val]
     (position! object x-val y-val nil))
   ([object x-val y-val z-val]


added list! typecasting to binding storage, possibly fixing a bug leading to stack overflow (?)

--- src/push/interpreter/core.clj
+++ src/push/interpreter/core.clj
@@ -1,56 +1,89 @@
 (ns push.interpreter.core
   (:require [push.util.stack-manipulation :as u]
             [push.util.exceptions :as oops]
-            [push.router.core :as router])
+            [push.router.core :as router]
+            [push.util.code-wrangling :as fix]
+            )
   (:use [push.interpreter.definitions])
   (:use [push.util.type-checkers])
   )

+(defn append-to-record
+  "Appends the new thing to the collection stored under the indicated key, in the interpreter passed in"
+  [interpreter key new-thing]
+  (assoc
+    interpreter
+    key
+    (conj
+      (key interpreter)
+      new-thing
+      )))
+
+
+(defn merge-into-record
+  "Merges the new map with the map stored under the indicated key, in the interpreter passed in"
+  [interpreter keyname new-map]
+  (assoc
+    interpreter
+    keyname
+    (merge
+      new-map
+      (keyname interpreter)
+      )))
+
+
 (defn register-type
   "Takes an Interpreter record, and a PushType record, and adds the PushType to the :types collection in the Interpeter; adds the type's :name as a new stack (if not already present); appends the type's :router to the Interpreter's :routers vector; adds the type's internally defined instructions to the Interpreter's registry automatically."
   [interpreter type]
-  (let [old-types (:types interpreter)
-        old-stacks (:stacks interpreter)
-        old-routers (:routers interpreter)
-        old-instructions (:instructions interpreter)]
-        (-> interpreter
-            (assoc :types (conj old-types type))
-            (assoc :routers
-              (conj old-routers (:router type)))
-            (assoc :stacks (merge {(:name type) '()}  old-stacks))
-            (assoc :instructions (merge old-instructions (:instructions type))))))
+  (-> interpreter
+      (append-to-record  , :types type)
+      (append-to-record  , :routers (:router type))
+      (merge-into-record , :stacks {(:name type) '()})
+      (merge-into-record , :instructions (:instructions type))
+      ))

 (defn register-module
   "Takes an Interpreter record, and a module; adds the module's internally defined instructions to the Interpreter's registry automatically."
   [interpreter module]
-  (let [old-types (:types interpreter)
-        old-instructions (:instructions interpreter)]
-    (-> interpreter
-      (assoc :types (conj old-types module))
-      (assoc :instructions (merge old-instructions (:instructions module))))))
+  (-> interpreter
+      (append-to-record  , :types module)
+      (merge-into-record , :instructions (:instructions module))
+      ))

 (defn register-types
   "Takes an Interpreter record, and a list of PushType records. Calls `register-type` on each of the types in turn."
   [interpreter types]
-  (reduce #(register-type %1 %2) interpreter types))
+  (reduce
+    #(register-type %1 %2)
+    interpreter
+    types
+    ))

 (defn register-modules
   "Takes an Interpreter record, and a list of modules. Calls `register-module` on each of those in turn."
   [interpreter modules]
-  (reduce #(register-module %1 %2) interpreter modules))
+  (reduce
+    #(register-module %1 %2)
+    interpreter
+    modules
+    ))

 (defn bind-value
-  "Takes an interpreter, a keyword, and any item. If the keyword is already registered in the interpreter's :bindings hashmap, the item is pushed to that; otherwise, a new binding is made first. If the item is nil, the binding is created (if necessary) but nothing is pushed to the stack."
+  "Takes an interpreter, a keyword, and any item. If the keyword is already registered in the interpreter's :bindings hashmap, the item is pushed to that; otherwise, a new binding is made first. If the item is `nil`, the binding is created (if necessary) but nothing is pushed to the stack."
   [interpreter kwd item]
-  (let [current-stack (get-in interpreter [:bindings kwd] '())]
-    (if (nil? item)
-      (assoc-in interpreter [:bindings kwd] current-stack)
-      (assoc-in interpreter [:bindings kwd] (conj current-stack item)))))
+  (let [old-stack (get-in interpreter [:bindings kwd] '())]
+    (assoc-in
+      interpreter
+      [:bindings kwd]
+      (if (nil? item)
+        old-stack
+        (fix/list! (conj old-stack item))
+        ))))

 (defn peek-at-binding


Simpler way to get icon. Works locally, maybe will also work when deployed.

--- src/tyranitar/web.clj
+++ src/tyranitar/web.clj
@@ -104,8 +104,7 @@
         {:status 200
          :headers {"Content-Type" "image/jpeg"}
          :body (-> (clojure.java.io/resource "tyranitar.jpg")
-                   (.getFile)
-                   (java.io.FileInputStream.))})
+                   (clojure.java.io/input-stream))})

    (context "/applications"
             [] applications-routes))


Specify cyberspeed for Kerr A & B

Specify cyberspeed for Kerr A & B

--- spectacles/src/spectacles/scheduler.clj
+++ spectacles/src/spectacles/scheduler.clj
@@ -49,8 +49,6 @@
                            :name   "Whalesong"
                            :author "Aaron Arnett"}})

-;; TODO Determine what goes in Kerr A & B
-;; TODO Duplicate/split bet-you-miss
 (def installations {:lifeinlights01 :logo-countdown       ;; Leeds north door
                     :lifeinlights02 :starfield            ;; Commercial Kitchen (window)
                     :lifeinlights03 :bet-you-miss         ;; Easy Pickins (Needs to be duplicated/split, black background?)
@@ -58,9 +56,10 @@
                     :lifeinlights05 :whalesong            ;; Kerr (C)
                     :lifeinlights06 :kaleidoscope-logo    ;; Leeds lobby (or entrance?)
                     :lifeinlights07 :kaleidoscope         ;; Commercial Kitchen (facade) (800x600)
-                    :lifeinlights08 :kaleidoscope         ;; Kerr (A)
-                    :lifeinlights09 :kaleidoscope         ;; Kerr (B)
-                    })
+                    :lifeinlights08 :cyberspeed           ;; Kerr (A)
+                    :lifeinlights09 :cyberspeed           ;; Kerr (B)
+;;                    ;lifeinlights10 :                   ;; Unused
+:Spectre :bet-you-miss                    })

 (defn select-sketch []
   (let [hostname (.getHostName (java.net.InetAddress/getLocalHost))]


working repl that calls server to eval

working repl that calls server to eval

--- src-cljs/kata/pages/problem_editor.cljs
+++ src-cljs/kata/pages/problem_editor.cljs
@@ -19,7 +19,7 @@
   ""
   [input error result]
   (POST "/api/evaluate"
-        {:params        {:code @input}
+        {:params        {:expr @input}
          :handler       #(reset! result %)
          :error-handler #(reset! error %)}))

@@ -51,4 +51,4 @@
        [:div.row>div.col-md-12
         [editor input]
         [:div.row>div.col-md-12
-         [result-view input]]]])))
+         [result-view result]]]])))


using string

using string

--- test/celestial/integration/vc.clj
+++ test/celestial/integration/vc.clj
@@ -13,10 +13,10 @@
     (let [vm (vconstruct redis-vc-spec)]
       (.create vm)
       (.start vm)
-      (.status vm)  => :running
+      (.status vm)  => "running"
       (guest-status (get-in redis-vc-spec [:machine :hostname]))  => :running
       (.stop vm)
-      (.status vm)  => :stopped
+      (.status vm)  => "stopped"
       (.start vm)
       (.stop vm)
       (.delete vm)


Added more time & zone & str conversions

--- test/clj/tst/tupelo/java_time.clj
+++ test/clj/tst/tupelo/java_time.clj
@@ -4,8 +4,9 @@
   (:require
     [clj-time.core :as joda]
     [clojure.string :as str]
-    [tupelo.java-time :as tjt])
-  (:import [java.time Duration ZoneId ZoneId ZonedDateTime ZonedDateTime LocalDateTime]
+    [tupelo.string :as ts]
+    )
+  (:import [java.time Duration ZoneId ZoneId ZonedDateTime ZonedDateTime LocalDateTime Instant]
            [java.util Date]))

 (dotest
@@ -256,42 +257,53 @@
     (is (zero? (.toMillis (Duration/between instant zdt))))))

 (dotest
-  (let [jud         (Date.)
-        ldt         (LocalDateTime/parse "2019-02-01T00:00:00")
-        zdt         (.atZone ldt (ZoneId/of "UTC"))
-        instant     (.toInstant zdt)
+  (let [iso-str     "2019-02-03T04:05:06.789Z"
+        instant     (Instant/parse iso-str)
+        millis      (.toEpochMilli instant)
+        jud         (Date. millis)
+        zdt         (ZonedDateTime/ofInstant instant, zoneid-utc)
         instant-str (.toString instant)
-        now         (ZonedDateTime/now)
-        ]
-    (spyx jud)
-
-    (spyxx ldt)
-    (spyx (.toString ldt))
-    (spyxx (.atZone ldt (ZoneId/of "UTC")))
-
-    (spyx zdt)
-    (spyx (.toString zdt))
-
-    (spyx instant)
-    (spyx instant-str)
-    (nl)
-    (spyx now)
-    ; (require [tupelo.java-time :as tjt])
-    (spyx (tjt/string-date-time-iso zdt))
-    )
-  )
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+        zdt-str     (.toString instant)]
+    (is= 1549166706789 millis)
+    (let [result (ts/quotes->single (pr-str instant))]
+      (is (ts/contains-match? result #"#object\[java.time.Instant \p{Alnum}* '2019-02-03T04:05:06.789Z'\]"))
+      (is (ts/contains-str? result "#object[java.time.Instant"))
+      (is (ts/contains-str? result "2019-02-03T04:05:06.789Z")))
+    (let [result (ts/quotes->single (pr-str zdt))]
+      (is (ts/contains-str? result "#object[java.time.ZonedDateTime"))
+      (is (ts/contains-str? result "2019-02-03T04:05:06.789Z[UTC]")))
+    (is= instant-str     "2019-02-03T04:05:06.789Z")
+    (is= zdt-str         "2019-02-03T04:05:06.789Z")
+    (is= (.toString jud) "Sat Feb 02 20:05:06 PST 2019")
+
+    (is= "2019-02-03T04:05:06.789Z" (string-date-time-iso zdt))
+    (is= "2019-02-03T04:05:06.789Z" (string-date-time-iso instant))
+
+    (is= millis
+      (iso-str->millis iso-str)
+      (iso-str->millis instant-str)
+      (iso-str->millis zdt-str))
+
+    (let [ts          (java.sql.Timestamp. millis)
+          ts-from-str (iso-str->timestamp iso-str)
+          ts-str      (.toString ts)
+          ts-str-gmt  (.toGMTString ts)]
+      (is= ts-str     "2019-02-02 20:05:06.789") ; uses default TZ (US/Pacific in this example)
+      (is= ts-str-gmt "3 Feb 2019 04:05:06 GMT") ; UGLY!
+      (is= ts ts-from-str))))
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+


fix tests to work with travis

fix tests to work with travis

--- test/fileape/concurrency_test.clj
+++ test/fileape/concurrency_test.clj
@@ -28,7 +28,7 @@
                (let [base-dir (File. "target/tests/concurrent-write-read-gzip1")
                      _ (do
                          (doall (map #(clojure.java.io/delete-file % :silently) (file-seq base-dir))))
-                     ape2 (ape {:codec :gzip :base-dir base-dir :check-freq 1000 :rollover-timeout 200})
+                     ape2 (ape {:codec :gzip :base-dir base-dir :check-freq 1000 :rollover-timeout 1000})
                      key-stream1 (take 1 (cycle (map str (range 0 5))))
                      key-stream2 (take 1 (cycle (map str (range 10 20))))

@@ -37,7 +37,7 @@
                                 (doall
                                   (repeatedly thread-count
                                               #(future
-                                                (doseq [i (range 100000)]
+                                                (doseq [i (range 10000)]
                                                   (let [ bts (.getBytes (str i "\n")) ]
                                                     (write ape2 (str "abc-" (rand-nth key-stream))
                                                            (fn [{:keys [^DataOutputStream out]}] (.writeInt out (int i))))))))))]
@@ -54,6 +54,6 @@

                  (let [files (filter (fn [^File file] (re-find #"abc-" (.getName file))) (.listFiles base-dir))]
                    (> (count files) 0) => true
-                   (count (flatten (read-files files))) => 3000000)
+                   (count (flatten (read-files files))) => 300000)

                  (shutdown-agents))))


Add implementation of UpdateEvent for function.

Just for make easy implement pure state transformation
events just using plain functions, without reify.

--- src/uxbox/rstore.cljs
+++ src/uxbox/rstore.cljs
@@ -43,6 +43,11 @@
   the EffectEvent protocol."
   [e]
   (satisfies? EffectEvent e))
+
+(extend-protocol UpdateEvent
+  function
+  (-apply-update [func state]
+    (func state)))

 (defonce bus (rx/bus))


More informative reconnect console log.

More informative reconnect console log.

--- src/via/endpoint.cljs
+++ src/via/endpoint.cljs
@@ -122,7 +122,7 @@
                                     backoff-sq
                                     (exponential-seq 2 max-reconnect-interval))
                        interval (first backoff-sq)]
-                   (js/console.log "Reconnecting in " (str interval "ms"))
+                   (js/console.info (str "Disconnected from via endpoint. Reconnecting in " (str interval "ms...")))
                    (<! (timeout interval))
                    (recur (rest backoff-sq))))))
            (close! control-ch)


Remove test divs from dom after error

Remove test divs from dom after error

--- test/reagenttest/testreagent.cljs
+++ test/reagenttest/testreagent.cljs
@@ -34,11 +34,13 @@
 (defn with-mounted-component [comp f]
   (when isClient
     (let [div (add-test-div "_testreagent")]
-      (let [c (r/render comp div)]
-        (f c div)
-        (r/unmount-component-at-node div)
-        (r/flush)
-        (.removeChild (.-body js/document) div)))))
+      (try
+        (let [c (r/render comp div)]
+          (f c div))
+        (finally
+          (r/unmount-component-at-node div)
+          (r/flush)
+          (.removeChild (.-body js/document) div))))))

 (defn found-in [re div]
   (let [res (.-innerHTML div)]


Fixed typo in comment

Fixed typo in comment

--- resources/rules/post_identifier_merge/temp/hp/hp_phenotype_ice_to_bio.clj
+++ resources/rules/post_identifier_merge/temp/hp/hp_phenotype_ice_to_bio.clj
@@ -32,7 +32,7 @@
          (?/record obo/BFO_0000051 ?/human_phenotype_field_value) ; BFO:has_part
          (?/record rdf/type ccp/IAO_EXT_0000029) ; ccp:HPO_annotation_record

-         ;; retrieve the process participant identifier
+         ;; retrieve the bioentity participant identifier
          (?/record obo/BFO_0000051 ?/bioentity_field_value) ; BFO:has_part
          (?/bioentity_field_value rdf/type ccp/IAO_EXT_0000698) ; ccp:HPO_annotation_record__gene_identifier_field_value
          (?/bioentity_field_value rdf/type ?/bioentity_ice_id)


Bug: Switch 401 with 403

Bug: Switch 401 with 403

--- src/yada/security.clj
+++ src/yada/security.clj
@@ -82,13 +82,13 @@
          ctx
          (if credentials
            (d/error-deferred
-            (ex-info "Failed authorization check"
-                     {:status 401   ; or 404 to keep the resource hidden
+            (ex-info "Forbidden"
+                     {:status 403   ; or 404 to keep the resource hidden
                       ;; But allow WWW-Authenticate header in error
                       :headers (select-keys (-> ctx :response :headers) ["www-authenticate"])}))
            (d/error-deferred
-            (ex-info "Failed authorization check"
-                     {:status 403   ; or 404 to keep the resource hidden
+            (ex-info "No authorization provided"
+                     {:status 401   ; or 404 to keep the resource hidden
                       ;; But allow WWW-Authenticate header in error
                       :headers (select-keys (-> ctx :response :headers) ["www-authenticate"])}))))))
    ctx (get-in ctx [:resource :access-control :realms])))


Wrote a note about the various trade-offs in auth

--- src/yada/security.clj
+++ src/yada/security.clj
@@ -46,7 +46,8 @@

 (defn cors-preflight?
   "Is the method OPTIONS and does the resource accept requests from
-  other origins?"
+  other origins? This is important because we can't block pre-flight
+  requests– the CORS spec. doesn't allow us to."
   [ctx]
   (and (= (:method ctx) :options)
        (some-> ctx :resource :access-control :allow-origin)))
@@ -56,14 +57,38 @@
      ~ctx
      ~@body))

-;; We need to distinguish between authentication credentials being
-;; supplied and valid, supplied and invalid, not supplied.
-
 (defn authenticate [ctx]
   (when-not-cors-preflight ctx
     ;; Note that a response can have multiple challenges, one for each realm.
     (reduce
      (fn [ctx [realm {:keys [authentication-schemes]}]]
+       ;; Currently we take the credentials of the first scheme that
+       ;; returns them.  We also encourage scheme provides to return
+       ;; truthy (e.g. {}) if the credentials have been specified (the
+       ;; correct request header or cookie has been used) but are
+       ;; invalid. This is to distinguish between (i) authentication
+       ;; credentials being supplied and valid, (ii) supplied and
+       ;; invalid, (iii) not supplied.
+       ;;
+       ;; The upshot of this is that invalid basic auth creds are
+       ;; accepted (on the first attempt), so if the user makes a
+       ;; mistake typing them in, no re-attempts are allowed. It is
+       ;; hard for yada to provide re-attempts to a human, because it
+       ;; is designed to support other types of user-agent, where
+       ;; re-attempt counting would not be desirable.
+       ;;
+       ;; The compromise is that basic auth has a single attempt and
+       ;; we must find some better way of allowing humans to 'log out'
+       ;; of basic auth via browser JS. If re-attempts are desirable,
+       ;; then it is recommended to use a more sophisticated auth
+       ;; scheme rather than Basic, which is really only for quick
+       ;; prototypes and examples. I think this is a valid overall
+       ;; compromise between the various trade-offs here.
+
+       ;; In the future we may have a better design that can support
+       ;; conjunctions and disjunctions across auth-schemes, in much
+       ;; the same way we do for the built-in role-based
+       ;; authorization.
        (let [credentials (some (partial authenticate-with-scheme ctx) authentication-schemes)]
          (infof "credentials for realm %s, schemes %s are %s" realm authentication-schemes credentials)
          (cond-> ctx


Remove alerts from atoms namespace

Remove alerts from atoms namespace

--- src/devcards/discuss/atoms.cljs
+++ src/devcards/discuss/atoms.cljs
@@ -6,24 +6,13 @@
             [discuss.components.options :as options]
             [discuss.components.navigation :as nav]
             [discuss.components.clipboard :as clipboard]
-            [om.next :as om]
-            [discuss.components.items :as items]
-            [discuss.views.alerts :as valerts]))
+            [discuss.components.items :as items]))

 (defcard close-button-next
   views/close-button-next)

 (defcard control-elements-next
   views/control-elements-next)
-
-(defcard-om-next error-view
-  valerts/ErrorAlert
-  (om/reconciler {:state {:layout/error "I am an error message"}
-                  :parser (om/parser {:read parser/read})}))
-
-(defcard-om-next login-form
-  views/LoginForm
-  parser/reconciler)

 (defcard-om-next option-view
   options/Options


figwheel.main: fix bug in start

figwheel.main: fix bug in start

works successfully in CIDER!

--- figwheel-main/src/figwheel/main.cljc
+++ figwheel-main/src/figwheel/main.cljc
@@ -1236,8 +1236,9 @@
       config (assoc :config config))))

 (defn start*
-  ([join-server? build] (start* nil build))
+  ([join-server? build] (start* nil nil build))
   ([join-server? figwheel-options build & background-builds]
+   (assert build "Figwheel Start: build argument required")
    (let [{:keys [id] :as build} (start-build-arg->build-options build)
          cfg
          (cond-> {:options (:options build)


function ordering

function ordering

--- src/flambo/parquet/thrift.clj
+++ src/flambo/parquet/thrift.clj
@@ -19,6 +19,10 @@
 (defn unbound-record-filter! [job filter-sym]
   (doto job
     (ParquetThriftInputFormat/setUnboundRecordFilter (Class/forName filter-sym))))
+
+(defn column-filter! [conf filter]
+  (doto conf
+    (.set ThriftReadSupport/THRIFT_COLUMN_FILTER_KEY filter)))

 (defn parquet-thrift-file
   "Create an RDD from a directory of parquet-thrift files
@@ -46,10 +50,6 @@
 (defn compression! [job codec-name]
   (doto job
     (ParquetThriftOutputFormat/setCompression codec-name)))
-
-(defn column-filter! [conf filter]
-  (doto conf
-    (.set ThriftReadSupport/THRIFT_COLUMN_FILTER_KEY filter)))

 (defn save-as-parquet-thrift-file [rdd path klass & {:keys [job compression-codec]
                                                      :or {job (Job.)}}]


fix clicking external links

fix clicking external links

Addresses https://github.com/braidchat/meta/issues/542
The problem was that the event propagates to the containing thread div,
which then preventsDefault and focuses the input instead of opening the
link

--- src/braid/client/ui/views/message.cljs
+++ src/braid/client/ui/views/message.cljs
@@ -30,6 +30,7 @@
                [:a.external {:href url
                              :title url
                              :style {:background-color (helpers/url->color url)}
+                             :on-click (fn [e] (.stopPropagation e))
                              :target "_blank"
                              ; rel to address vuln caused by target=_blank
                              ; https://www.jitbit.com/alexblog/256-targetblank---the-most-underestimated-vulnerability-ever/


fix closing HTML tags

fix closing HTML tags

--- cljs-server/cljsinfo_server/html.cljs
+++ cljs-server/cljsinfo_server/html.cljs
@@ -32,8 +32,8 @@
     [:meta {:http-equiv "X-UA-Compatible" :content "IE=edge"}]
     [:title page-title]
     [:meta {:name "viewport" :content "width=device-width"}]
-    [:link {:rel "shortcut icon" :href "favicon.png" :type "image/png"}]]
-    [:link {:rel "stylesheet" :href (asset "css/main.min.css")}]
+    [:link {:rel "shortcut icon" :href "favicon.png" :type "image/png"}]
+    [:link {:rel "stylesheet" :href (asset "css/main.min.css")}]]
   "<body>")

 (hiccups/defhtml site-footer


Remove console clutter

Remove console clutter

--- src-cljs/qcon/main.cljs
+++ src-cljs/qcon/main.cljs
@@ -162,19 +162,13 @@

 (defn catch-game
   [owner {:keys [id slide channel instances position]}]
-  (println "instances is" instances)
   (go-loop [n 0]

     (om/set-state! owner :label n)
     (<! channel)

-    (println "instances is " (count instances))
     (let [to (mod (+ id (+ 2 (rand-int (- (count instances) 4))))
-                  (count instances)
-                  )]
-      ;;(println "Instance " id " is playing and sending to" to)
-      ;;(println "From position" position)
-      ;;(println "To position" (:position (get instances to)))
+                  (count instances))]
       (let [from-pos position
             to-pos (:position (get instances to))
             xdelta (/ (- (first to-pos) (first from-pos)) 18)
@@ -183,7 +177,6 @@

         (go-loop [i 0]
           (<! (timeout 1))
-          ;;(println "show message" x "," y)
           (om/set-state!
            slide :message
            [(+ (first from-pos) (* i xdelta))
@@ -191,7 +184,6 @@
           (if (= i 18)
             (do
               (om/set-state! slide :message nil)
-              (println "to is" to)
               (>! (get-in instances [to :channel]) "MESSAGE"))
             (recur (inc i)))
           )))
@@ -215,15 +207,9 @@

     om/IWillMount
     (will-mount [_]
-      (println "Mounting game")
       (go
         (>! (:channel (first (om/get-state owner :instances)))
-            "MESSAGE"))
-      (let [instances (om/get-state owner :instances)]
-        (println "There are instances:" (count instances))
-        )
-
-      )
+            "MESSAGE")))

     om/IRender
     (render [_]


Refactoring invoker

Refactoring invoker

--- src/helda/actions/invoker.clj
+++ src/helda/actions/invoker.clj
@@ -19,44 +19,56 @@
     }
   )

-(defn invoke-action [db url action-event]
+(defn invoke-rest [module action-event]
   ;todo add error processing
   (println "Posting " action-event)
   (let [
-    handler-response (client/post url {
+    handler-response (client/post (:url module) {
       :form-params action-event
       :content-type :json
       :as :json-strict
       })
     ]
     (println "Getting response " handler-response)
-    (if-let [action-ctx (get-in handler-response [:body :action-ctx])]
-      {
-        :action-ctx
-        (zipmap
-          (keys action-ctx)
-          (->> action-ctx vals (mapv #(save-entity db %)))
-          )
-        :params-ctx (get-in handler-response [:body :params-ctx])
-        :reasoning-msg (get-in handler-response [:body :reasoning-msg])
-        }
-      )
+    (:body handler-response)
     )
   )

-(defn lookup-action-url [db action-event]
+(defn invoke-script [module action-event]
+  ;todo implement
+  )
+
+(defn process-action-response [db resp]
+  (if-let [action-ctx (:action-ctx resp)]
+    {
+      :action-ctx
+      (zipmap
+        (keys action-ctx)
+        (->> action-ctx vals (mapv #(save-entity db %)))
+        )
+      :params-ctx (:params-ctx resp)
+      :reasoning-msg (:reasoning-msg resp)
+      }
+    )
+  )
+
+(defn lookup-module [db action-event]
   (some->> [:target-entity :actions (:action action-event)]
     (get-in action-event)
     (find-module-by-id db)
-    :url
     )
   )

 (defn fire-action [db action-request]
   (let [
     action-event (populate-action-event db action-request)
-    url (lookup-action-url action-event)
+    module (lookup-module db action-event)
     ]
-    (invoke-action db url action-event)
+    (process-action-response db
+      (if (-> module :kind (= :rest))
+        (invoke-rest module action-event)
+        (invoke-script module action-event)
+        )
+      )
     )
   )


some more clean up

some more clean up

--- src/clj/org/openforis/ceo/db/users.clj
+++ src/clj/org/openforis/ceo/db/users.clj
@@ -5,7 +5,9 @@
            java.util.UUID)
   (:require [clojure.string :as str]
             [org.openforis.ceo.utils.type-conversion :as tc]
-            [org.openforis.ceo.database   :refer [call-sql sql-primitive]]
+            [org.openforis.ceo.database   :refer [call-sql
+                                                  call-sql-opts
+                                                  sql-primitive]]
             [org.openforis.ceo.utils.mail :refer [email?
                                                   send-mail
                                                   send-to-mailing-list
@@ -17,7 +19,7 @@

 (defn login [{:keys [params]}]
   (let [{:keys [email password]} params]
-    (if-let [user (first (call-sql "check_login" email password))]
+    (if-let [user (first (call-sql-opts "check_login" {:log? false} email password))]
       (data-response ""
                      {:session {:userId   (:user_id user)
                                 :userName email
@@ -88,7 +90,7 @@

         :else nil))

-(defn update-account [{:keys [params session]}]
+(defn update-account [{:keys [params]}]
   (let [user-id               (:userId params -1)
         current-email         (:userName params)
         current-password      (:currentPassword params)
@@ -100,12 +102,13 @@
                                                   new-email password password-confirmation)]
       (data-response error-msg)
       ;; TODO: Create a single "update_user_information" sql function, use userid instead of email
-      (let [updated-email? (when-not (or (str/blank? new-email) (= new-email current-email))
-                             (sql-primitive (call-sql "set_user_email" current-email new-email)))]
+      (let [updated-email (if (or (str/blank? new-email) (= new-email current-email))
+                            current-email
+                            (sql-primitive (call-sql "set_user_email" current-email new-email)))]
         (when-not (str/blank? password)
-          (call-sql "update_password" (or updated-email? current-email) password))
+          (call-sql "update_password" updated-email password))
         (call-sql "set_mailing_list" user-id on-mailing-list?)
-        (data-response "" (when updated-email? {:session (assoc session :userName new-email)}))))))
+        (data-response "" {:session {:userName updated-email}})))))

 (defn get-password-reset-key [{:keys [params]}]
   (let [reset-key (str (UUID/randomUUID))
@@ -149,22 +152,18 @@

 ;; FIXME, remove this route and check if a user exists directly when adding
 (defn get-all-users [_]
-  (let [all-users (mapv (fn [{:keys [user_id email administrator]}]
+  (let [all-users (mapv (fn [{:keys [user_id email]}]
                           {:id    user_id
-                           :email email
-                           :role  (if administrator "admin" "user")})
+                           :email email})
                         (call-sql "get_all_users"))]
     (data-response all-users)))

-;; FIXME: We might not want to pass the reset key to the front end.
-;; FIXME: Update get_all_users_by_institution to rename user_id to id and return role instead of administrator.
+;; FIXME: Update get_all_users_by_institution to remove unused values.
 (defn get-institution-users [{:keys [params]}]
   (let [institution-id (tc/str->int (:institutionId params))
-        all-users      (mapv (fn [{:keys [user_id email administrator reset_key institution_role]}]
+        all-users      (mapv (fn [{:keys [user_id email institution_role]}]
                                {:id              user_id
                                 :email           email
-                                :role            (if administrator "admin" "user")
-                                :resetKey        reset_key
                                 :institutionRole institution_role})
                              (call-sql "get_all_users_by_institution_id" institution-id))]
     (data-response all-users)))
@@ -190,20 +189,23 @@
 (defn update-institution-role [{:keys [params]}]
   (let [account-id       (tc/str->int (:accountId params))
         institution-id   (tc/str->int (:institutionId params))
-        role             (:role params)]
-    (if (= role "not-member")
+        institution-role (:role params)] ; TODO rename param to institutionRole
+    (if (= institution-role "not-member")
       (call-sql "remove_institution_user_role" institution-id account-id)
       (let [email            (:email (first (call-sql "get_user_by_id" account-id)))
             institution-name (:name (first (call-sql "select_institution_by_id" institution-id)))
             timestamp        (-> (DateTimeFormatter/ofPattern "yyyy/MM/dd HH:mm:ss")
                                  (.format (LocalDateTime/now)))
-            inst-user-id     (sql-primitive (call-sql "update_institution_user_role" institution-id account-id role))
+            inst-user-id     (sql-primitive (call-sql "update_institution_user_role"
+                                                      institution-id
+                                                      account-id
+                                                      institution-role))
             email-msg        (format (str "Dear %s,\n\n"
                                           "You have been assigned the role of %s for %s on %s.\n\n"
                                           "Kind Regards,\n"
                                           "  The CEO Team")
-                                     email role institution-name timestamp)]
-        (when-not inst-user-id (call-sql "add_institution_user" institution-id account-id role))
+                                     email institution-role institution-name timestamp)]
+        (when-not inst-user-id (call-sql "add_institution_user" institution-id account-id institution-role))
         (send-mail email nil nil "User Role Assignment" email-msg "text/plain")))
     (data-response "")))


small fix

small fix

--- src/clj/salava/metabadge/metabadge.clj
+++ src/clj/salava/metabadge/metabadge.clj
@@ -119,7 +119,8 @@
                 (let [required-badges (expand-required-badges ctx (:id m) (:required_badges m) assertion-url)
                       received-required-badges (filter :user_badge_id required-badges)]
                   (-> m
-                      (merge (lookup-badge ctx (:id m) "milestone" (:badge m)))
+                      (assoc :name (:name m))
+                      (merge (dissoc (lookup-badge ctx (:id m) "milestone" (:badge m)) :name))
                       (assoc :required_badges required-badges
                         :completion_status (%completed (:min_required m) (count received-required-badges))
                         :milestone? (= assertion-url (get-in m [:badge :url])))
@@ -153,7 +154,7 @@
   [ctx pending-assertion id]
   (if-let [is-metabadge? (db/metabadge?! ctx (get-in ctx [:config :factory :url]) (-> pending-assertion (assoc :id id)))]
     (let [badge (metabadge->badge-map ctx id)]
-      (db/get-metabadge! ctx (:connection (u/get-db ctx)) (get-in ctx [:config :factory :url]) badge))))
+      (db/get-metabadge! ctx (get-in ctx [:config :factory :url]) badge))))

 (defn completed-metabadges [ctx user_id]
@@ -169,7 +170,7 @@
   {:in_progress (metabadges-in-progress ctx user_id)
    :completed (completed-metabadges ctx user_id)})

-#_(defn is-metabadge? [ctx user_badge_id]
+(defn is-metabadge? [ctx user_badge_id]
   (let [x (some-> (select-metabadge-info-from-user-badge {:id user_badge_id} (u/get-db ctx)) first)]
     (reduce-kv (fn [r k v]
                  (assoc r k (if (clojure.string/blank? v) false true))) {} x)))


avoid double loading items

avoid double loading items

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -546,7 +546,6 @@
   [page-state]
   (let [ctl-chan (r/cursor page-state [:ctl-chan])
         all-items-fetched? (r/cursor page-state [:all-items-fetched?])]
-    (trns/init-item-loading page-state)
     (fn []
       [:div.d-flex.flex-column.h-75
        [:div#items-container.flex-grow-1.overflow-auto {:style {:height "0"}}
@@ -564,6 +563,7 @@
         reconciliation (r/cursor page-state [:reconciliation])
         attachments-item (r/cursor page-state [:attachments-item])
         selected-attachment (r/cursor page-state [:selected-attachment])]
+    (trns/init-item-loading page-state)
     (fn []
       (cond
         @transaction         [transaction-form page-state]


add "fork me on github"-ribbon to about page

--- src/cljs/foosball/locations/about.cljs
+++ src/cljs/foosball/locations/about.cljs
@@ -14,6 +14,14 @@

 (defn render [{:keys [software-dependencies version]}]
   [:div.col-lg-8.jumbotron
+   [:a {:href "https://github.com/thomaschrstnsn/foosball"}
+    [:img {:style {:position "absolute"
+                   :top 0
+                   :right 0
+                   :border 0}
+           :src "https://camo.githubusercontent.com/652c5b9acfaddf3a9c326fa6bde407b87f7be0f4/68747470733a2f2f73332e616d617a6f6e6177732e636f6d2f6769746875622f726962626f6e732f666f726b6d655f72696768745f6f72616e67655f6666373630302e706e67"
+           :alt "Fork me on Github"
+           :data-canonical-src "https://s3.amazonaws.com/github/ribbons/forkme_right_orange_ff7600.png"}]]
    [:h1 "Foosball"]
    (when version
      [:p.lead (str "Version " version)])


Move codes around

Move codes around

--- src/cljs/openslack/views/messages.cljs
+++ src/cljs/openslack/views/messages.cljs
@@ -2,7 +2,34 @@
   (:require [om.core :as om :include-macros true]
             [sablono.core :as s :include-macros true]))

-; TODO: format own messages differently
+(defn message-input
+  [send-message-fn]
+  (fn [_ owner]
+    (reify
+      om/IDisplayName
+      (display-name [_] "Message Input")
+
+      om/IInitState
+      (init-state [_]
+        {:message ""})
+
+      om/IRenderState
+      (render-state [_ {:keys [message]}]
+        (s/html
+         [:div.write-message
+          [:textarea
+           {:value message
+            :auto-focus true
+            :on-change (fn [e] (om/set-state! owner :message (.-value (.-target e))))
+            :on-key-down (fn [e]
+                           (when (= (.-keyCode e) 13)
+                             (if (.-ctrlKey e)
+                               (om/set-state! owner :message (str message "\n"))
+                               (do
+                                 (.preventDefault e)
+                                 (send-message-fn message)
+                                 (om/set-state! owner :message "")))))}]])))))
+
 (defn contact-message
   [state owner]
   (reify
@@ -56,31 +83,3 @@
                                                  mins)]
                                       (str hours ":" mins))]]
          [:p.content (:body state)]]]))))
-
-(defn message-input
-  [send-message-fn]
-  (fn [_ owner]
-    (reify
-      om/IDisplayName
-      (display-name [_] "Message Input")
-
-      om/IInitState
-      (init-state [_]
-        {:message ""})
-
-      om/IRenderState
-      (render-state [_ {:keys [message]}]
-        (s/html
-         [:div.write-message
-          [:textarea
-           {:value message
-            :auto-focus true
-            :on-change (fn [e] (om/set-state! owner :message (.-value (.-target e))))
-            :on-key-down (fn [e]
-                           (when (= (.-keyCode e) 13)
-                             (if (.-ctrlKey e)
-                               (om/set-state! owner :message (str message "\n"))
-                               (do
-                                 (.preventDefault e)
-                                 (send-message-fn message)
-                                 (om/set-state! owner :message "")))))}]])))))


Don't cache nil/empty values.

Don't cache nil/empty values.

--- src/cmr/opendap/components/caching.clj
+++ src/cmr/opendap/components/caching.clj
@@ -65,7 +65,8 @@
           (cache/hit ch item-key))
         (when-let [value (value-fn)]
           (log/debug "Cache miss; calling value function ...")
-          (swap! (get-cache system) #(cache/miss % item-key value)))))
+          (when-not (or (nil? value) (empty? value))
+            (swap! (get-cache system) #(cache/miss % item-key value))))))
     (lookup system item-key)))

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


Make root redirect to /story.

Make root redirect to /story.

--- src/tryclojure/views/home.clj
+++ src/tryclojure/views/home.clj
@@ -1,5 +1,6 @@
 (ns tryclojure.views.home
   (:require [noir.core :refer [defpartial defpage]]
+            [noir.response :refer [redirect]]
             [hiccup.element :refer [javascript-tag link-to unordered-list]]
             [hiccup.page :refer [include-css include-js html5]]))

@@ -34,7 +35,7 @@
         })();")]]]))

 (defpage "/" []
-  (root-html))
+  (redirect "/story"))

 (defpage "/story" []
   (root-html "story" "Story time with Isla"))


make autoscroll on build page use body

make autoscroll on build page use body

--- frontend/components/build_steps.cljs
+++ frontend/components/build_steps.cljs
@@ -190,9 +190,9 @@
     om/IDidUpdate
     (did-update [_ _ _]
       (when (om/get-state owner [:autoscroll?])
-        (let [main (sel1 "main.app-main")
+        (let [body (sel1 "body")
               very-large-numer 10000000]
-          (set! (.-scrollTop main) very-large-numer))))
+          (set! (.-scrollTop body) very-large-numer))))
     om/IRender
     (render [_]
       (let [non-parallel-actions (->> containers


Make it clearer that you need to supply a bit generation strategy to noise.

--- src/klangmeister/synthesis.cljs
+++ src/klangmeister/synthesis.cljs
@@ -76,14 +76,14 @@

 ; Noise

-(defn noise [bit duration]
+(defn noise [generate-bit! duration]
   (fn [context at duration]
     (let [sample-rate 44100
           frame-count (* sample-rate duration)
           buffer (.createBuffer context 1 frame-count sample-rate)
           data (.getChannelData buffer 0)]
       (doseq [i (range sample-rate)]
-        (aset data i (bit)))
+        (aset data i (generate-bit!)))
       (doto (.createBufferSource context)
         (-> .-buffer (set! buffer))
         (.start at)))))


Delete unused fn.

Delete unused fn.

--- src/kolmogorov_music/coding.clj
+++ src/kolmogorov_music/coding.clj
@@ -10,9 +10,6 @@
   (if (= x (apply min v))
     0
     (inc (least xs))))
-
-(defn synchronise [v]
-  (vec (repeat (count v) (apply max v))))

 (defn increment [v i n]
   (update-in v [i] (partial + n)))


Fixed unit test.

Fixed unit test.

--- test/com/lemondronor/leaflet_gorilla_test.clj
+++ test/com/lemondronor/leaflet_gorilla_test.clj
@@ -75,10 +75,9 @@

 (deftest test-geojson-for-geodesc
   (testing "points"
-    (is (= {"type" "Feature",
-            "geometry" {"type" "MultiPoint", "coordinates" [[2 1] [4 3]]}}
-           (json/read-str
-            (lg/geojson-for-geodesc {:type :points :desc [[1 2] [3 4]]}))))))
+    (is (= {:type :Feature,
+            :geometry {:type :MultiPoint, :coordinates [[2 1] [4 3]]}}
+           (lg/geojson-for-geodesc {:type :points :desc [[1 2] [3 4]]})))))

 (deftest test-render


Forgot to check in tests

Forgot to check in tests

--- test/midje/internal_ideas/t_project_state.clj
+++ test/midje/internal_ideas/t_project_state.clj
@@ -60,11 +60,12 @@

  (fact "a dependents cleaner knows how to remove namespaces that depend on a namespace"
    (let [tracker {deps-key {:dependents {..ns1.. [..ns2..]
-                                         ..ns2.. []
+                                         ..ns2.. [..ns3..]
                                          ..ns3.. []}}}
          cleaner (mkfn:clean-dependents tracker)]
-     (cleaner ..ns1.. [..ns2.. ..ns3..]) => [..ns3..]
-     (cleaner ..ns2.. [..ns1.. ..ns3..]) => [..ns1.. ..ns3..]))
+     (cleaner ..ns1.. [..ns2.. ..ns3..]) => empty?
+     (cleaner ..ns2.. [..ns1.. ..ns3..]) => [..ns1..]
+     (cleaner ..ns3.. [..ns1..]) => [..ns1..]))

  (def cleaner) ; standin for the calculated dependency cleaner


Disable input-broker-reboot-test for now Causes problems on CircleCI

--- test/onyx/plugin/input_broker_reboot_test.clj
+++ test/onyx/plugin/input_broker_reboot_test.clj
@@ -8,7 +8,7 @@
             [onyx.api]
             [midje.sweet :refer :all]))

-(def id (java.util.UUID/randomUUID))
+(comment (def id (java.util.UUID/randomUUID))

 (def env-config
   {:zookeeper/address "127.0.0.1:2188"
@@ -147,4 +147,4 @@

 (onyx.api/shutdown-env env)

-(component/stop kafka-server)
+(component/stop kafka-server))


referee: removed no longer used `sum-rows` func

--- src/ultimate_ttt/referee.cljs
+++ src/ultimate_ttt/referee.cljs
@@ -4,12 +4,6 @@

 (defn- coordinates->owners [board coordinates]
   (map #(b/get-cell board (first %) (second %)) coordinates))
-
-(defn- sum-rows [board rows]
-  (->>
-   rows
-   (map #(coordinates->owners board %))
-   (map #(reduce + %))))

 (defn- any-row-won-by-player?
   "Given rows of cell owners, determines if any row has been won by player x"


CLJS-1191: rebased patch Update clojure.walk to the current version on clojure

--- src/main/cljs/clojure/walk.cljs
+++ src/main/cljs/clojure/walk.cljs
@@ -43,9 +43,13 @@
   {:added "1.1"}
   [inner outer form]
   (cond
-   (seq? form) (outer (doall (map inner form)))
-   (coll? form) (outer (into (empty form) (map inner form)))
-   :else (outer form)))
+    (list? form) (outer (apply list (map inner form)))
+    (satisfies? IMapEntry form) (outer (vec (map inner form)))
+    (seq? form) (outer (doall (map inner form)))
+    (satisfies? IRecord form)
+    (outer (reduce (fn [r x] (conj r (inner x))) form form))
+    (coll? form) (outer (into (empty form) (map inner form)))
+    :else (outer form)))

 (defn postwalk
   "Performs a depth-first, post-order traversal of form.  Calls f on


Add test to verify shutdown issue

Add test to verify shutdown issue

When I run a bunch of tasks, and one has an exception, I expect the
other tasks to fail. However, they keep running! This test verifies
that.

--- test/com/climate/claypoole_test.clj
+++ test/com/climate/claypoole_test.clj
@@ -344,7 +344,7 @@
             input (vec (reverse (range n)))
             ;; We'll record what tasks have been started so we can make sure
             ;; all of them are started.
-            started (atom #{})
+            started (atom [])
             ;; We'll check that our responses are streamed as available. We'll
             ;; control the order they're available with a sequence of promises.
             promise-chain (vec (repeatedly n promise))
@@ -368,7 +368,9 @@
                                input)]
         ;; All tasks should have started after 100ms.
         (Thread/sleep 100)
-        (is (= @started (set input)))
+        (is (= (set @started) (set input)))
+        ;; Each task should be started only once.
+        (is (= @started (distinct @started)))
         ;; Start the first task.
         (deliver (first promise-chain) nil)
         ;; Tasks should complete in numerical order, the opposite of the order
@@ -392,7 +394,7 @@
             second-inputs (range n (* n 2))
             ;; The input will have a pause after n items.
             pause (promise)
-            input (concat first-inputs (map deref [pause]) second-inputs)
+            input (concat first-inputs (lazy-seq (list @pause)) second-inputs)
             ;; We'll record what tasks have been started so we can make sure
             ;; all of them are started.
             started (atom #{})
@@ -542,9 +544,31 @@
           (when should-we-shutdown?
             (cp/shutdown! @apool)))))))

+(defn check-shuts-off
+  [pmap-like]
+  (cp/with-shutdown! [pool 2]
+    (let [;; A lazy blocking trap
+          blocker (map deref [(promise)])
+          started (atom [])
+          f (fn [x]
+              (Thread/sleep 1)
+              (swap! started conj x)
+              (when (= x 10)
+                (throw (Exception. (str x))))
+              x)
+          results (pmap-like pool f (concat (impl/unchunk (range 200)) blocker))]
+      (Thread/sleep 300)
+      ;; Surely we hit the exception.
+      (is (thrown? Exception (doall results)))
+      ;; Surely we didn't start every task.
+      (is (< 1 (count @started) 100))
+      ;; Surely something, but not everything, is returned, and we do not
+      ;; block.
+      (is (< 1 (count results) 100)))))
+
 (defn check-all
   "Run all checks on a pmap function."
-  [fn-name pmap-like ordered?]
+  [fn-name pmap-like ordered? lazy?]
   (testing (format "%s runs n things at once" fn-name)
     (check-parallel pmap-like ordered?))
   (testing (format "%s emits exceptions correctly" fn-name)
@@ -561,8 +585,11 @@
   (testing (format "%s throws exceptions when tasks are sent to a shutdown pool"
                    fn-name)
     (check-shutdown-exceptions pmap-like))
-  (testing (format "%s can be chained in various threadpools" fn-name)
-    (check-chaining pmap-like)))
+  (when lazy?
+    (testing (format "%s can be chained in various threadpools" fn-name)
+             (check-chaining pmap-like))
+    (testing (format "%s stops processing when an exception occurs" fn-name)
+             (check-shuts-off pmap-like))))

 (deftest test-future
@@ -610,7 +637,7 @@
   (testing "basic pmap test"
     (cp/with-shutdown! [pool 3]
       (is (= (range 1 11) (cp/pmap pool inc (range 10))))))
-  (check-all "pmap" cp/pmap true)
+  (check-all "pmap" cp/pmap true true)
   (testing "pmap reads lazily"
     (check-lazy-read cp/pmap)))

@@ -618,7 +645,7 @@
   (testing "basic upmap test"
     (cp/with-shutdown! [pool 3]
       (is (= (range 1 11) (sort (cp/upmap pool inc (range 10)))))))
-  (check-all "upmap" cp/upmap false)
+  (check-all "upmap" cp/upmap false true)
   (testing "upmap reads lazily"
     (check-lazy-read cp/upmap)))

@@ -633,7 +660,7 @@
               pool
               (for [i input]
                 #(work i))))]
-    (check-all "pcalls" pmap-like true)))
+    (check-all "pcalls" pmap-like true true)))

 (deftest test-upcalls
   (testing "basic pcalls test"
@@ -646,7 +673,7 @@
               pool
               (for [i input]
                 #(work i))))]
-    (check-all "upcalls" pmap-like false)))
+    (check-all "upcalls" pmap-like false true)))

 (deftest test-pvalues
   (testing "basic pvalues test"
@@ -662,7 +689,7 @@
                       ~@(for [i input]
                           (list worksym i)))))
                  pool work)))]
-    (check-all "pvalues" pmap-like true)))
+    (check-all "pvalues" pmap-like true false)))

 (deftest test-upvalues
   (testing "basic upvalues test"
@@ -678,7 +705,7 @@
                       ~@(for [i input]
                           (list worksym i)))))
                  pool work)))]
-    (check-all "upvalues" pmap-like false)))
+    (check-all "upvalues" pmap-like false false)))

 (deftest test-pfor
   (testing "basic pfor test"
@@ -690,7 +717,7 @@
               pool
               [i input]
               (work i)))]
-    (check-all "pfor" pmap-like true)
+    (check-all "pfor" pmap-like true true)
     (testing "pfor reads lazily"
       (check-lazy-read pmap-like))))

@@ -704,6 +731,6 @@
               pool
               [i input]
               (work i)))]
-    (check-all "upfor" pmap-like false)
+    (check-all "upfor" pmap-like false true)
     (testing "upfor reads lazily"
       (check-lazy-read pmap-like))))


removed buggy conference search bar for pre go live - please revert this commit afterwards

--- src/cljs/conference_rating/conference_list_page/conference_list_page.cljs
+++ src/cljs/conference_rating/conference_list_page/conference_list_page.cljs
@@ -65,8 +65,7 @@
   [:div
    (navbar/nav-bar)
    [:div {:class "container-fluid content-container pad-top"}
-    [:div {:class "conference-search form-group"}
-     [(search-for-conference-component conference-list)]]
+    [:div {:class "conference-search form-group"}]
     (add-conference-bar)
     [:div {:class "row"}(map list-entry/display-conference-list-item (sort-by :from conference-list))]]])


Validate CATS with a loop

Validate CATS with a loop

--- test/graphql_clj/validator_test.clj
+++ test/graphql_clj/validator_test.clj
@@ -63,166 +63,9 @@
 (defn- expect-valid [{:keys [result expected]}]
   (= expected result))

-(deftest default-values-of-correct-type
-  (testing "valid1"
-    (is (expect-valid (nth cats 0))))
-  (testing "valid2"
-    (let [{:keys [result expected]} (nth cats 1)]
-      (is (= expected result))))
-  (testing "valid3"
-    (let [{:keys [result expected]} (nth cats 2)]
-      (is (= expected result))))
-  (testing "default-for-required-field"
-    (let [{:keys [validated expected]} (nth cats 3)]
-      (is (match-error expected validated))))
-  (testing "bad-value-for-default"
-    (let [{:keys [validated expected]} (nth cats 4)]
-      (is (match-error expected validated))))
-  (testing "complex variables missing required field"
-    (let [{:keys [validated expected]} (nth cats 5)]
-      (is (match-error expected validated)))))
-
-(deftest arguments-of-correct-type
-  (testing "valid"
-    (is (expect-valid (nth cats 6))))
-  (testing "bad-value"
-    (let [{:keys [validated expected]} (nth cats 7)]
-      (is (match-error expected validated)))))
-
-(deftest fields-on-correct-type
-  (testing "valid"
-    (is (expect-valid (nth cats 8))))
-  (testing "missing-type"
-    (let [{:keys [validated expected]} (nth cats 9)]
-      (is (match-error expected validated))))
-  (testing "missing-type-nested"
-    (let [{:keys [validated expected]} (nth cats 10)]
-      (is (match-error expected validated))))
-  (testing "missing-type-double-nested"
-    (let [{:keys [validated expected]} (nth cats 11)]
-      (is (match-error expected validated)))))
-
-(deftest known-argument-names
-  (testing "valid"
-    (is (expect-valid (nth cats 12))))
-  (testing "unknown argument name on field"
-    (let [{:keys [validated expected]} (nth cats 13)]
-      (is (match-error expected validated))))
-  (testing "unknown argument name on directive"
-    (let [{:keys [validated expected]} (nth cats 14)]
-      (is (match-error expected validated)))))
-
-(deftest known-type-names
-  (testing "valid variable definition"
-    (is (expect-valid (nth cats 15))))
-  (testing "unknown type name on variable definition"
-    (let [{:keys [validated expected]} (nth cats 16)]
-      (is (match-error expected validated))))
-  (testing "valid fragment condition"
-    (is (expect-valid (nth cats 17))))
-  (testing "unknown type name on fragment condition"
-    (let [{:keys [validated expected]} (nth cats 18)]
-      (is (match-error expected validated)))))
-
-(deftest known-fragment-names
-  (testing "known fragment name"
-      (is (expect-valid (nth cats 19))))
-  (testing "unknown fragment name"
-    (let [{:keys [validated expected]} (nth cats 20)]
-      (is (match-error expected validated)))))
-
-(deftest variables-are-input-types
-  (testing "input type variable"
-    (is (expect-valid (nth cats 21))))
-  (testing "interface type variable"
-    (let [{:keys [validated expected]} (nth cats 22)]
-      (is (match-error expected validated)))))
-
-(deftest no-undefined-variables
-  (testing "undefined variable"
-    (let [{:keys [validated expected]} (nth cats 23)]
-      (is (match-error expected validated)))))
-
-(deftest no-fragment-cycles
-  (testing "fragment-cycle"
-    (let [{:keys [validated expected]} (nth cats 24)]
-      (is (match-error expected validated))))
-  (testing "cyclical data"
-    (let [{:keys [validated expected]} (nth cats 25)]
-      (is (match-error expected validated)))))
-
-(deftest fragments-on-composite-types
-  (testing "valid inline fragment"
-    (is (expect-valid (nth cats 26))))
-  (testing "invalid inline fragment"
-    (let [{:keys [validated expected]} (nth cats 27)]
-      (is (match-error expected validated))))
-  (testing "invalid fragment-definition"
-    (let [{:keys [validated expected]} (nth cats 28)]
-      (is (match-error expected validated)))))
-
-(deftest unique-variable-names
-  (testing "duplicate variable name"
-    (let [{:keys [validated expected]} (nth cats 29)]
-      (is (match-error expected validated)))))
-
-(deftest unique-operation-names
-  (testing "duplicate operation name"
-    (let [{:keys [validated expected]} (nth cats 30)]
-      (is (match-error expected validated))))
-  (testing "multiple valid operations with unique names"
-    (is (expect-valid (nth cats 31)))))
-
-(deftest unique-input-field-name
-  (testing "duplicate input field name on object value"
-    (let [{:keys [validated expected]} (nth cats 32)]
-      (is (match-error expected validated))))
-  (testing "duplicate input field name on schema"
-    (let [{:keys [validated expected]} (nth cats 33)]
-      (is (match-error expected validated)))))
-
-(deftest unique-fragment-names
-  (testing "duplicate fragment name"
-    (let [{:keys [validated expected]} (nth cats 34)]
-      (is (match-error expected validated)))))
-
-(deftest unique-argument-names
-  (testing "duplicate argument name on field (query)"
-    (let [{:keys [validated expected]} (nth cats 35)]
-      (is (match-error expected validated))))
-  (testing "duplicate argument name on type field (schema)"
-    (let [{:keys [validated expected]} (nth cats 36)]
-      (is (match-error expected validated))))
-  (testing "duplicate argument name on directive (query)"
-    (let [{:keys [validated expected]} (nth cats 37)]
-      (is (match-error expected validated)))))
-
-(deftest provided-non-null-arguments
-  (testing "missing required argument"
-    (let [{:keys [validated expected]} (nth cats 38)]
-      (is (match-error expected validated)))))
-
-(deftest no-unused-variables
-  (testing "unused variable"
-    (let [{:keys [validated expected]} (nth cats 39)]
-      (is (match-error expected validated)))))
-
-(deftest no-unused-fragments
-  (testing "unused fragment"
-    (let [{:keys [validated expected]} (nth cats 40)]
-      (is (match-error expected validated)))))
-
-(deftest known-directives
-  (testing "unknown directive"
-    (let [{:keys [validated expected]} (nth cats 41)]
-      (is (match-error expected validated)))))
-
-(deftest lone-anonymous-operation
-  (testing "multiple anonymous operations"
-    (let [{:keys [validated expected]} (nth cats 42)]
-      (is (match-error expected validated)))))
-
-(deftest variables-in-allowed-position
-  (testing "variable type mismatch"
-    (let [{:keys [validated expected]} (nth cats 43)]
-      (is (match-error expected validated)))))
+(deftest validate-cats
+  (doseq [{:keys [name result expected validated]} cats]
+    (testing name
+      (if (= :passes result)
+        (is (= expected result))
+        (is (match-error expected validated))))))