Re-throw XQueryException and XCC RequestException

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -365,9 +365,32 @@
   [request-factory session query options variables types shape]
   (let [req (sling/try+ (.submitRequest session
                                         (request-obj request-factory options variables))
-                        ;; XXX which ML exceptions have overridden toString?
-                        (catch com.marklogic.xcc.exceptions.XccException e
-                          (sling/throw+ (doto (Exception. (.toString e))
+                        ;; RequestException and its subclass
+                        ;; XQueryException have overridden toString,
+                        ;; so only those need to be re-thrown with
+                        ;; that info in `message`, otherwise it is
+                        ;; hidden by most Clojure middleware (probably
+                        ;; nrepl, possibly leiningen and cider)
+                        (catch com.marklogic.xcc.exceptions.XQueryException e
+                          (sling/throw+ (doto (com.marklogic.xcc.exceptions.XQueryException.
+                                               ;; See https://github.com/marklogic/xcc-java/blob/master/com/marklogic/xcc/exceptions/XQueryException.java#L63
+                                               (.getRequest e)
+                                               (.getCode e)
+                                               (.getW3CCode e)
+                                               (.getXQueryVersion e)
+                                               (.toString e)
+                                               (.getFormatString e)
+                                               "" ;; FIXME expr - "The expression that caused the exception, if applicable"
+                                               (.isRetryable e)
+                                               (.getData e)
+                                               (.getStack e))
+                                          (.setStackTrace (:stack-trace &throw-context)))))
+                        ;; TODO It could be useful to re-throw other
+                        ;; specific sub-classes of RequestException.
+                        (catch com.marklogic.xcc.exceptions.RequestException e
+                          (sling/throw+ (doto (com.marklogic.xcc.exceptions.RequestException.
+                                               (.toString e)
+                                               (.getRequest e))
                                           (.setStackTrace (:stack-trace &throw-context))))))]
     (shape-results (cond (= :raw types) req
                          :else          (convert-types req types))


Mostly future tests

Mostly future tests

--- test/structural_typing/f_bouncer.clj
+++ test/structural_typing/f_bouncer.clj
@@ -1,8 +1,102 @@
 (ns structural-typing.f-bouncer
   (:require [structural-typing.type :as type]
             [clojure.set :as set]
-            [structural-typing.testutil.accumulator :as accumulator])
+            [structural-typing.testutil.accumulator :as accumulator]
+            [bouncer.core :as b]
+            [bouncer.validators :as bv])
   (:use midje.sweet))

 (namespace-state-changes (before :facts (accumulator/reset!)))

+(fact "you can validate nested maps"
+  (fact "required arguments"
+    (let [type-repo (-> accumulator/type-repo
+                        (type/named :hork [[:point :x]
+                                           [:point :y]]))]
+      (type/checked type-repo :hork {:point {:x 1 :y 2, :z 3}
+                                     :other 3}) => {:point {:x 1 :y 2 :z 3}
+                                                    :other 3}
+
+      (type/checked type-repo :hork {}) => :failure-handler-called
+      (accumulator/messages) => (just "[:point :x] must be present and non-nil"
+                                      "[:point :y] must be present and non-nil"
+                                      :in-any-order)
+
+      (type/checked type-repo :hork {:point 1}) => :failure-handler-called
+      (accumulator/messages) => (just "[:point :x] must be present and non-nil"
+                                      "[:point :y] must be present and non-nil"
+                                      :in-any-order)
+
+      (type/checked type-repo :hork {:point {:x 1}}) => :failure-handler-called
+      (accumulator/messages) => ["[:point :y] must be present and non-nil"])
+                                      :in-any-order)
+
+
+  (fact "optional args"
+    (let [type-repo (-> accumulator/type-repo
+                        (type/named :hork [:string [:point :x] [:point :y]]
+                                    {:string #'string?
+                                     [:point :x] #'integer?
+                                     :distance #'pos?}))]
+      (type/checked type-repo :hork {:string "hi" :point {:x 1, :y 1} :distance 3})
+      (type/checked type-repo :hork {:string "hi" :point {:x 1, :y 1}})
+
+      (type/checked type-repo :hork {:string 3 :point {:x 1, :y 1}}) => :failure-handler-called
+      (accumulator/messages) => [":string should be `string?`; it is `3`"]
+
+      (type/checked type-repo :hork {:string "hi" :point {:x 1.0, :y 1.0}}) => :failure-handler-called
+      (accumulator/messages) => ["[:point :x] should be `integer?`; it is `1.0`"]
+
+      (type/checked type-repo :hork {:string "hi" :point {:x 1, :y 1} :distance -3}) => :failure-handler-called
+      (accumulator/messages) => [":distance should be `pos?`; it is `-3`"]
+
+      (type/checked type-repo :hork {:string "hi" :point {:x 1, :y 1} :distance "foo"}) => :failure-handler-called
+      (accumulator/messages) => [":distance should be `pos?`; it is `\"foo\"`"]))
+
+
+  (future-fact "validator sets would be nice"
+    (let [type-repo (-> accumulator/type-repo
+                        (type/named :hork [:string [:point :x] [:point :y]]
+                                    {:string #'string?
+                                     :point {:x #'integer?}
+                                     :distance #'pos?}))]
+      (type/checked type-repo :hork {:string "hi" :point {:x 1, :y 1} :distance 3})
+      (type/checked type-repo :hork {:string "hi" :point {:x 1, :y 1}})
+
+      (type/checked type-repo :hork {:string 3 :point {:x 1, :y 1}}) => :failure-handler-called
+      (accumulator/messages) => [":string should be `string?`; it is `3`"]
+
+      (type/checked type-repo :hork {:string "hi" :point {:x 1.0, :y 1.0}}) => :failure-handler-called
+      (accumulator/messages) => ["[:point :x] should be `integer?`; it is `1.0`"]
+
+      (type/checked type-repo :hork {:string "hi" :point {:x 1, :y 1} :distance -3}) => :failure-handler-called
+      (accumulator/messages) => [":distance should be `pos?`; it is `-3`"]
+
+      (type/checked type-repo :hork {:string "hi" :point {:x 1, :y 1} :distance "foo"}) => :failure-handler-called
+      (accumulator/messages) => [":distance should be `pos?`; it is `\"foo\"`"]
+
+      )
+))
+
+
+(future-fact "validating embedded collections"
+  (b/validate {:pets [{:name "p" :age 1} {:name "s"}]}
+              {:pets [bv/required [bv/every #(do (prn %) (:name %))]]})
+  => (just nil {:pets [{:name "p" :age 1} {:name "s"}]})
+
+
+  (let [type-repo (-> accumulator/type-repo
+                      (type/named :named-pets [:pets] {:pets [[(fn [pets]
+                                                               (every? :name pets))
+                                                              :message "%s gorp foo! %s"]]
+}))]
+    (type/checked type-repo :named-pets {:pets [{:name "p" :age 1} {:name "s"}]})
+    => {:pets [{:name "p" :age 1} {:name "s"}]}
+    (type/checked type-repo :named-pets {:pets [{:age 1} {:name "s"}]}) => :failure-handler-called
+    (accumulator/messages) => 3
+
+))
+
+(future-fact "preconditions")
+(future-fact "type/all-of and type/some-of")
+(future-fact "double-check validators and extra args")


Function to export any data into JSON format

--- src/emender_jenkins/metadata_exporter.clj
+++ src/emender_jenkins/metadata_exporter.clj
@@ -10,9 +10,12 @@
 ;      Pavel Tisnovsky
 ;

-(ns emender-jenkins.metadata-exporter)
+(ns emender-jenkins.metadata-exporter
+    "Module for exporting selected metadata into selected format.")

-(require '[clojure.data.csv      :as csv])
+(require '[clojure.data.json :as json])
+(require '[clojure.xml       :as xml])
+(require '[clojure.data.csv  :as csv])

 (defn data->csv
     "Convert/format any data to CSV format."
@@ -20,6 +23,11 @@
     (with-out-str
         (csv/write-csv *out* data)))

+(defn data->json
+    "Convert/format any data to JSON format."
+    [products]
+    (json/write-str products))
+
 (defn export2csv
     [columns data]
     (data->csv (cons columns data)))


add open and complement

add open and complement

--- clj-tcp/src/clj_tcp/client.clj
+++ clj-tcp/src/clj_tcp/client.clj
@@ -144,13 +144,15 @@
                                        (>!! internal-error-ch [e nil]))))))))

-(defn closed? [client]
+(defn open? [client]
       (-> client ^ChannelFuture (:channel-f) ^Channel (.channel) (.isOpen)))
+
+(def closed? (complement open?))

 (defn write!
   "Writes and blocks if the write-ch is full"
   [client v]
-  (if (not (closed? client))
+  (if (open? client))
     (>!! (:write-ch client) v)
     (throw (RuntimeException. "Client closed"))))


added example of dealing with SSR form init

--- src/main/fulcro_template/ui/new_user.cljc
+++ src/main/fulcro_template/ui/new_user.cljc
@@ -53,8 +53,11 @@
   ; SSR state cannot properly initialize forms, so we ensure it is initialized on mount. This mutation is safe
   ; to run on an already initialized form, but we only do it once since the extra transact is not necessary
   ; and would be distracting in the logs.
-  (componentWillMount [this]
-    (when-not (f/is-form? (om/props this))
+  (componentWillReceiveProps [this props]                   ; on return to this screen once cleared
+    (when (or (f/server-initialized? props) (not (f/is-form? props)))
+      (om/transact! this `[(f/initialize-form {})])))
+  (componentWillMount [this]                                ; on initial from server
+    (when (or (f/server-initialized? (om/props this)) (not (f/is-form? (om/props this))))
       (om/transact! this `[(f/initialize-form {})])))
   (render [this]
     (let [{:keys [uid name email password password2 ui/password-error ui/create-failed] :as form} (om/props this)


Tweak numbers of spans in about-bam-indexer-small-file tests that came from https://github.com/chrovis/cljam/pull/69#discussion_r113851147

--- test/cljam/t_bam_indexer.clj
+++ test/cljam/t_bam_indexer.clj
@@ -71,10 +71,11 @@
       (with-open [r (bam/reader temp-file-sorted)]
         ;; Random read with different number of spans.
         (are [?param ?counts] (= (count (io/read-alignments r ?param)) ?counts)
-          {:chr "chr1" :start 23000000 :end 25000000 :depth :deep} 14858
-          {:chr "chr1" :start 23000000 :end 24500000 :depth :deep} 11424
-          {:chr "chr1" :start 23000000 :end 24000000 :depth :deep} 10010
-          {:chr "chr1" :start 23000000 :end 23500000 :depth :deep} 3806
+          {:chr "chr1" :start 23000000 :end 23001000 :depth :deep} 46 ;; 1 span
+          {:chr "chr1" :start 24900000 :end 24902000 :depth :deep} 3  ;; 2 spans
+          {:chr "chr1" :start 24000000 :end 24001000 :depth :deep} 6  ;; 3 spans
+          {:chr "chr1" :start 23260000 :end 23268650 :depth :deep} 58 ;; 4 spans
+          {:chr "chr1" :start 23430000 :end 23470000 :depth :deep} 55 ;; 5 spans
           {:chr "*"} 0)))))

 (deftest-slow about-bam-indexer-medium-file


Add test for select.

Add test for select.

--- test/multihash/core_test.clj
+++ test/multihash/core_test.clj
@@ -210,3 +210,18 @@
             (multihash/create :blake2b "68a9f54521a5501230e9dc73")
             content))
         "Unsupported hash function cannot be validated")))
+
+
+(deftest multihash-selection
+  (let [a (multihash/create :sha1 "37b51d194a7513e45b56f6524f2d51f200000000")
+        b (multihash/create :sha1 "73fcffa4b7f6bb68e44cf984c85f6e888843d7f9")
+        c (multihash/create :sha1 "73fe285cedef654fccc4a4d818db4cc225932878")
+        d (multihash/create :sha1 "acbd18db4cc2f856211de9ecedef654fccc4a4d8")
+        e (multihash/create :sha1 "c3c23db5285662ef717963ff4ce2373df0003206")
+        f (multihash/create :sha2-256 "285c3c23d662b5ef7172373df0963ff4ce003206")
+        hashes [a b c d e f]]
+    (are [brs opts] (= brs (multihash/select opts hashes))
+         hashes   {}
+         [c d e f]  {:after "111473fd2"}
+         [b c]      {:prefix "111473"}
+         [f]        {:algorithm :sha2-256})))


fixed borken tests, and json-response wraps exceptions

--- test/ontrail/test/mutate.clj
+++ test/ontrail/test/mutate.clj
@@ -26,8 +26,7 @@
   (is (= (hours 1) (hours-and-minutes 1 0)))
   (is (= (parse-duration "1:0") (hours 1)))
   (is (= (parse-duration "1.0") (hours 1)))
-  (is (= (parse-duration "1.0.0") (hours 1)))
-  (is (= (parse-duration "2.42,2") 16320)))
+  (is (= (parse-duration "2.42,2") 16220)))

 (deftest test-db-insertable-from-basic-user-ex


whitespace

whitespace

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -94,7 +94,8 @@
                 :buyable true
                 :edible false
                 :human false
-                :spec {:of {:human true}}}
+                :spec {:of {:human true}}
+                }

    {:physical-object false} {:animate false}


Some better var names that use better suffxies.

--- src/cbfg/world-storage.cljs
+++ src/cbfg/world-storage.cljs
@@ -22,51 +22,51 @@
            {:opaque opaque :status :not-found
             :key key}))))

-(defn storage-set [actx storage opaque key cas-old val op]
+(defn storage-set [actx storage opaque key old-cas val op]
   (ago storage-set actx
-       (let [cas-check (and cas-old (not (zero? cas-old)))]
+       (let [cas-check (and old-cas (not (zero? old-cas)))]
          (if (and cas-check (= op :add))
            {:opaque opaque :status :wrong-cas :key key}
            (let [res (atom nil)]
              (swap! storage
                     #(let [s1 (assoc % :next-sq (max (:next-sq %)
                                                      (inc (:max-deleted-sq %))))
-                           sq-new (:next-sq s1)
-                           sq-old (get-in s1 [:keys key])]
-                       (if (and (= op :add) sq-old)
+                           new-sq (:next-sq s1)
+                           old-sq (get-in s1 [:keys key])]
+                       (if (and (= op :add) old-sq)
                          (do (reset! res {:opaque opaque :status :exists
                                           :key key})
                              s1)
                          (let [prev-change (when (or cas-check
                                                      (= op :append)
                                                      (= op :prepend))
-                                             (get-in s1 [:changes sq-old]))]
-                           (if (and cas-check (not= cas-old (:cas prev-change)))
+                                             (get-in s1 [:changes old-sq]))]
+                           (if (and cas-check (not= old-cas (:cas prev-change)))
                              (do (reset! res {:opaque opaque :status :wrong-cas
                                               :key key})
                                  s1)
                              (if (and (or (= op :replace)
                                           (= op :append)
                                           (= op :prepend))
-                                      (not sq-old))
+                                      (not old-sq))
                                (do (reset! res {:opaque opaque :status :not-found
                                                 :key key})
                                    s1)
-                               (let [cas-new (gen-cas)
-                                     val-new (case op
+                               (let [new-cas (gen-cas)
+                                     new-val (case op
                                                :add val
                                                :replace val
                                                :append (str (:val prev-change) val)
                                                :prepend (str val (:val prev-change))
                                                val)]
                                  (reset! res {:opaque opaque :status :ok
-                                              :key key :sq sq-new :cas cas-new})
+                                              :key key :sq new-sq :cas new-cas})
                                  (-> s1
-                                     (dissoc-in [:changes sq-old])
-                                     (assoc-in [:keys key] sq-new)
-                                     (assoc-in [:changes sq-new]
-                                               {:key key :sq sq-new :cas cas-new
-                                                :val val-new})
+                                     (dissoc-in [:changes old-sq])
+                                     (assoc-in [:keys key] new-sq)
+                                     (assoc-in [:changes new-sq]
+                                               {:key key :sq new-sq :cas new-cas
+                                                :val new-val})
                                      (update-in [:next-sq] inc)))))))))
              @res)))))


adding physical provider

adding physical provider

--- src/celestial/workflows.clj
+++ src/celestial/workflows.clj
@@ -17,7 +17,7 @@
     [slingshot.slingshot :only  [throw+ try+]]
     [celestial.model :only (vconstruct pconstruct rconstruct)])
   (:require ; loading defmethods
-    proxmox.provider aws.provider vc.provider
+    proxmox.provider aws.provider vc.provider physical.provider
     celestial.puppet_standalone
     remote.capistrano remote.ruby
     [celestial.persistency :as p]


correct bug in getting html file from static dir

--- src/clj/closerve/server.clj
+++ src/clj/closerve/server.clj
@@ -37,8 +37,8 @@
         (let [
               t1-response (response/file-response path opts)
               t1-response (if t1-response t1-response
-                              (if (and (not= 0 (.indexOf path "static/"))
-                                       (= -1 (.indexOf path ".html")))
+                              (if
+                                  (= -1 (.indexOf path ".html"))
                                 (do
                                   (response/file-response (str path ".html") opts))
                                 nil


remove unecessary log

remove unecessary log

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -122,11 +122,9 @@
                  (log/debugf "Catched Exception %s at runtime with message -> %s => already initialized : %s / candidates for init : %s"
                              (type e#) (.getMessage e#) (into #{} already-required#) (into [] nss#))
                  (if (empty? nss#)
-                   (do
-                     (log/errorf e# "ClojureRuntimeException in [%s]" pt-name#)
-                     (throw (ex-info "Runtime exception intercepted"
-                                     (-> {:hostname (get-hostname)}
-                                         (cond-> pt-name# (assoc :name pt-name#))) e#)))
+                   (throw (ex-info "Runtime exception intercepted"
+                                   (-> {:hostname (get-hostname)}
+                                       (cond-> pt-name# (assoc :name pt-name#))) e#))
                    (let [missings# nss# ;; (remove already-required# nss#)
                          missing-at-start?# (not (empty? (remove required-at-start# nss#)))]
                      (if-not (empty? missings#)


dissoc client header from error if any

dissoc client header from error if any

--- src/clj/swarmpit/server.clj
+++ src/clj/swarmpit/server.clj
@@ -24,7 +24,7 @@
     (try
       (handler request)
       (catch ExceptionInfo e
-        (ex-data e)))))
+        (dissoc (ex-data e) :headers)))))

 (defn wrap-fallback-exception
   [handler]


Update search query only if it necessary

--- src/cljs/subman/routes.cljs
+++ src/cljs/subman/routes.cljs
@@ -8,9 +8,12 @@
   "Set value of stable search query"
   [value]
   (when-let [state (secretary/get-config :state)]
-    (swap! state assoc
-           :stable-search-query value
-           :search-query value)))
+    (when (not= (:search-query @state) value)
+      (swap! state assoc
+             :stable-search-query value
+             :search-query value)
+      (swap! state update-in
+             [:search-query-counter] inc))))

 (defn change-url!
   "Change page url"


Added missing import.

Added missing import.

--- src/cmr/http/kit/config.clj
+++ src/cmr/http/kit/config.clj
@@ -1,8 +1,6 @@
 (ns cmr.http.kit.config
   (:require
-   [cmr.exchange.common.file :as file])
-  (:import
-   (clojure.lang Keyword)))
+   [cmr.exchange.common.file :as file]))

 (def config-file "config/cmr-http-kit/config.edn")


Code cleanup

Code cleanup

Code cleanup

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -623,6 +623,33 @@

+(defn update-query-in-cache [query]
+  (let [
+        record-count       (get-count   (get query :db-table)  (get query :where)   (get query :params))
+
+
+
+        results            (get-results    :db-table (get query :db-table)
+                                           :where    (get query :where)
+                                           :order    (get query :order)
+                                           :start    (get query :start)
+                                           :end      (get query :end)
+                                           :params   (get query :params)
+                                           )
+
+        result-id-vector   (into [] (map :id results))
+        ]
+    (do
+      (println (str "    " query))
+      (swap! cached-queries assoc  query {
+                                          :records      result-id-vector
+                                          :count        record-count
+                                          }))))
+
+
+
+
+

@@ -635,65 +662,74 @@
    (doall (for [query queries]
             (do
               (if (= (get query :db-table) (get realtime-log-entry :record_table_name))
-                (println (str "    " query))))
-   )))))
-
-
-
-
-
-
+                (println (str "    " query)))))))))
+
+
+
+
+
+
+
+
+
+
+; ----------------------------------------------------------------
+; Whenever a database record changes it get processed here on the
+; server
+; ----------------------------------------------------------------
 (go
   (loop []
     (do
         (let [realtime-log-entry   (<! server-side-record-changes)]
             (process-log-entry  realtime-log-entry )
         )
-        (recur)
-      )
-    ))
-
-
-
-
+        (recur))))
+
+
+
+
+
+
+
+
+
+; ----------------------------------------------------------------
+; Check every 1 second for record changes on the database. If
+; a record changes then send the log entry details to to the
+; channel 'server-side-record-changes'
+; ----------------------------------------------------------------
 (def my-pool (mk-pool))
-
-
-
-
 (every 1000 (fn []
-              (let [next-id   (next-realtime-id)
-
-                    sql (str "update coils_realtime_log"
-                            "      set record_status = 'PROCESSING',"
-                            "          realtime_jvm_id = ? "
-                            "where "
-                            "      id in ( SELECT "
-                            "                    id"
-                            "              FROM "
-                            "                    coils_realtime_log"
-                            "              WHERE "
-                            "                   record_status='WAITING' LIMIT 1 ) "
-                    )
-
-                    get-realtime-log-entry (str "select * from coils_realtime_log "
-                                                "WHERE "
-                                                "realtime_jvm_id = ?")
+              (let [next-id                           (next-realtime-id)
+
+                    sql                               (str "update coils_realtime_log"
+                                                           "      set record_status = 'PROCESSING',"
+                                                           "          realtime_jvm_id = ? "
+                                                           "where "
+                                                           "      id in ( SELECT "
+                                                           "                    id"
+                                                           "              FROM "
+                                                           "                    coils_realtime_log"
+                                                           "              WHERE "
+                                                           "                   record_status='WAITING' LIMIT 1 ) "
+                                                           )
+
+                    get-realtime-log-entry            (str "select * from coils_realtime_log "
+                                                           "WHERE "
+                                                           "realtime_jvm_id = ?")
+
+                    how-many-records-have-changed?    (first  (korma.core/exec-raw [sql [next-id]] []))
                     ]
-                     (let [get-new-entry-count    (korma.core/exec-raw [sql [next-id]] []) ]
-                       (do
-                       (println "processing: " get-new-entry-count )
-                       ;(println (str @cached-queries))
-                        (if (pos? (first get-new-entry-count))
-                          (do
-                        (let [realtime-log-entry-list
-                              (korma.core/exec-raw [get-realtime-log-entry [next-id]] :results)
-                              realtime-log-entry (first realtime-log-entry-list)
-                                ]
-                          (go
-                            (if realtime-log-entry
-                               (>! server-side-record-changes  realtime-log-entry)))
-                          ))))
-                 ))) my-pool )
-
-
+                (do
+                  (println "How many real time records have changed? " how-many-records-have-changed? )
+                  (if (pos? how-many-records-have-changed?)
+                    (do
+                      (let [realtime-log-entry-list     (korma.core/exec-raw [get-realtime-log-entry [next-id]] :results)
+                            realtime-log-entry          (first realtime-log-entry-list)
+                            ]
+                        (go
+                         (if realtime-log-entry
+                           (>! server-side-record-changes  realtime-log-entry)))
+                        )))))) my-pool)
+
+


remove auth tests

remove auth tests

--- test/doc/sync.clj
+++ test/doc/sync.clj
@@ -6,7 +6,6 @@
             [geschichte.p2p.publish-on-request :refer [publish-on-request]]
             [geschichte.p2p.hash :refer [ensure-hash]]
             [geschichte.p2p.log :refer [logger]]
-            [geschichte.p2p.auth :refer [auth]]
             [geschichte.repo :as repo]
             [geschichte.platform :refer [create-http-kit-handler! start stop]]
             [konserve.store :refer [new-mem-store]]
@@ -34,10 +33,6 @@
          handler (create-http-kit-handler! "ws://127.0.0.1:9090/")
          ;; remote server to sync to
          remote-store (<!! (new-mem-store))
-         local-users {"john" "haskell" "jane" "lisp"}
-         input-users {"john" "haskell" "jane" "lisp"}
-         auth-fn (fn [users] (go (into {} (filter #(users (key %)) input-users ))))
-         cred-fn (fn [token] (if (= (:password token) (get local-users (:username token))) true nil))
          _ (def remote-peer (server-peer handler remote-store (comp (partial logger log-atom :remote-core)
                                                                     (partial fetch remote-store)
                                                                     (partial publish-on-request remote-store))))
@@ -48,8 +43,7 @@
          local-store (<!! (new-mem-store))
          _ (def local-peer (client-peer "CLIENT" local-store (comp (partial logger log-atom :local-core)
                                                                    (partial fetch local-store)
-                                                                   (partial publish-on-request local-store)
-                                                                   (partial auth local-store auth-fn cred-fn (atom #{})))))
+                                                                   (partial publish-on-request local-store))))
          ;; hand-implement stage-like behaviour with [in out] channels
          in (chan)
          out (chan)]
@@ -90,46 +84,6 @@
                                    :branches {"master" #{2}}
                                    :schema {:type :geschichte
                                             :version 1}}}}})
-     ;; auth required
-     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 5}
-     ;; send some credentials
-     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häßkl"}})
-     ;; ups
-     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 4}
-     ;; let's try again
-     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häskl"}})
-     ;; wrong, how could that be?
-     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 3}
-     ;; oh my, next try
-     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häskel"}})
-     ;; wrong again
-     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 2}
-     ;; it's getting close
-     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häsckl"}})
-     ;; doh, wrong again
-     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 1}
-     ;; last try
-     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "häskil"}})
-     ;; oh no, epic fail
-     (<!! in) => {:topic :geschichte.p2p.auth/auth-failed, :users #{"john"}}
-     ;; let's try again
-     (>!! out {:topic :meta-pub,
-               :peer "STAGE",
-               :metas {"john" {42 {:id 42
-                                   :causal-order {1 []
-                                                  2 [1]}
-                                   :last-update (java.util.Date. 0)
-                                   :description "Bookmark collection."
-                                   :head "master"
-                                   :branches {"master" #{2}}
-                                   :schema {:type :geschichte
-                                            :version 1}}}}})
-     ;; auth required again
-     (<!! in) => {:topic :geschichte.p2p.auth/auth-required, :users #{"john"},:tries-left 5}
-     ;; this time with correct password
-     (>!! out {:topic :geschichte.p2p.auth/auth :users {"john" "haskell"}})
-     ;; authed
-     (<!! in) => {:topic :geschichte.p2p.auth/authed, :users #{"john"}}
      ;; the peer replies with a request for missing commit values
      (<!! in) => {:topic :fetch,
                   :ids #{1 2}}
@@ -161,8 +115,7 @@
                                       :head "master",
                                       :pull-requests {}
                                       :branches {"master" #{2}}
-                                      :schema {:type :geschichte, :version 1}}}}
-                  :users #{"john"}, :geschichte.p2p.auth/authed true}
+                                      :schema {:type :geschichte, :version 1}}}}}

      ;; ack
      (>!! out {:topic :meta-pubed
@@ -178,8 +131,6 @@
                                    :branches {"master" #{3}}
                                    :schema {:type :geschichte
                                             :version 1}}}}})
-     ;; already authed
-     (<!! in) => {:topic :geschichte.p2p.auth/authed, :users #{"john"}}
      ;; again a new commit value is needed
      (<!! in) => {:topic :fetch,
                   :ids #{3}}
@@ -209,8 +160,6 @@
                                       :pull-requests {},
                                       :schema {:type :geschichte, :version 1}}}},
                   :peer "CLIENT",
-                  :users #{"john"}
-                  :geschichte.p2p.auth/authed true
                   :topic :meta-pub}
      ;; ack
      (>!! out {:topic :meta-pubed


Store delayer in metadata

Store delayer in metadata

--- src/cyanite_cache/cache.clj
+++ src/cyanite_cache/cache.clj
@@ -35,10 +35,12 @@

 (defn run-delayer!
   [rollup flusher]
-  (let [flush-delay (+ (int rollup) wait-time (rand-int 59))]
+  (let [flush-delay (+ (int rollup) wait-time (rand-int 59))
+        delayer (future (Thread/sleep (* flush-delay 1000)))]
     (future
-      (Thread/sleep (* flush-delay 1000))
-      (flusher))))
+      (deref delayer)
+      (flusher))
+    delayer))

 (defn get-pkeys!
   [mkeys tkeys tenant period rollup time ttl fn-data fn-agg fn-store]
@@ -49,12 +51,12 @@
              (let [pkeys (atom [])
                    flusher (create-flusher mkeys tkeys pkeys tenant period
                                            rollup time ttl fn-data fn-agg
-                                           fn-store)]
+                                           fn-store)
+                   delayer (run-delayer! rollup flusher)]
                (swap! pkeys
                       (fn [pkeys]
-                        (with-meta pkeys {:flusher flusher})))
-               (assoc! tkeys time pkeys)
-               (run-delayer! rollup flusher))))
+                        (with-meta pkeys {:flusher flusher :delayer delayer})))
+               (assoc! tkeys time pkeys))))
          time)
   (get @tkeys time))


Updated clojure example

Updated clojure example

--- 2048-June2015/ShawnCampbellClojure/codeeval_2048/src/codeeval_2048/core.clj
+++ 2048-June2015/ShawnCampbellClojure/codeeval_2048/src/codeeval_2048/core.clj
@@ -7,22 +7,27 @@
   ; Read each line ignoring empty ones
   (doseq [line (remove empty? (line-seq rdr))]
     (parseLine line)))
-
+; First in the function cascade
+; Parses a line of the game board
 (defn parseLine
   [line]
   (let direction (get_direction line))
   (let grid_size (get_grid_size line))
   (println (do_move direction grid_size line 0)))

+; Get the direction of the game move
 (defn get_direction
   [line]
   (nth (split line #";") 1)
   )

+; Get the size of the grid
 (defn get_grid_size
   [line]
   (nth (split line #";") 2))

+
+; Starts the move
 (defn do_move
   [direction grid_size line movement]
   (let grid_lines (nth (split line #";") 3))
@@ -30,11 +35,13 @@
   (for [i (range grid_size)] (get_line grid direction (movement * i)))
   )

+; Grab the line to process
 (defn get_line
   [grid_lines direction line_no]
   (if (= direction "RIGHT")
     (ret_line (nth grid_lines line_no)))
   (if (= direction "LEFT")
+    ; Gah this is ugly and if I didn't suck at clojure I'd know a better way
     (reverse (ret_line (reverse (nth grid_lines line_no)))))
   (if (= direction "DOWN")
     (ret_line (get_column grid_lines line_no)))
@@ -42,6 +49,8 @@
      (reverse (ret_line (reverse (get_column grid_lines line_no)))))
   )

+
+; Grab indiviual columns to work on
 (defn get_column
   [grid_lines line_no]
   (map #(nth % line_no) grid_lines)
@@ -55,14 +64,23 @@
   (for [i (range (count non_zero_vals))] (combine_indexes non_zero_vals i (+ i 1)))
   )

+; Basic Utilities functions below here
+
+
+
+; Filter out certain the passed in index passed in
+; used to skip zero's
 (defn index-exclude
   [r ex]
   (filter #(not (ex %)) (range r)))

+; dissociate indexes of nonzero values
 (defn dissoc-idx
   [v & ds]
   (map v (index-exclude (count v) (into #{} ds))))

+; So this crazy thing is poorly named but basically it returns a 0, the static value
+; or the Combined values, basically aggegrating all the info together
 (defn combine_indexes
   [line current_index next_index]


Add github issue action test.

Add github issue action test.

--- test/clj/hatnik/selenium/actions_test.clj
+++ test/clj/hatnik/selenium/actions_test.clj
@@ -94,8 +94,11 @@
                                     :actions []}])))))

 (defn change-action-type [driver type]
-  (.selectByValue (Select. (find-element driver "#action-type"))
-                  type))
+  (let [select (find-element driver "#action-type")]
+    (.selectByValue (Select. select) type)
+    ; Yet another hack. For some reason action type not always selected
+    ; completely. We fix it by clicking on select element.
+    (.click select)))

 (defn set-input-text-from-map [driver map]
   (doseq [[id text] map]
@@ -142,9 +145,56 @@
                :email-subject "New subject"
                :email-body "New body"}))))))

+(deftest github-issue-action-test
+  (run-with-driver
+   (fn [driver]
+
+     ; Create action
+     (let [[project] (find-projects-on-page driver)]
+       (open-add-action-dialog driver project)
+       (change-action-type driver "github-issue")
+       (set-input-text-from-map driver
+                                {:library-input "quil"
+                                 :gh-repo "nbeloglazov/hatnik"
+                                 :gh-issue-title "Issue title"
+                                 :gh-issue-body "Issue body"})
+       (apply-changes driver))
+
+     ; Check that action has expected fields
+     (let [[project] (find-projects-on-page driver)
+           action (first (:actions project))]
+       (open-edit-action-dialog driver action)
+       (is (= (action-params driver)
+              {:library-input "quil"
+               :action-type "github-issue"
+               :gh-repo "nbeloglazov/hatnik"
+               :gh-issue-title "Issue title"
+               :gh-issue-body "Issue body"})))
+
+     ; Update action
+     (set-input-text-from-map driver
+                              {:library-input "ring"
+                               :gh-repo "quil/quil"
+                               :gh-issue-title "New title"
+                               :gh-issue-body "New body"})
+     (apply-changes driver)
+
+     ; Check updated action
+     (let [[project] (find-projects-on-page driver)
+           action (first (:actions project))]
+       (open-edit-action-dialog driver action)
+       (is (= (action-params driver)
+              {:library-input "ring"
+               :action-type "github-issue"
+               :gh-repo "quil/quil"
+               :gh-issue-title "New title"
+               :gh-issue-body "New body"}))))))
+
 (comment

-  (start-test-system)
+  (def system (start-test-system))
+
+  (com.stuartsierra.component/stop system)

   (create-delete-test)


rule head now generates appropriate subclasses for drug and target

the previous version of this rule referenced the parent bio-entities
for both the drug and target in the interaction restrictions previously
(which is incorrect).

--- kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/temp/drugbank/drugbank_rules.clj
+++ kabob-build/src/main/resources/edu/ucdenver/ccp/kabob/build/rules/temp/drugbank/drugbank_rules.clj
@@ -15,15 +15,23 @@
          (?/interaction rdfs/subClassOf obo/MI_0407) ;direct interaction
          (?/interaction rdfs/subClassOf obo/GO_0005488) ;binding

+         ;; create a subclass of the target that will participate in this
+         ;; particular binding
+         (?/target rdfs/subClassOf ?/target_bioentity)
+
           ;; link the binding event to the target participant (protein in this case)
          (?/r_target_participant rdf/type owl/Restriction)
          (?/r_target_participant owl/onProperty obo/RO_0000057) ; has_participant
-         (?/r_target_participant owl/someValuesFrom ?/target_bioentity)
+         (?/r_target_participant owl/someValuesFrom ?/target)
+
+         ;; create a subclass of the drug molecule that will participate
+         ;; in this particular binding
+         (?/drug rdfs/subClassOf ?/drug_bioentity)

           ;; link the binding event to the drug
          (?/r_drug_participant rdf/type owl/Restriction)
          (?/r_drug_participant owl/onProperty obo/RO_0000057) ; has_participant
-         (?/r_drug_participant owl/someValuesFrom ?/drug_bioentity)
+         (?/r_drug_participant owl/someValuesFrom ?/drug)

           ;; this binding realizes the drug_role that inheres_in the drug
          (?/r_realizes_drug_role rdf/type owl/Restriction)
@@ -35,7 +43,7 @@
          ;;   so that it can be realized by the restriction above
          (?/r_inheres rdf/type owl/Restriction)
          (?/r_inheres owl/onProperty obo/RO_0000052) ;inheres_in
-         (?/r_inheres owl/someValuesFrom ?/drug_bioentity)
+         (?/r_inheres owl/someValuesFrom ?/drug)

          (?/inheres rdfs/subClassOf obo/CHEBI_23888) ;drug (role)
          (?/inheres rdfs/subClassOf ?/r_inheres)
@@ -72,6 +80,10 @@

   :reify ([?/interaction {:ln (:sha-1 "interaction" ?/target_bioentity ?/drug_bioentity)
                           :ns "kbio" :prefix "I_"}]
+          [?/target {:ln (:sha-1 ?/target_bioentity ?/drug_bioentity)
+                    :ns "kbio" :prefix "T_"}]
+          [?/drug {:ln (:sha-1 ?/target_bioentity ?/drug_bioentity)
+                    :ns "kbio" :prefix "D_"}]
           [?/r_target_participant {:ln (:restriction)
                  :ns "kbio" :prefix "RESTR_"}]
           [?/r_drug_participant {:ln (:restriction)


use img instead of image

use img instead of image

--- src/hiccup/page_helpers.clj
+++ src/hiccup/page_helpers.clj
@@ -111,8 +111,8 @@

 (defelem image
   "Create an image tag"
-  ([src]     [:image {:src (resolve-uri src)}])
-  ([src alt] [:image {:src (resolve-uri src), :alt alt}]))
+  ([src]     [:img {:src (resolve-uri src)}])
+  ([src alt] [:img {:src (resolve-uri src), :alt alt}]))

 (defn encode-params
   "Turn a map of parameters into a urlencoded string."


UI tweak + typo

UI tweak + typo

--- src/instapapure/servlet.clj
+++ src/instapapure/servlet.clj
@@ -57,7 +57,7 @@
               :style (str "display: " (if displayed "inline" "none"))}])
 (defn star-empty-image [displayed]
   [:img.star-empty {:src "/public/i/star-empty.png"
-              :title "Sar it"
+              :title "Star it"
               :style (str "display: " (if displayed "inline" "none"))}])
 (def delete-image
   [:img.delete {:src "/public/i/cross.png" :title "Delete it"}])
@@ -149,24 +149,24 @@
 (defn unread-help []
   (html
     [:div.help
-      [:p "Nothing to read?"]
+      [:p [:em "Nothing to read?"]]
       [:p "Drag the bookmarklet " (link-to bookmarklet "Read later") "
-        in your menu bar and use it next time you
-        find a good article you want to read later"]
+        in your menu bar and use it next time you find a good article you want
+        to read later"]
       [:p "You can also save articles directly from Google Reader (see the "
           (link-to "/public/google-reader.html" "instructions") ")."]]))

 (defn archive-help []
   (html
     [:div.help
-      [:p "Nothing in the archive?"]
+      [:p [:em "Nothing in the archive?"]]
       [:p "When you have read an unread article, it will be moved to the archive.
           It will remain there until you delete it."]]))

 (defn starred-help []
   (html
     [:div.help
-      [:p "Nothing starred?"]
+      [:p [:em "Nothing starred?"]]
       [:p "If you find a good article you really like, you can \"star\" it by
         clicking on " (star-empty-image true) " at the left of the article. Starred article will always
         be displayed in the " (link-to "/starred" "Starred") " section


adding test test

adding test test

--- src/leiningen/new/closp.clj
+++ src/leiningen/new/closp.clj
@@ -75,7 +75,7 @@

               ["README.md" (*render* "README.md")]

-              [(str "test/clj/db/{{san-path}}/user_test.clj") (*render* "test/clj/db/user_test.clj")]
+              [(str "test/clj/{{san-path}}/db/user_test.clj") (*render* "test/clj/db/user_test.clj")]

               ]))


Update ThreeDeeIntersect.clj

Update ThreeDeeIntersect.clj

--- clojure/ThreeDeeIntersect.clj
+++ clojure/ThreeDeeIntersect.clj
@@ -29,11 +29,10 @@
                               (Math/pow (- y k) 2.0)
                               (Math/pow (- z l) 2.0))
                               (Math/pow r 2.0))
-                av (Math/abs dSphere)
+                dist (- 0 dSphere)
                ]
-               (print (cond (< av 1) "@"  ;; Centered on charracter - darkest symbol
-                            (< av 10) "*" ;; Almost centered - lighter symbol
-                            (< av 40) "'" ;; Within 1/2 character - lightest symbol
+               (print (cond (and (> dist 0) (< dist 20)) "*" ;; Almost centered - lighter symbol
+                            (and (> dist 0) (< dist 70)) "'" ;; Within 1/2 character - lightest
                             (= 0 (rem x 10)) (if (= 0 (rem y 10)) "+" "|") ;; Vertical grid line
                             (= 0 (rem y 10)) "-" ;; Horizontal grid line
                             :else " "))))        ;; Background
@@ -43,9 +42,8 @@
 (dotimes [t 61]
          (showSphere (+ 40 (* 20 (Math/sin (* t (/ Math/PI 30)))))
                      (+ 20 (* 10 (Math/cos (* t (/ Math/PI 20)))))
-                     (- t 30) 30)
+                     (- t 30) 30.1)
          (Thread/sleep (if (< t 11)          ;; First few frames slower
                            (let [n (- 17 t)]
                                 (* n n 4))
                            150)))            ;; Subsequent frames faster
-


(maint) Check for error logging in test

(maint) Check for error logging in test

--- test/puppetlabs/trapperkeeper/services/status/status_core_test.clj
+++ test/puppetlabs/trapperkeeper/services/status/status_core_test.clj
@@ -67,18 +67,19 @@
         (update-status-context status-fns "quux" "1.1.0" 1 (fn [_] (Thread/sleep 2000) {:state :running
                                                                                :status "aw yis"}))
         (with-redefs [puppetlabs.trapperkeeper.services.status.status-core/check-timeout (constantly 1)]
-          (let [result (with-test-logging
-                         (call-status-fn-for-service "quux" (get @status-fns "quux") :debug))]
-            (testing "state is set properly"
-              (is (= :unknown (:state result))))
-            (testing "status is set to explain timeout"
-              (is (= "Status check timed out after 1 seconds" (:status result)))))))
+          (with-test-logging
+            (let [result (call-status-fn-for-service "quux" (get @status-fns "quux") :debug)]
+              (testing "state is set properly"
+                (is (= :unknown (:state result))))
+              (testing "status is set to explain timeout"
+                (is (= "Status check timed out after 1 seconds" (:status result))))))))

       (testing "and it is from the status reporting function"
         (update-status-context status-fns "bar" "1.1.0" 1 (fn [_] (throw (Exception. "don't"))))
-        (let [result (with-test-logging
-                       (call-status-fn-for-service "bar" (get @status-fns "bar") :debug))]
-          (testing "status contains exception"
-            (is (re-find #"don't" (pr-str result))))
-          (testing "state is set properly"
-            (= :unknown (:state result))))))))
+        (with-test-logging
+          (let [result (call-status-fn-for-service "bar" (get @status-fns "bar") :debug)]
+            (is (logged? #"Status check threw an exception" :error))
+            (testing "status contains exception"
+              (is (re-find #"don't" (pr-str result))))
+            (testing "state is set properly"
+              (= :unknown (:state result)))))))))


Use destructuring when grabbing field values

--- src/mavlink/mavlink_xml.clj
+++ src/mavlink/mavlink_xml.clj
@@ -47,28 +47,24 @@
   (if-let [node (zip-xml/xml1-> m :extensions)]
     (remove nil?
             (mapv #(when (= (:tag %) :field)
-                     (let [fld-name (-> % :attrs :name)
-                           type-name (-> % :attrs :type)
-                           enum-name (-> % :attrs :enum)]
-                       {:fld-name fld-name
-                        :name-key (keyword fld-name)
-                        :type-key (get-type type-name)
-                        :enum-type (when enum-name
-                                     (keywordize enum-name))
-                        :length (get-array-length type-name) }))
+                     (let [{:keys [enum name type]} (:attrs % first)]
+                       {:fld-name name
+                        :name-key (keyword name)
+                        :type-key (get-type type)
+                        :enum-type (when enum
+                                     (keywordize enum))
+                        :length (get-array-length type) }))
                   (zip/lefts node)))
     (vec
       (zip-xml/xml-> m :field
         (fn [f]
-          (let [fld-name (-> f first :attrs :name)
-                type-name (-> f first :attrs :type)
-                enum-name (-> f first :attrs :enum)]
-            {:fld-name fld-name
-             :name-key (keyword fld-name)
-             :type-key (get-type type-name)
-             :enum-type (when enum-name
-                          (keywordize enum-name))
-             :length (get-array-length type-name) }))))))
+          (let [{:keys [enum name type]} (-> f first :attrs)]
+            {:fld-name name
+             :name-key (keyword name)
+             :type-key (get-type type)
+             :enum-type (when enum
+                          (keywordize enum))
+             :length (get-array-length type) }))))))

 (defn get-extension-fields
   "Returns just the extension fields of a message; or nil if there are none."
@@ -77,15 +73,13 @@
     (when-let [ext-fields (zip/rights node)]
       (vec
         (for [f ext-fields]
-          (let [fld-name (-> f :attrs :name)
-                type-name (-> f :attrs :type)
-                enum-name (-> f :attrs :enum)]
-            {:fld-name fld-name
-             :name-key (keyword fld-name)
-             :type-key (get-type type-name)
-             :enum-type (when enum-name
-                          (keywordize enum-name))
-             :length (get-array-length type-name)
+          (let [{:keys [enum name type]} (:attrs f)]
+            {:fld-name name
+             :name-key (keyword name)
+             :type-key (get-type type)
+             :enum-type (when enum
+                          (keywordize enum))
+             :length (get-array-length type)
              }))))))

 (defn sort-fields


Add pass message to lazytest-asserts

Add pass message to lazytest-asserts

--- src/asserts/lazytest_asserts.clj
+++ src/asserts/lazytest_asserts.clj
@@ -145,3 +145,5 @@

 (describe *ns* "Dummy spec to thwart run-spec"
           (is (= 1 1)))
+
+(println "All assertions in lazytest-asserts passed.")


Added forkjoin dependency

Added forkjoin dependency

--- clojure/basics/project.clj
+++ clojure/basics/project.clj
@@ -3,6 +3,7 @@
   :url "http://example.com/FIXME"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.5.1"]]
+  :dependencies [[org.clojure/clojure "1.5.1"]
+                 [org.codehaus.jsr166-mirror/jsr166y "1.7.0"]]
   :aot [basics.core]
   :main basics.core)


Pad filename to avoid too short name

Pad filename to avoid too short name

--- jar-async/src/slipstream/async/metric_updator.clj
+++ jar-async/src/slipstream/async/metric_updator.clj
@@ -31,7 +31,7 @@
 (defn update
   [user]
   (let [xml-str (get-measurements user)
-        tmp-file (java.io.File/createTempFile (.getName user) ".xml")]
+        tmp-file (java.io.File/createTempFile (str "measures-" (.getName user)) ".xml")]
     (try
       (do
         (with-open [w (clojure.java.io/writer tmp-file)]


Return a 409 conflict if the user tries to create a second org for the same team.

--- src/oc/storage/api/orgs.clj
+++ src/oc/storage/api/orgs.clj
@@ -129,6 +129,11 @@

 ;; ----- Validations -----

+(defn- is-first-org? [conn user]
+  {:pre (db-common/conn? conn)}
+  (let [authed-orgs (org-res/list-orgs-by-teams conn (:teams user))]
+    (zero? (count authed-orgs))))
+
 (defn- valid-new-org? [conn ctx]
   (try
     ;; Create the new org from the data provided
@@ -288,6 +293,8 @@
     :options true
     :post (fn [ctx] (valid-new-org? conn ctx))})

+  :conflict? (fn [ctx] (not (is-first-org? conn (:user ctx))))
+
   ;; Actions
   :post! (fn [ctx] (create-org conn ctx))


Add missing dependencies to synth ns

Add missing dependencies to synth ns

--- src/overtone/inst/synth.clj
+++ src/overtone/inst/synth.clj
@@ -1,9 +1,10 @@
 (ns overtone.inst.synth
   (:use [overtone.sc ugens envelope]
-        [overtone.sc.cgens mix]
+        [overtone.sc.cgens mix line]
         [overtone.sc.machinery.ugen.fn-gen]
         [overtone.music pitch]
-        [overtone.studio mixer inst]))
+        [overtone.studio mixer inst]
+        [overtone.algo.chance :only [ranged-rand]]))

 ;; translated from: https://github.com/supercollider-quarks/SynthDefPool/blob/master/pool/apad_mh.scd
 (definst simple-flute [freq 880


WIP: Replace printer using Fipp

WIP: Replace printer using Fipp

--- src/pinpointer/printer.cljc
+++ src/pinpointer/printer.cljc
@@ -4,78 +4,84 @@
             [fipp.engine :as fipp]
             [fipp.visit :as visit]))

-(def ^:dynamic *trace*)
+(defn- with-highlighting [printer f & args]
+  (if (empty? (:trace printer))
+    [:group "<<<" (apply f (:base-printer printer) args) ">>>"]
+    (apply f (:base-printer printer) args)))

-(defn- wrap-highlighting [f]
-  (bound-fn [& args]
-    (if (empty? *trace*)
-      [:group "<<<" (apply f args) ">>>"]
-      (apply f args))))
+(defn- pop-trace [printer]
+  (update printer :trace rest))

-(defn- with-trace-pop [x f]
-  #_(clojure.core/prn :trace *trace*)
-  #_(clojure.core/prn :x x)
-  (if (= x (:val (first *trace*)))
-    (binding [*trace* (rest *trace*)]
-      (f))
-    (f)))
+(defn- pop-trace-if-matches [printer x]
+  (if (= x (:val (first (:trace printer))))
+    (pop-trace printer)
+    printer))

-(defrecord HighlightPrinter [base-printer]
+(defn- pretty-coll [printer open xs sep close f]
+  (let [xform (comp (map #(f printer %))
+                    (interpose sep))
+        ys (sequence xform xs)]
+    [:group open ys close]))
+
+(defrecord HighlightPrinter [base-printer trace]
   visit/IVisitor
   (visit-unknown [this x]
-    ((wrap-highlighting visit/visit-unknown) base-printer x))
+    (with-highlighting this visit/visit-unknown x))
   (visit-nil [this]
-    ((wrap-highlighting visit/visit-nil) base-printer))
+    (with-highlighting this visit/visit-nil))
   (visit-boolean [this x]
-    ((wrap-highlighting visit/visit-boolean) base-printer x))
+    (with-highlighting this visit/visit-boolean x))
   (visit-string [this x]
-    ((wrap-highlighting visit/visit-string) base-printer x))
+    (with-highlighting this visit/visit-string x))
   (visit-character [this x]
-    ((wrap-highlighting visit/visit-character) base-printer x))
+    (with-highlighting this visit/visit-character x))
   (visit-symbol [this x]
-    ((wrap-highlighting visit/visit-symbol) base-printer x))
+    (with-highlighting this visit/visit-symbol x))
   (visit-keyword [this x]
-    ((wrap-highlighting visit/visit-keyword) base-printer x))
+    (with-highlighting this visit/visit-keyword x))
   (visit-number [this x]
-    ((wrap-highlighting visit/visit-number) base-printer x))
+    (with-highlighting this visit/visit-number x))
   (visit-seq [this x]
-    (with-trace-pop x
-      (wrap-highlighting
-        #(edn/pretty-coll this "(" x :line ")" visit/visit))))
+    (with-highlighting this
+      (fn [_]
+        (let [printer (pop-trace-if-matches this x)]
+          (edn/pretty-coll printer "(" x :line ")" visit/visit)))))
   (visit-vector [this x]
-    (with-trace-pop x
-      (wrap-highlighting
-        #(edn/pretty-coll this "[" x :line "]" visit/visit))))
+    (with-highlighting this
+      (fn [_]
+        (let [printer (pop-trace-if-matches this x)]
+          (edn/pretty-coll printer "[" x :line "]" visit/visit)))))
   (visit-map [this x]
-    (with-trace-pop x
-      (wrap-highlighting
-        #(edn/pretty-coll this "{" x [:span "," :line] "}"
-           (fn [printer [k v]]
-             [:span (visit/visit printer k) " " (visit/visit printer v)])))))
+    (with-highlighting this
+      (fn [_]
+        (let [printer (pop-trace-if-matches this x)]
+          (edn/pretty-coll printer "{" x [:span "," :line] "}"
+            (fn [printer [k v]]
+              [:span (visit/visit printer k) " " (visit/visit printer v)]))))))
   (visit-set [this x]
-    (with-trace-pop x
-      (wrap-highlighting
-        #(edn/pretty-coll this "#{" x :line "}" visit/visit))))
+    (with-highlighting this
+      (fn [_]
+        (let [printer (pop-trace-if-matches this x)]
+          (edn/pretty-coll printer "#{" x :line "}" visit/visit)))))
   (visit-tagged [this x]
-    ((wrap-highlighting visit/visit-tagged) base-printer x))
+    (with-highlighting this visit/visit-tagged x))
   (visit-meta [this meta x]
-    ((wrap-highlighting #(visit/visit-meta %1 meta %2)) base-printer x))
+    (with-highlighting this #(visit/visit-meta %1 meta %2) x))
   (visit-var [this x]
-    ((wrap-highlighting visit/visit-var) base-printer x))
+    (with-highlighting this visit/visit-var x))
   (visit-pattern [this x]
-    ((wrap-highlighting visit/visit-pattern) base-printer x))
+    (with-highlighting this visit/visit-pattern x))
   (visit-record [this x]
-    ((wrap-highlighting visit/visit-record) base-printer x))
+    (with-highlighting this visit/visit-record x))
   )

-(defn highlight-printer []
+(defn highlight-printer [trace]
   (let [base-printer (edn/map->EdnPrinter {:symbols {}})]
-    (->HighlightPrinter base-printer)))
+    (->HighlightPrinter base-printer trace)))

 (defn pprint [x trace]
-  (let [printer (highlight-printer)]
-    (binding [*trace* trace]
-      (fipp/pprint-document (visit/visit printer x) {}))))
+  (let [printer (highlight-printer trace)]
+    (fipp/pprint-document (visit/visit printer x) {})))

 (defn pr [x])


upgrade mranderson to 0.4.5 and replace get-last-sexp...

implementation with one which uses `search-sexp-boundary`

- that fixes the misteriously failing find-macro test

--- src/refactor_nrepl/util.clj
+++ src/refactor_nrepl/util.clj
@@ -164,31 +164,8 @@
                          (search-sexp-boundary (partial = 0))))]
     (cut-sexp file-content sexp-start sexp-end)))

-(defn get-last-sexp
-  "Read and return the last sexp in FILE-CONTENT"
-  [file-content]
-  (let [open #{\( \[ \{}
-        close #{\) \] \}}]
-    ;; Reverse the remaining content of the file
-    ;; Put the last char, which is a closing delimiter, into SEXP and
-    ;; drop it from TOKS.
-    ;; Keep reading into SEXP until depth reaches 0.
-    ;; Finally reverse SEXP, turn it into a string and read the
-    ;; containing sexp.
-    (loop [sexp [(first (reverse file-content))], depth 1,
-           toks (seq (rest (reverse file-content)))]
-      (cond
-        (not (seq toks))(throw (IllegalStateException. "Unbalanced region!"))
-        (= depth 0) (let [next-token (first toks)]
-                      (if (= next-token \#)
-                        (apply str "#" (reverse sexp))
-                        (apply str (reverse sexp))))
-
-        (get open (first toks))
-        (recur (conj sexp (first toks)) (dec depth) (rest toks))
-
-        (get close (first toks))
-        (recur (conj sexp (first toks)) (inc depth) (rest toks))
-
-        :else
-        (recur (conj sexp (first toks)) depth (rest toks))))))
+(defn get-last-sexp [file-content]
+  (let [trimmed-content (str/trim file-content)
+        sexp-start (search-sexp-boundary (partial > 0) :backwards trimmed-content)
+        sexp-end (search-sexp-boundary (partial = 0) :backwards trimmed-content)]
+    (cut-sexp trimmed-content sexp-start sexp-end)))


Document the behavior of strip-guard-prefix.

--- src/spiral/experimental.clj
+++ src/spiral/experimental.clj
@@ -31,7 +31,11 @@
             (async/>! (:async-response req) shed-response)))))
     req-chan))

-(defn- strip-guard-prefix [path guard]
+(defn- strip-guard-prefix
+  "Strips the guard string from the front of the path, returning the
+   suffix string or nil if the path is nil or the resulting suffix is
+   \"\"."
+  [path guard]
   (when path
     (let [suffix (.substring ^String path (count guard))]
       (when-not (empty? suffix) suffix))))


Fixed typo in build-fetch-options to use .chunkSize rather than .checkSize

--- gaeshi/src/gaeshi/datastore.clj
+++ gaeshi/src/gaeshi/datastore.clj
@@ -306,7 +306,7 @@
       (when limit (.limit fetch-options limit))
       (when offset (.offset fetch-options offset))
       (when prefetch-size (.prefetchSize fetch-options prefetch-size))
-      (when chunk-size (.checkSize fetch-options chunk-size))
+      (when chunk-size (.chuckSize fetch-options chunk-size))
       (when start-cursor (.startCursor fetch-options start-cursor))
       (when end-cursor (.endCursor fetch-options end-cursor))
       fetch-options)))


added request caching, better 404 and docstrings

--- src/cia/routes/documentation.clj
+++ src/cia/routes/documentation.clj
@@ -6,43 +6,56 @@
    [hiccup.core :as h]
    [hiccup.page :as page]
    [ring.util.mime-type :refer [ext-mime-type]]
-   [clojure.java.io :as io]))
+   [clojure.java.io :as io]
+   [clojure.core.memoize :as memo]))

+;; set request cache ttl
+(def cache-ttl-ms (* 1000 5))
+
+;; additional types for req content type mime detection
 (def mime-overrides {"md" "text/markdown"})
+
+;; additional page formatting css
 (def page-style "width:980px;padding:45px;")
+
+;; set page css class here
 (def page-class "markdown-body")
-(def additional-css ["css/github-markdown.css"])
+
+;; additional css embeded in Head
+(def additional-css ["css/github-markdown.css"
+                     "css/github.css"])
+
+;; additional js embeded in head
+(def additional-js ["js/highlight.pack.js"])
+
+;; head hiccup template
+(def head-tpl [:head
+               (map page/include-css additional-css)
+               (map page/include-js additional-js)])

 (defn get-file-content [path]
-  (slurp (io/resource
-          path)))
+  "read a file from resources, returns nil on any failure"
+  (try (slurp (io/resource
+               path))
+       (catch Throwable e nil)))

-(def head-tpl [:head (map page/include-css additional-css)])
-
-(defn decorate [html-body]
-  "decorate an html converted markdown file"
+(defn decorate-markdown [html-body]
+  "decorate an html converted markdown file with css and js"
   (page/html5
    head-tpl
    [:body
+    [:script "hljs.initHighlightingOnLoad();"]
     [:div {:style page-style
            :class page-class}
      html-body]]))

 (defn render-markdown [file]
   "render a mardown file into an html webpage"
-  (let [response  (-> file
-                      md-to-html-string
-                      decorate
-                      )]
-    {:status 200
-     :headers {"Content-Type" "text/html"}
-     :body response}))
-
-(defn render-css [file type]
-  "render a css file"
   {:status 200
-   :headers {"Content-Type" type}
-   :body file})
+   :headers {"Content-Type" "text/html"}
+   :body (-> file
+             md-to-html-string
+             decorate-markdown)})

 (defn render-default [file type]
   "default render for unknown file types"
@@ -54,14 +67,27 @@
   "render a file by type"
   (condp = type
     "text/markdown" (render-markdown file)
-    "text/css" (render-css file type)
     (render-default file type)))
+
+(defn render-request [req]
+  "read the requested file from resources, render it if needed"
+  (let [file-path (subs (:path-info req) 1)
+        file-content (get-file-content file-path)
+        file-type (ext-mime-type file-path mime-overrides)]
+
+    (if file-content
+      (render file-content file-type)
+      {:status 404
+       :body "The requested page couldn't be found."})))
+
+(def render-request-with-cache
+  "request cache wrapper"
+  (memo/ttl
+   #(render-request %)
+   :ttl/threshold cache-ttl-ms))

 (defroutes documentation-routes
   (context "/doc" []
     (GET "/*.*" req
       :no-doc true
-      (let [file-path (subs (:path-info req) 1)
-            file-content (get-file-content file-path)
-            file-type (ext-mime-type file-path mime-overrides)]
-        (render file-content file-type)))))
+      (render-request-with-cache req))))


restore anti-forgery projection

restore anti-forgery projection

--- src/clj/clj_money/web/server.clj
+++ src/clj/clj_money/web/server.clj
@@ -251,6 +251,7 @@

 (def wrapped-routes
   (wrap-routes all-routes
+               [wrap-anti-forgery                   "anti-forgery"]
                [wrap-multipart-params               "multipart params" (complement api?)]
                [wrap-keyword-params                 "keyword params"   (complement api?)]
                [wrap-json-params                    "json params"      api?]


include player count on waiting page

include player count on waiting page

--- src/cljs/avalon/pages/games.cljs
+++ src/cljs/avalon/pages/games.cljs
@@ -79,7 +79,7 @@
                 [:h4.code "Access code: " [:pre id]]]]]
              [row
               [col
-               [ui/List {:subheader "Players"}
+               [ui/List {:subheader ["Players - " (count people)] }
                 (for [player people]
                   [ui/ListItem
                    [:div.player


Show the labels

Show the labels

--- src/cljs/hyphen_keeper/core.cljs
+++ src/cljs/hyphen_keeper/core.cljs
@@ -84,7 +84,7 @@

 (defn word-field []
   [:div.form-group
-   [:label.sr-only {:for "wordInput"} "Word"]
+   [:label {:for "wordInput"} "Word"]
    [:input.form-control
     {:id "wordInput"
      :type "text"
@@ -104,7 +104,7 @@
    {:class (if (or (string/blank? @hyphenation)
                    (hyphenation-valid? @hyphenation))
              "form-group" "form-group has-error")}
-   [:label.sr-only {:for "hyphenationInput"} "Hyphenation"]
+   [:label {:for "hyphenationInput"} "Corrected Hyphenation"]
    [:input.form-control
     {:type "text"
      :placeholder "Hyphenation"


Refactor draw circle a bit

Refactor draw circle a bit

--- src/cljs/modern_cljs/modern.cljs
+++ src/cljs/modern_cljs/modern.cljs
@@ -12,14 +12,13 @@

 (def my-canvas (.getElementById js/document "myCanvas"))

-(defn draw-circle [ctx]
+(defn draw-circle [ctx color]
     (set! (.-fillStyle ctx) "blue")
     (.beginPath ctx)
     (.arc ctx 55 207 50 0 (* 2 (.-PI js/Math)))
     (.stroke ctx)
-    (set! (.-fillStyle ctx) "yellow")
-    (.fill ctx)
-)
+    (set! (.-fillStyle ctx) color)
+    (.fill ctx))

 (defn draw-rect [ctx color x1 y1 x2 y2]
     (set! (.-fillStyle ctx) color)
@@ -30,7 +29,7 @@
     ;; Red rectangle
     (draw-rect ctx "#FF0000" 0 0 150 75)
     ;; Paint a circle
-    (draw-circle ctx)
+    (draw-circle ctx "yellow")
     ;; Green rectangle
     (draw-rect ctx "green" 155 80 255 180)))


fix import button not being shown when user has no badge

--- src/cljs/salava/badge/ui/my.cljs
+++ src/cljs/salava/badge/ui/my.cljs
@@ -111,7 +111,7 @@
       [badge-grid-form state]
       (cond
         (not-activated?) (not-activated-banner)
-        (empty? (:badges @state)) [no-badges-text]
+        ;(empty? (:badges @state)) [no-badges-text]
         :else [badge-grid state])]
      )])


Fix conditional compilation errors.

Fix conditional compilation errors.

--- src/clojure/clj_chess/board.cljc
+++ src/clojure/clj_chess/board.cljc
@@ -541,49 +541,56 @@
      (.see board move)))

 #?(:clj
-
    (defn occupied-squares
      "The set of occupied squares on the board, including blockers. Supplying
      the optional 'color' parameter will result in only squares occupied by
      pieces of that color (and no blockers) to be returned."
      ([board] (.occupiedSquares board))
-     ([board color] (.piecesOfColor board color)))
-
+     ([board color] (.piecesOfColor board color))))
+
+#?(:clj
    (defn pawn-squares
      "The set of squares containing pawns of the given color."
      [board color]
-     (.pawnsOfColor board color))
-
+     (.pawnsOfColor board color)))
+
+#?(:clj
    (defn knight-squares
      "The set of squares containing knights of the given color."
      [board color]
-     (.knightsOfColor board color))
-
+     (.knightsOfColor board color)))
+
+#?(:clj
    (defn bishop-squares
      "The set of squares containing bishops of the given color."
      [board color]
-     (.bishopsOfColor board color))
-
+     (.bishopsOfColor board color)))
+
+#?(:clj
    (defn rook-squares
      "The set of squares containing rooks of the given color."
      [board color]
-     (.rooksOfColor board color))
-
+     (.rooksOfColor board color)))
+
+#?(:clj
    (defn queen-squares
      "The set of squares containing queens of the given color."
      [board color]
-     (.queensOfColor board color))
-
+     (.queensOfColor board color)))
+
+#?(:clj
    (defn king-squares
      "The set of squares containing kings of the given color."
      [board color]
-     (.kingsOfColor board color))
-
+     (.kingsOfColor board color)))
+
+#?(:clj
    (defn attacks-from
      "The set of squares attacked by the piece on the given square."
      [board square]
-     (.attacksFrom board square))
-
+     (.attacksFrom board square)))
+
+#?(:clj
    (defn attacks-to
      "The set of squares containing pieces that attack the given square.
      If the third, optional argument 'color' is supplied, only attackers
@@ -591,39 +598,45 @@
      ([board square color]
       (.attacksTo board square color))
      ([board square]
-       (bit-or (.attacksTo board square 0)
-               (.attacksTo board square 1))))
-
+      (bit-or (.attacksTo board square 0)
+              (.attacksTo board square 1)))))
+
+#?(:clj
    (defn pawn-attacks
      "The set of squares that would be attacked by a pawn of the given color
      from the given square."
      [board color square]
-     (.pawnAttacks board color square))
-
+     (.pawnAttacks board color square)))
+
+#?(:clj
    (defn knight-attacks
      "The set of squares that would be attacked by a knight on the given
      square."
      [board square]
-     (.knightAttacks board square))
-
+     (.knightAttacks board square)))
+
+#?(:clj
    (defn bishop-attacks
      "The set of squares that would be attacked by a bishop on the given
      square."
      [board square]
-     (.bishopAttacks board square))
-
+     (.bishopAttacks board square)))
+
+#?(:clj
    (defn rook-attacks
      "The set of squares that would be attacked by a rook on the given
      square."
      [board square]
-     (.rookAttacks board square))
-
+     (.rookAttacks board square)))
+
+#?(:clj
    (defn queen-attacks
      "The set of squares that would be attacked by a queen on the given
      square."
      [board square]
-     (.queenAttacks board square))
-
+     (.queenAttacks board square)))
+
+#?(:clj
    (defn king-attacks
      "The set of squares that would be attacked by a king on the given
      square."


Valid user authorizer delegates to authenticator

--- src/cylon/impl/authorization.clj
+++ src/cylon/impl/authorization.clj
@@ -2,25 +2,24 @@

 (ns cylon.impl.authorization
   (:require
+   [com.stuartsierra.component :as component]
    [clojure.set :refer (union)]
    [clojure.tools.logging :refer :all]
    [cylon.role :refer (user-in-role?)]
-   [cylon.authorization :refer (Authorizer restrict-handler)]
+   [cylon.authorization :refer (Authorizer)]
+   [cylon.authentication :refer (authenticate)]
    [schema.core :as s]))

-(defn restrict-handler-map
-  "Restrict all the values in the given map according to the given
-  authorizer."
-  [m authorizer rejectfn]
-  (reduce-kv (fn [acc k v] (assoc acc k (restrict-handler v authorizer rejectfn))) {} m))
-
-(defrecord LoggedInAuthorizer []
+;; A ValidUserAuthorizer simply checks for :cylon/user in the
+;; request. If there is one, they are authorized.
+(defrecord ValidUserAuthorizer []
   Authorizer
   (authorized? [this request _]
-    (:cylon/user request)))
+    (:cylon/user (authenticate (:authenticator this) request))))

-(defn new-logged-in-authorizer []
-  (->LoggedInAuthorizer))
+(defn new-valid-user-authorizer []
+  (component/using
+   (->ValidUserAuthorizer) [:authenticator]))

 (defrecord StaticUserAuthorizer []
   Authorizer


try creating the hipe ebin output directory

--- config/software/erlang.clj
+++ config/software/erlang.clj
@@ -53,7 +53,9 @@
       ]
   (software "erlang" :source "otp_src_R14B02"
             :steps [
-                    {:command "touch" :args ["lib/wx/SKIP"] }
+                    {:command "touch" :args ["lib/wx/SKIP"] }
+                    {:command "mkdir" :args ["-p lib/hipe/ebin"] } ;; I know, right? [cb]
+
                     {:command "./configure"
                      :args args
                      :env env}


Fix exit code assertion

Fix exit code assertion

--- test/desdemona/cli_test.clj
+++ test/desdemona/cli_test.clj
@@ -35,5 +35,5 @@
   (testing "usage"
     (let [[result stdout] (with-fake-launcher-side-effects
                             (aeron/-main "--help"))]
-      (is (= result 0))
       (is (= stdout nil)))))
+      (is (= result [::exited 0]))


Fix DB unit tests

Fix DB unit tests

--- test/env_logger/db_test.clj
+++ test/env_logger/db_test.clj
@@ -397,19 +397,22 @@
                {:location "indoor"
                 :temperature 22.0
                 :pressure 1024.0
-                :humidity 45.0})
+                :humidity 45.0
+                :battery_voltage 2.910})
     (j/insert! test-postgres
                :ruuvitag_observations
                {:location "indoor"
                 :temperature 21.0
                 :pressure 1023.0
-                :humidity 45.0})
+                :humidity 45.0
+                :battery_voltage 2.890})
     (j/insert! test-postgres
                :ruuvitag_observations
                {:location "balcony"
                 :temperature 15.0
                 :pressure 1024.0
-                :humidity 30.0})
+                :humidity 30.0
+                :battery_voltage 2.805})
     (is (= '({:rt-temperature 15.0
               :rt-humidity 30.0})
            (get-ruuvitag-obs test-postgres


rename primary render to render-canvas

rename primary render to render-canvas


remove nil check for first element

remove nil check for first element

--- src/sierpinski_sieve/core.cljs
+++ src/sierpinski_sieve/core.cljs
@@ -10,10 +10,11 @@
 (defonce app-state (atom {}))

 (defn next-row [modulus row]
-  (for [x (range 0 (inc (count row)))]
-    (let [before (nth row (dec x) 0)
-          above (nth row x 0)]
-      (mod (+ before above) modulus))))
+  (cons 1
+        (for [x (range 1 (inc (count row)))]
+          (let [before (nth row (dec x))
+                above (nth row x 0)]
+            (mod (+ before above) modulus)))))

 (defn sieve [initial-state modulus]
   (iterate (partial next-row modulus) initial-state))


Include primes in math repl.

Include primes in math repl.

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -8,9 +8,11 @@
                   [lein-pprint "1.1.1"]]}
  :math {:dependencies [[org.clojure/math.combinatorics "0.0.2"]
                        [org.clojure/math.numeric-tower "0.0.1"]
+                       [com.hypirion/primes "0.2.1"]
                        [org.clojure/tools.trace "0.7.3"]]
         :repl-options {:init (do (use 'clojure.math.combinatorics
                                       'clojure.math.numeric-tower
                                       'clojure.tools.trace)
                                  (require '[clojure.pprint
-                                            :refer [pprint cl-format]]))}}}
+                                            :refer [pprint cl-format]]
+                                          '[com.hypirion.primes :as primes]))}}}


Improved querystring parameters parsing.

--- src/uxbox/util/querystring.clj
+++ src/uxbox/util/querystring.clj
@@ -5,11 +5,14 @@
 ;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>

 (ns uxbox.util.querystring
-  (:require [uxbox.util.transit :as t]))
+  (:require [uxbox.util.transit :as t]
+            [buddy.core.codecs :as codecs]))

 (defn parse-params
   ([params] (parse-params params nil))
-  ([params {:keys [key] :as opts}]
+  ([params {:keys [key] :or {key :params} :as opts}]
    (if (contains? params key)
-     (t/decode (get params key))
+     (-> (get params key)
+         (codecs/base64->bytes)
+         (t/decode))
      {})))


feat(ccw.events): prevents subscription of a var to happen twice

--- ccw.core/src/clj/ccw/events.clj
+++ ccw.core/src/clj/ccw/events.clj
@@ -29,10 +29,21 @@
   ;; we get consistent behavior in the handler
   (.post (event-broker) (as-topic topic) [data]))

+(defn unsubscribe
+  "event-handler-var is either a var with ::event-handler metadata attached to it,
+   or a true org.osgi.service.event.EventHandler"
+  [event-handler-var]
+  (if (var? event-handler-var)
+    (when-let [event-handler (some-> event-handler-var meta ::event-handler)]
+      (alter-meta! event-handler-var dissoc ::event-handler)
+      (.unsubscribe (event-broker) event-handler))
+    (.unsubscribe (event-broker) event-handler-var)))
+
 (defn subscribe
   ([topic event-handler-var] (subscribe topic false event-handler-var))
   ([topic require-ui? event-handler-var]
     (t/format :events "subscribing to topic %s" (as-topic topic))
+    (unsubscribe event-handler-var)
     (let [event-handler
           (reify org.osgi.service.event.EventHandler
             (handleEvent [this event]
@@ -45,7 +56,7 @@
               nil
               event-handler
               (boolean require-ui?))
+        (when (var? event-handler-var)
+          (alter-meta! event-handler-var assoc ::event-handler event-handler))
         event-handler))))

-(defn unsubscribe [event-handler]
-  (.unsubscribe (event-broker) event-handler))


add ^not-native hint for -nth bench

add ^not-native hint for -nth bench

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -55,6 +55,7 @@
 (simple-benchmark [coll [1 2 3]] (transient coll) 100000)
 (simple-benchmark [coll [1 2 3]] (nth coll 0) 1000000)
 (simple-benchmark [coll [1 2 3]] (-nth coll 0) 1000000)
+(simple-benchmark [coll [1 2 3]] (-nth ^not-native coll 0) 1000000)
 (simple-benchmark [coll [1 2 3]] (conj coll 4) 1000000)
 (simple-benchmark [coll [1 2 3]] (-conj coll 4) 1000000)
 (simple-benchmark [coll [1 2 3]] (seq coll) 1000000)


[lein] bump deps

[lein] bump deps

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,4 +1,4 @@
-{:user {:plugins [[lein-cloverage                    "1.0.9"]
+{:user {:plugins [[lein-cloverage                    "1.0.13"]
                   [lein-fore-prob                    "0.1.2"]

                   ; Check for outdated dependencies
@@ -7,13 +7,13 @@
                   ; Check for bad coding style
                   [lein-bikeshed                      "0.5.1"]
                   [lein-kibit                         "0.1.6"]
-                  [jonase/eastwood                    "0.2.6"]
+                  [jonase/eastwood                    "0.3.4"]

                   ;; lein-test when something changes
-                  [com.jakemccrary/lein-test-refresh "0.21.1"]
+                  [com.jakemccrary/lein-test-refresh "0.23.0"]

-                  [lein-figwheel                     "0.5.10"]
-                  [venantius/ultra                   "0.5.1"]]
+                  [lein-figwheel                     "0.5.18"]
+                  [venantius/ultra                   "0.5.2"]]

         :dependencies [[org.clojure/tools.namespace  "0.2.11"]]


The show command should have an option for getting the classpath

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -103,13 +103,15 @@
    e env       bool "Print the boot env map."
    f fileset   bool "Print the build fileset object."
    u updates   bool "Print newer releases of outdated dependencies."
-   s snapshots bool "Include snapshot versions in updates searches."]
-
-  (let [updates (or updates (not (or deps env fileset)))]
+   s snapshots bool "Include snapshot versions in updates searches."
+   c classpath bool "Print the project's full classpath."]
+
+  (let [updates (or updates (not (or deps env fileset classpath)))]
     (core/with-pre-wrap fileset'
       (when deps    (print (pod/with-call-worker (boot.aether/dep-tree ~(core/get-env)))))
       (when env     (println (pr-str (core/get-env))))
       (when fileset (println (pr-str fileset')))
+      (when classpath (println (or (System/getProperty "boot.class.path") "")))
       (when updates (mapv prn (pod/outdated (core/get-env) :snapshots snapshots)))
       fileset')))

@@ -245,7 +247,7 @@

 (core/deftask sift
   "Transform the fileset, matching paths against regexes.
-
+
   The --to-asset, --to-resource, and --to-source options move matching paths
   to the corresponding section of the fileset. This can be used to make source
   files into resource files, for example, etc. If --invert is also specified


Simplify enemy creation

Simplify enemy creation

--- resources/arcade/entities.clj
+++ resources/arcade/entities.clj
@@ -53,7 +53,7 @@

 (defn create-enemy
   []
-  (assoc (texture (rand-nth ["enemy.png"]))
+  (assoc (texture "enemy.png")
          :enemy? true
          :x (rand (game :width))
          :y (game :height)


CMR-1280 Updates ISO MENDS spatial to create polygon rings correctly

--- umm-lib/src/cmr/umm/iso_mends/spatial.clj
+++ umm-lib/src/cmr/umm/iso_mends/spatial.clj
@@ -10,6 +10,7 @@
             [cmr.spatial.mbr :as mbr]
             [cmr.spatial.point :as p]
             [cmr.spatial.polygon :as poly]
+            [cmr.spatial.ring-relations :as r]
             [cmr.umm.collection :as c]
             [cmr.umm.spatial :as umm-s]))

@@ -49,9 +50,10 @@

 (defmethod parse-gml :Polygon
   [element]
-  (let [exterior  (cx/element-at-path  element [:exterior :LinearRing])
-        interiors (cx/elements-at-path element [:interior :LinearRing])
-        rings     (cons (parse-points exterior) (map parse-points interiors))]
+  (let [exterior   (cx/element-at-path  element [:exterior :LinearRing])
+        interiors  (cx/elements-at-path element [:interior :LinearRing])
+        parse-ring #(r/ring :geodetic (parse-points %))
+        rings      (cons (parse-ring exterior) (map parse-ring interiors))]
     (poly/polygon :geodetic rings)))

 (defmethod parse-geo-element :default


Break tsplot into two Reagent components to avoid nasty parent ref.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -12,6 +12,9 @@
 (def dashboard-state (reagent/atom {:series [] :text ""}))

 (def window-width (reagent/atom nil))
+
+(def default-tsplot-width 1024)
+(def default-tsplot-height 180)

 (defn <<< [f & args]
   (let [c (chan)]
@@ -33,9 +36,6 @@
 (defn fetch-series-data [ series-name query-window-secs cb ]
   (ajax-get (str "/data/" series-name "?query-window-secs=" query-window-secs) cb))

-(def default-tsplot-width 1024)
-(def default-tsplot-height 180)
-
 (defn dom-node-width
   ([ node default-width ]
    (if node
@@ -56,7 +56,7 @@
   (let [ ctx (.getContext canvas "2d")]
     (tsplot/draw ctx (dom-node-width canvas) (dom-node-height canvas) series-data)))

-(defn series-tsplot [ series ]
+(defn series-tsplot-plot-canvas [ series ]
   (let [ series-state (reagent/atom { }) ]
     (reagent/create-class
      {:display-name (str "series-tsplot-" series)
@@ -66,17 +66,28 @@

       :component-did-mount
       (fn [ this ]
-        (swap! series-state assoc :dom-node (.-parentNode (reagent/dom-node this)))
         (go
           (swap! series-state assoc :series-data (<! (<<< fetch-series-data series @query-window-secs)))))

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

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


fix missing shadow$provide global in :npm-module

fixes #832

--- src/main/shadow/build/output.clj
+++ src/main/shadow/build/output.clj
@@ -490,6 +490,10 @@
        "CLJS_GLOBAL.CLOSURE_NO_DEPS = true;\n"
        ;; so devtools can access it
        "CLJS_GLOBAL.$CLJS = $CLJS;\n"
+
+       ;; in case of commonjs on the classpath
+       "global.shadow$provide = {};\n"
+
        "var goog = $CLJS.goog = {};\n"
        ;; the global must be overriden in goog/base.js since it contains some
        ;; goog.define(...) which would otherwise be exported to "this"


CMR-688: Added check for empty fields.

CMR-688: Added check for empty fields.

--- search-app/src/cmr/search/results_handlers/opendata_results_handler.clj
+++ search-app/src/cmr/search/results_handlers/opendata_results_handler.clj
@@ -145,9 +145,9 @@
         access-url (first (ru/downloadable-urls related-urls))
         distribution (distribution related-urls)]
     (util/remove-nil-keys {:title entry-title
-                           :description summary
+                           :description (not-empty summary)
                            :keyword (not-empty keywords)
-                           :modified update-time
+                           :modified (not-empty update-time)
                            :publisher PUBLISHER
                            :contactPoint contact-name
                            :mbox contact-email
@@ -164,7 +164,7 @@
                            :landingPage (landing-page related-urls)
                            :language  [LANGUAGE_CODE]
                            :references (not-empty (map :url related-urls))
-                           :issued insert-time})))
+                           :issued (not-empty insert-time)})))

 (defn results->opendata
   "Convert search results to opendata."


comment out paths no longer in checkouts dir

--- cljs/project.clj
+++ cljs/project.clj
@@ -35,8 +35,9 @@
                                        ;"checkouts/clojurescript/src/main/clojure"
                                        "checkouts/tools.reader/src/main/cljs"
                                        "checkouts/reagent/src"
-                                       "checkouts/figwheel/src"
-                                       "checkouts/rewrite-cljs/src"]
+                                       ;"checkouts/figwheel/src"
+                                       ;"checkouts/rewrite-cljs/src"
+                                       ]
                         :compiler     {:main           quark.init
                                        :output-to      "../lib/_build/quark.js"
                                        :output-dir     "../lib/_build"


comment on an interesting -- and potentially confusing -- area of the code

--- code-breaker.clj
+++ code-breaker.clj
@@ -45,6 +45,10 @@

 (defn count-inexact-matches [guess answer exact-matches]
   "Returns count of the inexact matches -- color and position -- between both sets"
+  ; This works because the number of inexact matches is just a set theory problem.
+  ; Specifically, counting them is just the intersection of the guess and answer,
+  ; after exact matches are removed. The same approach is much more code in Java
+  ; because java.util.Set doesn't have set-theory methods like clojure.set.
   (let [guess-without-exact-matches (drop-elements-by-indexes guess exact-matches)]
     (count (clojure.set/intersection
       (set guess-without-exact-matches)


Never rollback, there's no reason to without the coordinator.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -61,9 +61,7 @@

 (defn munge-commit-tx
   [{:keys [onyx.core/queue onyx.core/session onyx.core/commit?] :as event}]
-  (if commit?
-    (extensions/commit-tx queue session)
-    (extensions/rollback-tx queue session))
+  (extensions/commit-tx queue session)
   (merge event {:onyx.core/committed? commit?}))

 (defn munge-close-temporal-resources [event]


code and tests, fixes #209

code and tests, fixes #209

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -481,9 +481,12 @@
           (throw e))))
     calls-map))

+(defn select-applicable-lifecycles [lifecycles task-name]
+  (filter #(or (= (:lifecycle/task %) :all)
+               (= (:lifecycle/task %) task-name)) lifecycles))
+
 (defn compile-start-task-functions [lifecycles task-name]
-  (let [matched (filter #(or (= (:lifecycle/task %) :all)
-                          (= (:lifecycle/task %) task-name)) lifecycles)
+  (let [matched (select-applicable-lifecycles lifecycles task-name)
         fs
         (remove
          nil?
@@ -499,8 +502,7 @@
         true))))

 (defn compile-lifecycle-functions [lifecycles task-name kw]
-  (let [matched (filter #(or (= (:lifecycle/task %) :all)
-                          (= (:lifecycle/task %) task-name)) lifecycles)]
+  (let [matched (select-applicable-lifecycles lifecycles task-name)]
     (reduce
      (fn [f lifecycle]
        (let [calls-map (resolve-lifecycle-calls (:lifecycle/calls lifecycle))]
@@ -511,8 +513,7 @@
      matched)))

 (defn compile-ack-retry-lifecycle-functions [lifecycles task-name kw]
-  (let [matched (filter #(or (= (:lifecycle/task %) :all)
-                             (= (:lifecycle/task %) task-name)) lifecycles)
+  (let [matched (select-applicable-lifecycles lifecycles task-name)
         fns (keep (fn [lifecycle]
                     (let [calls-map (resolve-lifecycle-calls (:lifecycle/calls lifecycle))]
                       (if-let [g (get calls-map kw)]


Fix exception swallowing.

Fix exception swallowing.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -219,18 +219,21 @@
        (assoc condition :flow/predicate (build-pred-fn (:flow/predicate condition) condition)))
           conditions)))

-(defn run-task-lifecycle [init-event kill-ch]
-  (loop [event init-event]
-    (when (first (alts!! [kill-ch] :default true))
-      (-> event
-          (inject-batch-resources)
-          (read-batch)
-          (decompress-batch)
-          (apply-fn)
-          (compress-batch)
-          (write-batch)
-          (close-batch-resources))
-      (recur init-event))))
+(defn run-task-lifecycle [init-event kill-ch ex-f]
+  (try
+    (loop [event init-event]
+      (when (first (alts!! [kill-ch] :default true))
+        (-> event
+            (inject-batch-resources)
+            (read-batch)
+            (decompress-batch)
+            (apply-fn)
+            (compress-batch)
+            (write-batch)
+            (close-batch-resources))
+        (recur init-event)))
+    (catch Exception e
+      (ex-f e))))

 (defn listen-for-sealer [job task init-event seal-ch outbox-ch]
   ;; TODO: only launch for output tasks
@@ -296,7 +299,7 @@
         (release-messages! messenger pipeline-data)
         (thread (forward-completion-calls! pipeline-data completion-ch))
         (listen-for-sealer job-id task-id pipeline-data seal-resp-ch outbox-ch)
-        (thread (run-task-lifecycle pipeline-data kill-ch))
+        (thread (run-task-lifecycle pipeline-data kill-ch ex-f))

         (assoc component :pipeline-data pipeline-data :seal-ch seal-resp-ch))
       (catch Exception e


fix bug in JSON generation where there is a comma at the end

--- server/feed/src/feed/core.clj
+++ server/feed/src/feed/core.clj
@@ -272,7 +272,7 @@
   "serialize out the collection of entities in a client friendly format"
   [entities]
   (str "["
-       (reduce str (map #(str (to-client %) ", ") entities))
+       (s/join "," (map #(to-client %) entities))
        "]"))

 (defmulti save-to-db (fn [o] (type o)))


updated to the latest version of lib-noir

--- luminus/hello/project.clj
+++ luminus/hello/project.clj
@@ -3,7 +3,7 @@
   "luminus"
   :dependencies
   [[org.clojure/clojure "1.5.1"]
-   [lib-noir "0.5.5"]
+   [lib-noir "0.6.6"]
    [compojure "1.1.5"]
    [ring-server "0.2.8"]
    [selmer "0.3.6"]


Use actual github avatar for user

Use actual github avatar for user

Github user info contains an avatar_url which provides the avatar for
the user regardless of whether the avatar was uploaded directly to
github, comes from gravatar, or is a default provided by github.  This
uses that, so avatars uploaded to github are supported.

Currently only the logged in user; similar still needs to be done for
other places where github avatars show up

--- frontend/components/aside.cljs
+++ frontend/components/aside.cljs
@@ -188,9 +188,7 @@
                           :title "Account"
                           :class (when (get-in app state/user-options-shown-path)
                                   "open")}
-           [:img {:src (gh-utils/gravatar-url {:gravatar_id (:gravatar-id opts)
-                                               :login (:login opts)
-                                               :size 50})}]
+           [:img {:src (:avatar-url opts)}]
            (:login opts)]

           [:a.aside-item {:title "Documentation"
@@ -250,11 +248,11 @@
       (let [data (select-in app [state/projects-path state/settings-path state/user-options-shown-path])
             user (get-in app state/user-path)
             login (:login user)
-            gravatar-id (:gravatar_id user)]
+            avatar-url (:avatar_url user)]
         (html
          [:aside.app-aside-left
           shared/invite-form ;; modal trigger is in aside-nav
           (om/build aside-nav data {:opts {:login login
-                                           :gravatar-id gravatar-id}})
+                                           :avatar-url avatar-url}})

           (om/build activity data {:opts {:login login}})])))))


group-window stream

group-window stream

--- satori-rules/rules/alarm.clj
+++ satori-rules/rules/alarm.clj
@@ -36,10 +36,9 @@
   创建一个发送报警的流，流经这个流的事件都会被发到 alarm 产生报警。
   接受一个 map 做参数，map 中需要可以指定如下的参数

-  (! {:note \"报警标题，标题对于一个特定的报警是不能变的（不要把报警的数据编码在这里面）\"
+  (! {:note string ; 报警标题，标题对于一个特定的报警是不能变的（不要把报警的数据编码在这里面）
       :level 1  ;报警级别, 0最高，6最小。报警级别影响报警方式。
       :event? false  ; 可选，是不是事件（而不是状态）。默认 false。如果是事件的话，只会发报警，不会记录状态（alarm插件里看不到）。
-      :expected 233  ; 可选，期望值，暂时没用到)
       :outstanding-tags [:region :mount]  ; 可选，相关的tag，写在这里的 tag 会用于区分不同的事件，以及显示在报警内容中, 不填的话默认是所有的tag
       :groups [:operation]})  ; groups 是在规则仓库的 alarm 配置里管理的)
   "
@@ -145,18 +144,6 @@
   [from to & children]
   (apply smap #(assoc % to (from %)) children))

-
-(defn |>| [& args] (apply > (map #(Math/abs %) args)))
-(defn |<| [& args] (apply < (map #(Math/abs %) args)))
-
-(defn maxpdiff
-  "计算最大变化率，与 aggregate 搭配使用(MAX Percentage DIFFerence)"
-  [& m]
-  (let [r (last m)]
-    (->> (map #(/ (- r %) r) m)
-         (reduce (fn [v v'] (if (> (Math/abs v') (Math/abs v)) v' v))))))
-
-
 (defn ->difference
   "接受事件的数组，变换成另外一个事件数组。
    新的事件数组中，每一个事件的 metric 是之前相邻两个事件 metric 的差。
@@ -167,6 +154,17 @@
       (fn [[ev' ev]] (assoc ev' :metric (- (:metric ev') (:metric ev))))
       (map vector (rest l) l)))
     children))
+
+
+(defn |>| [& args] (apply > (map #(Math/abs %) args)))
+(defn |<| [& args] (apply < (map #(Math/abs %) args)))
+
+(defn maxpdiff
+  "计算最大变化率，与 aggregate 搭配使用(MAX Percentage DIFFerence)"
+  [& m]
+  (let [r (last m)]
+    (->> (map #(/ (- r %) r) m)
+         (reduce (fn [v v'] (if (> (Math/abs v') (Math/abs v)) v' v))))))

 (defn feed-dog
@@ -202,3 +200,37 @@
         (smap :metric
           (with {:state :ok}
             (apply sdo children)))))))
+
+(defn group-window
+  "将事件分组后向下传递，类似 fixed-time-window，但不使用时间切割，
+  而是通过 (group-fn event) 的值进行切割。(group-fn event) 的值会被记录下来，
+  每一次出现重复值的时候，会将当前缓存住的事件数组向下传递。
+
+  比如你有一组同质的机器，跑了相同的服务，但是机器名不一样，可以通过
+  (group-window :host
+    ....)
+  将事件分组后处理（e.g. 对单台的容量求和获得总体容量）
+  e.g.: 一个事件流中的事件先后到达，其中 :host 的值如下
+      a b c d b a c a b
+  那么会被这个流分成
+    [a b c d] [b a c] [a b]
+  分成 3 次向下游传递
+  "
+  [group-fn & children]
+  (let [buffer (ref [])
+        group-keys (ref #{})]
+    (fn stream [event]
+      (let [evkey (group-fn event)]
+        (-> (dosync
+              (if (@group-keys evkey)
+                (let [rst @buffer]
+                  (ref-set buffer [event])
+                  (ref-set group-keys #{evkey})
+                  rst)
+                (do
+                  (alter buffer conj event)
+                  (alter group-keys conj evkey)
+                  nil)))
+            ((fn [rst]
+              (when rst
+                (call-rescue rst children)))))))))


Notes.

Notes.

--- test/com/nomistech/clojure_the_language/c_200_clojure_basics/s_010_intro.clj
+++ test/com/nomistech/clojure_the_language/c_200_clojure_basics/s_010_intro.clj
@@ -1,6 +1,6 @@
 (ns com.nomistech.clojure-the-language.c-200-clojure-basics.s-010-intro
   (:require [midje.sweet :refer :all]))

-;;;; See Intro to Clojure blog post.
+;;;; See Intro to Clojure blog post. TODO: Get stuff to here.

 ;;;; Including bracketed prefix notation for calling functions.


better comments, balancing parens

better comments, balancing parens

--- resources/leiningen/new/re_frame/src/cljs/project_name/handlers.cljs
+++ resources/leiningen/new/re_frame/src/cljs/project_name/handlers.cljs
@@ -9,7 +9,7 @@
 (def standard-middlewares
   [trim-v
    ;; (if goog.DEBUG log-ex)    ;; will be available in v0.3.0
-   (when goog.DEBUG [debug (after db/valid-schema?)]))
+   (when goog.DEBUG [debug (after db/valid-schema?)])])

 ;; -- Helpers -----------------------------------------------------------------

@@ -23,8 +23,8 @@

 (register-handler                 ;; handlers changes the footer filter
-  :set-showing                    ;; event-id
-  [standard-middlewares (path :showing)]
+  :set-name                       ;; event-id
+  [standard-middlewares (path :name)]
   (fn                             ;; handler
-    [db [filter-kw]]
-    filter-kw))
+    [db [new-name]]               ;; because of trim-v, not [_ new-name]
+    new-name))