custom tests should (almost always) use encode*, not encode

--- test/cheshire/test/custom.clj
+++ test/cheshire/test/custom.clj
@@ -16,38 +16,46 @@

 (deftest t-ratio
   (let [n 1/2]
-    (is (= (double n) (:num (json/decode (json/encode {:num n}) true))))))
+    (is (= (double n) (:num (json/decode (json/encode* {:num n}) true))))))

 (deftest t-long-wrap-around
-  (is (= 2147483648 (json/decode (json/encode 2147483648)))))
+  (is (= 2147483648 (json/decode (json/encode* 2147483648)))))

 (deftest t-bigint
   (let [n 9223372036854775808]
-    (is (= n (:num (json/decode (json/encode {:num n}) true))))))
+    (is (= n (:num (json/decode (json/encode* {:num n}) true))))))

 (deftest t-biginteger
   (let [n (BigInteger. "42")]
-    (is (= n (:num (json/decode (json/encode {:num n}) true))))))
+    (is (= n (:num (json/decode (json/encode* {:num n}) true))))))

 (deftest t-bigdecimal
   (let [n (BigDecimal. "42.5")]
-    (is (= (.doubleValue n) (:num (json/decode (json/encode {:num n}) true))))
+    (is (= (.doubleValue n) (:num (json/decode (json/encode* {:num n}) true))))
     (binding [parse/*use-bigdecimals?* true]
-      (is (= n (:num (json/decode (json/encode {:num n}) true)))))))
+      (is (= n (:num (json/decode (json/encode* {:num n}) true)))))))

 (deftest test-string-round-trip
   (is (= test-obj (json/decode (json/encode* test-obj)))))

 (deftest test-generate-accepts-float
-  (is (= "3.14" (json/encode 3.14))))
+  (is (= "3.14" (json/encode* 3.14))))

 (deftest test-keyword-encode
   (is (= {"key" "val"}
-         (json/decode (json/encode {:key "val"})))))
+         (json/decode (json/encode* {:key "val"})))))

 (deftest test-generate-set
   (is (= {"set" ["a" "b"]}
-         (json/decode (json/encode {"set" #{"a" "b"}})))))
+         (json/decode (json/encode* {"set" #{"a" "b"}})))))
+
+(deftest test-generate-empty-set
+  (is (= {"set" []}
+         (json/decode (json/encode* {"set" #{}})))))
+
+(deftest test-generate-empty-array
+  (is (= {"array" []}
+         (json/decode (json/encode* {"array" []})))))

 (deftest test-key-coercion
   (is (= {"foo" "bar" "1" "bat" "2" "bang" "3" "biz"}
@@ -57,11 +65,11 @@

 (deftest test-keywords
   (is (= {:foo "bar" :bat 1}
-         (json/decode (json/encode {:foo "bar" :bat 1}) true))))
+         (json/decode (json/encode* {:foo "bar" :bat 1}) true))))

 (deftest test-symbols
   (is (= {"foo" "clojure.core/map"}
-         (json/decode (json/encode {"foo" 'clojure.core/map})))))
+         (json/decode (json/encode* {"foo" 'clojure.core/map})))))

 (deftest test-parsed-seq
   (let [br (BufferedReader. (StringReader. "1\n2\n3\n"))]
@@ -79,26 +87,26 @@
 (deftest test-date
   (is (= {"foo" "1970-01-01T00:00:00Z"}
          (json/decode
-          (json/encode
+          (json/encode*
            {:foo (Date. (long 0))}))))
   (is (= {"foo" "1970-01-01"}
          (json/decode
-          (json/encode
+          (json/encode*
            {:foo (Date. (long 0))} {:date-format "yyyy-MM-dd"})))
       "encode with given date format"))

 (deftest test-sql-timestamp
   (is (= {"foo" "1970-01-01T00:00:00Z"}
-         (json/decode (json/encode {:foo (Timestamp. (long 0))}))))
+         (json/decode (json/encode* {:foo (Timestamp. (long 0))}))))
   (is (= {"foo" "1970-01-01"}
-         (json/decode (json/encode {:foo (Timestamp. (long 0))}
-                                   {:date-format "yyyy-MM-dd"})))
+         (json/decode (json/encode* {:foo (Timestamp. (long 0))}
+                                    {:date-format "yyyy-MM-dd"})))
       "encode with given date format"))

 (deftest test-uuid
   (let [id (UUID/randomUUID)
         id-str (str id)]
-    (is (= {"foo" id-str} (json/decode (json/encode {:foo id}))))))
+    (is (= {"foo" id-str} (json/decode (json/encode* {:foo id}))))))

 (deftest test-streams
   (is (= {"foo" "bar"}
@@ -121,7 +129,7 @@
 (deftest test-jsondotorg-pass1
   (let [string (slurp "test/pass1.json")
         decoded-json (json/decode string)
-        encoded-json (json/encode decoded-json)
+        encoded-json (json/encode* decoded-json)
         re-decoded-json (json/decode encoded-json)]
     (is (= decoded-json re-decoded-json))))

@@ -148,19 +156,21 @@

 (deftest test-namespaced-keywords
   (is (= "{\"foo\":\"user/bar\"}"
-         (json/encode {:foo :user/bar}))))
+         (json/encode* {:foo :user/bar})))
+  (is (= {:foo/bar "baz/eggplant"}
+         (json/decode (json/encode* {:foo/bar :baz/eggplant}) true))))

 (deftest test-array-coerce-fn
   (is (= {"set" #{"a" "b"} "array" ["a" "b"] "map" {"a" 1}}
          (json/decode
-          (json/encode {"set" #{"a" "b"} "array" ["a" "b"] "map" {"a" 1}}) false
+          (json/encode* {"set" #{"a" "b"} "array" ["a" "b"] "map" {"a" 1}}) false
           (fn [field-name] (if (= "set" field-name) #{} []))))))

 (deftest t-symbol-encoding-for-non-resolvable-symbols
   (is (= "{\"foo\":\"clojure.core/map\",\"bar\":\"clojure.core/pam\"}"
-         (json/encode {:foo 'clojure.core/map :bar 'clojure.core/pam})))
+         (json/encode* {:foo 'clojure.core/map :bar 'clojure.core/pam})))
   (is (= "{\"foo\":\"foo.bar/baz\",\"bar\":\"clojure.core/pam\"}"
-         (json/encode {:foo 'foo.bar/baz :bar 'clojure.core/pam}))))
+         (json/encode* {:foo 'foo.bar/baz :bar 'clojure.core/pam}))))

 (deftest t-bindable-factories
   (binding [fact/*json-factory* (fact/make-json-factory
@@ -173,19 +183,15 @@
     (is (= q (json/decode (json/encode q))))
     (is (= q (json/decode (json/encode* q))))))

-(deftest t-namespaced-keywords
-  (is (= {:foo/bar "baz/eggplant"}
-         (json/decode (json/encode {:foo/bar :baz/eggplant}) true))))
-
 (deftest t-pretty-print
   (is (= (str "{\n  \"foo\" : 1,\n  \"bar\" : [ {\n    \"baz\" : 2\n  }, "
               "\"quux\", [ 1, 2, 3 ] ]\n}")
-         (json/encode {:foo 1 :bar [{:baz 2} :quux [1 2 3]]}
-                      {:pretty true}))))
+         (json/encode* {:foo 1 :bar [{:baz 2} :quux [1 2 3]]}
+                       {:pretty true}))))

 (deftest t-unicode-escaping
   (is (= "{\"foo\":\"It costs \\u00A3100\"}"
-         (json/encode {:foo "It costs £100"} {:escape-non-ascii true}))))
+         (json/encode* {:foo "It costs £100"} {:escape-non-ascii true}))))

 (deftest t-custom-keyword-fn
   (is (= {:FOO "bar"} (json/decode "{\"foo\": \"bar\"}"


minor: seeds backwards instead of in the future

Note: beware (time/today-at-midnight) !
It behaves differently from (time/today-at 0 0 0 0) as if its precision
was at day level only.

--- ssclj/jar/src/test/clojure/com/sixsq/slipstream/ssclj/usage/seeds/usages.clj
+++ ssclj/jar/src/test/clojure/com/sixsq/slipstream/ssclj/usage/seeds/usages.clj
@@ -5,20 +5,21 @@
     [com.sixsq.slipstream.ssclj.usage.record-keeper :as rc]
     [com.sixsq.slipstream.ssclj.db.impl :as db]
     [com.sixsq.slipstream.ssclj.db.database-binding :as dbdb]
-    [com.sixsq.slipstream.ssclj.usage.utils :as u]
     [clj-time.core :as time]))

-(defn days-from-now
-  [n]
-  (str (time/plus (time/today-at-midnight) (time/days n))))
+(defn days-ago-at-hour
+  ([n h]
+   (str (time/minus (time/today-at h 0 0 0) (time/days n))))
+  ([n]
+   (days-ago-at-hour n 0)))

 (defn- daily-usage
   [username cloud day-number metrics-map]
   {:user            username
    :cloud           cloud
    :frequency       "daily"
-   :start_timestamp (days-from-now day-number)
-   :end_timestamp   (days-from-now (inc day-number))
+   :start_timestamp (days-ago-at-hour day-number)
+   :end_timestamp   (days-ago-at-hour (inc day-number))
    :usage           (->> metrics-map
                          (map (fn [[k v]] {k {:unit_minutes v}}))
                          (into {}))})
@@ -28,8 +29,8 @@
   (for [[k v] metrics-map]
     { :user            username
       :cloud           cloud
-      :start_timestamp (days-from-now day-number)
-      :end_timestamp   (days-from-now (inc day-number))
+      :start_timestamp (days-ago-at-hour day-number)
+      :end_timestamp   (days-ago-at-hour day-number 10)
       :metric_name     k
       :metric_value    v}))

@@ -40,8 +41,8 @@
   {:user            username
    :cloud           cloud
    :frequency       "monthly"
-   :start_timestamp (days-from-now (* 30 day-number))
-   :end_timestamp   (days-from-now (* 30 (inc day-number)))
+   :start_timestamp (days-ago-at-hour (* 30 day-number))
+   :end_timestamp   (days-ago-at-hour (* 30 (inc day-number)))
    :usage           (->> {:ram 97185920 :disk 950.67 :cpu 9250}
                          (map (fn [[k v]] {k {:unit_minutes v}}))
                          (into {}))})
@@ -51,8 +52,8 @@
   {:user            username
    :cloud           cloud
    :frequency       "weekly"
-   :start_timestamp (days-from-now (* 7 day-number))
-   :end_timestamp   (days-from-now (* 7 (inc day-number)))
+   :start_timestamp (days-ago-at-hour (* 7 day-number))
+   :end_timestamp   (days-ago-at-hour (* 7 (inc day-number)))
    :usage           (->> {:ram 571859200 :disk 5000.67 :cpu 52500}
                          (map (fn [[k v]] {k {:unit_minutes v}}))
                          (into {}))})
@@ -62,8 +63,8 @@
   {:user            username
    :cloud           cloud
    :frequency       "daily"
-   :start_timestamp (days-from-now day-number)
-   :end_timestamp   (days-from-now (inc day-number))
+   :start_timestamp (days-ago-at-hour day-number)
+   :end_timestamp   (days-ago-at-hour (inc day-number))
    :usage           (->> {:ram 47185920 :disk 450.67 :cpu 1250}
                          (map (fn [[k v]] {k {:unit_minutes v}}))
                          (into {}))})


Enable Instaparse memory optimization

Enable Instaparse memory optimization

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -100,7 +100,7 @@
            (fail (str "Could not write to '" out "'"))))))

 (defn- nml-parse [s start src]
-  (let [result (parse s :start start)]
+  (let [result (parse s :start start :optimize :memory)]
     (if (insta/failure? result)
       (let [{t :text l :line c :column} result]
         (fail (str "Error parsing " src " at line " l " column " c ":")


Working on :complex in nml-map

Working on :complex in nml-map

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -181,6 +181,7 @@
                {
                 :blank (fn [] "")
                 :c identity
+                :complex (fn [& components] (println (str "### " components)) [])
                 :dataref string_id
                 :dec (fn [point int] (str point int))
                 :exp string_lc


Reimplements await-job-completion. No future this time.

--- src/onyx/api.clj
+++ src/onyx/api.clj
@@ -78,9 +78,19 @@
     (component/stop client)
     id))

-(defn await-job-completion* [sync job-id]
-  ;; TODO: re-implement me
-  )
+(defn await-job-completion [config job-id]
+  (let [client (component/start (system/onyx-client config))
+        ch (chan 100)]
+    (extensions/subscribe-to-log (:log client) 0 ch))
+
+  (loop [replica {:job-scheduler (:onyx.peer/job-scheduler peer-config)}]
+    (let [position (<!! ch)
+          entry (extensions/read-log-entry (:log env) position)
+          new-replica (extensions/apply-log-entry entry replica)
+          tasks (get (:tasks replica) job-id)
+          complete-tasks (get (:completions replica) job-id)]
+      (when-not (= (into #{} tasks) (into #{} complete-tasks))
+        (recur new-replica)))))

 (defn start-peers!
   "Launches n virtual peers. Each peer may be stopped


[#12718] Endless spinner when signing TX with custom nonce (Keycard account only)

Signed-off-by: andrey <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/ui/screens/signing/views.cljs
+++ src/status_im/ui/screens/signing/views.cljs
@@ -443,7 +443,7 @@
             [amount-item prices wallet-currency amount amount-error display-symbol fee-display-symbol prices-loading?])
           [separator]
           [fee-item prices wallet-currency fee-display-symbol fee gas-error gas-error-state prices-loading?]
-          (when management-enabled?
+          (when (and management-enabled? (not keycard-multiaccount?))
             [advanced-item])
           (when (= :gas-is-set gas-error-state)
             [react/text {:style {:color colors/gray :margin-horizontal 32 :text-align :center}}


testing: added debug for travis

testing: added debug for travis

--- src/test/clojure/czlab/test/twisty/test.clj
+++ src/test/clojure/czlab/test/twisty/test.clj
@@ -162,11 +162,17 @@
   (testing
     "related to: keypairs"
     (is (let [kp (t/asymKeyPair<> "RSA" 1024)
+              _ (println "kp = " kp)
               b (t/exportPEM kp secret)
+              _ (println "b = " b)
               pub (.getPublic kp)
+              _ (println "pub = " pub)
               prv (.getPrivate kp)
+              _ (println "prv = " prv)
               b1 (t/exportPrivateKey prv secret)
+              _ (println "b1 = " b1)
               b2 (t/exportPublicKey pub)]
+_ (println "b2 = " b2)
           (and (s/hgl? (c/strit b))
                (s/hgl? (c/strit b1))
                (s/hgl? (c/strit b2))))))


Fixed a bug when multiple tables were updated in realtime

The bug was that only the head table in the realtime update queue was
being checked

--- src/webapp/framework/client/coreclient.cljs
+++ src/webapp/framework/client/coreclient.cljs
@@ -1240,7 +1240,7 @@
        ;(log (pr-str "Order:  " (filter (fn[g] g) (vals ui-order-of-records))))
        ;(log (pr-str "Query count:" query-count))
        ;(log (pr-str "Total Records:" (-> @data-query-atom :values)))
-       (log (pr-str "update-data-window-for-query : "  (-> @data-query-atom :values) ))
+       ;(log (pr-str "update-data-window-for-query : "  (-> @data-query-atom :values) ))

@@ -1348,26 +1348,27 @@
    ;(log (pr-str (count (keys @client-query-cache))))

    (let [x            (remote  !check-for-server-updates  {:client-data-session-id  @data-session-id} )
-         y            (-> x :queries keys first)
+         yy            (-> x :queries keys)
          ]
-     (if y
-     (let [
-         xxx          (merge y {:data-source (keyword (get y :db-table)) :realtime true :table nil})
-         new-key2     (dissoc (dissoc xxx :start) :end)
-         ]
-
-     (log "Client realtime: " y)
-     (>! client-query-cache-requests  {
-                                  :query-key     new-key2
-
-                                  :subset-range  {
-                                                  :start   (:start  y)
-                                                  :end     (:end    y)
-                                                  ;:start    1
-                                                  ;:end      20
-                                                  } })
-
-     )))) 3000)
+     (do
+         (log "Client realtime: " yy)
+     (doseq [y yy]
+       (let [
+             xxx          (merge y {:data-source (keyword (get y :db-table)) :realtime true :table nil})
+             new-key2     (dissoc (dissoc xxx :start) :end)
+             ]
+
+         (>! client-query-cache-requests  {
+                                           :query-key     new-key2
+
+                                           :subset-range  {
+                                                           :start   (:start  y)
+                                                           :end     (:end    y)
+                                                           ;:start    1
+                                                           ;:end      20
+                                                           } })
+
+     ))))) 3000)

@@ -1662,7 +1663,7 @@
        ]
     (log (pr-str ""))
     ;(log (pr-str "populate: "  query-key " : " records))
-    (log (pr-str "  datbase returned      : "  records))
+    ;(log (pr-str "  database returned      : "  records))
     ;(log (pr-str "        : "  records-count))

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


Add string dependency

Add string dependency

--- src/org/zalando/stups/friboo/ring.clj
+++ src/org/zalando/stups/friboo/ring.clj
@@ -13,7 +13,8 @@
 ; limitations under the License.

 (ns org.zalando.stups.friboo.ring
-  (:require [ring.util.response :refer :all]))
+  (:require [ring.util.response :refer :all]
+            [clojure.string :as s]))

 ;; some convinience helpers


Add create test

Add create test

--- test/src/clojure/neko/dialog/alert_test.clj
+++ test/src/clojure/neko/dialog/alert_test.clj
@@ -15,12 +15,15 @@
   (:gen-class :main false
               :extends android.test.AndroidTestCase
               :methods [[testNewBuilder [] void]
+                        [testBasicCreate [] void]
                         ]
               :exposes-methods {setUp superSetUp}
               )
-  (:import neko.dialog.alert.FunctionalAlertDialogBuilder)
+  (:import android.app.AlertDialog$Builder
+           neko.dialog.alert.FunctionalAlertDialogBuilder)
   (:use junit.assert
         neko.context
+        neko.find-view
         neko.dialog.alert
         )
   )
@@ -42,7 +45,16 @@
   (does-throw AssertionError (new-builder "neko"))
   (is (instance? FunctionalAlertDialogBuilder (new-builder @context)))
   (with-context @context
-    (is (instance? FunctionalAlertDialogBuilder (new-builder))))
+    (is (instance? FunctionalAlertDialogBuilder (new-builder)))))

-
-  )
+(defn -testBasicCreate
+  "Tests that the create function works with no other set-up."
+  [this]
+  (let [test-builder (fn [builder]
+                       ; a simple test that just ensures a view exists
+                       (let [dialog (create builder)]
+                         (is-not-nil (find-view dialog :android/icon))))]
+    ; test with android builder
+    (test-builder (AlertDialog$Builder. @context))
+    ; test with functional builder
+    (test-builder (new-builder @context))))


CMR-2379 Possibly fix a breaking CI test

--- umm-lib/project.clj
+++ umm-lib/project.clj
@@ -6,7 +6,8 @@

   :dependencies [[org.clojure/clojure "1.7.0"]
                  [nasa-cmr/cmr-common-lib "0.1.1-SNAPSHOT"]
-                 [nasa-cmr/cmr-spatial-lib "0.1.0-SNAPSHOT"]]
+                 [nasa-cmr/cmr-spatial-lib "0.1.0-SNAPSHOT"]
+                 [nasa-cmr/cmr-umm-spec-lib "0.1.0-SNAPSHOT"]]

   :plugins [[lein-test-out "0.3.1"]]

@@ -32,5 +33,3 @@
          :source-paths ["src" "dev" "test"]
          :injections [(require 'pjstadig.humane-test-output)
                       (pjstadig.humane-test-output/activate!)]}})
-
-


Eliminate explicit :static-fns settings We can rely on the defaults

--- ClojureScript/project.clj
+++ ClojureScript/project.clj
@@ -14,7 +14,6 @@
                                                   "dev-src"]
                                    :compiler     {:output-to     "js/main.js"
                                                   :optimizations :whitespace
-                                                  :static-fns    false
                                                   :externs       ["externs.js"]
                                                   :pretty-print  true}}
                                  :rel
@@ -22,7 +21,6 @@
                                                   "rel-src"]
                                    :compiler     {:output-to     "js/main.js"
                                                   :optimizations :advanced
-                                                  :static-fns    true
                                                   :externs       ["externs.js"]
                                                   :pretty-print  false
                                                   :pseudo-names  false}}}})


changed formatting in run forma tests.

changed formatting in run forma tests.

--- test/forma/hadoop/jobs/run_forma_test.clj
+++ test/forma/hadoop/jobs/run_forma_test.clj
@@ -13,7 +13,8 @@
 (fact
   "Tests that the combine neighbors function produces the proper
 textual representation."
-  (textify 1 1 1 1 (first neighbors)
+  (textify 1 1 1 1
+           (first neighbors)
            (combine-neighbors neighbors)) =>
   "1 1 1 1 0 0 0 0 1.0 1.0 1.0 0 0 0 0 2 1.5 1.0 1.5 1.0 1.5 1.0")


(PDB-3928) Add helper function for facts queries

--- test/puppetlabs/puppetdb/command_test.clj
+++ test/puppetlabs/puppetdb/command_test.clj
@@ -685,6 +685,25 @@
   "Support fact command versions"
   [:v4])

+(defn approx-facts-query []
+  "Get all fact names and their values converting values to text.
+   Returns a vector of maps following the format below:
+   [{:certname \"blarg\" :name \"fact1\" :value \"1\"}]"
+  (query-to-vec
+   "SELECT fp.path as name,
+           COALESCE(fv.value_string,
+                    cast(fv.value_integer as text),
+                    cast(fv.value_boolean as text),
+                    cast(fv.value_float as text),
+                    '') as value,
+           fs.certname
+    FROM factsets fs
+         INNER JOIN facts as f on fs.id = f.factset_id
+         INNER JOIN fact_values as fv on f.fact_value_id = fv.id
+         INNER JOIN fact_paths as fp on f.fact_path_id = fp.id
+    WHERE fp.depth = 0
+    ORDER BY name ASC"))
+
 (let [certname  "foo.example.com"
       facts     {:certname certname
                  :environment "DEV"
@@ -751,20 +770,7 @@
       (testing "should store the facts"
         (with-message-handler {:keys [handle-message dlo delay-pool q]}
           (handle-message (queue/store-command q (facts->command-req (version-kwd->num version) command)))
-          (is (= (query-to-vec
-                  "SELECT fp.path as name,
-                          COALESCE(fv.value_string,
-                                   cast(fv.value_integer as text),
-                                   cast(fv.value_boolean as text),
-                                   cast(fv.value_float as text),
-                                   '') as value,
-                          fs.certname
-                   FROM factsets fs
-                     INNER JOIN facts as f on fs.id = f.factset_id
-                     INNER JOIN fact_values as fv on f.fact_value_id = fv.id
-                     INNER JOIN fact_paths as fp on f.fact_path_id = fp.id
-                   WHERE fp.depth = 0
-                   ORDER BY name ASC")
+          (is (= (approx-facts-query)
                  [{:certname certname :name "a" :value "1"}
                   {:certname certname :name "b" :value "2"}
                   {:certname certname :name "c" :value "3"}]))
@@ -797,20 +803,7 @@
                         yesterday))
               (is (= (scf-store/environment-id "DEV") (:environment_id result))))

-            (is (= (query-to-vec
-                    "SELECT fp.path as name,
-                          COALESCE(fv.value_string,
-                                   cast(fv.value_integer as text),
-                                   cast(fv.value_boolean as text),
-                                   cast(fv.value_float as text),
-                                   '') as value,
-                          fs.certname
-                   FROM factsets fs
-                     INNER JOIN facts as f on fs.id = f.factset_id
-                     INNER JOIN fact_values as fv on f.fact_value_id = fv.id
-                     INNER JOIN fact_paths as fp on f.fact_path_id = fp.id
-                   WHERE fp.depth = 0
-                   ORDER BY fp.path ASC")
+            (is (= (approx-facts-query)
                    [{:certname certname :name "a" :value "1"}
                     {:certname certname :name "b" :value "2"}
                     {:certname certname :name "c" :value "3"}]))
@@ -835,20 +828,7 @@

           (is (= (query-to-vec "SELECT certname,timestamp,environment_id FROM factsets")
                  [(with-env {:certname certname :timestamp tomorrow})]))
-          (is (= (query-to-vec
-                  "SELECT fp.path as name,
-                          COALESCE(fv.value_string,
-                                   cast(fv.value_integer as text),
-                                   cast(fv.value_boolean as text),
-                                   cast(fv.value_float as text),
-                                   '') as value,
-                          fs.certname
-                   FROM factsets fs
-                     INNER JOIN facts as f on fs.id = f.factset_id
-                     INNER JOIN fact_values as fv on f.fact_value_id = fv.id
-                     INNER JOIN fact_paths as fp on f.fact_path_id = fp.id
-                   WHERE fp.depth = 0
-                   ORDER BY name ASC")
+          (is (= (approx-facts-query)
                  [{:certname certname :name "x" :value "24"}
                   {:certname certname :name "y" :value "25"}
                   {:certname certname :name "z" :value "26"}]))
@@ -866,20 +846,7 @@
           (handle-message (queue/store-command q (facts->command-req (version-kwd->num version) command)))
           (is (= (query-to-vec "SELECT certname,deactivated FROM certnames")
                  [{:certname certname :deactivated nil}]))
-          (is (= (query-to-vec
-                  "SELECT fp.path as name,
-                          COALESCE(fv.value_string,
-                                   cast(fv.value_integer as text),
-                                   cast(fv.value_boolean as text),
-                                   cast(fv.value_float as text),
-                                   '') as value,
-                          fs.certname
-                   FROM factsets fs
-                     INNER JOIN facts as f on fs.id = f.factset_id
-                     INNER JOIN fact_values as fv on f.fact_value_id = fv.id
-                     INNER JOIN fact_paths as fp on f.fact_path_id = fp.id
-                   WHERE fp.depth = 0
-                   ORDER BY name ASC")
+          (is (= (approx-facts-query)
                  [{:certname certname :name "a" :value "1"}
                   {:certname certname :name "b" :value "2"}
                   {:certname certname :name "c" :value "3"}]))
@@ -896,20 +863,7 @@

           (is (= (query-to-vec "SELECT certname,deactivated FROM certnames")
                  [{:certname certname :deactivated tomorrow}]))
-          (is (= (query-to-vec
-                  "SELECT fp.path as name,
-                          COALESCE(fv.value_string,
-                                   cast(fv.value_integer as text),
-                                   cast(fv.value_boolean as text),
-                                   cast(fv.value_float as text),
-                                   '') as value,
-                          fs.certname
-                   FROM factsets fs
-                     INNER JOIN facts as f on fs.id = f.factset_id
-                     INNER JOIN fact_values as fv on f.fact_value_id = fv.id
-                     INNER JOIN fact_paths as fp on f.fact_path_id = fp.id
-                   WHERE fp.depth = 0
-                   ORDER BY name ASC")
+          (is (= (approx-facts-query)
                  [{:certname certname :name "a" :value "1"}
                   {:certname certname :name "b" :value "2"}
                   {:certname certname :name "c" :value "3"}]))


add Open in Ram option in data browser

add Open in Ram option in data browser

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

--- plugins/DataBrowser/src/org/micromanager/browser/core.clj
+++ plugins/DataBrowser/src/org/micromanager/browser/core.clj
@@ -14,7 +14,7 @@

 (ns org.micromanager.browser.core
   (:import [javax.swing BorderFactory JButton JComboBox JFrame JLabel JOptionPane
-                        JList JPanel JScrollPane JSplitPane SortOrder
+                        JList JPanel JScrollPane JSplitPane SortOrder JCheckBox
                         JTable JTextField RowFilter RowSorter$SortKey SpringLayout]
            [javax.swing.table AbstractTableModel DefaultTableModel
                               TableColumn TableRowSorter]
@@ -57,6 +57,8 @@

 (def stop (atom false))

+(def open-in-ram (atom false))
+
 (def prefs (.. Preferences userRoot
       (node "MMDataBrowser") (node "b3d184b1-c580-4f06-a1d9-b9cc00f12641")))

@@ -135,7 +137,7 @@
   (doseq [i (.getSelectedRows table)]
     (let [f (row-index-to-path i)]
       (if (.exists (File. f))
-        (.openAcquisitionData gui f false)
+        (.openAcquisitionData gui f @open-in-ram)
         (ReportingUtils/showError "File not found.")))))

 (defn listen-to-open [table]
@@ -635,6 +637,15 @@
   (close-window (@settings-window :frame))
   true)

+(defn create-checkbox
+  "Creats a checkbox and binds the value of an atom to the checkbox's selection state."
+  [text value-atom]
+  (let [cb (JCheckBox. text)]
+    (doto cb
+      (.addItemListener
+        (proxy [ItemListener] []
+          (itemStateChanged [_] (reset! value-atom (.isSelected cb))))))))
+
 (defn create-browser []
   (let [frame (JFrame.)
         panel (.getContentPane frame)
@@ -645,11 +656,13 @@
         refresh-button (create-button "Refresh" refresh-collection)
         settings-button (create-button "Settings..."
                           #(.show (:frame @settings-window)))
+        open-in-ram-checkbox (create-checkbox "Open in RAM" open-in-ram)
         collection-label (JLabel. "Collection:")
         collection-menu (JComboBox.)]
     (doto panel
        (.add scroll-pane) (.add search-field) (.add refresh-button)
        (.add settings-button) (.add search-label)
+       (.add open-in-ram-checkbox)
        (.add collection-label) (.add collection-menu))
     (doto table
       (.setAutoCreateRowSorter true)
@@ -663,6 +676,7 @@
     (constrain-to-parent scroll-pane :n 32 :w 5 :s -5 :e -5
                          search-field :n 5 :w 25 :n 28 :w 200
                          settings-button :n 5 :w 500 :n 28 :w 600
+                         open-in-ram-checkbox :n 5 :w 600 :n 28 :w 720
                          refresh-button :n 5 :w 405 :n 28 :w 500
                          search-label :n 5 :w 5 :n 28 :w 25
                          collection-label :n 5 :w 205 :n 28 :w 275
@@ -700,9 +714,9 @@
   ;(MMImageCache/addImageCacheListener (create-image-storage-listener))
   (awt-event
     (.show (@browser :frame))
-    (.setModel (:table @browser) (create-browser-table-model tags))
+    (.setModel (:table @browser) (create-browser-table-model ["Loading..."]))
     (let [collection-name (get-last-collection-name)]
-      (apply-data-and-settings collection-name (load-data-and-settings collection-name))))
+      (future (apply-data-and-settings collection-name (load-data-and-settings collection-name)))))
   browser)

 (defn show-browser []


updated matlab-server.

updated matlab-server.

--- src/clojure/test/matlab_physicloud/matlab_server.clj
+++ src/clojure/test/matlab_physicloud/matlab_server.clj
@@ -15,8 +15,6 @@
   [ip ns]

   (def neighbors (load-string ns))
-
-  (util/initialize-printer 2) ;(2) - print output to physicloud console

   (def connection-status (atom 0))

@@ -38,9 +36,10 @@
                            :bounds [10 10 380 40])
                          progress]
                        :background java.awt.Color/LIGHT_GRAY))]
-      (show! frame)
+      (.setAlwaysOnTop frame true)
       (.setLocation frame 300 300)
       (.setSize frame 400 140)
+      (show! frame)
       (loop []
         (if-not @connection-status
           (dispose! frame)


moving mini profiler to dev deps

moving mini profiler to dev deps

--- resources/leiningen/new/closp/project.clj
+++ resources/leiningen/new/closp/project.clj
@@ -36,8 +36,6 @@
                  [jarohen/nomad "0.7.2"]

                  [de.sveri/clojure-commons "0.2.0"]
-
-                 [clojure-miniprofiler "0.5.0"]

                  [org.danielsz/system "0.1.8"]

@@ -97,6 +95,8 @@

                                       [org.clojure/test.check "0.9.0"]

+                                      [clojure-miniprofiler "0.5.0"]
+
                                       [ring/ring-devel "1.5.0"]
                                       [pjstadig/humane-test-output "0.8.1"]]


ささやかな修正

ささやかな修正

result:
https://paiza.jp/poh/ando/share/ccce8249

--- POH7/Mizugi/Main.clj
+++ POH7/Mizugi/Main.clj
@@ -1,16 +1,15 @@
 ; Try POH
 ; author: Leonardone @ NEETSDKASU
-
 (def gs read-line)
 (defn gi [] (read-string (gs)))
-(defn gss [] (list* (.split (gs) " ")))
+(defn gss [] (list* (.split (gs) " "))) ; gisのmapがlistを返すのでgssも揃える
 (defn gis [] (map read-string (gss)))
-(defn ngt [n f] (for [_ (range n)] (f)))
+(defn ngt [n f] (reverse (loop [c n r []] (if (= c 0) r (recur (dec c) (cons (f) r))))))  ; forやmapだと遅延評価で読み込み順が狂うう
 (defn ngs [n] (ngt n gs))
 (defn ngi [n] (ngt n gi))
 (defn ngss [n] (ngt n gss))
 (defn ngis [n] (ngt n gis))
-
+; ============================================

 (defn modval [v] (mod v 1000000000))
 (defn reject [d v c]
@@ -27,11 +26,13 @@
                 (recur (dec v) (modval (* r y)) (+ c c2))
             ))))

+; ============================================

 (defn main []
     (let [n (gi) ans (solve n)]
         (println ans)
     ))

-
+; ============================================
 (main)
+; ============================================


Fix reactivex ns alias in tests

Fix reactivex ns alias in tests

--- test/cljs/potok_rumu/events_test.cljs
+++ test/cljs/potok_rumu/events_test.cljs
@@ -4,7 +4,7 @@
             [potok-rumu.spec]
             [potok-rumu.store]
             [potok.core :as ptk]
-            [beicon.core :as rxt]
+            [beicon.core :as rx]
             [cljs.spec :as s]
             [cljs.test :as t :include-macros true]))

@@ -20,11 +20,11 @@
       (is (state-valid? (ptk/update ev initial-state)))))
   (testing "Small Shot"
     (let [ev (sut/->SmallShot)]
-      (rxt/on-value (ptk/watch ev initial-state (rxt/empty))
+      (rx/on-value (ptk/watch ev initial-state (rx/empty))
                     #(is (= (sut/->Drink 2) %)))))
   (testing "Big Shot"
     (let [ev (sut/->BigShot)]
-      (rxt/on-value (ptk/watch ev initial-state (rxt/empty))
+      (rx/on-value (ptk/watch ev initial-state (rx/empty))
                     #(is (= (sut/->Drink 5) %)))))
   (testing "Drain"
     (let [ev (sut/->Drain)]
@@ -43,7 +43,7 @@
   (testing "Go Home"
     (let [ev (sut/->GoHome)
           evs (atom #{})]
-      (rxt/on-value (ptk/watch ev initial-state (rxt/empty))
+      (rx/on-value (ptk/watch ev initial-state (rx/empty))
                     #(swap! evs conj %))
       (is (= (count @evs) 3))
       (is (@evs (sut/->LeavePub)))


return only alerts

return only alerts

--- test/forma/classify/logistic_test.clj
+++ test/forma/classify/logistic_test.clj
@@ -83,9 +83,10 @@
         feature-mat (map second tuples)]
     [[(logistic-beta-vector label-seq feature-mat 1e-8 1e-6 250)]]))

-(defn calc-group-probabilities
-  "generate a separate coefficient vector for each ecoregion, and
-  apply the appropriate coefficient vector to each pixel.  Note that
+(defn show-group-probabilities
+  "show calculated probabilities for each ecoregion grouping. generate
+  a separate coefficient vector for each ecoregion, and apply the
+  appropriate coefficient vector to each pixel.  Note that
   `?feat-training` is the feature set over the training period,
   whereas `?feat-update` is the feature set through the updated
   interval.  Here, for this example, the two feature sets are
@@ -93,15 +94,20 @@
   probability of deforestation *during* the training period. This
   seems a little round-about, but this workflow will reduce redundant
   calculation as we estimate probabilities for more than one time
-  period (or any other time period than the training period)"
+  period (or any other time period than the training period)
+
+  FOR THIS EXAMPLE: return the probabilities for the alerts identified
+  for the sample ecoregion, eco1"
   [n]
   (let [src (create-sample-tap n)
         beta-gen (<- [?eco ?beta]
                      (src ?eco ?labels ?feat-training)
                      (logistic-beta-wrap ?labels ?feat-training :> ?beta))]
-    (<- [?eco ?prob]
-        (src ?eco ?labels ?feat-update)
-        (= ?eco "eco1")
-        (beta-gen ?eco ?beta)
-        (logistic-prob ?beta ?feat-update :> ?prob))))
+    (?<- (stdout)
+         [?eco ?prob]
+         (src ?eco ?labels ?feat-update)
+         (= ?eco "eco1")
+         (beta-gen ?eco ?beta)
+         (logistic-prob ?beta ?feat-update :> ?prob)
+         (> ?prob 0.5))))


removed comment

removed comment

--- test/forma/hadoop/jobs/forma_test.clj
+++ test/forma/hadoop/jobs/forma_test.clj
@@ -47,11 +47,6 @@
 (def gadm-src   [(conj loc-vec 40132)])
 (def border-src [(conj loc-vec 4)])

-
-(comment
-  pail-src (to-pail "/tmp/pail-path" sample-hansen-src)
-  src (split-chunk-tap pail-src ["hansen"]))
-
 (def sample-hansen-dc
   (thrift/DataChunk* "hansen" pixel-loc 100 t-res))


use memory-index in test

use memory-index in test

--- test/iwaswhere_web/ft_search_test.clj
+++ test/iwaswhere_web/ft_search_test.clj
@@ -1,7 +1,9 @@
 (ns iwaswhere-web.ft-search-test
   "Here, we test the handler functions of the fulltext search component."
   (:require [clojure.test :refer [deftest testing is]]
-            [iwaswhere-web.fulltext-search :as fs]))
+            [iwaswhere-web.fulltext-search :as fs]
+            [iwaswhere-web.fulltext-search :as ft]
+            [clucy.core :as clucy]))

 (def some-test-entry
   {:mentions   #{"@SantaClaus"}
@@ -14,14 +16,15 @@
    :md         "Some test entry"})

 (deftest entry-index-test
-  (testing "entry is added"
-    (fs/add-to-index {:msg-payload some-test-entry})
-    (is (= [1450998000000]
-           (fs/search {:ft-search "test"}))))
-  (testing "entry is removed"
-    (fs/remove-from-index {:msg-payload {:timestamp 1450998000000}})
-    (is (= []
-           (fs/search {:ft-search "test"})))))
+  (with-redefs [ft/index (clucy/memory-index)]
+    (testing "entry is added"
+      (fs/add-to-index {:msg-payload some-test-entry})
+      (is (= [1450998000000]
+             (fs/search {:ft-search "test"}))))
+    (testing "entry is removed"
+      (fs/remove-from-index {:msg-payload {:timestamp 1450998000000}})
+      (is (= []
+             (fs/search {:ft-search "test"}))))))

 (deftest cmp-map-test
   (testing "cmp-map contains required keys"


Remove UI for property and profile csv upload.

Fixes #387

--- src-cljs/kixi/hecuba/tabs/hierarchy/property_details.cljs
+++ src-cljs/kixi/hecuba/tabs/hierarchy/property_details.cljs
@@ -352,23 +352,6 @@
                        (om/build (measurementsupload/measurements-upload (str "/4/measurements/for-entity/" property-id "/")
                                                                          div-id)
                                  (-> properties :uploads) {:opts {:method "POST"}}))]]]
-                  ;; Upload profile data
-                  [:div.panel.panel-default
-                   [:div.panel-body
-                    [:div
-                     [:h4 "Upload CSV profile data"]
-                     (let [div-id "file-form"]
-                       (om/build (file/file-upload (str "/4/entities/" property-id "/profiles/")
-                                                   div-id)
-                                 nil {:opts {:method "POST"}}))]]]
-                  ;; Upload property details
-                  [:div.panel.panel-default
-                   [:div.panel-body
-                    [:div
-                     [:h4 "Upload CSV property details"]
-                     (let [div-id "property-details-form"]
-                       (om/build (file/file-upload (str "/4/entities/" property-id) div-id)
-                                 nil {:opts {:method "PUT"}}))]]]
                   ;; Upload image
                   [:div.panel.panel-default
                    [:div.panel-body


Rename methods with suffix -panel to -scene

--- src/elfeed_cljsrn/android/core.cljs
+++ src/elfeed_cljsrn/android/core.cljs
@@ -37,7 +37,7 @@
                     :background-color "#fff9c4"}}
    [rn/text "Network error. Check your wifi or your elfeed server."]])

-(defn settings-panel []
+(defn settings-scene []
   (let [server (subscribe [:server])
         styles {:wrapper {:margin-top 10
                           :padding-left 16}}]
@@ -63,7 +63,7 @@
       [rn/view {}
        [icon {:style (:icon styles) :name "archive" :size 22}]]]]))

-(defn entry-panel [entry]
+(defn entry-scene [entry]
   (let [loading? (subscribe [:fetching-entry?])
         remote-error (subscribe [:remote-error :entry])
         entry-content (subscribe [:current-entry])
@@ -151,7 +151,7 @@
      [rn/text {:style (:value styles)}
       (str "Last update at: ") (format-update-time update-time)]]))

-(defn entries-panel []
+(defn entries-scene []
   (let [loading (subscribe [:loading?])
         update-time (subscribe [:update-time])
         remote-error (subscribe [:remote-error :entries])
@@ -264,9 +264,9 @@

 (defmulti scene #(keyword (aget % "scene" "route" "key")))

-(defmethod scene :entries [scene-props] [entries-panel])
-(defmethod scene :entry [scene-props] [entry-panel])
-(defmethod scene :settings [scene-props] [settings-panel])
+(defmethod scene :entries [scene-props] [entries-scene])
+(defmethod scene :entry [scene-props] [entry-scene])
+(defmethod scene :settings [scene-props] [settings-scene])

 (defn nav-title [scene-props]
   (let [title (aget scene-props "scene" "route" "title")]


CMR-3387: Adding comments to new vars in group json results handler.

--- access-control-app/src/cmr/access_control/data/group_json_results_handler.clj
+++ access-control-app/src/cmr/access_control/data/group_json_results_handler.clj
@@ -7,12 +7,15 @@
             [cheshire.core :as json]))

 (def base-fields
-  ["concept-id" "revision-id" "name" "provider-id" "description" "legacy-guid" "member-count"])
+  "The base set of fields to select from Elasticsearch"
+  ["concept-id" "revision-id" "name" "provider-id" "description" "legacy-guid" "member-count"]

 (def fields-with-members
+  "The fields to select from Elasticsearch if members should be included"
   (conj base-fields "members"))

 (defn- include-members?
+  "Returns true if the query indicates members should be returned in the response."
   [query]
   (some #{:include-members} (:result-features query)))


Remove combination testing

Remove combination testing

--- test/clojure/clojurewerkz/cassaforte/test_helper.clj
+++ test/clojure/clojurewerkz/cassaforte/test_helper.clj
@@ -51,10 +51,3 @@

     (f)
     (drop-keyspace session :new_cql_keyspace)))
-
-(defmacro test-combinations
-  "Run given queries in both plain and prepared modes."
-  [& body]
-  `(do
-     ~@body
-     (client/prepared ~@body)))


Take care of when not all dimensions are used.

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

--- clojure/sequence_generator.clj
+++ clojure/sequence_generator.clj
@@ -83,6 +83,16 @@
         (assoc e2 :wait-time-ms interval-ms)
         e2))))

+(defn fill-in-missing-indices
+  ([events index]
+    (for [event events]
+      (if (contains? event index)
+        event
+        (assoc event index 0))))
+  ([events]
+    (reduce fill-in-missing-indices events
+      [:position-index :slice-index :channel-index :frame-index])))
+
 (defn generate-acq-sequence [settings]
   (let [{:keys [slices keep-shutter-open-channels keep-shutter-open-slices
          use-autofocus autofocus-skip interval-ms]} settings]
@@ -91,7 +101,8 @@
       (manage-shutter keep-shutter-open-channels keep-shutter-open-slices)
       (process-channel-skip-frames)
       (process-use-autofocus use-autofocus autofocus-skip)
-      (process-wait-time interval-ms))))
+      (process-wait-time interval-ms)
+      (fill-in-missing-indices))))

 ; Testing:


(PDB-2433) Add deprecation warnings for old command versions

We need to support old command versions in the case where users have
enqueued commands from before the upgrade. These warnings are targeted
more for users submitting old commands directly or mistakenly via an old
terminus

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -191,15 +191,18 @@
   (log/warnf "command '%s' version %s is deprecated, use the latest version" command version))

 (defmethod process-command! [(command-names :replace-catalog) 4]
-  [command options]
+  [{:keys [version] :as command} options]
+  (warn-deprecated version "replace catalog")
   (replace-catalog* command options))

 (defmethod process-command! [(command-names :replace-catalog) 5]
-  [command options]
+  [{:keys [version] :as command} options]
+  (warn-deprecated version "replace catalog")
   (replace-catalog* command options))

 (defmethod process-command! [(command-names :replace-catalog) 6]
-  [command options]
+  [{:keys [version] :as command} options]
+  (warn-deprecated version "replace catalog")
   (replace-catalog* command options))

 (defmethod process-command! [(command-names :replace-catalog) 7]
@@ -225,13 +228,15 @@
     (log/infof "[%s] [%s] %s" id (command-names :replace-facts) certname)))

 (defmethod process-command! [(command-names :replace-facts) 3]
-  [command config]
+  [{:keys [version] :as command} config]
+  (warn-deprecated version "replace facts")
   (-> command
       fact/v3-wire->v4-wire
       (process-command! config)))

 (defmethod process-command! [(command-names :replace-facts) 2]
-  [command config]
+  [{:keys [version] :as command} config]
+  (warn-deprecated version "replace facts")
   (let [received-time (get-in command [:annotations :received])]
     (-> command
         (fact/v2-wire->v4-wire received-time)
@@ -239,14 +244,16 @@

 ;; Node deactivation
 (defmethod process-command! [(command-names :deactivate-node) 1]
-  [command config]
+  [{:keys [version] :as command} config]
+  (warn-deprecated version "deactivate node")
   (-> command
       (assoc :version 2)
       (update :payload #(upon-error-throw-fatality (json/parse-string % true)))
       (process-command! config)))

 (defmethod process-command! [(command-names :deactivate-node) 2]
-  [command config]
+  [{:keys [version] :as command} config]
+  (warn-deprecated version "deactivate node")
   (-> command
       (assoc :version 3)
       (update :payload #(hash-map :certname %))
@@ -281,19 +288,22 @@
                puppet_version certname)))

 (defmethod process-command! [(command-names :store-report) 3]
-  [command {:keys [db]}]
+  [{:keys [version] :as command} {:keys [db]}]
+  (warn-deprecated version "store report")
   (store-report* 6 db
                  (let [received-time (get-in command [:annotations :received])]
                    (update command :payload report/wire-v3->wire-v6 received-time))))

 (defmethod process-command! [(command-names :store-report) 4]
-  [command {:keys [db]}]
+  [{:keys [version] :as command} {:keys [db]}]
+  (warn-deprecated version "store report")
   (store-report* 6 db
                  (let [received-time (get-in command [:annotations :received])]
                    (update command :payload report/wire-v4->wire-v6 received-time))))

 (defmethod process-command! [(command-names :store-report) 5]
-  [command {:keys [db]}]
+  [{:keys [version] :as command} {:keys [db]}]
+  (warn-deprecated version "store report")
   (store-report* 6 db
                  (update command :payload report/wire-v5->wire-v6)))


(maint) Format recieved-time before translation

Previously, the received-time would be formatted by the translation
library, which adds commas to the integer
```
2022-08-24 10:38:48,975 DEBUG [qtp1365504513-29] [p.p.command] [0-1,661,362,728,961] 'configure expiration' command enqueued for new-host
```

The purpose of this received-time is to correlate it with a later log
message (in which we do not include the commas)
```
2022-08-24 10:38:48,991 INFO  [cmd-proc-thread-1] [p.p.command] [0-1661362728961-1560874645000] [7 ms] 'configure expiration' command processed for new-host
```

So we now format this integer as a string to avoid additional formatting
by the translation library
```
2022-08-24 10:39:51,447 DEBUG [qtp1480434848-35] [p.p.command] [1-1661362791430] 'configure expiration' command enqueued for new-host
```

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -274,7 +274,7 @@
              (maybe-send-cmd-event! cmdref ::ingested)
              (log/debug (trs "[{0}-{1}] ''{2}'' command enqueued for {3}"
                              id
-                             (time/to-long received)
+                             (str (time/to-long received))
                              command
                              certname))))
     (finally


Slightly improve style of match

Slightly improve style of match

--- src/chapter3/match.cljs
+++ src/chapter3/match.cljs
@@ -26,7 +26,7 @@
        (= (first (first p)) '?)
        (match4 (rest p) (rest s)))
       (do
-        (swap! variables (fn [vs] (assoc vs (first (rest (first p))) (first s))))
+        (swap! variables (fn [vs] (assoc vs (second (first p)) (first s))))
         true)
       :else false))
   (if (match-helper p s) @variables false))
@@ -45,7 +45,7 @@
        (= (first (first p)) '?)
        (match5 (rest p) (rest s)))
       (do
-        (swap! variables (fn [vs] (assoc vs (first (rest (first p))) (first s))))
+        (swap! variables (fn [vs] (assoc vs (second (first p)) (first s))))
         true)
       (and
        (= (count (first p)) 2)
@@ -53,7 +53,7 @@
        ((resolve (first (first p))) (first s))
        (match5 (rest p) (rest s)))
       (do
-        (swap! variables (fn [vs] (assoc vs (first (rest (first p))) (first s))))
+        (swap! variables (fn [vs] (assoc vs (second (first p)) (first s))))
         true)
     :else false))
   (if (match-helper p s) @variables false))
@@ -73,32 +73,32 @@
       (and (not (empty? s))
            (= (first (first p)) '?))
       (when (match (rest p) (rest s))
-        (swap! variables (fn [vs] (assoc vs (first (rest (first p))) (first s))))
+        (swap! variables (fn [vs] (assoc vs (second (first p)) (first s))))
         true)
       (= (first (first p)) '*)
       (cond
         (and (not (empty? s))
              (match (rest p) (rest s)))
         (do
-          (swap! variables (fn [vs] (assoc vs (first (rest (first p))) (list (first s)))))
+          (swap! variables (fn [vs] (assoc vs (second (first p)) (list (first s)))))
           true)
         (match (rest p) s)
         (do
-          (swap! variables (fn [vs] (assoc vs (first (rest (first p))) (list))))
+          (swap! variables (fn [vs] (assoc vs (second (first p)) (list))))
           true)
         (and (not (empty? s))
              (match p (rest s)))
         (do
           (swap! variables (fn [vs] (assoc vs
-                                           (first (rest (first p)))
-                                           (cons (first s) (vs (first (rest (first p))))))))
+                                           (second (first p))
+                                           (cons (first s) (vs (second (first p)))))))
           true))
       (and
        (not (empty? s))
        ((resolve (first (first p))) (first s))
        (match (rest p) (rest s)))
       (do
-        (swap! variables (fn [vs] (assoc vs (first (rest (first p))) (first s))))
+        (swap! variables (fn [vs] (assoc vs (second (first p)) (first s))))
         true)
     :else false))
   (if (match-helper p s) @variables false))


creating single hz client instance vs. recreating it on every call

--- src/clj/hface/stats.clj
+++ src/clj/hface/stats.clj
@@ -85,8 +85,11 @@
   (let [top-stats (aggregate-top instance-stats)]
     (assoc aggr-stats :top top-stats)))

+(def hz-instance
+  (delay (client-instance (conf :hz-client))))
+
 (defn cluster-stats []
-   (let [i-stats (per-instance-stats (client-instance (conf :hz-client)))
+   (let [i-stats (per-instance-stats @hz-instance)
          a-stats (aggregate-across-cluster (vals i-stats))]
      {:per-node i-stats
       :aggregated (with-top i-stats a-stats)}))


fix swapped post and put methods

fix swapped post and put methods

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -205,13 +205,13 @@
 (defn post
   "Like #'request, but sets the :method and :url as appropriate."
   [url & [req]]
+  (request (merge req {:method :post :url url})))
+
+(defn put
+  "Like #'request, but sets the :method and :url as appropriate."
+  [url & [req]]
   (request (merge req {:method :put :url url})))

-(defn put
-  "Like #'request, but sets the :method and :url as appropriate."
-  [url & [req]]
-  (request (merge req {:method :post :url url})))
-
 (defn delete
   "Like #'request, but sets the :method and :url as appropriate."
   [url & [req]]


Let :delete have form params

Let :delete have form params

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -902,7 +902,7 @@
   [{:keys [form-params content-type request-method]
     :or {content-type :x-www-form-urlencoded}
     :as req}]
-  (if (and form-params (#{:post :put :patch} request-method))
+  (if (and form-params (#{:post :put :patch :delete} request-method))
     (-> req
         (dissoc :form-params)
         (assoc :content-type (content-type-value content-type)


multimethods wip: intial hierarchy implemeation; mutifn deftype work

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -3258,3 +3258,197 @@

+;; FF
+(defn not-empty
+  "If coll is empty, returns nil, else coll"
+  [coll] (when (seq coll) coll))
+
+(defn make-hierarchy
+  "Creates a hierarchy object for use with derive, isa? etc."
+  [] {:parents {} :descendants {} :ancestors {}})
+
+(def ^{:private true}
+  global-hierarchy (atom (make-hierarchy)))
+
+(defn isa?
+  "Returns true if (= child parent), or child is directly or indirectly derived from
+  parent, either via a Java type inheritance relationship or a
+  relationship established via derive. h must be a hierarchy obtained
+  from make-hierarchy, if not supplied defaults to the global
+  hierarchy"
+  ([child parent] (isa? @global-hierarchy child parent))
+  ([h child parent]
+   (or (= child parent)
+       (contains? ((:ancestors h) child) parent)
+       (and (some #(contains? ((:ancestors h) %) parent)))
+       (and (vector? parent) (vector? child)
+            (= (count parent) (count child))
+            (loop [ret true i 0]
+              (if (or (not ret) (= i (count parent)))
+                ret
+                (recur (isa? h (child i) (parent i)) (inc i))))))))
+
+(defn parents
+  "Returns the immediate parents of tag, either via a Java type
+  inheritance relationship or a relationship established via derive. h
+  must be a hierarchy obtained from make-hierarchy, if not supplied
+  defaults to the global hierarchy"
+  ([tag] (parents @global-hierarchy tag))
+  ([h tag] (not-empty (get (:parents h) tag))))
+
+(defn ancestors
+  "Returns the immediate and indirect parents of tag, either via a Java type
+  inheritance relationship or a relationship established via derive. h
+  must be a hierarchy obtained from make-hierarchy, if not supplied
+  defaults to the global hierarchy"
+  ([tag] (ancestors @global-hierarchy tag))
+  ([h tag] (not-empty (get (:ancestors h) tag))))
+
+(defn descendants
+  "Returns the immediate and indirect children of tag, through a
+  relationship established via derive. h must be a hierarchy obtained
+  from make-hierarchy, if not supplied defaults to the global
+  hierarchy. Note: does not work on Java type inheritance
+  relationships."
+  ([tag] (descendants @global-hierarchy tag))
+  ([h tag] (not-empty (get (:descendants h) tag))))
+
+(defn derive
+  "Establishes a parent/child relationship between parent and
+  tag. Parent must be a namespace-qualified symbol or keyword and
+  child can be either a namespace-qualified symbol or keyword or a
+  class. h must be a hierarchy obtained from make-hierarchy, if not
+  supplied defaults to, and modifies, the global hierarchy."
+  ([tag parent]
+   (assert (namespace parent))
+   ;; (assert (or (class? tag) (and (instance? cljs.core.Named tag) (namespace tag))))
+   (swap! global-hierarchy derive tag parent) nil)
+  ([h tag parent]
+   (assert (not= tag parent))
+   ;; (assert (or (class? tag) (instance? cljs.core.Named tag)))
+   ;; (assert (instance? cljs.core.INamed tag))
+   ;; (assert (instance? cljs.core.INamed parent))
+
+   (let [tp (:parents h)
+         td (:descendants h)
+         ta (:ancestors h)
+         tf (fn [m source sources target targets]
+              (reduce (fn [ret k]
+                        (assoc ret k
+                               (reduce conj (get targets k #{}) (cons target (targets target)))))
+                      m (cons source (sources source))))]
+     (or
+      (when-not (contains? (tp tag) parent)
+        (when (contains? (ta tag) parent)
+          (throw (str tag "already has" parent "as ancestor")))
+        (when (contains? (ta parent) tag)
+          (throw (str "Cyclic derivation:" parent "has" tag "as ancestor")))
+        {:parents (assoc (:parents h) tag (conj (get tp tag #{}) parent))
+         :ancestors (tf (:ancestors h) tag td parent ta)
+         :descendants (tf (:descendants h) parent ta tag td)})
+      h))))
+
+(defn underive
+  "Removes a parent/child relationship between parent and
+  tag. h must be a hierarchy obtained from make-hierarchy, if not
+  supplied defaults to, and modifies, the global hierarchy."
+  ([tag parent]
+     ;; (alter-var-root #'global-hierarchy underive tag parent)
+     (swap! global-hierarchy derive tag parent)  nil)
+  ([h tag parent]
+    (let [parentMap (:parents h)
+	  childsParents (if (parentMap tag)
+			  (disj (parentMap tag) parent) #{})
+	  newParents (if (not-empty childsParents)
+		       (assoc parentMap tag childsParents)
+		       (dissoc parentMap tag))
+	  deriv-seq (flatten (map #(cons (first %) (interpose (first %) (second %)))
+				       (seq newParents)))]
+      (if (contains? (parentMap tag) parent)
+	(reduce #(apply derive %1 %2) (make-hierarchy)
+		(partition 2 deriv-seq))
+	h))))
+
+
+(defprotocol IMultiFn
+  (-reset [])
+  (-add-method [dispatch-val method])
+  (-remove-method [dispatch-val])
+  (-prefer-method [dispatch-val dispatch-val-y])
+  (-get-method [dispatch-val])
+  ;;(-invoke [& args])
+  )
+
+(defn- reset-cache
+  [method-cache method-table cached-hierarchy hierarchy]
+  (swap! method-cache (fn [_] method-table))
+  (swap! cached-hierarchy (fn [_] (deref hierarchy))))
+
+(defn- prefers
+  [x y prefer-table]
+  (let [xprefs (@prefer-table x)]
+    (or
+     (when (and xprefs (xprefs y))
+      true)
+     (loop [ps (parents y)]
+       (when (pos? (count ps))
+	 (when (prefers x (first ps))
+	   true)
+	 (recur (rest ps))))
+     (loop [ps (parents x)]
+       (when (pos? (count ps))
+	 (when (prefers (first ps) y)
+	   true)
+	 (recur (rest ps)))))
+    false))
+
+(defn- dominates
+  [x y prefer-table]
+  (or (prefers x y prefer-table) (isa? x y)))
+
+(defn- find-and-cache-best-method
+  [dispatch-val method-table name cached-hierarchy hierarchy method-cache]
+  (let [best-entry (reduce (fn [be e]
+			     (when (isa? dispatch-val (first e))
+			       (when (or (nil? be)
+					 (dominates (first e) (first be)))
+				 (when-not (dominates (first be) (first e))
+				   (throw (str "Multiple methods in multimethod '" name "' match dispatch value: " dispatch-val " -> " (first e)" and " (first be) ", and neither is preferred")))
+				 e)))
+			   nil @method-table)]
+    (when best-entry
+      (if (= @cached-hierarchy @hierarchy)
+	(do
+	  (swap! method-cache assoc dispatch-val (second best-entry))
+	  (second best-entry))
+	(do
+	  (reset-cache method-cache method-table cached-hierarchy hierarchy)
+	  (find-and-cache-best-method dispatch-val method-table name cached-hierarchy hierarchy method-cache)))
+      )))
+
+(deftype MultiFn [name dispatch-fn default-dispatch-val hierarchy
+		  method-table prefer-table method-cache cached-hierarchy]
+  IMultiFn
+  (-reset []
+    (swap! method-table (fn [_] {}))
+    (swap! method-cache (fn [_] {}))
+    (swap! prefer-table (fn [_] {}))
+    (swap! cached-hierarchy (fn [_] nil)))
+  (-add-method [dispatch-val method]
+    (prn "add-method")
+    (swap! method-table assoc dispatch-val method)
+    (reset-cache method-cache method-table cached-hierarchy hierarchy))
+  (-remove-method [dispatch-val]
+    (swap! method-table dissoc dispatch-val)
+    (reset-cache method-cache method-table cached-hierarchy hierarchy))
+  (-get-method [dispatch-val]
+    (when-not (= @cached-hierarchy @hierarchy)
+      (reset-cache method-cache method-table cached-hierarchy hierarchy))
+    (if-let [target-fn (@method-cache dispatch-val)]
+      target-fn
+      (if-let [target-fn (find-and-cache-best-method dispatch-val method-table name
+						 cached-hierarchy hierarchy method-cache)]
+	target-fn
+	(@method-table default-dispatch-val)))
+    )
+  )


add *loaded-libs* dyn var

add *loaded-libs* dyn var

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -36,6 +36,8 @@
 (def ^:dynamic *print-dup* false)
 (def ^:dynamic *print-length* nil)
 (def ^:dynamic *print-level* nil)
+
+(def ^:dynamic *loaded-libs* nil)

 (defn- pr-opts []
   {:flush-on-newline *flush-on-newline*


cljs.test needs to default to sync, remove broken validation

--- src/cljs/cljs/test.cljs
+++ src/cljs/cljs/test.cljs
@@ -443,16 +443,14 @@
        (update-current-env! [:testing-vars] conj v)
        (update-current-env! [:report-counters :test] inc)
        (do-report {:type :begin-test-var :var v})
-       (let [{:keys [async-disabled]} (get-current-env)]
-         (cond-> (try
-                   (t)
-                   (catch :default e
-                     (do-report
-                      {:type :error
-                       :message "Uncaught exception, not in assertion."
-                       :expected nil
-                       :actual e})))
-           async-disabled (-> async? not (assert async-disabled)))))
+       (try
+         (t)
+         (catch :default e
+           (do-report
+             {:type :error
+              :message "Uncaught exception, not in assertion."
+              :expected nil
+              :actual e}))))
      (fn []
        (do-report {:type :end-test-var :var v})
        (update-current-env! [:testing-vars] rest))]))
@@ -493,28 +491,22 @@
           block
           (reverse (keep :after map-fixtures))))

-(defn- fixtures-type
-  [coll]
-  (cond (empty? coll)
-        :none
-        (every? map? coll)
-        :map
-        (every? fn? coll)
-        :fn))
-
-(defn- execution-strategy
-  [once-fixtures each-fixtures]
-  (let [types (map fixtures-type [once-fixtures each-fixtures])
-        _ (assert (not-any? nil? types)
-                  "Fixtures may not be of mixed types")
-        types (->> types
-                   (remove #{:none})
-                   (distinct))
-        _ (assert (> 2 (count types)) "fixtures specified in :once and :each must be of the same type")]
-    (case (first types)
-      :map :async
-      :fn :sync
-      nil :async)))
+(defn- execution-strategy [once each]
+  (letfn [(fixtures-type [coll]
+            (cond
+              (empty? coll) :none
+              (every? map? coll) :map
+              (every? fn? coll) :fn))
+          (fixtures-types []
+            (->> (map fixtures-type [once each])
+              (remove #{:none})
+              (distinct)))]
+    (let [[type :as types] (fixtures-types)]
+      (assert (not-any? nil? types)
+        "Fixtures may not be of mixed types")
+      (assert (> 2 (count types))
+        "fixtures specified in :once and :each must be of the same type")
+      ({:map :async :fn :sync} type :sync))))

 (defn test-vars-block
   "Like test-vars, but returns a block for further composition and
@@ -536,9 +528,6 @@
                  (wrap-map-fixtures once-fixtures))
             :sync
             (do
-              (update-current-env! [:async-disabled]
-                                   (constantly
-                                    "Async tests require fixtures to be specified as maps"))
               (let [each-fixture-fn (join-fixtures each-fixtures)]
                 [(fn []
                    ((join-fixtures once-fixtures)
@@ -547,9 +536,7 @@
                         (when (:test (meta v))
                           (each-fixture-fn
                            (fn []
-                             (test-var v)))))))
-                   (update-current-env! [:async-disabled]
-                                        (constantly nil)))])))))))
+                             (test-var v))))))))])))))))
    (group-by (comp :ns meta) vars)))

 (defn test-vars


Add optional context argument to defui

Add optional context argument to defui

--- src/clojure/neko/ui.clj
+++ src/clojure/neko/ui.clj
@@ -140,8 +140,8 @@
   "Takes an object class name and the attributes map to extract
   additional arguments (if available) and returns a form that
   constructs the object."
-  [klass {:keys [constructor-args]}]
-  `(new ~klass context ~@constructor-args))
+  [klass context {:keys [constructor-args]}]
+  `(new ~klass ~context ~@constructor-args))

 ;; ## Top-level code-generation facilities

@@ -151,20 +151,33 @@
   elements to it. `make-ui-element` is called recursively on each
   internal element. The second argument is a keyword that represents
   the type of the container UI element will be put in."
-  [element container-type]
+  [element container-type context]
   (if (vector? element)
     (let [[el-type attributes & inside-elements] element
           ^Class klass (kw/classname el-type)
           obj (gensym (.getSimpleName klass))]
-      `(let [~obj ~(make-constructor-call klass attributes)]
+      `(let [~obj ~(make-constructor-call klass context attributes)]
          ~@(process-attributes el-type obj attributes container-type)
          ~@(map (fn [el]
-                  `(.addView ~obj ~(make-ui-element el el-type)))
+                  `(.addView ~obj ~(make-ui-element el el-type context)))
                 inside-elements)
          ~obj))
     (if (and (sequential? element) (= (first element) 'quote))
       (second element)
-      (make-ui-element (eval element) container-type))))
+      (make-ui-element (eval element) container-type context))))

-(defmacro defui [tree]
-  (make-ui-element tree nil))
+(defmacro defui
+  "Takes a tree of elements and creates Android UI elements according
+  to this tree. A tree has a form of a vector that looks like following:
+
+  `[element-name map-of-attributes & subelements]`
+
+  where `map-of-attributes` is a map of attribute names to their
+  values, and subelement is itself a tree of this form.
+
+  Two-argument version takes an arbitrary Context object to use in UI
+  elements constructor."
+  ([tree]
+     (make-ui-element tree nil `context))
+  ([custom-context tree]
+     (make-ui-element tree nil custom-context)))


Don't reduce context for context-from-clop

This is not needed.

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

--- src/conexp/fca/more.clj
+++ src/conexp/fca/more.clj
@@ -191,15 +191,14 @@
   given closure operator on the given base-set."
   [base-set clop]
   (let [base-set (set base-set)]
-    (-> (explore-attributes (make-context #{} base-set #{})
-                            :handler (fn [_ _ impl]
-                                       (let [A (premise impl),
-                                             B (conclusion impl),
-                                             C (clop A)]
-                                         (when-not (subset? B C)
-                                           [[(gensym) (maximal-counterexample clop base-set B C)]]))))
-        :context
-        reduce-context-objects)))       ;is this still necessary?
+    (:context
+     (explore-attributes (make-context #{} base-set #{})
+                         :handler (fn [_ _ impl]
+                                    (let [A (premise impl),
+                                          B (conclusion impl),
+                                          C (clop A)]
+                                      (when-not (subset? B C)
+                                        [[(gensym) (maximal-counterexample clop base-set B C)]])))))))

 ;;;


Remove 'projector' type

Remove 'projector' type

--- src/databinder/core.clj
+++ src/databinder/core.clj
@@ -66,7 +66,7 @@
     :value (fn [parent uri binding meta val]
              uri)
     :update nil
-    :type :projector}
+    :type :relator}
    :column8
    {:display (fn [meta vals]
                (hic/html [:div.span8 vals]))
@@ -81,7 +81,7 @@
     :type :container}

    :list
-   {:resource (fn [uri binding meta vals]
+   {:resource (fn [uri binding active url meta vals]
                 (hic/html
                           [:ul {:class "list-binding nav nav-list"
                                              :data-uri uri
@@ -102,7 +102,7 @@
     :type :relator}

    :deleter
-   {:resource (fn [uri binding meta vals]
+   {:resource (fn [uri binding active url meta vals]
                 (hic/html [:a.remove-binding
                                  {:href "#"
                                   :data-uri uri
@@ -116,7 +116,7 @@
     :type :relator}

    :paragraph
-   {:resource (fn [uri binding meta vals]
+   {:resource (fn [uri binding active url meta vals]
                 (hic/html [:p {:data-uri uri
                        :data-binding binding
                        :data-description (:description meta)}
@@ -127,7 +127,7 @@
     :type :relator}

    :text-field
-   {:resource (fn [uri binding meta vals]
+   {:resource (fn [uri binding active url meta vals]
                 (hic/html [:label (str (:title meta) " ")
                    [:input {:type "text"
                             :class "text-field-binding"
@@ -291,49 +291,15 @@
         sub-calls (map (fn [child] (s-rec child model url-parts)) children) ;; make the next part of the tree
         meta-data (get-meta-data binding model)]

-    (cond (= type :relator)
-          (let [statement (get-bound binding model) ;; fuckery for binding
-                relation-getter (fn [data resource] (relator statement data resource))
-                child-func (:value bindable)
-                parent-func (:resource bindable)] ;; extraneous function getting]
-            (fn [data child resource url built-url]
-
-              (let [related (if child   ;; get sub-resources (a single one if partial rendering)
-                              (seq [child])
-                              (relation-getter data resource))
-                    func (if child ;; get the bound function
-                           (fn [uri bind meta vals]
-                             (let [val (first vals)]
-                               (child-func
-                                uri (:uri val) bind meta (:html val))))
-                           (fn [uri bind meta vals]
-                             (parent-func
-                              uri bind meta
-                              (map (fn [val] (child-func
-                                             uri (:uri val) bind meta (:html val))) vals))))
-                    vals (map (fn [val] {:uri (first val) :html (second val)})
-                           (map vector
-                                (map #(.toString %) related) ;; TODO this is a little sketchy
-                                (if (empty? sub-calls)
-                                  (map literalize related)
-                                  (map seq (apply map vector (map (fn [sub-call]
-                                                                    (map
-                                                                     (fn [val]
-                                                                       (sub-call data nil val url built-url))
-                                                                     related))
-                                                                  sub-calls))))))]
-
-                (func (.getURI resource) ;; apply the bound function to the thing, the binding that points at the funtion, meta-data, and the finished children (should be ordered by now).
-                      (.getURI binding)
-                      meta-data
-                      vals))))
-          (= type :projector)
+    (cond
+          (= type :relator)

           (let [statement (get-bound binding model) ;; fuckery for binding
                 relation-getter (fn [data resource] (relator statement data resource))
                 child-func (:value bindable)
                 parent-func (:resource bindable)
-                mypath (.getString (.asLiteral (first (relate-right model (prop (:path db)) binding))))
+                myp (first (relate-right model (prop (:path db)) binding))
+                mypath (and myp (.getString (.asLiteral myp)))
                 ]
             (fn [data child resource url built-url]

@@ -350,13 +316,13 @@
                               uri bind active url meta
                               (map (fn [val] (child-func
                                              uri (:uri val) bind meta (:html val))) vals))))
-                    current (get (parse-uri url) mypath)
-                    active (= current (.getURI resource))
-                    myurl (str built-url mypath "/" (.getURI resource) "/")]
+                    current (and mypath (get (parse-uri url) mypath))
+                    active (and mypath (= current (.getURI resource)))
+                    myurl (and mypath (str built-url mypath "/" (.getURI resource) "/")) ]
                 (func (.getURI resource) ;; apply the bound function to the thing, the binding that points at the funtion, meta-data, and the finished children (should be ordered by now).
                       (.getURI binding)
                       active
-                      myurl
+                      (or myurl built-url)
                       meta-data
                       (map (fn [val] {:uri (first val) :html (second val)})
                            (map vector


fix inversion in write-by

fix inversion in write-by

--- src/datasplash/core.clj
+++ src/datasplash/core.clj
@@ -882,7 +882,7 @@
      (-> pcoll
          (.apply (with-opts (merge base-schema text-writer-schema) opts
                    (write-text-file-by-transform encoder f mapping to opts))))))
-  ([encoder f mapping to pcoll] (write-file-by encoder f to mapping {} pcoll)))
+  ([encoder f mapping to pcoll] (write-file-by encoder f  mapping to {} pcoll)))

 (def write-edn-file-by (partial write-file-by write-edn-file))
 (def write-text-file-by (partial write-file-by write-text-file))


Meh, oggz-info is too slow. ogginfo is 150% faster.

--- src/defragment/feed.clj
+++ src/defragment/feed.clj
@@ -19,7 +19,7 @@
   (:import [adamb.vorbis VorbisCommentHeader VorbisIO CommentField CommentUpdater]
            [org.joda.DateTime]))

-(sh/programs oggz-info)
+(sh/programs ogginfo)

 (defn my-zone
   "show a time in a readable format, in my damn time zone
@@ -38,6 +38,13 @@
        my-zone))

+(defn m:s->h:m:s
+  [ms]
+  (let [[_ m s] (re-matches #"(.*)m:(.*)" ms)
+          mm (Integer/parseInt m)
+          ss (Integer/parseInt s)]
+      (format "%02d:%02d:%02d" (int (/ mm 60)) (mod mm 60) ss)))
+
 (defn unogg
   "Strip the .suffix from a string.
    WARNING: Can not handle . in the name!"
@@ -52,12 +59,13 @@
   (log/debug "getting duration for" full-path)
   (try
     (->> full-path
-         oggz-info
+         ogginfo
          string/split-lines
-         (filter #(.contains % "Content-Duration"))
+         (filter #(.contains % "Playback length"))
          first
-         (re-matches #"^.*?\s+(.+)\..*")
-         last)
+         (re-matches #"\tPlayback length:\s+(.+)\..*")
+         last
+         m:s->h:m:s)
     (catch Exception e
       (log/error e)
       "04:00:00")))
@@ -225,5 +233,5 @@
          (urepl/massive-spew "/tmp/foo.edn")))

-
-  )+
+    )


change from move to actions for channel, add boundaries for each team

--- src/dodgeball/core.cljs
+++ src/dodgeball/core.cljs
@@ -59,8 +59,8 @@
 (defn tile-view [cursor owner]
   (reify
     om/IRenderState
-    (render-state [this {:keys [coords move] :as unit}]
-      (dom/td #js {:onClick #(put! move unit)}
+    (render-state [this {:keys [coords actions] :as unit}]
+      (dom/td #js {:onClick #(put! actions unit)}
         (if-let [ball (unit? :balls coords)]
           (dom/div #js {:className "ball"}))
         (if-let [red-player (unit? :red-team coords)]
@@ -76,12 +76,19 @@
   (Math/abs (- b a)))

 (defn in-range? [target selected]
-  (<=
-   (reduce
-    +
-    (map distance (vals target) (vals selected)))
-   move-range))
-
+  (and
+   (or
+     (and
+      (= :blue-team (:turn @app-state))
+      (<= (:y target) 7))
+     (and
+      (= :red-team (:turn @app-state))
+      (>= (:y target) 4)))
+   (<=
+    (reduce
+     +
+     (map distance (vals target) (vals selected)))
+    move-range)))

 (defn turn-view [data owner]
   (reify
@@ -106,23 +113,23 @@
   (reify
     om/IInitState
     (init-state [_]
-      {:move (chan)
+      {:actions (chan)
        :selected-unit nil})

     om/IWillMount
     (will-mount [_]
-     (let [move (om/get-state owner :move)]
+     (let [actions (om/get-state owner :actions)]
        (go (loop []
-          (let [selected (:coords (<! move))]
-            (om/set-state! owner :selected-unit (first (filter #(= selected (:coords %)) ((:turn @app) (:cells @app)))))
-            (let [target (:coords (<! move))]
+          (let [selected (:coords (<! actions))]
+            (om/set-state! owner :selected-unit (first (filter #(= selected (:coords %)) ((:turn @app-state) (:cells @app-state)))))
+            (let [target (:coords (<! actions))]
             (if (or
-                 (unit? (:turn @app) target)
+                 (unit? (:turn @app-state) target)
                  (not (in-range? target selected)))
               (om/set-state! owner :selected-unit nil)
                (om/transact!
                app
-               [:cells (:turn @app)]
+               [:cells (:turn @app-state)]
                (fn [units]
                   (map
                    #(if (= (om/get-state owner :selected-unit) %)
@@ -132,12 +139,11 @@
                            (flip-team app))
                          {:coords target}))
                       %)
-                   units))))
-              ))
+                   units))))))
           (recur)))))

     om/IRenderState
-    (render-state [this {:keys [move]}]
+    (render-state [this {:keys [actions]}]
       (dom/div #js {:className "container"}
         (om/build turn-view (:turn @app))
         (om/build action-view (:actions @app))
@@ -147,7 +153,7 @@
             (apply dom/tr #js {:className (border-top y)}
               (vec (for [x board-length]
                 (om/build tile-view app
-                  {:state {:selected-unit (om/get-state owner :selected-unit) :move move :coords {:x x :y y}}})))))))
+                  {:state {:selected-unit (om/get-state owner :selected-unit) :actions actions :coords {:x x :y y}}})))))))
         (bench)))))

 (om/root board-view app-state


refactor click events into types, draw off channel and handle events accordingly, start implementing ball pickup

--- src/dodgeball/core.cljs
+++ src/dodgeball/core.cljs
@@ -46,31 +46,21 @@
        (dom/td nil))))))

 (defn unit? [kind coords]
-  (first (filter
-          #(= coords (:coords %))
-          (kind (:cells (om/root-cursor app-state))))))
+  (first
+   (filter
+    #(= coords (:coords %))
+    (kind (:cells @app-state)))))
+

 (defn select-class [owner unit]
-  (if (=
-       (:coords unit)
-       (:coords (om/get-state owner :selected-unit)))
+  (cond
+   (=
+    (:coords unit)
+    (:coords (om/get-state owner :selected-unit)))
     "selected"))

-(defn tile-view [cursor owner]
-  (reify
-    om/IRenderState
-    (render-state [this {:keys [coords actions] :as unit}]
-      (dom/td #js {:onClick #(put! actions unit)}
-        (if-let [ball (unit? :balls coords)]
-          (dom/div #js {:className "ball"}))
-        (if-let [red-player (unit? :red-team coords)]
-          (dom/div
-           #js {
-           :className (str "red-team" " " (select-class owner unit))}))
-        (if-let [blue-player (unit? :blue-team coords)]
-          (dom/div
-           #js {
-           :className (str "blue-team" " " (select-class owner unit))}))))))
+(defn active-team []
+  (:turn @app-state))

 (defn distance [a b]
   (Math/abs (- b a)))
@@ -87,8 +77,52 @@
    (<=
     (reduce
      +
-     (map distance (vals target) (vals selected)))
+     (map distance (vals target) (vals (:coords selected))))
     move-range)))
+
+(defn action-type [owner target]
+  (let [selected (om/get-state owner :selected-unit)]
+
+    (cond
+     (and
+       (= nil selected)
+       (unit? (:turn @app-state) target))
+     :select-unit
+
+     (unit? :balls target)
+     :pickup-ball
+
+     (in-range? target selected)
+     :move-unit
+
+
+     (or
+       (unit? (:turn @app-state) target)
+       (not (in-range? target selected)))
+     :deselect-unit
+
+
+     )))
+
+(defn tile-view [cursor owner]
+  (reify
+    om/IRenderState
+    (render-state [this {:keys [coords actions] :as unit}]
+      (dom/td #js {:onClick
+                   #(put!
+                     actions
+                     {:coords coords
+                      :type (action-type owner coords)})}
+        (if-let [ball (unit? :balls coords)]
+          (dom/div #js {:className "ball"}))
+        (if-let [red-player (unit? :red-team coords)]
+          (dom/div
+           #js {
+           :className (str "red-team" " " (select-class owner unit))}))
+        (if-let [blue-player (unit? :blue-team coords)]
+          (dom/div
+           #js {
+           :className (str "blue-team" " " (select-class owner unit))}))))))

 (defn turn-view [data owner]
   (reify
@@ -104,10 +138,78 @@

 (defn flip-team [app]
   (om/update! app :actions 0)
-  (if (= (:turn @app) :red-team)
+  (if (= (:turn @app-state) :red-team)
     (om/update! app :turn :blue-team)
     (om/update! app :turn :red-team)))

+(defn deselect-unit [owner]
+  (om/set-state! owner :selected-unit nil))
+
+(defn ball-in-front-of-unit? [ball-coords unit-coords]
+  (and
+   (=
+    (:x ball-coords)
+    (:x (:coords unit-coords)))
+   (or
+    (and
+     (= (:turn @app-state) :blue-team)
+     (= (:y (:coords unit-coords)) (- (:y ball-coords) 1)))
+    (and
+     (= (:turn @app-state) :red-team)
+     (= (:y (:coords unit-coords)) (+ (:y ball-coords) 1))))))
+
+(defn move-unit [app owner target]
+  (om/transact!
+   app
+   [:cells (:turn @app-state)]
+   (fn [units]
+     (map
+      #(if (= (:coords (om/get-state owner :selected-unit)) (:coords %))
+         ((fn []
+            (om/transact! app :actions inc)
+            (deselect-unit owner)
+            (cond (= (:actions @app-state) 2)
+                  (flip-team app))
+            {:coords target}))
+         %)
+      units))))
+
+(defn pickup-ball [app owner ball]
+  (om/transact!
+   app
+   [:cells :balls]
+   (fn [units]
+     (map
+      #(if (ball-in-front-of-unit? ball (om/get-state owner :selected-unit))
+         ((fn []
+            (println "PICKING UP BALL")
+            (om/transact! app :actions inc)
+            (cond (= (:actions @app-state) 2)
+                  (flip-team app))
+            {:coords (om/get-state owner :selected-unit)}))
+         %)
+      units))))
+
+(defn select-unit [app owner selected]
+  (om/set-state!
+   owner
+   :selected-unit
+   (first
+    (filter
+     #(= selected (:coords %))
+     ((:turn @app-state) (:cells @app-state))))))
+
+(defn handle-action [app owner actions]
+  (go
+   (loop []
+     (let [event (<! actions)]
+       (println event)
+       (case (:type event)
+         :select-unit   (select-unit app owner (:coords event))
+         :move-unit     (move-unit app owner (:coords event))
+         :deselect-unit (deselect-unit owner)
+         :pickup-ball   (pickup-ball app owner (:coords event)))
+       (recur)))))

 (defn board-view [app owner]
   (reify
@@ -118,29 +220,7 @@

     om/IWillMount
     (will-mount [_]
-     (let [actions (om/get-state owner :actions)]
-       (go (loop []
-          (let [selected (:coords (<! actions))]
-            (om/set-state! owner :selected-unit (first (filter #(= selected (:coords %)) ((:turn @app-state) (:cells @app-state)))))
-            (let [target (:coords (<! actions))]
-            (if (or
-                 (unit? (:turn @app-state) target)
-                 (not (in-range? target selected)))
-              (om/set-state! owner :selected-unit nil)
-               (om/transact!
-               app
-               [:cells (:turn @app-state)]
-               (fn [units]
-                  (map
-                   #(if (= (om/get-state owner :selected-unit) %)
-                      ((fn []
-                        (om/transact! app :actions inc)
-                         (cond (= (:actions @app) 2)
-                           (flip-team app))
-                         {:coords target}))
-                      %)
-                   units))))))
-          (recur)))))
+    (handle-action app owner (om/get-state owner :actions)))

     om/IRenderState
     (render-state [this {:keys [actions]}]
@@ -153,7 +233,10 @@
             (apply dom/tr #js {:className (border-top y)}
               (vec (for [x board-length]
                 (om/build tile-view app
-                  {:state {:selected-unit (om/get-state owner :selected-unit) :actions actions :coords {:x x :y y}}})))))))
+                  {:state
+                   {:selected-unit (om/get-state owner :selected-unit)
+                    :actions actions
+                    :coords {:x x :y y}}})))))))
         (bench)))))

 (om/root board-view app-state


Delete static param that should not be used

--- src/freecoin/params.clj
+++ src/freecoin/params.clj
@@ -29,11 +29,6 @@
             [freecoin.translation :as trans]))

 (def version "software release version" "0.2")
-
-;; TODO: perhaps already configured in ring?
-(def host
-  {:address "fork"
-   :port 8000})

 ;; defaults
 (def encryption


Correctly handle ->str for NULL MultiBulkReplies

--- src/labs/redis/core.clj
+++ src/labs/redis/core.clj
@@ -66,6 +66,7 @@
 (extend-protocol StringCoerce
   (Class/forName "[B")  (->str [reply] (String. ^bytes reply))
   BulkReply (->str [reply] (let [bs (.bytes reply)] (when bs (String. bs))))
+  MultiBulkReply (->str [reply] (when-let [v (value reply)] (map ->str v)))
   StatusReply (->str [reply] (->str @reply))
   LinkedReplyFuture (->str [reply] (->str @reply))
   Object (->str [reply] (.toString reply))


Fixes regexp to filter out URLs with protocols and documents the regexp

--- src/lt/plugins/css.cljs
+++ src/lt/plugins/css.cljs
@@ -42,11 +42,21 @@
       (process-urls diff-path (rest matches)
                     (string/replace code token (str "url(\"" (files/join diff-path url) "\")"))))))

+(def relative-url-pattern
+  (re-pattern (str "(?m)[uU][rR][lL]\\(" ; Matches all capitalizations of 'url('
+                   "[\"']?"              ; Matches single, double, or no quotation mark
+                   "(?!.*?:\\/\\/)"      ; Skips URLs prefixed by a protocol
+                   "([^\\/\"']"          ; Skips URLs prefixed by a slash (or quotation marks, to prevent donation)
+                   ".+?)"                ; Matches the URL string
+                   "[\"']?\\)")))        ; Matches single, double, or no quotation mark followed by ')'
+
 (defn preprocess [file-path client-path code]
   "Preprocess CSS to make it work as expected when injected."
   ; Matches a url() function containing a possibly quoted relative path. Captures just the path in group 1.
-  (let [matches (distinct (re-seq #"(?m)[uU][rR][lL]\([\"']?([^\/\"'].+?)[\"']?\)" code))]
+  (let [matches (distinct (re-seq relative-url-pattern code))]
     (process-urls (diff-paths file-path client-path) matches code)))
+
+

 (behavior ::on-eval
           :triggers #{:eval
@@ -77,6 +87,8 @@
                             code (if-not client-path
                                    (:code info)
                                    (preprocess (files/parent file-path) client-path (:code info)))]
+
+                        code
                         (clients/send client
                                       :editor.eval.css
                                       (assoc info :code code)