Moar stash

Moar stash

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -2,6 +2,16 @@
   (:require [aurora.btree :as btree]
             [aurora.join :as join])
   (:require-macros [aurora.macros :refer [apush set!!]]))
+
+;; FLOWS
+
+(deftype Flow [input-iter output-kinds output-names output-fields]
+  Object
+  (run [this kn]
+       (.reset input-iter)
+       (let [facts (btree/iterator->keys input-iter)]
+         (dotimes [i (alength output-kinds)]
+           (.add-facts kn (aget output-kinds i) (aget output-names i) (aget output-fields i) facts)))))

 ;; KNOWLEDGE

@@ -50,45 +60,11 @@
                (when changed?
                  (set! version (+ version 1)))))
   (tick [this])
+  ;; TODO Knowledge.tick using array of flows, needs dirty tracking per flow (requires map from index to flow)
   (tock [this]))

 (defn knowledge []
   (Knowledge. {} 0))
-
-;; FLOWS
-
-(deftype MagicIterator [kind name fields index vars]
-  Object
-  (iter [this]
-        (join/magic-iterator index vars)))
-
-(defn magic-iterator [kn kind name fields vars]
-  (let [index (.get-or-create-index kn kind name fields)]
-    (MagicIterator. kind name fields index vars)))
-
-(deftype Join [input-iterables output-kinds output-names output-fields]
-  Object
-  (run [this kn]
-       (let [input-iters (amap input-iterables i _ (.iter (aget input-iterables i)))
-             join-iter (join/join-iterator input-iters)
-             facts (btree/iterator->keys join-iter)]
-         (dotimes [i (alength output-kinds)]
-           (.add-facts kn (aget output-kinds i) (aget output-names i) (aget output-fields i) facts)))))
-
-(deftype Chain [flows]
-  Object
-  (run [this kn]
-       (dotimes [i (alength flows)]
-         (.run (aget flows i) kn))))
-
-(deftype Fixpoint [flow]
-  Object
-  (run [this kn]
-       (loop [old-version (.-version kn)]
-         (.run flow kn)
-         (let [new-version (.-version kn)]
-           (when (not (== old-version new-version))
-             (recur new-version))))))

 ;; COMPILER

@@ -98,11 +74,10 @@
        (.replace (js/uuid) (js/RegExp. "-" "gi") "_")
        (str "id-" (swap! next inc)))))

-
 ;; NOTE can't handle missing keys yet - requires a schema
 (defn compile [kn]
-  (let [clauses (btree/iterator->keys (btree/iterator (.get-or-create-index kn "know" "clauses" ["rule-id" "when|pretend|remember|forget" "clause-id" "name"])))
-        fields (btree/iterator->keys (btree/iterator (.get-or-create-index kn "know" "clause-fields" ["clause-id" "constant|variable" "key" "val"])))
+  (let [clauses (btree/iterator->keys (btree/iterator (.get-or-create-index kn "know" "clauses" #js ["rule-id" "when|pretend|remember|forget" "clause-id" "name"])))
+        fields (btree/iterator->keys (btree/iterator (.get-or-create-index kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"])))
         rule-id->clauses (atom (into {} (for [[k vs] (group-by #(nth % 0) clauses)] [k (set (map vec vs))])))
         clause-id->fields (atom (into {} (for [[k vs] (group-by #(nth % 0) fields)] [k (set (map vec vs))])))]

@@ -136,16 +111,16 @@
       (let [vars (atom #{})]

         ;; collect vars
-        (doseq [[_ _ clause-id _] clauses
-                (get @clause-id->fields clause-id)]
+        (doseq [[_ _ clause-id _] clauses]
           (let [fields (get @clause-id->fields clause-id)]
             (doseq [[_ field-type key val] fields]
               (when (= field-type "variable")
                 (swap! vars conj val)))))

-        ;; make ruleset
         (let [var->ix (zipmap @vars (range))
               num-vars (count @vars)
+
+              ;; make input iter
               iters (for [[_ clause-type clause-id name] clauses
                           :when (= clause-type "when")]
                       (let [fields (get @clause-id->fields clause-id)]
@@ -176,11 +151,49 @@
                                               key)
                                 index (.get-or-create-index kn "know" name clause-keys)]
                             (join/magic-iterator index (into-array var-map))))))
-              join-iter (join/join-iterator (into-array iterators))]
-
-          ;; TODO outputs, ruleset
-          )
-    ))
+              join-iter (join/join-iterator (into-array iterators))
+
+              ;; make output specs
+              output-kinds (into-array
+                            (for [[_ clause-type clause-id name] clauses
+                                  :when (not= clause-type "when")]
+                              clause-type))
+              output-names (into-array
+                            (for [[_ clause-type clause-id name] clauses
+                                  :when (not= clause-type "when")]
+                              name))
+              output-fields (into-array
+                             (for [[_ clause-type clause-id name] clauses
+                                   :when (not= clause-type "when")]
+                               (let [clause-fields (get @clause-id->fields clause-id)
+                                     output-fields (make-array num-vars)]
+                                 (doseq [[_ field-type key val] fields]
+                                   (assert (= field-type "variable"))
+                                   (aset output-fields (var->ix val) key)))))]
+
+          (Flow. join-iter output-kinds output-names output-fields))))))
+
+(def kn (knowledge))
+
+(.get-or-create-index kn "know" "edge" #js ["x" "y"])
+
+(.get-or-create-index kn "know" "connected" #js ["x" "y"])
+
+(.add-facts kn "know" "edge" #js ["x" "y"] #js [#js ["a" "b"] #js ["b" "c"] #js ["c" "d"] #js ["d" "b"]])
+
+(.get-or-create-index kn "know" "clauses" #js ["rule-id" "when|pretend|remember|forget" "clause-id" "name"])
+
+(.get-or-create-index kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"])
+
+(.add-facts kn "know" "clauses" #js ["rule-id" "when|pretend|remember|forget" "clause-id" "name"] #js [#js ["edge->connected" "when" "get-edges" "edge"]
+                                                                                #js ["edge->connected" "pretend" "output-connected" "edge"]])
+
+(.add-facts kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"] #js [#js ["get-edges" "variable" "x" "xx"]
+                                                                                #js ["get-edges" "variable" "y" "yy"]
+                                                                                #js ["output-connected" "variable" "x" "xx"]
+                                                                                #js ["output-connected" "variable" "y" "yy"]])
+
+(compile kn)

 (comment


Remove unused initialization code.

Remove unused initialization code.

--- test/circle/backend/build/test_run_build.clj
+++ test/circle/backend/build/test_run_build.clj
@@ -10,9 +10,6 @@
   (:require [somnium.congomongo :as mongo])
   (:use [arohner.utils :only (inspect)])
   (:use [circle.util.predicates :only (ref?)]))
-
-(circle.db/init)
-(ensure-test-user-and-project)

 (defaction successful-action [act-name]
   {:name act-name}


function names changed to add-cookie and clear-cookies

--- src/clj_http/cookies.clj
+++ src/clj_http/cookies.clj
@@ -136,13 +136,21 @@
   (when cookie-store
     (into {} (map to-cookie (.getCookies cookie-store)))))

+<<<<<<< HEAD
 (defn add-cookie
+=======
+(defn add-cookie-to-cookie-store
+>>>>>>> 4104028ab6c0893879ea93358c8c4a34b9aa55be
   "Add a ClientCookie to a cookie-store"
   [^CookieStore cookie-store ^ClientCookie cookie]
   (.addCookie cookie-store cookie)
   )

+<<<<<<< HEAD
 (defn clear-cookies
+=======
+(defn clear-cookies-from-cookie-store
+>>>>>>> 4104028ab6c0893879ea93358c8c4a34b9aa55be
   "Clears all cookies from cookie-store"
   [^CookieStore cookie-store]
   (.clear cookie-store)


testfix

testfix

--- test/latte_compiler/static_analysis_test.clj
+++ test/latte_compiler/static_analysis_test.clj
@@ -7,7 +7,7 @@
 (deftest ext-name
    (testing "whether the extension name is correct")
    (is (nil? (static-analysis/class-dep [:noextclssdef [:ident "Node"] [:clssdecls]])))
-   (is (= (static-analysis/class-dep [:extclssdef [:ident "Rectangle"] [:tident [:ident "Shape"]]]) [:ident "Shape"]))
+   (is (= (static-analysis/class-dep [:extclssdef [:ident "Rectangle"] [:ident "Shape"]]) [:ident "Shape"]))
 )

 (deftest name


Fix ns from moved test.

Fix ns from moved test.

--- test/onyx/flow_conditions/flow_pred_test.clj
+++ test/onyx/flow_conditions/flow_pred_test.clj
@@ -6,49 +6,39 @@
 (def false-pred (constantly false))

 (deftest flow-pred
-  (is (true? ((build-pred-fn :onyx.flow-pred-test/true-pred {}) [1 2 3])))
+  (is (true? ((build-pred-fn ::true-pred {}) [1 2 3])))

-  (is (false? ((build-pred-fn [:and :onyx.flow-pred-test/true-pred
-                               :onyx.flow-pred-test/false-pred] {}) [5 6 7])))
+  (is (false? ((build-pred-fn [:and ::true-pred ::false-pred] {}) [5 6 7])))

-  (is (true? ((build-pred-fn [:and :onyx.flow-pred-test/true-pred
-                              :onyx.flow-pred-test/true-pred] {}) [5 6 7])))
+  (is (true? ((build-pred-fn [:and ::true-pred ::true-pred] {}) [5 6 7])))

-  (is (false? ((build-pred-fn [:and :onyx.flow-pred-test/false-pred
-                               [:and :onyx.flow-pred-test/true-pred
-                                :onyx.flow-pred-test/true-pred]] {}) [5])))
+  (is (false? ((build-pred-fn [:and ::false-pred
+                               [:and ::true-pred ::true-pred]] {}) [5])))

-  (is (false? ((build-pred-fn [:and :onyx.flow-pred-test/true-pred
-                               [:and :onyx.flow-pred-test/true-pred
-                                :onyx.flow-pred-test/false-pred]] {}) [5])))
+  (is (false? ((build-pred-fn [:and ::true-pred
+                               [:and ::true-pred ::false-pred]] {}) [5])))

-  (is (true? ((build-pred-fn [:or :onyx.flow-pred-test/true-pred
-                              :onyx.flow-pred-test/false-pred] {}) [5])))
+  (is (true? ((build-pred-fn [:or ::true-pred ::false-pred] {}) [5])))

-  (is (nil? ((build-pred-fn [:or :onyx.flow-pred-test/false-pred
-                             :onyx.flow-pred-test/false-pred] {}) [5])))
+  (is (nil? ((build-pred-fn [:or ::false-pred ::false-pred] {}) [5])))

-  (is (true? ((build-pred-fn [:or :onyx.flow-pred-test/true-pred
-                              [:or :onyx.flow-pred-test/true-pred
-                               :onyx.flow-pred-test/false-pred]] {}) [5])))
+  (is (true? ((build-pred-fn [:or ::true-pred
+                              [:or ::true-pred ::false-pred]] {}) [5])))

-  (is (false? ((build-pred-fn [:not :onyx.flow-pred-test/true-pred] {}) [1 2 3])))
+  (is (false? ((build-pred-fn [:not ::true-pred] {}) [1 2 3])))

-  (is (true? ((build-pred-fn [:not :onyx.flow-pred-test/false-pred] {}) [5])))
+  (is (true? ((build-pred-fn [:not ::false-pred] {}) [5])))

-  (is (false? ((build-pred-fn [:not [:not :onyx.flow-pred-test/false-pred]] {}) [5])))
+  (is (false? ((build-pred-fn [:not [:not ::false-pred]] {}) [5])))

-  (is (true? ((build-pred-fn [:not [:not :onyx.flow-pred-test/true-pred]] {}) [5])))
+  (is (true? ((build-pred-fn [:not [:not ::true-pred]] {}) [5])))

-  (is (true? ((build-pred-fn [:or :onyx.flow-pred-test/true-pred
-                              [:and :onyx.flow-pred-test/false-pred
-                               :onyx.flow-pred-test/false-pred]] {}) [5])))
+  (is (true? ((build-pred-fn [:or ::true-pred
+                              [:and ::false-pred ::false-pred]] {}) [5])))

-  (is (nil? ((build-pred-fn [:or [:not :onyx.flow-pred-test/true-pred]
-                             [:and :onyx.flow-pred-test/false-pred
-                              :onyx.flow-pred-test/false-pred]] {}) [5])))
+  (is (nil? ((build-pred-fn [:or [:not ::true-pred]
+                             [:and ::false-pred ::false-pred]] {}) [5])))

-  (is (true? ((build-pred-fn [:and :onyx.flow-pred-test/true-pred
-                              [:and :onyx.flow-pred-test/true-pred
-                               :onyx.flow-pred-test/true-pred]] {}) [1 2 3]))))
+  (is (true? ((build-pred-fn [:and ::true-pred
+                              [:and ::true-pred ::true-pred]] {}) [1 2 3]))))


s/if/when/

s/if/when/

--- src/leiningen/new/chestnut.clj
+++ src/leiningen/new/chestnut.clj
@@ -159,7 +159,7 @@
   (main/info "Generating fresh Chestnut project.")
   (main/info "README.md contains instructions to get you started.")

-  (if (sass? opts)
+  (when (sass? opts)
     (main/info "WARNING: You have enabled SASS support, which relies on the sassc binary")
     (main/info "WARNING: being available on your system. This is an advanced, undocumented")
     (main/info "WARNING: feature. In other words: you're on your own."))


Add arrows signalling flippability.

Add arrows signalling flippability.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -21,16 +21,24 @@
     ch))

-(def triangle-marker
+(defn make-triangle-marker [id arrow]
   [:svg:marker
-   {:id "Triangle"
-    :viewBox "0 0 10 10"
-    :refX "3"
+   {:id id
+    :viewBox "-5 -5 20 20"
+    :refX "5"
     :refY "5"
-    :markerWidth "3"
-    :markerHeight "3"
+    :markerWidth "7"
+    :markerHeight "7"
     :orient "auto"}
-   [:svg:path {:d "M0,0 L 10,5 L0,10 z"}]])
+   arrow])
+
+(def triangle-marker-ok
+  (make-triangle-marker "TriangleOK"
+        [:svg:path {:fill "white" :stroke "black" :d "M0,0 L 10,5 L0,10 z"}]))
+
+(def triangle-marker-not-ok
+  (make-triangle-marker "TriangleNotOK"
+    [:svg:path {:fill "black" :stroke "black" :d "M0,0 L 10,5 L0,10 z"}]))

 (defn make-line-dirs [from to]
@@ -39,7 +47,7 @@
     (string/join " " (map str ["M" "L" "L"] coords))))

-(defn svg-edge [[id [from to color]]]
+(defn svg-edge [[id [from to color flippable?]]]
   [:svg:path
    {:class "clickable"
     :id id
@@ -47,20 +55,31 @@
     :stroke (name color)
     :stroke-width "10px"
     :fill "none"
-    :marker-mid "url(#Triangle)"
+    :marker-mid (if flippable?
+                  "url(#TriangleOK)"
+                  "url(#TriangleNotOK)")
     :opacity 0.6
     }])

 (def color->value {:red 1
                    :blue 2})

+(defn inflow [edges vertex]
+  (let [in-going (for [[_ [_ to color]] edges
+                       :when (= to vertex)]
+                   (color->value color))]
+    (apply + in-going)))
+
 (defn svg-vertex [edges id [weight [x y]]]
-  (let [vert-inflow (inflow edges id)]
+  (let [vert-inflow (inflow edges id)
+        free (- vert-inflow weight)]
     (list
       [:svg:circle
        {:cx x :cy y
-        :r 25
-        :fill "white"
+        :r (+ 5 (* weight 10))
+        :fill (if (> free 0)
+                "white"
+                "black ")
         :stroke "black"
         :stroke-width 3
         }]
@@ -68,7 +87,7 @@
        {:x x :y (+ 5 y)
         :fill "black"
         :text-anchor "middle"}
-       (str id " (" vert-inflow "/" weight ")") ]))
+       (str free) ]))
   )

 (defn event->targetid [e]
@@ -83,30 +102,36 @@
     (into {}
         (map vector edge-ids bare-edges))))

+(defn ok-to-flip? [{:keys [vertices edges]} [_ to color]]
+  (let [edge-value (color->value color)
+        to-inflow (inflow edges to)
+        to-vertex-value (first (vertices to))]
+    (>= (- to-inflow edge-value) to-vertex-value)))

-(defn locate-vertices [locations [start end color]]
+
+(defn prepare-edge [locations world-state [start end color :as edge]]
   [(locations start)
    (locations end)
-   color])
+   color
+   (ok-to-flip? world-state edge)])

 (defn fmap [f m]
   (into {} (for [[k v] m] [k (f v)])))

-(defn vertex-id->points [named-edges locations]
-  (fmap (partial locate-vertices locations) named-edges))
-
-
-(defn make-edges [{:keys [vertices edges]}]
-  (vertex-id->points edges (mapv second vertices)))
+(defn make-edges [{:keys [vertices edges] :as world-state}]
+  (let [locations (mapv second vertices)]
+    (fmap (partial prepare-edge locations world-state) edges)
+    ))

 (defn make-svg [[width height] {:keys [vertices edges] :as world-state}]
   [:svg:svg {:width width :height height}
    [:svg:defs
-    triangle-marker]
+    triangle-marker-ok
+    triangle-marker-not-ok]
    (map svg-edge (make-edges world-state))
    (map (partial svg-vertex edges) (range) vertices)

@@ -119,17 +144,7 @@
                   (crate/html [:div#forsvg
                                 (make-svg [1000 1000] world-state)])))

-(defn inflow [edges vertex]
-  (let [in-going (for [[_ [_ to color]] edges
-                       :when (= to vertex)]
-                   (color->value color))]
-    (apply + in-going)))

-(defn ok-to-flip? [{:keys [vertices edges]} [_ to color]]
-  (let [edge-value (color->value color)
-        to-inflow (inflow edges to)
-        to-vertex-value (first (vertices to))]
-    (>= (- to-inflow edge-value) to-vertex-value)))

 (defn flip-edge [world-state [from to color :as edge]]
   (if (ok-to-flip? world-state edge)


Make the surrogate key more descriptive

Make the surrogate key more descriptive

Just for case someone inspecting our surrogates in a debugger.

--- src/devtools/format.cljs
+++ src/devtools/format.cljs
@@ -11,7 +11,7 @@
 (def new-line-string-replacer "↵")
 (def line-index-separator ":")
 (def dq "\"")
-(def surrogate-key "$$surrogate")
+(def surrogate-key "$$this-is-cljs-devtools-surrogate")
 (def standard-ol-style "list-style-type:none; padding-left:0px; margin-top:0px; margin-bottom:0px; margin-left:12px")
 (def standard-ol-no-margin-style "list-style-type:none; padding-left:0px; margin-top:0px; margin-bottom:0px; margin-left:0px")
 (def standard-li-style "margin-left:12px")


Revert "Sorted count count lists by current number of votes"

This reverts commit 8c7df9518643d0a36c3005ee0c17c213baf35d0e.

--- src/mafia_votecount/models.clj
+++ src/mafia_votecount/models.clj
@@ -2,9 +2,17 @@
   (:require [clojure.string :as string])
   (:use [korma.db]
         [korma.core]))
-
-(def db (h2 {:db "./resources/database"}))
-
+
+(def db
+(let [db-uri (java.net.URI. (System/getenv "DATABASE_URL"))]
+        (->> (string/split (.getUserInfo db-uri) #":")
+          (#(identity {:db (last (string/split (System/getenv "DATABASE_URL") #"\/"))
+                       :classname "org.postgresql.Driver"
+                       :subprotocol "postgresql"
+                       :user (% 0)
+                       :password (% 1)
+                       :subname "//ec2-107-20-222-114.compute-1.amazonaws.com:5432/dbsa7cb9rv7jtk"})))))
+
 (defdb korma-db db)

 (declare game host player vote)


Make sure regexp is performed against a string. This helps the rare case where keyword params already exist at this point.

--- ring-core/src/ring/middleware/nested_params.clj
+++ ring-core/src/ring/middleware/nested_params.clj
@@ -6,7 +6,7 @@
     \"foo[bar][][baz]\"
     => [\"foo\" \"bar\" \"\" \"baz\"]"
   [param-name]
-  (let [[_ k ks] (re-matches #"(.*?)((?:\[.*?\])*)" param-name)
+  (let [[_ k ks] (re-matches #"(.*?)((?:\[.*?\])*)" (name param-name))
         keys     (if ks (map second (re-seq #"\[(.*?)\]" ks)))]
     (cons k keys)))


Fixed multiple queue bug.

Fixed multiple queue bug.

--- src/appengine_magic/services/task_queues.clj
+++ src/appengine_magic/services/task_queues.clj
@@ -40,7 +40,7 @@
     (throw (IllegalArgumentException. "add! requires a :url argument")))
   (when-not (map? params)
     (throw (IllegalArgumentException. "add! :params must be a map")))
-  (let [queue-obj (get-task-queue :keys queue)
+  (let [queue-obj (get-task-queue :queue queue)
         opts (TaskOptions$Builder/url url)]
     ;; headers
     (doseq [[header-name header-value] headers]


pushroute hosts

pushroute hosts

--- src/name_bazaar/ui/config.cljs
+++ src/name_bazaar/ui/config.cljs
@@ -15,7 +15,7 @@
 (def production-config
   {:logging {:level :warn
              :sentry {:dsn "https://597ef71a10a240b0949c3b482fe4b9a4@sentry.io/1364232"}}
-   :pushroute-hosts "beta.namebazaar.io,namebazaar.io"
+   :pushroute-hosts "namebazaar.io"
    :node-url "https://mainnet.infura.io/"
    :load-node-addresses? false
    :root-url "https://namebazaar.io"


Formatting

Formatting

--- src/onyx/peer/virtual_peer.clj
+++ src/onyx/peer/virtual_peer.clj
@@ -85,9 +85,7 @@
               restart-ch (chan 1)
               completion-ch (:completions-ch acking-daemon)
               peer-site (extensions/peer-site messenger)
-              entry (create-log-entry :prepare-join-cluster
-                                      {:joiner id
-                                       :peer-site peer-site})
+              entry (create-log-entry :prepare-join-cluster {:joiner id :peer-site peer-site})
               origin (extensions/subscribe-to-log log inbox-ch)]
           (extensions/register-pulse log id)
           (>!! outbox-ch entry)


flesh out the template

flesh out the template

--- src/pc/views/blog/template.clj
+++ src/pc/views/blog/template.clj
@@ -1,11 +1,18 @@
 (ns pc.views.blog.template)

-;; To make a new post, copy this template to a new file, then
-;; add pc.views.blog.your-post-name to pc.views.blog, then add the
-;; your-post-name to the end of slugs in pc.views.blog.
-;; Whatever you set as your-post-name will be the url.
+;; To make a new post, copy this template to a new file, rename the
+;; template fn below to something like your-post-name, then add
+;; "your-post-name" to the end of slugs in pc.views.blog.
+;; Whatever you set as your-post-name will be the slug after /blog/ in the url.

 (defn template []
-  {:title "Template post, not a real post!"
-   :body
-   [:div [:p ""]]})
+  {:title nil ;; replace the nil with a string like "This is a title"
+   :blurb nil ;; replace the nil with a short string about this post
+   :author nil ;; should be "Danny" or "Daniel", ask Daniel to add you to the list if you want to blog
+   :body (list
+          [:article
+           [:p "opening paragraph"]]
+          [:h3 "Heading"]
+          [:article
+           [:p "New paragraph"]]
+          [:figure [:img {:src "/some-image.png"}]])})


CMR-1265 Restores dif collection generation test count to 100

--- umm-lib/test/cmr/umm/test/dif/collection.clj
+++ umm-lib/test/cmr/umm/test/dif/collection.clj
@@ -117,7 +117,7 @@
         (dissoc :metadata-language)
         umm-c/map->UmmCollection)))

-(defspec generate-collection-is-valid-xml-test 1
+(defspec generate-collection-is-valid-xml-test 100
   (for-all [collection coll-gen/collections]
     (let [xml (dif/umm->dif-xml collection)]
       (and


save transaction-date when saving a transaction-item

--- src/clj_money/models/storage/sql_storage.clj
+++ src/clj_money/models/storage/sql_storage.clj
@@ -793,6 +793,7 @@
                                      (:transaction-date transaction-item)
                                      :transaction_items))
                          (h/sset (->update-set transaction-item
+                                               :transaction-date
                                                :amount
                                                :memo
                                                :action
@@ -806,6 +807,7 @@
     (execute db-spec (-> (h/update (table-name (:transaction-date transaction-item)
                                                :transaction_items))
                          (h/sset (->update-set transaction-item
+                                               :transaction-date
                                                :index
                                                :balance))
                          (h/where [:and


Adding more logging to bulk indexing.

Adding more logging to bulk indexing.

--- src/cmr/metadata_db/data/oracle/concepts.clj
+++ src/cmr/metadata_db/data/oracle/concepts.clj
@@ -265,6 +265,7 @@
                       table (tables/get-table-name provider-id concept-type)
                       conditions [`(>= :id ~start-index)
                                   `(< :id ~(+ start-index batch-size))]
+                      _ (debug "Finding batch from id >=" start-index " and id <" (+ start-index batch-size))
                       conditions (if (empty? params)
                                    conditions
                                    (cons (find-params->sql-clause params) conditions))
@@ -276,7 +277,6 @@
                         batch-result))))
             (lazy-find
               [start-index]
-              (debug "Finding batch from" start-index)
               (let [batch (find-batch start-index)]
                 (when-not (empty? batch)
                   (cons batch (lazy-seq (lazy-find (+ start-index batch-size)))))))]


Get rid of bad LinClosure implementation

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

--- src/conexp/contrib/algorithms/linclosure.clj
+++ src/conexp/contrib/algorithms/linclosure.clj
@@ -6,53 +6,13 @@
 ;; the terms of this license.
 ;; You must not remove this notice, or any other, from this software.

-(ns conexp.contrib.algorithms.linclosure
+(ns conexp.contrib.algorithms.downing-gallier
   (:use [conexp.base :only (difference)]
         [conexp.fca.implications :only (premise conclusion make-implication)]))

 ;;;

-(defn close-under-implications  ;; this is LinClosure
-  "Computes smallest superset of start being closed under given implications."
-  [implications start]
-  (let [[counts list newdep] (loop [implications implications,
-                                    counts       (transient {}),
-                                    list         (transient {}),
-                                    newdep       (set start)]
-                               (if-let [impl (first implications)]
-                                 (let [impl-count (count (premise impl))]
-                                   (if (zero? impl-count)
-                                     (recur (rest implications)
-                                            counts
-                                            list
-                                            (into newdep (conclusion impl)))
-                                     (recur (rest implications)
-                                            (assoc! counts impl impl-count)
-                                            (reduce (fn [list a]
-                                                      (assoc! list a (conj (get list a) impl)))
-                                                    list
-                                                    (premise impl))
-                                            newdep)))
-                                 [counts list newdep]))]
-    (loop [counts (persistent! counts)
-           update newdep,
-           newdep newdep]
-      (if (empty? update)
-        newdep
-        (let [a (first update),
-              [counts newdep update]
-                (reduce (fn [[counts newdep update] impl]
-                          (let [cnt (dec (get counts impl))]
-                            (if (zero? cnt)
-                              [(assoc counts impl cnt)
-                               (into newdep (conclusion impl))
-                               (into update (difference (conclusion impl) newdep))]
-                              [(assoc counts impl cnt)
-                               newdep
-                               update])))
-                        [counts newdep (disj update a)]
-                        (get list a))]
-          (recur counts update newdep))))))
+

 ;;;


Don't put extra spaces in tags when adding defaults.

This was causing a test to fail.

--- src/selmer/template_parser.clj
+++ src/selmer/template_parser.clj
@@ -143,10 +143,10 @@
         (consume-block rdr buf blocks)))))

 (defn wrap-in-expression-tag [string]
-  (str *tag-open* *tag-second* \space string \space *tag-second* *tag-close*))
+  (str *tag-open* *tag-second* string *tag-second* *tag-close*))

 (defn wrap-in-variable-tag [string]
-  (str *tag-open* *filter-open* \space string \space *filter-close* *tag-close*))
+  (str *tag-open* *filter-open* string *filter-close* *tag-close*))

 (defn trim-regex [string & regexes]
   (reduce #(clojure.string/replace %1 %2 "") string regexes))


Fixed error in exploration algorithm

Fixed error in exploration algorithm

and now all attributes of the paper are added! Yippi!

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

--- src/conexp/contrib/dl/framework/exploration.clj
+++ src/conexp/contrib/dl/framework/exploration.clj
@@ -72,9 +72,9 @@
 	    subsumes?     (memoize subsumes?)]
     (let [language (model-language initial-model)]
       (loop [k     0,
-	     M_k   (vec (map #(dl-expression language %)
-			     (concept-names language))),
-	     M_k-1 [],
+	     M_k   (map #(dl-expression language %)
+			(concept-names language)),
+	     M_k-1 (),
 	     K     (induced-context M_k initial-model),
 	     Pi_k  [],
 	     P_k   #{},
@@ -95,22 +95,21 @@
 			       (if-not (expert-refuses? susu)
 				 model
 				 (recur (extend-model-by-contradiction model susu))))),
-		next-M_k   (into M_k (for [r (role-names language)]
-				       (dl-expression language (exists r (model-closure next-model all-P_k))))),
+		next-M_k   (into M_k (difference (set-of (dl-expression language (exists r (model-closure next-model all-P_k)))
+							 [r (role-names language)])
+						 (set M_k))),
 		next-M_k-1 M_k,
 		next-K     (induced-context next-M_k next-model),
 		next-Pi_k  (conj Pi_k P_k),
-		next-P_k   (if (= (set M_k) (set M_k-1) (set P_k))
-			     nil
-			     (next-closed-set M_k
-					      (clop-by-implications
-					       (union (set-of (make-implication P_l (context-attribute-closure next-K P_l))
-							      [P_l (rest Pi_k)])
-						      (set-of (make-implication #{C} #{D})
-							      [C M_k, D M_k
-							       :when (and (not= C D)
-									  (subsumes? C D))])))
-					      P_k))]
+		next-P_k   (next-closed-set M_k
+					    (clop-by-implications
+					     (union (set-of (make-implication P_l (context-attribute-closure next-K P_l))
+							    [P_l (rest Pi_k)])
+						    (set-of (make-implication #{C} #{D})
+							    [C M_k, D M_k
+							     :when (and (not= C D)
+									(subsumes? C D))])))
+					    P_k)]
 	    (recur (inc k) next-M_k next-M_k-1 next-K next-Pi_k next-P_k next-model)))))))

 ;;;


Fix wrong state transformation on icons events.

--- src/uxbox/main/data/icons.cljs
+++ src/uxbox/main/data/icons.cljs
@@ -89,7 +89,7 @@
   rs/UpdateEvent
   (-apply-update [_ state]
     (let [{:keys [id] :as item} (assoc item :type :own)]
-      (update state :image-colls-by-id assoc id item)))
+      (update state :icon-colls-by-id assoc id item)))

   rs/WatchEvent
   (-apply-watch [_ state stream]


Remove unused jgit code / deps.

Remove unused jgit code / deps.

--- src/leiningen/git_version.clj
+++ src/leiningen/git_version.clj
@@ -1,8 +1,5 @@
 (ns leiningen.git-version
-  [:use [clojure.pprint]]
-  (:require [clj-jgit.querying :as gitq]
-            [clj-jgit.porcelain :as git]
-            [clojure.java.shell :refer [sh]]
+  (:require [clojure.java.shell :refer [sh]]
             [clojure.string :as s]
             [leiningen.core.main :as lmain])
   (:import [java.util Date]))
@@ -32,7 +29,6 @@
   [project & args]
   (let [[kstrs sargs] (split-with #(.startsWith % ":") args)
         kargs (map #(keyword (.substring % 1)) kstrs)
-        gcommit (git/load-repo ".")
         gver (-> project :root get-git-version)
         qual (format-git-ver gver timestamp-fmt)
         upfn #(s/replace % #"-SNAPSHOT" qual)


Honor init form in eval-in-project. Fixes #152.

--- src/leiningen/interactive.clj
+++ src/leiningen/interactive.clj
@@ -24,9 +24,11 @@
         (Thread/sleep 100)
         (recur reader writer buffer socket)))))

-(defn eval-in-repl [connect project form & [args]]
+(defn eval-in-repl [connect project form & [_ _ init]]
   (let [[reader writer socket] (connect)]
-    (.write writer (str (pr-str form) "\n" '(.close *in*) "\n"))
+    (.write writer (str "(do " (pr-str init)
+                        (pr-str form) "\n" '
+                        (.close *in*) ")\n"))
     (.flush writer)
     (try (eval-client-loop reader writer
                            (make-array Character/TYPE 1000) socket)


add BOOT_EMIT_TARGET=no to boot.properties

this silences boot's warning about the implicit target task which has
been deprecated (see https://github.com/boot-clj/boot/wiki/FAQ)

--- src/leiningen/new/tenzing.clj
+++ src/leiningen/new/tenzing.clj
@@ -182,6 +182,13 @@
       (println "WARNING: unable to produce boot.properties file.")
       out)))

+(defn mute-implicit-target-warning [boot-props]
+  (let [line-sep (System/getProperty "line.separator")]
+    (string/join line-sep
+                 (conj (string/split (render-boot-properties)
+                                     (re-pattern line-sep))
+                       (str "BOOT_EMIT_TARGET=no" line-sep)))))
+
 (defn tenzing
   "Main function to generate new tenzing project."
   [name & opts]
@@ -207,7 +214,7 @@
                            ["resources/index.html" (render "index.html" data)]

                            (when-let [boot-props (render-boot-properties)]
-                             ["boot.properties" boot-props])
+                             ["boot.properties" (silence-implicit-target-warning boot-props)])

                            ["build.boot" (render "build.boot" data)]
                            [".gitignore" (render "gitignore" data)])))))


more progress on config editor

more progress on config editor

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

--- acqEngine/src/org/micromanager/config_editor.clj
+++ acqEngine/src/org/micromanager/config_editor.clj
@@ -67,10 +67,10 @@
     sp))

 (defn update-table [table]
-  (doto (.getModel table)
-    .fireTableDataChanged
-    .fireTableStructureChanged)
-  table)
+    (doto (.getModel table)
+      ;.fireTableDataChanged
+      .fireTableStructureChanged)
+    table)

 ;; events

@@ -118,7 +118,8 @@

 (defn update-groups []
   (reset! groups (vec (seq (core getAvailableConfigGroups))))
-  (update-group-data)
+  (redraw-data)
+  (update-all-properties)
   (-> @widgets :groups-table update-table)
   @group-data)

@@ -140,65 +141,67 @@
                        (do (println "duplicate") false)
                        true))))

-(defn used-properties-table-model []
-  (proxy [AbstractTableModel] []
-    (getColumnName [col] (["Use?" "Property" "Current Value"] col))
-    (getColumnCount [] 3)
-    (getColumnClass [col] ([Boolean String String] col))
-    (getRowCount [] (count @all-properties))
-    (isCellEditable [_ col] (zero? col))
-    (getValueAt [row column]
-                (let [prop (@all-properties row)]
-                  ([(not (nil? ((set (properties @group-data))
-                          (first (@all-properties row)))))
-                    (property-name (first prop))
-                    (second prop)]
-                    column)))
-    (setValueAt [val row column]
-                (let [[[dev prop] _] (@all-properties row)
-                      group (get-selected-group)]
-                  (println val row column)
-                (if val
-                  (add-property group dev prop)
-                  (remove-property group dev prop))))))
-
-(defn group-table-model []
-  (proxy [AbstractTableModel] []
-    (getColumnName [_] "Groups")
-    (getColumnCount [] 1)
-    (getRowCount [] (count @groups))
-    (isCellEditable [_ _] true)
-    (getValueAt [row column] (nth @groups row))
-    (setValueAt [val row column]
-      (let [old-val (nth @groups row)]
-        (core renameConfigGroup old-val val)
-        (update-groups)
-        ))))
-
-(defn preset-names-table-model []
-  (proxy [AbstractTableModel] []
-    (getColumnName [_] "Presets")
-    (getColumnCount [] 1)
-    (getRowCount [] (count (keys @group-data)))
-    (isCellEditable [_ _] true)
-    (getValueAt [row column] (nth (keys @group-data) row))
-    (setValueAt [val row column]
-      (let [old-val (.getValueAt this row column)]
-        (core renameConfig (get-selected-group) old-val val)
-        (update-group-data)))))
-
-(defn presets-table-model []
-  (proxy [AbstractTableModel] []
-    (getColumnName [column] (property-name (nth (properties @group-data) column)))
-    (getColumnCount [] (count (properties @group-data)))
-    (getRowCount [] (count (keys @group-data)))
-    (isCellEditable [_ _] false) ;; will be true
-    (getValueAt [row column] (get (nth (vals @group-data) row)
-                                  (nth (properties @group-data) column)))
-    (setValueAt [val row column]
-                ;(let [old-val (.getValueAt this row column)]
-        ;TODO: finish
-        )))
+(defn used-properties-table []
+  (JTable.
+    (proxy [AbstractTableModel] []
+      (getColumnName [col] (["Use?" "Property" "Current Value"] col))
+      (getColumnCount [] 3)
+      (getColumnClass [col] ([Boolean String String] col))
+      (getRowCount [] (count @all-properties))
+      (isCellEditable [_ col] (zero? col))
+      (getValueAt [row column]
+                  (let [prop (@all-properties row)]
+                    ([(not (nil? ((set (properties @group-data))
+                                       (first (@all-properties row)))))
+                      (property-name (first prop))
+                      (second prop)]
+                      column)))
+      (setValueAt [val row column]
+                  (let [[[dev prop] _] (@all-properties row)
+                        group (get-selected-group)]
+                    (if val
+                      (add-property group dev prop)
+                      (remove-property group dev prop)))))))
+
+(defn groups-table []
+  (JTable.
+    (proxy [AbstractTableModel] []
+      (getColumnName [_] "Groups")
+      (getColumnCount [] 1)
+      (getRowCount [] (count @groups))
+      (isCellEditable [_ _] true)
+      (getValueAt [row column] (nth @groups row))
+      (setValueAt [val row column]
+                  (let [old-val (nth @groups row)]
+                    (core renameConfigGroup old-val val)
+                    (update-groups))))))
+
+(defn preset-names-table []
+  (JTable.
+    (proxy [AbstractTableModel] []
+      (getColumnName [_] "Presets")
+      (getColumnCount [] 1)
+      (getRowCount [] (count (keys @group-data)))
+      (isCellEditable [_ _] true)
+      (getValueAt [row column] (nth (keys @group-data) row))
+      (setValueAt [val row column]
+                  (let [old-val (.getValueAt this row column)]
+                    (core renameConfig (get-selected-group) old-val val)
+                    (update-group-data))))))
+
+(defn presets-table []
+  (JTable.
+    (proxy [AbstractTableModel] []
+      (getColumnName [column] (property-name (nth (properties @group-data) column)))
+      (getColumnCount [] (count (properties @group-data)))
+      (getRowCount [] (count (keys @group-data)))
+      (isCellEditable [_ _] false) ;; will be true
+      (getValueAt [row column] (get (nth (vals @group-data) row)
+                                    (nth (properties @group-data) column)))
+      (setValueAt [val row column]
+                  ;(let [old-val (.getValueAt this row column)]
+                  ;TODO: finish
+                  ))))

 ;; table row selection rules

@@ -248,12 +251,14 @@
 (defn redraw-data []
   (update-group-data)
   (let [preset-names-table (@widgets :preset-names-table)
-        presets-table (@widgets :presets-table)]
+        presets-table (@widgets :presets-table)
+        used-properties-table (@widgets :used-properties-table)]
     (update-table preset-names-table)
-         (cancel-cell-editing preset-names-table)
-         (cancel-cell-editing presets-table)
-         (update-table presets-table)
-         (set-preferred-column-width presets-table)))
+    (update-table used-properties-table)
+    (cancel-cell-editing preset-names-table)
+    (cancel-cell-editing presets-table)
+    (update-table presets-table)
+    (set-preferred-column-width presets-table)))

 (defn new-group-name []
   (loop [index 1]
@@ -331,27 +336,19 @@
 (defn show []
   (let [f (JFrame. "Micro-Manager Configuration Preset Editor")
         cp (.getContentPane f)
-        groups-table (JTable.)
-        presets-table (JTable.)
-        preset-names-table (JTable.)
-        used-properties-table (JTable.)
-        groups-sp (scroll-pane groups-table)
-        presets-sp (scroll-pane presets-table)
-        use-properties-sp (scroll-pane used-properties-table)
-        ]
+        groups-table (groups-table)
+        presets-table (presets-table)
+        preset-names-table (preset-names-table)
+        used-properties-table (used-properties-table)
+        presets-table-sp (scroll-pane presets-table)]
     (edt
       (.setAutoResizeMode presets-table JTable/AUTO_RESIZE_OFF)
       (doall (map require-single-selection [groups-table presets-table preset-names-table]))
       (.. presets-table getTableHeader (setReorderingAllowed false))
-      (.setRowHeaderView presets-sp preset-names-table)
       (.. preset-names-table getParent (setPreferredSize (Dimension. 150 100)))
       ;(.setFixedCellWidth preset-names-list 150)
       ;(.setFixedCellHeight preset-names-list (.getRowHeight presets-table))
       (.setBackground preset-names-table (Color. 0xE0 0xE0 0xE0))
-      (.setModel groups-table (group-table-model))
-      (.setModel preset-names-table (preset-names-table-model))
-      (.setModel presets-table (presets-table-model))
-      (.setModel used-properties-table (used-properties-table-model))
       (link-table-row-selection presets-table preset-names-table)
       (double-click-for-new-row groups-table new-group)
       (double-click-for-new-row
@@ -359,11 +356,12 @@
       (.setAutoResizeMode presets-table JTable/AUTO_RESIZE_OFF)
       (doto cp
         (.setLayout (SpringLayout.))
-        (add-component groups-sp :n 5 :w 5 :n 150 :w 150)
-        (add-component use-properties-sp :n 5 :w 155 :n 150 :w 500)
-        (add-component presets-sp :n 155 :w 5 :s -5 :e -5))
-        (.setBounds f 100 100 800 500)
-        (.show f))
+        (add-component (scroll-pane groups-table) :n 5 :w 5 :n 150 :w 150)
+        (add-component (scroll-pane used-properties-table) :n 5 :w 155 :n 150 :w 500)
+        (add-component presets-table-sp :n 155 :w 5 :s -5 :e -5))
+      (.setRowHeaderView presets-table-sp preset-names-table)
+      (.setBounds f 100 100 800 500)
+      (.show f))
     (.setCellEditor groups-table (group-table-cell-editor))
     {:frame f
      :groups-table groups-table


Housekeeping, clean up coercion, bump perf

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -97,35 +97,36 @@

 ;;;; Coercions

-(defn- coerce-num [x] (if (.contains x ".") (Double. x) (Long. x)))
-(defn- coerce-ba  [^ByteBuffer bb] (.array bb))
-
-(defn- get-value "Returns the value of an AttributeValue object."
-  [attr-value]
-  (or (.getS attr-value)
-      (some->> (.getN  attr-value) coerce-num)
-      (some->> (.getB  attr-value) coerce-ba)
-      (some->> (.getSS attr-value) (into #{}))
-      (some->> (.getNS attr-value) (map coerce-num) (into #{}))
-      (some->> (.getBS attr-value) (map coerce-ba)  (into #{}))))
+(defn- str->num [^String s] (if (.contains s ".") (Double. s) (Long. s)))
+(defn- bb->ba   [^ByteBuffer bb] (.array bb))
+
+(defn- db-val->clj-val
+  "Returns the Clojure value of given AttributeValue object."
+  [^AttributeValue x]
+  (or (.getS x)
+      (some->> (.getN  x) str->num)
+      (some->> (.getB  x) bb->ba)
+      (some->> (.getSS x) (into #{}))
+      (some->> (.getNS x) (map str->num) (into #{}))
+      (some->> (.getBS x) (map bb->ba)   (into #{}))))

 (defn- set-of [pred s] (and (set? s) (every? pred s)))
 (def ^:private ^:const ba-class (Class/forName "[B"))
 (defn- ba? [x] (instance? ba-class x))
 (defn- ba-buffer [^bytes ba] (ByteBuffer/wrap ba))
-(defn- simple-number? [x] (or (instance? Long    x)
-                              (instance? Double  x)
-                              (instance? Integer x)
-                              (instance? Float   x)))
-
-(defn- to-attr-value
+(defn- simple-num? [x] (or (instance? Long    x)
+                           (instance? Double  x)
+                           (instance? Integer x)
+                           (instance? Float   x)))
+
+(defn- clj-val->db-val
   "Returns an AttributeValue object for given Clojure value."
-  ;; TODO Nippy support
+  ;; TODO Nippy support (will require special marker bin-wrapping)
   ;; TODO More efficient set-type dispatch
   [x]
   (cond
    (string? x)        (doto (AttributeValue.) (.setS x))
-   (simple-number? x) (doto (AttributeValue.) (.setN (str x)))
+   (simple-num? x)    (doto (AttributeValue.) (.setN (str x)))
    (ba?     x)        (doto (AttributeValue.) (.setB (ba-buffer x)))
    (set-of string? x) (doto (AttributeValue.) (.setSS x))
    (set-of number? x) (doto (AttributeValue.) (.setNS (map str x)))
@@ -133,8 +134,8 @@
    (set? x)           (throw (Exception. "Set must contain values of the same type."))
    :else              (throw (Exception. (str "Unknown value type: " (type x))))))

-(comment (map to-attr-value ["foo" 10 3.14 (.getBytes "foo")
-                             #{"a" "b" "c"} #{1 2 3.14} #{(.getBytes "foo")}]))
+(comment (map clj-val->db-val ["foo" 10 3.14 (.getBytes "foo")
+                                #{"a" "b" "c"} #{1 2 3.14} #{(.getBytes "foo")}]))

 ;;;; TODO Dev

@@ -219,7 +220,7 @@
     {:consumed-capacity-units (.getConsumedCapacityUnits result)
      :items (some->> (.getItems result)
                      (into [])
-                     (utils/fmap #(utils/fmap get-value (into {} %))))})
+                     (utils/fmap #(utils/fmap db-val->clj-val (into {} %))))})
   KeysAndAttributes
   (as-map [result]
     (merge
@@ -267,7 +268,7 @@
   "Turn a item in DynamoDB into a Clojure map."
   [item]
   (if item
-    (utils/fmap get-value (into {} item))))
+    (utils/fmap db-val->clj-val (into {} item))))

 (extend-protocol AsMap
   GetItemResult
@@ -280,7 +281,7 @@
   (when expected
     (.setExpected req (utils/fmap #(if (instance? Boolean %)
                                      (ExpectedAttributeValue. %)
-                                     (ExpectedAttributeValue. (to-attr-value %)))
+                                     (ExpectedAttributeValue. (clj-val->db-val %)))
                                   expected))))

 (defn put-item
@@ -303,7 +304,7 @@
      (.setItem
       (into {}
             (for [[k v] item]
-              [(name k) (to-attr-value v)])))
+              [(name k) (clj-val->db-val v)])))
      (set-expected-value! expected))))

 (defn- item-key
@@ -311,9 +312,9 @@
   [{:keys [hash-key range-key]}]
   (let [key (Key.)]
     (when hash-key
-      (.setHashKeyElement key (to-attr-value hash-key)))
+      (.setHashKeyElement key (clj-val->db-val hash-key)))
     (when range-key
-      (.setRangeKeyElement key (to-attr-value range-key)))
+      (.setRangeKeyElement key (clj-val->db-val range-key)))
     key))

 (defn get-item
@@ -336,8 +337,8 @@
 (extend-protocol AsMap
   Key
   (as-map [k]
-    {:hash-key  (get-value (.getHashKeyElement k))
-     :range-key (get-value (.getRangeKeyElement k))})
+    {:hash-key  (db-val->clj-val (.getHashKeyElement k))
+     :range-key (db-val->clj-val (.getRangeKeyElement k))})
   nil
   (as-map [_] nil))

@@ -389,7 +390,7 @@
     (.setItem
       (into {}
         (for [[id field] item]
-          {(name id) (to-attr-value field)})))))
+          {(name id) (clj-val->db-val field)})))))

 (defn- write-request [verb item]
   (let [wr (WriteRequest.)]
@@ -457,7 +458,7 @@
 (defn- set-range-condition
   "Add the range key condition to a QueryRequest object"
   [query-request operator & [range-key range-end]]
-  (let [attribute-list (->> [range-key range-end] (remove nil?) (map to-attr-value))]
+  (let [attribute-list (->> [range-key range-end] (remove nil?) (map clj-val->db-val))]
     (.setRangeKeyCondition query-request
                            (doto (Condition.)
                              (.withComparisonOperator operator)
@@ -473,7 +474,7 @@
 (defn- query-request
   "Create a QueryRequest object."
   [table hash-key range-clause {:keys [order limit after count consistent attrs]}]
-  (let [qr (QueryRequest. table (to-attr-value hash-key))
+  (let [qr (QueryRequest. table (clj-val->db-val hash-key))
         [operator range-key range-end] range-clause]
     (when operator
       (set-range-condition qr (normalize-operator operator) range-key range-end))


allow :autoload in :npm-module builds

allow :autoload in :npm-module builds

Not very reliable when running through another bundler but
apparantly did work in the past due to mispelled :autolaod
overwrite.

--- src/main/shadow/build/targets/npm_module.clj
+++ src/main/shadow/build/targets/npm_module.clj
@@ -56,9 +56,7 @@
         (node/set-defaults)

         (and (= :dev mode) (:worker-info state))
-        (shared/merge-repl-defines
-          (update config :devtools merge {:autoload false ;; doesn't work yet, use built-in for now
-                                          :use-document-host false}))
+        (shared/merge-repl-defines config)
         )))

 (defn resolve* [module-config {:keys [classpath] :as state} mode {:keys [entries runtime] :as config}]


missing arg

missing arg

--- src/leiningen/fore_prob.clj
+++ src/leiningen/fore_prob.clj
@@ -23,7 +23,7 @@
   "format a problem description as Clojure comments with one level of
    indentation"
   [desc]
-  (str "  ;; " (cs/replace #"\r?\n" "\n  ;; ")))
+  (str "  ;; " (cs/replace desc #"\r?\n" "\n  ;; ")))

 (defn- add-stub [project prob]
   (let [src (io/file "src" (ns->path (project :group)) "core.clj")]


use offset when slices not used.

use offset when slices not used.

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

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -235,12 +235,12 @@
   (if-let [z-drive (:z-drive event)]
     (-> event
       (assoc :z
-        (if (:slice event)
-					(+
-					  (or (get-in event [:channel :z-offset]) 0)
-					  (or
-						  (get @z-corrections z-drive)
-						  (:slice event)))))
+        (if (or (:slice event)
+                (not (zero? (get-in event [:channel :z-offset]))))
+					(+ (or (get-in event [:channel :z-offset]) 0)
+					   (or (get @z-corrections z-drive)
+						     (:slice event)
+						     (get-z-stage-position)))))
       (assoc-in [:postion :axes z-drive] nil))
     event))


cruff

cruff

--- src/nodecljs/server/core.cljs
+++ src/nodecljs/server/core.cljs
@@ -19,7 +19,7 @@
                             "<main id='jokes'>" % "</main>"
                             "<script src='/js/app.js'></script>"])) ))

-(defn jokes-handler [req res]
+(defn handler [req res]
   (if (= "https" (aget (.-headers req) "x-forwarded-proto"))
     (.redirect res (str "http://" (.get req "Host") (.-url req)))
     (go


Set a new board as draft only if it's created with at least one drafts in it and all the entries are drafts. Check if we need to delete a board when creating a new board with entries.

--- src/oc/storage/api/boards.clj
+++ src/oc/storage/api/boards.clj
@@ -163,7 +163,7 @@
 (defn- create-board [conn {org :existing-org new-board :new-board user :user :as ctx} org-slug]
   (timbre/info "Creating board for org:" org-slug)
   (let [entries (:entries new-board)
-        draft-board? (every? #(-> % :status keyword (= :draft)) entries)
+        draft-board? (and (pos? (count entries)) (every? #(-> % :status keyword (= :draft)) entries))
         new-board-data (assoc new-board :draft draft-board?)]
     (timbre/info "Crating board, is draft?" draft-board?)
     (if-let [board-result (board-res/create-board! conn new-board-data)] ; Add the board
@@ -192,6 +192,10 @@
             (timbre/info "Upserting entry for new board:" board-uuid)
             (let [entry-result (entry-res/upsert-entry! conn new-entry user)]
               (timbre/info "Upserted entry for new board:" board-uuid "as" (:uuid entry-result))
+              ;; If we are updating an existing draft check if we need to remove the old board
+              (let [old-board (board-res/get-board conn (:board-uuid entry))
+                    remaining-entries (entry-res/list-all-entries-by-board conn (:uuid old-board))]
+                (board-res/maybe-delete-draft-board conn org old-board remaining-entries user))
               (when (= (:status entry-result) "published")
                 (when (= :add entry-action)
                   (entries-api/auto-share-on-publish conn (assoc ctx :existing-board board-result) entry-result))


www/render.clj: fix render with multiple arguments

--- src/org/altlaw/www/render.clj
+++ src/org/altlaw/www/render.clj
@@ -79,7 +79,7 @@
        (.getInstanceOf (java/as-str name))
        (render-template (if (map? (first attrs))
                           (if (next attrs)
-                            (apply conj (first attrs) (next attrs))
+                            (apply assoc (first attrs) (next attrs))
                             (first attrs))
                           (apply array-map attrs)))))


Fix update check

Fix update check

--- desktop/src/nightweb_desktop/utils.clj
+++ desktop/src/nightweb_desktop/utils.clj
@@ -60,7 +60,8 @@
       (while true
         (when-let [url (try (slurp "https://nightweb.net/desktop.txt")
                          (catch Exception e nil))]
-          (reset! update-url (if (< (.indexOf version url) 0) url nil)))
+          (when (< (.indexOf url (str \- version \-)) 0)
+            (reset! update-url url)))
         (Thread/sleep (* 6 60 60 1000))))))

 (defn pic-to-data-uri


Renamed tuples-are to tuples-correspond.

--- EkekoAspectJ/test/test/damp/ekeko/aspectj.clj
+++ EkekoAspectJ/test/test/damp/ekeko/aspectj.clj
@@ -39,14 +39,14 @@

 (deftest
   explicit-decprec+-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?dom ?sub]
            (world/aspect-dominates-aspect-explicitly+ ?dom ?sub))
 "#{(\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.EightAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.SecondAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.FourthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SecondAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\")}"))

 (deftest
   implicit-precedence+-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?dom ?sub]
            (world/aspect-dominates-aspect-implicitly+ ?dom ?sub))
  "#{(\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.FourthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\") (\"cl.pleiad.ajlmp.testPrecedence.EightAspect\" \"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\")}"))
@@ -60,21 +60,21 @@
 ; but should also be between 4 and 5
 (deftest
   aspect-dominates-aspect-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?dom ?sub]
            (world/aspect-dominates-aspect ?dom ?sub))
 "#{(\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.EightAspect\") (\"cl.pleiad.ajlmp.testPrecedence.EightAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.FourthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.SecondAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.EightAspect\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\") (\"cl.pleiad.ajlmp.testPrecedence.EightAspect\" \"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.EightAspect\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.FourthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SecondAspect\" \"cl.pleiad.ajlmp.testPrecedence.FifthAspect\")}"))

 (deftest
   overriden-implicit-precedence-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?first ?second]
            (assumptions/overriden-implicit-precedence ?first ?second))
     "#{(\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\")}"))

 (deftest
   overriden-implicit-precedence-shadow-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?first ?second ?shadow]
            (assumptions/overriden-implicit-precedence-shadow ?first ?second ?shadow))
     "#{(\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"baseMethod1()\")}"))
@@ -82,14 +82,14 @@
 ; OK 16 oct
 (deftest
   incomplete-precedence-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?first ?second]
            (assumptions/incomplete-precedence ?first ?second))
     "#{(\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.EightAspect\") (\"cl.pleiad.ajlmp.testPrecedence.EightAspect\" \"cl.pleiad.ajlmp.testPrecedence.FirstAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SecondAspect\" \"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SecondAspect\" \"cl.pleiad.ajlmp.testPrecedence.FourthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.SecondAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.SixthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.FirstAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SecondAspect\" \"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\") (\"cl.pleiad.ajlmp.testPrecedence.EightAspect\" \"cl.pleiad.ajlmp.testPrecedence.SecondAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.FirstAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\" \"cl.pleiad.ajlmp.testPrecedence.FirstAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.FourthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SecondAspect\" \"cl.pleiad.ajlmp.testPrecedence.EightAspect\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.SecondAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SixthAspect\" \"cl.pleiad.ajlmp.testPrecedence.FirstAspect\") (\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.SecondAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SecondAspect\" \"cl.pleiad.ajlmp.testPrecedence.SixthAspect\") (\"cl.pleiad.ajlmp.testPrecedence.SeventhAspect\" \"cl.pleiad.ajlmp.testPrecedence.SecondAspect\")}"))

 (deftest
   incomplete-precedence-shadow-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?first ?second ?shadow]
            (assumptions/incomplete-precedence-shadow ?first ?second ?shadow))
 "#{(\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"baseMethod1()\") (\"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"baseMethod1()\") (\"cl.pleiad.ajlmp.testPrecedence.FourthAspect\" \"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"baseMethod1()\") (\"cl.pleiad.ajlmp.testPrecedence.ThirdAspect\" \"cl.pleiad.ajlmp.testPrecedence.FirstAspect\" \"baseMethod1()\")}"))
@@ -97,14 +97,14 @@

 (deftest
   concretization-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?abpointcut ?concpointcut1 ?concpointcut2]
            (assumptions/abstractpointcut-concretized-reconcretized ?abpointcut ?concpointcut1 ?concpointcut2))
     "#{(\"pointcut cl.pleiad.ajlmp.testPointcuts.AbstractAspect.abstractpc1()\" \"pointcut cl.pleiad.ajlmp.testPointcuts.FirstAspect.abstractpc1()\" \"pointcut cl.pleiad.ajlmp.testPointcuts.SecondAspect.abstractpc1()\")}"))

 (deftest
   intertypemethod-unused-test
-  (test/tuples-are
+  (test/tuples-correspond
     (ekeko [?itmethod]
            (assumptions/intertypemethod-unused ?itmethod))
     "#{(\"(BcelTypeMunger ResolvedTypeMunger(Method, void cl.pleiad.ajlmp.testITD.BaseClass.itdB()))\")}"))


Исправление

Исправление

--- radiolamp-6P3S/src/r6p3s/cpt/input_date_interval.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/input_date_interval.cljs
@@ -83,7 +83,9 @@
                                                                    :onChange-valid?-fn        common-input/vldfn-not-empty-date
                                                                    :onChange-updated-valid-fn #(put! chan-update 1)}}})))

-                 (when (or (get-in app-v [:from-date :text-warning]) (get-in app-v [:to-date :text-warning]))
+                 (when (or
+                        (get-in app-v [:from-date :text-warning])
+                        (get-in app-v [:to-date :text-warning]))
                    (dom/p #js {:className "text-warning"
                                :style #js {:textAlign "center"}}
                           (glyphicon/render "info-sign")


Add run-jetty CPS test

Add run-jetty CPS test

--- ring-jetty-adapter/test/ring/adapter/test/jetty.clj
+++ ring-jetty-adapter/test/ring/adapter/test/jetty.clj
@@ -244,3 +244,16 @@
               (Thread/sleep 250)
               (recur (inc i))))
           (is (= thread-count (count (all-threads)))))))))
+
+(defn- hello-world-cps [request cont raise]
+  (cont {:status  200
+         :headers {"Content-Type" "text/plain"}
+         :body    "Hello World"}))
+
+(deftest run-jetty-cps-test
+  (with-server hello-world-cps {:port test-port, :async? true}
+    (let [response (http/get test-url)]
+      (is (= (:status response) 200))
+      (is (.startsWith (get-in response [:headers "content-type"])
+                       "text/plain"))
+      (is (= (:body response) "Hello World")))))


(PDB-5161) engine/is-dotted-projection?: rm in favor of parse-field

Replace remaining uses of is-dotted-projection? with parse-field and
remove is-dotted-projection entirely..

--- src/puppetlabs/puppetdb/query_eng/engine.clj
+++ src/puppetlabs/puppetdb/query_eng/engine.clj
@@ -62,11 +62,6 @@
 (def field-schema (s/cond-pre s/Keyword
                               SqlCall SqlRaw
                               {:select s/Any s/Any s/Any}))
-
-(defn is-dotted-projection?
-  [projection]
-  ;; If the projection has a dot it must be of the form fact.foo
-  (str/includes? projection "."))

 ; The use of 'column' here is a misnomer. This refers to the result of
 ; a query and the top level keys used should match up to query entities
@@ -2103,48 +2098,48 @@
              (first expr)))

 (defn create-json-subtree-projection
-  [dotted-field projections]
-  (let [json-path (->> (parse/dotted-query->path dotted-field)
-                       (map parse/maybe-strip-escaped-quotes))
-        stringify-field (fn [{:keys [field field-type]}]
-                          (case field-type
-                            :keyword (name field)
-                            :raw (:s field)
-                            (throw (IllegalArgumentException.
-                                     (tru "Cannot determine field type for field ''{0}''" field)))))]
-  {:type :json
-   :queryable? false
-   :field (hcore/raw
-            (jdbc/create-json-path-extraction
-              ; Extract the original field as a string
-              (->> json-path
-                   first
-                   projections
-                   stringify-field)
-              (rest json-path)))
-   ;; json-path will be something like ("facts" "kernel" ...)
-   :join-deps (get-in projections [(first json-path) :join-deps])}))
+  [[top & path :as parsed-field] projections]
+  (let [stringify (fn [{:keys [field field-type]}]
+                    (case field-type
+                      :keyword (name field)
+                      :raw (:s field)
+                      (throw (IllegalArgumentException.
+                              (tru "Cannot determine field type for field ''{0}''" field)))))]
+    {:type :json
+     :queryable? false
+     :field (hcore/raw
+             (jdbc/create-json-path-extraction
+              ;; Extract the original field as a string
+              (-> top :name projections stringify)
+              (map #(case (:kind %)
+                      ::parse/named-field-part (:name %))
+                   path)))
+     ;; json-path will be something like ("facts" "kernel" ...)
+     :join-deps (get-in projections [(:name top) :join-deps])}))

 (defn create-extract-node*
   "Returns a `query-rec` that has the correct projection for the given
    `column-list`. Updating :projected-fields causes the select in the SQL query
    to be modified."
   [{:keys [projections] :as query-rec} column-list expr]
-  (let [names->fields (fn [names projections]
-                        (mapv #(if (is-dotted-projection? %)
-                                 (vector % (create-json-subtree-projection % projections))
-                                 (vector % (projections %)))
-                              names))]
+  (let [names->fields (fn [projections]
+                        (mapv (fn [field parsed]
+                                (vector field
+                                        (if (> (count parsed) 1) ;; dotted projection?
+                                          (create-json-subtree-projection parsed projections)
+                                          (projections field))))
+                              column-list
+                              (map parse/parse-field column-list)))]
     (if (or (nil? expr)
             (not (subquery-expression? expr)))
       (assoc query-rec
              :where (user-node->plan-node query-rec expr)
-             :projected-fields (names->fields column-list projections))
+             :projected-fields (names->fields projections))
       (let [[subname & subexpr] expr
             logobj (user-query->logical-obj subname)
             projections (:projections logobj)]
         (assoc logobj
-               :projected-fields (names->fields column-list projections)
+               :projected-fields (names->fields projections)
                :where (some->> (seq subexpr)
                                first
                                (user-node->plan-node logobj)))))))


Ensure that agg closes it ch out.

Ensure that agg closes it ch out.

--- src/onyx/peer/aggregate.clj
+++ src/onyx/peer/aggregate.clj
@@ -19,8 +19,8 @@
          (>! session-ch {:session session :halting-ch halting-ch :msgs msgs}))
        (when (<! halting-ch)
          (recur)))
-     (catch Exception e
-       (fatal e)))))
+     (finally
+      (close! session-ch)))))

 (defn inject-pipeline-resource-shim
   [{:keys [onyx.core/queue onyx.core/ingress-queues onyx.core/task-map] :as event}]


Dont need the extra parens for these defns

--- src/overcode/introvert.cljs
+++ src/overcode/introvert.cljs
@@ -121,19 +121,17 @@
 ;;***************************************************************************
 (declare deep=)

-(defn deep-arr=
-  ([val1 val2 visited]
-   (and (= (count val1) (count val2))
-        (every? identity (map #(deep= % %2 visited) val1 val2)))))
+(defn deep-arr= [val1 val2 visited]
+  (and (= (count val1) (count val2))
+       (every? identity (map #(deep= % %2 visited) val1 val2))))

-(defn deep-obj=
-  ([val1 val2 visited]
+(defn deep-obj= [val1 val2 visited]
   (and (= (obj-size val1) (obj-size val2))
        (deep-arr= (.keys js/Object val1)
                   (.keys js/Object val2)
                   visited)
        (every? #(deep= (aget val1 %) (aget val2 %) visited)
-               (.keys js/Object val1)))))
+               (.keys js/Object val1))))

 (defn deep=
   "Compares JS values for equality by value instead of by reference."


event-monitor-keys now returns a set. Fixes #192.

--- src/overtone/libs/event.clj
+++ src/overtone/libs/event.clj
@@ -260,6 +260,6 @@
   ([event-key] (get @monitor* event-key)))

 (defn event-monitor-keys
-  "Return a seq of all the keys of most recently seen events."
-  []
-  (keys @monitor*))
+  "Return a set of all the keys of most recently seen events."
+  []
+  (into #{} (keys @monitor*)))


default to cpu-count + 2 threads for new pools

--- src/overtone/time_utils.clj
+++ src/overtone/time_utils.clj
@@ -34,8 +34,8 @@
 ; it seems that timing isn't accurate enough.

 (defn make-pool
-  "Creates a new pool of threads to schedule new events for. Pool size defaults to the cpu count"
-  ([] (make-pool (cpu-count)))
+  "Creates a new pool of threads to schedule new events for. Pool size defaults to the cpu count + 2"
+  ([] (make-pool (+ 2 (cpu-count))))
   ([num-threads]
      (ScheduledThreadPoolExecutor. num-threads)))


Fixing my poorly done copy and paste.  Fixed resolve-entity-id overload issue.

--- src/prop_shop/data/base.clj
+++ src/prop_shop/data/base.clj
@@ -71,7 +71,7 @@
 (defn resolve-entity-id
   "Takes the internal ID of an entity, reducing instructions, and an optional
    database value reference, and resolves it to a map of the entity."
-  ([entity-id path-map] (resolve-entity-id path-map (db)))
+  ([entity-id path-map] (resolve-entity-id entity-id path-map (db)))
   ([entity-id path-map db]
     (reduce-entity (d/entity db entity-id) path-map)))


fixed bug in soft-environment-ending

fixed bug in soft-environment-ending

--- src/push/interpreter/core.clj
+++ src/push/interpreter/core.clj
@@ -469,7 +469,7 @@
         environments  (u/get-stack interpreter :environment)
         retrieved     (first environments)
         old-exec      (:exec retrieved)
-        new-exec      (concat returns current-exec old-exec)]
+        new-exec      (into '() (reverse (concat returns current-exec old-exec)))]
     (-> (u/merge-environment interpreter retrieved)
         (u/set-stack , :exec new-exec)
         (u/set-stack , :environment (pop environments))


Refactor

Refactor

--- backend/src/akvo/lumen/component/keycloak.clj
+++ backend/src/akvo/lumen/component/keycloak.clj
@@ -323,9 +323,10 @@
       (w/keywordize-keys (fetch-user-by-id headers (:api-root keycloak) tenant user-id))))

   (user? [keycloak email]
-    (-> (request-headers keycloak)
-        (fetch-user-by-email (:api-root keycloak) email)
-        some?))
+    (let [headers (request-headers keycloak)]
+      (not (nil? (fetch-user-by-email headers
+                                      (:api-root keycloak)
+                                      email)))))

   (users [this tenant-label]
     (tenant-members this tenant-label))


[#2763] Refactor

[#2763] Refactor

--- backend/src/akvo/lumen/lib/transformation.clj
+++ backend/src/akvo/lumen/lib/transformation.clj
@@ -51,9 +51,8 @@
             :transformation (engine/execute-transformation tx-deps dataset-id job-execution-id (:transformation command))
             :undo (engine/execute-undo tx-deps dataset-id job-execution-id)))
         (db.job-execution/update-successful-job-execution tx-conn {:id job-execution-id}))
-      (let [table-name (:table-name (db.transformation/latest-dataset-version-by-dataset-id tenant-conn
-                                                                     {:dataset-id dataset-id}))]
-       (db.job-execution/vacuum-table tenant-conn {:table-name table-name}))
+      (let [dsv (db.transformation/latest-dataset-version-by-dataset-id tenant-conn {:dataset-id dataset-id})]
+        (db.job-execution/vacuum-table tenant-conn (select-keys dsv [:table-name])))
       (catch Exception e
         (let [msg (.getMessage e)]
           (engine/log-ex e)


fix typo

fix typo

--- src/refactor_nrepl/config.clj
+++ src/refactor_nrepl/config.clj
@@ -6,7 +6,7 @@
              [misc :refer [response-for]]
              [transport :as transport]]))

-;; NOTE: Update the readme whenever this map is updaed
+;; NOTE: Update the readme whenever this map is changed
 (def ^:private opts
   (atom
    {
@@ -43,7 +43,7 @@
       (response-for msg :error (.getMessage e) :status :done))
     (catch Exception e
       (transport/send transport
-                      (response-for msg (err-info e :clean-ns-error))))))
+                      (response-for msg (err-info e :configure-error))))))

 (defn wrap-config
   [handler]


Fix Linux detection for Netty (#999)

Fix Linux detection for Netty (#999)

Netty uses the epoll implementation only if Riemann detects
that the operating system is Linux based.

On my computer (Debian 10), `(System/getProperty "os.name")` returns
"Linux", which does not match the `#"linux"` regex.

This commit modifies the regex to also accept `Linux`.

Some REPL outputs:

(re-find  #"(linux|Linux)" (System/getProperty "os.name"))
["Linux" "Linux"]

(re-find  #"linux" (System/getProperty "os.name"))
nil

--- src/riemann/transport/tcp.clj
+++ src/riemann/transport/tcp.clj
@@ -92,7 +92,7 @@

 (def netty-implementation
   (let [mac-or-freebsd? (re-find #"(mac|freebsd)" (System/getProperty "os.name"))
-       linux? (re-find  #"linux" (System/getProperty "os.name"))
+       linux? (re-find  #"(linux|Linux)" (System/getProperty "os.name"))
        sfbit? (re-find #"(x86_64|amd64)" (System/getProperty "os.arch"))
        native?  (= (System/getProperty "netty.native.implementation") "true")]
     (cond (and native? sfbit? linux?) (epoll-netty-implementation)


filter figwheel connect scripts properly

--- support/src/figwheel/client/file_reloading.cljs
+++ support/src/figwheel/client/file_reloading.cljs
@@ -347,7 +347,9 @@

 (defn expand-files [files]
   (let [deps (get-all-dependents (map :namespace files))]
-    (filter (comp not #{"figwheel.connect"} :namespace)
+    (filter (comp not
+                  (partial re-matches #"figwheel\.connect.*")
+                  :namespace)
             (map
              (fn [n]
                (if-let [file-msg (first (filter #(= (:namespace %) n) files))]


(TK-443) Improve and consolidate enable url metric tests

--- test/puppetlabs/http/client/metrics_test.clj
+++ test/puppetlabs/http/client/metrics_test.clj
@@ -71,17 +71,6 @@
       app
       [jetty9/jetty9-service test-metric-web-service]
       {:webserver {:port 10000}}
-      (with-open [client (Async/createClient (doto (ClientOptions.)
-                                               (.setMetricRegistry (MetricRegistry.))
-                                               (.setEnableURLMetrics false)))]
-        (let [request-opts (RequestOptions. hello-url)
-              response (-> client (.get request-opts) (.deref))]
-          (is (= 200 (.getStatus response)))
-          (let [client-metrics (-> client
-                                   (.getMetricRegistry)
-                                   (Metrics/getClientMetrics))]
-            (is (.isEmpty (.getUrlTimers client-metrics)))
-            (is (.isEmpty (.getUrlAndMethodTimers client-metrics))))))
       (let [metric-registry (MetricRegistry.)
             hello-request-opts (RequestOptions. hello-url)
             short-request-opts (RequestOptions. short-url)
@@ -180,15 +169,6 @@
       app
       [jetty9/jetty9-service test-metric-web-service]
       {:webserver {:port 10000}}
-      (with-open [client (async/create-client {:metric-registry (MetricRegistry.)
-                                               :enable-url-metrics? false})]
-        (let [response @(common/get client hello-url)]
-          (is (= 200 (:status response)))
-          (let [client-metrics (-> client
-                                   (common/get-client-metric-registry)
-                                   (metrics/get-client-metrics))]
-            (is (empty? (:url client-metrics)))
-            (is (empty? (:url-and-method client-metrics))))))
       (let [metric-registry (MetricRegistry.)]
         (with-open [client (async/create-client
                             {:metric-registry metric-registry})]
@@ -277,17 +257,6 @@
       app
       [jetty9/jetty9-service test-metric-web-service]
       {:webserver {:port 10000}}
-      (with-open [client (Sync/createClient (doto (ClientOptions.)
-                                              (.setMetricRegistry (MetricRegistry.))
-                                              (.setEnableURLMetrics false)))]
-        (let [request-opts (RequestOptions. hello-url)
-              response (-> client (.get request-opts))]
-          (is (= 200 (.getStatus response)))
-          (let [client-metrics (-> client
-                                   (.getMetricRegistry)
-                                   (Metrics/getClientMetrics))]
-            (is (.isEmpty (.getUrlTimers client-metrics)))
-            (is (.isEmpty (.getUrlAndMethodTimers client-metrics))))))
       (let [metric-registry (MetricRegistry.)
             hello-request-opts (RequestOptions. hello-url)
             short-request-opts (RequestOptions. short-url)
@@ -387,15 +356,6 @@
       app
       [jetty9/jetty9-service test-metric-web-service]
       {:webserver {:port 10000}}
-      (with-open [client (sync/create-client {:metric-registry (MetricRegistry.)
-                                              :enable-url-metrics? false})]
-        (let [response (common/get client hello-url)]
-          (is (= 200 (:status response)))
-          (let [client-metrics (-> client
-                                   (common/get-client-metric-registry)
-                                   (metrics/get-client-metrics))]
-            (is (empty? (:url client-metrics)))
-            (is (empty? (:url-and-method client-metrics))))))
       (let [metric-registry (MetricRegistry.)]
         (with-open [client (sync/create-client {:metric-registry metric-registry})]
           (common/get client hello-url) ; warm it up
@@ -777,3 +737,64 @@
                                                 :server-id server-id})]
               (-> client-with-server-id (common/get hello-url))
               (is (= metric-name-with-prefix (get-metric-name metric-registry)))))))))))
+
+(deftest toggleable-url-metrics
+  (testlogging/with-test-logging
+    (testutils/with-app-with-config
+     app
+     [jetty9/jetty9-service test-metric-web-service]
+     {:webserver {:port 10000}}
+     (testing "url-metrics can be disabled for clojure async client"
+       (with-open [client (async/create-client {:metric-registry (MetricRegistry.)
+                                                :enable-url-metrics? false})]
+         (let [response @(common/get client hello-url {:metric-id ["foo" "bar"]})]
+           (is (= 200 (:status response)))
+           (let [client-metrics (-> client
+                                    (common/get-client-metric-registry)
+                                    (metrics/get-client-metrics))
+                 metric-names (set (map #(.getMetricName %) (:metric-id client-metrics)))]
+             (is (empty? (:url client-metrics)))
+             (is (empty? (:url-and-method client-metrics)))
+             (is (= #{long-foo-name long-foo-bar-name} metric-names))))))
+     (testing "url-metrics can be disabled for java async client"
+       (with-open [client (Async/createClient (doto (ClientOptions.)
+                                              (.setMetricRegistry (MetricRegistry.))
+                                              (.setEnableURLMetrics false)))]
+         (let [request-opts (doto (RequestOptions. hello-url)
+                              (.setMetricId (into-array ["foo" "bar"])))
+               response (-> client (.get request-opts) (.deref))]
+           (is (= 200 (.getStatus response)))
+           (let [client-metrics (-> client
+                                    (.getMetricRegistry)
+                                    (Metrics/getClientMetrics))
+                 metric-names (set (map #(.getMetricName %) (.getMetricIdTimers client-metrics)))]
+             (is (.isEmpty (.getUrlTimers client-metrics)))
+             (is (.isEmpty (.getUrlAndMethodTimers client-metrics)))
+             (is (= #{long-foo-name long-foo-bar-name} metric-names))))))
+     (testing "url-metrics can be disabled for clojure sync client"
+       (with-open [client (sync/create-client {:metric-registry (MetricRegistry.)
+                                               :enable-url-metrics? false})]
+         (let [response (common/get client hello-url {:metric-id ["foo" "bar"]})]
+           (is (= 200 (:status response)))
+           (let [client-metrics (-> client
+                                    (common/get-client-metric-registry)
+                                    (metrics/get-client-metrics))
+                 metric-names (set (map #(.getMetricName %) (:metric-id client-metrics)))]
+             (is (empty? (:url client-metrics)))
+             (is (empty? (:url-and-method client-metrics)))
+             (is (= #{long-foo-name long-foo-bar-name} metric-names))))))
+     (testing "url-metrics can be disabled for java sync client"
+       (with-open [client (Sync/createClient (doto (ClientOptions.)
+                                               (.setMetricRegistry (MetricRegistry.))
+                                               (.setEnableURLMetrics false)))]
+         (let [request-opts (doto (RequestOptions. hello-url)
+                              (.setMetricId (into-array ["foo" "bar"])))
+               response (-> client (.get request-opts))]
+           (is (= 200 (.getStatus response)))
+           (let [client-metrics (-> client
+                                    (.getMetricRegistry)
+                                    (Metrics/getClientMetrics))
+                 metric-names (set (map #(.getMetricName %) (.getMetricIdTimers client-metrics)))]
+             (is (.isEmpty (.getUrlTimers client-metrics)))
+             (is (.isEmpty (.getUrlAndMethodTimers client-metrics)))
+             (is (= #{long-foo-name long-foo-bar-name} metric-names)))))))))


Test for immediate completion.

Test for immediate completion.

--- test/onyx/generative/acking_daemon_gen_test.clj
+++ test/onyx/generative/acking_daemon_gen_test.clj
@@ -20,14 +20,12 @@
    ;; UUID for its identifier.
    :model/args
    (fn [state]
-     (let [message-ids (keys (:model-state state))
-           new-msg-id (fn [v] (not (some #{v} message-ids)))]
-       [(:real-state state)
-        (gen/return (chan 1))
-        (gen/hash-map
-         :id (gen/return (UUID/randomUUID))
-         :completion-id (gen/return (UUID/randomUUID))
-         :ack-val (gen/return (a/gen-ack-value)))]))
+     [(:real-state state)
+      (gen/return (chan 1))
+      (gen/hash-map
+       :id (gen/return (UUID/randomUUID))
+       :completion-id (gen/return (UUID/randomUUID))
+       :ack-val (gen/return (a/gen-ack-value)))])

    :real/command #'a/ack-segment

@@ -135,10 +133,46 @@
             (nil? next-model-record)
             (not (nil? prev-model-record)))))})

+(def complete-new-segment-specification
+  {:model/requires
+   (fn [state]
+     (<= (count (keys (:model-state state))) max-state-size))
+
+   ;; Complete a new segment by immediately reported 0 as an ack val.
+   ;; This can happen if a flow condition for an input task chooses
+   ;; not to route a segment to the next task.
+   :model/args
+   (fn [state]
+     [(:real-state state)
+      (gen/return (chan 1))
+      (gen/hash-map
+       :id (gen/return (UUID/randomUUID))
+       :completion-id (gen/return (UUID/randomUUID))
+       :ack-val (gen/return 0))])
+
+   :real/command #'a/ack-segment
+
+   ;; Immediately remove this segment from the state.
+   :next-state
+   (fn [state [real-state ch {:keys [id completion-id ack-val]}] result]
+     (update-in state [:model-state] dissoc id))
+
+   ;; Check that it was removed from the state.
+   :real/postcondition
+   (fn [prev-state next-state [real-state ch {:keys [id ack-val]}] result]
+     (let [real @(:real-state next-state)
+           real-record (get (:state real) id)
+           prev-model-record (get-in prev-state [:model-state id])
+           next-model-record (get-in next-state [:model-state id])]
+       (and (nil? real-record)
+            (nil? next-model-record)
+            (nil? prev-model-record))))})
+
 (def acking-daemon-spec
   {:commands {:new #'new-segment-specification
               :update #'updated-segment-specification
-              :complete-existing #'complete-existing-segment-specification}
+              :complete-existing #'complete-existing-segment-specification
+              :complete-new #'complete-new-segment-specification}
    :real/setup #'a/init-state
    :initial-state (fn [ack-state] {:real-state ack-state :model-state {}})})


test that composite numbers are not prime

--- test/prime_times/math_test.clj
+++ test/prime_times/math_test.clj
@@ -5,7 +5,10 @@
 (deftest prime?
   (testing "prime numbers"
     (are [n] (m/prime? n)
-      2 3 5 7 11)))
+      2 3 5 7 11 541))
+  (testing "composite numbers"
+    (are [n] ((complement m/prime?) n)
+      1 4 6 8 10 999)))

 #_(defn p67 [__]
   [(= (__ 2) [2 3])


fix typo, (curly brackets instead of parens)

--- frontend/components/aside.cljs
+++ frontend/components/aside.cljs
@@ -69,7 +69,7 @@
     om/IDisplayName (display-name [_] "Aside Project Activity")
     om/IRender
     (render [_]
-      (let [login {:login opts}
+      (let [login (:login opts)
             project (:project data)
             controls-ch (om/get-shared owner [:comms :controls])
             settings (:settings data)


CMR-5106 Changes coll ACL matcher logic for entry-titles and concept-ids

--- umm-spec-lib/src/cmr/umm_spec/acl_matchers.clj
+++ umm-spec-lib/src/cmr/umm_spec/acl_matchers.clj
@@ -89,10 +89,10 @@
         concept-id (or (:concept-id coll)
                        (:id coll))
         {:keys [entry-titles access-value temporal concept-ids]} coll-id]
-    (and (or (empty? entry-titles)
-             (some (partial = coll-entry-title) entry-titles))
-         (or (empty? concept-ids)
-             (some (partial = concept-id) (map name concept-ids)))
+    (and (or (some (partial = coll-entry-title) entry-titles)
+             (some (partial = concept-id) (map name concept-ids))
+             (and (empty? concept-ids)
+                  (empty? entry-titles)))
          (or (nil? access-value)
              (matches-access-value-filter? :collection coll access-value))
          (or (nil? temporal)


API doc for :vhosts

API doc for :vhosts

--- web/src/immutant/web.clj
+++ web/src/immutant/web.clj
@@ -31,11 +31,12 @@

    options can be a map or kwargs, with these valid keys [default]:

-     * :host  The interface bind address [localhost]
-     * :port  The port listening for requests [8080]
-     * :path  Maps the handler to a prefix of the url path [/]
+     * :host   The interface bind address [localhost]
+     * :port   The port listening for requests [8080]
+     * :path   Maps the handler to a prefix of the url path [/]
+     * :vhosts Virtual host name[s] (a String or a List of Strings) [nil]

-   Run calls can be threaded together, e.g.
+   Run calls may be threaded together, too:

    ```
      (-> (run hello)


Improve syntax of the from / select

Improve syntax of the from / select

--- src/clojure/clojurewerkz/cassaforte/new_query_api.clj
+++ src/clojure/clojurewerkz/cassaforte/new_query_api.clj
@@ -139,14 +139,19 @@
        :filtering    (fn filtering-query [query-builder _]
                        (.allowFiltering query-builder))

-       :from         (fn from-query [query-builder table-name]
-                       (.from query-builder (name table-name)))
+       :from         (fn from-query [query-builder t]
+                       (match t
+                              [keyspace table] (.from query-builder (name keyspace) (name table))
+                              table            (.from query-builder (name table)))
+
+                       )
        }]
   (defn select
-    [table-name & statements]
-    (->> (conj statements (from table-name))
-         (sort-by #(get order (first %)))
-         ;; (map second)
+    [& statements];; table-name &
+    (->> (if (sequential? (first statements))
+           statements
+           (conj (next statements) (from (first statements))))
+         (sort-by #(get order (first %)))
          (reduce (fn [builder [statement-name statement-args]]
                    ((get renderers statement-name) builder statement-args))
                  (QueryBuilder/select))


[victoryw] fix build

[victoryw] fix build

--- go-visual/src/go_visual/static_pipeline_instance.clj
+++ go-visual/src/go_visual/static_pipeline_instance.clj
@@ -1,10 +1,13 @@
 (ns go-visual.static_pipeline_instance
   (:require [clj-http.client :as client])
   (:require [clojure.data.json :as json])
-  (:require [go-visual.string2number :as string2number]))
+  (:require [go-visual.string2number :as string2number])
+  (:require [clj-time.coerce :as c]))

 (defn fetch-pipeline-datas
   [url username password]
+  ; (spit "./123.json" (json/read-str (get (client/get url {:basic-auth [username password]}) :body)
+  ;                                   :key-fn keyword))
   (json/read-str (get (client/get url {:basic-auth [username password]}) :body)
                  :key-fn keyword))


[victoryw] #N/A refactor the code format

--- go-visual/src/go_visual/static_pipeline_instance.clj
+++ go-visual/src/go_visual/static_pipeline_instance.clj
@@ -20,40 +20,29 @@
   [pipeline-instance]
   {:name (:name pipeline-instance)
    :counter (:counter pipeline-instance)
-   :pipeline-run-times   (+ 1 (-
-                               (reduce + (map (comp string2number/to-number :counter) (:statges pipeline-instance)))
-                               ((comp count :statges) pipeline-instance)))})
-
-(defn statis-pipeline-success-status
+   :statges-run-times   (reduce + (map (comp string2number/to-number :counter) (:statges pipeline-instance)))
+   :statges ((comp count :statges) pipeline-instance)
+   :statges-sucess-radio ()})
+
+(defn statis-pipeline-success-rate
   [pipelines]
-  (sort-by :counter < (map (fn [pipeline]
-         {:name (:name pipeline)
-          :counter (:counter pipeline)
-          :status  (every? #(and (true? (:scheduled %)) (= (str (:result %)) "Passed")) (:stages pipeline))})
-       pipelines)))
-
-(defn statis-pipeline-continue-failure-counter
-  [last-result-failure-counter pipeline-instance]
-  (if (true? (:status pipeline-instance))
-    (assoc pipeline-instance :fail 0)
-    (assoc pipeline-instance :fail (+ 1 last-result-failure-counter))))
-
-(defn extract-last-pipeline-continue-failure-counter
-  [last-result]
-  (if (empty? last-result) 0
-      (if (list? last-result) (:fail (last last-result)) (:fail last-result))))
-
-(defn statis-accumulate-pipeline-failure-counter
-  [pipelines]
-  (flatten (reduce #(list % (statis-pipeline-continue-failure-counter (extract-last-pipeline-continue-failure-counter %) %2)) '() pipelines)))
+  (map
+    #(
+      { :name  (:name %)
+        :counter (:counter %)
+        :success-rate (map
+                       #(reduce
+                           (if))
+                       (:stages %))})
+
+    pipelines))
+
+

 (defn statistic-each-pipeline-stage-run-time
   [url username password]
-  (def pipelines (:pipelines (fetch-pipeline-datas url username password)))
-  ; (def statis (sort-by :counter < (map (comp  statistic-pipeline-instace extract-pipeline-instance-history) pipelines)))
-  (statis-accumulate-pipeline-failure-counter
-   (map
-    (fn [statistic-pipeline status-pipeline] (assoc statistic-pipeline :status (:status status-pipeline)))
-    (sort-by :counter < (map (comp  statistic-pipeline-instace extract-pipeline-instance-history) pipelines))
-    (statis-pipeline-success-status pipelines))))
-
+  (def pipelines (:pipelines (fetch-pipeline-datas url username password))
+   (map (comp  statistic-pipeline-instace
+               extract-pipeline-instance-history)
+        pipelines)))
+


add more tests

add more tests

--- test/duratom/core_test.clj
+++ test/duratom/core_test.clj
@@ -3,6 +3,30 @@
             [duratom.core :refer :all]
             [clojure.java.io :as jio]
             [duratom.utils :as ut]))
+
+(defn- common* [dura peek-in-source exists?]
+  (-> dura
+      (doto (swap! assoc :z 3))
+      (doto (swap! dissoc :x)))
+
+  (Thread/sleep 200)
+  (is (= {:z 3 :y 2} @dura))
+  (is (= {:z 3 :y 2} (peek-in-source)))
+
+  (-> dura
+      (doto (reset! [1 2 3]))
+      (doto (swap!  (comp vec rest))))
+
+  (Thread/sleep 200)
+  (is (= [2 3] @dura))
+  (is (= [2 3] (peek-in-source)))
+
+  (destroy dura)
+  (Thread/sleep 200)
+  (is (= [2 3] @dura))
+  (is (thrown? AssertionError (swap! dura conj 4)))
+  (is (false? (exists?)) "Storage resurce was NOT deleted!!!")
+  )

 (deftest file-backed-tests
   (println "File-backed atom...")
@@ -14,29 +38,23 @@
                         :init init)
                :log (fn [k r old-state new-state]
                       (println "Transitioning from" old-state "to" new-state "...")))]
-    (-> dura
-        (doto (swap! assoc :z 3))
-        (doto (swap! dissoc :x)))

-    (Thread/sleep 200)
-    (is (= {:z 3 :y 2} @dura))
-    (is (= {:z 3 :y 2} (-> rel-path slurp read-string)))
-
-    (-> dura
-        (doto (reset! [1 2 3]))
-        (doto (swap!  (comp vec rest))))
-
-    (Thread/sleep 200)
-    (is (= [2 3] @dura))
-    (is (= [2 3] (-> rel-path slurp read-string)))
-
-    (destroy dura)
-    (Thread/sleep 200)
-    (is (= [2 3] @dura))
-    (is (thrown? AssertionError (swap! dura conj 4)))
-    (is (false? (.exists (jio/file rel-path))) "File was NOT deleted!!!")
-
-    ))
+    ;; empty file first
+    (common* dura
+             #(-> rel-path slurp read-string)
+             #(.exists (jio/file rel-path)))
+    ;; with-contents thereafter
+    (spit rel-path (pr-str init))
+    (common* (add-watch
+               (duratom :local-file
+                        :file-path rel-path
+                        :init init)
+               :log (fn [k r old-state new-state]
+                      (println "Transitioning from" old-state "to" new-state "...")))
+             #(-> rel-path slurp read-string)
+             #(.exists (jio/file rel-path)))
+    )
+  )

 (deftest postgres-backed-tests
@@ -56,28 +74,20 @@
                         :init init)
                :log (fn [k, r, old-state, new-state]
                       (println "Transitioning from" old-state "to" new-state "...")))]
-      (-> dura
-          (doto (swap! assoc :z 3))
-          (doto (swap! dissoc :x)))

-      (Thread/sleep 200)
-      (is (= {:z 3 :y 2} @dura))
-      (is (= {:z 3 :y 2} (ut/get-pgsql-value db-spec table-name 0)))
-
-      (-> dura
-          (doto (reset! [1 2 3]))
-          (doto (swap! (comp vec rest))))
-
-      (Thread/sleep 200)
-      (is (= [2 3] @dura))
-      (is (= [2 3] (ut/get-pgsql-value db-spec table-name 0)))
-
-      (destroy dura)
-
-      (Thread/sleep 200)
-      (is (= [2 3] @dura))
-      (is (thrown? AssertionError (swap! dura conj 4)))
-      (is (false? (ut/table-exists? db-spec table-name)) "Table was NOT deleted!!!")
+    ;; empty row first
+    (common* dura #(ut/get-pgsql-value db-spec table-name 0) #(ut/table-exists? db-spec table-name))
+    ;; with-contents threafter
+    (common* (add-watch
+               (duratom :postgres-db
+                        :db-config db-spec
+                        :table-name table-name
+                        :row-id 0
+                        :init init)
+               :log (fn [k, r, old-state, new-state]
+                      (println "Transitioning from" old-state "to" new-state "...")))
+             #(ut/get-pgsql-value db-spec table-name 0)
+             #(ut/table-exists? db-spec table-name))
     )
   )


The zoom change is relative to the current zoom (#5)

--- src/uxbox/data/workspace.cljs
+++ src/uxbox/data/workspace.cljs
@@ -249,7 +249,7 @@
 (defrecord IncreaseZoom []
   rs/UpdateEvent
   (-apply-update [_ state]
-    (let [increase #(+ % 0.1)]
+    (let [increase #(* % 1.05)]
       (update-in state [:workspace :zoom] (fnil increase 1)))))

 (defn increase-zoom
@@ -261,7 +261,7 @@
 (defrecord DecreaseZoom []
   rs/UpdateEvent
   (-apply-update [_ state]
-    (let [decrease #(if (> % 0) (- % 0.1) 0)]
+    (let [decrease #(* % 0.95)]
       (update-in state [:workspace :zoom] (fnil decrease 1)))))

 (defn decrease-zoom


Add some helpers for read files as text.

--- src/uxbox/util/dom/files.cljs
+++ src/uxbox/util/dom/files.cljs
@@ -9,7 +9,16 @@
   (:require [beicon.core :as rx]
             [cuerdas.core :as str]))

-(defn- read-as-dataurl
+(defn read-as-text
+  [file]
+  (rx/create
+   (fn [sink]
+     (let [fr (js/FileReader.)]
+       (aset fr "onload" #(sink (rx/end (.-result fr))))
+       (.readAsText fr file)
+       (constantly nil)))))
+
+(defn read-as-dataurl
   [file]
   (rx/create
    (fn [sick]


Add leaf node flashing.

Add leaf node flashing.

--- src/videotest/coral/coral.clj
+++ src/videotest/coral/coral.clj
@@ -215,16 +215,21 @@
 ;; ----------------------------------
 ;;  Draw Coral
 ;; ----------------------------------
+(defn leaf-alpha [col row]
+  (let [nz (q/noise col row (* 0.99 (q/frame-count)))]
+    (q/map-range nz 0.0 1.0
+                 50.0 150.0)))
+
 (defn draw-polyp [coral
                   {:keys [cell-w cell-half-w
                           hex-w hex-half-w
                           hex-y-offset
                           odd-col-lower] :as coral-size}
                   [[col row :as coords]
-                   {:keys [color-rgba] :as polyp}]]
+                   {:keys [color-rgba color-hsva] :as polyp}]]
   #_(apply q/fill color-rgba)
   (if (is-leaf? odd-col-lower coral coords)
-    (q/fill 50 255 0 155)
+    (q/fill 255 (leaf-alpha col row))
     (q/no-fill))
   (apply q/stroke color-rgba)
   (hex/draw-hex-cell odd-col-lower


fix bug in assign alias at index creation

--- src/wb_es/mappings/core.clj
+++ src/wb_es/mappings/core.clj
@@ -77,7 +77,7 @@
   ([index & {:keys [default-index]}]
    (let [index-url (format "%s/%s " es-base-url index)
          settings (if default-index
-                    (assoc-in index-settings :aliases release-id {})
+                    (assoc-in index-settings [:aliases release-id] {})
                     index-settings)]
      (http/put index-url {:headers {:content-type "application/json"}
                           :body (json/generate-string settings)}))))