database: add a bunch of tests

database: add a bunch of tests

--- test/subrosa/test/database.clj
+++ test/subrosa/test/database.clj
@@ -4,22 +4,65 @@

 (use-fixtures :each
               (fn [f]
-                (dosync (ref-set db/db {}))
-                (f)))
-
-(defn =* [m1 m2]
-  (= (dissoc m1 :id)
-     (dissoc m2 :id)))
+                (binding [db/db (ref {})]
+                  (f))))

 (deftest basic-database-operations
-  (let [m {:foo 42 :nick "dan"}]
-    (db/add-index :foo :foo)
-    (db/add-index :foo :nick)
-    (db/put :foo m)
-    (is (=* (db/get :foo :foo 42)
-            m))
-    (is (=* (db/get :foo :nick "dan")
-            m))
-    (db/delete :foo (:id (db/get :foo :foo 42)))
-    (is (nil? (db/get :foo :foo 42)))
-    (is (nil? (db/get :foo :nick "dan")))))
+  (let [m {:baz 42 :nick "dan" :id "foo"}
+        m2 {:baz "baz" :nick "dan2" :id "foo2"}]
+    (testing "put one row and retrieve it"
+      (db/put :table1 m)
+      (is (= m (db/get :table1 :id "foo"))))
+    (testing "put another row and retrieve it"
+      (db/put :table1 m2)
+      (is (= m2 (db/get :table1 :id "foo2"))))
+    (testing "make sure the table has two rows"
+      (is (= #{m m2} (db/get :table1))))
+    (testing "delete one row and make sure it's gone"
+      (db/delete :table1 "foo")
+      (is (nil? (db/get :table :id "foo"))))))
+
+(deftest put-should-update-not-replace
+  (let [m {:baz 42 :nick "dan" :id "foo"}
+        m2 (assoc m :nick "dan2")]
+    (db/put :table1 m)
+    (db/put :table1 m2)
+    (is (= m2 (db/get :table1 :id "foo")))
+    (is (= #{m2} (db/get :table1)))))
+
+(deftest put-should-create-id-field-if-missing
+  (let [m {:baz 42 :nick "dan"}]
+    (db/put :table1 m)
+    (let [new-m (first (db/get :table1))]
+      (is (not (nil? (:id new-m)))))))
+
+(deftest get-shouldnt-work-with-unindexed-field
+  (let [m {:baz 42 :nick "dan" :id "foo"}]
+    (db/put :table1 m)
+    (is (nil? (db/get :table1 :nick "dan")))
+    (is (= #{m} (db/get :table1)))))
+
+(deftest test-add-index ; get-shouldnt-work-with-unindexed-field
+  (let [m {:baz 42 :nick "dan" :id "foo"}]
+    (db/add-index :table1 :nick)
+    (db/put :table1 m)
+    (is (= m (db/get :table1 :nick "dan")))
+    (is (= #{m} (db/get :table1)))))
+
+(deftest test-complex-index
+  (let [m {:baz 42 :nick "dan" :id "foo"}]
+    (db/add-index :table1 [:baz :nick])
+    (db/put :table1 m)
+    (is (= m (db/get :table1 [:baz :nick] [42 "dan"])))
+    (is (= #{m} (db/get :table1)))))
+
+(deftest complex-index-are-updated
+  (let [m {:baz 42 :nick "dan" :id "foo"}
+        m2 (assoc m :nick "dan2")]
+    (db/add-index :table1 [:baz :nick])
+    (db/put :table1 m)
+    (is (= m (db/get :table1 [:baz :nick] [42 "dan"])))
+    (db/put :table1 m2)
+    (is (nil? (db/get :table1 [:baz :nick] [42 "dan"])))
+    (is (= m2 (db/get :table1 [:baz :nick] [42 "dan2"])))
+    (is (= #{m2} (db/get :table1)))))


resources page - correct download links

resources page - correct download links

--- src/norman_sicily_static/resources.clj
+++ src/norman_sicily_static/resources.clj
@@ -26,14 +26,14 @@
        [:div {:class "credits-header"} "Datasets"]
        [:p "Currently, the dataset includes Norman monasteries in Sicily.
            It is available in various formats, including "
-        [:a {:href "http://www.normansicily.org/data/places-20180727.csv"} "CSV"] ", "
-        [:a {:href "http://www.normansicily.org/data/places-20180727.geojson"} "GeoJSON"] ", "
-        [:a {:href "http://www.normansicily.org/data/places-20180727.jsonld"} "JSON-LD"] ", "
-        [:a {:href "http://www.normansicily.org/data/places-riot-20180727.n3"} "N3"] ", "
-        [:a {:href "http://www.normansicily.org/data/places-riot-20180727.rdfxml"} "RDF/XML"] " and "
-        [:a {:href "http://www.normansicily.org/data/places-riot-20180727.ttl"} "TTL"]
+        [:a {:href "/data/places-20180727.csv"} "CSV"] ", "
+        [:a {:href "/data/places-20180727.geojson"} "GeoJSON"] ", "
+        [:a {:href "/data/places-20180727.jsonld"} "JSON-LD"] ", "
+        [:a {:href "/data/places-riot-20180727.n3"} "N3"] ", "
+        [:a {:href "/data/places-riot-20180727.rdfxml"} "RDF/XML"] " and "
+        [:a {:href "/data/places-riot-20180727.ttl"} "TTL"]
         ". For the CSV and GeoJSON formats, there is a "
-        [:a {:href "http://www.normansicily.org/data/places_column_dictionary_20180727.csv"} "data dictionary"]
+        [:a {:href "/data/places_column_dictionary_20180727.csv"} "data dictionary"]
         " to describe the columns."]
        [:p "All of the datasets are LOD three star compliant "
         [:a {:href "https://5stardata.info/en/"}


Rephrase new docstring

Rephrase new docstring

--- library/src/doo/core.clj
+++ library/src/doo/core.clj
@@ -240,8 +240,8 @@
     :debug - bool (default false) to log to standard-out internal events
              to aid debugging
     :paths - a map from runners (keywords) to string commands for bash.
-    :exec-dir - string (default nil) that overrides working directory
-                for execution, if present."
+    :exec-dir - a directory path (string) from where runner should be
+                exectuted. Defaults to nil which resolves to the current dir"
   ([js-env compiler-opts]
    (run-script js-env compiler-opts {}))
   ([js-env compiler-opts opts]


Added reference to can-repair

Added reference to can-repair

--- test/cljs/zetawar/subs_test.cljs
+++ test/cljs/zetawar/subs_test.cljs
@@ -206,6 +206,7 @@
                  :unit-type/min-range
                  :unit-type/max-range
                  :unit-type/can-capture
+                 :unit-type/can-repair
                  :unit-type/image}
                (into #{} unit-type-keys)))))))


Bundle import race condition (#1177)

Bundle import race condition (#1177)

This PR adds a test which reproduces the race condition in the bundle/import to deduplicate data on external ids.

--- test/ctia/bundle/routes_test.clj
+++ test/ctia/bundle/routes_test.clj
@@ -1125,3 +1125,41 @@
          (is (= 201 (:status link-res)))
          (is (= 200 (:status bundle-get-res)))
          (is (seq (-> bundle-get-res :parsed-body :casebooks))))))))
+
+(deftest race-condition-test
+  (helpers/with-properties
+    ["ctia.store.es.default.refresh" "false"
+     "ctia.store.es.default.refresh_interval" "1s"
+     "ctia.store.bulk-refresh" "false"
+     "ctia.store.bundle-refresh" "wait_for"]
+    (helpers/fixture-ctia-with-app
+     (fn [app]
+       (helpers/set-capabilities! app "foouser" ["foogroup"] "user" (all-capabilities))
+       (whoami-helpers/set-whoami-response app
+                                           "45c1f5e3f05d0"
+                                           "foouser"
+                                           "foogroup"
+                                           "user")
+       (let [new-bundle {:source "anonymous coward"
+                         :incidents
+                         [{:source "CTR-WIN-IP"
+                           :external_ids
+                           ["secure-endpoint-incident-4050710c4bb9692e55465c32ae150730a57936cc95377f09a76952ead9556da0"]
+                           :title "CTR-WIN-IP in group Protect @ 20211124 13:52:21"
+                           :incident_time {:opened "2021-11-24T13:52:21.000Z"}
+                           :source_uri
+                           "https://console.qa1.immunet.com/computers/74eff879-a30b-4a39-8d53-3501a2155f84/trajectory2"
+                           :status "New"
+                           :severity "High"
+                           :tlp "amber"
+                           :timestamp "2021-11-24T13:52:23.906Z"
+                           :confidence "High"}]}
+             import (fn [new-bundle]
+                      (POST app
+                          "ctia/bundle/import"
+                        :body new-bundle
+                        :headers {"Authorization" "45c1f5e3f05d0"}))
+             res (->> (pmap import (repeat 10 new-bundle))
+                      (mapcat (comp :results :parsed-body)))]
+         (testing "there is a race condition for checking external ids"
+             (is (< 1 (count (filter #(= "created" (:result %)) res))))))))))


remove trace output

remove trace output

--- test/clj_money/models/reports_test.clj
+++ test/clj_money/models/reports_test.clj
@@ -263,9 +263,4 @@
                    :value (bigdec 249)
                    :style :data
                    :depth 0}]]
-
-    (pprint {:expected expected
-             :actual actual
-             :diff (diff expected actual)})
-
     (is (= expected actual) "The rpoert renders the correct data")))


lein-release plugin: preparing 0.2.1 release

--- material/project.clj
+++ material/project.clj
@@ -1,4 +1,4 @@
-(defproject re-view/material "0.2.1-SNAPSHOT"
+(defproject re-view/material "0.2.1"

   :description "Material design components in re-view"


Test for bigger cluster.

Test for bigger cluster.

--- test/onyx/coordinator/cluster_test.clj
+++ test/onyx/coordinator/cluster_test.clj
@@ -156,5 +156,17 @@
     (testing "All peers got a roughly even number of tasks assigned"
       (peer-fairness result-db n-peers n-jobs tasks-per-job))))

+(deftest big-cluster-few-jobs
+  (let [n-jobs 10
+        n-peers 200
+        tasks-per-job 3
+        result-db (run-cluster n-jobs n-peers)]
+
+    (testing "No tasks are left incomplete"
+      (task-completeness result-db))
+
+    (testing "No sequential task ever had more than 1 peer"
+      (task-safety result-db))))
+
 (run-tests 'onyx.coordinator.cluster-test)


Fix deprecation warning

Fix deprecation warning

--- electron_src/electron/core.cljs
+++ electron_src/electron/core.cljs
@@ -11,7 +11,7 @@
                         (clj->js {:width 800
                                   :height 600})))
   ; Path is relative to the compiled js file (main.js in our case)
-  (.loadUrl @main-window (str "file://" js/__dirname "/public/index.html"))
+  (.loadURL @main-window (str "file://" js/__dirname "/public/index.html"))
   (.on @main-window "closed" #(reset! main-window nil)))

 (.start crash-reporter)


Latest ClojureScript

Latest ClojureScript

--- Clojure/project.clj
+++ Clojure/project.clj
@@ -3,8 +3,8 @@
   :url "https://github.com/omcljs/ambly"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.7.0-beta1"]
-                 [org.clojure/clojurescript "0.0-3211"]
+  :dependencies [[org.clojure/clojure "1.7.0-beta2"]
+                 [org.clojure/clojurescript "0.0-3246"]
                  [com.github.rickyclarkson/jmdns "3.4.2-r353-1"]]
   :source-paths ["src"]
   :main ambly.repl.jsc)


fix lein

fix lein

--- stow/lein/.lein/profiles.clj
+++ stow/lein/.lein/profiles.clj
@@ -1,7 +1,7 @@
 {:user {:dependencies [[org.clojure/tools.namespace "1.1.0"]]

         :plugins [[lein-ancient "1.0.0-RC3"]
-                  [com.jakemccrary/lein-test-refresh "0.25.t"]
+                  [com.jakemccrary/lein-test-refresh "0.25.0"]
                   [nrepl "0.9.0-beta5"]
                   [cljfmt "0.8.0"]
                   [cider/cider-nrepl "0.27.2"]


WIP refine routes

WIP refine routes

--- src/clj/clj_money/web/server.clj
+++ src/clj/clj_money/web/server.clj
@@ -48,133 +48,139 @@
             [clj-money.web.users :as users]
             [clj-money.web.grants :as grants]))

+(defmacro model-route
+  [method path handler]
+  `(~method ~path req# (-> ~handler
+                           wrap-models
+                           wrap-integer-id-params)))
+
 (defroutes protected-routes
   ; Entities
-  (GET  "/entities"            req entities/index)
-  (GET  "/entities/new"        req entities/new-entity)
-  (POST "/entities"            req entities/create-entity)
-  (GET  "/entities/:id/edit"   req entities/edit-entity)
-  (POST "/entities/:id"        req entities/update)
-  (POST "/entities/:id/delete" req entities/delete)
+  (model-route GET "/entities" entities/index)
+  (model-route GET "/entities/new" entities/new-entity)
+  (model-route POST "/entities" entities/create-entity)
+  (model-route GET "/entities/:id/edit" entities/edit-entity)
+  (model-route POST "/entities/:id" entities/update)
+  (model-route POST "/entities/:id/delete" entities/delete)

   ; User grants
-  (GET  "/entities/:entity-id/grants"     req grants/index)
-  (GET  "/entities/:entity-id/grants/new" req grants/new-grant)
-  (POST "/entities/:entity-id/grants"     req grants/create)
-  (GET  "/grants/:id/edit"                req grants/edit)
-  (POST "/grants/:id"                     req grants/update)
-  (POST "/grants/:id/delete"              req grants/delete)
+  (model-route GET "/entities/:entity-id/grants" grants/index)
+  (model-route GET "/entities/:entity-id/grants/new" grants/new-grant)
+  (model-route POST "/entities/:entity-id/grants" grants/create)
+  (model-route GET "/grants/:id/edit" grants/edit)
+  (model-route POST "/grants/:id" grants/update)
+  (model-route POST "/grants/:id/delete" grants/delete)

   ; Accounts
-  (GET "/entities/:entity-id/accounts" req accounts/index)
-  (GET "/entities/:entity-id/accounts/new" req accounts/new-account)
-  (POST "/entities/:entity-id/accounts" req accounts/create)
-  (GET "/accounts/:id" req accounts/show)
-  (GET "/accounts/:id/edit" req accounts/edit)
-  (POST "/accounts/:id" req accounts/update)
-  (POST "/accounts/:id/delete" req accounts/delete)
+  (model-route GET "/entities/:entity-id/accounts" accounts/index)
+  (model-route GET "/entities/:entity-id/accounts/new" accounts/new-account)
+  (model-route POST "/entities/:entity-id/accounts" accounts/create)
+  (model-route GET "/accounts/:id" accounts/show)
+  (model-route GET "/accounts/:id/edit" accounts/edit)
+  (model-route POST "/accounts/:id" accounts/update)
+  (model-route POST "/accounts/:id/delete" accounts/delete)

   ; Budgets
-  (GET "/entities/:entity-id/budgets" req budgets/index)
-  (GET "/entities/:entity-id/budgets/new" req budgets/new-budget)
-  (POST "/entities/:entity-id/budgets" req budgets/create)
-  (GET "/budgets/:id/edit" req budgets/edit)
-  (POST "/budgets/:id" req budgets/update)
-  (POST "/budgets/:id/delete" req budgets/delete)
-  (GET "/budgets/:id" req budgets/show)
+  (model-route GET "/entities/:entity-id/budgets" budgets/index)
+  (model-route GET "/entities/:entity-id/budgets/new" budgets/new-budget)
+  (model-route POST "/entities/:entity-id/budgets" budgets/create)
+  (model-route GET "/budgets/:id/edit" budgets/edit)
+  (model-route POST "/budgets/:id" budgets/update)
+  (model-route POST "/budgets/:id/delete" budgets/delete)
+  (model-route GET "/budgets/:id" budgets/show)

   ; Budget items
-  (GET "/budgets/:budget-id/items/new/:method" req budgets/new-item)
-  (POST "/budgets/:budget-id/items" req budgets/create-item)
-  (GET "/budget-items/:id/edit/:method" req budgets/edit-item)
-  (POST "/budget-items/:id" req budgets/update-item)
-  (POST "/budget-items/:id/delete" req budgets/delete-item)
+  (model-route GET "/budgets/:budget-id/items/new/:method" budgets/new-item)
+  (model-route POST "/budgets/:budget-id/items" budgets/create-item)
+  (model-route GET "/budget-items/:id/edit/:method" budgets/edit-item)
+  (model-route POST "/budget-items/:id" budgets/update-item)
+  (model-route POST "/budget-items/:id/delete" budgets/delete-item)

   ; Budget monitors
-  (GET "/entities/:entity-id/monitors" req entities/monitors)
-  (POST "/entities/:entity-id/monitors" req entities/create-monitor)
-  (POST "/entities/:entity-id/monitors/:account-id/delete" req entities/delete-monitor)
+  (model-route GET "/entities/:entity-id/monitors" entities/monitors)
+  (model-route POST "/entities/:entity-id/monitors" entities/create-monitor)
+  (model-route POST "/entities/:entity-id/monitors/:account-id/delete" entities/delete-monitor)

   ; Commodities
-  (GET "/entities/:entity-id/commodities" req commodities/index)
-  (GET "/entities/:entity-id/commodities/new" req commodities/new-commodity)
-  (POST "/entities/:entity-id/commodities" req commodities/create)
-  (GET "/commodities/:id/edit" req commodities/edit)
-  (POST "/commodities/:id" req commodities/update)
-  (POST "/commodities/:id/delete" req commodities/delete)
+  (model-route GET "/entities/:entity-id/commodities" commodities/index)
+  (model-route GET "/entities/:entity-id/commodities/new" commodities/new-commodity)
+  (model-route POST "/entities/:entity-id/commodities" commodities/create)
+  (model-route GET "/commodities/:id/edit" commodities/edit)
+  (model-route POST "/commodities/:id" commodities/update)
+  (model-route POST "/commodities/:id/delete" commodities/delete)

   ; Prices
-  (GET "/commodities/:commodity-id/prices" req prices/index)
-  (GET "/commodities/:commodity-id/prices/new" req prices/new-price)
-  (POST "/commodities/:commodity-id/prices" req prices/create)
-  (POST "/commodities/:commodity-id/prices/fetch" req prices/fetch)
-  (POST "/entities/:entity-id/prices/fetch" req prices/fetch-all)
-  (POST "/prices/:id/delete" req prices/delete)
+  (model-route GET "/commodities/:commodity-id/prices" prices/index)
+  (model-route GET "/commodities/:commodity-id/prices/new" prices/new-price)
+  (model-route POST "/commodities/:commodity-id/prices" prices/create)
+  (model-route POST "/commodities/:commodity-id/prices/fetch" prices/fetch)
+  (model-route POST "/entities/:entity-id/prices/fetch" prices/fetch-all)
+  (model-route POST "/prices/:id/delete" prices/delete)

   ; Transactions
-  (GET "/entities/:entity-id/transactions" req transactions/index)
-  (GET "/entities/:entity-id/transactions/new" req transactions/new-transaction)
-  (POST "/entities/:entity-id/transactions" req transactions/create)
-  (GET "/transactions/:transaction-date/:id/edit" req transactions/edit)
-  (POST "/transactions/:transaction-date/:id" req transactions/update)
-  (POST "/transactions/:transaction-date/:id/delete" req transactions/delete)
+  (model-route GET "/entities/:entity-id/transactions" transactions/index)
+  (model-route GET "/entities/:entity-id/transactions/new" transactions/new-transaction)
+  (model-route POST "/entities/:entity-id/transactions" transactions/create)
+  (model-route GET "/transactions/:transaction-date/:id/edit" transactions/edit)
+  (model-route POST "/transactions/:transaction-date/:id" transactions/update)
+  (model-route POST "/transactions/:transaction-date/:id/delete" transactions/delete)

   ; Attachments
-  (GET "/transactions/:transaction-id/attachments" req attachments/index)
-  (GET "/transactions/:transaction-id/attachments" req attachments/index)
-  (GET "/transactions/:transaction-id/attachments/new" req attachments/new-attachment)
-  (POST "/transactions/:transaction-id/attachments" req attachments/create)
-  (GET "/attachments/:id/edit" req attachments/edit)
-  (POST "/attachments/:id" req attachments/update)
-  (POST "/attachments/:id/delete" req attachments/delete)
+  (model-route GET "/transactions/:transaction-id/attachments" attachments/index)
+  (model-route GET "/transactions/:transaction-id/attachments" attachments/index)
+  (model-route GET "/transactions/:transaction-id/attachments/new" attachments/new-attachment)
+  (model-route POST "/transactions/:transaction-id/attachments" attachments/create)
+  (model-route GET "/attachments/:id/edit" attachments/edit)
+  (model-route POST "/attachments/:id" attachments/update)
+  (model-route POST "/attachments/:id/delete" attachments/delete)

   ; Images
-  (GET "/images/:image-id" req images/show)
+  (model-route GET "/images/:image-id" images/show)

   ; Trading
-  (GET "/accounts/:account-id/purchases/new" req trading/new-purchase)
-  (POST "/accounts/:account-id/purchases" req trading/purchase)
-  (GET "/accounts/:account-id/sales/new" req trading/new-sale)
-  (POST "/accounts/:account-id/sales" req trading/sell)
-  (POST "/transactions/:transaction-id/unbuy" req trading/unbuy)
+  (model-route GET "/accounts/:account-id/purchases/new" trading/new-purchase)
+  (model-route POST "/accounts/:account-id/purchases" trading/purchase)
+  (model-route GET "/accounts/:account-id/sales/new" trading/new-sale)
+  (model-route POST "/accounts/:account-id/sales" trading/sell)
+  (model-route POST "/transactions/:transaction-id/unbuy" trading/unbuy)

   ; Lots
-  (GET "/accounts/:account-id/lots" req lots/index)
+  (model-route GET "/accounts/:account-id/lots" lots/index)

   ; Reconciliations
-  (GET "/accounts/:account-id/reconciliations/new" req reconciliations/new-reconciliation)
-  (POST "/accounts/:account-id/reconciliations" req reconciliations/create)
-  (GET "/reconciliations/:id" req reconciliations/show)
-  (GET "/reconciliations/:id/edit" req reconciliations/edit)
-  (POST "/reconciliations/:id" req reconciliations/update)
-  (POST "/reconciliations/:id/delete" req reconciliations/delete)
+  (model-route GET "/accounts/:account-id/reconciliations/new" reconciliations/new-reconciliation)
+  (model-route POST "/accounts/:account-id/reconciliations" reconciliations/create)
+  (model-route GET "/reconciliations/:id" reconciliations/show)
+  (model-route GET "/reconciliations/:id/edit" reconciliations/edit)
+  (model-route POST "/reconciliations/:id" reconciliations/update)
+  (model-route POST "/reconciliations/:id/delete" reconciliations/delete)

   ; Imports
-  (GET "/imports/new" req imports/new-import)
+  (model-route GET "/imports/new" imports/new-import)

   ; Reports
-  (GET "/entities/:entity-id/reports" req reports/render)
-  (GET "/entities/:entity-id/reports/:type" req reports/render)
+  (model-route GET "/entities/:entity-id/reports" reports/render)
+  (model-route GET "/entities/:entity-id/reports/:type" reports/render)

   ; Single page apps
-  (GET "/apps" req apps/index)
-  (GET "/apps/:id" req apps/show))
+  (model-route GET "/apps" apps/index)
+  (model-route GET "/apps/:id" apps/show))

 (defroutes api-routes
-  (GET "/api/entities" req entities-api/index)
-  (DELETE "/api/entities/:id" req entities-api/delete)
+  (model-route GET "/api/entities" entities-api/index)
+  (model-route DELETE "/api/entities/:id" entities-api/delete)

   ; Imports
-  (POST "/api/imports" req imports-api/create)
-  (GET "/api/imports/:id" req imports-api/show))
+  (model-route POST "/api/imports" imports-api/create)
+  (model-route GET "/api/imports/:id" imports-api/show))

 (defroutes open-routes
-  (GET "/" req pages/home)
-  (GET "/login" req pages/login)
-  (GET "/signup" req users/new-user)
-  (POST "/users" req users/create-user)
-  (GET "/users/:token/password" req users/new-password)
-  (POST "/users/:token/password" req users/set-password))
+  (model-route GET "/" pages/home)
+  (model-route GET "/login" pages/login)
+  (model-route GET "/signup" users/new-user)
+  (model-route POST "/users" users/create-user)
+  (model-route GET "/users/:token/password" users/new-password)
+  (model-route POST "/users/:token/password" users/set-password))

 (def ^:private accept-map
   {"application/json" :json})
@@ -205,16 +211,12 @@
 (defroutes app
   (-> (routes open-routes
               (-> protected-routes
-                  wrap-models
-                  wrap-integer-id-params
                   wrap-multipart-params
                   wrap-keyword-params
                   wrap-params
                   (friend/wrap-authorize #{:user})
                   wrap-authenticate)
               (-> api-routes
-                  wrap-models
-                  wrap-integer-id-params
                   wrap-json-response
                   wrap-keyword-params
                   wrap-json-params


fix ns reference

fix ns reference

--- src/clj/clj_money/web/server.clj
+++ src/clj/clj_money/web/server.clj
@@ -30,7 +30,7 @@
                                           wrap-exception-handling]]
             [clj-money.api.imports :as imports-api]
             [clj-money.api.entities :as entities-api]
-            [clj-money.api.entities :as commodities-api]
+            [clj-money.api.commodities :as commodities-api]
             [clj-money.web.pages :as pages]
             [clj-money.web.entities :as entities]
             [clj-money.web.images :as images]


Check for installed Console when installing a Console

--- src/clj/game/core-installing.clj
+++ src/clj/game/core-installing.clj
@@ -163,9 +163,11 @@
 ;;; Installing a runner card
 (defn- runner-can-install?
   "Checks if the specified card can be installed.
-  Uses uniqueness of card"
+   Checks uniqueness of card and installed console"
   [state side {:keys [uniqueness] :as card} facedown]
   (and (or (not uniqueness) (not (in-play? state card)) facedown) ; checks uniqueness
+       (or (not (has-subtype? card "Console"))
+           (not (some #(has-subtype? % "Console") (all-installed state :runner)))) ; console check
        (if-let [req (:req (card-def card))]
          (or facedown (req state side card nil)) ; checks req for install
          true)))


fix compile error

fix compile error

--- src/clj/hsm/controllers/user.clj
+++ src/clj/hsm/controllers/user.clj
@@ -81,7 +81,7 @@
       (do
         (future (gh/find-n-update db id conf))
         (Thread/sleep 2000)
-        (if is-json?
+        (if is-json
           (redirect (format "/user2/%s?json=1" id))
           (redirect (str "/user2/" id))))
         ; (json-resp {:ok 1})


compile fixes

compile fixes

--- src/clj/shale/node_providers.clj
+++ src/clj/shale/node_providers.clj
@@ -96,9 +96,9 @@
 (defrecord KubeNodeProvider [api-url]
   INodeProvider
   (get-nodes [this]
-    (assert (map? label))
-    (assert (= 1 (count label)))
     (let [label (:kube/label this)
+          _ (assert (map? label))
+          _ (assert (= 1 (count label)))
           label-key (-> label first key)
           label-value (-> label first val)]
       (->> (kube/list-pods api-url {:namespace (or (:kube/namespace this) "default")})


move pending badges to my badges pages

move pending badges to my badges pages

--- src/cljs/salava/badge/ui/my.cljs
+++ src/cljs/salava/badge/ui/my.cljs
@@ -18,7 +18,8 @@
     [salava.core.ui.badge-grid :refer [badge-grid-element]]
     [clojure.walk :refer [keywordize-keys]]
     [cemerick.url :as url]
-    [salava.core.ui.modal :as mo]))
+    [salava.core.ui.modal :as mo]
+    [salava.social.ui.stream :refer [badge-pending badges-pending]]))

 (defn init-data
@@ -28,7 +29,11 @@
      {:handler (fn [data]
                  (swap! state assoc :badges (filter #(= "accepted" (:status %)) data)
                         :pending () ;(filter #(= "pending" (:status %)) data)
-                        :initializing false))})))
+                        :initializing false))})
+   (ajax/GET
+     (path-for "/obpv1/social/pending_badges" true)
+     {:handler (fn [data]
+                 (swap! state assoc :spinner false :pending-badges (:pending-badges data)))})))

 (defn visibility-select-values []
   [{:value "all" :title (t :core/All)}
@@ -121,11 +126,12 @@
                                             [:i {:class "fa fa-cog fa-spin fa-2x "}]
                                             [:span (str (t :core/Loading) "...")]]
                                            [:div
-                                            [badge-grid-form state]
+                                            (if (seq (:pending-badges @state)) [badges-pending state]
+                                              [badge-grid-form state])
                                             (cond
                                               (not-activated?) (not-activated-banner)
                                               ;(empty? (:badges @state)) [no-badges-text]
-                                              :else [badge-grid state])]
+                                              :else (when-not (seq (:pending-badges @state)) [badge-grid state]))]
                                            )])
                  :component-did-mount (fn [] (if (:init-id @state) (open-modal (:init-id @state) state)))}))


Change test exception to `Throwable`

Change test exception to `Throwable`

This ensures that we are correctly handling `Error`s, as well as `Exception`s.

--- test/puppetlabs/trapperkeeper/shutdown_test.clj
+++ test/puppetlabs/trapperkeeper/shutdown_test.clj
@@ -100,7 +100,7 @@
                                      (init [this context]
                                            (shutdown-on-error
                                              :ShutdownTestService
-                                             #(throw (RuntimeException. "oops")))
+                                             #(throw (Throwable. "oops")))
                                            context)
                                      (stop [this context]
                                            (reset! shutdown-called? true)
@@ -108,7 +108,7 @@
           app                (bootstrap-services-with-empty-config [test-service])
           main-thread        (future (tk/run-app app))]
       (is (thrown-with-msg?
-            java.util.concurrent.ExecutionException #"java.lang.RuntimeException: oops"
+            java.util.concurrent.ExecutionException #"java.lang.Throwable: oops"
             (deref main-thread)))
       (is (true? @shutdown-called?))))


Fixed test for consistency with Clojure 1.2.1 class naming requirement.

--- test/test/appengine_magic/services/memcache.clj
+++ test/test/appengine_magic/services/memcache.clj
@@ -8,7 +8,7 @@

 (deftest stats
-  (is (= (appengine-magic.services.memcache.Statistics. 0 0 0 0 0 0)
+  (is (= (appengine_magic.services.memcache.Statistics. 0 0 0 0 0 0)
          (memcache/statistics))))


Fix #69 Retry WebDAV with exp backoff

Fix #69 Retry WebDAV with exp backoff

--- Clojure/src/ambly/repl/jsc.clj
+++ Clojure/src/ambly/repl/jsc.clj
@@ -244,14 +244,22 @@
          (string? endpoint-address) (number? endpoint-port)]}
   (let [webdav-mount-point (str "/Volumes/Ambly-" (format "%08X" (hash bonjour-name)))
         output-dir (io/file webdav-mount-point)
-        webdav-endpoint (str "http://" endpoint-address ":" endpoint-port)]
-    (when (.exists output-dir)
-      (sh "umount" webdav-mount-point)
-      (Thread/sleep 250))
-    (.mkdirs output-dir)
-    (if (zero? (sh "mount_webdav" webdav-endpoint webdav-mount-point))
-      (reset! (:webdav-mount-point repl-env) webdav-mount-point)
-      (throw (Exception. (str "Unable to mount WebDAV at " webdav-endpoint))))
+        webdav-endpoint (str "http://" endpoint-address ":" endpoint-port)
+        unmount-if #(if (.exists output-dir)
+                     (if-not (<= 0 (sh "umount" webdav-mount-point) 1)
+                       (throw (IOException. (str "Unable to unmount previous WebDAV mount at " webdav-mount-point)))))]
+    (unmount-if)
+    (loop [tries 1]
+      (if-not (or (.exists output-dir) (.mkdirs output-dir))
+        (throw (IOException. (str "Unable to create WebDAV mount point " webdav-mount-point))))
+      (if (zero? (sh "mount_webdav" webdav-endpoint webdav-mount-point))
+        (reset! (:webdav-mount-point repl-env) webdav-mount-point)
+        (if (= 4 tries)
+          (throw (IOException. (str "Unable to mount WebDAV at " webdav-endpoint)))
+          (do
+            (unmount-if)
+            (Thread/sleep (* tries 500))
+            (recur (inc tries))))))
     webdav-mount-point))

 (defn- set-up-socket


Added make-fuzzy-context-from-matrix

Added make-fuzzy-context-from-matrix

for interface consistency.

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

--- src/conexp/contrib/fuzzy/fca.clj
+++ src/conexp/contrib/fuzzy/fca.clj
@@ -33,9 +33,17 @@

 (defmethod make-fuzzy-context [clojure-coll clojure-coll clojure-coll]
   [objects attributes values]
-  (when-not (forall [v values] (and (number? v) (<= 0 v 1)))
-    (illegal-argument "Given value table does not contain of real values between 0 and 1."))
-  (make-mv-context-from-matrix objects attributes values))
+  (let [mv-ctx (make-mv-context-from-matrix objects attributes values)]
+    (when-not (forall [[_ v] (incidence mv-ctx)] (and (number? v) (<= 0 v 1)))
+      (illegal-argument "Given value table does not contain of real values between 0 and 1."))
+    mv-ctx))
+
+(defn make-fuzzy-context-from-matrix
+  "Creates a fuzzy context from the given (number of) objects, (number
+  of) attributes and the value table, which must contain only real
+  values between 0 and 1."
+  [objects attributes values]
+  (make-fuzzy-context objects attributes values))

 ;;;


more specified tasks, future features

more specified tasks, future features

--- src/tic-tac-toe.clj
+++ src/tic-tac-toe.clj
@@ -6,17 +6,29 @@
 (use '[clojure.string :only (join)])

 ;; 2 players: X, O
+;; 1 plane 2d array with 9 places (3 x 3)

 ;; 1 random how start: x or o
 ;; 2 show clear table
 ;; 3 get player input: where to put its char
-;; 4 check if player win
+;; 3.1 check if position is empty? -> if not print "error" and get next valid input from player
+;; 4 check if player win: check horizontal line, vertical, cross
+;; 4.1 if win then print: player x|o win!
+;; 4.2 if there ar not empty
+
+;; player vs player
+
+;; player vs AI:
+;; 0 - put at random first empty
+;; 1 - algorithm - think where is best to place char
+
+;; next: change it to desktop app (use Java forms)

 ;; todo: TDD

-(def array [[nil nil nil]
-            [nil nil nil]
+(def array [[\o nil nil]
+            [nil \x nil]
             [nil nil nil]])

 ;; (def arry (make-array Integer/TYPE 3 3))


Adapt uxbox code to storage app ns renaming.

--- src/uxbox/media.clj
+++ src/uxbox/media.clj
@@ -10,8 +10,8 @@
             [clojure.java.io :as io]
             [cuerdas.core :as str]
             [storages.core :as st]
-            [storages.fs :refer (filesystem)]
-            [storages.misc :refer (hashed scoped)]
+            [storages.fs.local :refer (filesystem)]
+            [storages.fs.misc :refer (hashed scoped)]
             [uxbox.config :refer (config)]))

 ;; --- State


Added support for generating words based on other words.

Fixes #42.

--- src/hxgm30/language/gen/core.clj
+++ src/hxgm30/language/gen/core.clj
@@ -1,5 +1,6 @@
 (ns hxgm30.language.gen.core
   (:require
+    [hxgm30.common.util :as util]
     [hxgm30.language.gen.impl.markov :as markov]
     [hxgm30.language.gen.impl.syntagmata :as syntagmata])
   (:import
@@ -49,3 +50,83 @@
   (case type
     :markov (markov/create-content-generator system)
     :syntagmata (syntagmata/create-content-generator system)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;   Non-system-using functions   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn eat [data]
+  (loop [d (map identity data)
+         acc [d]]
+    (if (= (count d) 2)
+      acc
+      (let [nxt (vec (rest d))]
+        (recur nxt
+               (conj acc nxt))))))
+
+(defn simple-markov [word]
+  (reduce (fn [acc rem] (assoc acc (str (first rem)) (str (second rem))))
+          {}
+          (eat word)))
+
+(defn create-word-lookup [words-data]
+  "This function expects `words-data` to have a structure like the following:
+
+  ```
+  (def world
+    [{:word \"tunkasila\"
+      :weight 52}
+     {:word \"nuna\"
+      :weight 4}
+     {:word \"olor\"
+      :weight 3}
+     {:word \"shaoghal\"
+      :weight 3}
+     {:word \"arda\"
+      :weight 1}
+     {:word \"verǫld\"
+      :weight 13}
+     {:word \"maailma\"
+      :weight 2}
+     {:word \"delkhiin\"
+      :weight 5}
+     {:word \"sikul\"
+      :weight 5}
+     {:word \"honua\"
+      :weight 3}
+     {:word \"ao\"
+      :weight 9}])
+  ````
+  "
+  (reduce (partial util/frequency->percent-range total)
+          []
+          (map #(list (simple-markov (:word %)) (:weight %))
+               words-data)))
+
+(defn derive-word
+  "Given a data structure that's a list of words and their weights, synthesize
+  a new word based on the given words with word of higher weight contributed
+  their sounds more heavily to the generated word.
+
+  For the data structure, see the docstring of the `create-word-lookup`
+  function."
+  ([words-data]
+    (derive-word words-data (rand-int 10)))
+  ([words-data syllable-count]
+    (let [total (reduce + 0.0 (map :weight words-data))]
+      (apply str
+        (flatten
+          (map (fn [_] (rand-nth
+                        (vec
+                         (u/percent-> (rand)
+                                      (create-word-lookup words-data)))))
+               (range syllable-count)))))))
+
+(defn derive-words
+  ([words-data]
+    (derive-words words-data 10))
+  ([words-data word-count]
+    (map (fn [_] (derive-word words-data)) (range word-count)))
+  ([words-data word-count syllable-count]
+    (map (fn [_] (derive-word words-data syllable-count))
+         (range word-count))))


Remove :emit-fn option to compile-dispatch-table

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -461,9 +461,8 @@
       (map-traversal-dispatcher dispatch-map))))

 (def dispatch-table-compilation-defaults
-  {:async?              false
-   :build-handler-fn    build-map-traversal-handler
-   :emit-fn             eval})
+  {:async?           false
+   :build-handler-fn build-map-traversal-handler})

 (defn compile-dispatch-table
   "Compiles the dispatch table into a Ring handler.
@@ -484,26 +483,18 @@
      docstring of analyse-dispatch-table for a description of these)
      and apply-middleware-fn. Should produce a value that can be
      passed to emit-fn; this might be a Ring handler or a Clojure form
-     evaluating to a Ring handler.
-
-   - emit-fn (eval):
-
-     Called with the output of build-handler-fn. When using
-     build-handler-fns that return Clojure forms, passing in
-     pprint-code instead of eval is useful for debugging purposes."
+     evaluating to a Ring handler."
   ([dispatch-table]
      (compile-dispatch-table
        dispatch-table-compilation-defaults
        dispatch-table))
   ([options dispatch-table]
      (let [options          (merge dispatch-table-compilation-defaults options)
-           emit-fn          (:emit-fn options)
            build-handler    (:build-handler-fn options)

            analysed-dispatch-table (analyse-dispatch-table dispatch-table)]
-       (emit-fn
-         (build-handler analysed-dispatch-table
-           (select-keys options [:async?]))))))
+       (build-handler analysed-dispatch-table
+         (select-keys options [:async?])))))

 (defn default-middleware [handler]
   (-> handler


Use postwalk so we can handle tags inside of vectors

--- src/aero/core.clj
+++ src/aero/core.clj
@@ -4,7 +4,7 @@
   (:require [clojure
              [edn :as edn]
              [string :refer [trim]]
-             [walk :refer [walk]]]
+             [walk :refer [walk postwalk]]]
             [clojure.java
              [io :as io]
              [shell :as sh]]
@@ -60,12 +60,17 @@
   [opts tag value]
   (read-config value opts))

+(defmethod reader 'path
+  [opts tag value]
+  (with-meta value {::tag 'path}))
+
 (defmethod transform 'path
   [opts tag config-map]
-  (walk (fn [v]
-          (if (= 'path (::tag (meta (second v))))
-            (update-in v [1] (fn [link] (get-in config-map link)))
-            v)) identity config-map))
+  (postwalk (fn [v]
+              (if (= 'path (::tag (meta v)))
+                (get-in config-map v)
+                v))
+            config-map))

 (defmethod transform 'schema
   [opts tag config-map]


Return timeout-ch from ago-timeout.

Return timeout-ch from ago-timeout.

--- src/ago/core.cljs
+++ src/ago/core.cljs
@@ -45,7 +45,7 @@
            :logical-ms 0      ; Logical time/msecs, which is always updated
            :physical-ms (now) ; at the same time as physical-ms time snapshot.
            :timeouts (sorted-map) ; Keyed by logical-ms => '(timeout-ch ...).
-           })))
+           })))                   ; TODO: The :closed map needs GC.

 (defn seqv+ [ago-world-now]
   (if (zero? (:logical-speed ago-world-now)) ; No seqv inc when at zero speed.
@@ -323,42 +323,6 @@

 ; --------------------------------------------------------

-(defn copy-sma-map [sma-map] ; Copy a hash-map of <buf-id => state-machine-array>.
-  (apply hash-map (mapcat (fn [[buf-id sma]] [buf-id (aclone sma)])
-                          sma-map)))
-
-(defn ago-snapshot [ago-world]
-  (let [ago-world-now @ago-world]
-    (-> ago-world-now ; The mutable sma's need explicit cloning.
-        (assoc :smas (copy-sma-map (:smas ago-world-now)))
-        (assoc :smas-new (copy-sma-map (:smas-new ago-world-now))))))
-
-(defn ago-restore [ago-world snapshot]
-    (let [ss (ago-snapshot (atom snapshot)) ; Re-snapshot so snapshot stays immutable.
-          [recycled-smas reborn-smas] (ago-judge-state-machines (:bufs ss)
-                                                                (:smas ss)
-                                                                (:smas @ago-world))
-          [recycled-smasN reborn-smasN] (ago-judge-state-machines (:bufs ss)
-                                                                  (:smas-new ss)
-                                                                  (:smas-new @ago-world))
-          branch-id (- ((:gen-id @ago-world)))] ; Negative in case snapshot re-restored.
-      (swap! ago-world
-             #(-> %
-                  (assoc :seqv (conj (:seqv ss) branch-id 0))
-                  (assoc :bufs (:bufs ss))
-                  (assoc :smas recycled-smas)
-                  (assoc :smas-new recycled-smasN)
-                  (assoc :closed (:closed ss))
-                  (assoc :logical-ms (:logical-ms ss))
-                  (assoc :physical-ms (now))))
-      (doseq [[sma-old ss-buf-id] reborn-smas]
-        (ago-revive-state-machine ago-world sma-old ss-buf-id))
-      (doseq [[sma-old ss-buf-id] reborn-smasN]
-        (ago-revive-state-machine ago-world sma-old ss-buf-id))
-      ago-world))
-
-; --------------------------------------------------------
-
 (def curr-js-timeout-id (atom nil)) ; Value is nil or js-timeout-id.

 (defn timeout-handler [ago-world]
@@ -374,11 +338,11 @@
                               (protocols/close! ch))
                             (recur (dissoc timeouts soonest-ms)))
                         timeouts)))]
+    (swap! ago-world #(assoc % :timeouts timeouts2))
     (when-let [[soonest-ms chs] (first timeouts2)]
-      (reset! curr-js-timeout-id
-              (js/setTimeout #(timeout-handler ago-world)
-                             (- soonest-ms logical-ms))))
-    (swap! ago-world #(assoc % :timeouts timeouts2))))
+      (let [tid (js/setTimeout (fn [] (timeout-handler ago-world))
+                               (- soonest-ms logical-ms))]
+        (reset! curr-js-timeout-id tid)))))

 (defn ago-timeout [ago-world delay-ms] ; Logical milliseconds from now.
   (let [timeout-at (+ delay-ms (:logical-ms @ago-world))
@@ -389,4 +353,42 @@
                        (fn [m] (assoc m timeout-at ; to provide snapshot'ability.
                                       (conj (get-in % [:timeouts timeout-at])
                                             timeout-ch)))))
-    (timeout-handler ago-world)))
+    (timeout-handler ago-world)
+    timeout-ch))
+
+; --------------------------------------------------------
+
+(defn copy-sma-map [sma-map] ; Copy a hash-map of <buf-id => state-machine-array>.
+  (apply hash-map (mapcat (fn [[buf-id sma]] [buf-id (aclone sma)]) sma-map)))
+
+(defn ago-snapshot [ago-world]
+  (let [ago-world-now @ago-world]
+    (-> ago-world-now ; The mutable sma's need explicit cloning.
+        (assoc :smas (copy-sma-map (:smas ago-world-now)))
+        (assoc :smas-new (copy-sma-map (:smas-new ago-world-now))))))
+
+(defn ago-restore [ago-world snapshot]
+    (let [ss (ago-snapshot (atom snapshot)) ; Re-snapshot so snapshot stays immutable.
+          [recycled-smas reborn-smas] (ago-judge-state-machines (:bufs ss)
+                                                                (:smas ss)
+                                                                (:smas @ago-world))
+          [recycled-smasN reborn-smasN] (ago-judge-state-machines (:bufs ss)
+                                                                  (:smas-new ss)
+                                                                  (:smas-new @ago-world))
+          branch-id (- ((:gen-id @ago-world)))] ; Negative in case snapshot re-restored.
+      (swap! ago-world #(-> %
+                            (assoc :seqv (conj (:seqv ss) branch-id 0))
+                            (assoc :bufs (:bufs ss))
+                            (assoc :smas recycled-smas)
+                            (assoc :smas-new recycled-smasN)
+                            (assoc :closed (:closed ss))
+                            (assoc :logical-ms (:logical-ms ss))
+                            (assoc :physical-ms (now))
+                            (assoc :timeouts (:timeouts ss))))
+      (doseq [[sma-old ss-buf-id] reborn-smas]
+        (ago-revive-state-machine ago-world sma-old ss-buf-id))
+      (doseq [[sma-old ss-buf-id] reborn-smasN]
+        (ago-revive-state-machine ago-world sma-old ss-buf-id))
+      (when (seq (:timeouts @ago-world))
+        (timeout-handler ago-world))
+      ago-world))


Fix `assoc` for `HashCollisionNode`

Fix `assoc` for `HashCollisionNode`

`assoc`was only using code for persistent changes not transient ones

--- src/main/cljs/lean_map/core.cljs
+++ src/main/cljs/lean_map/core.cljs
@@ -248,20 +248,42 @@
                             ^:mutable cnt
                             ^:mutable arr]
   Object
-  (inode-assoc [inode hedit shift hash key val added-leaf?]
+  (persistent-inode-assoc [inode idx hedit key val changed?]
+    (if (== idx -1)
+      (let [len     (* 2 cnt)
+            new-arr (make-array (+ len 2))]
+        (array-copy arr 0 new-arr 0 len)
+        (aset new-arr len key)
+        (aset new-arr (inc len) val)
+        (set! (.-added changed?) true)
+        (set! (.-modified changed?) true)
+        (HashCollisionNode. hedit collision-hash (inc cnt) new-arr))
+      (if (= (aget arr idx) val)
+        inode
+        (do
+          (set! (.-modified changed?) true)
+          (HashCollisionNode. hedit collision-hash cnt (clone-and-set arr (inc idx) val))))))
+
+  (mutable-inode-assoc [inode idx key val changed?]
+    (if (== idx -1)
+      (let [new-arr (make-array (* 2 (inc cnt)))]
+        (array-copy arr 0 new-arr 0 (* 2 cnt))
+        (aset arr (* 2 cnt) key)
+        (aset arr (inc (* 2 cnt)) val)
+        (set! (.-added changed?) true)
+        (set! (.-modified changed?) true)
+        (set! cnt (inc cnt)))
+      (when-not (identical? (aget arr (inc idx)) val)
+        (set! (.-modified changed?) true)
+        (aset arr (inc idx) val)))
+    inode)
+
+  (inode-assoc [inode hedit _ hash key val changed?]
     (assert (== hash collision-hash))
     (let [idx (hash-collision-node-find-index arr cnt key)]
-      (if (== idx -1)
-        (let [len     (* 2 cnt)
-              new-arr (make-array (+ len 2))]
-          (array-copy arr 0 new-arr 0 len)
-          (aset new-arr len key)
-          (aset new-arr (inc len) val)
-          (set! (.-val added-leaf?) true)
-          (HashCollisionNode. nil collision-hash (inc cnt) new-arr))
-        (if (= (aget arr idx) val)
-          inode
-          (HashCollisionNode. nil collision-hash cnt (clone-and-set arr (inc idx) val))))))
+      (if ^boolean (can-edit edit hedit)
+        (.mutable-inode-assoc inode idx key val changed?)
+        (.persistent-inode-assoc inode idx hedit key val changed?))))

   (has-nodes? [_]
     false)


just use Thread.toString

just use Thread.toString

--- src/bzzz/core.clj
+++ src/bzzz/core.clj
@@ -140,7 +140,7 @@
       :get (case uri
              "/_stat" (stat)
              "/_stack" (into {} (for [[^Thread t traces] (Thread/getAllStackTraces)]
-                                  [(str (.getName t) "@" (.getId t) "-" (.toString ^Thread$State (.getState t)))
+                                  [(str (.toString t) "-" (.toString ^Thread$State (.getState t)))
                                    (into [] (for [^StackTraceElement s traces]
                                               (.toString s)))]))
              "/favicon.ico" "" ;; XXX


Add missing import for clj version.

Add missing import for clj version.

--- src/octet/core.cljc
+++ src/octet/core.cljc
@@ -26,7 +26,9 @@
   (:refer-clojure :exclude [read byte float double short long bytes into repeat])
   (:require [octet.spec :as spec]
             #?(:cljs
-               [octet.util :as util :include-macros true])
+               [octet.util :as util :include-macros true]
+               :clj
+               [octet.util :as util])
             [octet.spec.basic :as basic-spec]
             [octet.spec.string :as string-spec]
             [octet.spec.collections :as coll-spec]


range check

range check

--- web/celestial/models/system.clj
+++ web/celestial/models/system.clj
@@ -1,14 +1,21 @@
 (ns celestial.models.system
   "System model for the frontend"
-  (:require [celestial.persistency :as p]))
+  (:require
+    [slingshot.slingshot :refer [throw+]]
+    [clojure.core.strint :refer  (<<)]
+    [celestial.persistency :as p]))

 (defn systems
-   "system list range"
-   [from to]
-   (map (juxt identity p/get-system ) (subvec (into [] (p/all-systems)) from to)))
+  "system list range"
+  [from to]
+  {:pre [(> from -1)]}
+  (let [systems (into [] (p/all-systems))]
+    (if (and (contains? systems from) (contains? systems to))
+      (map (juxt identity p/get-system) (subvec systems from to))
+      (throw+ {:type ::non-legal-range :message (<<  "No legal systems in range ~{from}:~{to} try between ~{0}:~(count systems)")}))))

 (defn systems-count
   "How many systems there are"
-   []
+  []
   (count (p/all-systems)))


Bump query timeout for BigQuery a bit :scream_cat:

--- src/metabase/driver/bigquery.clj
+++ src/metabase/driver/bigquery.clj
@@ -182,10 +182,11 @@
    "TIMESTAMP" parse-timestamp-str})

 (def ^:private ^:const query-timeout-error-message "Query timed out.")
+(def ^:private ^:const query-default-timeout-seconds 30)

 (defn- post-process-native
   ([^QueryResponse response]
-   (post-process-native response 20))
+   (post-process-native response query-default-timeout-seconds))
   ([^QueryResponse response, ^Integer timeout-seconds]
    (if-not (.getJobComplete response)
      ;; 99% of the time by the time this is called `.getJobComplete` will return `true`. On the off chance it doesn't, wait a few seconds for the job to finish.


keywordize pusher keys

keywordize pusher keys

--- src-cljs/frontend/config.cljs
+++ src-cljs/frontend/config.cljs
@@ -17,7 +17,7 @@
   ;;TODO Delete this if-let when https://github.com/circleci/circle/pull/3972 is fully deployed.
   (if-let [app-key (aget js/window "renderContext" "pusherAppKey")]
     {:key app-key}
-    (js->clj (aget js/window "renderContext" "pusher"))))
+    (js->clj (aget js/window "renderContext" "pusher") :keywordize-keys true)))

 (defn logging-enabled?
   []


only non-merge commits are processed now

--- src-clj/acha/dispatcher.clj
+++ src-clj/acha/dispatcher.clj
@@ -16,14 +16,15 @@
 (defn- analyze-commit [repo commit df]
   (try
     (let [commit-info (git-parser/commit-info repo commit df)]
-      (->> (for [[code scanner] achievement/all-commit-info-scanners
+      (when (not (:merge commit-info))
+        (->> (for [[code scanner] achievement/all-commit-info-scanners
                  :let [report (scan-achievement scanner commit-info)]
                  :when report]
              [[(:email commit-info) code] (-> report
                                             (assoc-in [:author :email] (:email commit-info))
                                             (assoc-in [:author :name]  (:author commit-info))
                                             (assoc-in [:sha1] (:id commit-info)))])
-           (into {})))
+           (into {}))))
     (catch Exception e
       (logging/error e "Error occured during commit-info parsing" (.getName commit)))
     (finally )))


delete extra comment

delete extra comment

--- src-cljs/flatride/core.cljs
+++ src-cljs/flatride/core.cljs
@@ -59,7 +59,6 @@
                             (partial process-elevation-data display-elev-fn idx))))

 (defn parse-route [route]
-  ;; route.legs[0].distance // .duration
   (let [route-info (nth (.-legs route) 0)]
     {:distance (->> route-info .-distance .-text)
      :duration (->> route-info .-duration .-text)}))


Add -main back in

Add -main back in

--- src/net/sekao/nightcode/core.clj
+++ src/net/sekao/nightcode/core.clj
@@ -12,8 +12,8 @@
       (.setScene (Scene. root 800 600))
       (.show))))

-(defn -stop [app]
-  (println "Exiting"))
+(defn -main [& args]
+  (Application/launch net.sekao.nightcode.core (into-array String args)))

 (defn main [& args]
-  (Application/launch net.sekao.nightcode.core (into-array String args)))
+  (apply -main args))


Add docstring.

Add docstring.

--- src/onyx/peer/task_lifecycle.clj
+++ src/onyx/peer/task_lifecycle.clj
@@ -344,7 +344,9 @@
 (defn compile-fc-exs [flow-conditions task-name]
   (compile-flow-conditions flow-conditions task-name :flow/thrown-exception?))

-(defn run-task-lifecycle [init-event seal-ch kill-ch ex-f]
+(defn run-task-lifecycle
+  "The main task run loop, read batch, ack messages, etc."
+  [init-event seal-ch kill-ch ex-f]
   (try
     (while (first (alts!! [seal-ch kill-ch] :default true))
       (-> init-event


Reduce throughput to see if ZK sessions still expire.

--- src/onyx/plugin/bench_plugin.clj
+++ src/onyx/plugin/bench_plugin.clj
@@ -42,6 +42,7 @@
                                     :input :generator
                                     :message {:n n
                                               :data hundred-bytes}}))))]
+    (Thread/sleep 500)
     (doseq [m batch]
       (swap! pending-messages assoc (:id m) (:message m)))
     {:onyx.core/batch batch}))


Simplify protocol extension

Simplify protocol extension

--- src/rdf_path_examples/sparql.clj
+++ src/rdf_path_examples/sparql.clj
@@ -13,9 +13,8 @@

 (extend-protocol IStringifiableNode
   Literal
-  (node->clj [node] (.getValue node)))
-
-(extend-protocol IStringifiableNode
+  (node->clj [node] (.getValue node))
+
   Resource
   (node->clj [node] (str node)))


added server-side api for muting

added server-side api for muting

--- src/server/client-interface.cljs
+++ src/server/client-interface.cljs
@@ -175,6 +175,25 @@
             (fn []
               (.emit (.to io room) "set-loop" false)))))))

+  (.on socket "mute"
+    (fn []
+      (println "Socket id " (.-id socket) " is muted!")
+      (rooms/mute-user (.-id socket)
+        (fn []
+          (rooms/get-room-from-user-id (.-id socket)
+            (fn [room-id]
+              (.emit (.to io room-id) "user-muted" (.-id socket))))))))
+
+  (.on socket "unmute"
+    (fn []
+      (println "Socket id " (.-id socket) " is unmuted!")
+      (rooms/unmute-user (.-id socket)
+        (fn []
+          (rooms/get-room-from-user-id (.-id socket)
+            (fn [room-id]
+              (.emit (.to io room-id) "user-unmuted" (.-id socket))))))))
+
+
   (.on socket "track-complete"
     (fn []
       (println "Received track-complete signal from " (.-id socket))


Remove unused namespace

Remove unused namespace

--- examples/shopping-cart/assets/cljs/frontend/spec.cljs
+++ examples/shopping-cart/assets/cljs/frontend/spec.cljs
@@ -1,12 +0,0 @@
-(ns frontend.spec
-  (:require [clojure.spec :as s]))
-
-(s/def :item/name string?)
-(s/def :item/quantity int?)
-
-(s/def :cart/item (s/keys :req [:item/name :item/quantity]))
-
-(s/def :cart/items (s/coll-of :cart/item))
-
-(s/def ::cart (s/keys :req [::items]))
-


Modified tmp dir.

Modified tmp dir.

--- src/gbu/utils.clj
+++ src/gbu/utils.clj
@@ -6,7 +6,7 @@
   (-> s .toLowerCase (.replace "_" "-") keyword))

 (defn make-tmp-dir []
-  (let [dirname (str "/tmp/gbu-" (java.util.UUID/randomUUID))
+  (let [dirname (str "tmp/gbu-" (java.util.UUID/randomUUID))
         dir     (File. dirname)]
     (.mkdir dir)
     dirname))


Remove superfluous relay job init

Remove superfluous relay job init

--- test/engulf/test/control_test.clj
+++ test/engulf/test/control_test.clj
@@ -44,7 +44,8 @@
    "the start-edge method should be executed"
    (:start-edge @seen) => truthy)))

-(facts "about starting relay jobs"
+(facts
+ "about starting relay jobs"
  (watched-run
   seen
   (ctrl/start-job


[#1519] Update backend deps

[#1519] Update backend deps

--- backend/project.clj
+++ backend/project.clj
@@ -6,46 +6,46 @@
   :min-lein-version "2.0.0"
   :dependencies [[clojurewerkz/scrypt "1.2.0"]
                  [ch.qos.logback/logback-classic "1.2.3"]
-                 [org.clojure/tools.logging "0.4.0"]
+                 [org.clojure/tools.logging "0.4.1"]
                  [org.slf4j/log4j-over-slf4j "1.7.25"]
                  [org.slf4j/jcl-over-slf4j "1.7.25"]
                  [org.slf4j/jul-to-slf4j "1.7.25"]
                  [cheshire "5.8.0" :exclusions [com.fasterxml.jackson.core/jackson-core]]
-                 [clj-http "3.7.0" :exclusions [org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime]]
-                 [clj-time "0.14.2"]
-                 [com.layerware/hugsql "0.4.8"]
+                 [clj-http "3.9.0" :exclusions [org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime]]
+                 [clj-time "0.14.4"]
+                 [com.layerware/hugsql "0.4.9"]
                  [com.stuartsierra/component "0.3.2"]
                  [commons-io/commons-io "2.6"]
-                 [compojure "1.6.0" :exclusions [medley]]
+                 [compojure "1.6.1" :exclusions [medley]]
                  [duct "0.8.2"]
                  [duct/hikaricp-component "0.1.2" :exclusions [org.slf4j/slf4j-nop]]
                  [environ "1.1.0"]
                  [funcool/cuerdas "2.0.5"]
-                 [honeysql "0.9.1"]
+                 [honeysql "0.9.3"]
                  [meta-merge "1.0.0"]
                  [org.akvo/commons "0.4.5" :exclusions [org.postgresql/postgresql org.clojure/java.jdbc]]
                  [org.akvo/resumed "1.17.be5e74d2518253bb87ce087c15f5e04bd4b8b824"]
-                 [org.apache.tika/tika-core "1.17"]
-                 [org.apache.tika/tika-parsers "1.17" :exclusions [org.slf4j/slf4j-api com.fasterxml.jackson.core/jackson-core org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime]]
+                 [org.apache.tika/tika-core "1.18"]
+                 [org.apache.tika/tika-parsers "1.18" :exclusions [org.slf4j/slf4j-api com.fasterxml.jackson.core/jackson-core org.apache.httpcomponents/httpcore org.apache.httpcomponents/httpclient org.apache.httpcomponents/httpmime]]
                  ;; explicit versions of commons deps used by tika-parsers and clj-http
-                 [com.fasterxml.jackson.core/jackson-core "2.9.2"]
-                 [org.apache.httpcomponents/httpcore "4.4.7"]
-                 [org.apache.httpcomponents/httpclient "4.5.4"]
-                 [org.apache.httpcomponents/httpmime "4.5.4"]
+                 [com.fasterxml.jackson.core/jackson-core "2.9.6"]
+                 [org.apache.httpcomponents/httpcore "4.4.10"]
+                 [org.apache.httpcomponents/httpclient "4.5.5"]
+                 [org.apache.httpcomponents/httpmime "4.5.5"]

                  [org.clojure/clojure "1.9.0"]
                  [org.clojure/data.csv "0.1.4"]
                  [org.clojure/core.match "0.3.0-alpha5"]
-                 [org.clojure/java.jdbc "0.7.5"]
-                 [org.immutant/web "2.1.9" :exclusions [ch.qos.logback/logback-classic]]
-                 [org.postgresql/postgresql "42.2.1"]
+                 [org.clojure/java.jdbc "0.7.7"]
+                 [org.immutant/web "2.1.10" :exclusions [ch.qos.logback/logback-classic]]
+                 [org.postgresql/postgresql "42.2.2"]
                  [ragtime/ragtime.jdbc "0.6.4"]
-                 [raven-clj "1.5.1"]
+                 [raven-clj "1.5.2"]
                  [ring "1.6.3" :exclusions [ring/ring-core]]
                  [ring/ring-core "1.6.3"]
-                 [ring/ring-defaults "0.3.1"]
+                 [ring/ring-defaults "0.3.2"]
                  [ring/ring-json "0.4.0"]
-                 [selmer "1.11.5"]
+                 [selmer "1.11.8"]
                  [net.postgis/postgis-jdbc "2.2.1" :exclusions [org.postgresql/postgresql]]]
   :uberjar-name "akvo-lumen.jar"
   :repl-options {:timeout 120000}
@@ -77,7 +77,7 @@
                                     [reloaded.repl "0.2.4"]
                                     [org.clojure/tools.namespace "0.2.11"]
                                     [org.clojure/tools.nrepl "0.2.13"]
-                                    [eftest "0.4.1"]
+                                    [eftest "0.5.1"]
                                     [com.gearswithingears/shrubbery "0.4.1"]
                                     [kerodon "0.9.0"]]
                    :source-paths   ["dev/src"]


lein-release plugin: preparing 0.3.3 release

--- backend/project.clj
+++ backend/project.clj
@@ -1,4 +1,4 @@
-(defproject lambdaui "0.3.3-SNAPSHOT"
+(defproject lambdaui "0.3.3"
   :description "LambdaCD-Plugin that provides a modern UI for your pipeline."
   :url "https://github.com/sroidl/lambda-ui"
   :license {:name "Apache License 2.0"


first draft of classes view

first draft of classes view

--- src/tango/cljs/runtime/core.cljs
+++ src/tango/cljs/runtime/core.cljs
@@ -179,6 +179,58 @@
           )))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ClassRow
+
+(defui ClassRow
+  static om/IQuery
+  (query [_]
+    [:class/position :class/name :class/remaining :class/starting
+     {:class/rounds
+      [{:round/status ['*]}
+       {:round/type ['*]}]}
+     {:class/adjudicator-panel
+      [:adjudicator-panel/name]}
+     {:class/dances ['*]}])
+  Object
+  (render [this]
+    (log "ClassRow")
+    (log (:class/dances (om/props this)))
+    (let [{:keys [position name panel type starting status]}
+          (presentation/make-class-presenter (om/props this))]
+      (dom/tr nil
+        (dom/td nil position)
+        (dom/td nil name)
+        (dom/td nil panel)
+        (dom/td nil type)
+        (dom/td nil starting)
+        (dom/td nil status)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ClassesView
+(defui ClassesView
+  static om/IQuery
+  (query [_]
+    (into [] (om/get-query ClassRow)))
+  Object
+  (render
+    [this]
+    (let [classes (sort-by :class/position (om/props this))]
+      (dom/div nil
+        (dom/h2 {:className "sub-header"} "Klasser")
+        (dom/table
+          #js {:className "table"}
+          (dom/thead nil
+            (dom/tr nil
+              (dom/th #js {:width "20"} "#")
+              (dom/th #js {:width "200"} "Dansdisciplin")
+              (dom/th #js {:width "20"} "Panel")
+              (dom/th #js {:width "20"} "Typ")
+              (dom/th #js {:width "20"} "Startande")
+              (dom/th #js {:width "20"} "Status")))
+          (apply dom/tbody nil (map (om/factory ClassRow) classes)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Import/Export Component
 (defui ImportExportComponent
   static om/IQuery
@@ -229,14 +281,20 @@
   Object
   (render
     [this]
-    (let [p (om/props this)]
-      (dom/div nil
-        (dom/button #js {:onClick #(om/transact! this `[(app/select-page {:selected-page :home})
-                                                        :app/selected-page])} "Home")
-        (dom/button #js {:onClick #(om/transact! this `[(app/select-page {:selected-page :time-schedule})
-                                                        :app/selected-page])} "Time Schedule")
-        (dom/button #js {:onClick #(om/transact! this `[(app/select-page {:selected-page :clients})
-                                                        :app/selected-page])} "Clients")))))
+    (let [make-btn-fn
+          (fn [page-name page-key]
+            (dom/button #js {:onClick
+                             #(om/transact! this
+                                            `[(app/select-page {:selected-page ~page-key})
+                                              :app/selected-page])}
+                        page-name))]
+      (dom/div nil
+        (apply dom/div #js {:className "nav"}
+               (map (fn [[name key]] (make-btn-fn name key))
+                    [["Home" :home]
+                     ["Classes" :classes]
+                     ["Time Schedule" :time-schedule]
+                     ["Clients" :clients]]))))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Client Row
@@ -292,18 +350,6 @@
             ))
         ))))

-;

-;<button class="btn btn-default dropdown-toggle" type="button" id="menu1" data-toggle="dropdown">Tutorials
-;</button>
-;

-;
HTML

-;
CSS

-;
JavaScript

-;

-;
About Us

-;

-;

-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Clients View
 (defui ClientsView
@@ -335,12 +381,14 @@
 (defui MainComponent
   static om/IQuery
   (query [_]
-    [{:app/selected-competition (into [:competition/name :competition/location
-                                       {:competition/panels [:adjudicator-panel/name
-                                                             {:adjudicator-panel/adjudicators
-                                                              [:adjudicator/id
-                                                               :adjudicator/name]}]}]
-                                      (concat (om/get-query ScheduleView)))}
+    [{:app/selected-competition
+      (into [:competition/name :competition/location
+             {:competition/classes (om/get-query ClassesView)}
+             {:competition/panels [:adjudicator-panel/name
+                                   {:adjudicator-panel/adjudicators
+                                    [:adjudicator/id
+                                     :adjudicator/name]}]}]
+            (concat (om/get-query ScheduleView)))}
      :app/status
      :app/selected-page
      {:app/selected-activities [:activity/id] }
@@ -362,6 +410,8 @@
           :home (dom/div nil
                   (dom/h1 nil (str "Runtime of " (:competition/name selected-competition)))
                   ((om/factory AdminViewComponent) {:status status}))
+
+          :classes ((om/factory ClassesView) (:competition/classes selected-competition))

           :time-schedule ((om/factory ScheduleView) {:competition/activities
                                                      (:competition/activities selected-competition)


Check bounds when adding point to spatialtree.

--- src/thi/ng/geom/spatialtree.cljc
+++ src/thi/ng/geom/spatialtree.cljc
@@ -150,7 +150,9 @@
         ^:mutable bounds])

   g/ISpatialTree
-  (add-point [_ p d] (add-point* _ p d) _)
+  (add-point [_ p d]
+    (when (g/contains-point? (g/bounds _) p)
+      (add-point* _ p d) _))
   (delete-point [_ p] (delete-point* _ p))
   (get-point [_] point)
   (get-point-data [_] data)
@@ -228,7 +230,9 @@
         ^:mutable bounds])

   g/ISpatialTree
-  (add-point [_ p d] (add-point* _ p d) _)
+  (add-point [_ p d]
+    (when (g/contains-point? (g/bounds _) p)
+      (add-point* _ p d) _))
   (delete-point [_ p] (delete-point* _ p))
   (get-point [_] point)
   (get-point-data [_] data)


{:pred :wear} -> {:subj {:clothing true}}

--- src/babel/encyclopedia.cljc
+++ src/babel/encyclopedia.cljc
@@ -553,6 +553,18 @@

         {:pred :wash-oneself
          :subj {:living true}}
+
+        {:pred :wear
+         :subj {:clothing true}}
+
+        {:pred :wear-i
+         :subj {:clothing true}}
+
+        {:pred :wear-l
+         :subj {:clothing true}}
+
+        {:pred :wear-p
+         :subj {:clothing true}}

         {:pred :win
          :subj {:human true}


web: add some type annotations

web: add some type annotations

--- src/otto/web.clj
+++ src/otto/web.clj
@@ -1,11 +1,16 @@
 (ns otto.web
-  (:require [compojure.core     :as c]
+  (:require [clojure.core.typed :as t :refer :all]
+            [compojure.core     :as c]
             [ring.util.response :as r]))

+(def-alias State (HMap :complete? true :mandatory {:organizations (clojure.lang.IPersistentVector otto.organization.Organization)}))
+
+(ann make-state [(clojure.lang.IPersistentVector otto.organization.Organization) -> State])
 (defn- make-state
   [o]
   {:organizations o})

+(ann show-organization [State -> String])
 (defn- show-organization
   [s]
   (let [o (first (:organizations s))]
@@ -14,5 +19,5 @@
 (defn make-handler-fn
   [o]
   (let [s (make-state o)]
-    (c/defroutes main-routes
+    (c/defroutes web-routes
       (c/GET "/" [] (show-organization s)))))


Sample subselect.

Sample subselect.

--- src/cavm/h2.clj
+++ src/cavm/h2.clj
@@ -4,15 +4,21 @@
   (:require [org.clojars.smee.binary.core :as binary])
   (:require [clojure.java.io :as io])
   (:use [clj-time.format :only (formatter unparse)])
-  (:use korma.core)
-  (:gen-class))
-
-; H2 has one int type: signed, 4 byte. Max is approximately 2 billion.
-
-(def db {:classname "org.h2.Driver"
-         :subprotocol "h2"
-         :subname "file:///data/TCGA/craft/h2/cavm.h2"})
-
+  (:use korma.core))
+
+;(def db {:classname "org.h2.Driver"
+;         :subprotocol "h2"
+;         :subname "file:///data/TCGA/craft/h2/cavm.h2"})
+
+;
+; Table definitions.
+;
+
+(def float-size 4)
+(def bin-size 100)
+(def score-size (* float-size bin-size))
+
+; Note H2 has one int type: signed, 4 byte. Max is approximately 2 billion.
 (def probes-table ["CREATE TABLE IF NOT EXISTS `probes` (
                    `id` INT NOT NULL AUTO_INCREMENT PRIMARY KEY,
                    `eid` INT NOT NULL,
@@ -25,10 +31,6 @@
                    "CREATE INDEX IF NOT EXISTS probe_name ON probes (eid, name)"
                    "CREATE INDEX IF NOT EXISTS probe_chrom ON probes (eid, chrom, bin)"])

-(def float-size 4)
-(def bin-size 100)
-(def score-size (* float-size bin-size))
-
 (def scores-table [(format "CREATE TABLE IF NOT EXISTS `scores` (
                   `id` INT NOT NULL AUTO_INCREMENT PRIMARY KEY,
                   `expScores` VARBINARY(%d) NOT NULL)" score-size)])
@@ -68,9 +70,12 @@
                         `i` INT NOT NULL,
                         PRIMARY KEY(`eid`, `sid`))"])

-(declare score-decode)
-
-(declare probes scores experiments samples)
+
+;
+; Table models
+;
+
+(declare probes scores experiments samples exp_samples)

 (defentity cohorts
   (has-many experiments {:fk :cid})
@@ -82,23 +87,31 @@
   (has-many probes))

 (defentity samples
+  (has-many exp_samples {:fk :sid})
   (belongs-to cohorts {:fk :cid}))

 (defentity exp_samples
+  (belongs-to samples {:fk :sid})
   (belongs-to experiments {:fk :eid}))
+
+(declare score-decode)

 (defentity probes
   (many-to-many scores :joins  {:lfk 'pid :rfk 'sid})
   (belongs-to experiments {:fk :eid})
   (transform (fn [{scores :EXPSCORES :as v}]
                (if scores
-                 (assoc v :EXPSCORES (score-decode scores))
+                 (assoc v :EXPSCORES (float-array (score-decode scores)))
                  v))))

 (defentity scores
   (many-to-many probes :joins  {:lfk 'sid :rfk 'pid}))

 (defentity joins)
+
+;
+;
+;

 (defn- probes-in-exp [exp]
   (subselect probes (fields :id) (where {:eid exp})))
@@ -145,6 +158,10 @@
 (defn- insert-join [pid i sid]
   (insert joins (values {:pid pid :i i :sid sid})))

+;
+; Binary buffer manipulation.
+;
+
 (def codec-length (memoize (fn [len]
                              (binary/repeated :float-le :length len))))

@@ -158,6 +175,33 @@
   (let [baos (java.io.ByteArrayOutputStream.)]
     (binary/encode (codec-length (count slist)) baos slist)
     (.toByteArray baos)))
+
+; Pick elements of float array, by index.
+(defn apick-float [^floats a idxs]
+ (let [ia (float-array idxs)]
+  (amap ia i ret (aget a i))))
+
+(defn ashuffle-float [mapping ^floats out ^floats in]
+  (dorun (map #(aset out (% 1) (aget in (% 0))) mapping))
+  out)
+
+(defn bytes-to-floats [barr]
+  (let [bb (java.nio.ByteBuffer/allocate (alength barr))
+        fb (.asFloatBuffer bb)
+        out (float-array (quot (alength barr) 4))]
+    (.put bb barr)
+    (.get fb out)
+    out))
+
+(defn floats-to-bytes [farr]
+  (let [bb (java.nio.ByteBuffer/allocate (* (alength farr) 4))
+        fb (.asFloatBuffer bb)]
+    (.put fb farr)
+    (.array bb)))
+
+;
+;
+;

 (defn- load-probe [exp prow]
   (let [pid (insert-probe exp (:probe (meta prow)))
@@ -176,10 +220,6 @@
   (select samples (fields :id :sample)
           (where {:cid cid :sample [in sample-list]})))

-(defn snoop [x]
-  (println x)
-  x)
-
 ; hash seq of maps by given key
 (defn- hash-by-key [k s]
   (zipmap (map #(% k) s) s))
@@ -231,12 +271,19 @@
       (clear-by-exp exp)
       (delete experiments (where {:id exp})))))

-(kdb/defdb cavmdb db)
+(defn create-db [file]
+  (kdb/create-db  {:classname "org.h2.Driver"
+                   :subprotocol "h2"
+                   :subname file}))
+
+(defmacro with-db [db & body]
+  `(kdb/with-db ~db ~@body))
+
 (kconf/set-delimiters "`") ; for h2

 ; execute a sequence of sql statements
 (defn- exec-statements [stmts]
-  (dorun (map (partial exec-raw cavmdb) stmts)))
+  (dorun (map (partial exec-raw) stmts)))

 ; TODO look up N
 (defn- dataset-transform [ds]
@@ -249,15 +296,21 @@
   (->> (select experiments (with cohorts) (fields :FILE [:cohorts.name :cohort]))
        (map dataset-transform)))

-(defn select-probes []
-  (select* probes))
-
-; The cast is required because group_concat converts to hex.
+; Intersect experiment samples with the given set of samples.
+(defn exp-samples-in-list [exp samps]
+  (select exp_samples (with samples) (fields :i :samples.sample)
+          (where  {:eid exp}) (where (in :samples.sample samps))))
+
+(defn sample-bins [samps]
+  (set (map #(quot (% :I) bin-size) samps)))
+
 (defn select-scores []
   (-> (select* probes)
-      (fields (raw "CAST(GROUP_CONCAT(`expScores` ORDER BY `i` SEPARATOR '') AS BINARY) AS `expScores`"))
-      (join scores)
-      (group :joins.pid)))
+      (fields :name [:scores.expScores :expScores] [:joins.i :i])
+      (join scores)))
+
+(defn with-bins [q bins]
+  (where q (in :i bins)))

 (defn for-experiment [q exp]
   (where q {:probes.eid exp}))
@@ -265,11 +318,69 @@
 (defn for-experiment-named [q exp]
   (for-experiment q (subselect experiments (fields "id") (where {:file exp}))))

+(defn exp-by-name [exp]
+  (let [[{id :ID}]
+        (select experiments (fields "id") (where {:file exp}))]
+    id))
+
+; XXX expand model for probes/genes??
 (defn with-genes [q genes]
   (fields (where q {:probes.name [in genes]}) [:probes.name :gene]))

 (defn do-select [q]
   (exec q))
+
+; merge bin number and bin offset for a sample.
+(defn- merge-bin-off [sample]
+  (let [{i :I} sample]
+    (assoc sample :bin (quot i bin-size) :off (rem i bin-size))))
+
+(defn- bin-mapping [order {off :off sample :SAMPLE}]
+  [off (order sample)])
+
+(defn- pick-samples-fn [order [bin samples]]
+  [bin (partial ashuffle-float
+                (map (partial bin-mapping order) samples))])
+
+; Take an ordered list of requested samples, a list of samples (with indexes) in the
+; experiment, and generate fns to copy values from a score bin to an output array.
+; Returns one function for each score bin in the request.
+
+(defn- pick-samples-fns [s-req s-exp]
+  (let [order (zipmap s-req (range))
+        by-bin (group-by :bin s-exp)]
+    (apply hash-map (mapcat (partial pick-samples-fn order) by-bin))))
+
+; Take map of bin copy fns, list of scores rows, and a map of output arrays,
+; copying the scores to the output arrays via the bin copy fns.
+(defn- build-score-arrays [rows bfns out]
+  (dorun (map (fn [{i :I scores :EXPSCORES gene :GENE}]
+                ((bfns i) (out gene) scores))
+              rows))
+  out)
+
+(defn- col-arrays [columns n]
+  (zipmap columns (repeatedly (partial float-array n))))
+
+; XXX Need to fill in NAN for unknown samples.
+(defn genomic-read-req [req]
+  (let [{samples 'samples table 'table columns 'columns} req
+        eid (exp-by-name table)
+        s-in-exp (map merge-bin-off (exp-samples-in-list eid samples))
+        bins (map :bin s-in-exp)
+        bfns (pick-samples-fns samples s-in-exp)]
+
+    (-> (select-scores)
+        (for-experiment eid)
+        (with-genes columns)
+        (with-bins bins)
+        (do-select)
+        (build-score-arrays bfns (col-arrays columns (count samples))))))
+
+; doall is required so the seq is evaluated in db context.
+; Otherwise lazy map may not be evaluted until the context is lost.
+(defn genomic-source [reqs]
+  (doall (map #(update-in % ['data] merge (genomic-read-req %)) reqs)))

 (defn create[]
   (kdb/transaction


Some more tests for compojure.html

Some more tests for compojure.html

--- test/compojure/html/html.clj
+++ test/compojure/html/html.clj
@@ -3,7 +3,7 @@
         (compojure html)))

 (def names
-  '(foo Bar foo-bar foo_bar fooBar))
+  '(foo Bar foo-bar foo_bar fooBar foo:bar))

 (fact "The first element of a tag vector defines the tag name"
   [tag names]
@@ -101,9 +101,30 @@
   (= (html [tag {:id id}])
      (html [(str tag "#" id)])))

-(fact "The contents of HTML block tags are indented")
+(fact "The content of HTML 'block' tags is indented"
+  [tag '(body div p blockquote script)]
+  (= (html [tag "Lorem\nIpsum"])
+     (str "<" tag ">\n  Lorem\n  Ipsum\n</" tag ">\n")))

-(fact "The HTML pre tag is rendered without indentation"
+(fact "A newline character is appended to HTML 'line' tags"
+  [tag '(h1 h3 title li)]
+  (= (html [tag "Lorem Ipsum"])
+     (str "<" tag ">Lorem Ipsum</" tag ">\n")))
+
+(fact "Nested tags result in nested indentation"
+  [content  test-contents
+   indented ["    Lorem"
+             "    Lorem Ipsum"
+             "    "
+             "    Lorem\n    Ipsum"
+             "      Lorem"
+             "    Ipsum  "
+             "      Lorem\n        Ipsum"
+             "    Lorem
Ipsum"]]
+  (= (html [:div [:p content]])
+     (str "
\n
\n" indented "\n
\n
\n")))
+
+(fact "The HTML pre tag is always rendered without indentation"
   [content test-contents]
   (= (html [:body [:div [:pre content]]])
      "\n
\n
" content "
\n
\n\n"))


Support prioritization of overlays.

Support prioritization of overlays.

This will allow the Show Stopped overlay on the Push 2 to float over
even more recent overlays if the user adjusts cue variables while the
show is stopped. Also found a more idiomatic and efficient way of
keeping the map sorted in the right order, so the reverse step can be
eliminated when running the overlays.

--- src/afterglow/controllers.clj
+++ src/afterglow/controllers.clj
@@ -357,18 +357,21 @@
   functions that manipulate and invoke overlays."
   []
   (atom {:next-id 0
-         :overlays (sorted-map-by >)}))
+         :overlays (sorted-map)}))

 (defn add-overlay
   "Add a temporary overlay to the interface. The `state` argument must
   be a value created by [[create-overlay-state]], and `overlay` an
   implementation of the [[IOverlay]] protocol to be added as the most
-  recent overlay to that state."
-  [state overlay]
+  recent overlay to that state. The optional keyword argument
+  `:priority` can be used to modify the sorting order of overlays,
+  which is that more recent ones run later, so they get the last word
+  when it comes to rendering. The default priority is `0`."
+  [state overlay & {:keys [priority] :or {priority 0}}]
   (swap! state (fn [old-state]
                  (let [id (:next-id old-state)
                        overlays (:overlays old-state)]
-                   (assoc old-state :next-id (inc id) :overlays (assoc overlays id overlay))))))
+                   (assoc old-state :next-id (inc id) :overlays (assoc overlays [priority id] overlay))))))

 (defn add-control-held-feedback-overlay
   "Builds a simple overlay which just adds something to the user
@@ -398,15 +401,15 @@

 (defn run-overlays
   "Add any contributions from interface overlays, removing them if
-  they report being finished. Most recent overlays run last, having
-  the opportunity to override older ones. `state` must be a value
-  created by [[create-overlay-state]] and tracked by the controller.
-  The `snapshot` is an [[IMetroSnapshot]] that captures the instant in
-  time at which the interface is being rendered, and is passed in to
-  the overlay so it can be rendered in sync with all other interface
-  elements."
+  they report being finished. Most recent and higher priority overlays
+  run last, having the opportunity to override older ones. `state`
+  must be a value created by [[create-overlay-state]] and tracked by
+  the controller. The `snapshot` is an [[IMetroSnapshot]] that
+  captures the instant in time at which the interface is being
+  rendered, and is passed in to the overlay so it can be rendered in
+  sync with all other interface elements."
   [state snapshot]
-  (doseq [[k overlay] (reverse (:overlays @state))]
+  (doseq [[k overlay] (:overlays @state)]
       (when-not (adjust-interface overlay snapshot)
         (swap! state update-in [:overlays] dissoc k))))


fix api doc for cond-path

fix api doc for cond-path

--- src/clj/com/rpl/specter.clj
+++ src/clj/com/rpl/specter.clj
@@ -185,10 +185,11 @@
   (->PutValCollector val))

 (defn cond-path
-  "Takes in alternating cond-fn selector cond-fn selector...
-   Tests the structure on the cond-fn, and if it matches uses the following selector for
-   the rest of the selector. Otherwise, it moves on to the next selector. If nothing
-   matches, then the structure is not selected."
+  "Takes in alternating cond-path selector cond-path selector...
+   Tests the structure if selecting with cond-path returns anything.
+   If so, it uses the following selector for this portion of the navigation.
+   Otherwise, it tries the next cond-path. If nothing matches, then the structure
+   is not selected."
   [& conds]
   (->> conds
        (partition 2)


Removed typo option

Removed typo option

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -1604,8 +1604,6 @@
    base-combine-schema
    {:as-singleton-view {:docstr "The transform returns a PCollectionView whose elements are the result of combining elements per-window in the input PCollection."
                         :action (fn [transform b] (when b (.asSingletonView transform)))}
-    :without-default {:docstr "Empty windows will return an empty collection"
-                      :action (fn [transform b] (when b (.withoutDefault transform)))}
     :scope {:docstr "Specifies the combiner scope of application"
             :enum [:global :per-key]
             :default :global}}))


add main-dev metric

add main-dev metric

--- src/clj/gitomic/reports.clj
+++ src/clj/gitomic/reports.clj
@@ -84,4 +84,15 @@
 (defn coupling->csv [db repo fname & opts]
   (let [tc (temporal-coupling db repo opts)
         pairs (i/$order [:churn :f1 :percentage] :desc tc)]
-    (i/save pairs fname)))+    (i/save pairs fname)))
+
+(defn main-dev [ds]
+  (i/add-derived-column :ownership [:change/added :change/added-total]
+                        (fn [x y] (Math/round (if (pos? y)
+                                                (* 100 (float (/ x y)))
+                                                -1.0)))
+                        (i/$join [:file/path :file/path]
+                                 (i/$rollup :sum :change/added [:person/name :file/path] ds)
+                                 (i/rename-cols {:change/added :change/added-total}
+                                                (i/$rollup :sum :change/added :file/path ds))))
+  )


Roll back the state change if we can't delete the files

--- src/clj/mdr2/production.clj
+++ src/clj/mdr2/production.clj
@@ -266,10 +266,11 @@
 (defn delete!
   "Delete a `production`"
   [production]
-  ;; we do not actually delete anything in the db
-  (-> production
-      (set-state! "deleted")
-      delete-all-dirs!))
+  (conman/with-transaction [db/*db*]
+    (-> production
+        ;; we do not actually delete anything in the db
+        (set-state! "deleted")
+        delete-all-dirs!)))

 (defn add-structure
   "Add a DTBook XML to a `production`. This will also set the status


Add a sub route to /:id called /raw that returns the content of a paste with the content-type of 'text/plain'

--- src/clj_codetip/handler.clj
+++ src/clj_codetip/handler.clj
@@ -7,7 +7,7 @@
             [ring.server.standalone :refer [serve]]
             [clojure.java.jdbc :refer [with-db-connection]]
             [clojure.tools.logging :as log]
-            [compojure.core :refer [defroutes ANY GET POST]]
+            [compojure.core :refer [context defroutes ANY GET POST]]
             [compojure.route :as route]
             [environ.core :refer [env]]
             [joplin.core :as joplin]
@@ -40,22 +40,41 @@
 (defroutes app
   (route/resources "/static")

-  (GET  "/:id" [id]
-        (resource
-         :available-media-types ["text/html"]
+  (context "/:id" [id]
+           (GET "/" []
+                (resource
+                 :available-media-types ["text/html"]

-         :service-available?
-         (fn [{{conn :db-conn} :request}]
-           {::paste (db/paste-by-id conn id)})
+                 :service-available?
+                 (fn [{{conn :db-conn} :request}]
+                   {::paste (db/paste-by-id conn id)})

-         :exists?
-         (fn [{paste ::paste}]
-           (not (nil? paste)))
+                 :exists?
+                 (fn [{paste ::paste}]
+                   (not (nil? paste)))

-         :handle-ok
-         (fn [{paste ::paste}]
-           (view/application (paste-title paste)
-                             (view/paste paste)))))
+                 :handle-ok
+                 (fn [{paste ::paste}]
+                   (view/application (paste-title paste)
+                                     (view/paste paste id)))))
+
+
+           (GET "/raw" []
+                (resource
+                 :available-media-types ["text/plain"]
+
+                 :service-available?
+                 (fn [{{conn :db-conn} :request}]
+                   {::paste (db/paste-by-id conn id)})
+
+                 :exists?
+                 (fn [{paste ::paste}]
+                   (not (nil? paste)))
+
+                 :handle-ok
+                 (fn [{paste ::paste}]
+                   (:content paste)))))
+

   (ANY  "/" []
         (resource


Fix StackOverflowError in read-in-region.

--- src/cljam/io/bam/reader.clj
+++ src/cljam/io/bam/reader.clj
@@ -64,7 +64,7 @@
         (read-blocks-randomly* this chr start end decoder))))
   protocols/IRegionReader
   (read-in-region [this region]
-    (protocols/read-in-region this region))
+    (protocols/read-in-region this region {}))
   (read-in-region [this region _]
     (protocols/read-alignments this region)))


Tweaks to color selection.

Tweaks to color selection.

--- src/cljs/bookmarx/icon.cljs
+++ src/cljs/bookmarx/icon.cljs
@@ -437,17 +437,22 @@

 (defn color-option "Render a color option."
   [color]
-  [:option (merge {:value color :style {:color color} :key (str "option-" color "-key")}
-            (when (= color (session/get-in [:add :bookmark/icon-color])) {:selected "selected"}))
-   color])
+  (let [current-color (session/get-in [:add :bookmark/icon-color])]
+    [:option (merge {:value color :key (str "option-" color "-key")}
+                    (when (= color (if current-color current-color "Black")) {:selected "selected"}))
+     color]))

 (defn color-select "Render a color dropdown."
   [colors]
-  [:select {:id "color-select"
-            :on-change #(let [this (.getElementById js/document "color-select")
-                              new-color (nth colors (.-selectedIndex this))]
+  [:div
+   [:select {:id "color-select"
+             :on-change #(let [this (.getElementById js/document "color-select")
+                               new-color (nth colors (.-selectedIndex this))]
                           (session/update-in! [:add :bookmark/icon-color] (fn [_] new-color)))}
-   (map color-option colors)])
+    (map color-option colors)]
+   " "
+   [:div.glyphicon.glyphicon-stop {:style {:color (session/get-in [:add :bookmark/icon-color])
+                                           :font-size "18px"}}]])

 (defn icon-page "Select an icon for a bookmark."
   []


make packet-view reloadable with case

make packet-view reloadable with case

--- src/cljs/demtools/core.cljs
+++ src/cljs/demtools/core.cljs
@@ -175,28 +175,29 @@
   (when file
     (dom/div nil (str "File loaded: " (.-name file)))))

-(defmulti packet-view (fn [p] (aget p "packetType" :default)))
-(defmethod packet-view :default [p] (str/join ", " (js/Object.keys p)))
-(defmethod packet-view "setConVar" [p]
-  (->> (aget p "vars") js/Object.entries (map (fn [[k v]] (str k "=\"" v "\""))) (str/join " ")))
-(defmethod packet-view "netTick" [p]
-  (str "Tick: " (p "tick") " frameTime: " (p "frameTime")
-       " stdDev: " (p "stdDev")))
-(defmethod packet-view "gameEvent" [p]
-  (-> (aget p "event") js/JSON.stringify))
-;; (defmethod packet-view "packetEntities" [p]
-;;   (->> (p "entities")
-;;        (mapv (fn [ent]
-;;                (str (ent "entityIndex")
-;;                     "-" (get-in ent ["serverClass" "name"] nil)
-;;                     "-" (count (get ent "props" []))
-;;                     )))
-;;        (str/join "; ")
-;;        ))
-;; (defmethod packet-view "serverInfo" [p]
-;;   (str "frameTime: " (p "frameTime") " stdDev: " (p "stdDev")))
-(defmethod packet-view "consoleCmd" [p] (aget p "command"))
-(defmethod packet-view "print" [p] (aget p "value"))
+(defn packet-view [p]
+  (case (.-packetType p)
+    "setConVar"
+    (->> (.-vars p)
+         js/Object.entries
+         (map (fn [[k v]] (str k "=\"" v "\"")))
+         (str/join " "))
+
+    "netTick"
+    (str "Tick: " (.-tick p)
+         " frameTime: " (.-frameTime p)
+         " stdDev: " (.-stdDev p))
+
+    "gameEvent"
+    (-> (aget p "event") js/JSON.stringify)
+
+    "consoleCmd"
+    (aget p "command")
+
+    "print"
+    (aget p "value")
+
+    (str/join "; " (js/Object.keys p))))

 (defn packet-type-cell [offset data]
   (fn [props-js]
@@ -235,7 +236,8 @@

           packets-count (count packets)
           last-idx (max 0 (dec packets-count))
-          packet (when selected-idx (nth packets (min last-idx selected-idx) nil))
+          packet (when selected-idx
+                   (nth packets (min last-idx selected-idx) nil))
           start (min offset last-idx)
           end (min (+ limit offset) last-idx)
           packets (subvec packets start end)]


Use abbr tag for unit-type names instead of note at the bottom of modal body

--- src/cljs/zetawar/views.cljs
+++ src/cljs/zetawar/views.cljs
@@ -328,8 +328,8 @@
                [:th {:style {:text-align "center"}} "Range"]
                [:th {:style {:text-align "center"}} "Strength"]]
               [:tbody>tr
-               [:td ({:unit-type.armor-type/personnel "P"
-                      :unit-type.armor-type/armored "A"}
+               [:td ({:unit-type.armor-type/personnel [:abbr {:title "Personnel" :style {:cursor "inherit"}} "P"]
+                      :unit-type.armor-type/armored [:abbr {:title "Armored" :style {:cursor "inherit"}} "A"]}
                      (get-in unit-type [:unit-type/armor-type]))]
                [:td (:unit-type/movement unit-type)]
                [:td (:unit-type/armor unit-type)]
@@ -339,9 +339,7 @@
                [:td (interleave [[:strong "P: "] [:strong " A: "]]
                           (map #(str (get-in % [:unit-strength/attack]))
                                      (get-in unit-type [:unit-type/strengths])))]
-               ]]]]]))]
-      [:p "P = Personnel"]
-      [:p "A = Armored"]]
+               ]]]]]))]]
      [:> js/ReactBootstrap.Modal.Footer
       [:button.btn.btn-default {:on-click hide-picker}
        "Cancel"]]]))


Fix cljx specifier

Fix cljx specifier

--- src/cljx/robinson/main.cljx
+++ src/cljx/robinson/main.cljx
@@ -151,7 +151,7 @@
                                                (get settings :windows-font)
                                                (get settings :else-font)
                                                (get settings :font-size))
-                      #+clj
+                      #+cljs
                       (webglterminal/make-terminal 80 24 [255 255 255] [0 0 0] nil
                                                (get settings :windows-font)
                                                (get settings :else-font)


Add create-or-update-channel

Add create-or-update-channel

--- src/clojure_fabric/user.clj
+++ src/clojure_fabric/user.clj
@@ -35,13 +35,16 @@
 (ns clojure-fabric.user
   (:require [clojure-fabric.chaincode :as chaincode]
             [clojure-fabric.core :as core]
+            [clojure-fabric.crypto-suite :as crypto-suite]
             [clojure-fabric.proto :as proto]
             [clojure.java.io :as io])
   (:import [java.io ByteArrayOutputStream File FileInputStream]
            [org.apache.commons.compress.archivers.tar TarArchiveEntry TarArchiveOutputStream]
            org.apache.commons.compress.compressors.gzip.GzipCompressorOutputStream
            org.apache.commons.io.IOUtils
-           org.hyperledger.fabric.protos.common.Common$Envelope))
+           [com.google.protobuf ByteString Timestamp GeneratedMessageV3]
+           [org.hyperledger.fabric.protos.common Common$Envelope Configtx$ConfigUpdateEnvelope
+            Common$Payload Configtx$ConfigGroup Configtx$ConfigUpdate]))

 (defn ca-user?
   [user]
@@ -297,7 +300,9 @@
   ([user]
    (:certificate user)))

+#_
 (defn create-or-update-channel
+  ;; evelope - read from <channel-name>.tx file
   [user channel-name orderer {:keys [^bytes envelope config signatures]}]
   (cond envelope
         ;; envelope is byte array of Envelope, which is ready to be parsed in
@@ -317,6 +322,47 @@
           ;; config-update-envelope is a payload data, i.e.
           ;; Payload = Header + Payload(config-update-envelope)
           (proto/send-update-channel-using-envelope envelope))))
+
+(defn create-or-update-channel
+  ([user channel-name orderer envelope]
+   envelope
+   )
+  ([user channel-name orderer config signatures]
+   (let [payload (proto/make-payload :header (chaincode/make-header channel-name user {:channel-header-type :config-update})
+                                     :data (proto/make-config-update-envelope :config-update config :signatures signatures))]
+     (create-or-update-channel user
+                               channel-name
+                               orderer
+                               (proto/make-envelope :payload payload
+                                                    :signature (crypto-suite/sign (.toByteArray ^Common$Payload (proto/clj->proto payload))
+                                                                                (:private-key user)
+                                                                                {:algorithm (:key-algorithm (:crypto-suite user))}))))))
+
+;; (create-or-update-channel-using-tx-file u1 "" 1 1 "/home/jc/Work/clojure-fabric/resources/fixture/balance-transfer/artifacts/channel/mychannel.tx")
+(comment
+  ;; Test
+  (defn create-or-update-channel-using-envelope
+    [user channel-name orderer participating-peers proto-envelope]
+    (let [clj-envelope (proto/proto->clj proto-envelope
+                                         {:payload {:data {:fn #(Configtx$ConfigUpdateEnvelope/parseFrom ^ByteString %)
+                                                           :config-update {:fn #(Configtx$ConfigUpdate/parseFrom ^ByteString %)}}}})
+          clj-config-update (get-in clj-envelope [:payload :data :config-update])
+          proto-config-update (proto/clj->proto clj-config-update)]
+
+      clj-envelope
+      ))
+  (defonce max-tx-file-size 1024)
+  (defn create-or-update-channel-using-tx-file
+    [user channel-name orderer participating-peers tx-filename]
+    (let [tx-file (io/as-file tx-filename)]
+      (assert (<= (.length tx-file) max-tx-file-size))
+      (->> (with-open [in (io/input-stream tx-file)
+                       out (java.io.ByteArrayOutputStream.)]
+             (io/copy in out)
+             (Common$Envelope/parseFrom (.toByteArray out)))
+           (create-or-update-channel-using-envelope user channel-name orderer participating-peers)))))
+
+;;(create-or-update-channel-using-file 1 1 1 "/home/jc/Work/clojure-fabric/resources/fixture/balance-transfer/artifacts/channel/mychannel.tx")

 (defn create-channel
   ([channel-name orderer opts]
@@ -424,3 +470,13 @@
                                          user
                                          {:args [deployment-spec]
                                           :channel-header-type :endorser-transaction})))))
+
+
+;; (def e1 (Common$Envelope/parseFrom buf))
+;; (def p0 (.getPayload e1))
+;; (def p1 (Common$Payload/parseFrom p0))
+;; (def h1 (.getHeader p1))
+;; (def d1 (.getData p1))
+;; (def e2 (Configtx$ConfigUpdateEnvelope/parseFrom d1))
+;; (def c1 (.getConfigUpdate e2))
+;; (def s1 (.getSignatures e2))


Added dev util function for saying the specified text.

--- src/cmr/common/dev/util.clj
+++ src/cmr/common/dev/util.clj
@@ -11,7 +11,7 @@
   [file]
   (future
     (try
-      (clojure.java.shell/sh "touch" file)
+      (sh/sh "touch" file)
       (catch Throwable e
         (println "Error touch" file)
         (.printStackTrace e))))
@@ -31,10 +31,10 @@
         files (seq (.listFiles d))]
     (dorun (map #(-> % str touch-file) (filter #(not (.isDirectory ^java.io.File %)) files)))))

-(comment
-(touch-files-in-dir ".")
-
-)
+(defn speak
+  "Says the specified text outloud."
+  [text]
+  (sh/sh "say" "-v" "Victoria" text))

 (defn copy-to-clipboard
   "Copies the string into the clipboard"


specify that 'carry' is a verb

specify that 'carry' is a verb

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -1241,12 +1241,13 @@
    "take" (let [common {:synsem {:cat :verb}
                         :english {:past "took"
                                   :past-participle "taken"}}]
-            [{:synsem {:sem {:pred :carry}}
+            [{:synsem {:cat :verb
+                       :sem {:pred :carry}}
               :english {:note "carry"}}

-             {:synsem {:sem {:pred :grab}}
+             {:synsem {:cat :verb
+                       :sem {:pred :grab}}
               :english {:note "grab"}}])
-

    "take advantage of" {:english {:past "took advantage of"
                                   :participle "taking advantage of"


whitespace

whitespace

--- src/babel/english/lexicon.clj
+++ src/babel/english/lexicon.clj
@@ -1431,7 +1431,7 @@
                 :sem {:pred :walk}}}

    "want" {:synsem {:cat :verb
-                      :sem {:pred :want}}}
+                    :sem {:pred :want}}}

    "warm" {:synsem {:cat :verb
                 :sem {:pred :warm}}}