(PDB-3738) Add compound report id index

(PDB-3738) Add compound report id index

We've encountered some problematic queries when doing historical scans over
reports. This adds an index targeted at those queries.

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1466,6 +1466,18 @@
      ["create index packages_name_trgm on packages"
       "  using gin (name gin_trgm_ops)"])))

+(defn ensure-report-id-index []
+  (when-not (sutils/index-exists? "idx_reports_compound_id")
+    (log/info "Indexing reports for id queries")
+
+    (jdbc/do-commands
+     "create index idx_reports_compound_id on reports
+        (producer_timestamp, certname, hash)
+        where start_time is not null")
+
+    (jdbc/do-commands-outside-txn
+     "vacuum analyze reports")))
+
 (defn indexes!
   "Create missing indexes for applicable database platforms."
   [config]
@@ -1478,4 +1490,5 @@
         "\n\n"
         (trs "We are unable to create the recommended pg_trgm indexes due to\nthe extension not being installed correctly.")
         " "
-        (trs " Run the command:\n\n    CREATE EXTENSION pg_trgm;\n\nas the database super user on the PuppetDB database to correct\nthis, then restart PuppetDB.\n"))))))
+        (trs " Run the command:\n\n    CREATE EXTENSION pg_trgm;\n\nas the database super user on the PuppetDB database to correct\nthis, then restart PuppetDB.\n")))))
+  (ensure-report-id-index))


Tundra: add TODO

Tundra: add TODO

--- src/taoensso/carmine/tundra/faraday.clj
+++ src/taoensso/carmine/tundra/faraday.clj
@@ -10,6 +10,9 @@
   (:import  [taoensso.carmine.tundra IDataStore]))

 ;; TODO Add auto-threading support for saturating (very) high-throughput freezing?
+;; TODO Add support for splitting data > 64KB over > 1 keys? This may be tough
+;; to do well relative to the payoff. And I'm guessing there may be an official
+;; (Java) lib to offer this capability at some point?

 (def default-table :faraday.tundra.datastore.default.prod)

@@ -110,4 +113,4 @@
   (far/describe-table creds default-table)
   (far/batch-write-item creds
     {ttable {:put [{:redis-key "k1" :data "data1"}
-                   {:redis-key "k2" :data "data2"}]}}))+                   {:redis-key "k2" :data "data2"}]}}))


fix memo errors in transactions web test

--- test/clj_money/web/transactions_test.clj
+++ test/clj_money/web/transactions_test.clj
@@ -116,21 +116,25 @@
         expected {:transaction-date (t/local-date 2016 1 2)
             :description "Employer"
             :entity-id (-> context :entities first :id)
+            :memo nil
             :items [{:action :debit
                      :account-id (:id checking)
                      :amount 1001M
                      :balance 1001M
-                     :index 0}
+                     :index 0
+                     :memo nil}
                     {:action :credit
                      :account-id (:id salary)
                      :amount 901M
                      :balance 901M
-                     :index 0}
+                     :index 0
+                     :memo nil}
                     {:action :credit
                      :account-id (:id bonus)
                      :amount 100M
                      :balance 100M
-                     :index 0}]}]
+                     :index 0
+                     :memo nil}]}]

     (when (not= expected actual)
       (pprint {:expected expected


Remove extra inspect

Remove extra inspect

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -59,7 +59,7 @@
     om/IDisplayName (display-name [_] "Aside Branch Activity")
     om/IRender
     (render [_]
-      (let [{:keys [org repo branch-data vcs_type]} (inspect data)
+      (let [{:keys [org repo branch-data vcs_type]} data
             [name-kw branch-builds] branch-data
             display-builds (take-last 5 (sort-by :build_num (concat (:running_builds branch-builds)
                                                                     (:recent_builds branch-builds))))]


remove dommy reliance

remove dommy reliance

--- src/cljs/infinitelives/pixi/canvas.cljs
+++ src/cljs/infinitelives/pixi/canvas.cljs
@@ -91,11 +91,11 @@
       ;; custom canvas was generated. we should position it
       ;; and add it to the DOM
       (do
-        (dommy/set-style! actual-canvas
+        (set-style! actual-canvas
                           :left (if expand 0 x)
                           :top (if expand 0 y)
                           :position "absolute")
-        (dommy/append! (sel1 :body) actual-canvas)))
+        (append! (.-body js/document) actual-canvas)))

     (let [wind-width (if expand fswidth canvas-width)
           wind-height (if expand fsheight canvas-height)


Only show toggle when the history is long enough

--- src/clojure/staircase/views/history.clj
+++ src/clojure/staircase/views/history.clj
@@ -33,8 +33,10 @@
           :div.panel-body
           [:p [:small [:em "{{history.created_at | roughDate }}"]]]
           (staircase.views.forms/label-input-pair "history.description"))
-    [:div.flex-row.stretched [:a.toggle-elisions {:ng-click "appView.elide = !appView.elide"}
-                              [:small "show all steps"]]]
+   [:div.flex-row.stretched
+    {:ng-if "steps.length > 4"}
+    [:a.toggle-elisions {:ng-click "appView.elide = !appView.elide"}
+     [:small "show all steps"]]]
     [:div.list-group.history-steps
      [:a.list-group-item {:ng-repeat "s in steps"
                           :ng-controller "HistoryStepCtrl as stepCtrl"


Add preconditions to db storage functions

--- src/com/puppetlabs/cmdb/scf/storage.clj
+++ src/com/puppetlabs/cmdb/scf/storage.clj
@@ -7,6 +7,7 @@
 (defn persist-certname!
   "Given a certname, persist it in the db"
   [certname api-version catalog-version]
+  {:pre [certname api-version catalog-version]}
   (sql/insert-record :certnames {:name certname
                                  :api_version api-version
                                  :catalog_version catalog-version}))
@@ -14,6 +15,8 @@
 (defn persist-classes!
   "Given a certname and a list of classes, persist them in the db"
   [certname classes]
+  {:pre [certname
+         (coll? classes)]}
   (let [default-row {:certname certname}
         classes     (map #(assoc default-row :name %) classes)]
     (apply sql/insert-records :classes classes)))
@@ -21,6 +24,8 @@
 (defn persist-tags!
   "Given a certname and a list of tags, persist them in the db"
   [certname tags]
+  {:pre [certname
+         (coll? tags)]}
   (let [default-row {:certname certname}
         tags        (map #(assoc default-row :name %) tags)]
     (apply sql/insert-records :tags tags)))
@@ -28,6 +33,7 @@
 (defn resource-already-persisted?
   "Returns a boolean indicating whether or not the given resource exists in the db"
   [hash]
+  {:pre [hash]}
   (sql/with-query-results result-set
     ["SELECT EXISTS(SELECT 1 FROM resources WHERE hash=?) as present" hash]
     (let [row (first result-set)]
@@ -59,6 +65,7 @@
 (defn persist-resource!
   "Given a certname and a single resource, persist that resource and its parameters"
   [certname {:keys [type title exported parameters tags] :as resource}]
+  {:pre [(every? string? #{type title})]}

   (let [hash       (compute-hash resource)
         persisted? (resource-already-persisted? hash)
@@ -103,6 +110,9 @@
 For example, if the source of an edge is {'type' 'Foo' 'title' 'bar'},
 then we'll lookup a resource with that key and use its hash."
   [certname edges resources]
+  {:pre [certname
+         (coll? edges)
+         (map? resources)]}
   (let [rows  (for [{:keys [source target relationship]} edges
                     :let [source-hash (compute-hash (resources source))
                           target-hash (compute-hash (resources target))
@@ -112,13 +122,16 @@

 (defn persist-catalog!
   "Persist the supplied catalog in the database"
-  [catalog]
-  (let [{:keys [certname api-version version resources classes edges tags]} catalog]
+  [{:keys [certname api-version version resources classes edges tags] :as catalog}]
+  {:pre [(every? string? #{certname})
+         (number? api-version)
+         (every? coll? #{classes tags edges})
+         (map? resources)]}

-    (sql/transaction
-     (persist-certname! certname api-version version)
-     (persist-classes! certname classes)
-     (persist-tags! certname tags)
-     (doseq [resource (vals resources)]
-       (persist-resource! certname resource))
-     (persist-edges! certname edges resources))))
+  (sql/transaction
+   (persist-certname! certname api-version version)
+   (persist-classes! certname classes)
+   (persist-tags! certname tags)
+   (doseq [resource (vals resources)]
+     (persist-resource! certname resource))
+   (persist-edges! certname edges resources)))


Add test for filtering comics by site

Add test for filtering comics by site

--- test/clj/comic_reader/database_test.clj
+++ test/clj/comic_reader/database_test.clj
@@ -88,6 +88,17 @@
         (is (= [{:comic/id "comic-one" :comic/name "Comic One"}]
                (sut/get-comics test-database "site-one"))))))

+  (testing "returns one stored comic record"
+    (with-test-db test-database
+      (let [site {:id "site-one", :name "Site One"}
+            other-site {:id "site-two", :name "Site Two"}]
+        @(sut/store-sites test-database [site other-site])
+        @(sut/store-comics test-database (:id site) [{:id "comic-one" :name "Comic One"}])
+        @(sut/store-comics test-database (:id other-site) [{:id "not-good-comic" :name "Not Good Comic"}])
+
+        (is (= [{:comic/id "comic-one" :comic/name "Comic One"}]
+               (sut/get-comics test-database "site-one"))))))
+
   (testing "returns many stored comic records"
     (with-test-db test-database
       (let [site {:id "site-one", :name "Site One"}]


Connect :file type into type hierarchy

Connect :file type into type hierarchy

--- src/pipeline/grafter/pipeline/types.clj
+++ src/pipeline/grafter/pipeline/types.clj
@@ -42,6 +42,9 @@
                    :value input-val
                    :options opts})))

+(defmethod parse-parameter [String ::root-type] [_ val opts]
+  (throw (ex-info "root-type is abstract and does not correspond to any concrete object coercion." {:error ::abstract-type-error})))
+
 (defmethod parse-parameter [String ::primitive] [_ val opts]
   (edn/read-string val))

@@ -97,10 +100,16 @@
 (defmethod parse-parameter [String ::map] [_ val opts]
   (edn/read-string val))

+(defmethod parse-parameter [String ::file] [_ val opts]
+  (io/file val))
+
 (defmethod parse-parameter [String ::text-file] [_ val opts]
   ;; assume its a file path to a text file and return a reader on it
   (io/reader val))

+(defmethod parse-parameter [String ::binary-file] [_ val opts]
+  (io/input-stream val))
+
 (defmethod parse-parameter [String java.net.URL] [_ val opts]
   (URL. val))

@@ -140,6 +149,8 @@

 (swap! parameter-types derive ::vector ::value)

+(swap! parameter-types derive ::file ::root-type)
+
 (swap! parameter-types derive ::binary-file ::file)

 (swap! parameter-types derive ::text-file ::file)
@@ -153,6 +164,7 @@
 (swap! parameter-types derive ::tabular-dataset ::text-file)

 (prefer-method parse-parameter [String ::tabular-dataset] [String Map])
+
 (prefer-method parse-parameter [Map ::tabular-dataset] [Map Map])

 (swap! parameter-types derive java.io.InputStream ::binary-file)


(PDB-3723) storage: store path_array in fact_paths

[rlb@puppet.com: squash; adjust message]

--- src/puppetlabs/puppetdb/scf/storage.clj
+++ src/puppetlabs/puppetdb/scf/storage.clj
@@ -1235,33 +1235,35 @@
               (jdbc/insert-multi! :fact_values)
               (map :id)))))

+(def ps-chunksize 6000)
+
 (defn realize-paths!
   "Ensures that all paths exist in the database and returns a map of
   paths to ids."
   [pathstrs]
   (when-let [pathstrs (seq pathstrs)]
-    (let [array-to-param sutils/array-to-param
-          existing-path-ids (jdbc/call-with-query-rows
+    (let [existing-path-ids (jdbc/call-with-query-rows
                              [(str "select path, id from fact_paths"
                                    "  where path in (select * from unnest(?))")
-                              (array-to-param "text" String pathstrs)]
+                              (sutils/array-to-param "text" String pathstrs)]
                              {:as-arrays? true}
                              (fn [[col-names & rows]]
                                (into {} rows)))
           missing-db-paths (set/difference (set pathstrs)
                                            (set (keys existing-path-ids)))
           new-paths (map facts/string-to-factpath missing-db-paths)]
-
-      (jdbc/call-with-query-rows
-       [(str "insert into fact_paths (path, name, depth)"
-             "  (select * from unnest(?, ?, ?)) returning path, id")
-        (array-to-param "text" String (map facts/factpath-to-string new-paths))
-        (array-to-param "text" String (map first new-paths))
-        (array-to-param "integer" Integer (map #(-> (count %) dec int)
-                                               new-paths))]
-       {:as-arrays? true}
-       (fn [[col-names & rows]]
-         (into existing-path-ids rows))))))
+      (let [chunks (->> (map #(hash-map :path %1 :name %2 :depth %3 :path_array %4)
+                              (map facts/factpath-to-string new-paths)
+                              (map first new-paths)
+                              (map #(-> (count %) dec int) new-paths)
+                              (->> new-paths
+                                   (map #(sutils/array-to-param
+                                           "text" String (map str %)))))
+                         (partition-all ps-chunksize))]
+        (->> chunks
+             (mapcat #(jdbc/insert-multi! :fact_paths %))
+             (map #(select-keys % [:path :name]))
+             (reduce #(assoc %1 (:path %2) (:id %2)) existing-path-ids))))))

 (defn realize-values!
   "Ensures that all valuemaps exist in the database and returns a


Little namespace spec cleanup

Little namespace spec cleanup

--- src/polismath/poller.clj
+++ src/polismath/poller.clj
@@ -1,5 +1,6 @@
 (ns polismath.poller
-  (:use polismath.matrix-utils polismath.pca)
+  (:use polismath.matrix-utils
+        polismath.pca)
   (:require [korma.db :as kdb]
             [korma.core :as ko]
             [clojure.java.jdbc :as sql]


Drop the schema before test instead of after, to help manual inspection

--- test/territory_bro/congregation_test.clj
+++ test/territory_bro/congregation_test.clj
@@ -41,6 +41,8 @@
 (deftest my-congregations-test
   (let [master (master-db-migrations "test_master")
         tenant (tenant-db-migrations "test_tenant")]
+    (.clean tenant)
+    (.clean master)
     (.migrate master)
     (.migrate tenant)

@@ -50,10 +52,7 @@
         (is (= [] (jdbc/query conn ["select * from foo"])))
         (is (= {:foo_id 1} (jdbc/execute! conn ["insert into foo (foo_id) values (default)"] {:return-keys true})))
         (is (= {:bar_id 1} (jdbc/execute! conn ["insert into bar (bar_id) values (default)"] {:return-keys true})))
-        (is (= [{:foo_id 1}] (jdbc/query conn ["select * from foo"])))))
-
-    (.clean tenant)
-    (.clean master))
+        (is (= [{:foo_id 1}] (jdbc/query conn ["select * from foo"]))))))

   (testing "lists congregations to which the user has access")
   (testing "hides congregations to which the user has no access")


Add timeouts to all blocking takes/derefs

--- test/time_tracker/timers/pubsub_test.clj
+++ test/time_tracker/timers/pubsub_test.clj
@@ -1,6 +1,6 @@
 (ns time-tracker.timers.pubsub-test
   (:require [clojure.test :refer :all]
-            [clojure.core.async :refer [<!! put! chan]]
+            [clojure.core.async :refer [chan alt!! put!] :as async]
             [time-tracker.fixtures :as fixtures]
             [time-tracker.db :as db]
             [time-tracker.timers.db :as timers.db]
@@ -17,6 +17,18 @@

 (def connect-url "ws://localhost:8000/timers/ws-connect/")

+(defn- try-take!!
+  [channel]
+  (alt!!
+    channel              ([value] value)
+    (async/timeout 1000) (throw (ex-info "Take from channel timed out" {:channel channel}))))
+
+(defn- try-deref
+  [a-promise]
+  (let [result (deref a-promise 1000 ::deref-timeout)]
+    (if (= result ::deref-timeout)
+      (throw (ex-info "Deref promise timed out" {:promise a-promise}))
+      result)))

 (deftest start-timer-command
   (let [gen-projects  (projects.helpers/populate-data! {"gid1" ["foo"]
@@ -37,7 +49,7 @@
                              {:command      "start-timer"
                               :timer-id     (:id timer1)
                               :started-time current-time}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (= (:id timer1) (:timer-id command-response)))
           (is (= current-time (:started-time command-response)))))

@@ -46,7 +58,7 @@
                              {:command      "start-timer"
                               :timer-id     (:id timer2)
                               :started-time current-time}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (:error command-response))))

       (finally (ws/close socket)))))
@@ -75,7 +87,7 @@
                              {:command   "stop-timer"
                               :timer-id  (:id timer1)
                               :stop-time stop-time}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (s/valid? :timers.db/duration (:duration command-response)))
           (is (= 7.0
                  (get-in command-response [:duration :seconds])))))
@@ -85,7 +97,7 @@
                              {:command   "stop-timer"
                               :timer-id  (:id timer2)
                               :stop-time stop-time}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (:error command-response))))
       (finally (ws/close socket)))))

@@ -108,7 +120,7 @@
           (ws/send-msg socket (json/encode
                                {:command   "delete-timer"
                                 :timer-id  (:id timer1)}))
-          (let [command-response (<!! response-chan)]
+          (let [command-response (try-take!! response-chan)]
             (is (:delete? command-response))
             (is (= (:id timer1)
                    (:timer-id command-response)))))
@@ -117,14 +129,14 @@
           (ws/send-msg socket (json/encode
                                {:command  "delete-timer"
                                 :timer-id (+ 5 (:id timer1))}))
-          (let [command-response (<!! response-chan)]
+          (let [command-response (try-take!! response-chan)]
             (is (:error command-response)))))

       (testing "Unowned timer"
         (ws/send-msg socket (json/encode
                              {:command   "delete-timer"
                               :timer-id  (:id timer2)}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (:error command-response))))

       (finally (ws/close socket)))))
@@ -143,7 +155,7 @@
                              {:command      "create-and-start-timer"
                               :project-id   (get gen-projects "foo")
                               :started-time current-time}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (= (get gen-projects "foo")
                  (:project-id command-response)))
           (is (:create? command-response))
@@ -155,7 +167,7 @@
                              {:command      "create-and-start-timer"
                               :project-id   (get gen-projects "goo")
                               :started-time current-time}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (:error command-response))))

       (finally (ws/close socket)))))
@@ -186,7 +198,7 @@
                               :duration     {:hours   0
                                              :minutes 0
                                              :seconds 37}}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (= (:id timer1) (:timer-id command-response)))
           (is (= update-time (:started-time command-response)))
           (is (= {:hours   0
@@ -204,7 +216,7 @@
                               :duration     {:hours   0
                                              :minutes 0
                                              :seconds 37}}))
-        (let [command-response (<!! response-chan)]
+        (let [command-response (try-take!! response-chan)]
           (is (:error command-response))))

       (finally (ws/close socket)))))
@@ -234,15 +246,17 @@
                             {:command      "start-timer"
                              :timer-id     timer-id
                              :started-time current-time}))
-      (is (= timer-id (get @response1 :timer-id)))
-      (is (= current-time (get @response1 :started-time)))
-
-      (testing "All clients with the same gid receive the broadcast"
-        (is (= @response1 @response2)))
+      (let [result1 (try-deref response1)
+            result2 (try-deref response2)]
+        (is (= timer-id (:timer-id result1)))
+        (is (= current-time (:started-time result2)))
+
+        (testing "All clients with the same gid receive the broadcast"
+          (is (= result1 result2))))

       (testing "Some other gid should not receive the broadcast"
-        (is (= :not-received
-               (deref response3 100 :not-received))))
+        (is (= ::not-received
+               (deref response3 100 ::not-received))))

       (finally
         (ws/close socket1)


linearize

linearize

--- src/labs_4_cource/aproximation.cljs
+++ src/labs_4_cource/aproximation.cljs
@@ -1,6 +1,25 @@
 (ns labs-4-cource.aproximation
   (:require [clojure.core.matrix :as m]
-            [labs-4-cource.first-order-lines :refer [floor line-points]]))
+            [labs-4-cource.first-order-lines
+             :refer
+             [->BrezenhameLine floor line-points]]))
+
+(defn get-form-points [matrix [p1 p2 p3 p4]]
+    (m/emap
+     floor
+     (m/mmul
+      (m/matrix
+       (map (fn [t] [(* t t t) (* t t) t 1]) (range 0 1 0.05)))
+      matrix
+      (m/matrix (list p1
+                      p2
+                      p3
+                      p4)))))
+
+(defn linearise [points]
+    (mapcat line-points
+            (map (fn [[p1 p2]] (->BrezenhameLine p1 p2))
+                 (partition 2 1 points))))

 (defn ->Ermit [p1 p2 p3 p4]
   (let [[x1 y1] p1
@@ -17,16 +36,8 @@
     [1  0  0  0]]))

 (defmethod line-points :ermit [{:keys [p1 p4 v1 v4]}]
-  (m/emap
-   floor
-   (m/mmul
-    (m/matrix
-     (map (fn [t] [(* t t t) (* t t) t 1]) (range 0 1 0.01)))
-    ermit-matrix
-    (m/matrix (list p1
-                    p4
-                    v1
-                    v4)))))
+    (linearise (get-form-points ermit-matrix [p1 p4 v1 v4])))
+
 (line-points (->Ermit [30 30] [240 300] [130 20] [200 400]))

 (defn ->Bezie [p1 p2 p3 p4]
@@ -40,22 +51,12 @@
     [1  0  0 0]]))

 (defmethod line-points :bezie [{:keys [p1 p2 p3 p4]}]
-  (m/emap
-   floor
-   (m/mmul
-    (m/matrix
-     (map (fn [t] [(* t t t) (* t t) t 1]) (range 0 1 0.01)))
-    bezie-matrix
-    (m/matrix (list p1
-                    p2
-                    p3
-                    p4)))))
+    (linearise (get-form-points bezie-matrix [p1 p2 p3 p4])))

 (defn ->Spline [& rest]
-  {:type :spline :points (into [] (concat (list (first rest)) rest (take-last 1 rest)))})
-
-(comment
-  (->Spline [0 0] [100 100]))
+  (let [f (take 1 rest)
+        l (take-last 1 rest)]
+    {:type :spline :points (into [] (concat f f rest l l))}))

 (def b-spline-matrix
   (m/mul
@@ -67,20 +68,12 @@
    (/ 1 6)))

 (defn b-spline-segment [[p1 p2 p3 p4]]
-  (m/emap
-   floor
-   (m/mmul
-    (m/matrix
-     (map (fn [t] [(* t t t) (* t t) t 1]) (range 0 1 0.01)))
-    b-spline-matrix
-    (m/matrix (list p1
-                    p2
-                    p3
-                    p4)))))
+  (get-form-points b-spline-matrix [p1 p2 p3 p4]))

 (defmethod line-points :spline [{points :points}]
-  (mapcat b-spline-segment  (partition 4 1 points)))
+  (linearise (mapcat b-spline-segment (partition 4 1 points))))

 (comment
-  (line-points {:type :spline :points [[0 0] [100 100] [200 200] [100 100]]})
-  (b-spline-segment [[0 0] [100 100] [200 200] [100 100]]))
+  (line-points {:type :spline :points [[0 0] [0 0] [100 100] [200 200] [100 100][100 100]]})
+  (doall
+   (partition 2 1 (b-spline-segment [[0 0] [100 100] [200 200] [100 100]]))))


Remove sbase for simplification as only used once

Change-Id: Ie9c1f34480aa6f15845aeff8ff1e05e7dbda8272

--- src/qcast/infoq/site.clj
+++ src/qcast/infoq/site.clj
@@ -63,9 +63,6 @@
 (defn base-url [& s]
   (apply str "http://www.infoq.com" s))

-(defn sbase-url [& s]
-  (apply str "https://www.infoq.com" s))
-
 (defn poster-url [file-path]
   (when file-path (base-url file-path)))

@@ -76,7 +73,7 @@
   (base-url id))

 (defn login [user pass]
-  (POST (sbase-url "/login.action")
+  (POST "https://www.infoq.com/login.action"
         {:form-params {:username user
                        :password pass}}))


Remove unnecessary symbol

Remove unnecessary symbol

--- src/nightmod/sandbox.clj
+++ src/nightmod/sandbox.clj
@@ -21,7 +21,7 @@
        addMethod forName
        load load-file load-string load-reader
        ns-resolve ns-publics ns-unmap ns-map ns-interns the-ns in-ns
-       push-thread-bindings pop-thread-bindings future future-call
+       push-thread-bindings pop-thread-bindings future-call
        agent send send-off
        pmap pvalues pcalls
        System/out System/in System/err


fix regression with Indexing

fix regression with Indexing

--- src/node/game/cards.cljs
+++ src/node/game/cards.cljs
@@ -601,7 +601,7 @@
    {:effect (effect (run :rd {:replace-access
                               {:msg "rearrange the top 5 cards of R&D"
                                :effect (req (doseq [c (take 5 (:deck corp))]
-                                              (move state side c :play-area false true)))}}))}
+                                              (move state :corp c :play-area false true)))}}))}

    "Infiltration"
    {:prompt "Gain 2 [Credits] or expose a card?" :choices ["Gain 2 [Credits]" "Expose a card"]


Implement home/end/delete keys in Selectable

--- src/main/om_mantras/selectable.cljs
+++ src/main/om_mantras/selectable.cljs
@@ -93,20 +93,20 @@
     (.recalculate-active-match this)
     (.show-matches this true))

-  (update-selected [this items]
-    (om/update-state! this assoc :selected items)
-    (some-> this om/props :change-fn (apply [items])))
+  (update-selected [this f]
+    (let [selected (f (:selected (om/get-state this)))]
+      (om/update-state! this assoc :selected selected)
+      (some-> this om/props :change-fn (apply [selected]))))

   (select-match [this match]
     (let [match (cond-> match (om/component? match) (-> om/props :item))
-          selected (:selected (om/get-state this))
           caret (:caret (om/get-state this))]
-      (let [[before after] (split-at caret selected)]
-        (->> (concat before [match] after)
-             (into [])
-             (.update-selected this)))
-      (.update-caret this inc)
-      (.update-text this "")))
+      (.update-selected this
+                        (fn [selected]
+                          (let [[before after] (split-at caret selected)]
+                            (into [] (concat before [match] after))))))
+    (.update-caret this inc)
+    (.update-text this ""))

   (show-matches [this show?]
     (om/update-state! this assoc :show-matches show?))
@@ -132,25 +132,27 @@

   (key-backspace [this e]
     (when (empty? (:text (om/get-state this)))
-      (let [selected (:selected (om/get-state this))
-            caret (:caret (om/get-state this))]
-        (let [[before after] (split-at caret selected)]
-          (->> (concat (butlast before) after)
-               (into [])
-               (.update-selected this)))
-        (.update-caret this dec)
-        (.update-text this ""))))
-
-  (key-left [this e]
-    (when (empty? (:text (om/get-state this)))
+      (let [caret (:caret (om/get-state this))]
+        (.update-selected this
+                          (fn [selected]
+                            (let [[before after] (split-at caret selected)]
+                              (into [] (concat (butlast before) after))))))
       (.update-caret this dec)))

-  (key-right [this e]
-    (when (empty? (:text (om/get-state this)))
-      (.update-caret this inc)))
+  (key-delete [this e]
+    (when (empty? (:text (om/get-state this)))
+      (let [caret (:caret (om/get-state this))]
+        (.update-selected this
+                          (fn [selected]
+                            (let [[before after] (split-at caret selected)]
+                              (into [] (concat before (rest after)))))))
+      (.update-caret this identity)))

   (key-escape [this e]
     (.show-matches this false))
+
+  (key-return [this e]
+    (some->> this om/get-state :active-match (.select-match this)))

   (key-up [this e]
     (let [{:keys [matches active-match]} (om/get-state this)
@@ -168,23 +170,39 @@
            (om/update-state! this assoc :active-match)))
     (.preventDefault e))

-  (key-return [this e]
-    (some->> this om/get-state :active-match (.select-match this)))
+  (key-left [this e]
+    (when (empty? (:text (om/get-state this)))
+      (.update-caret this dec)))
+
+  (key-right [this e]
+    (when (empty? (:text (om/get-state this)))
+      (.update-caret this inc)))
+
+  (key-home [this e]
+    (when (empty? (:text (om/get-state this)))
+      (.update-caret this (constantly 0))))
+
+  (key-end [this e]
+    (when (empty? (:text (om/get-state this)))
+      (.update-caret this #(count (:selected (om/get-state this))))))

   (key-press [this e]
     (case (.-keyCode e)
       8  (.key-backspace this e)
+      46 (.key-delete this e)
       27 (.key-escape this e)
+      13 (.key-return this e)
       38 (.key-up this e)
       40 (.key-down this e)
-      13 (.key-return this e)
       37 (.key-left this e)
       39 (.key-right this e)
+      36 (.key-home this e)
+      35 (.key-end this e)
          true))

   (componentWillMount [this]
     (.update-text this "")
-    (.update-selected this [])
+    (.update-selected this (constantly []))
     (.update-caret this (constantly 0))
     (.show-matches this false))


Remove word daily from digest subject.

Remove word daily from digest subject.

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -437,7 +437,7 @@

 (defn digest-title [org-name]
   (let [date-str (time-format/unparse digest-subject-format (time/now))]
-    (str "☕ Your " (or org-name "Carrot") " daily digest for " date-str)))
+    (str "☕ Your " (or org-name "Carrot") " digest for " date-str)))

 (defn- get-digest-url [digest-data]
   (s/join "/" [config/web-url (:org-slug digest-data) "all-posts"]))


unique

unique

--- src/ophion/aggregate.clj
+++ src/ophion/aggregate.clj
@@ -99,7 +99,7 @@
     (to-vertex vertex-label where))))

 (defn from-unique
-  ([edge-label vertex-label] (from-dedup edge-label vertex-label {}))
+  ([edge-label vertex-label] (from-unique edge-label vertex-label {}))
   ([edge-label vertex-label where]
    (concat
     (from-edge edge-label)
@@ -107,7 +107,7 @@
     (from-vertex vertex-label where))))

 (defn to-unique
-  ([edge-label vertex-label] (to-dedup edge-label vertex-label {}))
+  ([edge-label vertex-label] (to-unique edge-label vertex-label {}))
   ([edge-label vertex-label where]
    (concat
     (to-edge edge-label)


adding MessageRouting protocol + pass-on function

--- src/ow/starbuck/core.clj
+++ src/ow/starbuck/core.clj
@@ -19,6 +19,9 @@
             [clojure.core.async :refer [put! >! >!! <! <!! go go-loop pub sub chan close! timeout alts!! promise-chan]]
             [taoensso.timbre :refer [trace debug info warn error fatal]]))

+(defprotocol MessageRouting
+  (pass-on [this req]))
+
 (defn safe-process [this f req & args]
   (try
     (apply f this req args)
@@ -38,6 +41,12 @@
     `(defrecord ~name [~'processfn ~'ch-in ~'ch-out     ;; constructor-initialized fields
                        ]                                ;; start/stop-initialized fields

+       MessageRouting
+
+       (pass-on [this# req#]
+         (debug "routing message...")
+         (put! ~'ch-out req#))
+
        c/Lifecycle

        (start [~this1]
@@ -53,8 +62,8 @@
                          (debug "sending response(s)")
                          (cond
                            (nil? res#)        nil
-                           (sequential? res#) (dorun (map #(put! ~'ch-out %) res#))
-                           true               (put! ~'ch-out res#)))))
+                           (sequential? res#) (dorun (map #(pass-on ~this1 %) res#))
+                           true               (pass-on ~this1 res#)))))
                  (recur (<! ~'ch-in)))
              (info "stopped.")))
          (let [~this1 ~(if startfn


Added some comments for the playground

Added some comments for the playground

--- src/tensorflow_clj/graph_playground.clj
+++ src/tensorflow_clj/graph_playground.clj
@@ -7,6 +7,12 @@
            [tensorflow-clj.graph.transform :refer :all]
            [tensorflow-clj.util :refer [assoc-not-empty assoc-in-not-empty]]
            [clojure.string :as str]))
+;TODO this is a playground namespace for now
+;pieces will be hacked on here in isolation and then moved out to other namespaces
+;where they can be re-used once they are considered semi-stable
+;much of this code is commented out as I'm just running it once here or there
+;during development. anything that I think *might* be useful will be thrown into a function
+;any functions that prove to have some utility will be grouped and moved to their own ns

 (defn def-tensor-nodes [name value dtype dims]
   (let [target (build-node-variable dims dtype :name name)
@@ -61,18 +67,6 @@
         reduce-mean-node (build-node-reduce-mean input-node reduction-indices-node)]
     [reduction-indices-node reduce-mean-node]))

-(let [y-mx-b-nodes (build-nodes-y-mx-b)
-      placeholder-node (build-node-placeholder "DT_FLOAT" :name "y_hat")
-      softmax-nodes (build-nodes-softmax-cross-entropy-with-logits (last y-mx-b-nodes) placeholder-node)
-      reduce-mean-nodes (build-nodes-reduce-mean (last softmax-nodes))
-      nodes (concat y-mx-b-nodes softmax-nodes reduce-mean-nodes)
-      tf-nodes (map clj-node->tensorflow-node nodes)
-      graph {:node tf-nodes
-             :versions {:producer 21}}]
-  ;(proto/protobuf-load proto-much/proto-graph-def
-  ;                     (proto/protobuf-dump proto-much/proto-graph-def graph))
-  graph)
-
 ;;todo build these for reals
 (defn build-loop [loop-node times])
 (defn build-train-next-batch [])
@@ -81,21 +75,17 @@
 (defn build-cast [node dtype])
 (defn build-ApplyGradientDescent [variable learning-rate gradient-control])

-(def linreg-graph (proto/protobuf-load proto-much/proto-graph-def (util/slurp-binary "misc/linreg.pb")))
-(-> linreg-graph :node count)
-(mapv :name (-> linreg-graph :node))
-(filter #(= "Identity" (:op %)) (-> linreg-graph :node))
-(map #(str (:name %) " " (:op %) " " (:input %)) (-> linreg-graph :node))
-
-(def addconst-graph (proto/protobuf-load proto-much/proto-graph-def (util/slurp-binary "misc/addconst.pb")))
-(-> addconst-graph :node count)
-
-(def nonsense-graph (proto/protobuf-load proto-much/proto-graph-def (util/slurp-binary "misc/nonsense.pb")))
-
-(def mnist-simple-graph (proto/protobuf-load proto-much/proto-graph-def (util/slurp-binary "misc/mnist_simple.pbtxt")))
-(def mnist-meta-graph (proto/protobuf-load proto-much/proto-meta-graph-def (util/slurp-binary "misc/mnist_simple.model.meta")))
-
-(-> mnist-meta-graph keys)
+;(def linreg-graph (proto/protobuf-load proto-much/proto-graph-def (util/slurp-binary "misc/linreg.pb")))
+;(-> linreg-graph :node count)
+;(mapv :name (-> linreg-graph :node))
+;(filter #(= "Identity" (:op %)) (-> linreg-graph :node))
+;(map #(str (:name %) " " (:op %) " " (:input %)) (-> linreg-graph :node))
+;(def addconst-graph (proto/protobuf-load proto-much/proto-graph-def (util/slurp-binary "misc/addconst.pb")))
+;(-> addconst-graph :node count)
+;(def nonsense-graph (proto/protobuf-load proto-much/proto-graph-def (util/slurp-binary "misc/nonsense.pb")))
+;(def mnist-simple-graph (proto/protobuf-load proto-much/proto-graph-def (util/slurp-binary "misc/mnist_simple.pbtxt")))
+;(def mnist-meta-graph (proto/protobuf-load proto-much/proto-meta-graph-def (util/slurp-binary "misc/mnist_simple.model.meta")))
+;(-> mnist-meta-graph keys)

 (defn parse-node-ref [node-ref]
   (let [[name output] (str/split node-ref #":")]
@@ -125,77 +115,88 @@
        :value
        (map (partial parse-variable true))))

-(parse-trainable-vars mnist-meta-graph)
-
-(def thing (-> nonsense-graph :node second :attr second :value :tensor :string-val first proto-much/byte-string-to-string))
-
-(time
-  (exp/exec-graph-sess-fn
-    (fn [graph session]
-      (let [nodes (build-nodes-y-mx-b)
-            out-node-name (-> nodes last :name)
-            tf-nodes (map clj-node->tensorflow-node nodes)
-            graph-def {:node tf-nodes
-                       :versions {:producer 21}}
-            graph-bytes (proto/protobuf-dump proto-much/proto-graph-def graph-def)]
-        (.importGraphDef graph graph-bytes)
-        (exp/run-graph-thing session {:x [[5.0 12.0]
-                                          [2.5 3.4]]
-                                      :W [[6.0 1.3]
-                                          [0.0 0.0]]
-                                      :b [[0.0]]}
-                             out-node-name)
-        ))))
-
-(time
-  (exp/exec-graph-sess-fn
-    (fn [graph session]
-      (let [y-mx-b-nodes (build-nodes-y-mx-b)
-            out-node-1 (-> y-mx-b-nodes last)
-            placeholder-node (build-node-placeholder "DT_FLOAT" :name "y_hat")
-            softmax-nodes (build-nodes-softmax-cross-entropy-with-logits out-node-1 placeholder-node)
-            out-node-2 (-> softmax-nodes last)
-            nodes (concat y-mx-b-nodes softmax-nodes)
-            tf-nodes (map clj-node->tensorflow-node nodes)
-            graph-def {:node tf-nodes
-                       :versions {:producer 21}}
-            graph-bytes (proto/protobuf-dump proto-much/proto-graph-def graph-def)]
-        (.importGraphDef graph graph-bytes)
-        (exp/run-graph-thing session {:x [[5.0 12.0]
-                                          [2.5 3.4]]
-                                      :W [[6.0 1.3]
-                                          [0.0 0.0]]
-                                      :b [[2.0]]
-                                      :y_hat [[5.3 8.5]
-                                              [900.24 9.94]]}
-                             (-> out-node-1 :name)
-                             (-> out-node-2 :name))
-        ))))
-
-(time
-  (exp/exec-graph-sess-fn
-    (fn [graph session]
-      (let [y-mx-b-nodes (build-nodes-y-mx-b)
-            out-node-1 (-> y-mx-b-nodes last)
-            placeholder-node (build-node-placeholder "DT_FLOAT" :name "y_hat")
-            softmax-nodes (build-nodes-softmax-cross-entropy-with-logits out-node-1 placeholder-node)
-            out-node-2 (-> softmax-nodes last)
-            reduce-mean-nodes (build-nodes-reduce-mean out-node-2)
-            out-node-3 (-> reduce-mean-nodes last)
-            nodes (concat y-mx-b-nodes softmax-nodes reduce-mean-nodes)
-            tf-nodes (map clj-node->tensorflow-node nodes)
-            graph-def {:node tf-nodes
-                       :versions {:producer 21}}
-            graph-bytes (proto/protobuf-dump proto-much/proto-graph-def graph-def)]
-        (.importGraphDef graph graph-bytes)
-        (exp/run-graph-thing session {:x [[5.0 12.0]
-                                          [2.5 3.4]]
-                                      :W [[6.0 1.3]
-                                          [0.0 0.0]]
-                                      :b [[2.0]]
-                                      :y_hat [[5.3 3.5]
-                                              [0.24 3.94]]}
-                             (-> out-node-1 :name)
-                             (-> out-node-2 :name)
-                             (-> out-node-3 :name))
-        ))))
+;(parse-trainable-vars mnist-meta-graph)
+;(def thing (-> nonsense-graph :node second :attr second :value :tensor :string-val first proto-much/byte-string-to-string))
+
+;(let [y-mx-b-nodes (build-nodes-y-mx-b)
+;      placeholder-node (build-node-placeholder "DT_FLOAT" :name "y_hat")
+;      softmax-nodes (build-nodes-softmax-cross-entropy-with-logits (last y-mx-b-nodes) placeholder-node)
+;      reduce-mean-nodes (build-nodes-reduce-mean (last softmax-nodes))
+;      nodes (concat y-mx-b-nodes softmax-nodes reduce-mean-nodes)
+;      tf-nodes (map clj-node->tensorflow-node nodes)
+;      graph {:node tf-nodes
+;             :versions {:producer 21}}]
+;  (proto/protobuf-load proto-much/proto-graph-def
+;                       (proto/protobuf-dump proto-much/proto-graph-def graph))
+;  graph)
+
+;(time
+;  (exp/exec-graph-sess-fn
+;    (fn [graph session]
+;      (let [nodes (build-nodes-y-mx-b)
+;            out-node-name (-> nodes last :name)
+;            tf-nodes (map clj-node->tensorflow-node nodes)
+;            graph-def {:node tf-nodes
+;                       :versions {:producer 21}}
+;            graph-bytes (proto/protobuf-dump proto-much/proto-graph-def graph-def)]
+;        (.importGraphDef graph graph-bytes)
+;        (exp/run-graph-thing session {:x [[5.0 12.0]
+;                                          [2.5 3.4]]
+;                                      :W [[6.0 1.3]
+;                                          [0.0 0.0]]
+;                                      :b [[0.0]]}
+;                             out-node-name)
+;        ))))
+;
+;(time
+;  (exp/exec-graph-sess-fn
+;    (fn [graph session]
+;      (let [y-mx-b-nodes (build-nodes-y-mx-b)
+;            out-node-1 (-> y-mx-b-nodes last)
+;            placeholder-node (build-node-placeholder "DT_FLOAT" :name "y_hat")
+;            softmax-nodes (build-nodes-softmax-cross-entropy-with-logits out-node-1 placeholder-node)
+;            out-node-2 (-> softmax-nodes last)
+;            nodes (concat y-mx-b-nodes softmax-nodes)
+;            tf-nodes (map clj-node->tensorflow-node nodes)
+;            graph-def {:node tf-nodes
+;                       :versions {:producer 21}}
+;            graph-bytes (proto/protobuf-dump proto-much/proto-graph-def graph-def)]
+;        (.importGraphDef graph graph-bytes)
+;        (exp/run-graph-thing session {:x [[5.0 12.0]
+;                                          [2.5 3.4]]
+;                                      :W [[6.0 1.3]
+;                                          [0.0 0.0]]
+;                                      :b [[2.0]]
+;                                      :y_hat [[5.3 8.5]
+;                                              [900.24 9.94]]}
+;                             (-> out-node-1 :name)
+;                             (-> out-node-2 :name))
+;        ))))
+;
+;(time
+;  (exp/exec-graph-sess-fn
+;    (fn [graph session]
+;      (let [y-mx-b-nodes (build-nodes-y-mx-b)
+;            out-node-1 (-> y-mx-b-nodes last)
+;            placeholder-node (build-node-placeholder "DT_FLOAT" :name "y_hat")
+;            softmax-nodes (build-nodes-softmax-cross-entropy-with-logits out-node-1 placeholder-node)
+;            out-node-2 (-> softmax-nodes last)
+;            reduce-mean-nodes (build-nodes-reduce-mean out-node-2)
+;            out-node-3 (-> reduce-mean-nodes last)
+;            nodes (concat y-mx-b-nodes softmax-nodes reduce-mean-nodes)
+;            tf-nodes (map clj-node->tensorflow-node nodes)
+;            graph-def {:node tf-nodes
+;                       :versions {:producer 21}}
+;            graph-bytes (proto/protobuf-dump proto-much/proto-graph-def graph-def)]
+;        (.importGraphDef graph graph-bytes)
+;        (exp/run-graph-thing session {:x [[5.0 12.0]
+;                                          [2.5 3.4]]
+;                                      :W [[6.0 1.3]
+;                                          [0.0 0.0]]
+;                                      :b [[2.0]]
+;                                      :y_hat [[5.3 3.5]
+;                                              [0.24 3.94]]}
+;                             (-> out-node-1 :name)
+;                             (-> out-node-2 :name)
+;                             (-> out-node-3 :name))
+;        ))))


Code cleanup :sweat:

Code cleanup :sweat:

--- src/metabase/sync_database/sync.clj
+++ src/metabase/sync_database/sync.clj
@@ -118,14 +118,14 @@
   "Update the working `Table` and `Field` metadata for a given `Table` based on the latest raw schema information.
    This function uses the data in `RawTable` and `RawColumn` to update the working data models as needed."
   [{raw-table-id :raw_table_id, table-id :id, :as existing-table}]
-  (when-let [{database-id :database_id, :as raw-tbl} (db/sel :one RawTable :id raw-table-id)]
+  (when-let [{database-id :database_id, :as raw-table} (db/sel :one RawTable :id raw-table-id)]
     (try
-      (if-not (:active raw-tbl)
+      (if-not (:active raw-table)
         ;; looks like the table has been deactivated, so lets retire this Table and its fields
         (table/retire-tables #{table-id})
         ;; otherwise update based on the RawTable/RawColumn information
         (do
-          (save-table-fields! (table/update-table existing-table raw-tbl))
+          (save-table-fields! (table/update-table existing-table raw-table))

           ;; handle setting any fk relationships
           (when-let [table-fks (k/select RawColumn
@@ -174,13 +174,13 @@
 (defn- create-and-update-tables!
   "Create/update tables (and their fields)."
   [database existing-tables raw-tables]
-  (doseq [{raw-table-id :id, :as raw-tbl} (non-blacklisted-tables raw-tables)]
+  (doseq [{raw-table-id :id, :as raw-table} (non-blacklisted-tables raw-tables)]
     (try
-      (if-let [existing-table (get existing-tables raw-table-id)]
-        ;; table already exists, update it
-        (save-table-fields! (table/update-table existing-table raw-tbl))
-        ;; must be a new table, insert it
-        (save-table-fields! (table/create-table (:id database) (assoc raw-tbl :raw-table-id raw-table-id))))
+      (save-table-fields! (if-let [existing-table (get existing-tables raw-table-id)]
+                            ;; table already exists, update it
+                            (table/update-table existing-table raw-table)
+                            ;; must be a new table, insert it
+                            (table/create-table (:id database) (assoc raw-table :raw-table-id raw-table-id))))
       (catch Throwable e
         (log/error (u/format-color 'red "Unexpected error syncing table") e)))))


Add uploading spinner for images page in dashboard.

--- src/uxbox/main/ui/dashboard/images.cljs
+++ src/uxbox/main/ui/dashboard/images.cljs
@@ -58,6 +58,10 @@
 (def ^:private images-ref
   (-> (l/key :images-by-id)
       (l/derive st/state)))
+
+(def ^:private uploading?-ref
+  (-> (l/key :uploading)
+      (l/derive dashboard-ref)))

 ;; --- Page Title

@@ -185,22 +189,25 @@
 ;; --- Grid

 (mx/defcs grid-form
-  {:mixins [mx/static]}
+  {:mixins [mx/static mx/reactive]}
   [own coll-id]
   (letfn [(forward-click [event]
             (dom/click (mx/ref-node own "file-input")))
           (on-file-selected [event]
             (let [files (dom/get-event-files event)]
               (rs/emit! (di/create-images coll-id files))))]
-    [:div.grid-item.add-project {:on-click forward-click}
-     [:span "+ New image"]
-     [:input.upload-image-input
-      {:style {:display "none"}
-       :multiple true
-       :ref "file-input"
-       :value ""
-       :type "file"
-       :on-change on-file-selected}]]))
+    (let [uploading? (mx/react uploading?-ref)]
+      [:div.grid-item.add-project {:on-click forward-click}
+       (if uploading?
+         [:div i/loader-pencil]
+         [:span "+ New image"])
+       [:input.upload-image-input
+        {:style {:display "none"}
+         :multiple true
+         :ref "file-input"
+         :value ""
+         :type "file"
+         :on-change on-file-selected}]])))

 (mx/defc grid-options-copy
   {:mixins [mx/reactive mx/static]}


Major refactor of images page ns (in the same way as colors ns).

--- src/uxbox/main/ui/dashboard/images.cljs
+++ src/uxbox/main/ui/dashboard/images.cljs
@@ -50,321 +50,429 @@
     projs
     (filter #(contains-term? (:name %) term) projs)))

-;; --- Lenses
+;; --- Refs

 (def ^:private dashboard-ref
   (-> (l/key :dashboard)
       (l/derive st/state)))

-(def ^:private collections-by-id-ref
-  (-> (l/key :images-by-id)
+;; (def ^:private collections-by-id-ref
+;;   (-> (l/key :images-by-id)
+;;       (l/derive st/state)))
+
+;; (def ^:private images-ordering-ref
+;;   (-> (l/in [:dashboard :images-order])
+;;       (l/derive st/state)))
+
+;; (def ^:private images-filtering-ref
+;;   (-> (l/in [:dashboard :images-filter])
+;;       (l/derive st/state)))
+
+(def ^:private collections-map-ref
+  (-> (comp (l/key :images-by-id)
+            (ul/merge library/+image-collections-by-id+))
       (l/derive st/state)))

-(def ^:private images-ordering-ref
-  (-> (l/in [:dashboard :images-order])
-      (l/derive st/state)))
-
-(def ^:private images-filtering-ref
-  (-> (l/in [:dashboard :images-filter])
-      (l/derive st/state)))
+(def ^:private collections-ref
+  (-> (l/lens vals)
+      (l/derive collections-map-ref)))

 (defn- focus-collection
-  [collid]
-  (-> (l/key collid)
-      (l/derive collections-by-id-ref)))
+  [id]
+  (-> (l/key id)
+      (l/derive collections-map-ref)))

 ;; --- Page Title

-(defn page-title-render
-  [own coll]
+(mx/defcs page-title
+  {:mixins [(mx/local {}) mx/static mx/reactive]}
+  [own {:keys [id] :as coll}]
   (let [local (:rum/local own)
         dashboard (mx/react dashboard-ref)
-        own? (:builtin coll false)]
-    (letfn [(persist [event]
-              (let [name (:coll-name @local)]
-                (rs/emit! (di/rename-collection (:id coll) name))
+        own? (= :builtin (:type coll))
+        edit? (:edit @local)]
+    (letfn [(on-save [e]
+              (let [dom (mx/ref-node own "input")
+                    name (.-innerText dom)]
+                (rs/emit! (di/rename-collection id (str/trim name)))
                 (swap! local assoc :edit false)))
-
-            (on-key-down [event]
+            (on-cancel [e]
+              (swap! local assoc :edit false))
+            (on-edit [e]
+              (swap! local assoc :edit true))
+            (on-input-keydown [e]
               (cond
-                (kbd/esc? event)
-                (swap! local assoc :edit false)
-
-                (kbd/enter? event)
+                (kbd/esc? e) (on-cancel e)
+                (kbd/enter? e)
                 (do
-                  (dom/stop-propagation event)
-                  (persist event))))
-
-            (on-input [event]
-              (let [content (dom/event->inner-text event)]
-                (swap! local assoc :coll-name content)))
-
-            (on-edit [e]
-              (swap! local assoc :edit true :coll-name (:name coll)))
-
-            (on-delete [e]
+                  (dom/prevent-default e)
+                  (dom/stop-propagation e)
+                  (on-save e))))
+            (on-delete []
               (rs/emit! (di/delete-collection (:id coll))))]
-      (html
-       [:div.dashboard-title
-        [:h2
-         (if (:edit @local)
-           [:div.dashboard-title-field
-            [:span.edit
-             {:content-editable ""
-              :on-input on-input
-              :on-key-down on-key-down}
-             (:name coll)]
-            [:span.close
-             {:on-click #(swap! local assoc :edit false)}
-             i/close]]
-           [:span.dashboard-title-field
-            (:name coll)])]
-        (if (and (not own?) coll)
-          [:div.edition
-           (if (:edit @local)
-             [:span {:on-click persist} i/save]
-             [:span {:on-click on-edit} i/pencil])
-           [:span {:on-click on-delete} i/trash]])]))))
-
-(def ^:private page-title
-  (mx/component
-   {:render page-title-render
-    :name "page-title"
-    :mixins [(mx/local) mx/static mx/reactive]}))
+      [:div.dashboard-title
+       [:h2
+        (if edit?
+          [:div.dashboard-title-field
+           [:span.edit
+            {:content-editable true
+             :ref "input"
+             :on-key-down on-input-keydown}
+            (:name coll)]
+           [:span.close {:on-click on-cancel} i/close]]
+          [:span.dashboard-title-field
+           {:on-double-click on-edit}
+           (:name coll)])]
+       (if (and (not own?) coll)
+         [:div.edition
+          (if edit?
+            [:span {:on-click on-save} i/save]
+            [:span {:on-click on-edit} i/pencil])
+          [:span {:on-click on-delete} i/trash]])])))

 ;; --- Nav

-(defn nav-render
-  [own]
-  (let [dashboard (mx/react dashboard-ref)
-        collid (:collection-id dashboard)
-        own? (= (:collection-type dashboard) :own)
-        builtin? (= (:collection-type dashboard) :builtin)
-        collections (if builtin?
-                      (vals library/+image-collections-by-id+)
-                      (vals (mx/react collections-by-id-ref)))
-        show-builtin #(rs/emit! (di/set-collection-type :builtin))
-        show-own #(rs/emit! (di/set-collection-type :own))
-        new-coll #(rs/emit! (di/create-collection))
-        select-coll #(rs/emit! (di/set-collection % builtin?))]
-    (html
-     [:div.library-bar
-      [:div.library-bar-inside
-       [:ul.library-tabs
-        [:li {:class-name (when builtin? "current")
-              :on-click show-builtin}
-         "STANDARD"]
-        [:li {:class-name (when own? "current")
-              :on-click show-own}
-         "YOUR LIBRARIES"]]
-       [:ul.library-elements
-        (when own?
-          [:li
-           [:a.btn-primary {:on-click new-coll} "+ New library"]])
-        (for [{:keys [id images name]} collections
-              :let [num (count images)]]
-          [:li {:key (str id)
-                :on-click (partial select-coll id)
-                :class (when (= id collid) "current")}
-           [:span.element-title name]
-           [:span.element-subtitle
-            (tr "ds.num-elements" (t/c num))]])]]])))
-
-(def ^:private nav
-  (mx/component
-   {:render nav-render
-    :name "nav"
-    :mixins [mx/reactive mx/static]}))
-
-;; --- Grid
-
-(defn- grid-render
-  [own]
-  (let [local (:rum/local own)
-        dashboard (mx/react dashboard-ref)
-        coll-type (:collection-type dashboard)
-        coll-id (:collection-id dashboard)
-        own? (= coll-type :own)
-        builtin? (= coll-type :builtin)
-        coll (if builtin?
-               (get library/+image-collections-by-id+ coll-id)
-               (mx/react (focus-collection coll-id)))
-        images-filtering (mx/react images-filtering-ref)
-        images-ordering (mx/react images-ordering-ref)
-        images (->> (:images coll)
-                    (remove nil?)
-                    (filter-images-by images-filtering)
-                    (sort-images-by images-ordering))
-        show-menu? (not (empty? (:selected @local)))]
-    (letfn [(toggle-check [image]
-              (swap! local update :selected #(data/conj-or-disj % image)))
-            (toggle-check-card [image event]
-              (when (kbd/shift? event)
-                (toggle-check image)))
-            (forward-click [event]
-              (dom/click (mx/ref-node own "file-input")))
-            (delete-selected []
-              (->> (:selected @local)
-                   (run! #(rs/emit! (di/delete-image coll-id %)))))
-            (on-file-selected [event]
-              (let [files (dom/get-event-files event)]
-                (rs/emit! (di/create-images coll-id files))))]
-      (when coll
-        (html
-         [:section.dashboard-grid.library
-          (page-title coll)
-          [:div.dashboard-grid-content
-           [:div.dashboard-grid-row
-            (if own?
-              [:div.grid-item.add-project {:on-click forward-click}
-               [:span "+ New image"]
-               [:input.upload-image-input
-                {:style {:display "none"}
-                 :multiple true
-                 :ref "file-input"
-                 :value ""
-                 :type "file"
-                 :on-change on-file-selected}]])
-
-            (for [image images
-                  :let [selected? (contains? (:selected @local) image)]]
-              [:div.grid-item.images-th
-               {:key (:id image)
-                :on-click (partial toggle-check-card image)}
-               [:div.grid-item-th
-                {:style {:background-image (str "url('" (:thumbnail image) "')")}}
-                [:div.input-checkbox.check-primary
-                 [:input {:type "checkbox"
-                          :id (:id image)
-                          :on-click (partial toggle-check image)
-                          :checked selected?}]
-                 [:label {:for (:id image)}]]]
-               [:span (:name image)]])]
-
-           (when show-menu?
-             ;; MULTISELECT OPTIONS BAR
-             [:div.multiselect-bar
-              [:div.multiselect-nav
-               [:span.move-item.tooltip.tooltip-top {:alt "Copy to"} i/organize]
-               (if own?
-                 [:span.copy.tooltip.tooltip-top {:alt "Duplicate"} i/copy])
-               (if own?
-                 [:span.delete.tooltip.tooltip-top
-                  {:alt "Delete"
-                   :on-click delete-selected}
-                  i/trash])]])]])))))
-
-(def ^:private grid
-  (mx/component
-   {:render grid-render
-    :name "grid"
-    :mixins [(rum/local {:selected #{}}) mx/static mx/reactive]}))
-
-;; --- Sort Widget
-
-(defn- sort-widget-render
-  []
-  (let [ordering (mx/react images-ordering-ref)
-        on-change #(rs/emit! (di/set-images-ordering
-                              (keyword (.-value (.-target %)))))]
-    (html
-     [:div
-      [:span (tr "ds.project-ordering")]
-      [:select.input-select
-       {:on-change on-change
-        :value (:name ordering "")}
-       (for [option (keys +ordering-options+)
-             :let [option-id (get +ordering-options+ option)
-                   option-value (:name option)
-                   option-text (tr option-id)]]
-         [:option
-          {:key option-id
-           :value option-value}
-          option-text])]])))
-
-(def ^:private sort-widget
-  (mx/component
-   {:render sort-widget-render
-    :name "sort-widget-render"
-    :mixins [mx/reactive mx/static]}))
-
-;; --- Filtering Widget
-
-(defn- search-widget-render
-  []
-  (letfn [(on-term-change [event]
-            (-> (dom/get-target event)
-                (dom/get-value)
-                (di/set-images-filtering)
-                (rs/emit!)))
-          (on-clear [event]
-            (rs/emit! (di/clear-images-filtering)))]
-    (html
-     [:form.dashboard-search
-      [:input.input-text
-       {:key :images-search-box
-        :type "text"
-        :on-change on-term-change
-        :auto-focus true
-        :placeholder (tr "ds.project-search.placeholder")
-        :value (mx/react images-filtering-ref)}]
-      [:div.clear-search {:on-click on-clear} i/close]])))
-
-(def ^:private search-widget
-  (mx/component
-   {:render search-widget-render
-    :name "search-widget"
-    :mixins [mx/reactive mx/static]}))
-
-;; --- Menu
-
-(defn- menu-render
+(mx/defc nav-item
+  {:mixins [mx/static]}
+  [collection selected?]
+  (letfn [(on-click [event]
+            (let [type (:type collection)
+                  id (:id collection)]
+              (rs/emit! (di/select-collection type id))))]
+    (let [colors (count (:data collection))]
+      [:li {:on-click on-click
+            :class-name (when selected? "current")}
+       [:span.element-title (:name collection)]
+       [:span.element-subtitle
+        (tr "ds.num-elements" (t/c colors))]])))
+
+(mx/defc nav-section
+  {:mixins [mx/static mx/reactive]}
+  [type selected]
+  (let [own? (= type :own)
+        builtin? (= type :builtin)
+        collections (cond->> (mx/react collections-ref)
+                      own? (filter #(= :own (:type %)))
+                      builtin? (filter #(= :builtin (:type %)))
+                      own? (sort-by :id))]
+    [:ul.library-elements
+     (when own?
+       [:li
+        [:a.btn-primary
+         {:on-click #(rs/emit! (di/create-collection))}
+         "+ New library"]])
+     (for [coll collections
+           :let [selected? (= (:id coll) selected)
+                 key (str (:id coll))]]
+       (-> (nav-item coll selected?)
+           (mx/with-key key)))]))
+
+(mx/defc nav
+  {:mixins [mx/static mx/reactive]}
   []
   (let [dashboard (mx/react dashboard-ref)
-        coll-id (:collection-id dashboard)
+        collections (mx/react collections-ref)
+        selected (:id dashboard)
+        type (:type dashboard)
+        own? (= type :own)
+        builtin? (= type :builtin)]
+    (letfn [(select-tab [type]
+              (let [xf (filter #(= type (:type %)))
+                    colls (sequence xf collections)]
+                (if-let [item (first colls)]
+                  (rs/emit! (di/select-collection type (:id item)))
+                  (rs/emit! (di/select-collection type)))))]
+      [:div.library-bar
+       [:div.library-bar-inside
+        [:ul.library-tabs
+         [:li {:class-name (when builtin? "current")
+               :on-click (partial select-tab :builtin)}
+          "STANDARD"]
+         [:li {:class-name (when own? "current")
+               :on-click (partial select-tab :own)}
+          "YOUR LIBRARIES"]]
+        (nav-section type selected)]])))
+
+;; --- Grid
+
+;; (defn- grid-render
+;;   [own]
+;;   (let [local (:rum/local own)
+;;         dashboard (mx/react dashboard-ref)
+;;         coll-type (:collection-type dashboard)
+;;         coll-id (:collection-id dashboard)
+;;         own? (= coll-type :own)
+;;         builtin? (= coll-type :builtin)
+;;         coll (if builtin?
+;;                (get library/+image-collections-by-id+ coll-id)
+;;                (mx/react (focus-collection coll-id)))
+;;         images-filtering (mx/react images-filtering-ref)
+;;         images-ordering (mx/react images-ordering-ref)
+;;         images (->> (:images coll)
+;;                     (remove nil?)
+;;                     (filter-images-by images-filtering)
+;;                     (sort-images-by images-ordering))
+;;         show-menu? (not (empty? (:selected @local)))]
+;;     (letfn [(toggle-check [image]
+;;               (swap! local update :selected #(data/conj-or-disj % image)))
+;;             (toggle-check-card [image event]
+;;               (when (kbd/shift? event)
+;;                 (toggle-check image)))
+;;             (delete-selected []
+;;               (->> (:selected @local)
+;;                    (run! #(rs/emit! (di/delete-image coll-id %)))))
+;;       (when coll
+;;         (html
+;;          [:section.dashboard-grid.library
+;;           (page-title coll)
+;;           [:div.dashboard-grid-content
+;;            [:div.dashboard-grid-row
+;;             (if own?
+;;               [:div.grid-item.add-project {:on-click forward-click}
+;;                [:span "+ New image"]
+;;                [:input.upload-image-input
+;;                 {:style {:display "none"}
+;;                  :multiple true
+;;                  :ref "file-input"
+;;                  :value ""
+;;                  :type "file"
+;;                  :on-change on-file-selected}]])
+
+;;             (for [image images
+;;                   :let [selected? (contains? (:selected @local) image)]]
+;;               [:div.grid-item.images-th
+;;                {:key (:id image)
+;;                 :on-click (partial toggle-check-card image)}
+;;                [:div.grid-item-th
+;;                 {:style {:background-image (str "url('" (:thumbnail image) "')")}}
+;;                 [:div.input-checkbox.check-primary
+;;                  [:input {:type "checkbox"
+;;                           :id (:id image)
+;;                           :on-click (partial toggle-check image)
+;;                           :checked selected?}]
+;;                  [:label {:for (:id image)}]]]
+;;                [:span (:name image)]])]
+
+;;            (when show-menu?
+;;              ;; MULTISELECT OPTIONS BAR
+;;              [:div.multiselect-bar
+;;               [:div.multiselect-nav
+;;                [:span.move-item.tooltip.tooltip-top {:alt "Copy to"} i/organize]
+;;                (if own?
+;;                  [:span.copy.tooltip.tooltip-top {:alt "Duplicate"} i/copy])
+;;                (if own?
+;;                  [:span.delete.tooltip.tooltip-top
+;;                   {:alt "Delete"
+;;                    :on-click delete-selected}
+;;                   i/trash])]])]])))))
+
+;; (def ^:private grid
+;;   (mx/component
+;;    {:render grid-render
+;;     :name "grid"
+;;     :mixins [(rum/local {:selected #{}}) mx/static mx/reactive]}))
+
+(mx/defcs grid-form
+  {:mixins [mx/static]}
+  [own coll-id]
+  (letfn [(forward-click [event]
+            (dom/click (mx/ref-node own "file-input")))
+          (on-file-selected [event]
+            (let [files (dom/get-event-files event)]
+              (rs/emit! (di/create-images coll-id files))))]
+    [:div.grid-item.add-project {:on-click forward-click}
+     [:span "+ New image"]
+     [:input.upload-image-input
+      {:style {:display "none"}
+       :multiple true
+       :ref "file-input"
+       :value ""
+       :type "file"
+       :on-change on-file-selected}]]))
+
+(mx/defc grid-options
+  [coll]
+  (let [own? (= (:type coll) :own)]
+    (letfn [(on-delete [event]
+              (rs/emit! (di/delete-selected)))]
+      ;; MULTISELECT OPTIONS BAR
+      [:div.multiselect-bar
+       (if own?
+         [:div.multiselect-nav
+          #_[:span.move-item.tooltip.tooltip-top
+             {:alt "Move to"}
+             i/organize]
+          [:span.delete.tooltip.tooltip-top
+           {:alt "Delete"
+            :on-click on-delete}
+           i/trash]]
+         [:div.multiselect-nav
+          [:span.move-item.tooltip.tooltip-top
+           {:alt "Copy to"}
+           i/organize]])])))
+
+(mx/defc grid-item
+  [{:keys [id] :as image} selected?]
+  (letfn [(toggle-selection [event]
+            (rs/emit! (di/toggle-image-selection id)))
+          (toggle-selection-shifted [event]
+            (when (kbd/shift? event)
+              (toggle-selection event)))]
+    [:div.grid-item.images-th
+     {:on-click toggle-selection-shifted}
+     [:div.grid-item-th
+      {:style {:background-image (str "url('" (:thumbnail image) "')")}}
+      [:div.input-checkbox.check-primary
+       [:input {:type "checkbox"
+                :id (:id image)
+                :on-click toggle-selection
+                :checked selected?}]
+       [:label {:for (:id image)}]]]
+     [:span (:name image)]]))
+
+(mx/defc grid
+  {:mixins [mx/static]}
+  [selected {:keys [id type images] :as coll}]
+  (let [own? (= type :own)]
+    (println (map :id images))
+    [:div.dashboard-grid-content
+     [:div.dashboard-grid-row
+      (when own?
+        (grid-form id))
+      (for [image images
+            :let [id (:id image)
+                  selected? (contains? selected id)]]
+        (-> (grid-item image selected?)
+            (mx/with-key (str id))))]]))
+
+(mx/defc content
+  {:mixins [mx/static mx/reactive]}
+  []
+  (let [dashboard (mx/react dashboard-ref)
+        selected (:selected dashboard)
+        coll-type (:type dashboard)
+        coll-id (:id dashboard)
         coll (mx/react (focus-collection coll-id))
-        icount (count (:images coll)) ]
-    (html
-     [:section.dashboard-bar.library-gap
-      [:div.dashboard-info
-       [:span.dashboard-images (tr "ds.num-images" (t/c icount))]
-       (sort-widget)
-       (search-widget)]])))
-
-(def ^:private menu
-  (mx/component
-   {:render menu-render
-    :name "menu"
-    :mixins [mx/reactive mx/static]}))
+        own? (= coll-type :own)]
+    (when coll
+      [:section.dashboard-grid.library
+       (page-title coll)
+       (grid selected coll)
+       (when (and (seq selected))
+         (grid-options coll))])))
+
+;; --- Sort Widget
+
+;; (defn- sort-widget-render
+;;   []
+;;   (let [ordering (mx/react images-ordering-ref)
+;;         on-change #(rs/emit! (di/set-images-ordering
+;;                               (keyword (.-value (.-target %)))))]
+;;     (html
+;;      [:div
+;;       [:span (tr "ds.project-ordering")]
+;;       [:select.input-select
+;;        {:on-change on-change
+;;         :value (:name ordering "")}
+;;        (for [option (keys +ordering-options+)
+;;              :let [option-id (get +ordering-options+ option)
+;;                    option-value (:name option)
+;;                    option-text (tr option-id)]]
+;;          [:option
+;;           {:key option-id
+;;            :value option-value}
+;;           option-text])]])))
+
+;; (def ^:private sort-widget
+;;   (mx/component
+;;    {:render sort-widget-render
+;;     :name "sort-widget-render"
+;;     :mixins [mx/reactive mx/static]}))
+
+;; --- Filtering Widget
+
+;; (defn- search-widget-render
+;;   []
+;;   (letfn [(on-term-change [event]
+;;             (-> (dom/get-target event)
+;;                 (dom/get-value)
+;;                 (di/set-images-filtering)
+;;                 (rs/emit!)))
+;;           (on-clear [event]
+;;             (rs/emit! (di/clear-images-filtering)))]
+;;     (html
+;;      [:form.dashboard-search
+;;       [:input.input-text
+;;        {:key :images-search-box
+;;         :type "text"
+;;         :on-change on-term-change
+;;         :auto-focus true
+;;         :placeholder (tr "ds.project-search.placeholder")
+;;         :value (mx/react images-filtering-ref)}]
+;;       [:div.clear-search {:on-click on-clear} i/close]])))
+
+;; (def ^:private search-widget
+;;   (mx/component
+;;    {:render search-widget-render
+;;     :name "search-widget"
+;;     :mixins [mx/reactive mx/static]}))
+
+;; ;; --- Menu
+
+;; (defn- menu-render
+;;   []
+;;   (let [dashboard (mx/react dashboard-ref)
+;;         coll-id (:collection-id dashboard)
+;;         coll (mx/react (focus-collection coll-id))
+;;         icount (count (:images coll)) ]
+;;     (html
+;;      [:section.dashboard-bar.library-gap
+;;       [:div.dashboard-info
+;;        [:span.dashboard-images (tr "ds.num-images" (t/c icount))]
+;;        (sort-widget)
+;;        (search-widget)]])))
+
+;; (def ^:private menu
+;;   (mx/component
+;;    {:render menu-render
+;;     :name "menu"
+;;     :mixins [mx/reactive mx/static]}))

 ;; --- Images Page

-(defn- images-page-render
-  [own]
-  (html
-   [:main.dashboard-main
-    (header)
-    [:section.dashboard-content
-     (nav)
-     (menu)
-     (grid)]]))
+;; (defn- images-page-render
+;;   [own]
+;;   (html
+;;    [:main.dashboard-main
+;;     (header)
+;;     [:section.dashboard-content
+;;      (nav)
+;;      (menu)
+;;      (grid)]]))

 (defn- images-page-will-mount
   [own]
-  (rs/emit! (dd/initialize :dashboard/images)
-            (di/initialize))
-  own)
+  (let [[type id] (:rum/args own)]
+    (rs/emit! (di/initialize type id))
+    own))

 (defn- images-page-did-remount
-  [old-state state]
-  (rs/emit! (dd/initialize :dashboard/images))
-  state)
-
-(def images-page
-  (mx/component
-   {:render images-page-render
-    :will-mount images-page-will-mount
-    :did-remount images-page-did-remount
-    :name "images-page"
-    :mixins [mx/static]}))
+  [old-own own]
+  (let [[old-type old-id] (:rum/args old-own)
+        [new-type new-id] (:rum/args own)]
+    (when (or (not= old-type new-type)
+              (not= old-id new-id))
+      (rs/emit! (di/initialize new-type new-id)))
+    own))
+
+(mx/defc images-page
+  {:will-mount images-page-will-mount
+   :did-remount images-page-did-remount
+   :mixins [mx/static]}
+  [type id]
+  [:main.dashboard-main
+   (header)
+   [:section.dashboard-content
+    (nav)
+    (content)]])


Refactoring: more sensible naming

Refactoring: more sensible naming

--- src/cljs/matthiasn/systems_toolbox_ui/charts/histogram.cljs
+++ src/cljs/matthiasn/systems_toolbox_ui/charts/histogram.cljs
@@ -37,17 +37,17 @@

 (defn histogram-view-fn
   "Renders a histogram."
-  [{:keys [rtt-times x y w h x-label color bin-cf max-bins increment-fn]}]
-  (let [mx (apply max rtt-times)
-        mn (apply min rtt-times)
+  [{:keys [data x y w h x-label color bin-cf max-bins increment-fn]}]
+  (let [mx (apply max data)
+        mn (apply min data)
         rng (- mx mn)
         increment-fn (or increment-fn m/default-increment-fn)
         increment (increment-fn rng)
         mx2 (m/round-up (or mx 10) increment)
         mn2 (m/round-down (or mn 0) increment)
         x-scale (/ w (- mx2 mn2))
-        bin-size (max (/ rng max-bins) (* (m/freedman-diaconis-rule rtt-times) bin-cf))
-        binned-freq (frequencies (map (fn [n] (Math/floor (/ (- n mn) bin-size))) rtt-times))
+        bin-size (max (/ rng max-bins) (* (m/freedman-diaconis-rule data) bin-cf))
+        binned-freq (frequencies (map (fn [n] (Math/floor (/ (- n mn) bin-size))) data))
         binned-freq-mx (apply max (map (fn [[_ f]] f) binned-freq))
         bins (inc (apply max (map (fn [[v _]] v) binned-freq)))
         bar-width (/ (* rng x-scale) bins)
@@ -89,12 +89,12 @@
   [data label color]
   [:svg {:width   "100%"
          :viewBox "0 0 400 250"}
-   (histogram-view-fn {:rtt-times data
-                       :x         80
-                       :y         180
-                       :w         300
-                       :h         160
-                       :x-label   label
-                       :color     color
-                       :bin-cf    0.8
-                       :max-bins  25})])
+   (histogram-view-fn {:data     data
+                       :x        80
+                       :y        180
+                       :w        300
+                       :h        160
+                       :x-label  label
+                       :color    color
+                       :bin-cf   0.8
+                       :max-bins 25})])


populating users and assigning system-id to system

--- test/celestial/integration/remoters.clj
+++ test/celestial/integration/remoters.clj
@@ -3,38 +3,40 @@
   (:require
     [celestial.persistency :as p]
     [celestial.persistency.systems :as s]
-    [celestial.fixtures.data :refer (redis-actions redis-prox-spec redis-type)]
+    [celestial.fixtures.data :refer (redis-deploy redis-runall redis-prox-spec redis-type)]
+    [celestial.fixtures.populate :refer (add-users)]
     [celestial.fixtures.core :refer (with-defaults)]
     [celestial.redis :refer (clear-all)]
     [me.raynes.fs :refer (exists?)]
     [celestial.workflows :refer (reload destroy)]
-    [celestial.model :refer (rconstruct)]
-     remote.capistrano)
-  (:use midje.sweet)
-  )
+    [celestial.model :refer (rconstruct)]
+    remote.capistrano)
+  (:use midje.sweet))

 (with-defaults
-  (with-state-changes [(before :facts (do (clear-all) (p/add-type redis-type)) )]
+  (with-state-changes [(before :facts (do (clear-all) (p/add-type redis-type) (add-users)))]
     (fact "basic deploy" :integration :capistrano
-      (let [id (s/add-system redis-prox-spec)
-            cap (rconstruct redis-actions {:action :deploy :target "192.168.5.200"})]
-         (reload redis-prox-spec)
+      (let [id (s/add-system redis-prox-spec)
+            spec (assoc redis-prox-spec :system-id id)
+            cap (rconstruct redis-deploy {:target "192.168.5.200"})]
+         (reload spec)
          (.setup cap)
          (exists? (:dst cap)) => truthy
          (.run cap)
          (.cleanup cap)
-         (destroy (assoc redis-prox-spec :system-id id))
+         (destroy spec)
          (exists? (:dst cap))  => falsey
          (s/system-exists? id)  => falsey)))

-    (fact "ruby run-all" :integration :ruby
+    (fact "ruby runall" :integration :ruby :capistrano
       (let [id (s/add-system redis-prox-spec)
-            cap (rconstruct redis-actions {:action :run-all :target "192.168.5.200"})]
-         (reload redis-prox-spec)
+            spec (assoc redis-prox-spec :system-id id)
+            cap (rconstruct redis-runall {:target "192.168.5.200"}) ]
+         (reload spec)
          (.setup cap)
          (exists? (:dst cap)) => truthy
          (.run cap)
          (.cleanup cap)
-         (destroy (assoc redis-prox-spec :system-id id))
+         (destroy spec)
          (exists? (:dst cap))  => falsey
          (s/system-exists? id)  => falsey)))


Rip out dijkstra subproblem

Rip out dijkstra subproblem

--- src/angelic/search/implicit/dash_astar_opt_simple.clj
+++ src/angelic/search/implicit/dash_astar_opt_simple.clj
@@ -24,7 +24,7 @@
 ;; skeleton, and an unevaluated child for first in the sequence.
 ;; I.e., the skeleton really represents the real deal, should not be shared.

-;; A relatively clean version of dash-A*, for optimistic descriptions only.
+;; Initially, remove complexities like dijkstra actions.

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;       Options      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -38,7 +38,6 @@
 (declare *decompose-cache*       ) ;; Cache subproblems? Requires *collect-equal-outputs*
 (declare *state-abstraction*     ) ;; Use state abstraction?  Requires *decompose-cache*
 (declare *propagate-subsumption* ) ;; Automatically propagate subsumption links to corresponding children
-(declare *dijkstra-actions*      ) ;; Use dijkstra for these action types (set).

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -296,80 +295,6 @@

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Dijkstra       ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; This subproblem does a flattened, pruned search for right-recursive HLAs.
-
-;; TODO: how do i know if i'm already in a dijkstra or not?
-;; Does it matter?
-;; If we have dijkstra all the way down, don't even need full dijkstra?
-;; Nah, remember whole deal about GG versus Dijkstra versus Caching.
-;; Dijkstra all the way down means n dijkstras running, no fun.
-;; For now, just do straight top-level dijkstra, skip caching of right.
-;; I.e., generate our own refinements.  Just use pairs, doens't matter since
-;; everything will be solved already.
-;; Directly implements evaluable, so we don't need to show our queue to the outside
-;; world; and we can eagerly evaluate left children.
-
-(use '[angelic.util.queues :as queues])
-
-(declare wrapped-atomic-name)
-
-(defn dijkstra-name [fs] [:Dijkstra fs])
-
-;; This seems a bit dangerous, but should be ok...
-(defn get-evaluated-sp [fs inp-set]
-  (let [n (wrapped-atomic-name fs)
-        s (get-subproblem n inp-set)]
-    (when (summary/live? (sg/summary s))
-      (evaluate! (ts-sp (sp-ts s)))
-      (sg/summary-changed! (ts-sp (sp-ts s))))
-    (assert (summary/solved? (sg/summary s)))
-    s))
-
-
-;; We bend the rules a bit and eval immediately, for simplicity.
-(defn make-dijkstra-subproblem [fs inp-set]
-  (let [nm (dijkstra-name fs)
-        q  (queues/make-graph-search-pq)
-        ret (make-subproblem
-             nm inp-set nil
-             (fn eval-dijkstra! [s]
-;               (println "EVAL" s)
-               (assert (not (queues/pq-empty? q)))
-               (schedule-decrease! s)
-               (let [[mid-set [_ _ _ _ prim-r]] (queues/pq-remove-min-with-cost! q)]
-                 (doseq [child-seq (fs/child-seqs fs mid-set)]
-                   (util/assert-is (#{1 2} (count child-seq)) "%s" [child-seq])
-                   (when (= 2 (count child-seq)) (assert (= (second child-seq) fs)))
-                   (let [l (get-evaluated-sp (first child-seq) mid-set)
-                         next-mid-set (get-output-set! l)
-                         next-prim-r (+ prim-r (summary/max-reward (sg/summary l)))]
-;                     (when (= 1 (count child-seq)) (println l (sg/summary l)))
-                     (if (= 1 (count child-seq))
-                       (queues/pq-replace! q next-mid-set [(- 0 next-prim-r) -2 next-prim-r :solved :d])
-                       (let [[out-set reward status] (fs/apply-opt fs next-mid-set)]
-                         (when out-set
-                           (let [tot-rew (+ next-prim-r reward)]
-                             (queues/pq-add! q next-mid-set
-                                             [(- 0 tot-rew) (- (summary/status-val status))
-                                              tot-rew status next-prim-r])))))))))
-             (fn [s ri] (make-dijkstra-subproblem fs ri))
-             (fn summarize [s]
-;               (println "SUM" s (que))
-               (if (queues/pq-empty? q)
-                 (make-summary Double/NEGATIVE_INFINITY :blocked s)
-                 (let [[_ [_ _ reward status]] (queues/pq-peek-min q)]
-                   (make-summary reward status s)))))]
-    (let [[out-set reward status] (fs/apply-opt fs inp-set)]
-      (set-output-set! ret out-set)
-      (queues/pq-add! q inp-set [(- reward) (- (summary/status-val status)) reward status 0]))
-    ret))
-
-
-(defmethod get-subproblem :Dijkstra [[_ fs :as n] inp-set]
-  (make-dijkstra-subproblem fs inp-set))
-

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;      Pair      ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Pair subproblems represent sequntial composition of two subproblems.
@@ -476,7 +401,7 @@

-(defn atomic-name-fs [n] (assert (#{:Atomic :Dijkstra} (first n))) (second n))
+(defn atomic-name-fs [n] (assert (#{:Atomic} (first n))) (second n))
 (defn log-input [fs inp-set] (if *state-abstraction* (fs/get-logger fs inp-set) inp-set))
 (defn get-input-key [fs inp-set] (if *state-abstraction* (fs/extract-context fs inp-set) inp-set))

@@ -486,7 +411,7 @@
 ;; TODO: only :Atomic or :Pair inside, when SA off
 (defn- make-output-collecting-subproblem [fs inp-key inner-sp]
   (make-wrapped-subproblem
-   (oc-name (sp-name inner-sp)) (input-set inner-sp) #{:Atomic :Dijkstra :Pair #_ ::TODO??? :SA :OC} inner-sp
+   (oc-name (sp-name inner-sp)) (input-set inner-sp) #{:Atomic :Pair #_ ::TODO??? :SA :OC} inner-sp
    identity
    (fn child-watch [sp child-sp]
      (if (fs/=-state-sets (get-output-set! inner-sp) (get-output-set! child-sp))
@@ -496,7 +421,7 @@
      (let [ninp-key (get-input-key fs ni)]
        (if (= inp-key ninp-key)
          s
-         (if (#{:Atomic :Dijkstra} (first (sp-name inner-sp))) ;; TODO!
+         (if (#{:Atomic} (first (sp-name inner-sp))) ;; TODO!
            (let [ret (get-ocs (sp-name inner-sp) fs ninp-key ni)]
              (util/assert-is (not (identical? (canonicalize ret) inner-sp)) "%s" [(def *bad* [s inner-sp (input-set s) ni])])
              (add-subsuming-sp! (canonicalize ret) inner-sp)
@@ -546,9 +471,7 @@
   (if (seq r) (pair-name f (right-factor r)) f))

 (defn- wrapped-atomic-name [fs]
-  (let [in  (if (*dijkstra-actions* (first (fs/fs-name fs)))
-              (dijkstra-name fs)
-              (atomic-name fs))
+  (let [in  (atomic-name fs)
         mid (if *collect-equal-outputs* (oc-name in) in)]
     (if *state-abstraction* (sa-name mid) mid)))

@@ -588,18 +511,17 @@
     :dir       Factor sequences into pairs using :left or :right recursion
     :prop      Automatically propagate subsumption from parents to matching children?"
   [henv & {gather :gather d :d  s :s   choice-fn :choice-fn
-           local? :local?  dir :dir   prop :prop dijkstra :dijkstra :as m
+           local? :local?  dir :dir   prop :prop :as m
       :or {gather true   d true s true choice-fn last
-           local? true     dir :right prop true dijkstra #{}}}]
-  (assert (every? #{:gather :d :s :choice-fn :local? :dir :prop :dijkstra} (keys m)))
+           local? true     dir :right prop true}}]
+  (assert (every? #{:gather :d :s :choice-fn :local? :dir :prop} (keys m)))
   (when s (assert d))
   (when d (assert gather))
   (binding [*collect-equal-outputs* gather
             *decompose-cache*       (when d (HashMap.))
             *state-abstraction*     s
             *left-recursive*        (case dir :left true :right false)
-            *propagate-subsumption* prop
-            *dijkstra-actions*      dijkstra]
+            *propagate-subsumption* prop]
     (def *root* (sp-ts (apply make-atomic-subproblem (reverse (fs/make-init-pair henv)))))
     (summary/solve
      #(sg/summary *root*)


Change the way queries are built, move towards encapsulation and reuse

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -97,10 +97,7 @@
        (fn [acc [column value]]
          (conj acc (eq (name column) value)))
        []
-       construct)))
-
-
-  )
+       construct))))

 ;;
 ;; Tuples
@@ -268,50 +265,54 @@

 (defn value
   [key value]
-  [:values
-   (fn value-query [query-builder]
-     (.value query-builder (name key) value))])
+  [:value [key value]])

 (defn if-not-exists
   []
-  [:if-not-exists
-   (fn if-not-exists [query-builder]
-     (.ifNotExists query-builder))])
+  [:if-not-exists nil])

 (defn values
   ([m]
-     [:values
-      (fn values-query [query-builder]
-        (.values query-builder (into-array (map name (keys m))) (object-array (vals m))))])
+     [:values-vector m])
   ([key-seq value-seq]
-     [:values
-      (fn order-by-query [query-builder]
-        (.values query-builder (into-array (map name key-seq)) (object-array value-seq)))]))
-
-(let [with-values {:timestamp #(QueryBuilder/timestamp %)
-                   :ttl       #(QueryBuilder/ttl %)}]
-  (defn using
-    [m]
-    [:using
-     (fn using-query [query-builder]
-       (doseq [[key value] m]
-         (.using query-builder ((get with-values key) value)))
-       query-builder)]))
+     [:values-seq [key-seq value-seq]]))
+
+(defn using
+  [m]
+  [:using m])

 (def ^:private insert-order
   {:values        1
+   :value         1
+   :values-vector 1
+   :values-seq    1
    :using         2
    :if-not-exists 3})

-(defn insert
-  [table-name & statements]
-  (->> statements
-       (sort-by #(get select-order (first %)))
-       (map second)
-       (reduce (fn [builder statement]
-                 (statement builder))
-               (QueryBuilder/insertInto (name table-name)))
-       (.toString)))
+(let [with-values {:timestamp #(QueryBuilder/timestamp %)
+                   :ttl       #(QueryBuilder/ttl %)}
+      renderers
+      {:value         (fn value-query [query-builder [key value]]
+                        (.value query-builder (name key) value))
+       :if-not-exists (fn value-query [query-builder _]
+                        (.value query-builder (name key) value))
+       :values-vector (fn values-query [query-builder m]
+                        (.values query-builder (into-array (map name (keys m))) (object-array (vals m))))
+       :values-seq    (fn order-by-query [query-builder [key-seq value-seq]]
+                        (.values query-builder (into-array (map name key-seq)) (object-array value-seq)))
+       :using         (fn using-query [query-builder m]
+                        (doseq [[key value] m]
+                          (.using query-builder ((get with-values key) value)))
+                        query-builder)
+       }]
+  (defn insert
+    [table-name & statements]
+    (->> statements
+         (sort-by #(get select-order (first %)))
+         (reduce (fn [builder [statement-name statement-args]]
+                   ((get renderers statement-name) builder statement-args))
+                 (QueryBuilder/insertInto (name table-name)))
+         (.toString))))

 ;;
 ;; Update Query
@@ -415,8 +416,7 @@
   [[k v]]
   (if (fn? v)
     (v (name k))
-    (set-column- (name k) v))
-  )
+    (set-column- (name k) v)))

 (defn only-if
   [m]
@@ -426,10 +426,7 @@
            query-builder  (.onlyIf query-builder first)]
        (doseq [current more]
          (.and query-builder current))
-       query-builder)
-
-
-     )])
+       query-builder))])

 (defn- update-records-statement
   [m]