Fix rando metric test failures :wrench:

Fix rando metric test failures :wrench:

--- test/metabase/api/metric_test.clj
+++ test/metabase/api/metric_test.clj
@@ -368,8 +368,8 @@

 ;;; GET /api/metric/

-(tu/expect-with-temp [Metric [metric-1]
-                      Metric [metric-2]
+(tu/expect-with-temp [Metric [metric-1 {:name "Metric A"}]
+                      Metric [metric-2 {:name "Metric B"}]
                       Metric [_        {:is_active false}]] ; inactive metrics shouldn't show up
   (tu/mappify (hydrate [metric-1
                         metric-2] :creator))


add missing :js-package-dir for neste pkg

--- src/main/shadow/build/npm.clj
+++ src/main/shadow/build/npm.clj
@@ -678,7 +678,7 @@
                 [package match])
               (let [nested-package
                     (-> (read-package-json npm nested-package-json)
-                        (assoc ::parent package))]
+                        (assoc ::parent package :js-package-dir (:js-package-dir package)))]
                 ;; rel-require resolved to a dir, continue with ./ from there
                 (find-match-in-package npm nested-package "./")))))


image review tests

image review tests

--- test/vignette/util/services_test.clj
+++ test/vignette/util/services_test.clj
@@ -0,0 +1,23 @@
+(ns vignette.util.services-test
+  (:require [midje.sweet :refer :all]
+            [vignette.util.services :as svc]
+            [vignette.util.consul :as consul]))
+
+(facts :static-assets :url
+       (svc/materialize-static-asset-url "uuid_sample") => "http://hostname:9999/image/uuid_sample"
+       (provided
+         (consul/find-service consul/create-consul "static-assets" "prod") => {:address "hostname", :port 9999})
+       (consul/create-consul ..dupa..) => ..aaa..)
+
+;(defn materialize-static-asset-url [oid]
+;  (str
+;    (consul/->uri
+;      (consul/find-service
+;        consul/create-consul "static-assets" consul/service-query-tag)) "/image/" oid))
+;
+;(defn materialize-image-review-url [oid & statuses]
+;  (let [query-params (str "status=" (if (empty? statuses) (join "&status=" ["FLAGGED" "UNREVIEWED"]) (join "&" statuses)))]
+;    (str
+;      (consul/->uri
+;        (consul/find-service
+;          consul/create-consul "image-review" consul/service-query-tag)) "/image-review/image/" oid "?" query-params)))


Add a missing requires

Add a missing requires

--- src/circle/backend/action/load_balancer.clj
+++ src/circle/backend/action/load_balancer.clj
@@ -2,13 +2,14 @@
   (:require [circle.backend.nodes :as nodes])
   (:require [circle.backend.action :as action])
   (:require [circle.backend.load-balancer :as lb])
-  (:require [circle.backend.ec2 :as ec2]))
+  (:require [circle.backend.ec2 :as ec2])
+  (:require [circle.backend.ec2-tag :as tag]))

 (defn add-instances []
   (action/action
    :name "add to load balancer"
    :act-fn (fn [context]
-             (lb/register-instances (-> context :build :lb-name)
+             (lb/add-instances (-> context :build :lb-name)
                                     (nodes/group-instance-ids (-> context :build :group))))))

 (defn wait-for-healthy* [lb-name & {:keys [instance-ids
@@ -40,7 +41,7 @@
     (filter (fn [tag]
               (and (contains? lb-ids (-> tag :resourceId))
                    (= (-> tag :key) :rev)
-                   (not= (-> tag :value) current-rev))) (circle.backend.ec2-tag/describe-tags))))
+                   (not= (-> tag :value) current-rev))) (tag/describe-tags))))

 (defn shutdown-remove-old-revisions
   "remove from the LB and shutdown  all instances that don't have the revision tag of the current deploy"


trying to fix the icon scaling issue.

trying to fix the icon scaling issue.

--- src/unspun/screens/number_needed.cljs
+++ src/unspun/screens/number_needed.cljs
@@ -9,16 +9,84 @@

 (defn draw-square
-  []
+  [size]
   (view {:style {:backgroundColor "orange"
-                 :borderColor     "black"
-                 :borderWidth     1
-                 ;:height          a
-                 ;:width           a
                  :flex            1
                  :aspectRatio     1
-                 :marginBottom    20
-                 }}))
+                 :justifyContent "space-around"
+                 :alignItems "center"
+                 :width           size
+                 :height          size}}
+        (ionicon {:name  "ios-body"                         ;"ios-radio-button-on"
+                  :size  100
+                  :style {:color     "white"
+                          :height    100
+                          :transform [{:scale (/ size 100)}]}})))
+
+(defn draw-n-square
+  [n]
+  (view {:backgroundColor "blue"
+         :style           {:flex           1
+                           :flexDirection  "row"
+                           :alignItems     "center"
+                           :justifyContent "space-around"
+                           :aspectRatio    1
+                           :margin         2
+                           }
+         :aspectRatio     1
+         }
+        (for [k (range n)]
+
+          (view {:key   k
+                 :style {:flex           1
+                         :flexDirection  "column"
+                         :alignItems     "center"
+                         :justifyContent "space-around"}
+                 }
+
+                (for [sq (range n)]
+                  (draw-square 50))))
+        ))
+
+#_(defn nested-n-square
+    [path]
+    (when (seq path)
+      (let [[n & r] path]
+        (if r
+          (draw-n-square n (nested-n-square r))
+          (draw-n-square n draw-square 50)))))
+
+(defn draw-4-square
+  []
+  (view {
+         :style       {:flex            1
+                       :flexDirection   "row"
+                       :alignItems      "center"
+                       :justifyContent  "space-around"
+                       :backgroundColor "red"
+                       :paddingTop      0
+                       :aspectRatio     1}
+         :aspectRatio 1
+         }
+        (view {:key   (str "top")
+               :style {:flex           1
+                       :flexDirection  "column"
+                       :alignItems     "center"
+                       :justifyContent "space-around"}
+               }
+              (for [sq (range 2)]
+                (draw-n-square 3)))
+
+        (view {:key   (str "bot")
+               :style {:flex           1
+                       :flexDirection  "column"
+                       :alignItems     "center"
+                       :justifyContent "space-around"}
+               }
+
+              (for [sq (range 2)]
+                (draw-n-square 5)))
+        ))

 (defn draw-circle [scenar color size x y]
   "draw a icon selected by scenario."
@@ -76,32 +144,34 @@

         ]
     (prn [w h dw dh])
-    (view {:style {:flex 1
-                   :flexDirection "column"
-                   :justifyContent "flex-start"
+    (view {:style {:flex            1
+                   :flexDirection   "column"
+                   :justifyContent  "flex-start"
                    :backgroundColor (:primary palette)
                    }}
-          (view {:style {:flex            0.3
+          (view {:style {:flex            0.4
                          :justifyContent  "center"
-                         :alignItems "stretch"
+                         :alignItems      "stretch"
                          :backgroundColor (:dark-primary palette)}}
-                (scroll-view {:style {:flex      1}
-                       :key   1}
-                      (text {:style {:padding  20
-                                     :fontSize (text-field-font-size)}}
-                            (text-field :light-primary "normal" nn-head)
-                            (text-field (if (> rr 1) :accent :text-icons) "bold" nn-one)
-                            (text-field :light-primary "normal" nn-one-to-group)
-                            (text-field :light-primary "bold" nn-group)
-                            (text-field :light-primary "normal" nn-group-to-anyway)
-                            (text-field :accent "bold" nn-anyway)
-                            (text-field :light-primary "normal" nn-tail)
-                            )))
-          (scroll-view {:style {:flex 0.7}}
-                       (view {:style {:flexDirection "col"
+                (scroll-view {:style {:flex 1}
+                              :key   1}
+                             (text {:style {:padding  20
+                                            :fontSize (text-field-font-size)}}
+                                   (text-field :light-primary "normal" nn-head)
+                                   (text-field (if (> rr 1) :accent :text-icons) "bold" nn-one)
+                                   (text-field :light-primary "normal" nn-one-to-group)
+                                   (text-field :light-primary "bold" nn-group)
+                                   (text-field :light-primary "normal" nn-group-to-anyway)
+                                   (text-field :accent "bold" nn-anyway)
+                                   (text-field :light-primary "normal" nn-tail)
+                                   )))
+          (scroll-view {:style {:flex 1}}
+                       (view {:style {:flexDirection  "col"
                                       :justifyContent "flex-start"}}
-                             (draw-square)
-                             (draw-square))
+                             ;(nested-n-square [1])
+                             (draw-square 100)
+                             ;(draw-4-square)
+                             )
                        #_(view {:style {:flexDirection "row"}}
                                (draw-square)
                                (draw-square)))


compile log prefix

compile log prefix

--- src/clj/algorithms_clj/macro_initiation.clj
+++ src/clj/algorithms_clj/macro_initiation.clj
@@ -394,10 +394,8 @@

 (defn log-enter-message
   "Returns the log message for the function and its arguments"
-  [fct-name arg-names arg-values]
-  (str
-    "Entering the function " fct-name " with args "
-    (zipmap arg-names arg-values)))
+  [log-prefix arg-names arg-values]
+  (str log-prefix (zipmap arg-names arg-values)))

 (defn bindings->bound-vars
   "Clean the bindings to remove the restructuring artifacts"
@@ -408,12 +406,16 @@
     (remove keyword?)
     (vec)))

+(defn compile-log-prefix
+  [fct-name]
+  (str "Entering the function " fct-name " with arguents: "))
+
 (defn compile-log-message
   [form binding-vec]
   (let [fct-name (-> form second str)
         bindings (bindings->bound-vars binding-vec)]
     `(log-enter-message
-       ~fct-name
+       ~(compile-log-prefix fct-name)
        (quote ~bindings)
        ~bindings)))


Ensure only valid values after requesting parser indexes

--- src/com/wsscode/pathom/connect/foreign.cljc
+++ src/com/wsscode/pathom/connect/foreign.cljc
@@ -15,7 +15,9 @@
      :com.wsscode.pathom.connect/index-mutations]}])

 (defn parser-indexes [parser]
-  (-> (parser {} index-query) ::pc/indexes))
+  (->> (parser {} index-query)
+       ::pc/indexes
+       (p/elide-items p/special-outputs)))

 (defn compute-foreign-input [{::pcp/keys [node] :as env}]
   (let [input  (::pcp/input node)


Fix imports.

Fix imports.

--- src/oc/storage/api/digest.clj
+++ src/oc/storage/api/digest.clj
@@ -7,9 +7,9 @@
             [oc.lib.db.pool :as pool]
             [oc.lib.api.common :as api-common]
             [oc.storage.config :as config]
+            [oc.storage.api.activity :as activity-api]
+            [oc.storage.api.access :as access]
             [oc.storage.resources.activity :as activity-res]
-            [oc.storage.api.access :as access]
-            [oc.storage.api.activity :as activity-api]
             [oc.storage.resources.common :as common]
             [oc.storage.representations.media-types :as mt]
             [oc.storage.representations.digest :as digest-rep]


fix for 404

fix for 404

--- src/picturefillproxy/core.clj
+++ src/picturefillproxy/core.clj
@@ -5,17 +5,27 @@
         [ring.middleware.file :only [wrap-file]]
         [clojure.tools.cli :refer [parse-opts]]))

+(defn send404
+  [channel]
+  (send! channel {:status 404
+                  :body "not found"}))
+
+
 (defn async-handler [path ring-request]
   (with-channel ring-request channel
     (if (.endsWith (:uri ring-request) ".jpg")
-      (send! channel {:status 200
-                      :headers {"Content-Type" "image/jpg"}
-                      :body (resize/get-stream path (:uri ring-request))}))))
-
+      (let [result (resize/get-stream path (:uri ring-request))]
+        (if (nil? result)
+          (send404 channel)
+          (send! channel {:status 200
+                          :headers {"Content-Type" "image/jpg"}
+                          :body result})))
+      (send404 channel))))
+
 (defn start-server
   [port path]
   (let [handler (partial async-handler path)]
-    (prn "web server running")
+    (println "server started")
     (run-server (wrap-file handler path)
                 {:port port})))

@@ -36,7 +46,6 @@
   [& args]
   (let [parse-result (parse-opts args cli-options)
         options (:options parse-result)]
-    (prn options)
     (start-server (:port options)  (:path options))))


Name some tests now that test-is requires it.

--- clj_record/test/util-test.clj
+++ clj_record/test/util-test.clj
@@ -4,10 +4,10 @@
   (:use clojure.contrib.test-is))

-(deftest nil (are (= _1 (util/singularize _2))
+(deftest singularize (are (= _1 (util/singularize _2))
     "foo" "foos"
     "baby" "babies"))

-(deftest nil (are (= _1 (util/pluralize _2))
+(deftest pluralize (are (= _1 (util/pluralize _2))
     "foos" "foo"
     "babies" "baby"))


[PDOK-2045] add control-channel

[PDOK-2045] add control-channel

--- src/main/clojure/pdok/featured/extracts.clj
+++ src/main/clojure/pdok/featured/extracts.clj
@@ -103,10 +103,9 @@
               (recur (<! rc)))
             (do
               (cache/flush-batch chunk batched-fn)
-              (Thread/sleep 5000)
               (>! cc :done)))))
     (timeline/all (config/timeline) dataset collection rc)
-    (<!! cc)
+    (<!! cc) ; block until consumer ends
     {:status "ok" :count 777}))

 (defn file-to-features [path dataset]


Fixed validation example

Fixed validation example

The input validation example on the website was broken since the `i/input` field was not actually updating it's contents based on a user's input.

This was due to a missing `:value` key.

--- dev/snippets/input/validation.cljs
+++ dev/snippets/input/validation.cljs
@@ -24,6 +24,7 @@
           (i/input
            {:feedback? true
             :type "text"
+            :value (:text @state)
             :label "Working example with validation"
             :placeholder "Enter text"
             :help "Validates based on string length."


Switch to api-defaults

Switch to api-defaults


Dont try to use nil as a function

Dont try to use nil as a function

Signed-off-by: Andrea Maria Piana <39e16ece3c2d27e1889178b15ddb376e524032f8@gmail.com>

--- src/status_im/contact/db.cljs
+++ src/status_im/contact/db.cljs
@@ -114,7 +114,7 @@
          (map #(or (get all-contacts %)
                    (public-key->new-contact %)))
          (sort-by (comp clojure.string/lower-case :name))
-         (map #(if (admins (:public-key %))
+         (map #(if (get admins (:public-key %))
                  (assoc % :admin? true)
                  %)))))


Some lines of code are refactored.

Some lines of code are refactored.

--- src/sweet_crossplane/core.clj
+++ src/sweet_crossplane/core.clj
@@ -16,6 +16,8 @@

 (dog-mission/conj-resource-bundle-namespace "sweet-crossplane.message")

+;; Utilities.
+
 ;; Ring Middlewares. You should add below middlewares in your application.

 (defn wrap-locale
@@ -90,8 +92,8 @@
     (include-css "/lib/bootstrap/css/bootstrap.min.css")
     (include-css (format "/sweet-crossplane-%s.css" (.getLanguage dog-mission/*locale*)))]
    [:body
-    [:nav.navbar.navbar-default
-     [:div.container-fluid
+    [:header.navbar.navbar-default
+     [:nav.container-fluid
       [:div.navbar-header
        (link-to {:class "navbar-brand"} "/" @brand-name)]
       [:div.collapse.navbar-collapse
@@ -111,7 +113,6 @@
      [:div.container-fluid
       contents]]
     [:footer
-     [:hr]
      [:div.container-fluid
       [:p "Powered by Clojure, core.incubator, Logging, clojure.java.jdbc, clj-time, Compojure, Hiccup, PostgreSQL, jQuery, Bootstrap and sweet-crossplane."]]]
     (include-js "/lib/jquery/jquery.min.js")
@@ -136,7 +137,7 @@

 (defmethod search-condition-control :decimal
   [entity-key entity-schema property-key]
-  (let [[property-key-1 property-key-2] (map #(keyword (str (name %1) "-" %2)) (repeat property-key) (iterate inc 1))]
+  (let [[property-key-1 property-key-2] (map #(keyword (format "%s-%d--" (name %1) %2)) (repeat property-key) (iterate inc 1))]
     [:div.form-group
      (label property-key (string/capitalize (dog-mission/translate (radial-mount/property-message-key entity-key property-key))))
      (text-field {:class "form-control"}


skip bootstrap load when analyzer data for ns exists

--- src/main/shadow/cljs/bootstrap/browser.cljs
+++ src/main/shadow/cljs/bootstrap/browser.cljs
@@ -159,8 +159,10 @@
   (let [ns (if macros
              (symbol (str name "$macros"))
              name)]
-    (env/get-ns-info ns)
-    (load-namespaces compile-state-ref #{ns} cb)))
+    (if (get-in @compile-state-ref [:cljs.analyzer/namespaces ns])
+      (cb {:lang :js :source ""})
+      (do (env/get-ns-info ns)
+          (load-namespaces compile-state-ref #{ns} cb)))))

 (defn fix-provide-conflict! []
   ;; since cljs.js unconditionally does a goog.require("cljs.core$macros")


Not use `#active-image` in the querySelector but rather `*--placeholder`

Signed-off-by: Njagi Mwaniki <b6a4ba60ad861b9c9afb6daea7294be4be68f44c@urbanslug.com>


Change rel from `prior` to `previous`.

Change rel from `prior` to `previous`.

--- src/oc/storage/representations/activity.clj
+++ src/oc/storage/representations/activity.clj
@@ -29,7 +29,7 @@
         next-url (when activity? (url org {:start last-activity :direction :before}))
         next-link (when next-url (hateoas/link-map "next" hateoas/GET next-url {:accept mt/activity-collection-media-type}))
         prior-url (when (and start? activity?) (url org {:start first-activity :direction :after}))
-        prior-link (when prior-url (hateoas/link-map "prior" hateoas/GET prior-url {:accept mt/activity-collection-media-type}))]
+        prior-link (when prior-url (hateoas/link-map "previous" hateoas/GET prior-url {:accept mt/activity-collection-media-type}))]
     (remove nil? [next-link prior-link])))

 (defn render-activity-list


Reimplement deselect-all event.

Reimplement deselect-all event.

--- src/uxbox/data/workspace.cljs
+++ src/uxbox/data/workspace.cljs
@@ -301,9 +301,16 @@
   "Mark a shape selected for drawing in the canvas."
   []
   (reify
-    rs/UpdateEvent
-    (-apply-update [_ state]
-      (assoc-in state [:workspace :selected] #{}))))
+    rs/WatchEvent
+    (-apply-watch [_ state]
+      (let [selected (get-in state [:workspace :selected])
+            mevent (rs/swap-state #(assoc-in state [:workspace :selected] #{}))]
+        (->> (map #(get-in state [:shapes-by-id %]) selected)
+             (rx/from-coll)
+             (rx/filter :group)
+             (rx/map :group)
+             (rx/map rebuild-group-size)
+             (rx/merge (rx/just mevent)))))))

 (defn copy-selected
   "Copy the selected shapes."


Delete resource query tests asserting SQL output

These have become laborious to maintain, as any changes to query
generation cause basically all of them to need to be changed. Given that
they will start failing on effectively *any* change to the code (correct
or not), they aren't providing any value in identifying regressions.
The end-to-end tests against a database which assert results are much
more useful.

--- test/com/puppetlabs/puppetdb/test/query/resource.clj
+++ test/com/puppetlabs/puppetdb/test/query/resource.clj
@@ -9,109 +9,6 @@

 (use-fixtures :each with-test-db)

-(deftest query->sql
-  (testing "comparisons"
-    ;; simple, local attributes
-    (let [query ["=" "title" "whatever"]
-          result [(str "(SELECT DISTINCT catalog_resources.catalog,catalog_resources.resource FROM catalog_resources "
-                       "WHERE (catalog_resources.title = ?))")
-                  "whatever"]]
-      (is (= (s/query->sql query) result)
-          (str query "=>" result)))
-    ;; with a path to the field
-    (let [[sql & params] (s/query->sql ["=" ["node" "name"] "example"])]
-      (is (= params ["example"]))
-      (is (re-find #"SELECT DISTINCT catalog_resources.catalog,catalog_resources.resource FROM certname_catalogs JOIN catalog_resources" sql))
-      (is (re-find #"\(certname_catalogs.certname = \?\)" sql)))
-    (let [[sql & params] (s/query->sql ["=" "tag" "foo"])]
-      (is (re-find #"SELECT DISTINCT catalog,resource FROM catalog_resources" sql))
-      (is (= params ["foo"]))))
-  (testing "order of params in grouping"
-    (let [[sql & params] (s/query->sql ["and"
-                                        ["=" "type" "foo"]
-                                        ["=" "type" "bar"]
-                                        ["=" "type" "baz"]])]
-      (is (= params ["foo" "bar" "baz"]))))
-  (let [terms [["=" "title" "one"]
-               ["=" "type" "two"]
-               ["=" "tag" "three"]
-               ["=" ["node" "name"] "four"]
-               ["=" ["parameter" "ensure"] "five"]
-               ["=" ["parameter" "banana"] "yumm"]]]
-    (testing "simple {and, or} grouping"
-      (doall
-       (for [one terms
-             two terms]
-         (let [[sql1 & param1] (s/query->sql one)
-               [sql2 & param2] (s/query->sql two)
-               [and-sql & and-params] (s/query->sql ["and" one two])
-               [or-sql & or-params] (s/query->sql ["or" one two])]
-           (is (= and-sql (format "(SELECT DISTINCT catalog,resource FROM %s resources_0 NATURAL JOIN %s resources_1)"
-                                  sql1 sql2)))
-           (is (= or-sql (format "(%s UNION %s)" sql1 sql2)))
-           (is (= and-params (concat param1 param2)))
-           (is (= or-params (concat param1 param2)))))))
-    (testing "simple {and, or} grouping with many terms"
-      (let [terms-  (map s/query->sql terms)
-               queries (map first terms-)
-               joins (->> (map #(format "%s resources_%d" %1 %2) queries (range (count queries)))
-                          (string/join " NATURAL JOIN "))
-               and- (format "(SELECT DISTINCT catalog,resource FROM %s)" joins)
-               or- (format "(%s)" (string/join " UNION " queries))
-               params- (mapcat rest terms-)
-               [and-sql & and-params] (s/query->sql (apply vector "and" terms))
-               [or-sql & or-params] (s/query->sql (apply vector "or" terms))]
-           (is (= and-sql and-))
-           (is (= or-sql or-))
-           (is (= and-params params-))
-           (is (= or-params params-)))))
-
-  (testing "negation"
-    (let [[sql & params] (s/query->sql ["not" ["=" "type" "foo"]])]
-      (is (= sql (str "(SELECT DISTINCT lhs.catalog,lhs.resource FROM catalog_resources lhs LEFT OUTER JOIN "
-                      "((SELECT DISTINCT catalog_resources.catalog,catalog_resources.resource FROM catalog_resources "
-                      "WHERE (catalog_resources.type = ?))) rhs "
-                      "ON lhs.catalog = rhs.catalog AND lhs.resource = rhs.resource WHERE (rhs.resource IS NULL))")))
-      (is (= params ["foo"])))
-    (let [[sql & params] (s/query->sql ["not" ["=" "type" "foo"]
-                                        ["=" "title" "bar"]])]
-      (is (= sql (str "(SELECT DISTINCT lhs.catalog,lhs.resource FROM catalog_resources lhs LEFT OUTER JOIN "
-                      "("
-                      "(SELECT DISTINCT catalog_resources.catalog,catalog_resources.resource FROM catalog_resources WHERE (catalog_resources.type = ?))"
-                      " UNION "
-                      "(SELECT DISTINCT catalog_resources.catalog,catalog_resources.resource FROM catalog_resources WHERE (catalog_resources.title = ?))"
-                      ") rhs ON lhs.catalog = rhs.catalog AND lhs.resource = rhs.resource WHERE (rhs.resource IS NULL)"
-                      ")")))
-      (is (= params ["foo" "bar"]))))
-
-  (testing "real world query"
-    (let [[sql & params]
-          (s/query->sql ["and"
-                         ["not" ["=" ["node" "name"] "example.local"]]
-                         ["=" "exported" true]
-                         ["=" ["parameter" "ensure"] "yellow"]])]
-      (is (= sql (str "("
-                      ;; top level and not certname
-                      "SELECT DISTINCT catalog,resource FROM "
-                      "(SELECT DISTINCT lhs.catalog,lhs.resource FROM catalog_resources lhs LEFT OUTER JOIN ("
-                      "(SELECT DISTINCT catalog_resources.catalog,catalog_resources.resource FROM certname_catalogs "
-                      "JOIN catalog_resources USING(catalog) "
-                      "WHERE (certname_catalogs.certname = ?))) "
-                      "rhs ON lhs.catalog = rhs.catalog AND lhs.resource = rhs.resource WHERE (rhs.resource IS NULL)) resources_0"
-                      ;; exported
-                      " NATURAL JOIN "
-                      "(SELECT DISTINCT catalog_resources.catalog,catalog_resources.resource FROM catalog_resources "
-                      "WHERE (catalog_resources.exported = ?)) resources_1"
-                      ;; parameter match
-                      " NATURAL JOIN "
-                      "(SELECT DISTINCT catalog_resources.catalog,catalog_resources.resource FROM resource_params "
-                      "JOIN catalog_resources USING(resource) "
-                      "WHERE ((resource_params.name = ?) AND (resource_params.value = ?))) resources_2"
-                      ")")))
-      (is (= params ["example.local" true "ensure" (db-serialize "yellow")])))))
-
-
-;; now, for some end-to-end testing with a database...
 (deftest query-resources
   (sql/insert-records
    :resource_params


Add larger grid of coral.

Add larger grid of coral.

--- src/videotest/coral/coral.clj
+++ src/videotest/coral/coral.clj
@@ -9,8 +9,10 @@
 ;; - run into existing coral,
 ;; -

-(def NUM-CORAL-COL-BINS 64.0)
-(def HEX-W 10.0)
+;; (def NUM-CORAL-COL-BINS 64.0)
+;; (def HEX-W 10.0)
+(def NUM-CORAL-COL-BINS 110.0)
+(def HEX-W 7.6)

 (defn coral-size [display-w display-h]
   (let [col-bins NUM-CORAL-COL-BINS


Fix warning.

Fix warning.


Add a disabled pulse channel to test 'enabled' functionality

--- test/metabase/models/pulse_channel_test.clj
+++ test/metabase/models/pulse_channel_test.clj
@@ -284,7 +284,8 @@
     {:schedule_type "hourly", :channel_type "slack"}]]
   (tu/with-temp* [Pulse        [{pulse-id :id}]
                   PulseChannel [_ {:pulse_id pulse-id}]
-                  PulseChannel [_ {:pulse_id pulse-id, :channel_type :slack, :schedule_type :hourly}]]
+                  PulseChannel [_ {:pulse_id pulse-id, :channel_type :slack, :schedule_type :hourly}]
+                  PulseChannel [_ {:pulse_id pulse-id, :channel_type :email, :schedule_type :hourly, :enabled false}]]
     (let [retrieve-channels (fn [hour day]
                               (for [channel (retrieve-scheduled-channels hour day :other :other)]
                                 (dissoc channel :id :pulse_id)))]


Reformatted Indicator for readability

Reformatted Indicator for readability

--- src/cia/schemas/indicator.clj
+++ src/cia/schemas/indicator.clj
@@ -56,23 +56,72 @@
   (merge
    c/GenericStixIdentifiers
    {:valid_time c/ValidTime
-    (s/optional-key :alternate_ids) (describe [s/Str] "alternative identifier (or alias)")
-    (s/optional-key :version) (describe s/Num "schema version for this content")
-    (s/optional-key :negate) (describe s/Bool "specifies the absence of the pattern")
-    (s/optional-key :type) (describe [v/IndicatorType] "Specifies the type or types for this Indicator")
-    (s/optional-key :observable) (describe c/Observable "a relevant cyber observable for this Indicator")
-    (s/optional-key :judgements) (describe rel/RelatedJudgements "related Judgements for this Indicator")
-    (s/optional-key :composite_indicator_expression) CompositeIndicatorExpression
-    (s/optional-key :indicated_TTP) (describe rel/RelatedTTPs "the relevant TTP indicated by this Indicator")
-    (s/optional-key :likely_impact) (describe s/Str "likely potential impact within the relevant context if this Indicator were to occur")
-    (s/optional-key :suggested_COAs) (describe rel/RelatedCOAs "suggested Courses of Action")
-    (s/optional-key :confidence) (describe v/HighMedLow "level of confidence held in the accuracy of this Indicator")
-    (s/optional-key :sightings) (describe [Sighting] "a set of sighting reports")
-    (s/optional-key :related_indicators) (describe rel/RelatedIndicators "relationship between the enclosing indicator and a disparate indicator")
-    (s/optional-key :related_campaigns) (describe rel/RelatedCampaigns "references to related campaigns")
-    (s/optional-key :related_COAs) (describe rel/RelatedCOAs "related Courses of Actions for this cyber threat Indicator")
-    (s/optional-key :kill_chain_phases) (describe [s/Str] "relevant kill chain phases indicated by this Indicator") ;; simplified
-    (s/optional-key :test_mechanisms) (describe [s/Str] "Test Mechanisms effective at identifying the cyber Observables specified in this cyber threat Indicator") ;; simplified
+    (s/optional-key :alternate_ids)
+    (describe [s/Str]
+              "alternative identifier (or alias)")
+
+    (s/optional-key :version)
+    (describe s/Num
+              "schema version for this content")
+
+    (s/optional-key :negate)
+    (describe s/Bool
+              "specifies the absence of the pattern")
+
+    (s/optional-key :type)
+    (describe [v/IndicatorType]
+              "Specifies the type or types for this Indicator")
+
+    (s/optional-key :observable)
+    (describe c/Observable
+              "a relevant cyber observable for this Indicator")
+
+    (s/optional-key :judgements)
+    (describe rel/RelatedJudgements
+              "related Judgements for this Indicator")
+
+    (s/optional-key :composite_indicator_expression)
+    CompositeIndicatorExpression
+
+    (s/optional-key :indicated_TTP)
+    (describe rel/RelatedTTPs
+              "the relevant TTP indicated by this Indicator")
+
+    (s/optional-key :likely_impact)
+    (describe s/Str
+              "likely potential impact within the relevant context if this Indicator were to occur")
+
+    (s/optional-key :suggested_COAs)
+    (describe rel/RelatedCOAs
+              "suggested Courses of Action")
+
+    (s/optional-key :confidence)
+    (describe v/HighMedLow
+              "level of confidence held in the accuracy of this Indicator")
+
+    (s/optional-key :sightings)
+    (describe [Sighting]
+              "a set of sighting reports")
+
+    (s/optional-key :related_indicators)
+    (describe rel/RelatedIndicators
+              "relationship between the enclosing indicator and a disparate indicator")
+
+    (s/optional-key :related_campaigns)
+    (describe rel/RelatedCampaigns
+              "references to related campaigns")
+
+    (s/optional-key :related_COAs)
+    (describe rel/RelatedCOAs
+              "related Courses of Actions for this cyber threat Indicator")
+
+    (s/optional-key :kill_chain_phases) ;; simplified
+    (describe [s/Str]
+              "relevant kill chain phases indicated by this Indicator")
+
+    (s/optional-key :test_mechanisms) ;; simplified
+    (describe [s/Str]
+              "Test Mechanisms effective at identifying the cyber Observables specified in this cyber threat Indicator")

     ;; Extension fields:
     :producer s/Str


(feat) adds integers-cache

(feat) adds integers-cache

--- src/clj/clojure/data/json.clj
+++ src/clj/clojure/data/json.clj
@@ -149,9 +149,18 @@
           (do (.append buffer (char c))
               (recur)))))))

+(defonce ^:private integers-cache
+  (->> 1000
+       (range -1000)
+       (map (fn [n]
+              [(str n) n]))
+       (into {})))
+
 (defn- read-integer [^String string]
-  (if (< (.length string) 18)  ; definitely fits in a Long
-    (Long/valueOf string)
+  (if (< (.length string) 18)          ; definitely fits in a Long
+    (or
+     (get integers-cache string)
+     (Long/valueOf string))
     (or (try (Long/valueOf string)
              (catch NumberFormatException e nil))
         (bigint string))))


implement Cyber Threat

implement Cyber Threat

--- src/clj/game/cards-events.clj
+++ src/clj/game/cards-events.clj
@@ -57,6 +57,28 @@
                            :choices (req (filter #(has? % :type "Program") (:deck runner)))
                            :effect (effect (install-cost-bonus [:credit (* -3 (count (get-in corp [:servers :rd :ices])))])
                                            (runner-install target) (tag-runner 1) (shuffle! :deck))}} card))}
+
+   "Cyber Threat"
+   {:prompt "Choose a server" :choices (req servers)
+    :effect (req (let [serv target
+                       runtgt [(last (server->zone state serv))]
+                       ices (get-in @state (concat [:corp :servers] runtgt [:ices]))]
+                   (resolve-ability
+                     state :corp
+                     {:optional
+                      {:prompt (msg "Rez a piece of ICE protecting " serv "?")
+                       :yes-ability {:prompt (msg "Choose a piece of " serv " ICE to rez") :player :corp
+                                     :choices {:req #(and (not (:rezzed %))
+                                                          (= (last (:zone %)) :ices))}
+                                     :effect (req (rez state :corp target nil))}
+                       :no-ability {:effect (req (swap! state assoc :per-run nil
+                                                        :run {:server runtgt :position (count ices) :ices ices
+                                                              :access-bonus 0 :run-effect nil})
+                                                 (gain-run-credits state :runner (:bad-publicity corp))
+                                                 (swap! state update-in [:runner :register :made-run] #(conj % (first runtgt)))
+                                                 (trigger-event state :runner :run runtgt))
+                                    :msg (msg "make a run on " serv " during which no ICE can be rezzed")}}}
+                    card nil)))}

    "Day Job"
    {:additional-cost [:click 3] :effect (effect (gain :credit 10))}


Add modest cp437 to unicode conversion

Add modest cp437 to unicode conversion

--- src/cljc/robinson/render.cljc
+++ src/cljc/robinson/render.cljc
@@ -1144,6 +1144,14 @@
           (put-string (state :screen) 10 22 "Play again? [yn]")))
     (refresh (state :screen))))

+(defn cp437->unicode
+  [c]
+  (case (int c)
+      3 \u2665
+    219 \u2588
+    220 \u2584
+    c))
+
 (defn rockpick->render-map
   [layers]
   (let [layer (first layers)]
@@ -1154,7 +1162,7 @@
                            (log/info "line" (vec line))
                            (map-indexed (fn [x tile]
                                           ;(log/info "tile" tile x y)
-                                          {:c (str (get tile :ch))
+                                          {:c (str (cp437->unicode (get tile :ch)))
                                            :fg [(get-in tile [:fg :r])
                                                 (get-in tile [:fg :g])
                                                 (get-in tile [:fg :b])]


Create a recurring expense component that is expandable for further information

--- src/cljs/my_money/events.cljs
+++ src/cljs/my_money/events.cljs
@@ -97,13 +97,23 @@
   (let [month-filter (filters/month-filter month)]
     (filter month-filter events)))

+(defn recurring-expense-item [expense]
+  (let [expense-state (r/atom {:data expense
+                               :expanded false})]
+    (fn [expense]
+      [:button {:class "list-group-item list-group-item-action"
+                :on-click #(swap! expense-state update :expanded not)}
+       (str (get-in @expense-state [:data :recipient])
+            " "
+            (amount->pretty-string (get-in @expense-state [:data :amount])))
+       (when (:expanded @expense-state)
+         [:div "Last occurrence " (get-in @expense-state [:data :transaction_date])])])))
+
 (defn recurring-expense-info [recurring-expenses]
   [:div.list-group
-   (for [event recurring-expenses]
-     ^{:key (:id event)}
-     [:p.list-group-item (str (:recipient event)
-                              " "
-                              (amount->pretty-string(:amount event)))])])
+   (for [expense recurring-expenses]
+     ^{:key (:id expense)}
+     [recurring-expense-item expense])])

 (defn events-page []
   (fn []


CMR-680: Refactored to make method available across projects

--- src/cmr/common/mime_types.clj
+++ src/cmr/common/mime_types.clj
@@ -1,6 +1,7 @@
 (ns cmr.common.mime-types
   "Provides functions for handling mime types."
   (:require [pantomime.media :as mt]
+            [clojure.string :as str]
             [cmr.common.services.errors :as errors]))

 (def base-mime-type-to-format
@@ -42,6 +43,17 @@
          (get base-mime-type-to-format (base-mime-type default-mime-type)))
      (get base-mime-type-to-format (base-mime-type default-mime-type)))))

+(defn mime-type-from-headers
+  "Try to get a supported mime-type from the 'accept' header."
+  [headers supported-mime-types]
+  (let [mime-type-str (when-let [mstr (get headers "accept")]
+                        ;; Strip out any semicolon clauses
+                        (str/replace mstr #";.*?(,|$)" "$1"))
+        ;; Split mime-type string on commas
+        mime-types (when mime-type-str (str/split (str/lower-case mime-type-str), #"[,]"))
+        first-supported-mime-type (some (set mime-types) supported-mime-types)]
+    (or first-supported-mime-type mime-type-str)))
+
 (defn validate-request-mime-type
   "Validates the requested mime type is supported."
   [mime-type supported-types]
@@ -52,6 +64,6 @@
 (defn get-request-format
   "Returns the requested format parsed from headers"
   [headers supported-types]
-  (let [mime-type (get headers "accept")]
+  (let [mime-type (mime-type-from-headers headers supported-types)]
     (validate-request-mime-type mime-type supported-types)
     (mime-type->format mime-type)))


refactor to shorten code

refactor to shorten code

--- src/cortex/impl/functions.clj
+++ src/cortex/impl/functions.clj
@@ -34,8 +34,7 @@
         ;; input gradient = output * (1 - output) * output-gradient
         (m/assign! ig 1.0)
         (m/sub! ig output)
-        (m/mul! ig output)
-        (m/mul! ig output-gradient)
+        (m/mul! ig output output-gradient)

         ;; finally return this, input-gradient has been updated in-place
         this))


Change indentation in interactive tests to make cljfmt happy

--- test/app/test/interactive.clj
+++ test/app/test/interactive.clj
@@ -53,7 +53,7 @@
                (interactive javaparser-cus)
                (verify-call-times-for printOperation 1)
                (verify-first-call-args-for
-                 printOperation
-                 classesWithManyConstructorsOp
-                 (:cus javaparser-cus)
-                 mc-op-threshold)))))
+                printOperation
+                classesWithManyConstructorsOp
+                (:cus javaparser-cus)
+                mc-op-threshold)))))


Function callable? added into core_test.clj

--- test/clj_mrazik/core_test.clj
+++ test/clj_mrazik/core_test.clj
@@ -14,3 +14,12 @@
   (:require [clojure.test :refer :all]
             [clj-mrazik.core :refer :all]))

+;
+; Common functions used by tests.
+;
+
+(defn callable?
+    "Test if given function-name is bound to the real function."
+    [function-name]
+    (clojure.test/function? function-name))
+


Added test for map-n function.

Added test for map-n function.

--- test/cmr/common/test/util.clj
+++ test/cmr/common/test/util.clj
@@ -1,5 +1,11 @@
 (ns cmr.common.test.util
   (:require [clojure.test :refer :all]
+            ; [clojure.test.check.clojure-test :refer [defspec]]
+            ;; Temporarily included to use the fixed defspec. Remove once issue is fixed.
+            [cmr.common.test.test-check-ext :as gen-ext :refer [defspec]]
+
+            [clojure.test.check.properties :refer [for-all]]
+            [clojure.test.check.generators :as gen]
             [cmr.common.util :as util]))

 (deftest test-sequence->fn
@@ -56,4 +62,12 @@
 (deftest remove-nil-keys-test
   (is (= {:a true :c "value" :d false}
          (util/remove-nil-keys
-           {:a true :b nil :c "value" :d false}))))+           {:a true :b nil :c "value" :d false}))))
+
+(defspec map-n-spec 100
+  (for-all [n gen/s-pos-int
+            step gen/s-pos-int
+            items (gen/vector gen/int)]
+    ;; Verifies map-n is equivalent to partition
+    (= (util/map-n vector n step items)
+       (partition n step items))))


Add some tests for marking symbols free

Add some tests for marking symbols free

--- test/desdemona/query_test.clj
+++ test/desdemona/query_test.clj
@@ -28,6 +28,14 @@
 (deftest infix->dsl-tests
   (is (= '(= (:ip x) "10.0.0.1")
          (q/infix->dsl "ip(x) = 10.0.0.1"))))
+
+(deftest free-sym-tests
+  (is (not (#'q/free-sym? 's))
+      "sym not marked as free")
+  (is (not (#'q/free-sym? 1))
+      "not a symbol")
+  (is (#'q/free-sym? (#'q/free-sym 's))
+      "sym explicitly marked as free"))

 (deftest find-free-vars-tests
   (are [expected query] (= expected (#'q/find-free-vars query))


Marks unused matches variable with _.

Marks unused matches variable with _.

--- src/active/clojure/match.clj
+++ src/active/clojure/match.clj
@@ -776,8 +776,8 @@
                 (cons (deep-merge acc lhs-map) tail))

               (and (sequential? acc) (sequential? lhs))
-              (let [[acc-map guard-key acc-tail] acc
-                    [lhs-map guard-key lhs-tail] lhs]
+              (let [[acc-map _guard-key acc-tail] acc
+                    [lhs-map _guard-key lhs-tail] lhs]
                 (list (deep-merge acc-map lhs-map) :guard (concat acc-tail lhs-tail)))

               :else


don't re-chain the rules every time, a useless attempt at speeding things up

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/aurora/runtime/core.cljs
+++ src/aurora/runtime/core.cljs
@@ -19,10 +19,7 @@
                    (datalog/fixpoint (datalog/chain stratum)))))

 (defn tick [kn tick-rules rules watchers feeder-fn]
-  (let [chained-tick-rules (datalog/chain tick-rules)
-        kn (chained-tick-rules kn)
-        chained (chain-rules rules)
-        kn (chained kn)]
+  (let [kn (-> kn (tick-rules) (rules))]
     (doseq [watch watchers]
       (watch kn feeder-fn))
     (datalog/and-now kn)))
@@ -36,7 +33,7 @@
       (swap! env update-in [:kn]
              (fn [cur]
                (-> cur
-                   ((datalog/chain (:cleanup-rules @env)))
+                   ((:cleanup-rules @env))
                    (datalog/and-now)
                    (datalog/assert-many feed-set)
                    (datalog/and-now)
@@ -54,14 +51,19 @@
     env))

 (defn ->env [opts]
-  (atom (merge {:tick-rules []
-                :cleanup-rules []
-                :rules []
-                :watchers @watchers
-                :feed (array)
-                :queued? false}
-               opts
-               {:kn (datalog/Knowledge. (:kn opts #{}) #{} #{})})))
+  (let [env (merge {:tick-rules []
+                    :cleanup-rules []
+                    :rules []
+                    :watchers @watchers
+                    :feed (array)
+                    :queued? false}
+                   opts
+                   {:kn (datalog/Knowledge. (:kn opts #{}) #{} #{})})
+        env (-> env
+                (update-in [:cleanup-rules] datalog/chain)
+                (update-in [:rules] chain-rules)
+                (update-in [:tick-rules] datalog/chain))]
+    (atom env)))

 (defn run-env [opts]
   (-> opts


OO: Only render currently active tab

OO: Only render currently active tab

--- src/hatti/views/dataview.cljs
+++ src/hatti/views/dataview.cljs
@@ -140,5 +140,6 @@
           (for [{:keys [component view]} dataviews]
             [:div {:class (str "tab-page " (name view) "-page")
                    :style {:display (view->display view)}}
-             [:div.tab-content {:id (str "tab-content" (name view))}
-              (om/build component app-state {:opts opts})]])])))))
+             (when (= active-view view)
+               [:div.tab-content {:id (str "tab-content" (name view))}
+                (om/build component app-state {:opts opts})])])])))))


Fix paste expiry not expiring the correct entries.

--- src/clj_codetip/database.clj
+++ src/clj_codetip/database.clj
@@ -33,12 +33,12 @@

 (defn- -schedule-paste-expiry
   "Schedule the expired paste cleanup to run."
-  [db-spec expires now]
+  [db-spec expires]
   (chime-at [expires]
             (fn [_]
               ; Intentionally drop the `:connection` key to avoid stale
               ; connections later.
-              (delete-expired-pastes! (dissoc db-spec :connection) now))))
+              (delete-expired-pastes! (dissoc db-spec :connection) expires))))

 (defquery -unexpired-pastes "sql/unexpired_pastes.sql")
@@ -48,7 +48,7 @@
   [db-spec now]
   (j/with-db-transaction [tx db-spec]
     (doseq [p (-unexpired-pastes {:now (to-sql-time now)} {:connection tx})]
-      (-schedule-paste-expiry db-spec (-> :expires p from-long) now))))
+      (-schedule-paste-expiry db-spec (-> :expires p from-long)))))

 (defquery -create-paste! "sql/create_paste.sql")
@@ -67,7 +67,7 @@
                        :content      content
                        :content_type content-type}
                       {:connection tx}))
-    (-schedule-paste-expiry db-spec expires (t/now))
+    (-schedule-paste-expiry db-spec expires)
     id))


change in addressa

change in addressa

--- src/cljs/fractals/about.cljs
+++ src/cljs/fractals/about.cljs
@@ -354,7 +354,7 @@
                     :background-color "#4A3356"
                     :color "#D9C9BA"}}
       [:div "Shama Ar Rashid"]
-      [:div "Director Engineering"]
-      [:div "shama@gmail.com"]]]
+      [:div "Director Engineering, SGC Global"]
+      [:div "shama.rashid@gmail.com"]]]
     [:div {:style {:padding "10px"
                    :font-size ".86rem"}} "I was born in Dhaka in 20th July 1986. I spend my childhood in many corners of Bangladesh. My father MD Gulam Kibria and My mother is Asia Akter, we are from district Netrokuna. I am married to Rezwanna Sharmin. We have two daughters"]]])


avoid race-condition when adding the commmit watch to duragent

--- src/clojure/duratom/core.clj
+++ src/clojure/duratom/core.clj
@@ -379,7 +379,7 @@

 (defn- duragent*
   "Common constructor for duragents"
-  [init ehandler make-backend]
+  [init meta-map ehandler make-backend]
   (let [ag (agent nil :error-mode :continue)
         backend (with-meta (make-backend ag)
                            ;; force synchronous recommits
@@ -387,6 +387,7 @@
         storage-init (storage/snapshot backend)
         cleanup-lock (ReentrantLock.)
         release (ut/releaser)
+        safe-to-add-watch? (promise)
         final-agent (delay
                       (-> ag
                           (add-watch ::storage/commit
@@ -400,8 +401,11 @@
                                               {:type ::storage/commit-error}
                                               e))))))
                           (doto
-                            (reset-meta! {::storage/destroy  (partial storage/safe-cleanup! backend release cleanup-lock)
-                                          ::storage/snapshot #(storage/snapshot backend)})
+                            (reset-meta! (merge meta-map
+                                                {::storage/destroy
+                                                 (partial storage/safe-cleanup! backend release cleanup-lock)
+                                                 ::storage/snapshot
+                                                 #(storage/snapshot backend)}))
                             (set-error-handler!
                               (if (nil? ehandler)
                                 ut/noop
@@ -411,10 +415,14 @@
                                     (ehandler a e))))))))]
     (if (some? storage-init)
       ;; found stuff - sync it before adding the commit watch
-      (send-off ag (constantly storage-init))
+      (send-off ag (fn [& _]
+                     (deliver safe-to-add-watch? true)
+                     storage-init))
       ;; empty storage - trigger first commit
-      (send-off @final-agent (constantly (ut/->init init))))
-    @final-agent))
+      (do (deliver safe-to-add-watch? true)
+          (send-off @final-agent (constantly (ut/->init init)))))
+    (and @safe-to-add-watch?
+         @final-agent)))

 (defmulti duragent
           "duragent is to agent, what duratom is to atom"
@@ -422,17 +430,17 @@
             backed-by))

 (defmethod duragent :local-file
-  [_ & {:keys [file-path init rw]
+  [_ & {:keys [file-path init rw meta]
         :or {rw default-file-rw}}]
   (let [make-backend (partial storage/->FileBackend
                               (doto (jio/file file-path)
                                 (.createNewFile))
                               (:read rw)
                               (:write rw))]
-    (duragent* init (:error-handler rw) make-backend)))
+    (duragent* init meta (:error-handler rw) make-backend)))

 (defmethod duragent :postgres-db
-  [_ & {:keys [db-config table-name row-id init lock rw]
+  [_ & {:keys [db-config table-name row-id init lock rw meta]
         :or {lock (ReentrantLock.)
              rw default-postgres-rw}}]
   (let [make-backend (partial storage/->PGSQLBackend
@@ -444,10 +452,10 @@
                               row-id
                               (:read rw)
                               (:write rw))]
-    (duragent* init (:error-handler rw) make-backend)))
+    (duragent* init meta (:error-handler rw) make-backend)))

 (defmethod duragent :aws-s3
-  [_ & {:keys [credentials bucket key init lock rw]
+  [_ & {:keys [credentials bucket key init lock rw meta]
         :or {lock (ReentrantLock.)
              rw default-s3-rw}}]
   (let [make-backend (partial storage/->S3Backend
@@ -460,10 +468,10 @@
                               (:metadata rw)
                               (:read rw)
                               (:write rw))]
-    (duragent* init (:error-handler rw) make-backend)))
+    (duragent* init meta (:error-handler rw) make-backend)))

 (defmethod duragent :redis-db
-  [_ & {:keys [db-config key-name init lock rw]
+  [_ & {:keys [db-config key-name init lock rw meta]
         :or {lock (ReentrantLock.)
              rw default-redis-rw}}]
   (let [make-backend (partial storage/->RedisBackend
@@ -471,4 +479,4 @@
                               key-name
                               (:read rw)
                               (:write rw))]
-    (duragent* init (:error-handler rw) make-backend)))
+    (duragent* init meta (:error-handler rw) make-backend)))


Make create-or-update-channel work

Make create-or-update-channel work

--- src/clojure_fabric/proto.clj
+++ src/clojure_fabric/proto.clj
@@ -28,7 +28,7 @@
            [org.hyperledger.fabric.protos.common Common$Block Common$BlockData Common$BlockHeader Common$BlockMetadata Common$ChannelHeader Common$Envelope Common$Header Common$HeaderType Common$Payload Common$SignatureHeader Configtx$ConfigGroup Configtx$ConfigPolicy Configtx$ConfigSignature Configtx$ConfigUpdate Configtx$ConfigUpdateEnvelope Configtx$ConfigValue Ledger$BlockchainInfo Policies$Policy]
            org.hyperledger.fabric.protos.msp.Identities$SerializedIdentity
            [org.hyperledger.fabric.protos.peer Chaincode$ChaincodeDeploymentSpec Chaincode$ChaincodeDeploymentSpec$ExecutionEnvironment Chaincode$ChaincodeID Chaincode$ChaincodeInput Chaincode$ChaincodeInvocationSpec Chaincode$ChaincodeSpec Chaincode$ChaincodeSpec$Type EndorserGrpc ProposalPackage$ChaincodeHeaderExtension ProposalPackage$ChaincodeProposalPayload ProposalPackage$Proposal ProposalPackage$SignedProposal Query$ChaincodeInfo Query$ChaincodeQueryResponse Query$ChannelInfo Query$ChannelQueryResponse TransactionPackage$ProcessedTransaction]
-           [org.hyperledger.fabric.protos.orderer AtomicBroadcastGrpc Ab$DeliverResponse$TypeCase Ab$DeliverResponse]))
+           [org.hyperledger.fabric.protos.orderer AtomicBroadcastGrpc Ab$BroadcastResponse]))

 ;;;
 ;;;
@@ -310,7 +310,7 @@
   (clj->proto [this]
     (cond-> (Configtx$ConfigPolicy/newBuilder)
         version (.setVersion version)
-        policy (.setPolicy (clj->proto policy))
+        policy (.setPolicy ^Policies$Policy (clj->proto policy))
         mod-policy (.setModPolicy mod-policy)
         true (.build))))

@@ -658,14 +658,12 @@
 (defn envelope-broadcast-observer
   [ch]
   (reify StreamObserver
-    (onNext [this deliver-response]
-      (async/put! ch deliver-response)
-      (when (= (.getTypeCase ^Ab$DeliverResponse deliver-response)
-               Ab$DeliverResponse$TypeCase/STATUS)
-        (async/put! ch :done)))
+    (onNext [this boradcast-response]
+      (async/put! ch boradcast-response))
     (onError [this err]
       (async/put! ch err))
-    (onCompleted [this])))
+    (onCompleted [this]
+      (async/put! ch :done))))

 ;; typeout values (from Java SDK)
 ;; defaultProperty(PROPOSAL_WAIT_TIME, "20000");
@@ -679,18 +677,21 @@

 (defn broadcast-via-orderer
   [orderer envelope]
-  (let [ch (async/chan 32)
-        callback (envelope-broadcast-observer ch)
-        observer (.broadcast (AtomicBroadcastGrpc/newStub ^ManagedChannel (node->channel orderer))
-                              callback)]
-    (.onNext observer ^Common$Envelope (clj->proto envelope))
-    (async/go-loop [result []]
-      (let [[v ch] (async/alts! [ch (async/timeout (:orderer-wait-time timeouts))])]
-        (cond (= v :done) result
-              (nil? v) (throw (Exception. "Timeout to send Evelope using orderer"))
-              (instance? Exception v) (throw v)
-              :else (recur (conj result v)))))
-          (.onCompleted observer)))
+  (letfn [(broadcast-via-orderer-using-async []
+            (let [ch (async/chan 32)
+                  callback (envelope-broadcast-observer ch)
+                  observer (.broadcast (AtomicBroadcastGrpc/newStub ^ManagedChannel (node->channel orderer))
+                                       callback)]
+              (.onNext observer ^Common$Envelope (clj->proto envelope))
+              (try
+                (async/go-loop [result []]
+                  (let [[v ch] (async/alts! [ch (async/timeout (:orderer-wait-time timeouts))])]
+                    (cond (= v :done) result
+                          (nil? v) (throw (Exception. "Timeout to send Evelope using orderer"))
+                          (instance? Exception v) (throw v)
+                          :else (recur (conj result v)))))
+                (finally (.onCompleted observer)))))]
+    (async/<!! (broadcast-via-orderer-using-async))))

 ;;;;
 (comment


Renamed pipe-stream to copy-stream

Renamed pipe-stream to copy-stream

--- src/compojure/file_utils.clj
+++ src/compojure/file_utils.clj
@@ -25,16 +25,16 @@
   [dir]
   (seq (. (file dir) (list))))

-(defn pipe-stream
-  "Pipe the contents of an InputStream into an OutputStream."
+(defn copy-stream
+  "Copy the contents of an InputStream into an OutputStream."
   ([in out]
-    (pipe-stream in out 4096))
-  ([#^InputStream in #^OutputStream out bufsize]
-    (let [buffer (make-array (. Byte TYPE) bufsize)]
-      (loop [len (. in (read buffer))]
+    (copy-stream in out 4096))
+  ([#^InputStream in, #^OutputStream out, bufsize]
+    (let [buffer (make-array Byte/TYPE bufsize)]
+      (loop [len (.read in buffer)]
         (when (pos? len)
-          (. out (write buffer 0 len))
-          (recur (. in (read buffer))))))))
+          (.write out buffer 0 len)
+          (recur (.read in buffer)))))))

 (defn file-parents
   "Lazily iterate through all of the parents of a file."


acquisition engine now including summary-metadata for each image

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@8314 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -117,6 +117,7 @@
        "SliceIndex" (:slice-index event)
        "SlicePosition" (:slice event)
        "Source" (state :source)
+       "Summary" (state :summary-metadata)
        "Time" (get-current-time-str)
        "UUID" (UUID/randomUUID)
        "WaitInterval" (:wait-time-ms event)
@@ -166,7 +167,7 @@
     (try
       (core waitForDevice dev)
       (swap! pending-devices disj dev)
-      (catch Exception e (println "wait for device" dev "failed.")))))
+      (catch Exception e (log "wait for device" dev "failed.")))))

 (defn wait-for-pending-devices []
   (log "pending devices: " @pending-devices)
@@ -294,7 +295,6 @@
         camera-index (str (core getCameraDevice) "-CameraChannelIndex")]
     (doseq [event (:burst-data event)]
       (doseq [i (range (core getNumberOfCameraChannels))]
-        (println "i=" i)
         (when-not (@state :stop)
           (let [image (pop-burst-image)
                 image+ (if-not slices
@@ -304,7 +304,6 @@
               (swap! state assoc
                      :burst-time-offset (- (elapsed-time @state)
                                            (core-time-from-tags (image :tags)))))
-            (println (image+ :tags))
             (let [cam-chan (get-in image [:tags camera-index])
                   event+ (if cam-chan
                            (assoc event :channel-index
@@ -717,10 +716,12 @@
                      "Acquisition Engine Thread (Clojure)")
         processors (ProcessorStack. out-queue (.getTaggedImageProcessors acq-eng))
         out-queue-2 (.begin processors)
-        live-acq (LiveAcq. mmc out-queue-2 (make-summary-metadata settings)
+        summary-metadata (make-summary-metadata settings)
+        live-acq (LiveAcq. mmc out-queue-2 summary-metadata
                   (:save settings) acq-eng)]
     (swap! (.state this) assoc :image-cache (.getImageCache live-acq)
-                               :acq-thread acq-thread)
+                               :acq-thread acq-thread
+                               :summary-metadata summary-metadata)
     (def outq out-queue)
     (when-not (:stop @(.state this))
       (if (. gui getLiveMode)


fix bug with no xy stage and no z stage in acq engine

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@7555 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -88,9 +88,12 @@
   (merge
     (map-config (core getSystemStateCache))
     (:metadata event)
-    (let [[x y] (get-in state [:last-positions (state :default-xy-stage)])]
+    (let [[x y] (let [xy-stage (state :default-xy-stage)]
+                  (when-not (empty? xy-stage)
+                    (get-in state [:last-positions xy-stage])))]
       {
-       "AxisPositions" (when-let [axes (get-in event [:position :axes])] (JSONObject. axes))
+       "AxisPositions" (when-let [axes (get-in event [:position :axes])]
+                         (JSONObject. axes))
        "Binning" (state :binning)
        "BitDepth" (state :bit-depth)
        "Channel" (get-in event [:channel :name])
@@ -356,8 +359,8 @@
       :running true
       :finished false
       :last-wake-time (clock-ms)
-      :last-positions {default-z-drive z
-                       default-xy-stage xy}
+      :last-positions (merge {default-z-drive z}
+                             {default-xy-stage xy})
       :reference-z-position z
       :start-time (clock-ms)
       :init-auto-shutter (core getAutoShutter)


make sure shutter closes at end of MDA and don't send unnecessary messages

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@8678 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -193,6 +193,13 @@
     (let [xy (.getXYStagePosition gui)]
       [(.x xy) (.y xy)])))

+(defn set-shutter-open [open?]
+  (let [shutter (core getShutterDevice)]
+    (device-best-effort shutter
+      (when (not= open? (get-in @state [:shutter-states shutter]))
+        (core setShutterOpen open?)
+        (swap! state assoc-in [:shutter-states shutter] open?)))))
+
 (defn set-z-stage-position [stage pos]
   (when (and (@state :init-continuous-focus)
              (not (core isContinuousFocusDrive stage))
@@ -234,14 +241,12 @@
   (with-core-setting [getAutoShutter setAutoShutter false]
     (let [shutter (core getShutterDevice)]
       (when open-before
-        (device-best-effort shutter
-          (core setShutterOpen true)))
+        (set-shutter-open true))
       (wait-for-pending-devices)
       (device-best-effort (core getCameraDevice) (core snapImage))
       (swap! state assoc :last-image-time (elapsed-time @state))
       (when close-after
-        (device-best-effort shutter
-          (core setShutterOpen false))))))
+        (set-shutter-open false)))))

 (defn load-property-sequences [property-sequences]
   (let [new-seq (not= property-sequences @active-property-sequences)]
@@ -474,6 +479,7 @@
       :init-continuous-focus (core isContinuousFocusEnabled)
       :init-width (core getImageWidth)
       :init-height (core getImageHeight)
+      :init-shutter-state (when-not (empty? (core getShutterDevice)) (core getShutterOpen))
       :binning (core getProperty (core getCameraDevice) "Binning")
       :bit-depth (core getImageBitDepth)
       :pixel-size-um (core getPixelSizeUm)
@@ -492,6 +498,8 @@
     (core setAutoShutter (@state :init-auto-shutter))
     (set-exposure (core getCameraDevice) (@state :init-exposure))
     (set-stage-position (@state :default-z-drive) (@state :init-z-position))
+    (when-let [state (@state :init-shutter-state)]
+      (set-shutter-open state))
     (when (and (@state :init-continuous-focus)
                (not (core isContinuousFocusEnabled)))
       (core enableContinuousFocus true))


Component: removing tests for system-using, which we don't support

--- test/yadic/component_test.clj
+++ test/yadic/component_test.clj
@@ -260,18 +260,19 @@
                   :e (component/using {:n 50} [:b :c :d])}]
       (assert-increments (increment-all-components system)))))

-(deftest t-system-using
-  (let [dependency-map {:b [:a]
-                        :c [:a :b]
-                        :d {:a :a :b :b}
-                        :e [:b :c :d]}
-        system {:a {:n 10}
-                :b {:n 20}
-                :c {:n 30}
-                :d {:n 40}
-                :e {:n 50}}
-        system (component/system-using system dependency-map)]
-    (assert-increments (increment-all-components system))))
+(str "I don't propose to implement system-using")
+#_((deftest t-system-using
+   (let [dependency-map {:b [:a]
+                         :c [:a :b]
+                         :d {:a :a :b :b}
+                         :e [:b :c :d]}
+         system         {:a {:n 10}
+                         :b {:n 20}
+                         :c {:n 30}
+                         :d {:n 40}
+                         :e {:n 50}}
+         system         (component/system-using system dependency-map)]
+     (assert-increments (increment-all-components system)))))

 (defrecord ComponentWithoutLifecycle [state])


Add empty string :else clause to geo-to-svg, rename to more concise geo->svg.

--- src/clj/c2/geo/core.clj
+++ src/clj/c2/geo/core.clj
@@ -2,7 +2,7 @@
   (:use [clojure.core.match :only [match]]
         [clojure.string :only [join]]))

-(defn geo-to-svg
+(defn geo->svg
   "Convert geoJSON to svg path data. Takes optional projection, defaulting to identity"
   [geo & {:keys [projection]
           :or {projection identity}}]
@@ -28,4 +28,6 @@
          ;;It'd be nice to recurse to the actual branch that handles Polygon, instead of repeating...
          (join (map (fn [subpoly]
                       (join (map coords->path subpoly)))
-                    xs))))
+                    xs))
+
+         :else ""))


Default to CMD.EXE on Windows

Default to CMD.EXE on Windows

--- src/clj/runbld/opts.clj
+++ src/clj/runbld/opts.clj
@@ -14,6 +14,9 @@
             [runbld.io :as io]
             [runbld.version :as version]))

+(defn windows? []
+  (.startsWith (System/getProperty "os.name") "Windows"))
+
 (def config-file-defaults
   {:es
    {:url "http://localhost:9200"
@@ -89,7 +92,7 @@

 (defn system-config []
   (io/file
-   (if (.startsWith (System/getProperty "os.name") "Windows")
+   (if (windows?)
      "c:\\runbld\\runbld.conf"
      "/etc/runbld/runbld.conf")))

@@ -129,9 +132,9 @@
     :default (environ/env :job-name)]
    [nil "--java-home PATH" "If different from JAVA_HOME or need to override what will be discovered in PATH"]
    ["-p" "--program PROGRAM" "Program that will run the scriptfile"
-    :default "bash"]
+    :default (if (windows?) "CMD.EXE" "bash")]
    ["-a" "--args ARGS" "Args to pass PROGRAM"
-    :default ["-x"]
+    :default (if (windows?) ["/C"] ["-x"])
     :parse-fn #(str/split % #" ")]
    [nil "--system-info" "Just dump facts output"]
    ["-h" "--help" "Help me"]])


Remove unused function

Remove unused function

--- src/cljam/io/bigwig.clj
+++ src/cljam/io/bigwig.clj
@@ -275,35 +275,6 @@
       (CirTree.
        block-size item-count start-chrom-ix start-base end-chrom-ix
        end-base file-size items-per-slot root-offset))))
-
-(defn- find-bpt-file
-  "Returns an ID associated with chrom name."
-  [^RandomAccessFile r chrom {:keys [key-size root-offset]}]
-  (letfn [(r-find [block-start]
-            (.seek r block-start)
-            (let [leaf? (-> r lsb/read-ubyte zero? not)
-                  _reversed (lsb/read-ubyte r)
-                  child-count (lsb/read-ushort r)]
-              (if leaf?
-                (letfn [(read-leaves [n]
-                          (when-not (zero? n)
-                            (let [key (read-c-style-string r key-size)
-                                  id (lsb/read-uint r)
-                                  _size (lsb/read-uint r)]
-                              (if (zero? (compare chrom key))
-                                id
-                                (recur (dec n))))))]
-                  (read-leaves child-count))
-                (let [_key (lsb/read-bytes r key-size)]
-                  (letfn [(through-remainder [n offset]
-                            (if (or (zero? n)
-                                    (neg? (compare chrom
-                                                   (read-c-style-string r key-size))))
-                              offset
-                              (recur (dec n) (lsb/read-ushort r))))]
-                    (recur (through-remainder (dec child-count)
-                                              (lsb/read-ushort r))))))))]
-    (r-find root-offset)))

 (defn- cir-tree-overlaps?
   "Returns true if the given blocks are overlapped."
@@ -369,10 +340,8 @@

 (defn- fetch-overlapping-blocks-group
   "Returns a sequence of blocks that describe overlapping chrom range."
-  [^RandomAccessFile r ^BptHeader bpt-header ^BbiChromInfo chrom-info
-   ^CirTree cir-tree]
-  (when-let [id (find-bpt-file r (:name chrom-info) bpt-header)]
-    (fetch-overlapping-blocks r id 0 (:size chrom-info) cir-tree)))
+  [^RandomAccessFile r ^BbiChromInfo chrom-info ^CirTree cir-tree]
+  (fetch-overlapping-blocks r (:id chrom-info) 0 (:size chrom-info) cir-tree))

 (defn- find-gap
   "Returns a map containing `before` and `after` blocks that have gaps between
@@ -446,8 +415,8 @@
   "Reads blocks according to BbiChromInfo data and returns tracks described
   Wig or BedGraph format."
   [^RandomAccessFile r ^BbiChromInfo chrom-info ^URL url
-   {:keys [bpt-header fixed-width-header cir-tree]}]
-  (let [blocks (fetch-overlapping-blocks-group r bpt-header chrom-info cir-tree)
+   {:keys [fixed-width-header cir-tree]}]
+  (let [blocks (fetch-overlapping-blocks-group r chrom-info cir-tree)
         rng {:start 0, :end (:size chrom-info)}]
     (letfn [(bigwig-> [offset after blocks acc]
               (let [block (first blocks)


identical? -> keyword-identical?

identical? -> keyword-identical?

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -7533,8 +7533,8 @@
               (let [pval @pa
                     val (f input)]
                 (reset! pa val)
-                (if (or (identical? pval ::none)
-                      (= val pval))
+                (if (or (keyword-identical? pval ::none)
+                        (= val pval))
                   (do
                     (.add a input)
                     result)


Sneak the store relative path into exs, notes

--- src/grimoire/api/fs/read.clj
+++ src/grimoire/api/fs/read.clj
@@ -103,27 +103,34 @@
 (defmethod api/-list-notes ::fs/Config [config thing]
   {:pre [(t/thing? thing)]}
   (if (t/versioned? thing)
-    (let [versions (api/thing->prior-versions config thing)]
+    (let [versions (api/thing->prior-versions config thing)
+          lhs      (.toPath (io/file (:notes config)))]
       (if (succeed? versions)
         (succeed
-         (for [thing (result versions)
-               :let  [v (t/thing->name (t/thing->version thing))
-                      h (impl/thing->notes-handle config thing)]
+         (for [prior-thing (result versions)
+               :let  [v (t/thing->name (t/thing->version prior-thing))
+                      h (impl/thing->notes-handle config prior-thing)]
                :when (.exists h)
                :when (.isFile h)]
-           (t/->Note thing, (.getPath h))))
+           (let [rhs (.toPath h)
+                 p   (.relativize lhs rhs)]
+             (-> thing
+                 (t/->Note (.getName h)
+                           (.getPath h))
+                 (assoc ::t/file (.toString p))))))

         ;; versions is a Fail, pass it down
         versions))

     (let [^java.io.File h (impl/thing->notes-handle config thing)]
       (if (.exists h)
-        (succeed [(t/->Note thing, (.getPath h))])
+        (succeed [(t/->Note thing, (.getName h), (.getPath h))])
         (fail "No notes file!")))))

 (defmethod api/-list-examples ::fs/Config [config thing]
   {:pre [(t/thing? thing)]}
-  (let [versions (api/thing->prior-versions config thing)]
+  (let [versions (api/thing->prior-versions config thing)
+        lhs      (.toPath (io/file (:notes config)))]
     (if (succeed? versions)
       (succeed
        (for [prior-thing (result versions)
@@ -131,7 +138,12 @@
                           h (impl/thing->handle config :examples prior-thing)]
              ex          (.listFiles h)
              :when       (.isFile ex)]
-         (t/->Example thing, (.getPath ex))))
+         (let [rhs (.toPath ex)
+               p   (.relativize lhs rhs)]
+           (-> thing
+               (t/->Example (.getName ex)
+                            (.getPath ex))
+               (assoc ::t/file (.toString p))))))

       ;; versions is a Fail, pass it down
       versions)))


Implements contains? on map, array, vector, and nil. refs #34

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -85,9 +85,11 @@
   #_(-assoc-ex [coll k v])
   (-dissoc [coll k]))

-(defprotocol ISet
-  (-contains? [coll v])
+(defprotocol ISet
   (-disjoin [coll v]))
+
+(defprotocol IKeyed
+  (-contains? [coll v]))

 (defprotocol IStack
   (-peek [coll])
@@ -174,8 +176,10 @@
   IMap
   (-dissoc [_ k] nil)

+  IKeyed
+  (-contains? [_ v] false)
+
   ISet
-  (-contains? [_ v] false)
   (-disjoin [_ v] nil)

   IStack
@@ -289,7 +293,12 @@
     ([array f]
        (ci-reduce array f))
     ([array f start]
-       (ci-reduce array f start))))
+       (ci-reduce array f start)))
+
+  IKeyed
+  (-contains? [array n]
+     (and (js* "(~{n} >= 0)")
+          (js* "(~{n} < ~{array}.length)"))))

 (defn seq
   "Returns a seq on the collection. If the collection is
@@ -1591,8 +1600,12 @@
   (-reduce [v f]
     (ci-reduce array f))
   (-reduce [v f start]
-    (ci-reduce array start))
-  )
+           (ci-reduce array start))
+
+  IKeyed
+  (-contains? [coll n]
+     (and (>= n 0)
+          (< n (.length array)))))

 (set! cljs.core.Vector/EMPTY (Vector. nil (array)))

@@ -1699,6 +1712,10 @@
   (-contains-key? [coll k]
     (obj-map-contains-key? k strobj))

+  IKeyed
+  (-contains? [coll k]
+    (-contains-key? coll k))
+
   IMap
   (-dissoc [coll k]
     (if (and (goog/isString k) (.hasOwnProperty strobj k))
@@ -1787,6 +1804,10 @@
       (if i
         true
         false)))
+
+  IKeyed
+  (-contains? [coll k]
+    (-contains-key? coll k))

   IMap
   (-dissoc [coll k]
@@ -1896,9 +1917,11 @@
       v
       not-found))

-  ISet
+  IKeyed
   (-contains? [coll v]
     (-contains-key? hash-map v))
+
+  ISet
   (-disjoin [coll v]
     (Set. meta (dissoc hash-map v)))

@@ -2566,6 +2589,15 @@
              (map odd? [1 2 3 4 -1 0])))
   (assert (= [true false true false true true]
              (map even? [2 3 4 5 -2 0])))
+  (assert (contains? {:a 1 :b 2} :a))
+  (assert (not (contains? {:a 1 :b 2} :z)))
+  (assert (contains? [5 6 7] 1))
+  (assert (contains? [5 6 7] 2))
+  (assert (not (contains? [5 6 7] 3)))
+  (assert (contains? (to-array [5 6 7]) 1))
+  (assert (contains? (to-array [5 6 7]) 2))
+  (assert (not (contains? (to-array [5 6 7]) 3)))
+  (assert (not (contains? nil 42)))
   :ok
   )


Remove comment.

Remove comment.

--- src/clu/server/core.clj
+++ src/clu/server/core.clj
@@ -16,7 +16,7 @@
   (http/with-channel request channel
     (http/on-close channel (fn [status]
                              (log/infof "Channel closed: %s" status)))
-    (http/on-receive channel (fn [data] ;; echo it back
+    (http/on-receive channel (fn [data]
                                (let [parsed-data (json/read-str data :key-fn keyword)]
                                  (log/infof "received data: %s" parsed-data)
                                  (->> parsed-data


Missed one rename.

Missed one rename.

--- project/analyze-data/src/analyze_data/evaluate_model.clj
+++ project/analyze-data/src/analyze_data/evaluate_model.clj
@@ -27,4 +27,4 @@
   (with-open [in (io/reader test-file)]
     (let [model (read-object tf-idf-model-file)
           test-data (csv-to-map in)]
-      (evaluate-test-data tf-idf-model test-data))))
+      (evaluate-model tf-idf-model test-data))))


Enable feature expressions to work for clj code

--- lein-light-nrepl/src/lighttable/nrepl/eval.clj
+++ lein-light-nrepl/src/lighttable/nrepl/eval.clj
@@ -15,7 +15,7 @@

 (defn try-read [rdr]
   (when rdr
-    (reader/read rdr false ::EOF)))
+    (reader/read {:read-cond :allow :features #{:clj} :eof ::EOF} rdr)))

 (defn lined-read [string]
   (let [rdr (rt/indexing-push-back-reader string)]


rearrange code

rearrange code

--- src/dodgeball/core.cljs
+++ src/dodgeball/core.cljs
@@ -36,17 +36,20 @@

 (defn cell-view [data owner]
   (om/component (dom/td nil
-                        (if (not= data nil) (dom/img #js {:src (str "images/" (:image data))})))))
+                        (if data
+                          (dom/img #js {:src (str "images/" (:image data))})))))

 (defn find-cell [x y data]
   (first
-   (filter #(and (= (:x %) x) (= (:y %) y)) data)))
+    (filter #(and (= (:x %) x)
+                  (= (:y %) y))
+            data)))

 (defn board [data]
- (dom/div #js {:className "container"}
- (bench)
- (dom/table nil
+  (dom/div #js {:className "container"}
+  (bench)
+  (dom/table nil
     (vec (for [y (range 0 board-height)]
       (dom/tr
         #js {:className


DM + AB - Fix confirm-create

DM + AB - Fix confirm-create

--- src/freecoin/wallet.clj
+++ src/freecoin/wallet.clj
@@ -278,52 +278,51 @@
   :exists? (fn [ctx]
              (let [db (get-in request [:config :db-connection])
                    cc (storage/find-by-id db "confirms" confirmation)]
-                         (if (empty? cc)
-                           ;; no confirmation found
-                           {::found false ::confirmation confirmation}
-                           ;; entry found, proceed
-                           {::found true ::params cc}
-                           )))
+               (if (empty? cc)
+                 ;; no confirmation found
+                 {::found false ::confirmation confirmation}
+                 ;; entry found, proceed
+                 {::found true ::params cc}
+                 )))

-  :handle-ok (fn [ctx]
-               ;; the confirmation was found
-               (if (::found ctx)
-                 ;; proceed with the wallet creation
-                 (let [params (::params ctx)
-                       db (get-in request [:config :db-connection])
-                       secret (fxc/create-secret param/encryption)
-                       cookie-data (str/join "::" [(:cookie secret) (:_id secret)])
-                       secret-without-cookie (dissoc secret :cookie)
-                       nxt-data (nxt/getAccountId
-                                 {:secret (fxc/unlock-secret
-                                           param/encryption
-                                           secret-without-cookie
-                                           (:cookie secret))})]
-
-                   ;; delete the confirmation entry from the db
-                   (storage/remove-by-id db "confirms" (:_id params))
-
-                   ;; insert in the secrets database
-                   (storage/insert db "secrets" secret-without-cookie)
-
-                   ;; insert in the wallet database
-                   (storage/insert db "wallets"
-                                   (conj nxt-data {:name  (:name params)
-                                                   :email (:email params)
-                                                   :_id (:_id secret-without-cookie)}))
-
-                   ;; return the apikey cookie
-                   (ring-response {:headers {"Location" (ctx :location)}
-                                   :session {:cookie-data cookie-data}
-                                   :apikey cookie-data})
-                   ;; TODO: give PINs
-                   ;; send backup (show QR, also per email?)
-
-                   )
-                 ;; else confirmation not found
-                 {:debug (util/trace)
-                  :error "Confirmation not found."
-                  :id (::confirmation ctx)})))
+  :handle-created (fn [ctx]
+                    ;; the confirmation was found
+                    (if (::found ctx)
+                      ;; proceed with the wallet creation
+                      (let [params (::params ctx)
+                            db (get-in request [:config :db-connection])
+                            secret (fxc/create-secret param/encryption)
+                            cookie-data (str/join "::" [(:cookie secret) (:_id secret)])
+                            secret-without-cookie (dissoc secret :cookie)
+                            nxt-data (nxt/getAccountId
+                                      {:secret (fxc/unlock-secret
+                                                param/encryption
+                                                secret-without-cookie
+                                                (:cookie secret))})]
+                        ;; delete the confirmation entry from the db
+                        (storage/remove-by-id db "confirms" (:_id params))
+
+                        ;; insert in the secrets database
+                        (storage/insert db "secrets" secret-without-cookie)
+
+                        ;; insert in the wallet database
+                        (storage/insert db "wallets"
+                                        (conj nxt-data {:name  (:name params)
+                                                        :email (:email params)
+                                                        :_id (:_id secret-without-cookie)}))
+
+                        ;; return the apikey cookie
+                        (ring-response {:headers {"Location" (ctx :location)}
+                                        :session {:cookie-data cookie-data}
+                                        :apikey cookie-data})
+                        ;; TODO: give PINs
+                        ;; send backup (show QR, also per email?)
+
+                        )
+                      ;; else confirmation not found
+                      {:debug (util/trace)
+                       :error "Confirmation not found."
+                       :id (::confirmation ctx)})))

 ;; Reminder, but NEVER show nxtpass!


Add command to open current file as linked doc

--- src/lt/objs/opener.cljs
+++ src/lt/objs/opener.cljs
@@ -260,6 +260,12 @@
               :exec (fn [info]
                       (object/raise opener :open-info! info))})

+(cmd/command {:command :opener.open-linked-doc
+              :desc "Opener: Open linked document of current file"
+              :exec (fn []
+                      (let [ed (pool/last-active)]
+                        (open-linked-path ed opener (get-in @ed [:info :path]) {})))})
+
 (set! js/window.ondragover  (fn [e]
                               (set! (.-dataTransfer.dropEffect e) "move")
                               (dom/prevent e)


fix 404 status for things like /user/edit_current

--- src/metabase/routes.clj
+++ src/metabase/routes.clj
@@ -10,4 +10,4 @@
     (GET "/" [] serve-index)                            ; ^/$    -> index.html
     (context "/api" [] api/routes)                      ; ^/api/ -> API routes
     (route/files "/app/" {:root "frontend_client/app"}) ; ^/app/ -> static files under frontend_client/app
-    (route/not-found serve-index)))                     ; Anything else (e.g. /user/edit_current) should serve up index.html; Angular app will handle the rest
+    (GET "*" [] serve-index)))                          ; Anything else (e.g. /user/edit_current) should serve up index.html; Angular app will handle the rest


make meter reloadable as well, so upbeat-downbeat does not get messed up upon reload

--- src/metronome/core.cljs
+++ src/metronome/core.cljs
@@ -8,7 +8,8 @@
   (do
     (enable-console-print!)))

-(defonce app-state (atom {:bpm {}}))
+(defonce app-state (atom {:bpm {}
+                          :meter {:count 0}}))

 (defn clock [bpm owner]
   (letfn [(start-interval [millis]
@@ -41,22 +42,20 @@
       om/IRender
       (render [_] (dom/span nil)))))

-(defn sound [_ owner]
+(defn sound [meter owner]
   (reify
-    om/IInitState
-    (init-state [_] {:beat 0})
     om/IDidMount
     (did-mount [_]
                (let [sound-channel (om/get-state owner :sound-channel)]
                  (go (loop []
                        (let [_     (<! sound-channel)
-                             audio (if (zero? (mod (om/get-state owner :beat) 4))
+                             audio (if (zero? (:count @meter))
                                      (om/get-node owner "ding")
                                      (om/get-node owner "dong"))]
                          (if (.-paused audio)
                            (.play audio)
                            (set! (.-currentTime audio) 0))
-                         (om/update-state! owner :beat inc)
+                         (om/transact! meter :count #(mod (inc %) 4))
                          (recur))))))
     om/IRender
     (render [_]
@@ -93,7 +92,7 @@
       (dom/div nil
                (dom/h1 nil "metronome")
                (om/build clock (:bpm app) {:init-state {:sound-channel sound-channel :click-channel click-channel}})
-               (om/build sound nil {:init-state {:sound-channel sound-channel}})
+               (om/build sound (:meter app) {:init-state {:sound-channel sound-channel}})
                (om/build click nil {:init-state {:click-channel click-channel}}))
       )))
  app-state


Add header-included codec helpers to core ns.

--- src/multicodec/core.clj
+++ src/multicodec/core.clj
@@ -1,5 +1,7 @@
 (ns multicodec.core
   "Core multicodec protocols and functions."
+  (:require
+    [multicodec.header :as header])
   (:import
     (java.io
       ByteArrayInputStream
@@ -69,6 +71,19 @@
     (.toByteArray baos)))

+(defn encode-with-header!
+  "Writes a header to the output stream, then writes out the encoded value.
+  Returns the number of bytes written.
+
+  If a header is not given, the codec's header is used."
+  ([codec output value]
+   (encode-with-header! codec output (:header codec) value))
+  ([codec output header value]
+   (let [header-length (header/write-header! output header)
+         body-length (encode! codec output value)]
+     (+ header-length body-length))))
+
+

 ;; ## Decoding

@@ -91,3 +106,21 @@
   [codec ^bytes byte-data]
   (let [bais (ByteArrayInputStream. byte-data)]
     (decode! codec bais)))
+
+
+(defn decode-with-header!
+  "Reads a multicodec header from the input stream and checks it against the one
+  provided. Throws an exception if the header does not match, otherwise uses the
+  codec to read a value from the stream.
+
+  If a header is not given, the codec's header is used."
+  ([codec input]
+   (decode-with-header! codec input (:header codec)))
+  ([codec input header]
+   (let [header' (header/read-header! input)]
+     (when-not (= header header')
+       (throw (ex-info
+                (format "The stream header %s did not match expected header %s"
+                        (pr-str header') (pr-str header))
+                {:expected header, :actual header'})))
+     (decode! codec input))))


atomize ddt-events

atomize ddt-events

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -731,13 +731,12 @@
 (defn ddt-events
   "(ddt) between each pair of events."
   [& children]
-  (let [prev (ref nil)]
+  (let [prev (atom nil)]
     (fn stream [event]
       (when-let [m (:metric event)]
-        (let [prev-event (dosync
-                           (let [prev-event (deref prev)]
-                             (ref-set prev event)
-                             prev-event))]
+        (let [prev-event (let [prev-event @prev]
+                           (reset! prev event)
+                           prev-event)]
           (when prev-event
             (let [dt (- (:time event) (:time prev-event))]
               (when-not (zero? dt)


remove unused require

remove unused require

--- src/braid/client/ui/views/pills.cljs
+++ src/braid/client/ui/views/pills.cljs
@@ -1,6 +1,5 @@
 (ns braid.client.ui.views.pills
   (:require [reagent.core :as r]
-            [reagent.impl.util :refer [extract-props]]
             [braid.client.routes :as routes]
             [braid.client.dispatcher :refer [dispatch!]]
             [braid.client.helpers :refer [id->color]]


Add frequency and notes to the visualization

--- src/sporktrum/core.cljs
+++ src/sporktrum/core.cljs
@@ -83,6 +83,28 @@
   (.lineTo ctx width spectrum-baseline)
   (.fill ctx))

+(defn print-strongest-freq
+  "Print the strongest frequency in the top right corner of the graph"
+  [freq-mags]
+  (let [max-freq (:freq (apply max-key #(:mag %) freq-mags))
+        floated-steps (u/steps-from-A4 max-freq)
+        steps (int floated-steps)
+        octave (+ 4 (Math/floor (/ steps 12)))
+        cents (int (* (- floated-steps steps) 100))
+        signed-cents (if (>= cents 0)
+                       (str "+" cents)
+                       (str cents))
+        note (if (>= steps 0)
+                (nth (cycle scale) steps)
+                (nth (cycle (reverse scale)) (Math/abs steps)))]
+    (set! (.-fillStyle ctx) "#8A8A8A")
+    (set! (.-textAlign ctx) "right")
+    (set! (.-font ctx) "14px Helvetica, Arial")
+    (.fillText ctx (str (js/parseInt max-freq 10) "Hz") (- width 20) 20)
+    (.fillText ctx (str note octave) (- width 20) 40)
+    (.fillText ctx (str signed-cents " cents") (- width 20) 60)
+    ))
+
 (defn print-scale
   "Print the scale accross the bottom"
   []
@@ -119,15 +141,6 @@
                   (.stroke ctx))
               (drop 1 (take-nth 4 (range 0 steps)))))
   )
-
-;(defn print-strongest-freq
-;  "Print the strongest frequency in the top right corner of the graph"
-;  [freq-data]
-;  (let [highest-mag (apply max (take upper-idx simple-freq-data))
-;        idx (.indexOf simple-freq-data highest-mag)
-;        freq (u/freq-for-bin idx (:sample-rate @refs) (:fft-size @refs))]
-;    (set! (.-fillStyle ctx) "#8A8A8A")
-;    (.fillText ctx (str (js/parseInt freq 10) "Hz") (- width 70) 20)))

 (defn clear
   "Clear the canvas"
@@ -150,7 +163,7 @@
       (draw-spectrum freq-mags)
       (draw-line-scale)
       (print-scale)
-      ;(print-strongest-freq freq-data freq-mags)
+      (print-strongest-freq freq-mags)
       )))

 (defn configure


simplified delta computation

simplified delta computation

--- src/syncserver/core.clj
+++ src/syncserver/core.clj
@@ -103,14 +103,15 @@
    (every? map? [a b]) (map-diff path a b diffs)
    :otherwise (conj diffs [:set path b])))

+
+(defn- compute-delta [os cs]
+  (object-array [(:current cs) (map-diff [] (:state os) (:state cs) #{})]))
+
+(defn- get-from-cache [old-state]
+  (when old-state (.getIfPresent cache! old-state)))
+
 (defn delta [old-state]
-  (let [cs @current-state]
-  (if old-state
-    (let [os (.getIfPresent cache! old-state)]
-      (when os (debug "Cache hit:" os))
-      (object-array [(:current cs) (map-diff [] os (:state cs) #{})]))
-    (object-array [(:current cs) (map-diff [] nil (:state cs) #{})]))))
-
+  (compute-delta (get-from-cache old-state) @current-state))

 (comment
   (defn -main [& args]


removed debug print

removed debug print

--- src/syncserver/core.clj
+++ src/syncserver/core.clj
@@ -94,7 +94,7 @@
     d3))

 (defn ddiff [path a b diffs]
-  (println "ddiff" a b "@" path " : " diffs)
+  #_(println "ddiff" a b "@" path " : " diffs)
   (cond
    (= a b) diffs
    (every? vector? [a b]) (vector-diff path a b diffs)


Prevent NPE when subscriber receives a message and the vpeer has already been stopped.

--- src/onyx/messaging/aeron.clj
+++ src/onyx/messaging/aeron.clj
@@ -123,27 +123,29 @@
           (let [message (protocol/read-acker-message buffer offset-rest)
                 ack (:payload message)
                 id (:id message)]
-            (>!! (:acking-ch (get @virtual-peers id)) ack))
+            (when-let [chs (get @virtual-peers id)]
+              (>!! (:acking-ch chs) ack)))

           (= msg-type protocol/messages-msg-id)
           (let [message (protocol/read-messages-buf decompress-f buffer offset-rest length)
                 segments (:payload message)
-                id (:id message)
-                inbound-ch (:inbound-ch (get @virtual-peers id))]
-            (doseq [segment segments]
-              (>!! inbound-ch segment)))
+                id (:id message)]
+            (when-let [chs (get @virtual-peers id)]
+              (let [inbound-ch (:inbound-ch chs)]
+                (doseq [segment segments]
+                  (>!! inbound-ch segment)))))

           (= msg-type protocol/completion-msg-id)
           (let [message (protocol/read-completion buffer offset-rest)
                 completion-id (:payload message)]
-            (>!! (:release-ch (get @virtual-peers (:id message)))
-                 completion-id))
+            (when-let [chs (get @virtual-peers (:id message))]
+              (>!! (:release-ch chs) completion-id)))

           (= msg-type protocol/retry-msg-id)
-          (let [message (protocol/read-retry buffer offset-rest)
-                retry-id (:payload message)]
-            (>!! (:retry-ch (get @virtual-peers (:id message)))
-                 retry-id)))))
+            (let [message (protocol/read-retry buffer offset-rest)
+                  retry-id (:payload message)]
+              (when-let [chs (get @virtual-peers (:id message))]
+                (>!! (:retry-ch chs) retry-id))))))

 (defn start-subscriber! [bind-addr port virtual-peers decompress-f idle-strategy]
   (let [ctx (.errorHandler (Aeron$Context.) no-op-error-handler)


db/docids.clj: added get/set-next-docid

db/docids.clj: added get/set-next-docid

--- src/org/altlaw/db/docids.clj
+++ src/org/altlaw/db/docids.clj
@@ -1,5 +1,6 @@
 (ns org.altlaw.db.docids
-  (:require [org.altlaw.db.data :as data]))
+  (:require [org.altlaw.db.data :as data]
+            [org.altlaw.db.properties :as props]))

 (def #^{:private true} *bucket* "altlaw.org")

@@ -22,3 +23,8 @@
   (dosync (apply alter (get-docids collection)
                  assoc (mapcat list keys (repeat docid)))))

+(defn get-next-docid []
+  (Integer/parseInt (props/get-property "next_docid")))
+
+(defn set-next-docid [docid]
+  (props/set-property "next_docid" docid))


Add cached-agents for device-specific MIDI controls.

--- src/overtone/studio/midi.clj
+++ src/overtone/studio/midi.clj
@@ -7,22 +7,29 @@

 (defonce MIDI-POOL (mk-pool))
 (defonce midi-devices* (atom {}))
+(defonce midi-control-agents* (atom {}))

 (def EXCLUDED-DEVICES #{"Real Time Sequencer" "Java Sound Synthesizer"})

 (defn midi-mk-full-device-event-key
-  "Creates the full key used for events generated by incoming MIDI
-  events. Using this key can allow you to detect events from specific
-  devices rather than just general control events."
+  "Creates the device-specific part of the key used for events generated
+  by incoming MIDI messages."
   [dev command]
   [:midi-device (dev :vendor) (dev :name) (dev :description) command])
+
+(defn midi-mk-full-control-event-key
+  "Creates the full key used for events generated by incoming MIDI
+  messages. Using this key can allow you to detect events from specific
+  devices rather than just general control events."
+  [dev command control-id]
+  (concat (midi-mk-full-device-event-key dev command) [control-id]))

 (defn midi-event
   "Trigger a global midi event."
   [dev msg & [ts]]
   (let [command (:command msg)]
     (event [:midi command] msg)
-    (event (midi-mk-full-device-event-key dev command (:data1 msg)) msg)))
+    (event (midi-mk-full-control-event-key dev command (:data1 msg)) msg)))

 (defn- detect-midi-devices
   "Designed to run periodically and update the midi-devices* atom with
@@ -160,3 +167,43 @@
   controller."
   []
   (:key (midi-capture-next-control-input true)))
+
+(defn midi-capture-next-controller-control-key
+  "Returns a vector representing the unique key for the specific control
+  of the next modified controller. This is the key used for controller
+  specific MIDI events."
+  []
+  (let [next-input (midi-capture-next-control-input true)]
+    (concat (:key next-input) [(:controller next-input)])))
+
+(defn- mk-control-key-keyword
+  [control-key]
+  (keyword (str "overtone.studio.midi/update-atom-for-control-" control-key)))
+
+(defn midi-agent-for-control
+  "Returns an agent representing the current value of a
+  controller-specific control identified by a fully-qualified MIDI event
+  key such as that generated by midi-mk-full-control-event-key. If the
+  atom doesn't exist, it is created and cached. Subsequent calls with
+  the same control-key will return the same agent.
+
+  Agents are used because the event to update them can be safely handled
+  synchronously (with on-sync-event) without watchers being able to
+  block the thread generating the MIDI events. This also means that
+  incoming events are sent to the agent in the correct order whereas if
+  the thread pool were used (via on-event), the incoming events may be
+  arbitrarily ordered."
+  [control-key]
+  (let [control-agents (swap! midi-control-agents*
+                             (fn [prev]
+                               (if (get prev control-key)
+                                 prev
+                                 (let [new-control-agent (agent 0)]
+                                   (on-sync-event control-key
+                                             (fn [msg]
+                                               (send new-control-agent
+                                                     (fn [old-val]
+                                                       (:data2 msg))))
+                                             (mk-control-key-keyword control-key))
+                                   (assoc prev control-key new-control-atom)))))]
+    (get control-agents control-key)))


Add proper validation for instant registration

You should not be able to create a nested domain (because it will not be registered correctly)

--- src/name_bazaar/ui/pages/instant_register_name_page.cljs
+++ src/name_bazaar/ui/pages/instant_register_name_page.cljs
@@ -4,7 +4,7 @@
     [district0x.ui.components.transaction-button :refer [transaction-button]]
     [name-bazaar.ui.components.app-layout :refer [app-layout]]
     [name-bazaar.ui.components.ens-record.ens-name-input :refer [ens-name-input]]
-    [name-bazaar.ui.utils :refer [valid-ens-name? path-for]]
+    [name-bazaar.ui.utils :refer [valid-ens-subname? path-for]]
     [re-frame.core :refer [subscribe dispatch]]
     [reagent.core :as r]
     [soda-ash.core :as ui]))
@@ -25,7 +25,7 @@
            :value @label
            :on-change (fn [_ data]
                         (let [value (aget data "value")]
-                          (when (valid-ens-name? value)
+                          (when (valid-ens-subname? value)
                             (reset! label value))))}]]]
        [ui/GridRow
         {:centered true}
@@ -36,7 +36,7 @@
            :pending-text "Registering..."
            :on-click (fn []
                        (when (and (not (empty? @label))
-                                  (valid-ens-name? @label))
+                                  (valid-ens-subname? @label))
                          (dispatch [:name-bazaar-registrar/register {:ens.record/label @label}])
                          (reset! label "")))}
           "Register"]]]])))


Removes reflection from set-idle-timeout! (#268)

--- waiter/src/waiter/process_request.clj
+++ waiter/src/waiter/process_request.clj
@@ -72,10 +72,8 @@
   [^HttpOutput output-stream idle-timeout-ms]
   (try
     (log/debug "executing pill to adjust idle timeout to" idle-timeout-ms "ms.")
-    (let [channel-field (.getDeclaredField HttpOutput "_channel")]
-      (.setAccessible channel-field true)
-      (let [^HttpChannel http-channel (.get channel-field output-stream)]
-        (.setIdleTimeout http-channel idle-timeout-ms)))
+    (let [^HttpChannel http-channel (.getHttpChannel output-stream)]
+      (.setIdleTimeout http-channel idle-timeout-ms))
     (catch Exception e
       (log/error e "gobbling unexpected error while setting idle timeout"))))