Inline response

Inline response

--- src/github_changelog/github.clj
+++ src/github_changelog/github.clj
@@ -38,8 +38,7 @@
   (map #(make-request config {:page %}) (gen-pages links)))

 (defn- issue-request [endpoint request]
-  (let [response (http/get endpoint request)]
-    (update response :body j/read-value)))
+  (update (http/get endpoint request) :body j/read-value))

 (defn- call-api-fn [config]
   (let [ratelimit (get config :rate-limit 5)


optimize reload-npm

optimize reload-npm

only watch package.json files for changes and invalidate entire
package when changed. don't watch individual files because that
may end up being multiple thousands ...

--- src/main/shadow/cljs/devtools/server/reload_npm.clj
+++ src/main/shadow/cljs/devtools/server/reload_npm.clj
@@ -1,11 +1,14 @@
 (ns shadow.cljs.devtools.server.reload-npm
   "service that watches fs updates and ensures npm resources are updated
    will emit system-bus messages for inform about changed resources"
-  (:require [clojure.core.async :as async :refer (alt!! thread)]
-            [shadow.jvm-log :as log]
-            [shadow.build.npm :as npm]
-            [shadow.cljs.model :as m]
-            [clojure.set :as set]))
+  (:require
+    [clojure.core.async :as async :refer (alt!! thread)]
+    [clojure.set :as set]
+    [shadow.jvm-log :as log]
+    [shadow.build.npm :as npm]
+    [shadow.cljs.model :as m]
+    [shadow.debug :refer (?> ?-> ?->>)]
+    ))

 (defn dissoc-all [m files]
   (reduce dissoc m files))
@@ -22,14 +25,27 @@
   ;; this only needs to check files that were already referenced in some build
   ;; new files will be discovered when resolving

-  (let [{:keys [files] :as index}
+  (let [{:keys [files package-json-cache] :as index}
         @index-ref

+        modified-packages
+        (reduce-kv
+          (fn [modified package-json-file {:keys [last-modified content]}]
+            (if (= last-modified (.lastModified package-json-file))
+              modified
+              (conj modified (:package-name content))))
+          #{}
+          package-json-cache)
+
         modified-resources
-        (->> (:files @index-ref)
-             (vals)
-             (filter was-modified?)
-             (into []))
+        (when (seq modified-packages)
+          (reduce-kv
+            (fn [modified js-file {:keys [package-name] :as rc}]
+              (if-not (contains? modified-packages package-name)
+                modified
+                (conj modified rc)))
+            []
+            files))

         modified-files
         (into [] (map :file) modified-resources)]
@@ -55,17 +71,13 @@
       control-chan
       ([_] :stop)

-      ;; FIXME: figure out how much CPU this uses
-      ;; this is mostly watching node_modules which is unlikely to change
-      ;; but JS modules usually contain a whole bunch of files
-      ;; so increasing this would be fine
       (async/timeout 2000)
       ([_]
-        (try
-          (check-files! npm update-fn)
-          (catch Exception e
-            (log/warn-ex e ::npm-check-ex)))
-        (recur))))
+       (try
+         (check-files! npm update-fn)
+         (catch Exception e
+           (log/warn-ex e ::npm-check-ex)))
+       (recur))))

   ::terminated)


Moved destructuring into function parameter

--- src/wishlistd/models/queries.clj
+++ src/wishlistd/models/queries.clj
@@ -69,10 +69,9 @@
   (sql/with-connection db
     (sql/delete-rows :wish ["id=?" id])))

-(defn update-wish [wish]
-  (let [{:keys [id]} wish]
+(defn update-wish [{:keys [id] :as wish}]
     (sql/with-connection db
-      (sql/update-values :wish ["id=?" id] wish))))
+      (sql/update-values :wish ["id=?" id] wish)))

 ;; ADVANCED STUFF


use ethereum address of the default wallet account for ens resolution

Signed-off-by: yenda <96f164ad4d9b2b0dacf8ebee2bb1eeb3aa69adf1@status.im>

--- src/status_im/ens/core.cljs
+++ src/status_im/ens/core.cljs
@@ -59,7 +59,8 @@
     (re-frame/dispatch [:ens/set-state username :unregistrable])))

 (fx/defn register-name
-  [{:keys [db] :as cofx} contract custom-domain? username address public-key]
+  {:events [:ens/register]}
+  [{:keys [db] :as cofx} {:keys [contract custom-domain? username address public-key]}]
   (let [{:keys [x y]} (ethereum/coordinates public-key)]
     (signing/eth-transaction-call
      cofx
@@ -100,7 +101,8 @@
               (assoc-state-for username state))}
      (when (and name (= :valid state))
        (let [{:keys [multiaccount]}        db
-             {:keys [address public-key]}     multiaccount
+             {:keys [public-key]}     multiaccount
+             address (ethereum/default-address db)
              registry (get ens/ens-registries (ethereum/chain-keyword db))]
          {:ens/resolve-address [registry name #(on-resolve registry custom-domain? username address public-key %)]})))))

@@ -156,11 +158,6 @@
   [{:keys [db]} username]
   {:db (assoc-state-for db username :registration-failed)})

-(fx/defn register
-  {:events [:ens/register]}
-  [cofx {:keys [contract custom-domain? username address public-key]}]
-  (register-name cofx contract custom-domain? username address public-key))
-
 (fx/defn store-name-detail
   {:events [:ens/store-name-detail]}
   [{:keys [db]} name k v]


Fix the regex

Fix the regex

--- src/nine90_extractor/core.clj
+++ src/nine90_extractor/core.clj
@@ -53,7 +53,7 @@
   (Rectangle. 2200 y-off 300 row-height))

 (defn parse-name-and-title [name-str]
-  (when-let [[_ _ name title] (re-matches #"\W*(\(\d+\))?\W*(.*)\W*(.*)\W*" name-str)]
+  (when-let [[_ _ name title] (re-matches #"\s*(\(\d+\))?s*(.*)s*(.*)s*" name-str)]
     {:name name :title title}))

 (defn parse-hours [hours-str]
@@ -100,7 +100,7 @@
         tess (Tesseract/getInstance)
         form-id (clojure.string/trim (.doOCR tess page-one name-rect))]
     (.setTessVariable tess "tessedit_char_whitelist" (str number-chars " ()"))
-    (last (re-find #"990\W*\((201\d)\)" form-id))))
+    (last (re-find #"990\s*\((201\d)\)" form-id))))

 (defn read-pdf [pdf]
   (let [ein (last (re-find #"([\d-]+)_.*\.pdf" (.getName pdf)))


Do fetch and reset --hard when loading existing repo

--- src-clj/acha/git_parser.clj
+++ src-clj/acha/git_parser.clj
@@ -3,6 +3,7 @@
             [clj-jgit.porcelain :as jgit.p]
             [clj-jgit.querying :as jgit.q]
             [clojure.java.io :as io]
+            [clojure.tools.logging :as logging]
             [clojure.string :as string])
   (:import [java.security MessageDigest]
            [java.io ByteArrayOutputStream]
@@ -11,17 +12,27 @@
            [org.eclipse.jgit.lib ObjectReader]
            [org.eclipse.jgit.api Git]
            [org.eclipse.jgit.revwalk RevWalk RevCommit RevTree]
+           [org.eclipse.jgit.transport FetchResult]
            [org.eclipse.jgit.treewalk EmptyTreeIterator CanonicalTreeParser AbstractTreeIterator]))

 (defn- data-dir [url]
   (let [repo-name (last (string/split url #"/"))]
     (str "./remotes/" repo-name "_" (util/md5 url))))

+(defn safely-force-pull [repo]
+  (try
+    (let [fetch-result ^FetchResult (jgit.p/git-fetch repo)]
+      (when-let [current (first (.getAdvertisedRefs fetch-result))]
+        (jgit.p/git-reset repo (.getName (.getObjectId current)) :hard)))
+    (catch Exception e
+      (logging/error e "Error occured during force pull"))))
+
 (defn load-repo [url]
   (let [path (str (data-dir url) "/repo")]
     (if (.exists (io/as-file path))
-      ;; todo fetch and hard reset too
-      (jgit.p/load-repo path)
+      (let [repo (jgit.p/load-repo path)]
+        (safely-force-pull repo)
+        repo)
       (jgit.p/git-clone url path))))

 (gen-interface
@@ -117,5 +128,3 @@

 (defn setup []
  (repo-info "https://github.com/tonsky/datascript.git"))
-;  (spit "test_rails" (prn-str (repo-info "https://github.com/rails/rails.git"))))
-


Adding require for geodetic ring validation so that it is included in loaded test code.

--- test/cmr/spatial/test/geodetic_ring.clj
+++ test/cmr/spatial/test/geodetic_ring.clj
@@ -9,6 +9,7 @@
             [cmr.spatial.point :as p]
             [cmr.spatial.mbr :as m]
             [cmr.spatial.geodetic-ring :as gr]
+            [cmr.spatial.geodetic-ring-validations]
             [cmr.spatial.ring-relations :as rr]
             [cmr.spatial.derived :as d]
             [cmr.spatial.test.generators :as sgen]


remove duplicate line-count defn

remove duplicate line-count defn

--- src/main/shadow/cljs/output.clj
+++ src/main/shadow/cljs/output.clj
@@ -80,11 +80,9 @@
        (every? #(str/starts-with? (str %) "goog") provides)
        ))

-(defn line-count [s]
-  (-> (StringReader. s)
-      (BufferedReader.)
-      (line-seq)
-      (count)))
+(defn line-count [text]
+  (with-open [rdr (io/reader (StringReader. text))]
+    (count (line-seq rdr))))

 (defn flush-sources-by-name
   ([state]
@@ -299,9 +297,7 @@
   (flush-unoptimized! state)
   state)

-(defn line-count [text]
-  (with-open [rdr (io/reader (StringReader. text))]
-    (count (line-seq rdr))))
+

 (defn create-index-map
   [{:keys [output-dir cljs-runtime-path] :as state}


fixed logging test

fixed logging test

--- test/picard/test/middleware/logging.clj
+++ test/picard/test/middleware/logging.clj
@@ -35,7 +35,7 @@
             (first (:remote-addr request ))
             request-time-string
             (:request-method request)
-            (:path-info request)
+            (request-url [request])
             (first (:http-version request))
             (second (:http-version request))
             (:response-status request)
@@ -136,9 +136,12 @@
   (binding [*log-msgs* (atom [])]
     (let [logger (Logger/getRootLogger)
           appender (mock-appender)]
-      (.removeAllAppenders logger)
-      (.addAppender logger appender)
-      (.setLayout appender (CommonLogFormatLayout.)))
-    (f)))
+      (try
+        (.removeAllAppenders logger)
+        (.addAppender logger appender)
+        (.setLayout appender (CommonLogFormatLayout.))
+        (f)
+        (finally
+         (.removeAllAppenders logger))))))

 (use-fixtures :each setup-logger)


Remove trailing whitespace

Remove trailing whitespace

--- test/simple_check/clojure_test_test.clj
+++ test/simple_check/clojure_test_test.clj
@@ -35,12 +35,12 @@
           read-string
           :num-tests
           (= ct/*default-test-count*)))
-
+
   (is (-> (capture-test-var #'trial-counts)
           read-string
           (select-keys [:test-var :result :num-tests])
           (= {:test-var 'trial-counts, :result true, :num-tests 5000})))
-
+
   (binding [ct/*report-trials* true]
      (let [output (capture-test-var #'trial-counts)]
        (is (re-matches #"(?s)\.{5}.+" output))))


attach a click listener to validate dom listeners

--- src-cljs/hello.cljs
+++ src-cljs/hello.cljs
@@ -28,7 +28,9 @@
 (defn ^:export main []
   (let [game-world (create-world)
         canvas-element (create-canvas)
-        graphics-context (.getContext canvas "2d")]
+        graphics-context (.getContext canvas-element "2d")]
+    (aset canvas-element "onclick" (fn []
+                                       (.log js/console "click event")))
     (letfn [(anim-frame []
               (update game-world)
               (clear-for-frame graphics-context)


reload ui with any js change

reload ui with any js change

--- frontend/src/figwheel/leftovers_figwheel.cljs
+++ frontend/src/figwheel/leftovers_figwheel.cljs
@@ -1,4 +1,5 @@
 (ns leftovers-figwheel
-  (:require [figwheel.client :as fw :include-macros true]))
+  (:require [figwheel.client :as fw]))

-(fw/watch-and-reload)
+; reload main UI when new js comes in
+(fw/start {:on-jsload (fn [] (leftover.core/main))})


Update location of echo script

Update location of echo script

--- worker/src/patavi/worker/main.clj
+++ worker/src/patavi/worker/main.clj
@@ -18,7 +18,7 @@
              ["-m" "--method" "R method name" :default "echo"]
              ["-p" "--packages" "Comma seperated list of additional R packages to load"
               :parse-fn #(split % #",\s?")]
-             ["-f" "--file" "R file to execute" :default "resources/pirate/echo.R"])
+             ["-f" "--file" "R file to execute" :default "resources-dev/pirate/echo.R"])
         method (:method options)
         file (:file options)]
     (when (:help options)


Using .isArray to test for arrayness

Using .isArray to test for arrayness

--- src/clojure/puppetlabs/certificate_authority/core.clj
+++ src/clojure/puppetlabs/certificate_authority/core.clj
@@ -116,7 +116,8 @@
     (instance? Set data-structure)
     (set (mapv #(keyword (string/replace % #"_" "-")) data-structure))

-    (.startsWith (str (type data-structure)) "class [")
+    (and ((complement nil?) data-structure)
+         (.isArray (.getClass data-structure)))
     (vec data-structure)

     :else


Story ID: RPC-236 - Improved actual and expected to print what they are rather than the whole check and the check wrapped in a not - is' message also now prints the assertion before evaluation - Added basic diff-ing for list-like things

--- src/untangled_spec/report.clj
+++ src/untangled_spec/report.clj
@@ -3,6 +3,7 @@
             [clojure.stacktrace :as stack]
             [untangled-spec.report-data :as rd]
             [colorize.core :as c]
+            [clojure.data :refer [diff]]
             )
   (:import clojure.lang.ExceptionInfo)
   )
@@ -18,22 +19,31 @@
 (defn space-level [level]
   (apply str (repeat (* 2 level) " ")))

-(defn print-test-results [test-results print-level]
+(defn print-test-results [test-results print-fn]
   (loop [filtered-test-results (filter #(not (= (:status %) :passed)) test-results)]
-    (when (not (empty? filtered-test-results))
-      (let [test-result (first filtered-test-results)]
-        (println)
-        (println (space-level print-level) (if (= (:status test-result) :error) "Error" "Failed") " in" (:where test-result))
-        (when-let [message (:message test-result)] (println (space-level print-level) message))
-        (println (space-level print-level) "expected:" (pr-str (:expected test-result)))
-        (println (space-level print-level) "  actual:" (pr-str (:actual test-result)))
-        (println)
+    (when (seq filtered-test-results)
+      (let [{:keys [message actual where status]} (first filtered-test-results)
+            [_ [_ act exp]] (read-string actual)]
+        (print-fn)
+        (print-fn (if (= status :error)
+                    "Error" "Failed") "in" where)
+        (when message (print-fn message))
+        (print-fn "expected:" exp)
+        (print-fn "  actual:" act)
+        (when (and (coll? exp)
+                   (not (map? exp)))
+          ;clojure.data/diff does basic eq check for strings & maps -> redundant
+          (let [[plus minus eq] (clojure.data/diff act exp)]
+            (print-fn "    diff: -" minus)
+            (print-fn "    diff: +" plus)))
+        (print-fn)
         (recur (rest filtered-test-results))))))

 (defn print-test-item [test-item print-level]
   (t/with-test-out
     (println (space-level print-level) (color-str (:status test-item) (:name test-item)))
-    (print-test-results (:test-results test-item) (inc print-level))
+    (print-test-results (:test-results test-item)
+                        (partial println (space-level (inc print-level))))
     (loop [test-items (:test-items test-item)]
       (when (not (empty? test-items))
         (print-test-item (first test-items) (inc print-level))


Fix typo in docstring

Fix typo in docstring

--- src/braid/search/server.clj
+++ src/braid/search/server.clj
@@ -47,7 +47,7 @@
 (defn search-threads-as
   "Return the ids of all threads, visible to the user, in the given group,
   matching the provided query.
-  The query can speficy tags by prefixing them with an octothope; for example,
+  The query can specify tags by prefixing them with an octothorpe; for example,
   the query 'foo #bar' will find any threads tagged with 'bar' containing the
   text 'foo'"
   [user-id [query group-id]]


Refactor

Refactor

--- src/buildviz/testsuites.clj
+++ src/buildviz/testsuites.clj
@@ -84,19 +84,18 @@
        (average-runtimes-by-testclass test-runs)))

-(defn- find-flaky-job-candidates [jobs]
-  (->> (seq jobs)
+(defn- find-flaky-build-candidates [builds]
+  (->> (seq builds)
        (map (fn [[build-id build-data]]
               (assoc build-data :id build-id)))
        (jobinfo/builds-grouped-by-same-inputs)
        (filter #(< 1 (count %)))))

-(defn- unrolled-testcases [{build-id :id start :start} test-results-func]
-  (->> (test-results-func build-id)
+(defn- unrolled-testcases [build test-results-func]
+  (->> (test-results-func (:id build))
        transform/unroll-testsuites
        (map (fn [[testcase-id testcase]]
-              [testcase-id {:build-id build-id
-                            :failure-time start
+              [testcase-id {:build build
                             :ok? (junit-xml/is-ok? testcase)}]))))

 (defn- flaky-testcases-for-builds [builds test-results-func]
@@ -114,10 +113,10 @@
               (get testcase-result-groups false)))))

 (defn- flaky-testcase-summary [unrolled-testcases]
-  (let [build-infos (map last unrolled-testcases)
-        last-build (apply max-key :failure-time build-infos)]
-    {:build-id (:build-id last-build)
-     :latest-failure (:failure-time last-build)
+  (let [testcase-data (map last unrolled-testcases)
+        last-builds-testcase (apply max-key #(get-in % [:build :start]) testcase-data)]
+    {:build-id (get-in last-builds-testcase [:build :id])
+     :latest-failure (get-in last-builds-testcase [:build :start])
      :flaky-count (count unrolled-testcases)}))

 (defn- flaky-testcase-summaries [unrolled-testcases]
@@ -128,7 +127,7 @@

 (defn flaky-testcases-as-list [builds test-results-func]
   (->> builds
-       find-flaky-job-candidates
+       find-flaky-build-candidates
        (mapcat #(flaky-testcases-for-builds % test-results-func))
        flaky-testcase-summaries
        (map transform/testcase->map)))


added some comments.

added some comments.

--- src/cljs/ta_crash/core.cljs
+++ src/cljs/ta_crash/core.cljs
@@ -23,6 +23,7 @@

 (defonce target {:target (. js/document (getElementById "app"))})

+;;; Helpers for setting state data.

 (defmulti set-state-data!
   (fn [type _]
@@ -40,6 +41,7 @@
         identifier (keyword (:identifier (first data)))]
     (swap! app-state assoc-in [:data type identifier] data)
     (swap! app-state assoc :identifier [identifier] :type [type])))
+

 ;;; Page Render Methods

@@ -75,6 +77,8 @@
     app-state
     target))

+
+;;; Client Side Routes
 (defn get-area-type []
   (if-let [area-type (.getItem (.-localStorage js/window) "area")]
     (keyword area-type)


Adds placeholder for input field

Adds placeholder for input field

--- src/cljs/todo_clj/core.cljs
+++ src/cljs/todo_clj/core.cljs
@@ -41,7 +41,11 @@
     (render [_]
       (dom/div nil
         (dom/h1 nil "Todo")
-        (dom/input #js {:ref "new-todo" :type "text" :onKeyPress #(handle-key-press % app owner)} nil)
+        (dom/input #js {:ref "new-todo"
+                        :type "text"
+                        :placeholder "What needs to be done?"
+                        :onKeyPress #(handle-key-press % app owner)}
+                   nil)
         (dom/ul nil (map todo (get app :todos)))))))

 (om/root


More codez... too bad it's untested

More codez... too bad it's untested

--- src/clojure/picard/pool.clj
+++ src/clojure/picard/pool.clj
@@ -20,30 +20,60 @@
    :decoder (HttpResponseDecoder.)
    :encoder (HttpRequestEncoder.)))

+(defn- increment-count-for
+  [state addr]
+  (swap!
+   state
+   (fn [[total by-addrs]]
+     [(inc total)
+      (update-in by-addrs [addr] #(if % (inc %) 1))])))
+
+(defn- decrement-count-for
+  [state addr]
+  (swap!
+   state
+   (fn [[total by-addrs]]
+     [(dec total)
+      (if (> (by-addrs addr 0) 1)
+        (assoc by-addrs addr (inc (by-addrs addr)))
+        (dissoc by-addrs addr))])))
+
 (defn- return-conn
-  [conn handler callback fresh?]
+  [[state] conn handler callback fresh?]
   (when (instance? Channel conn)
-    (.. conn getPipeline (addLast "handler" handler)))
+    (.. conn getPipeline (addLast "handler" handler))
+    (when fresh?
+      (increment-count-for state (.getRemoteAddress conn))))
   (callback conn fresh?))
+
+(defn- checkout-conn*
+  [[_ pool] addr]
+  (.checkout pool (netty/mk-socket-addr addr)))
+
+(defn- connect-client
+  [[_ _ factory] addr callback]
+  (netty/connect-client factory addr callback))

 (defn checkout-conn
   "Calls success fn with the channel"
-  [[_ pool client-factory] addr handler callback]
-  (if-let [conn (.checkout pool (netty/mk-socket-addr addr))]
-    (return-conn conn handler callback false)
-    (netty/connect-client
-     client-factory addr
-     #(return-conn % handler callback true))))
+  [pool addr handler callback]
+  (if-let [conn (checkout-conn* pool addr)]
+    (return-conn pool conn handler callback false)
+    (connect-client pool addr #(return-conn pool % handler callback true))))

 (defn checkin-conn
   "Returns a connection to the pool"
-  [[_ ^ChannelPool pool] ^Channel conn]
-  (when (.isOpen conn)
-    (.. conn getPipeline removeLast)
-    (.checkin pool conn)))
+  [[state ^ChannelPool pool] ^Channel conn]
+  (if (.isOpen conn)
+    (do (.. conn getPipeline removeLast)
+        (.checkin pool conn))
+    (decrement-count-for state (.getRemoteAddress conn))))

 (defn close-conn
-  [_ ^Channel conn]
+  "Closes a connection that cannot be reused. The connection is
+   not returned to the pool."
+  [[state] ^Channel conn]
+  (decrement-count-for state (.getRemoteAddress conn))
   (.close conn))

 (def default-options
@@ -59,9 +89,13 @@
      (let [options (merge default-options options)
            state   (atom [0 {}])]
        [state
+        ;; The channel pool with a callback that tracks open
+        ;; connections
         (ChannelPool.
          (options :expire-after)
          (reify ChannelPoolCallback
-           (channelClosed [_ addr] 1)))
+           (channelClosed [_ addr]
+             (decrement-count-for state addr))))
         (netty/mk-client-factory
-         create-pipeline options)])))
+         create-pipeline options)
+        options])))


working find-by-class

working find-by-class

--- src/clojurefx/clojurefx.clj
+++ src/clojurefx/clojurefx.clj
@@ -144,7 +144,7 @@

 ;; ## Scene graph walker
 (defn- has-method? [node method]
-  (not (empty? (clojure.lang.Reflector/getMethods (class node) 0 method false))))
+  (and (not (nil? node)) (not (empty? (clojure.lang.Reflector/getMethods (class node) 0 method false)))))

 (defn- graph-node-has-children? [node]
   ;{:pre [(s/valid? ::node node)]
@@ -162,7 +162,6 @@
 (defn- graph-node-get-children [node]
   {:pre [(s/valid? ::node node)]
    :post [coll?]}
-  (debug "Getting children from" node)
   (cond (has-method? node "getChildren") (.getChildren node)
         (has-method? node "getGraphic")  [(.getGraphic node)]
         (has-method? node "getMenus")    (.getMenus node)
@@ -193,19 +192,16 @@
 (defn- contains-class? [node clazz]
   {:pre [(s/valid? ::node node) (string? clazz)]
    :post [boolean?]}
-  (debug "NODETEST:" node)
   (s/valid? ::node node)
   (if (instance? javafx.scene.Scene node)
     false
-    (> 0 (count (filter #(= % clazz) (.getStyleClass node))))))
+    (< 0 (count (filter #(= % clazz) (.getStyleClass node))))))

 (defn find-child-by-class [node clazz]
   {:pre [(s/valid? ::node node)
          (string? clazz)]
    :post [#(or (s/valid? ::node node) nil?)]}
-  (debug "NODE:" node)
   (let [zipper (scenegraph-zipper node)]
-    (debug "ZIPPER:" zipper)
     (filter #(contains-class? % clazz) (flat-zipper zipper))))

 ;; ## Properties


New type matcher that should not match on roots of hierarchies. Does not work though :-(

--- damp.ekeko.aspectj.plugin/src/damp/ekeko/aspectj/annotations.clj
+++ damp.ekeko.aspectj.plugin/src/damp/ekeko/aspectj/annotations.clj
@@ -110,7 +110,8 @@
     (behavior-annotation|key-annotation|value-annotation|type|name ?behavior ?key ?val "damp.ekeko.aspectj.annotations.ExcludesPrevious")))

 ;;Type pattern matching
-
+(comment
+  ;;homebrew version. AspectJ pattern matcher is type-type|pattern in weaverworld
 (defn- type-simple-name
   [?type ?sn]
   (l/all
@@ -141,4 +142,14 @@
               (type-name|sub+ ?name ?match)]
              [(l/!= ?nameplus ?typePat)
               (type-simple-name ?match ?typePat)])))
-
+ )
+
+(defn type-type|pattern2
+ "Uses AJ pattern matcher BUT removes 'root' types when using the + operator e.g., XXX+ will NOT match XXX.
+For normal AJ type-pattern matching semantics use d.e.a.weaverworld/type-type|pattern"
+ [?type ?pattern]
+ (v+ ?pattern)
+ (type-type|pattern ?type ?pattern)
+ (fails
+   (type-type|pattern ?type (clojure.string/replace ?pattern #"\+" ""))))
+


Small optimizations for context reduction

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/fca/contexts.clj
+++ src/conexp/fca/contexts.clj
@@ -277,33 +277,31 @@
 (defn down-arrows
   "Computes the down arrow relation of ctx."
   [ctx]
-  (let [obj (objects ctx)
-	att (attributes ctx)
-	inz (incidence ctx)
-	prime (memoize (partial object-derivation ctx))]
+  (let [obj   (objects ctx),
+	att   (attributes ctx),
+	inz   (incidence ctx),
+	prime (map-by-fn #(object-derivation ctx #{%}) obj)]
     (set-of [g m]
 	    [g obj
 	     m att
 	     :when (and (not (inz [g m]))
 			(forall [h obj]
-			  (=> (proper-subset? (prime #{g})
-					      (prime #{h}))
+			  (=> (proper-subset? (prime g) (prime h))
 			      (inz [h m]))))])))

 (defn up-arrows
   "Computes the up arrow relation of ctx."
   [ctx]
-  (let [obj (objects ctx)
-	att (attributes ctx)
-	inz (incidence ctx)
-	prime (memoize (partial attribute-derivation ctx))]
+  (let [obj   (objects ctx),
+	att   (attributes ctx),
+	inz   (incidence ctx),
+	prime (map-by-fn #(attribute-derivation ctx #{%}) att)]
     (set-of [g m]
 	    [g obj,
 	     m att
 	     :when (and (not (inz [g m]))
 			(forall [n att]
-			  (=> (proper-subset? (prime #{m})
-					      (prime #{n}))
+			  (=> (proper-subset? (prime m) (prime n))
 			      (inz [g n]))))])))

 (defn up-down-arrows
@@ -314,24 +312,24 @@
 (defn reduce-clarified-context
   "Reduces context ctx assuming it is clarified."
   [ctx]
-  (let [uda (up-down-arrows ctx)
-	new-obj (set (map first uda))
+  (let [uda     (up-down-arrows ctx),
+	new-obj (set (map first uda)),
 	new-att (set (map second uda))]
-    (make-context new-obj new-att (incidence ctx))))
+    (make-context-nc new-obj new-att (incidence ctx))))

 (defn reduce-context-objects
   "Object reduction for ctx."
   [ctx]
-  (make-context (set-of g [[g _] (down-arrows ctx)])
-		(attributes ctx)
-		(incidence ctx)))
+  (make-context-nc (set-of g [[g _] (down-arrows ctx)])
+                   (attributes ctx)
+                   (incidence ctx)))

 (defn reduce-context-attributes
   "Attribute reduction for ctx."
   [ctx]
-  (make-context (objects ctx)
-		(set-of m [[_ m] (up-arrows ctx)])
-		(incidence ctx)))
+  (make-context-nc (objects ctx)
+                   (set-of m [[_ m] (up-arrows ctx)])
+                   (incidence ctx)))

 (defn reduce-context
   "Reduces context ctx."
@@ -344,8 +342,8 @@
   "Tests whether given context ctx is reduced or not."
   [ctx]
   (and (clarified? ctx)
-       (let [obj (objects ctx)
-	     att (attributes ctx)
+       (let [obj (objects ctx),
+	     att (attributes ctx),
 	     uda (up-down-arrows ctx)]
 	 (and (forall [g obj]
 		(exists [[h _] uda]


Add counter for ordering locals in groups.

Cannot rely on order of locals in &env

--- src/main/clojure/com/stuartsierra/lazytest/groups.clj
+++ src/main/clojure/com/stuartsierra/lazytest/groups.clj
@@ -24,18 +24,23 @@
       :post [(group? %)]}
      (Group. contexts examples nil metadata)))

+(let [counter (atom 0)]
+  (defn local-counter []
+    (swap! counter inc)))
+
 (defmacro with-context
   "Establishes a local binding of sym to the state returned by context
   c in all groups and examples found within body."
   [sym c & body]
-  `(let [~(with-meta sym {::local true}) ~c]
+  `(let [~(with-meta sym {::local true ::order (local-counter)}) ~c]
      ~@body))

 (defn find-locals
   "Returns a vector of locals bound by with-context in the
   environment."
   [env]
-  (vec (reverse (filter #(::local (meta %)) (keys env)))))
+  (vec (sort-by #(::order (meta %))
+                (filter #(::local (meta %)) (keys env)))))

 (defmacro example
   "Creates an example function, using current context locals for


Print context states in reporting functions

--- src/main/clojure/com/stuartsierra/lazytest/report.clj
+++ src/main/clojure/com/stuartsierra/lazytest/report.clj
@@ -39,9 +39,8 @@
   number, doc string, and stack trace if applicable."
   [r]
   (let [m (meta (:source r))]
-    (print (source-name r))
-
-    (newline)
+    (println (source-name r) (line-and-file r))
+    (println "Context states:" (:states r))
     (print-source-doc r)
     (when-let [e (:error r)]
       (println "STACK TRACE")
@@ -72,10 +71,12 @@

            (= :com.stuartsierra.lazytest/AssertionFailed (type r))
            (do (println indent "FAIL" (source-name r) (line-and-file r))
+               (println indent "Context states:" (:states r))
                (print-source-doc r))

            (= :com.stuartsierra.lazytest/AssertionThrown (type r))
            (do (println indent "ERROR" (source-name r) (line-and-file r))
+               (println indent "Context states:" (:states r))
                (print-source-doc r)
                (print-cause-trace (:error r))))))

@@ -87,8 +88,8 @@
   ([r stack]
      (cond (= :com.stuartsierra.lazytest/TestResult (type r))
            (when-not (success? r)
-             (doseq [c (:children r)]
-               (report-first-fail c (cons r stack))))
+             (report-first-fail (first (drop-while success? (:children r)))
+                                (cons r stack)))

            (= :com.stuartsierra.lazytest/TestThrown (type r))
            (do (print "ERROR AT ")


Finish regularized logistic regression

Finish regularized logistic regression

Refactoring coming up

--- src/mekena/reg-logistic-reg.clj
+++ src/mekena/reg-logistic-reg.clj
@@ -24,37 +24,14 @@
           :x-label "Microchip test 1"
           :y-label "Microchip test 2"))

+(def alpha 1)
+(def iterations 400)
 (def lambda 1)

 (defn hypothesis
   "sigmoid function: 1/(1+e^-z)"
   [z]
   (/ 1 (inc (Math/exp (- z)))))
-
-(defn map-features
-  "Return vector containing powers that features will be used to generate
-  the regularization parameter. map the features into all polynomial terms
-  of x1 and x2 up to the degree'th power. Assumes only 2 features (for now)"
-  [degree]
-  (for [i (range 1 (inc degree)) j (range (inc i))] [(- i j) j]))
-
-(defn regularize-features [x1 x2 poly-vec]
-  (map (fn [x1i x2i]
-         (reduce (fn [acc [x1-term x2-term]]
-                       (conj acc (i/mult (i/pow x1i x1-term)
-                                             (i/pow x2i x2-term))))
-                     [] poly-vec)) x1 x2))
-
-(defn regularize
-  [xs]
-  (let [x1 (i/sel qa-data :cols 0)
-        x2 (i/sel qa-data :cols 1)
-        polynomial-terms (map-features 6)
-        regularized (regularize-features x1 x2 polynomial-terms)]
-    (-> x1
-        i/nrow
-        (repeat 1)
-        (i/bind-columns regularized))))

 ; X : 118x28 theta is 28x1
 ; test: (compute-cost (regularize qa-data) accepted (repeat 28 0))
@@ -99,10 +76,91 @@
          (i/mmult xs')
          (i/mult alpha (/ -1 (count xs))))))

+(defn calc-regularized-theta
+  [theta lambda m]
+  (let [theta-size (count theta)
+        ones (i/matrix 1 theta-size theta-size)
+        iden (i/identity-matrix theta-size)]
+    (->> iden
+         (i/minus ones)
+         first
+         i/trans
+         (i/mult theta lambda (/ 1 m)))))
+
+(defn calc-regularized-theta
+  [theta lambda m]
+  (let [theta-size (count theta)
+        ones (i/matrix theta-size theta-size)
+        iden (i/identity-matrix theta-size)]
+  (-> theta
+      (assoc 0 0)
+      (i/mult lambda (/ 1 m)))))
+
 (defn calc-next-theta
   "calculate the next theta value"
   [xs y theta]
   (->> theta
        (calc-theta xs y)
+       (i/plus (calc-regularized-theta theta lambda (count xs)))
        (i/minus theta)))

+(defn gradient-descent
+  "Calculate gradient descent. Matrix contains multiple features with the y column
+  as the last column (the dependent variable).
+  An optional number of iterations can be passed as another parameter."
+  [iter y xs]
+  (drop (dec iter)
+        (take iter (iterate (partial calc-next-theta xs y)
+                            (repeat (i/ncol xs) 0))))
+
+(defn map-features
+  "Return vector containing powers that features will be used to generate
+  the regularization parameter. map the features into all polynomial terms
+  of x1 and x2 up to the degree'th power. Assumes only 2 features (for now)"
+  [degree]
+  (for [i (range 1 (inc degree)) j (range (inc i))] [(- i j) j]))
+
+(defn regularize-features [x1 x2 poly-vec]
+  (map (fn [x1i x2i]
+         (reduce (fn [acc [x1-term x2-term]]
+                       (conj acc (i/mult (i/pow x1i x1-term)
+                                             (i/pow x2i x2-term))))
+                     [] poly-vec)) x1 x2))
+
+(defn regularize
+  [xs]
+  (let [x1 (i/sel qa-data :cols 0)
+        x2 (i/sel qa-data :cols 1)
+        polynomial-terms (map-features 6)
+        regularized (regularize-features x1 x2 polynomial-terms)]
+    (-> x1
+        i/nrow
+        (repeat 1)
+        (i/bind-columns regularized))))
+
+(defn regularized-logistic-regression
+  "Calculate gradient descent. input is Dataset containing multiple features
+  with the y column as the last column (the dependent variable).
+  An optional number of iterations can be passed as another parameter."
+  ([dataset] (regularized-logistic-regression dataset iterations))
+  ([dataset iters] (let [y (i/sel dataset :cols (dec (i/ncol dataset)))
+                         xs (i/sel dataset :except-cols (dec (i/ncol dataset)))
+                         reg-x (regularize xs)]
+                     (first (gradient-descent iters y reg-x)))))
+
+(defn predict
+  "Predict the outcome (y values) given x and the calculated thetas"
+  [xs theta]
+  (->> theta
+       (i/mmult xs)
+       (i/matrix-map (comp (fn [y] (cond-> 0 (>= y 0.5) inc)) hypothesis))))
+
+(defn prediction-accuracy
+  [predicted actual]
+  (let [accurate-count (->> actual
+                            (map (fn [p a] (= p a)) predicted)
+                            (filter true?)
+                            count)]
+    (println "Prediction accuracy:" (double (* 100
+                                               (/ accurate-count
+                                                 (count predicted)))) "%")))


add email message function for `send-new-user-email` which formats and sends the user welcome email.

--- src/metabase/email/messages.clj
+++ src/metabase/email/messages.clj
@@ -2,10 +2,31 @@
   "Convenience functions for sending templated email messages.  Each function here should represent a single email.
    NOTE: we want to keep this about email formatting, so don't put heavy logic here RE: building data for emails."
   (:require [hiccup.core :refer [html]]
-            [metabase.email :as email]))
+            [metabase.email :as email]
+            [metabase.util :as u]))

 ;;; ### Public Interface
+
+(defn send-new-user-email
+  "Format and Send an welcome email for newly created users."
+  [first_name email password-reset-url]
+  {:pre [(string? first_name)
+         (string? email)
+         (u/is-email? email)
+         (string? password-reset-url)]}
+  (let [message-body (html [:html
+                            [:body
+                             [:p (format "Welcome to Metabase %s!" first_name)]
+                             [:p "Your account is setup and ready to go, you just need to set a password so you can login.  Follow the link below to reset your account password."]
+                             [:p [:a {:href password-reset-url} password-reset-url]]]])]
+    (email/send-message
+      "Your new Metabase account is all set up"
+      {email email}
+      :html message-body)
+    ;; return the message body we sent
+    message-body))
+

 (defn send-email-report
   "Format and Send an `EmailReport` email."


Stabilize branch - fixes byte stream.

Stabilize branch - fixes byte stream.

--- src/onyx/messaging/http_kit.clj
+++ src/onyx/messaging/http_kit.clj
@@ -75,7 +75,7 @@
         url (:url peer-site)
         route (format "%s%s" url send-route)
         compressed-batch (nippy/freeze messages)]
-    (client/post route {:body (ByteBuffer/wrap (.array compressed-batch))}))
+    (client/post route {:body (ByteBuffer/wrap compressed-batch)}))
   {})

 (defmethod extensions/internal-ack-message HttpKit
@@ -84,7 +84,7 @@
         url (:url (get-in replica [:peer-site acker-id]))
         route (format "%s%s" url acker-route)
         contents (nippy/freeze {:id message-id :completion-id completion-id :ack-val ack-val})]
-    (client/post route {:body (ByteBuffer/wrap (.array contents))})))
+    (client/post route {:body (ByteBuffer/wrap contents)})))

 (defmethod extensions/internal-complete-message HttpKit
   [messenger id peer-id replica]
@@ -92,5 +92,5 @@
         url (:url (get-in snapshot [:peer-site peer-id]))
         route (format "%s%s" url completion-route)
         contents (nippy/freeze {:id id})]
-    (client/post route {:body (ByteBuffer/wrap (.array contents))})))
+    (client/post route {:body (ByteBuffer/wrap contents)})))


New payload before completion.

New payload before completion.

--- src/onyx/peer/task_pipeline.clj
+++ src/onyx/peer/task_pipeline.clj
@@ -141,25 +141,27 @@
       (>!! close-resources-ch (munge-commit-tx event))
       (recur))))

-(defn close-resources-loop [close-ch complete-task-ch]
+(defn close-resources-loop [close-ch reset-payload-ch]
   (loop []
     (when-let [event (<!! close-ch)]
-      (taoensso.timbre/info "Closing out resources for " (:session event))
-      (>!! complete-task-ch (munge-close-resources event))
-      (recur))))
-
-(defn complete-task-loop [complete-ch reset-payload-node-ch]
+      (>!! reset-payload-ch (munge-close-resources event))
+      (recur))))
+
+(defn reset-payload-node [reset-ch internal-complete-ch]
+  (loop []
+    (when-let [event (<!! reset-ch)]
+      (when (:tail-batch? event)
+        (let [event (munge-new-payload event)]
+          (>!! (:complete-ch event) true)))
+      (>!! internal-complete-ch event)
+      (recur))))
+
+(defn complete-task-loop [complete-ch]
   (loop []
     (when-let [event (<!! complete-ch)]
-      (let [event (munge-complete-task event)]
-        (when (:tail-batch? event)
-          (>!! reset-payload-node-ch event)))
-      (recur))))
-
-(defn reset-payload-node [reset-ch]
-  (when-let [event (<!! reset-ch)]
-    (munge-new-payload event)
-    (>!! (:complete-ch event) true)))
+      (when (:tail-batch? event)
+        (munge-complete-task event))
+      (recur))))

 (defrecord TaskPipeline [payload sync queue payload-ch complete-ch]
   component/Lifecycle
@@ -178,8 +180,8 @@
           ack-ch (chan 1)
           commit-tx-ch (chan 1)
           close-resources-ch (chan 1)
+          reset-payload-node-ch (chan 1)
           complete-task-ch (chan 1)
-          reset-payload-node-ch (chan 1)

           pipeline-data {:ingress-queues (:task/ingress-queues (:task payload))
                          :egress-queues (:task/egress-queues (:task payload))
@@ -240,11 +242,11 @@
         java.lang.Exception
         (fn [e & _] (.printStackTrace e)))

+      (dire/with-handler! #'reset-payload-node
+        java.lang.Exception
+        (fn [e & _] (.printStackTrace e)))
+
       (dire/with-handler! #'complete-task-loop
-        java.lang.Exception
-        (fn [e & _] (.printStackTrace e)))
-
-      (dire/with-handler! #'reset-payload-node
         java.lang.Exception
         (fn [e & _] (.printStackTrace e)))

@@ -260,8 +262,8 @@
         :ack-ch ack-ch
         :commit-tx-ch commit-tx-ch
         :close-resources-ch close-resources-ch
+        :reset-payload-node-ch reset-payload-node-ch
         :complete-task-ch complete-task-ch
-        :reset-payload-node-ch reset-payload-node-ch

         :open-session-loop (thread (open-session-loop read-batch-ch open-session-kill-ch pipeline-data))
         :read-batch-loop (thread (read-batch-loop read-batch-ch decompress-batch-ch))
@@ -273,9 +275,9 @@
         :status-check-loop (thread (status-check-loop status-check-ch ack-ch reset-payload-node-ch))
         :ack-loop (thread (ack-loop ack-ch commit-tx-ch))
         :commit-tx-loop (thread (commit-tx-loop commit-tx-ch close-resources-ch))
-        :close-resources-loop (thread (close-resources-loop close-resources-ch complete-task-ch))
-        :complete-task-loop (thread (complete-task-loop complete-task-ch reset-payload-node-ch))
-        :reset-payload-node (thread (reset-payload-node reset-payload-node-ch)))))
+        :close-resources-loop (thread (close-resources-loop close-resources-ch reset-payload-node-ch))
+        :reset-payload-node (thread (reset-payload-node reset-payload-node-ch complete-task-ch))
+        :complete-task-loop (thread (complete-task-loop complete-task-ch)))))

   (stop [component]
     (prn "Stopping Task Pipeline")
@@ -291,8 +293,8 @@
     (close! (:ack-ch component))
     (close! (:commit-tx-ch component))
     (close! (:close-resources-ch component))
+    (close! (:reset-payload-node-ch component))
     (close! (:complete-task-ch component))
-    (close! (:reset-payload-node-ch component))

     component))


Apparently *assert* is a thing.

Apparently *assert* is a thing.

--- lib/shin/cljs/cljs/core.clj
+++ lib/shin/cljs/cljs/core.clj
@@ -1,4 +1,6 @@
 (ns cljs.core)
+
+(def *assert* true)

 (defmacro ->
   ([x]


s/(:rule X)/(get-in X [:rule])/

s/(:rule X)/(get-in X [:rule])/

--- src/babel/cache.clj
+++ src/babel/cache.clj
@@ -146,7 +146,7 @@
     (lazy-shuffle result)))

 (defn get-head-phrases-of [parent cache]
-  (let [result (:head-phrases (get cache (:rule parent)))
+  (let [result (:head-phrases (get cache (get-in parent [:rule])))
         result (if (nil? result) (list) result)
         label (label-of parent)]
     (if (empty? result)
@@ -154,7 +154,7 @@
     (lazy-shuffle result)))

 (defn get-comp-phrases-of [parent cache]
-  (let [result (:comp-phrases (get cache (:rule parent)))
+  (let [result (:comp-phrases (get cache (get-in parent [:rule])))
         result (if (nil? result) (list) result)]
     (if (empty? result)
       (log/trace (str "comp-phrases of parent: " (label-of parent) " is empty.")))


Add test to robot-name to make sure name in reset isn't hard-coded (fixes #148)

--- exercises/robot-name/test/robot_name_test.clj
+++ exercises/robot-name/test/robot_name_test.clj
@@ -23,4 +23,7 @@
       (is (= (robot-name/robot-name robbie) (robot-name/robot-name robbie))
           "new name is persistent")
       (is (not= original-name (robot-name/robot-name robbie))
-          "new name is different from old name"))))
+          "new name is different from old name")
+      (is (not= (robot-name/robot-name robbie)
+                (-> robbie robot-name/reset-name robot-name/robot-name))
+          "new name is different each time"))))


[#2385] Use defaults for Flow form instance import

--- backend/src/akvo/lumen/lib/import/flow_common.clj
+++ backend/src/akvo/lumen/lib/import/flow_common.clj
@@ -19,7 +19,7 @@

 (defn form-instances* [headers-fn url]
   (let [response (-> url
-                     (http.client/get* (merge (http.client/req-opts 20000)
+                     (http.client/get* (merge http-client-req-defaults
                                               {:headers (headers-fn)
                                                :as :json-string-keys}))
                      :body)]
@@ -30,7 +30,7 @@
 (defn form-instances
   "Returns a lazy sequence of form instances"
   [headers-fn form]
-  (let [initial-url (str (:formInstancesUrl form) "&page_size=30")]
+  (let [initial-url (str (:formInstancesUrl form) "&page_size=300")]
     (form-instances* headers-fn initial-url)))

 (defn data-points*


duplicate custom keyword function for custom parsing

--- test/cheshire/test/custom.clj
+++ test/cheshire/test/custom.clj
@@ -186,3 +186,10 @@
 (deftest t-unicode-escaping
   (is (= "{\"foo\":\"It costs \\u00A3100\"}"
          (json/encode {:foo "It costs £100"} {:escape-non-ascii true}))))
+
+(deftest t-custom-keyword-fn
+  (is (= {:FOO "bar"} (json/decode "{\"foo\": \"bar\"}"
+                                   (fn [k] (keyword (.toUpperCase k))))))
+  (is (= {"foo" "bar"} (json/decode "{\"foo\": \"bar\"}" nil)))
+  (is (= {"foo" "bar"} (json/decode "{\"foo\": \"bar\"}" false)))
+  (is (= {:foo "bar"} (json/decode "{\"foo\": \"bar\"}" true))))


test exceptions

test exceptions

--- test/clj_http/client_test.clj
+++ test/clj_http/client_test.clj
@@ -50,6 +50,19 @@
     (is (= "ok" (:body resp)))))

+(deftest throw-on-exceptional
+  (let [client (fn [req] {:status 500})
+        e-client (client/wrap-exceptions client)]
+    (is (thrown-with-msg? Exception #"500"
+      (e-client {})))))
+
+(deftest pass-on-non-exceptional
+  (let [client (fn [req] {:status 200})
+        e-client (client/wrap-exceptions client)
+        resp (e-client {})]
+    (is (= 200 (:status resp)))))
+
+
 (deftest pass-on-no-method
   (let [m-client (client/wrap-method identity)
         echo (m-client {:key :val})]


Fix gradient for autoencoder

Fix gradient for autoencoder

--- src/cortex/impl/layers.cljc
+++ src/cortex/impl/layers.cljc
@@ -52,7 +52,7 @@
 ;; dropout field stores 0.0 or 1.0/probability as multiplicative noise
 ;; Works as a identity function otherwise
 #?(:cljs (register-module cortex.impl.layers.Dropout))
-(defrecord Dropout [output input-gradient ^double probability dropout]
+(defrecord Dropout [output input-gradient probability dropout]
   cp/PModule
     (calc [this input]
       (m/assign! output input)
@@ -397,7 +397,7 @@
         (Autoencoder. up down input-tmp output-tmp)))

     (backward [this input output-gradient]
-      (let [down (cp/backward down output-tmp (m/sub input (cp/output down)))
+      (let [down (cp/backward down output-tmp (m/sub (cp/output down) input))
             _ (m/assign! output-tmp output-gradient)
             _ (m/add! output-tmp (cp/input-gradient down)) ;; output-tmp contains gradient
             up (cp/backward up input output-tmp)


Simplify swap! functions

Simplify swap! functions

--- src/cyanite_cache/cache.clj
+++ src/cyanite_cache/cache.clj
@@ -17,11 +17,10 @@
   [mkeys tenant period rollup]
   (let [mkey (construct-mkey tenant period rollup)]
     (swap! mkeys
-           (fn [mkeys mkey]
+           (fn [mkeys]
              (if (contains? mkeys mkey)
                mkeys
-               (assoc mkeys mkey (atom {}))))
-           mkey)
+               (assoc mkeys mkey (atom {})))))
     (get @mkeys mkey)))

 (defn create-flusher
@@ -29,7 +28,7 @@
  (fn []
    (doseq [path @pkeys]
      (fn-store tenant period rollup time path (fn-agg (fn-data path)) ttl)
-     (swap! tkeys (fn [tkeys time] (dissoc tkeys time)) time)
+     (swap! tkeys (fn [tkeys] (dissoc tkeys time)))
      (when (empty? tkeys)
        (swap! mkeys (fn [mkeys mkey] (dissoc mkeys mkey))
               (construct-mkey tenant period rollup))))))
@@ -52,9 +51,8 @@
                                            rollup time ttl fn-data fn-agg
                                            fn-store)]
                (swap! pkeys
-                      (fn [pkeys flusher]
-                        (with-meta pkeys {:flusher flusher}))
-                      flusher)
+                      (fn [pkeys]
+                        (with-meta pkeys {:flusher flusher})))
                (assoc! tkeys time pkeys)
                (run-delayer! rollup flusher))))
          time)


Splits (optional-)path-exists-with-binding.


[frontend]: Case insensitive search

[frontend]: Case insensitive search

--- frontend/src/warehouse/storage/indexeddb.cljs
+++ frontend/src/warehouse/storage/indexeddb.cljs
@@ -8,8 +8,14 @@

 (def db-name "app-state7")

+(defn normalize-keyword [keyword]
+  (clojure.string/lower-case keyword))
+
 (defn component->obj [c]
-  (clj->js (assoc c :keywords (set (conj (:tags c) (:name c))))))
+  (let [keywords (->> (conj (:tags c) (:name c))
+                      (map normalize-keyword)
+                      (set))]
+    (clj->js (assoc c :keywords keywords))))

 (defn obj->component [o]
   (dissoc (js->clj o :keywordize-keys true) :keywords))
@@ -182,9 +188,11 @@
   (let [ch (a/chan 1)
         request (.indexedDB.open js/window db-name 1)]
     (set! (.-onupgradeneeded request) on-upgrade)
-    (set! (.-onsuccess request) (partial filter-keys (fn [res]
-                                                       (go (>! ch res)
-                                                           (a/close! ch))) keyword))
+    (set! (.-onsuccess request) (partial filter-keys
+                                         (fn [res]
+                                           (go (>! ch res)
+                                               (a/close! ch)))
+                                         (normalize-keyword keyword)))
     ch))

 (defn filter-ids


Record the length of the ingress queue every 15 seconds.

--- metlog-vault/src-server/metlog_vault/core.clj
+++ metlog-vault/src-server/metlog_vault/core.clj
@@ -18,9 +18,20 @@

 (def my-pool (at-at/mk-pool))

+(defn make-sample [ series-name value ]
+  {:t (java.util.Date.)
+   :series_name series-name
+   :val value})
+
 (defn queued-data-sink [ db-pool ]
   (let [ sample-queue (java.util.concurrent.LinkedBlockingQueue.) ]
-    (at-at/every 30
+    (at-at/every 15000
+                 (exception-barrier
+                  #(.add sample-queue (make-sample "vault-ingress-queue-size"
+                                                   (.size sample-queue)))
+                  "Record ingress queue size")
+                 my-pool)
+    (at-at/every 60000
                  (exception-barrier
                   #(let [ snapshot (java.util.concurrent.LinkedBlockingQueue.) ]
                      (locking sample-queue
@@ -29,11 +40,12 @@
                        (log/info "Storing " (count snapshot) " samples.")
                        (data/with-db-connection db-pool
                          (data/store-data-samples (seq snapshot)))))
-                  "Store inbound queue")
+                  "Store ingress queue contents")
                  my-pool)
     (fn [ samples ]
       (log/info "Enqueuing " (count samples) " samples for later storage.")
       (doseq [ sample samples ]
+        (log/info "sample" sample)
         (.add sample-queue sample)))))

 (defmacro get-version []
@@ -73,7 +85,6 @@
                :type "text/javascript"}]]]))

 (defn all-routes [ store-samples ]
-  (log/info "data sink" store-samples )
   (routes
    (GET "/series-names" []
      (transit-response


Fix doc comment formats.

Fix doc comment formats.

--- src/afterglow/fixtures/chauvet.clj
+++ src/afterglow/fixtures/chauvet.clj
@@ -98,6 +98,7 @@
   using Q Light Controller Plus version 4.7.0 GIT.

   QLC+ Fixture Type: Scanner."
+  {:doc/format :markdown}
   ([]
    (intimidator-scan-led-300 :11-channel))
   ([mode]
@@ -404,6 +405,7 @@
   using Q Light Controller Plus version 5.0.0 GIT.

   QLC+ Fixture Type: Laser."
+  {:doc/format :markdown}
   ([]
    (scorpion-storm-fx-rgb :7-channel))
   ([mode]
@@ -484,6 +486,7 @@
 (defn scorpion-storm-rgx
   "[Scorpion Storm RGX](http://www.chauvetlighting.com/products/manuals/Scorpion_Storm_RGX_UM_Rev03_WO.pdf)
   grid effect laser."
+  {:doc/format :markdown}
   []
   {:channels [(chan/functions :control 1
                                        0 "DMX Mode"


bug fish

bug fish


Implement comparator for «improve-basic-order» the right way

do we need some performance testing here?

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/base.clj
+++ src/conexp/base.clj
@@ -100,7 +100,11 @@
   (let [base (seq base),
         clop (memoize clop)]
     (sort (fn [x y]
-            (lectic-< base (clop #{y}) (clop #{x})))
+            (if (= (clop #{y}) (clop #{x}))
+              0
+              (if (lectic-< base (clop #{y}) (clop #{x}))
+                -1
+                1)))
           base)))

 (defn all-closed-sets-in-family


CMR-738: Added support for cartesian polygons in atom responses.

--- src/cmr/search/results_handlers/atom_spatial_results_handler.clj
+++ src/cmr/search/results_handlers/atom_spatial_results_handler.clj
@@ -5,6 +5,7 @@
             [cmr.spatial.point :as p]
             [cmr.spatial.mbr :as m]
             [cmr.spatial.geodetic-ring :as gr]
+            [cmr.spatial.cartesian-ring :as cr]
             [cmr.spatial.line-string :as l]
             [clojure.string :as str]))

@@ -65,6 +66,17 @@
                (x/element :gml:posList {}
                           (shape->string ring))))

+  cmr.spatial.cartesian_ring.CartesianRing
+  (shape->string
+    [ring]
+    (points-map->points-str ring))
+
+  (shape->xml-element
+    [ring]
+    (x/element :gml:LinearRing {}
+               (x/element :gml:posList {}
+                          (shape->string ring))))
+
   cmr.spatial.polygon.Polygon
   (shape->xml-element
     [{:keys [rings]}]


Make toolbar-icons a separate variable

Make toolbar-icons a separate variable

for readability

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/gui/editors/context_editor/context_editor.clj
+++ src/conexp/contrib/gui/editors/context_editor/context_editor.clj
@@ -127,103 +127,105 @@

 ;;; Creating context editor widgets

-(let [second-operand (atom nil)
-      icons   [["copy.png" "C"
-                "Copy the selected cells to clipboard",
-                #(copy-to-clipboard (get-table %)) :no-return]
-               ["cut.png" "X",
-                "Cut the selected cells to clipboard",
-                #(cut-to-clipboard (get-table %)) :no-return]
-               ["paste.png" "P",
-                "Paste the clipboard to the selected cell and its down-right neighbors",
-                #(paste-from-clipboard (get-table %)) :no-return]
-               ["second-op.png" "M+",
-                "Use a copy of this context as second operand",
-                #(reset! second-operand (get-context (get-ectx %))) :no-return]
-               ["add-attribute.png" "+A",
-                "Adds a new attribute column to the context",
-                add-new-attribute]
-               ["add-object.png" "+O",
-                "Adds a new object row to the context",
-                add-new-object]
-               :separator
-               ["keep-attribute.png" "8<A",
-                "Remove all non-selected attribute columns from the context",
-                keep-attributes]
-               ["keep-object.png" "8<O",
-                "Remove all non-selected object rows from the context",
-                keep-objects]
-               ["keep-both.png" "8<OA",
-                "Remove all non-selected rows and columns from the context",
-                keep-objects-attributes]
-               :separator
-               ["cut-attribute.png" "-A",
-                "Remove all selected attribute columns from the context",
-                cut-attributes]
-               ["cut-object.png" "-O",
-                "Remove all selected object rows from the context",
-                cut-objects]
-               ["cut-both.png" "-OA",
-                "Remove all selected rows and columns from the context",
-                cut-objects-attributes]
-               ["clarify-attribute.png" "cA",
-                "Clarify the attribute columns of the context",
-                (cc-1 clarify-attributes)]
-               ["clarify-object.png" "cO",
-                "Clarify the object rows of the context",
-                (cc-1 clarify-objects)]
-               ["clarify-both.png" "cOA",
-                "Clarify both objects and attributes of the context",
-                (cc-1 clarify-context)]
-               :separator
-               ["reduce-attribute.png" "rA",
-                "Reduce the attribute columns of the context",
-                (cc-1 reduce-attributes)]
-               ["reduce-object.png" "rO",
-                "Reduce the object rows of the context",
-                (cc-1 reduce-objects)]
-               ["reduce-both.png" "rOA",
-                "Reduce both objects and attributes of the context",
-                (cc-1 reduce-context)]
-               ["transitive-closure.png" "trans",
-                "Apply transitive closure to the context",
-                (cc-1 context-transitive-closure)]
-               :separator
-               ["dual-context.png" "dual",
-                "Flip objects and attributes",
-                (cc-1 dual-context)]
-               ["inverse-context.png" "inv",
-                "Flip all crosses",
-                (cc-1 invert-context)]
-               ["sum.png" "sum",
-                "Calculate the context sum of this context with the second operand context"
-                (cc-2 context-sum)]
-               ["product.png" "prod",
-                "Calculate the context product of this context with the second operand context"
-                (cc-2 context-product)]
-               ["semi-product.png" "semi",
-                "Calculate the context semiproduct of this context with the second operand context"
-                (cc-2 context-semiproduct)]
-               ["xia-product.png" "Xia",
-                "Calculate the context Xia product of this context with the second operand context"
-                (cc-2 context-xia-product)]
-               :separator
-               ["union.png" "union",
-                "Calculate the context union of this context with the second operand context"
-                (cc-2 context-union)]
-               ["intersection.png" "inter",
-                "Calculate the context intersection of this context with the second operand context"
-                (cc-2 context-intersection)]
-               :separator
-               ["composition.png" "comp",
-                "Calculate the context composition of this context with the second operand context"
-                (cc-2 context-composition)]
-               ["apposition.png" "ap",
-                "Calculate the context apposition of this context with the second operand context"
-                (cc-2 context-apposition)]
-               ["subposition.png" "sub",
-                "Calculate the context subposition of this context with the second operand context"
-                (cc-2 context-subposition)]]]
+(let [second-operand (atom nil)]
+
+  (defvar- toolbar-icons
+    [["copy.png" "C"
+      "Copy the selected cells to clipboard",
+      #(copy-to-clipboard (get-table %)) :no-return]
+     ["cut.png" "X",
+      "Cut the selected cells to clipboard",
+      #(cut-to-clipboard (get-table %)) :no-return]
+     ["paste.png" "P",
+      "Paste the clipboard to the selected cell and its down-right neighbors",
+      #(paste-from-clipboard (get-table %)) :no-return]
+     ["second-op.png" "M+",
+      "Use a copy of this context as second operand",
+      #(reset! second-operand (get-context (get-ectx %))) :no-return]
+     ["add-attribute.png" "+A",
+      "Adds a new attribute column to the context",
+      add-new-attribute]
+     ["add-object.png" "+O",
+      "Adds a new object row to the context",
+      add-new-object]
+     :separator
+     ["keep-attribute.png" "8<A",
+      "Remove all non-selected attribute columns from the context",
+      keep-attributes]
+     ["keep-object.png" "8<O",
+      "Remove all non-selected object rows from the context",
+      keep-objects]
+     ["keep-both.png" "8<OA",
+      "Remove all non-selected rows and columns from the context",
+      keep-objects-attributes]
+     :separator
+     ["cut-attribute.png" "-A",
+      "Remove all selected attribute columns from the context",
+      cut-attributes]
+     ["cut-object.png" "-O",
+      "Remove all selected object rows from the context",
+      cut-objects]
+     ["cut-both.png" "-OA",
+      "Remove all selected rows and columns from the context",
+      cut-objects-attributes]
+     ["clarify-attribute.png" "cA",
+      "Clarify the attribute columns of the context",
+      (cc-1 clarify-attributes)]
+     ["clarify-object.png" "cO",
+      "Clarify the object rows of the context",
+      (cc-1 clarify-objects)]
+     ["clarify-both.png" "cOA",
+      "Clarify both objects and attributes of the context",
+      (cc-1 clarify-context)]
+     :separator
+     ["reduce-attribute.png" "rA",
+      "Reduce the attribute columns of the context",
+      (cc-1 reduce-attributes)]
+     ["reduce-object.png" "rO",
+      "Reduce the object rows of the context",
+      (cc-1 reduce-objects)]
+     ["reduce-both.png" "rOA",
+      "Reduce both objects and attributes of the context",
+      (cc-1 reduce-context)]
+     ["transitive-closure.png" "trans",
+      "Apply transitive closure to the context",
+      (cc-1 context-transitive-closure)]
+     :separator
+     ["dual-context.png" "dual",
+      "Flip objects and attributes",
+      (cc-1 dual-context)]
+     ["inverse-context.png" "inv",
+      "Flip all crosses",
+      (cc-1 invert-context)]
+     ["sum.png" "sum",
+      "Calculate the context sum of this context with the second operand context"
+      (cc-2 context-sum)]
+     ["product.png" "prod",
+      "Calculate the context product of this context with the second operand context"
+      (cc-2 context-product)]
+     ["semi-product.png" "semi",
+      "Calculate the context semiproduct of this context with the second operand context"
+      (cc-2 context-semiproduct)]
+     ["xia-product.png" "Xia",
+      "Calculate the context Xia product of this context with the second operand context"
+      (cc-2 context-xia-product)]
+     :separator
+     ["union.png" "union",
+      "Calculate the context union of this context with the second operand context"
+      (cc-2 context-union)]
+     ["intersection.png" "inter",
+      "Calculate the context intersection of this context with the second operand context"
+      (cc-2 context-intersection)]
+     :separator
+     ["composition.png" "comp",
+      "Calculate the context composition of this context with the second operand context"
+      (cc-2 context-composition)]
+     ["apposition.png" "ap",
+      "Calculate the context apposition of this context with the second operand context"
+      (cc-2 context-apposition)]
+     ["subposition.png" "sub",
+      "Calculate the context subposition of this context with the second operand context"
+      (cc-2 context-subposition)]])

   (defn get-current-second-operand-context
     "Returns the current second operand."
@@ -249,7 +251,7 @@
                                                  ActionEvent/CTRL_MASK false)]
       (register-keyboard-action table fill-selection-with-X "Fill-X" keystroke-fill :focus)
       (add-widget e-ctx widget)
-      (doseq [icon icons]
+      (doseq [icon toolbar-icons]
         (if (= icon :separator)
           (.add bar (Box/createHorizontalStrut 3))
           (let [[path alt tip fun no-return] icon]


open links in new window    - thanks cfleming

--- src/chat/client/views/helpers.cljs
+++ src/chat/client/views/helpers.cljs
@@ -41,7 +41,7 @@
       (map
         (fn [elt]
           (if-let [link (elt :link)]
-            (dom/a #js {:href link} link)
+            (dom/a #js {:href link :target "_blank"} link)
             (elt :text)))
         text-links-seq))))


allow pasting files in to upload

allow pasting files in to upload

--- src/chat/client/views/threads.cljs
+++ src/chat/client/views/threads.cljs
@@ -29,6 +29,8 @@
   (> (:created-at message)
      (thread :last-open-at)) )

+(def max-file-size (* 10 1024 1024))
+
 (defn thread-view [thread owner opts]
   (let [scroll-to-bottom
         (fn [owner thread]
@@ -59,12 +61,26 @@
               limbo? (and
                        (not (thread :new?))
                        (empty? (thread :tag-ids))
-                       (empty? (thread :mentioned-ids)))]
+                       (empty? (thread :mentioned-ids)))
+              maybe-upload-file (fn [file]
+                                  (if (> (.-size file) max-file-size)
+                                    (store/display-error! "File to big to upload, sorry")
+                                    (do (om/set-state! owner :uploading? true)
+                                        (s3/upload file (fn [url]
+                                                          (om/set-state! owner :uploading? false)
+                                                          (dispatch! :new-message
+                                                                     {:content url
+                                                                      :thread-id (thread :id)}))))))]
           (dom/div #js {:className (str "thread"
                                         " " (when new? "new")
                                         " " (when private? "private")
                                         " " (when limbo? "limbo")
                                         " " (when dragging? "dragging"))
+                        :onPaste (fn [e]
+                                   (let [pasted-files (.. e -clipboardData -files)]
+                                     (when (< 0 (.-length pasted-files))
+                                       (.preventDefault e)
+                                       (maybe-upload-file (aget pasted-files 0)))))
                         :onDragOver (fn [e]  (.stopPropagation e) (.preventDefault e)
                                       (om/set-state! owner :dragging? true))
                         :onDragLeave (fn [e] (om/set-state! owner :dragging? false))
@@ -72,15 +88,7 @@
                                   (om/set-state! owner :dragging? false)
                                   (let [file-list (.. e -dataTransfer -files)]
                                     (when (< 0 (.-length file-list))
-                                      (let [file (aget file-list 0)]
-                                        (if (> (.-size file) (* 10 1024 1024))
-                                          (store/display-error! "File to big to upload, sorry")
-                                          (do (om/set-state! owner :uploading? true)
-                                              (s3/upload file (fn [url]
-                                                                (om/set-state! owner :uploading? false)
-                                                                (dispatch! :new-message
-                                                                                {:content url
-                                                                                :thread-id (thread :id)})))))))))}
+                                      (maybe-upload-file (aget file-list 0)))))}

             (when limbo?
               (dom/div #js {:className "notice"}


Fix concurrency issue in repo handling; more resilient cloning

--- src/cider_ci/ex/git/repository.clj
+++ src/cider_ci/ex/git/repository.clj
@@ -23,9 +23,14 @@
     ))

+;### Repo path ################################################################
+
 (defn- canonical-repository-path [repository-url]
-  (str (:git_repos_dir (get-config)) (File/separator)
-       (ci-fs/path-proof repository-url)))
+  (let [absolute-repos-path (fs/absolute (:git_repos_dir (get-config)))
+        path (str absolute-repos-path  (File/separator)
+                  (ci-fs/path-proof repository-url))]
+    (assert (> (count path) (count (str absolute-repos-path))))
+    path))

 ;### Agents ###################################################################

@@ -35,11 +40,13 @@
   (or (@repository-agents-atom repository-url)
       ((swap! repository-agents-atom
               (fn [repository-agents repository-url]
-                (conj repository-agents
-                      {repository-url
-                       (agent {:repository-url repository-url
-                               :repository-path (canonical-repository-path repository-url) }
-                              :error-mode :continue)}))
+                (if (repository-agents repository-url)
+                  repository-agents
+                  (conj repository-agents
+                        {repository-url
+                         (agent {:repository-url repository-url
+                                 :repository-path (canonical-repository-path repository-url) }
+                                :error-mode :continue)})))
               repository-url)
        repository-url)))

@@ -47,6 +54,7 @@
 ;### Core Git #################################################################

 (defn- create-mirror-clone [url path]
+  (system/exec ["rm" "-rf" path])
   (system/exec-with-success-or-throw
     ["git" "clone" "--mirror" url path]
     {:add-env {"GIT_SSL_NO_VERIFY" "1"}


Fix schema

Fix schema

--- src/cljc/salava/badge/schemas.cljc
+++ src/cljc/salava/badge/schemas.cljc
@@ -70,7 +70,7 @@
    (s/optional-key :endorsement_count) (s/maybe s/Int)
    (s/optional-key :pending_endorsements_count) (s/maybe s/Int)
    (s/optional-key :new_message_count) (s/maybe s/Int)
-   (s/optional-key :gallery_id)        s/Int})
+   (s/optional-key :gallery_id)        (s/maybe s/Int)})

 (s/defschema BadgesToExport (select-keys Badge [:id :name :description :image_file
                                                 :issued_on :expires_on :visibility


add metabadge link to info page

add metabadge link to info page

--- src/cljs/salava/badge/ui/info.cljs
+++ src/cljs/salava/badge/ui/info.cljs
@@ -24,7 +24,8 @@
             [salava.core.ui.content-language :refer [init-content-language content-language-selector content-setter]]
             [salava.social.ui.badge-message-modal :refer [badge-message-link]]
             [salava.admin.ui.reporttool :refer [reporttool1]]
-            [salava.badge.ui.verify :refer [check-badge]]))
+            [salava.badge.ui.verify :refer [check-badge]]
+            [salava.metabadge.ui.metabadge :refer [metabadge]]))

@@ -254,6 +255,8 @@
                [:div [:label (t :badge/Recipient) ": " ] [:a.link {:href (path-for (str "/user/profile/" owner))} first_name " " last_name]]
                [:div [:label (t :badge/Recipient) ": "]  first_name " " last_name]))

+            [:div [metabadge (:assertion_url @state)]]
+
            [:div.description description]

            ;check-badge-link


cleanup dom nodes

cleanup dom nodes

--- src/cljs/shadow/devtools/test.cljs
+++ src/cljs/shadow/devtools/test.cljs
@@ -23,8 +23,13 @@
   [{:keys [var]}]
   (js/console.groupEnd (-> var meta :name str)))

-(defn on-reset! [node callback]
-  (js/goog.object.set node "__shadow$remove" callback))
+(def reset-callback-ref (volatile! nil))
+
+(defn on-reset!
+  ([callback]
+   (vreset! reset-callback-ref callback))
+  ([node callback]
+   (js/goog.object.set node "__shadow$remove" callback)))

 (defn dom-test-root []
   (dom/by-id "shadow-test-root"))
@@ -33,16 +38,20 @@
   (let [root
         (dom-test-root)]

-    (doseq [container (dom/query "div.shadow-test-el" (dom-test-root))
-            :let [shadow-remove (js/goog.object.get container "__shadow$remove")]
+    (doseq [test-el (dom/query "div.shadow-test-el" (dom-test-root))
+            :let [shadow-remove
+                  (or (js/goog.object.get test-el "__shadow$remove")
+                      @reset-callback-ref)]
             :when shadow-remove]
-      (shadow-remove container))
+      (shadow-remove test-el))

     (dom/reset root)))

 (defn livetest-stop []
+  (js/console.clear)
+  (js/console.group "livetest-reset")
   (dom-test-clear)
-  (js/console.clear))
+  (js/console.groupEnd "livetest-reset"))

 (defn empty-env []
   (test/empty-env))


CMR-740: Changed granule mapping to store access value for retrieval in ACL enforcement.

--- src/cmr/indexer/data/index_set.clj
+++ src/cmr/indexer/data/index_set.clj
@@ -248,7 +248,10 @@
                    :producer-gran-id.lowercase string-field-mapping
                    :day-night (stored string-field-mapping)
                    :day-night.lowercase string-field-mapping
-                   :access-value double-field-mapping
+
+                   ;; Access value is stored to allow us to enforce acls after retrieving results
+                   ;; for certain types of queries.
+                   :access-value (stored double-field-mapping)

                    ;; We need to sort by a combination of producer granule and granule ur
                    ;; It should use producer granule id if present otherwise the granule ur is used


Update show creation docs, remove needless def.

--- src/afterglow/examples.clj
+++ src/afterglow/examples.clj
@@ -31,18 +31,14 @@
   ;; make sure a sane logging environment is established.
   (core/init-logging)

-  ;; Create a show that runs on OLA universe 1, for demonstration purposes.
-  (def sample-show
-  "A show that runs on OLA universe 1, for demonstration purposes."
-  (show/show :universes [universe]))
-
+  ;; Create a show on the chosen OLA universe, for demonstration purposes.
   ;; Make it the default show so we don't need to wrap everything below
   ;; in a (with-show sample-show ...) binding.
-  (set-default-show! sample-show)
+  (set-default-show! (show/show :universes [universe]))

   ;; TODO: Should this be automatic? If so, creating the show should assign the name too.
   ;; Register it with the web interface.
-  (show/register-show sample-show "Sample Show")
+  (show/register-show *show* "Sample Show")

   ;; Throw a couple of fixtures in there to play with. For better fun, use
   ;; fixtures and addresses that correspond to your actual hardware.
@@ -58,7 +54,7 @@
   (show/patch-fixture! :ws-1 (blizzard/weather-system) universe 161
                        :x (tf/inches 22) :y (tf/inches 7) :z (tf/inches 7)
                        :x-rotation (tf/degrees 90))
-  'sample-show)
+  '*show*)

 (defn global-color-effect


Fix docstring typo in update-system-reverse

--- src/com/stuartsierra/component.clj
+++ src/com/stuartsierra/component.clj
@@ -128,7 +128,7 @@
             (sort (dep/topo-comparator graph) component-keys))))

 (defn update-system-reverse
-  "Like update-system but operates in reverse-dependence order."
+  "Like update-system but operates in reverse dependency order."
   [system component-keys f & args]
   (let [graph (dependency-graph system component-keys)]
     (reduce (fn [system key]


CMR-4216 - Added commented out test for unlimited count.

--- system-int-test/test/cmr/system_int_test/search/collection_directory_pages_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_directory_pages_test.clj
@@ -6,6 +6,7 @@
    [clojure.string :as string]
    [clojure.test :refer :all]
    [cmr.mock-echo.client.echo-util :as e]
+   [cmr.search.site.data :as site-data]
    [cmr.search.site.routes :as r]
    [cmr.system-int-test.data2.core :as d]
    [cmr.system-int-test.system :as s]
@@ -93,6 +94,9 @@
       (string/includes? body (format "%s/%s" url "C1200000014-PROV1.html"))
       (string/includes? body "Collection Item 1"))))

+(def expected-over-ten-count
+  "<td class=\"align-r\">\n        14\n      </td>")
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Functions for creating testing data
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -105,23 +109,34 @@
          c1-p2 c2-p2 c3-p2] (for [p ["PROV1" "PROV2"]
                                   n (range 1 4)]
                               (d/ingest-umm-spec-collection
-                                p
-                                (-> exp-conv/example-collection-record
-                                    (assoc :ShortName (str "s" n))
-                                    (assoc :EntryTitle (str "Collection Item " n)))
+                               p
+                               (assoc exp-conv/example-collection-record
+                                      :ShortName (str "s" n)
+                                      :EntryTitle (str "Collection Item " n))
+                               {:format :umm-json
+                                :accept-format :json}))
+         [c1-p3 c2-p3 c3-p3] (for [n (range 4 7)]
+                               (d/ingest-umm-spec-collection
+                                "PROV3"
+                                (assoc exp-conv/example-collection-record
+                                       :ShortName (str "s" n)
+                                       :EntryTitle (str "Collection Item " n)
+                                       :DOI (cm/map->DoiType
+                                             {:DOI (str "doi" n)
+                                              :Authority (str "auth" n)}))
                                 {:format :umm-json
                                  :accept-format :json}))
-         [c1-p3 c2-p3 c3-p3] (for [n (range 4 7)]
-                               (d/ingest-umm-spec-collection
-                                 "PROV3"
-                                 (-> exp-conv/example-collection-record
-                                     (assoc :ShortName (str "s" n))
-                                     (assoc :EntryTitle (str "Collection Item " n))
-                                     (assoc :DOI (cm/map->DoiType
-                                                   {:DOI (str "doi" n)
-                                                    :Authority (str "auth" n)})))
-                                 {:format :umm-json
-                                  :accept-format :json}))]
+         ;; Let's create another collection that will put the total over the
+         ;; default of 10 values so that we can ensure the :unlimited option
+         ;; is being used in the directory page data.
+         over-ten-colls (for [n (range 20 41)]
+                          (d/ingest-umm-spec-collection
+                           "PROV2"
+                           (assoc exp-conv/example-collection-record
+                                  :ShortName (str "s" n)
+                                  :EntryTitle (str "Collection Item " n))
+                           {:format :umm-json
+                            :accept-format :json}))]
     ;; Wait until collections are indexed so tags can be associated with them
     (index/wait-until-indexed)
     ;; Use the following to generate html links that will be matched in tests
@@ -129,19 +144,19 @@
           notag-colls [c1-p1 c1-p2 c1-p3]
           nodoi-colls [c1-p1 c2-p1 c3-p1 c1-p2 c2-p2 c3-p2]
           doi-colls [c1-p3 c2-p3 c3-p3]
-          all-colls (into nodoi-colls doi-colls)
-          tag-colls [c2-p1 c2-p2 c2-p3 c3-p1 c3-p2 c3-p3]
+          all-colls (flatten [over-ten-colls nodoi-colls doi-colls])
+          tag-colls (into over-ten-colls [c2-p1 c2-p2 c2-p3 c3-p1 c3-p2 c3-p3])
           tag (tags/save-tag
                 user-token
                 (tags/make-tag {:tag-key "gov.nasa.eosdis"})
                 tag-colls)]
     (index/wait-until-indexed)
     ;; Sanity checks
-    (assert (= (count notag-colls) 3))
-    (assert (= (count nodoi-colls) 6))
-    (assert (= (count doi-colls) 3))
-    (assert (= (count tag-colls) 6))
-    (assert (= (count all-colls) 9)))))
+    (is (= (count notag-colls) 3))
+    (is (= (count nodoi-colls) 6))
+    (is (= (count doi-colls) 3))
+    (is (= (count tag-colls) 27))
+    (is (= (count all-colls) 30)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Fixtures
@@ -182,6 +197,7 @@
       (is (expected-header-link? body)))))

 (deftest eosdis-level-links
+  (Thread/sleep 1000)
   (let [response (get-response "site/collections/directory/eosdis")
         body (:body response)]
     (testing "check eosdis level status and links"
@@ -194,7 +210,13 @@
            (< (string/index-of body "PROV2")
               (string/index-of body "PROV3")))))
     (testing "eosdis-level directory page should have header links"
-      (is (expected-header-link? body)))))
+      (is (expected-header-link? body)))
+    (testing "provider page should have header links"
+      (is (expected-header-link? body)))
+    ;; XXX Can't get a consistent count on the page ...
+    ; (testing "collection count is greater than the default 10-limit"
+    ;   (is (string/includes? body expected-over-ten-count)))
+    ))

 (deftest provider1-level-links
   (let [provider "PROV1"


Move macro so it will compile :/

Move macro so it will compile :/

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -745,16 +745,6 @@

 ;; Low-Level Tasks, Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(defmacro with-pass-thru
-  "Given a binding and body expressions, constructs a task handler. The body
-  expressions are evaluated for side effects with the current fileset bound
-  to binding. The current fileset is then passed to the next handler and the
-  result is then returned up the handler stack."
-  [bind & body]
-  (let [bind (if (vector? bind) (first bind) bind)]
-    `(boot.core/with-pre-wrap [fs#]
-       (boot.util/with-let [~bind fs#] ~@body))))
-
 (defmacro with-pre-wrap
   "Given a binding and body expressions, constructs a task handler. The body
   expressions are evaluated with the current fileset bound to binding, and the
@@ -804,6 +794,16 @@
                    "task handler must return a fileset")
            ~@body
            result#)))))
+
+(defmacro with-pass-thru
+  "Given a binding and body expressions, constructs a task handler. The body
+  expressions are evaluated for side effects with the current fileset bound
+  to binding. The current fileset is then passed to the next handler and the
+  result is then returned up the handler stack."
+  [bind & body]
+  (let [bind (if (vector? bind) (first bind) bind)]
+    `(with-pre-wrap [fs#]
+       (util/with-let [~bind fs#] ~@body))))

 (defmacro fileset-reduce
   "Given a fileset, a function get-files that selects files from the fileset,


Add get-sys-env & set-sys-env! to access system props and env vars

--- boot/core/src/boot/core.clj
+++ boot/core/src/boot/core.clj
@@ -677,6 +677,26 @@
        (mapcat (fn [[k v]] [k #(merge-or-replace % v)]))
        (apply set-env!)))

+(defn get-sys-env
+  "Returns the value associated with the system property k, the environment
+  variable k, or not-found if neither of those are set. If not-found is the
+  keyword :required, an exception will be thrown when there is no value for
+  either the system property or environment variable k."
+  ([ ] (merge {} (System/getenv) (System/getProperties)))
+  ([k] (get-sys-env k nil))
+  ([k not-found]
+   (util/with-let [v ((get-sys-env) k not-found)]
+     (when (= v not-found :required)
+       (throw (ex-info (format "Required env var: %s" k) {}))))))
+
+(defn set-sys-env!
+  "For each key value pair in kvs the system property corresponding to the key
+  is set. Keys and values must be strings, but the value can be nil or false
+  to remove the system property."
+  [& kvs]
+  (doseq [[^String k ^String v] (partition 2 kvs)]
+    (if v (System/setProperty k v) (System/clearProperty k))))
+
 ;; Defining Tasks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defmacro deftask


Update new default filterers, `:content` -> `:has-content`

--- src/io/perun.clj
+++ src/io/perun.clj
@@ -218,11 +218,11 @@
   '[[time-to-read "0.1.0"]])

 (def ^:private +ttr-defaults+
-  {:filterer :content})
+  {:filterer :has-content})

 (deftask ttr
   "Calculate time to read for each file. Add `:ttr` key to the files' meta"
-  [_ filterer FILTER code "predicate to use for selecting entries (default: `:content`)"]
+  [_ filterer FILTER code "predicate to use for selecting entries (default: `:has-content`)"]
   (let [pod     (create-pod ttr-deps)
         options (merge +ttr-defaults+ *opts*)]
     (boot/with-pre-wrap fileset
@@ -234,11 +234,11 @@
         (perun/set-meta fileset updated-files)))))

 (def ^:private +word-count-defaults+
-  {:filterer :content})
+  {:filterer :has-content})

 (deftask word-count
   "Count words in each file. Add `:word-count` key to the files' meta"
-  [_ filterer FILTER code "predicate to use for selecting entries (default: `:content`)"]
+  [_ filterer FILTER code "predicate to use for selecting entries (default: `:has-content`)"]
   (let [pod (create-pod ttr-deps)
         options (merge +word-count-defaults+ *opts*)]
     (boot/with-pre-wrap fileset
@@ -253,13 +253,13 @@
   '[[gravatar "0.1.0"]])

 (def ^:private +gravatar-defaults+
-  {:filterer :content})
+  {:filterer :has-content})

 (deftask gravatar
   "Find gravatar urls using emails"
   [s source-key SOURCE-PROP kw "email property used to lookup gravatar url"
    t target-key TARGET-PROP kw "property name to store gravatar url"
-   _ filterer FILTER code "predicate to use for selecting entries (default: `:content`)"]
+   _ filterer FILTER code "predicate to use for selecting entries (default: `:has-content`)"]
   (let [pod (create-pod gravatar-deps)
         options (merge +gravatar-defaults+ *opts*)]
     (boot/with-pre-wrap fileset
@@ -283,11 +283,11 @@
       (perun/set-meta fileset updated-files))))

 (def ^:private +build-date-defaults+
-  {:filterer :content})
+  {:filterer :has-content})

 (deftask build-date
   "Add :date-build attribute to each file metadata and also to the global meta"
-  [_ filterer FILTER code "predicate to use for selecting entries (default: `:content`)"]
+  [_ filterer FILTER code "predicate to use for selecting entries (default: `:has-content`)"]
   (boot/with-pre-wrap fileset
     (let [options         (merge +build-date-defaults+ *opts*)
           files           (filter (:filterer options) (perun/get-meta fileset))
@@ -408,7 +408,7 @@
 (deftask rss
   "Generate RSS feed"
   [f filename    FILENAME    str  "generated RSS feed filename"
-   _ filterer    FILTER      code "predicate to use for selecting entries (default: `:content`)"
+   _ filterer    FILTER      code "predicate to use for selecting entries (default: `:include-rss`)"
    o out-dir     OUTDIR      str  "the output directory"
    t site-title  TITLE       str  "feed title"
    p description DESCRIPTION str  "feed description"
@@ -436,7 +436,7 @@
 (deftask atom-feed
   "Generate Atom feed"
   [f filename    FILENAME    str  "generated Atom feed filename"
-   _ filterer    FILTER      code "predicate to use for selecting entries (default: `:content`)"
+   _ filterer    FILTER      code "predicate to use for selecting entries (default: `:include-atom`)"
    o out-dir     OUTDIR      str  "the output directory"
    t site-title  TITLE       str  "feed title"
    s subtitle    SUBTITLE    str  "feed subtitle"


Expose incomplete deployments

Expose incomplete deployments

--- src/exploud/web.clj
+++ src/exploud/web.clj
@@ -145,6 +145,10 @@
                                       :size (util/string->int size)
                                       :from (util/string->int from)})}))))

+   (GET "/incomplete-deployments"
+        []
+        (response {:deployments (store/deployments-with-incomplete-tasks)}))
+
    (GET "/deployments/:deployment-id"
         [deployment-id]
         (response (store/get-deployment deployment-id)))


part way through ch 14.3

part way through ch 14.3

--- src/joy/ch14.clj
+++ src/joy/ch14.clj
@@ -138,3 +138,48 @@
 (def fx-timeline #(reductions apply-effect %1 %2))

 (fx-timeline {} (take 3 events))
+
+(def PLAYERS #{{:player "Nick" :ability 32} {:player "Matt" :ability 26} {:player "Ryan" :ability 19}})
+
+(defn lookup [db name]
+  (first (sql/select #(= name (:player %)) db)))
+
+(lookup PLAYERS "Nick")
+
+(defn update-stats [db event]
+  (let [player (lookup db (:player event))
+        less-db (sql/difference db #{player})]
+    (conj less-db (merge player (effect player event)))))
+
+(update-stats PLAYERS {:player "Nick" :result :hit})
+
+(defn commit-event [db event]
+  (dosync (alter db update-stats event)))
+
+(commit-event (ref PLAYERS) {:player "Nick" :result :hit})
+
+(defn rand-event [{ability :ability}]
+  (let [able (numerator ability)
+        max (denominator ability)]
+    (rand-map 1 #(-> :result) #(if
+                                  (< (rand-int max) able)
+                                :hit :out))))
+
+(defn rand-events [total player]
+  (take total (repeatedly #(assoc
+                               (rand-event player) :player
+                               (:player player)))))
+
+(rand-events 3 {:player "Nick" :ability 32/100})
+
+(def agent-for-player
+  (memoize (fn [player-name]
+             (-> (agent [])
+                 (set-error-handler! #(println "ERROR:   " %1 %2))
+                 (set-error-mode! :fail)))))
+(defn feed [db event]
+  (let [a (agent-for-player (:player event))]
+    (send a
+          (fn [state]
+            (commit-event db event
+                          (conj state event))))))


Rename gen-key to gen-uncompressed-key

Rename gen-key to gen-uncompressed-key

--- src/bitcoin/miniwallet.clj
+++ src/bitcoin/miniwallet.clj
@@ -11,12 +11,12 @@
 (defn private-to-pubkey-string [k]
   (format (if (.isCompressed k) "%066x" "%0130x") (java.math.BigInteger. (.getPubKey k))))

-(defn gen-key []
+(defn gen-uncompressed-key []
   ;; hack to get the key uncompressed, because bitcoinj makes it compressed by default.
   (.getPrivateKeyEncoded (ECKey. (.getPrivKeyBytes (ECKey.)) nil) (NetworkParameters/prodNet)))

 (defn minikey-candidate []
-  (let [key-str (.toString (gen-key))]
+  (let [key-str (.toString (gen-uncompressed-key))]
     (str "S" (subs key-str 2 31))))

 (defn minikey-validate [key-str]


Add TODO comment for persisting cache state.

--- src/blocks/store/cache.clj
+++ src/blocks/store/cache.clj
@@ -10,6 +10,12 @@
     [clojure.data.priority-map :refer [priority-map]]
     [clojure.tools.logging :as log]
     [com.stuartsierra.component :as component]))
+
+; TODO: use a generic sorted-kv interface to persist state.
+; keys would look like:
+; [:priorities tick size] -> block id
+; [:total-size] -> size
+; [:tick] -> tick counter

 (defn- scan-state


Fix bug that some idiot introduced in a refactor

Man, that @jungziege guy. What an idiot.

--- src-cljs/frontend/api/path.cljs
+++ src-cljs/frontend/api/path.cljs
@@ -42,7 +42,7 @@
 (defn project-token [vcs-type project-name token]
   (gstring/format
    "%s/%s/token/%s"
-   (base-project-url-path vcs-type) vcs-type project-name token))
+   (base-project-url-path vcs-type) project-name token))

 (defn project-follow [vcs-type project]
   (case vcs-type


Support the shortened forms of :dependencies and :dev-dependencies.

--- src/cake/tasks/clojars.clj
+++ src/cake/tasks/clojars.clj
@@ -1,7 +1,7 @@
 (ns cake.tasks.clojars
   (:require [clojure.string :as s]
             [clojure.java.io :as io])
-  (:use cake cake.core))
+  (:use cake cake.core [bake.core :only [log]]))

 (def clojars-repo-url "http://clojars.org/repo")
 (def clojars-all-jars-url (str clojars-repo-url "/all-jars.clj"))
@@ -17,27 +17,28 @@
 			    (read-string line)))))))

 (defn clojars-install
-  ([library-name]
+  ([library-name dev]
      (if-let [version (get-latest-version library-name)]
-       (clojars-install library-name version)
+       (clojars-install library-name version dev)
        (println "Can't find version of" library-name "on clojars.org\r\n"
                 "If the library is in another repository, please provide a version argument.")))
-  ([library-name library-version]
-     (clojars-install library-name library-version :dependencies))
-  ([library-name library-version to]
-     (let [s-to (str to)
-           project (line-seq (io/reader "project.clj"))
-           dep-line (some #(and (re-find (re-pattern s-to) %) %) project)
-           pad (and dep-line (-> dep-line (s/split #"\[" 2) first count inc))]
-       (if pad
-         (spit "project.clj"
-               (s/replace (slurp "project.clj")
-                          (re-pattern (str s-to "\\s*\\["))
-                          (str s-to " [[" library-name
-                               " \"" library-version "\"]"
-                               (when-not (re-find #"\[\]" dep-line)
-                                 (str "\n" (s/join (repeat pad " ")))))))
-         (println s-to "wasn't found in your project.clj file.")))))
+  ([library-name library-version dev]
+     (let [s-to (if dev #{":dev-deps" ":dev-dependencies"} #{":dependencies" ":deps"})
+           project (line-seq (io/reader "project.clj"))]
+       (if-let [dep-line (some
+                          (fn [x] (and (some #(re-find (re-pattern %) x) s-to) x))
+                          project)]
+         (let [to (some s-to (.split dep-line " "))
+               pad (and dep-line (-> dep-line (s/split #"\[" 2) first count inc))]
+           (spit "project.clj"
+                 (s/replace (slurp "project.clj")
+                            (re-pattern (str to "\\s*\\["))
+                            (str to " [[" library-name
+                                 " \"" library-version "\"]"
+                                 (when-not (re-find #"\[\]" dep-line)
+                                   (str "\n" (s/join (repeat pad " ")))))))
+           (log "Added" library-name library-version "to your" (str to ".")))
+         (println "Neither" (first s-to) "nor" (last s-to) "were found in your project.clj.")))))

 (defn clojars-search [term]
   (let [response (http-get-text-seq clojars-all-jars-url)]
@@ -150,8 +151,9 @@
   {term :search}
   (->> term (s/join " ") clojars-search))

-(deftask install-lib
+(deftask add-dep
   "Install a library from into your project."
-  "The library will be added to the [dev-]dependency vector in your project.clj."
-  {args :install-lib}
-  (apply clojars-install args))+  "The library will be added to the :deps or :dependencies vector in your project.clj.
+   If you pass the --dev option, it'll be added to :dev-deps or :dev-dependencies."
+  {args :add-dep dev :dev}
+  (apply clojars-install (conj args dev)))


Add an artifact on the marker and on the page number

in the header, so that they are not seen in a screen reader

--- src/catalog/layout/fop.clj
+++ src/catalog/layout/fop.clj
@@ -60,7 +60,8 @@

 (defn- retrieve-marker []
   [:fo:inline
-   [:fo:retrieve-marker {:retrieve-class-name running-header-class-name
+   [:fo:retrieve-marker {:role "artifact"
+                         :retrieve-class-name running-header-class-name
                          :retrieve-position "last-ending-within-page"
                          :retrieve-boundary "page-sequence"}]])

@@ -378,7 +379,7 @@
      (mapcat #(genre-sexp (get items %) fmt % (inc level) opts) (keys items)))])

 (defn- page-number []
-  [:fo:inline
+  [:fo:wrapper {:role "artifact"}
    [:fo:page-number]])

 (defn- header [side]


Added assoc-on function

Added assoc-on function

--- lib/compojure/compojure.clj
+++ lib/compojure/compojure.clj
@@ -7,6 +7,14 @@

 (import '(clojure.lang Named)
         '(javax.servlet.http HttpServlet))
+
+(defn assoc-on
+  "Returns a new map of the same type with key mapped to val conjoined with the
+  existing value at that key. If existing value does not exist, it uses base."
+  [map base key val]
+  (if (contains? map key)
+    (merge-with conj map {key val})
+    (assoc map key (conj base val))))

 (defn parse-int
   "Parse a integer contained in 'string'."


Set context size and delimiters for search results

--- src/clj/cglossa/search.clj
+++ src/clj/cglossa/search.clj
@@ -57,15 +57,20 @@
         results))))

 (defn search [corpus-id queries]
-  (let [search         (db/run-sql "create vertex Search")
-        search-id      (db/stringify-rid search)
-        corpus         (first (db/sql-query "select from #TARGET" {:target corpus-id}))
-        named-query    (cwb-query-name corpus search-id)
-        commands       [(str "set DataDirectory \"" (fs/tmpdir) \")
-                        (cwb-corpus-name corpus queries)
-                        (construct-query-commands corpus queries named-query search-id 100)
-                        "cat Last"]
-        results        (run-cqp-commands (flatten commands))]
+  (let [search      (db/run-sql "create vertex Search")
+        search-id   (db/stringify-rid search)
+        corpus      (first (db/sql-query "select from #TARGET" {:target corpus-id}))
+        named-query (cwb-query-name corpus search-id)
+        s-tag       (:s_tag corpus "s")
+        commands    [(str "set DataDirectory \"" (fs/tmpdir) \")
+                     (cwb-corpus-name corpus queries)
+                     (construct-query-commands corpus queries named-query search-id 100)
+                     (str "set Context 1 " s-tag)
+                     "set LD \"{{\""
+                     "set RD \"}}\""
+                     (str "show +" s-tag "_id")
+                     "cat Last"]
+        results     (run-cqp-commands (flatten commands))]
     (-> search
         db/vertex->map
         (assoc :results results))))