adding stl/ply mesh support & automatic mesh file generation during serialize, updating area-light to export its mesh as separate file is needed

--- src/thi/ng/luxor/core.clj
+++ src/thi/ng/luxor/core.clj
@@ -3,8 +3,11 @@
    [thi.ng.luxor.presets :as presets]
    [thi.ng.common.math.core :as m]
    [thi.ng.geom.core :as g]
+   [thi.ng.geom.rect :as r]
    [thi.ng.geom.plane :as pl]
-   [thi.ng.geom.mesh :as mesh])
+   [thi.ng.geom.mesh :as mesh]
+   [thi.ng.geom.meshio :as mio]
+   [clojure.java.io :as io])
   (:import
    [java.io File Writer OutputStreamWriter StringWriter]
    [java.util Date]))
@@ -16,7 +19,7 @@

 (def ^:dynamic *indent* 2)

-(def ^:const mesh-types {:inline :trimesh :ply :ply-mesh :stl :stl-mesh})
+(def ^:const mesh-types {:inline :trimesh :ply :plymesh :stl :stlmesh})

 (def ^:dynamic *degrees* true)

@@ -142,10 +145,10 @@

 (defmethod luxvalue :area-light
   [_ id opts]
-  (let [[stype mesh] (:__shape opts)]
+  (let [[stype sopts] (:__shape opts)]
     (str
      (luxentity "AreaLightSource" "area" opts)
-     (luxvalue stype (str id "-mesh") mesh))))
+     (luxvalue stype (str id "-mesh") sopts))))

 (defmethod luxvalue :light
   [_ id opts]
@@ -177,24 +180,44 @@
    "\n"))

 (defmethod luxvalue :trimesh
-  [_ id mesh]
-  (let [verts (vec (keys (:vertices mesh)))
+  [_ id {:keys [__mesh]}]
+  (let [verts (vec (keys (:vertices __mesh)))
         vidx (zipmap verts (range))
-        indices (mapcat (fn [[a b c]] [(vidx a) (vidx b) (vidx c)]) (:faces mesh))]
+        indices (mapcat (fn [[a b c]] [(vidx a) (vidx b) (vidx c)]) (:faces __mesh))]
     (luxentity
      "Shape" "trianglemesh"
      {:indices [:int-vec (vec indices)]
       :P [:point-vec verts]
       :name [:string id]})))

+(defmethod luxvalue :plymesh
+  [_ id {:keys [__mesh __basename path filename] :as opts}]
+  (when __mesh
+    (let [path (or (second filename) (str __basename ".ply"))]
+      (prn "exporting ply mesh: " id path)
+      (with-open [out (io/output-stream path)]
+        (mio/write-ply out __mesh))))
+  (luxentity "Shape" "plymesh" opts))
+
+(defmethod luxvalue :stlmesh
+  [_ id {:keys [__mesh __basename path filename] :as opts}]
+  (when __mesh
+    (let [path (or (second filename) (str __basename ".stl"))]
+      (prn "exporting stl mesh: " id path)
+      (with-open [out (io/output-stream path)]
+        (mio/write-stl out __mesh))))
+  (luxentity "Shape" "stlmesh" opts))
+
 (defmethod luxvalue :shape
-  [_ id opts]
+  [_ id {:keys [__type __transform __material] :as opts}]
   (luxattrib
    id
    (str
-    (when-let [tx (:__transform opts)] (luxtransform tx))
-    (when-let [mat (:__material opts)] (material-ref mat))
-    (luxentity "Shape" (:__type opts) opts))))
+    (when __transform (luxtransform __transform))
+    (when __material (material-ref __material))
+    (if ((set (vals mesh-types)) __type)
+      (luxvalue __type id opts)
+      (luxentity "Shape" __type opts)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; serialization
@@ -359,8 +382,6 @@
   [scene id]
   {:pre [(#{:none :single :emission :multi} id)]}
   (append scene :volume-integrator (name id) {} true))
-
-;; "string config" ["opencl.gpu.use = 1" "opencl.cpu.use = 1"]

 (defn renderer-slg
   [scene & {:keys [cpu? gpu?] :or {cpu? true gpu? true}}]
@@ -575,7 +596,7 @@
       (when tx (transform-common scene tx))
       (light-common scene opts)
       {:__type :area-light
-       :__shape [(mesh-types mesh-type) mesh]
+       :__shape [(mesh-types mesh-type) {:__mesh mesh :__basename (str "light-" id)}]
        :nsamples [:int samples]}))))

 (defn shape-disk
@@ -592,6 +613,31 @@
      :radius [:float radius]
      :innerradius [:float inner-radius]
      :phimax [:float phi]})))
+
+(defn ply-mesh
+  [scene id & {:keys [mesh path tx material smooth]}]
+  (append
+   scene :geometry id
+   (merge
+    (when tx (transform-common scene tx))
+    {:__type :plymesh
+     :__material material
+     :__mesh mesh
+     :name [:string id]
+     :filename [:string (or path (str id ".ply"))]
+     :smooth [:bool smooth]})))
+
+(defn stl-mesh
+  [scene id & {:keys [mesh path tx material]}]
+  (append
+   scene :geometry id
+   (merge
+    (when tx (transform-common scene tx))
+    {:__type :stlmesh
+     :__material material
+     :__mesh mesh
+     :name [:string id]
+     :filename [:string (or path (str id ".stl"))]})))

 (defn lux-scene
   []
@@ -606,16 +652,19 @@
       (material-null "__hidden__")))

 (comment
-  (-> (lux-scene)
-      (camera :eye [10 -2 10] :target [0 0 0] :up [0 0 1])
-      (film :width 640 :height 360 :display-interval 5 :halt-spp 5)
-      (area-light "left" :p [0 0 5] :size 1 :gain 1 :tx {:translate [-5 0 0] :ry -20} :hidden? true)
-      (area-light "right" :p [0 0 5] :size 1 :gain 1 :tx {:translate [5 0 0] :ry 20} :hidden? true)
-      (shape-disk "floor" :radius 20 :material "white")
-      (shape-disk "d1" :radius 3 :inner-radius 2 :material "red" :tx {:rx -30})
-      (shape-disk "d2" :radius 3 :inner-radius 2 :material "orange" :tx {:rx 30})
-      (material-matte "white" :diffuse [0.8 0.8 0.8])
-      (material-matte "red" :diffuse [1.0 0 0])
-      (material-matte "orange" :diffuse [1.0 0.3 0])
-      (serialize-scene "foo"))
+  (def lxs (-> (lux-scene)
+               (camera :eye [10 -2 10] :target [0 0 0] :up [0 0 1])
+               (film :width 640 :height 360 :display-interval 5 :halt-spp 50)
+               (area-light "left" :p [0 0 5] :size 1 :gain 1 :tx {:translate [-5 0 0] :ry -20})
+               (area-light "top" :p [0 0 7] :size 6 :gain 0.5 :tx {:translate [0 4 0] :rx -45})
+               (area-light "right" :p [0 0 5] :size 1 :gain 1 :tx {:translate [5 0 0] :ry 20})
+               (shape-disk "floor" :radius 20 :material "white")
+               ;;(shape-disk "d1" :radius 3 :inner-radius 2 :material "red" :tx {:rx -30})
+               ;;(shape-disk "d2" :radius 3 :inner-radius 2 :material "orange" :tx {:rx 30})
+               (stl-mesh "map" :material "orange" :tx {:scale [5 3 1] :translate [0 0 1]} :mesh (g/extrude (r/rect -1 -1 2 2) {:depth 1 :scale 0.8}))
+               (material-matte "white" :diffuse [0.8 0.8 0.8])
+               (material-matte "red" :diffuse [1.0 0 0])
+               (material-matte "orange" :diffuse [1.0 0.3 0])
+               (serialize-scene "foo" false)
+               ))
   )


define variable before it's used

define variable before it's used

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -618,6 +618,7 @@
       (log/infof "sending %s tx-ids for %s to %s" (count tx-ids) (:document/id ?data) client-id)
       (?reply-fn {:tx-ids tx-ids}))))

+(def ^:dynamic *db*)
 (def memo-frontend-tx-data (memo/lru (fn [tx-id]
                                        (->> tx-id
                                          (replay/reproduce-transaction *db*)
@@ -625,7 +626,6 @@
                                          :read-only-data))
                                      :lru/threshold 2000))

-(def ^:dynamic *db*)
 (defn get-frontend-tx-data [db tx-id]
   (binding [*db* db]
     (memo-frontend-tx-data tx-id)))


got 401 and 403 backwards

got 401 and 403 backwards

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -54,12 +54,12 @@
   (let [doc (doc-model/find-by-id (:db req) doc-id)]
     (when-not (auth/has-document-permission? doc (-> req :ring-req :auth))
       (if (auth/logged-in? (:ring-req req))
+        (throw+ {:status 403
+                 :error-msg "This document is private. Please request access."
+                 :error-key :document-requires-invite})
         (throw+ {:status 401
                  :error-msg "This document is private. Please log in to access it."
-                 :error-key :document-requires-login})
-        (throw+ {:status 403
-                 :error-msg "This document is private. Please request access."
-                 :error-key :document-requires-invite})))))
+                 :error-key :document-requires-login})))))

 ;; TODO: make sure to kick the user out of subscribed if he loses access
 (defn check-subscribed [doc-id req]


Reimplement loop/recur.

Reimplement loop/recur.

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -37,6 +37,8 @@
       java.util.concurrent.CompletableFuture
       java.util.concurrent.CompletionStage
       java.util.concurrent.TimeoutException)))
+
+(def ^:dynamic *run-fn* exec/run!)

 ;; --- Promise

@@ -455,23 +457,32 @@
                             (pt/-promise (f#)))))
           (pt/-bind identity))))

-
-(defonce ^:private INTERNAL_LOOP_FN_NAME
-  (gensym 'internal-loop-fn-name))
-
 (defmacro loop
-  "Analogous to `clojure.core/loop`."
   [bindings & body]
   (c/let [bindings (partition 2 2 bindings)
           names (mapv first bindings)
           fvals (mapv second bindings)
-          syms (mapv gensym names)]
-    `(do!
-      (letfn [(~INTERNAL_LOOP_FN_NAME [~@syms]
-               (-> (p/all [~@syms])
-                   (p/then (fn [[~@names]] (do! ~@body)))))]
-        (~INTERNAL_LOOP_FN_NAME ~@fvals)))))
+          tsym (gensym "loop")
+          dsym (gensym "deferred")]
+    `(c/let [~dsym (promesa.core/deferred)
+             ~tsym (fn ~tsym [params#]
+                     (-> (promesa.core/all params#)
+                         (promesa.core/then (fn [[~@names]]
+                                              (do! ~@body)))
+                         (promesa.core/handle
+                          (fn [res# err#]
+                            (cond
+                              (not (nil? err#))
+                              (promesa.core/reject! ~dsym err#)
+
+                              (and (map? res#) (= (:type res#) :promesa.core/recur))
+                              (*run-fn* (fn [] (~tsym (:args res#))))
+
+                              :else
+                              (promesa.core/resolve! ~dsym res#))))))]
+       (*run-fn* (fn [] (~tsym ~fvals)))
+       ~dsym)))

 (defmacro recur
   [& args]
-  `(~INTERNAL_LOOP_FN_NAME ~@args))
+  `(array-map :type :promesa.core/recur :args [~@args]))


switched to use resolve instead of eval for << interpolation macro

--- src/selmer/parser.clj
+++ src/selmer/parser.clj
@@ -409,19 +409,19 @@
          :all-tags
          parse-variables)))

-(defmacro env-map
+(defmacro ^:no-doc env-map
   "Puts &env into a map."
   []
   `(apply zipmap [(mapv keyword (quote ~(keys &env))) (vector ~@(keys &env))]))

-(defn resolve-var-from-kw [env kw]
+(defn ^:no-doc resolve-var-from-kw [env kw]
   (when-let [value (if (namespace kw)
-                     (try (eval (symbol (str (namespace kw) "/" (name kw))))
+                     (try @(resolve (symbol (str (namespace kw) "/" (name kw))))
                           (catch java.lang.RuntimeException _ nil))
                      (or
                       ;; check local env first
                       (get env kw nil)
-                      (try (eval (symbol (name kw)))
+                      (try @(resolve (symbol (name kw)))
                            (catch java.lang.RuntimeException _ nil))))]
     {kw value}))


Wrap grid in atom to hide from parser.

Wrap grid in atom to hide from parser.

This is to avoid the slowness in om next when transacting a very
large value into the application state (see omcljs/om#556). Since
we never need to query *within* these grid values, we don't need
om to go delving inside them to do its indexing.

--- src/snergly/core.cljs
+++ src/snergly/core.cljs
@@ -33,15 +33,14 @@
         _ (println (str "algorithm: " algorithm))
         algorithm-fn (algs/algorithm-functions algorithm)]
     (om/transact! reconciler `[(snergly.core/set-maze {:maze-key :channel :value ~maze-chan})])
-    (go
-      (loop []
+    (go-loop []
         (let [new-maze (async/<! maze-chan)]
              (if new-maze
                (do
-                 (om/transact! reconciler `[(snergly.core/set-maze {:maze-key :grid :value ~new-maze})])
+                 (om/transact! reconciler `[(snergly.core/set-maze {:maze-key :grid :value ~(atom new-maze)})])
                  (async/<! (async/timeout 1))
                  (recur))
-               (om/transact! reconciler `[(snergly.core/set-maze {:maze-key :channel :value ~nil})])))))
+               (om/transact! reconciler `[(snergly.core/set-maze {:maze-key :channel :value ~nil})]))))
     (algorithm-fn (grid/make-grid rows columns) maze-chan true)))

 ;; -----------------------------------------------------------------------------
@@ -107,14 +106,14 @@
     (let [{:keys [grid cell-size] :as maze} (om/props this)
           c (.-_canvas this)
           g (.getContext c "2d")]
-      (image/image-grid g grid cell-size)
+      (image/image-grid g @grid cell-size)
       )
     )
   (componentDidUpdate [this prev-props prev-state]
     (let [{:keys [grid cell-size] :as maze} (om/props this)
           c (.-_canvas this)
           g (.getContext c "2d")]
-      (image/image-grid g grid cell-size) ;; ??? remove assoc to optimize animation once fixed.
+      (image/image-grid g @grid cell-size) ;; ??? remove assoc to optimize animation once fixed.
       )
     )
   (render [this]


Finish porting the http server tests

Finish porting the http server tests

--- test/picard/test/http/server.clj
+++ test/picard/test/http/server.clj
@@ -911,3 +911,232 @@
          "HTTP/1.1 100 Continue\r\n\r\n"
          "HTTP/1.1 204 No Content\r\n"
          "connection: close\r\n\r\n"))))
+
+(defcoretest sending-100-continue-to-1-0-client
+  [ch1]
+  (start
+   (fn [dn]
+     (fn [evt val]
+       (enqueue ch1 [evt val])
+       (when (= :request evt)
+         (try
+           (dn :response [100])
+           (catch Exception err
+             (enqueue ch1 [:error err])))
+         (dn :response [204 {} ""])))))
+
+  (with-socket
+    (write-socket "POST / HTTP/1.0\r\n"
+                  "Content-Length: 5\r\n"
+                  "Expect: 100-continue\r\n\r\n"
+                  "Hello")
+
+    (let [expected-hdrs {:http-version [1 0]
+                         "expect" "100-continue"}]
+      (is (next-msgs
+           ch1
+           :request [#(includes-hdrs expected-hdrs %) "Hello"]
+           :error   #(instance? Exception %)
+           :done    nil))
+
+      (is (no-msgs ch1)))))
+
+(defcoretest timing-out-without-writing-request
+  [ch1]
+  (start
+   (fn [dn]
+     (enqueue ch1 [:binding nil])
+     (fn [_ _]))
+   {:keepalive 1})
+
+  (with-socket
+    (Thread/sleep 2010)
+    (is (closed-socket?))
+    (is (no-msgs ch1))))
+
+(defcoretest timing-out-halfway-streamed-chunked-request
+  [ch1]
+  (start
+   (fn [dn]
+     (fn [evt val]
+       (enqueue ch1 [evt val])))
+   {:timeout 1})
+
+  (with-socket
+    (write-socket "POST / HTTP/1.1\r\n"
+                  "Transfer-Encoding: chunked\r\n\r\n"
+                  "5\r\nHello\r\n5\r\nWorld")
+
+    (is (next-msgs
+         ch1
+         :request [:dont-care :chunked]
+         :body    "Hello"
+         :body    "World"))
+
+    (Thread/sleep 2000)
+
+    (is (next-msgs ch1 :abort #(instance? Exception %)))
+
+    (is (receiving ""))
+    (is (closed-socket?))))
+
+(defcoretest each-event-resets-timer
+  [ch1]
+  (start
+   (fn [dn]
+     (fn [evt val]
+       (enqueue ch1 [evt val])))
+   {:timeout 1})
+
+  (with-socket
+    (write-socket "POST / HTTP/1.1\r\n"
+                  "Transfer-Encoding: chunked\r\n\r\n")
+
+    (is (next-msgs ch1 :request :dont-care))
+
+    (Thread/sleep 800)
+
+    (write-socket "5\r\nHello\r\n")
+
+    (is (next-msgs ch1 :body "Hello"))
+
+    (Thread/sleep 800)
+
+    (write-socket "5\r\nWorld\r\n")
+
+    (is (next-msgs ch1 :body "World"))
+
+    (Thread/sleep 800)
+
+    (write-socket "0\r\n\r\n")
+
+    (is (next-msgs ch1 :body nil))))
+
+(defcoretest timing-out-halfway-through-streamed-chunked-response
+  [ch1]
+  (start
+   (fn [dn]
+     (fn [evt val]
+       (enqueue ch1 [evt val])
+       (when (= :request evt)
+         (dn :response [200 {"transfer-encoding" "chunked"} :chunked])
+         (dn :body "Hello")
+         (dn :body "World"))))
+   {:timeout 1})
+
+  (with-socket
+    (write-socket "GET / HTTP/1.1\r\n\r\n")
+    (is (receiving
+         "HTTP/1.1 200 OK\r\n"
+         "transfer-encoding: chunked\r\n\r\n"
+         "5\r\nHello\r\n5\r\nWorld\r\n"))
+
+    (Thread/sleep 2010)
+
+    (is (closed-socket?))))
+
+(defcoretest timing-out-during-keepalive
+  [ch1]
+  (start
+   (fn [dn]
+     (fn [evt val]
+       (enqueue ch1 [evt val])
+       (dn :response [200 {"content-length" "5"} "Hello"])))
+   {:keepalive 1})
+
+  (with-socket
+    (write-socket "GET / HTTP/1.1\r\n\r\n")
+
+    (is (receiving
+         "HTTP/1.1 200 OK\r\n"
+         "content-length: 5\r\n\r\n"
+         "Hello"))
+
+    (Thread/sleep 2010)
+
+    (is (closed-socket?))))
+
+(defcoretest closing-connection-during-keepalive
+  [ch1]
+  (start
+   (fn [dn]
+     (fn [evt val]
+       (enqueue ch1 [evt val])
+       (when (= :request evt)
+         (dn :response [200 {"content-length" "5"} "Hello"])))))
+
+  (with-socket
+    (write-socket "GET / HTTP/1.1\r\n\r\n")
+
+    (is (receiving
+         "HTTP/1.1 200 OK\r\n"
+         "content-length: 5\r\n\r\n"
+         "Hello"))
+
+    (Thread/sleep 100)
+    (close-socket)
+
+    (is (next-msgs
+         ch1
+         :request :dont-care
+         :done    nil))
+
+    (is (no-msgs ch1))))
+
+(defcoretest race-condition-between-requests
+  [ch1]
+  (start
+   (fn [dn]
+     (fn [evt val]
+       (enqueue ch1 [evt val])
+       (when (= :request evt)
+         (future
+           (dn :response [200 {"content-length" "5"} "Hello"])))
+       (when (= :done nil)
+         (Thread/sleep 50)))))
+
+  (with-socket
+    (dotimes [_ 2]
+      (write-socket "GET / HTTP/1.1\r\n\r\n")
+
+      (is (receiving
+           "HTTP/1.1 200 OK\r\n"
+           "content-length: 5\r\n\r\n"
+           "Hello")))
+
+    (is (next-msgs
+         ch1
+         :request :dont-care
+         :done    nil
+         :request :dont-care
+         :done    nil))
+
+    (is (no-msgs ch1))))
+
+(defcoretest closing-the-connection-immedietly-after-receiving-body
+  [ch1]
+  (start
+   (fn [dn]
+     (fn [evt val]
+       (enqueue ch1 [evt val])
+       (when (= :request evt)
+         (dn :response [200 {"content-length" 5} :chunked])
+         (dn :body "Hello")))))
+
+  (with-socket
+    (write-socket "GET / HTTP/1.1\r\n\r\n")
+
+    (is (receiving
+         "HTTP/1.1 200 OK\r\n"
+         "content-length: 5\r\n\r\n"
+         "Hello"))
+
+    (close-socket)
+
+    (is (next-msgs
+         ch1
+         :request :dont-care
+         :done    nil))
+
+    (is (no-msgs ch1))))
+


Fix netty protocol test.

Fix netty protocol test.

--- test/onyx/messaging/protocol_netty_test.clj
+++ test/onyx/messaging/protocol_netty_test.clj
@@ -10,14 +10,12 @@
                            (protocol/build-completion-msg-buf (:id message)))))

 (let [message {:type protocol/ack-type-id
-               :id #uuid "e2ba38dd-b523-4e63-ba74-645fb91c231a"
-               :completion-id #uuid "b57f7be1-f2f9-4d0f-aa02-939b3d48dc23"
-               :ack-val 3323130347050513529}]
+               :acks [{:id #uuid "e2ba38dd-b523-4e63-ba74-645fb91c231a"
+                       :completion-id #uuid "b57f7be1-f2f9-4d0f-aa02-939b3d48dc23"
+                       :ack-val 3323130347050513529}]}]
   (fact message =>
         (protocol/read-buf decompress
-                           (protocol/build-ack-msg-buf (:id message)
-                                                       (:completion-id message)
-                                                       (:ack-val message)))))
+                           (protocol/build-acks-msg-buf (:acks message)))))

 (let [messages {:type protocol/messages-type-id
                 :messages '({:id #uuid  "ac39bc62-8f06-46a0-945e-3a17642a619f"


do min-change calc inside acquire-unique-key

--- src/er_cassandra/model/alia/unique_key.clj
+++ src/er_cassandra/model/alia/unique_key.clj
@@ -77,11 +77,17 @@
               key-desc {:uber-key uber-key
                         :uber-key-value uber-key-value
                         :key uq-key
-                        :key-value key-value}]
+                        :key-value key-value}
+
+              ;; never nil, since old-unique-key-record is nil
+              min-change (min.ch/minimal-change-for-table
+                          unique-key-table
+                          nil ;; always nil for acquire
+                          unique-key-record)]

         insert-response (r/insert session
                                   (:name unique-key-table)
-                                  unique-key-record
+                                  min-change
                                   (merge (fns/opts-remove-timestamp opts)
                                          {:if-not-exists true}))

@@ -109,7 +115,7 @@
                            session
                            (:name unique-key-table)
                            (:key unique-key-table)
-                           unique-key-record
+                           min-change
                            (merge
                             (fns/opts-remove-timestamp opts)
                             {:only-if
@@ -122,7 +128,7 @@
                            session
                            (:name unique-key-table)
                            (:key unique-key-table)
-                           unique-key-record
+                           min-change
                            (merge
                             (fns/opts-remove-timestamp opts)
                             {:only-if
@@ -527,10 +533,7 @@
                 entity
                 table
                 ukv
-                (min.ch/minimal-change-for-table
-                 table
-                 nil
-                 new-unique-key-record)
+                new-unique-key-record
                 opts)]
       (return
        {:acquire-key-responses [aukr]}))


Core script setting up the overall system of agents

Signed-off-by: Stefan Marr <46f1a0bd5592a2f9244ca321b129902a06b53e03@stefan-marr.de>

--- Clojure/src/snake/core.clj
+++ Clojure/src/snake/core.clj
@@ -1,16 +1,33 @@
 (ns snake.core
-  (:use snake.terminal)
+  (:use snake.input-receiver)
   (:use snake.terminal-reader)
+  (:use snake.board)
+  (:use snake.player)
   (:use snake.board-view)
-	(:gen-class))
+  (:use snake.game-elements)
+  (:use snake.game-master))

-(defn -main [& args]
-	(snake.terminal-reader/start nil)
-	(println "Hello World!")
-	(clean)
-	(set-cursor 10 3)
-	(put "foo1")
-	(set-cursor 3 10)
-	(put "bar2")
-	(println "Hello World!2")
-	(. Thread sleep 5000))
+
+
+(def human-player       (create-human-player))
+(def board              (create-board :width  10
+                                      :height 10))
+(def board-view         (create-view  board :x 4 :y 4))
+
+(start-terminal-reader  human-player)
+
+; initialize the view
+(send  board-view  initialize-view)
+(send  board-view  draw-borders)
+
+; now start the actual game
+(def game-over    (exec-game-master board-view
+                                    board
+                                    :num-apples 5
+                                    :players   [human-player]))
+
+(println "waiting for game-over")(flush)
+
+(deref game-over) ;; will block until the games is completed
+
+(println "GAME OVER")


Adding bucket-readonly-policy fn, slaves only need read on some buckets

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -136,6 +136,22 @@
                        "s3:ListMultipartUploadParts"
                        "s3:PutObject"
                        "s3:PutObjectAcl"]
+             "Resource" resources})))
+
+(defn bucket-readonly-policy
+  [bucket-names]
+  (let [bucket-arn #(str "arn:aws:s3:::" %)
+        resources (reduce (fn [a n]
+                            (into a [(bucket-arn n) (bucket-arn (str n "/*"))]))
+                          []
+                          bucket-names)]
+    (policy {"Action" ["s3:GetBucketAcl"
+                       "s3:GetBucketPolicy"
+                       "s3:GetObject"
+                       "s3:GetObjectAcl"
+                       "s3:ListBucket"
+                       "s3:ListBucketMultipartUploads"
+                       "s3:ListMultipartUploadParts"]
              "Resource" resources})))

 (def auto-scaling-policy


facts work

facts work

--- test/celestial/integration/es/jobs.clj
+++ test/celestial/integration/es/jobs.clj
@@ -25,17 +25,19 @@
   (jobs/put (-> job (merge {:tid "1" :status :success}) stamp) 2000)
   (jobs/put (-> job (merge {:tid "2" :status :error :env :prod}) stamp) 2000)
   (jobs/put (-> job (merge {:tid "3" :status :success :identity 2}) stamp) 2000)
-  (jobs/put (-> job (merge {:tid "4" :status :error}) stamp) 2000))
+  (jobs/put (-> job (merge {:tid "4" :status :error}) stamp) 2000 :flush? true))
+
+(defn total [m]
+  (-> m :hits :hits count))

 (with-conf
-  (against-background [(before :facts (do (re-initlize true) (add-jobs) (add-users)))]
+  (against-background [(before :facts (do (re-initlize true) (add-jobs)))]
    (fact "basic job get" :integration :elasticsearch
      (get-in (jobs/get "1") [:source :status]) => ":success"
      (get-in (jobs/get "2") [:source :env]) => ":prod"
      (get-in (jobs/get "3") [:source :identity]) => 2)

-
    (fact "jobs pagination" :integration :elasticsearch
-     (let [{:keys [hits] :as res} (jobs/paginate 0 5 ["prod" "dev"])]
-        (println res)
-        (-> hits :hits count) => 5))))
+     (total (jobs/paginate 0 5 ["dev"])) => 3
+     (total (jobs/paginate 0 5 ["prod"]))=> 1
+     (total (jobs/paginate 0 5 ["prod" "dev"])) => 4)))


using with-redefs instead of global alter root

--- test/celestial/integration/proxmox.clj
+++ test/celestial/integration/proxmox.clj
@@ -13,18 +13,19 @@

 (def fake-id (update-in spec [:proxmox :vmid] (fn [o] 190)))

-(alter-var-root (var config) (fn [old] local-prox))

 (deftest ^:proxmox non-existing
-  (let [ct (construct fake-id) ]
+  (with-redefs [config local-prox]
+    (let [ct (construct fake-id) ]
     (.stop ct)
-    (.delete ct)))
+    (.delete ct))))

 (deftest ^:proxmox full-cycle
-  (let [ct (construct spec )]
+  (with-redefs [config local-prox]
+   (let [ct (construct spec )]
     (.stop ct)
     (.delete ct)
     (.create ct)
     (.start ct)
-    (is (= (.status ct) "running"))))
+    (is (= (.status ct) "running")))))


Fix .dir-locals.el not generating without kick

--- edge-app-template/src/clj/new/edge_app_template.clj
+++ edge-app-template/src/clj/new/edge_app_template.clj
@@ -22,12 +22,12 @@
              ["src/{{sanitized}}/foo.clj" (render "foo.clj" data)]
              ["src/config.edn" (render "config.edn" data)]
              ["dev/dev.clj" (render "dev.clj" data)]
-             ["dev/log_dev_app.properties" (render "log_dev_app.properties" data)])
+             ["dev/log_dev_app.properties" (render "log_dev_app.properties" data)]
+             [".dir-locals.el" (render "dir-locals.el")])
     (binding [*force?* true]
       (when (:kick data)
         (->files data
                  ["src/index.html" (render "index.html" data)]
-                 [".dir-locals.el" (render "dir-locals.el")]
                  ["target/dev/.gitkeep" ""]
                  ["target/prod/.gitkeep" ""]))
       (if (:sass data)


Wait for process to finish after stopping it

--- src/net/sekao/nightcode/process.clj
+++ src/net/sekao/nightcode/process.clj
@@ -38,8 +38,8 @@

 (defn stop-process!
   [process]
-  (when @process
-    (.destroy @process))
+  (when-let [p @process]
+    (doto p .destroy .waitFor))
   (reset! process nil))

 ; specs


Added follower.

Added follower.

--- src/overtunes/songs/variatio-12.clj
+++ src/overtunes/songs/variatio-12.clj
@@ -21,7 +21,7 @@
     (range a (inc b))
     (reverse (run b a))))

-(def pitches (flatten [-7 0 (run -1 3) (run 2 0) 4 (run 1 8) (run 7 -1) 0]))
+(def pitches (flatten [0 0 (run -1 3) (run 2 0) 4 (run 1 8) (run 7 -1) 0]))
 (def durations (flatten [1/2 (repeat 2 1/4) 1/2 (repeat 6 1/4) (repeat 8 1/4) 3/2 (repeat 10 1/4)]))

 (defn melody# [timing notes]
@@ -30,8 +30,10 @@

 (defn play# []
   (let [timing (-> (bpm 120) (translate 0 (now)))
-        rhythm-from #(syncopate (translate timing % 0) durations)]
-    (melody# (rhythm-from 0) pitches)
-    ))
+        rhythm-from #(syncopate (translate timing % 0) durations)
+        leader pitches
+        follower (->> leader (map -) (map #(- % 4)))]
+    (melody# (rhythm-from 0) leader)
+    (melody# (rhythm-from 3) follower)))

 (play#)


added button and modal for UI for importing method configurations

--- src/cljs/org/broadinstitute/firecloud_ui/page/workspace/workspace_method_confs.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/workspace/workspace_method_confs.cljs
@@ -3,6 +3,8 @@
     [dmohs.react :as react]
     [org.broadinstitute.firecloud-ui.common.components :as comps]
     [org.broadinstitute.firecloud-ui.utils :as utils]
+    [org.broadinstitute.firecloud-ui.common.icons :as icons]
+    [org.broadinstitute.firecloud-ui.common :as common]
     [org.broadinstitute.firecloud-ui.common.table :as table]
     [org.broadinstitute.firecloud-ui.common.style :as style]))

@@ -36,9 +38,10 @@
     (str k "," (get the_map k) " ; ")))

-(react/defc WorkspaceMethodsConfigurationsList
+
+(react/defc ImportWorkspaceMethodsConfigurationsList
   {:render
-   (fn [{:keys [props refs]}]
+   (fn [{:keys [props refs state]}]
      [:div {}
       (if (zero? (count (:method-confs props)))
         [:div {:style {:textAlign "center" :backgroundColor (:background-gray style/colors)
@@ -53,10 +56,20 @@
                cell (fn [children] [:span {:style {:paddingLeft 16}} children])]
            {:columns [{:header-component [:div {:style {:padding "13px 0 12px 12px"
                                                         :backgroundColor (:header-darkgray style/colors)}}
-                                          [:input {:type "checkbox" :ref "allcheck"}]]
+                                          [:input {:type "checkbox" :ref "allcheck"}]
+                                          ]
                        :starting-width 42 :resizable? false
                        :cell-renderer (fn [row-num conf]
-                                        [:div {:style {:paddingLeft 12}} [:input {:type "checkbox"}]])}
+                                    [:div
+                                      {:style {:paddingLeft 12}} [:input {
+                                         :type "checkbox" :id (str "import_mc_checkbox_" row-num )
+                                                          :onClick (fn [e] (let [
+                                                            check_box_id_str (str "import_mc_checkbox_" row-num )
+                                                            clicked_checkbox_element (.getElementById js/document (name check_box_id_str))
+                                                            checked_status (.-checked clicked_checkbox_element)]
+                                                            nil
+                                                            ;TODO something here that modifies the "Import Selected Workspaces" button
+                                                            ))}]])}
                       {:header-component (header "Name") :starting-width 200
                        :cell-renderer (fn [row-num conf]
                                         (cell [:a {:href "javascript:;"
@@ -90,6 +103,111 @@
                                   :backgroundColor (if (even? row-num) (:background-gray style/colors) "#fff")}})})])])})

+(defn- modal-import-background [state]
+  {:backgroundColor "rgba(82, 129, 197, 0.4)"
+   :display (when-not (:import-overlay-shown? @state) "none")
+   :overflowX "hidden" :overflowY "scroll"
+   :position "fixed" :zIndex 9999
+   :top 0 :right 0 :bottom 0 :left 0})
+
+(def ^:private modal-import-content
+  {
+   ;:transform "translate(-50%, 0px)" ORIGINAL
+   :transform "translate(-50%,0px)"
+   :backgroundColor (:background-gray style/colors)
+   :position "relative" :marginBottom 60
+   :top 60
+   ;:left "50%"  ORIGINAL
+   :left "50%"
+   ;:width 500 ORIGINAL
+   :width "75%"
+   })
+
+
+(defn- render-import-overlay [state refs]
+  (let [clear-import-overlay (fn []
+      (common/clear! refs "wsName" "wsDesc" "shareWith")
+      (swap! state assoc :import-overlay-shown? false))]
+    [:div {
+      :style (modal-import-background state)
+      :onKeyDown (common/create-key-handler [:esc] clear-import-overlay)}
+    [:div {:style modal-import-content}
+      [:div {:style {:backgroundColor "#fff"
+                     :borderBottom (str "1px solid " (:line-gray style/colors))
+                     :padding "20px 48px 18px"
+                     }}
+      [:div {}
+        [:div {:style {:paddingLeft "100%"    :halign "right"  :align "right"}} " "
+        [comps/Button {:icon :x
+                       :onClick #(swap! state assoc :import-overlay-shown? false)}]]
+        [:div {:style {:fontSize 24   :align "center" :textAlign "center"}} "Select Method Configurations For Import"]
+        [ImportWorkspaceMethodsConfigurationsList {:method-confs (utils/parse-json-string
+                                                                  (utils/->json-string
+                                                                    (create-mock-methodconfs)))}]]
+        [comps/Button {:style :add   :text "Add selected to workspace" :onClick
+                        ;TODO
+                        ; 1) acquire list of selected confs and
+                        ; 2) use orch API (post) to copy them to the workspace
+                       (fn [] nil)}]]]]))
+
+
+(react/defc WorkspaceMethodsConfigurationsList
+  {:render
+   (fn [{:keys [props refs state]}]
+     [:div {}
+      (render-import-overlay state refs)
+      [comps/Button {:text "Import Configurations ..."
+                     :onClick #(swap! state assoc :import-overlay-shown? true)}]
+      (if (zero? (count (:method-confs props)))
+        [:div {:style {:textAlign "center" :backgroundColor (:background-gray style/colors)
+                       :padding "1em 0" :margin "0 4em" :borderRadius 8}}
+         "There are no method configurations to display."]
+        [table/AdvancedTable
+         (let [header (fn [children] [:div {:style {:fontWeight 600 :fontSize 13
+                                                    :padding "14px 16px"
+                                                    :borderLeft "1px solid #777777"
+                                                    :color "#fff" :backgroundColor (:header-darkgray style/colors)}}
+                                      children])
+               cell (fn [children] [:span {:style {:paddingLeft 16}} children])]
+           {:columns [{:header-component [:div {:style {:padding "13px 0 12px 12px"
+                                                        :backgroundColor (:header-darkgray style/colors)}}
+                                          [:input {:type "checkbox" :ref "allcheck"}]]
+                       :starting-width 42 :resizable? false
+                       :cell-renderer (fn [row-num conf]
+                                        [:div {:style {:paddingLeft 12}} [:input {:type "checkbox"}]])}
+                      {:header-component (header "Name") :starting-width 200
+                       :cell-renderer (fn [row-num conf]
+                                        (cell [:a {:href "javascript:;"
+                                                   :style {:color (:button-blue style/colors)
+                                                           :textDecoration "none"}} (conf "name")]))}
+                      {:header-component (header "Namespace") :starting-width 200
+                       :cell-renderer (fn [row-num conf] (cell (conf "namespace")))}
+                      {:header-component (header "Type") :starting-width 100
+                       :cell-renderer (fn [row-num conf] (cell (conf "rootEntityType")))}
+                      {:header-component (header "Workspace Name") :starting-width 160
+                       :cell-renderer (fn [row-num conf] (cell (str ((conf "workspaceName") "namespace") ":"
+                                                                 ((conf "workspaceName") "name"))))}
+                      {:header-component (header "Method") :starting-width 210
+                       :cell-renderer (fn [row-num conf] (cell (str ((conf "methodStoreMethod") "methodNamespace") ":"
+                                                                 ((conf "methodStoreMethod") "methodName") ":"
+                                                                 ((conf "methodStoreMethod") "methodVersion"))))}
+                      {:header-component (header "Config") :starting-width 290
+                       :cell-renderer (fn [row-num conf] (cell (str ((conf "methodStoreConfig") "methodConfigNamespace") ":"
+                                                                 ((conf "methodStoreConfig") "methodConfigName") ":"
+                                                                 ((conf "methodStoreConfig") "methodConfigVersion"))))}
+                      {:header-component (header "Inputs") :starting-width 200
+                       :cell-renderer (fn [row-num conf] (cell (stringify_map (conf "inputs"))))}
+                      {:header-component (header "Outputs") :starting-width 200
+                       :cell-renderer (fn [row-num conf] (cell (stringify_map (conf "outputs"))))}
+                      {:header-component (header "Prerequisites") :starting-width 200
+                       :cell-renderer (fn [row-num conf] (cell (stringify_map (conf "prerequisites"))))}]
+            :data (:method-confs props)
+            :row-props (fn [row-num conf]
+                         {:style {:fontSize "80%" :fontWeight 500
+                                  :paddingTop 10 :paddingBottom 7
+                                  :backgroundColor (if (even? row-num) (:background-gray style/colors) "#fff")}})})])])})
+
+
 (react/defc WorkspaceMethodConfigurations
   {:component-did-mount
    (fn [{:keys [state props]}]


Fix window closing

Fix window closing

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -1225,7 +1225,7 @@
             (GLFW/glfwPollEvents)
             ;; Close the display if the close window button has been clicked
             ;; or the gl-lock has been released programmatically (e.g. by destroy!)
-            (or (= (GLFW/glfwWindowShouldClose window) GLFW/GLFW_TRUE) @destroyed))
+            (or (GLFW/glfwWindowShouldClose window) @destroyed))
         (do
           (log/info "Destroying display")
           (with-gl-context gl-lock window capabilities


make load-configurations more convinient to use

--- src/org/zalando/friboo/config.clj
+++ src/org/zalando/friboo/config.clj
@@ -57,8 +57,9 @@

 (defn load-configuration
   "Loads configuration options from various places."
-  [default-configuration & namespaces]
-  (parse-namespaces
-    (decrypt
-      (merge default-configuration env))
-    (conj namespaces :system :http :db)))
+  [namespaces default-configurations]
+  (let [default-configuration (apply merge default-configurations)]
+    (parse-namespaces
+      (decrypt
+        (merge default-configuration env))
+      (conj namespaces :system))))


[clojure] fix: image test does not rely on s3 to run (#15122)

* [clojure] fix: image test does not rely on s3 to run

* rename `with-image` to `with-file`

--- contrib/clojure-package/test/org/apache/clojure_mxnet/image_test.clj
+++ contrib/clojure-package/test/org/apache/clojure_mxnet/image_test.clj
@@ -19,32 +19,40 @@
   (:require [org.apache.clojure-mxnet.image :as image]
             [org.apache.clojure-mxnet.ndarray :as ndarray]
             [clojure.java.io :as io]
-            [clojure.test :refer :all])
+            [clojure.test :refer [deftest is use-fixtures]])
   (:import (javax.imageio ImageIO)
            (java.io File)))

 (def tmp-dir (System/getProperty "java.io.tmpdir"))
 (def image-path (.getAbsolutePath (io/file tmp-dir "Pug-Cookie.jpg")))
+(def image-src-path "test/test-images/Pug-Cookie.jpg")

-(defn download-image []
-  (with-open [in (io/input-stream "https://s3.amazonaws.com/model-server/inputs/Pug-Cookie.jpg")
-              out (io/output-stream (io/file image-path))]
+(defn- cp
+  "Copy from filepath `from` to filepath `to`."
+  [from to]
+  (with-open [in (io/input-stream (io/file from))
+              out (io/output-stream (io/file to))]
     (io/copy in out)))

-(defn delete-image []
-  (io/delete-file image-path))
+(defn- rm
+  "Removes `filepath`."
+  [filepath]
+  (io/delete-file filepath))

-(defn with-downloaded-image [f]
-  (download-image)
-  (f)
-  (delete-image))
+(defn- with-file
+  "Provides `src-path` in `dest-path` for the test function `f` to use."
+  [src-path dest-path]
+  (fn [f]
+    (cp src-path dest-path)
+    (f)
+    (rm dest-path)))

-(use-fixtures :once with-downloaded-image)
+(use-fixtures :once (with-file image-src-path image-path))

 (deftest test-decode-image
-  (let [img-arr (image/decode-image
+  (let [img-arr (image/decode-image
                  (io/input-stream image-path))
-        img-arr-2 (image/decode-image
+        img-arr-2 (image/decode-image
                    (io/input-stream image-path)
                    {:color-flag image/GRAYSCALE})]
     (is (= [576 1024 3] (ndarray/shape-vec img-arr)))


Testing bidi route-params.

Testing bidi route-params.

--- src/wareblog/core.clj
+++ src/wareblog/core.clj
@@ -38,18 +38,17 @@

 (defn -main
   "I don't do a whole lot ... yet."
-  [& args]
+  [& args]
   (println "Hello, World!" (:created-on some-edn)))

-(defresource article [id]
+(defresource article
   :available-media-types ["text/html"]
-  :handle-ok (fn [id] (str "" id "")))
+  :handle-ok (fn [ctx] (str "Id of the request: " (get-in ctx [:request :route-params :id]))))

 (def handler
   (make-handler ["/" {"index.html" (resource :available-media-types ["text/html"]
                            :handle-ok "Hello, Internet.")
-                      ["articles/" :id "/article.html"] #(article)}]))
-;["articles/" :id "/article.html"] :article}]))
+                      ["articles/" :id "/article.html"] article}]))

 (def wrap-handler
   (-> handler


Keep good corners around when resetting interesting corners array.

--- src/videotest/optical_flow_crit.clj
+++ src/videotest/optical_flow_crit.clj
@@ -1,7 +1,8 @@
 (ns videotest.optical-flow-crit
   (:require
    [quil.core :as q]
-   [quil.middleware :as m])
+   [quil.middleware :as m]
+   [clojure.set :as cset])
   (:import
    [org.opencv.highgui Highgui VideoCapture]
    [org.opencv.core CvType Mat MatOfByte MatOfFloat MatOfPoint MatOfPoint2f Size TermCriteria]
@@ -12,14 +13,14 @@
 (def WIDTH 640)
 (def HEIGHT 480)

-(def MAX-CORNERS 800)
+(def MAX-CORNERS 300)
 (def BLANK-MASK (Mat.))
 (def WIN-SIZE-W 10)
 (def WIN-SIZE (Size. WIN-SIZE-W WIN-SIZE-W))
 (def NEG-ONE-SIZE (Size. -1 -1))
 (def TERM-CRITERIA (TermCriteria. (+ TermCriteria/EPS TermCriteria/COUNT) 20 0.03))

-(def RESET-FRAMES 100)
+(def RESET-FRAMES 4)
 (def PT-D 10)

 ;; pixCnt1 is the number of bytes in the pixel buffer
@@ -47,7 +48,7 @@
 ;; bArray is the temporary byte array buffer for OpenCV cv::Mat.
 ;; iArray is the temporary integer array buffer for PImage pixels.
 (defn setup []
-  #_(q/frame-rate 60)
+  (q/frame-rate 60)
   {:b-array (byte-array PIX-CNT1)
    :i-array (int-array PIX-CNT2)
    :frame-mat (Mat. WIDTH HEIGHT CvType/CV_8UC3)
@@ -87,19 +88,37 @@
   (Imgproc/cvtColor m gray-mat Imgproc/COLOR_BGR2GRAY)
   gray-mat)

-(defn update-corners! [gray-mat corners]
-  (let [max-corners MAX-CORNERS
-        quality-level 0.01
-        min-dist 5.0
-        mask BLANK-MASK
-        block-size 3
-        use-harris-detector false
-        k 0.04
-        pts (MatOfPoint.)]
-    (Imgproc/goodFeaturesToTrack gray-mat pts max-corners quality-level min-dist mask block-size use-harris-detector k)
-    (.convertTo pts corners CvType/CV_32FC2)
-    #_(Imgproc/cornerSubPix gray-mat corners WIN-SIZE NEG-ONE-SIZE TERM-CRITERIA)
-    corners))
+(defn update-corners!
+  ([gray-mat]
+     (let [corners (MatOfPoint2f.)]
+       (update-corners! gray-mat corners)))
+  ([gray-mat corners]
+     (let [max-corners MAX-CORNERS
+           quality-level 0.01
+           min-dist 5.0
+           mask BLANK-MASK
+           block-size 3
+           use-harris-detector false
+           k 0.04
+           pts (MatOfPoint.)]
+       (Imgproc/goodFeaturesToTrack gray-mat pts max-corners quality-level min-dist mask block-size use-harris-detector k)
+       (.convertTo pts corners CvType/CV_32FC2)
+       #_(Imgproc/cornerSubPix gray-mat corners WIN-SIZE NEG-ONE-SIZE TERM-CRITERIA)
+       corners)))
+
+(defn valid-pts [pts pt-status]
+  (let [p-s (filter (fn [[_ s]] (= 1 s))
+                    (map vector pts pt-status))]
+    (doall
+     (map (fn [[p _]] p) p-s))))
+
+(defn refresh-corners! [gray-mat lk-status remaining-corners old-corners]
+  (let [valid-remaining (valid-pts (.toList remaining-corners)
+                                   (.toList lk-status))
+        new-corners (.toList (update-corners! gray-mat))
+        union (vec
+               (cset/union (set valid-remaining) (set new-corners)))]
+    (.fromList old-corners (take MAX-CORNERS union))))

 (defn init-gray-mat [{:keys [frame-mat old-gray-mat] :as state}]
   (if (nil? old-gray-mat)
@@ -107,11 +126,17 @@
       (-> state
           (assoc-in [:old-gray-mat] old-gray-mat)
           (assoc-in [:old-corners] (update-corners! old-gray-mat (MatOfPoint2f.)))))
-    (let [{:keys [old-gray-mat old-corners new-gray-mat new-corners]} state]
+    (let [{:keys [old-gray-mat old-corners new-gray-mat new-corners lk-status]} state]
       (.copyTo new-gray-mat old-gray-mat)
       (if (= 0 (mod (q/frame-count) RESET-FRAMES))
-        (update-corners! old-gray-mat old-corners)
-        (.copyTo new-corners old-corners))
+        (do
+          ;; Reuse existing valid corners (still detected):
+          (refresh-corners! new-gray-mat lk-status new-corners old-corners)
+
+          ;; Brute-Force reset of corners:
+          #_(update-corners! new-gray-mat old-corners))
+        (do
+          (.copyTo new-corners old-corners)))
       state)))

 (defn update-optical-flow [state]
@@ -153,12 +178,9 @@
       (dorun
        (map #(draw-pt % [0 0 255 60]) old-pts)))
     (when (< 0 (count pts))
-      (let [status (.toList lk-status)
-            z (filter (fn [[_ s]] (= 1 s))
-                      (map vector pts status))]
+      (let [v-pts (valid-pts pts (.toList lk-status))]
         (dorun
-         (map (fn [[p _]] (draw-pt p))
-              z))))))
+         (map draw-pt v-pts))))))

 (defn draw [state]
   (let [{:keys [p-image]} state]
@@ -176,7 +198,6 @@
   :title "Video Test"
   :size [WIDTH HEIGHT]
   :setup setup
-  ;; something for on-close??? (.release camera)
   :update update
   :draw draw
   :on-close on-close


CMR-2124: Adding test for invalid JSON when creating a group.

--- access-control-app/int_test/cmr/access_control/int_test/access_control_crud_test.clj
+++ access-control-app/int_test/cmr/access_control/int_test/access_control_crud_test.clj
@@ -29,6 +29,12 @@
               :errors
               ["The mime types specified in the content-type header [application/xml] are not supported."]}
              (u/create-group valid-user-token valid-group {:http-options {:content-type :xml}}))))
+
+    (testing "Create group with invalid JSON"
+      (is (= {:status 400,
+              :errors
+              ["Invalid JSON: Unexpected character ('{' (code 123)): was expecting double-quote to start field name\n at  line: 1, column: 3]"]}
+             (u/create-group valid-user-token valid-group {:http-options {:body "{{{"}}))))

     (testing "Missing field validations"
       (are [field]


Работа надо легендой

Работа надо легендой

--- radiolamp-6P3S/src/r6p3s/cpt/d3/chart_2.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/d3/chart_2.cljs
@@ -251,8 +251,9 @@
                            (-> circles
                                (.style "stroke" (fn [srow] (:stroke srow)))
                                (.style "stroke-width" "2px")
-                               (.style "fill" (fn [srow] (:stroke srow)))
-                               (.attr "r" "3px")
+                               (.style "fill" "white")
+                               ;;(.style "fill" (fn [srow] (:stroke srow)))
+                               (.attr "r" "4px")

                                (.attr "cx" (fn [{:keys [row]}]
                                              (x-scale (x-value-fn row))))
@@ -320,10 +321,11 @@
               :yx-schema
               (reduce
                (fn [a {:keys [stroke title]}]
-                 (conj a (dom/span #js {:style #js {:color stroke}}
-                                   "Δ" title " ")))
+                 (conj a (dom/span #js {:className "text-muted"}
+                                   (dom/b #js {:style #js {:color stroke :fontSize "1.5em"}} "⚫")
+                                   title " ")))
                [])
-              (apply dom/p #js {:style #js {:marginLeft left}}))
+              (apply dom/div #js {:style #js {:marginLeft left }}))

          (dom/svg #js {:width main-width :height main-height}
                   (dom/g #js {:id chart-pano-id :transform (str "translate(" left "," top ")")}


fixed conflict

fixed conflict

--- deploy/src/elephantdb/deploy/crate/daemontools.clj
+++ deploy/src/elephantdb/deploy/crate/daemontools.clj
@@ -1,9 +1,10 @@
 (ns elephantdb.deploy.crate.daemontools
   (:use [pallet.core]
+        [pallet.action
+         [exec-script :only [exec-script]]]
         [pallet.resource
          [package :only [package]]
-         [directory :only [directory]]
-         [exec-script :only [exec-script]]]))
+         [directory :only [directory]]]))

 (defn daemontools [req]
   (-> req


eval tests

eval tests

--- src/test/cljs/self_host/test.cljs
+++ src/test/cljs/self_host/test.cljs
@@ -13,7 +13,33 @@
 (defn inc! [r]
   (swap! r inc))

+(set! *target* "nodejs")
+
+(def vm (js/require "vm"))
+(def fs (js/require "fs"))
 (def st (cljs/empty-state))
+
+(defn node-eval [{:keys [name source]}]
+  (.runInThisContext vm source (str (munge name) ".js")))
+
+(def libs
+  {'bootstrap-test.core :cljs
+   'bootstrap-test.macros :clj
+   'bootstrap-test.helper :clj})
+
+(defn node-load [{:keys [name macros]} cb]
+  (if (contains? libs name)
+    (let [path (str "src/test/cljs/" (cljs/ns->relpath name)
+                 "." (cljs.core/name (get libs name)))]
+      (.readFile fs path "utf-8"
+        (fn [err src]
+          (cb (if-not err
+                {:lang :clj :source src}
+                (.error js/console err))))))
+    (cb nil)))
+
+(defn elide-env [env ast opts]
+  (dissoc ast :env))

 (deftest test-compile-str
   (async done
@@ -34,4 +60,30 @@
         (fn [{:keys [error value]}]
           (is (nil? error))
           (is (= value "(cljs.core.truth_(cljs.core.first)?1:2)"))
+          (inc! l))))))
+
+(deftest test-eval-str
+  (async done
+    (let [l (latch 3 done)]
+      (cljs/eval-str st "(+ 1 1)" nil
+        {:eval node-eval}
+        (fn [{:keys [error value]}]
+          (is (nil? error))
+          (is (== value 2))
+          (inc! l)))
+      (cljs/eval-str st "(def x 1)" nil
+        {:eval node-eval
+         :context :expr
+         :def-emits-var true}
+        (fn [{:keys [error value]}]
+          (is (nil? error))
+          (is (var? value))
+          (inc! l)))
+      (cljs/eval-str st "(fn [])" nil
+        {:eval node-eval
+         :context :expr
+         :def-emits-var true}
+        (fn [{:keys [error value]}]
+          (is (nil? error))
+          (is (fn? value))
           (inc! l))))))


Tidy up and remove redundant code

Tidy up and remove redundant code

--- src/yada/resource.clj
+++ src/yada/resource.clj
@@ -34,6 +34,8 @@
   nil
   (make-resource [_] nil))

+;; Fetch
+
 (defprotocol ResourceFetch
   (fetch [this ctx] "Fetch the resource, such that questions can be
   answered about it. Anything you return from this function will be
@@ -43,6 +45,18 @@
   to perform some IO in this function). Often, you will return 'this',
   perhaps augmented with some additional state. Sometimes you will
   return something else."))
+
+;; Fetch happens before negotiation, so must only return resource data,
+;; nothing to do with the representation itself. Negotiation information
+;; will not be present in the context, which is provided primarily to
+;; give the resource fetch access to the Ring request and it's own
+;; resource definition.
+
+(extend-protocol ResourceFetch
+  nil ; The user has not elected to specify a resource, that's fine (and common)
+  (fetch [_ ctx] nil)
+  Object
+  (fetch [o ctx] o))

 (defprotocol Resource
   "A protocol for describing a resource: where it is, when it was last
@@ -78,26 +92,7 @@
   (methods [_] nil)
   (last-modified [_ _] nil))

-;; Fetch
-
-;; Fetch happens before negotiation, so must only return resource data,
-;; nothing to do with the representation itself. Negotiation information
-;; will not be present in the context, which is provided primarily to
-;; give the resource fetch access to the Ring request and it's own
-;; resource definition.
-
-(extend-protocol ResourceFetch
-  nil ; The user has not elected to specify a resource, that's fine (and common)
-  (fetch [_ ctx] nil)
-  Object
-  (fetch [o ctx] o))
-
 ;; Negotiation
-
-(defprotocol Negotiable
-  (negotiate [_ ctx] "Negotiate the resource's representations. Return a
-  yada.negotiation/NegotiationResult. Optional protocol, falls back to
-  default negotiation."))

 (defprotocol ResourceRepresentations
   ;; Context-agnostic


Uncomment CLJS-1521 require-test

Uncomment CLJS-1521 require-test

--- test/cljs/replumb/require_test.cljs
+++ test/cljs/replumb/require_test.cljs
@@ -398,19 +398,14 @@
     (is (valid-eval-result? out) (str _msg_ "should be a valid result."))
     (is (= "30" out) (str _msg_ "should be 30"))))

-;; TB - this test fails but shouldn't, see https://github.com/clojure/clojurescript/wiki/Differences-from-Clojure#lisp
-;; see also http://dev.clojure.org/jira/browse/CLJS-1449
-;; I'm leaving it here for reference, it needs to be changed when the bug will be resolved
-;; the issue in replumb is https://github.com/ScalaConsultants/replumb/issues/90
-;; AR - this will be commented until http://dev.clojure.org/jira/browse/CLJS-1521 is in
-;; as it messes up big time with the compiler state (all the subsequent tests fail)
-;; (h/read-eval-call-test e/*target-opts*
-;;   ["(ns my.namespace (:require-macros [foo.bar.baz :as f]))"
-;;    "(f/mul-baz 20 20)"]
-;;   (let [error (unwrap-result @_res_)]
-;;     (is (not (success? @_res_)) (str _msg_ "should not succeed"))
-;;     (is (valid-eval-error? error) (str _msg_ "should be an instance of js/Error"))
-;;     (is (re-find #"ERROR" (extract-message error)) (str _msg_ "should have correct error message"))))
+;; https://github.com/Lambda-X/replumb/issues/90
+(h/read-eval-call-test (assoc e/*target-opts* :verbose true)
+  ["(ns my.namespace (:require-macros [foo.bar.baz :as f]))"
+   "(f/mul-baz 20 20)"]
+  (let [out (unwrap-result @_res_)]
+    (is (success? @_res_) (str _msg_ "should succeed"))
+    (is (valid-eval-result? out) (str _msg_ "should be a valid result."))
+    (is (= "400" out) (str _msg_ "should be 400"))))

 (h/read-eval-call-test e/*target-opts*
   ["(ns my.namespace (:require-macros [foo.bar.quux :refer [mul-quux]]))"


Update leiningen dependencies

Update leiningen dependencies

--- ssclj/jar/project.clj
+++ ssclj/jar/project.clj
@@ -9,34 +9,36 @@
   :resource-paths ["src/main/resources"]

   :dependencies [[org.clojure/clojure                       "1.7.0"]
-                 [org.clojure/tools.logging                 "0.3.0"]
-                 [org.clojure/tools.namespace               "0.2.5"]
+                 [org.clojure/tools.logging                 "0.3.1"]
+                 [org.clojure/tools.namespace               "0.2.10"]
                  [org.clojure/tools.cli                     "0.3.1"]
-                 [org.clojure/data.json                     "0.2.5"]
-                 [prismatic/schema                          "0.2.6"]
+                 [org.clojure/data.json                     "0.2.6"]
                  [org.clojure/java.classpath                "0.2.2"]
-                 [http-kit/http-kit                         "2.1.18"]
+                 [prismatic/schema                          "1.0.1"]
                  [clojurewerkz/scrypt                       "1.2.0"]
-                 [ring/ring-core                            "1.3.0"]
-                 [ring/ring-json                            "0.3.1"]
-                 [javax.servlet/servlet-api                 "2.5"]
-                 [compojure/compojure                       "1.1.8"]
-                 [clj-time/clj-time                         "0.8.0"]
-                 [clj-stacktrace/clj-stacktrace             "0.2.7"]
-                 [metrics-clojure/metrics-clojure           "2.1.0"]
-                 [metrics-clojure-ring/metrics-clojure-ring "2.1.0"]
-                 [metrics-clojure-jvm/metrics-clojure-jvm   "2.1.0"]
+                 [clj-time/clj-time                         "0.11.0"]
+                 [clj-stacktrace/clj-stacktrace             "0.2.8"]
+                 [metrics-clojure/metrics-clojure           "2.5.1"]
+                 [metrics-clojure-ring/metrics-clojure-ring "2.5.1"]
+                 [metrics-clojure-jvm/metrics-clojure-jvm   "2.5.1"]
                  [fs/fs                                     "1.3.3"]
-                 [org.slf4j/slf4j-log4j12                   "1.7.7"]
-                 [instaparse                                "1.4.0"]
+                 [org.slf4j/slf4j-log4j12                   "1.7.12"]
+                 [instaparse                                "1.4.1"]
                  ;; Environment settings
                  [environ                                   "1.0.0"]
                  ;; database
-                 [honeysql                                  "0.5.2"]
-                 [org.clojure/java.jdbc                     "0.3.6"]
+                 [honeysql                                  "0.6.1"]
+                 [org.clojure/java.jdbc                     "0.4.1"]
                  [korma                                     "0.4.2"]
-                 [org.hsqldb/hsqldb                         "2.3.2"]
-                 [org.xerial/sqlite-jdbc                    "3.7.2"]]
+                 [org.hsqldb/hsqldb                         "2.3.3"]
+                 [org.xerial/sqlite-jdbc                    "3.8.11.1"]
+                 ;; http related
+                 [javax.servlet/javax.servlet-api           "3.1.0"]
+                 [ring/ring-core                            "1.4.0"]
+                 [ring/ring-json                            "0.4.0"]
+                 [compojure/compojure                       "1.4.0"]
+                 [http-kit/http-kit                         "2.1.19"]
+                 [aleph                                     "0.4.0"]]

   :plugins      [[lein-expectations                         "0.0.7"]
                  [lein-autoexpect                           "1.4.2"]
@@ -83,13 +85,13 @@
       { :env {  :clj-env        :development
                 :db-config-path "config-hsqldb.edn"}
         :jvm-opts ["-Dlogfile.path=development"]
-        :dependencies [ [peridot/peridot "0.3.0"]
-                        [expectations/expectations "2.0.9"]]}
+        :dependencies [ [peridot/peridot "0.4.1"]
+                        [expectations/expectations "2.1.3"]]}
     :test
       { :env {  :clj-env        :test
                 :db-config-path "config-hsqldb-mem.edn"}

         :jvm-opts ["-Dlogfile.path=test"]

-        :dependencies [ [peridot/peridot "0.3.0"]
-                        [expectations/expectations "2.0.9"]]}})
+        :dependencies [ [peridot/peridot "0.4.1"]
+                        [expectations/expectations "2.1.3"]]}})


fix formatting quirk with native mongo test.

--- test/metabase/driver/mongo_test.clj
+++ test/metabase/driver/mongo_test.clj
@@ -68,6 +68,13 @@
                                             :port 3000
                                             :dbname "bad-db-name?connectTimeoutMS=50"}))

+(def ^:const ^:private native-query
+  "[{\"$project\": {\"_id\": \"$_id\"}},
+    {\"$match\": {\"_id\": {\"$eq\": 1}}},
+    {\"$group\": {\"_id\": null, \"count\": {\"$sum\": 1}}},
+    {\"$sort\": {\"_id\": 1}},
+    {\"$project\": {\"_id\": false, \"count\": true}}]")
+
 (expect-when-testing-mongo
   {:status :completed
    :row_count 1
@@ -75,16 +82,8 @@
           :columns ["count"]
           :cols [{:description nil, :table_id nil, :special_type nil, :name "count", :extra_info {}, :id nil, :target nil, :display_name "count", :preview-display true, :base_type :UnknownField}]
           :native_form {:collection "venues"
-                        :query "[{\"$project\": {\"_id\": \"$_id\"}},
-                                 {\"$match\": {\"_id\": {\"$eq\": 1}}},
-                                 {\"$group\": {\"_id\": null, \"count\": {\"$sum\": 1}}},
-                                 {\"$sort\": {\"_id\": 1}},
-                                 {\"$project\": {\"_id\": false, \"count\": true}}]"}}}
-  (qp/process-query {:native   {:query "[{\"$project\": {\"_id\": \"$_id\"}},
-                                         {\"$match\": {\"_id\": {\"$eq\": 1}}},
-                                         {\"$group\": {\"_id\": null, \"count\": {\"$sum\": 1}}},
-                                         {\"$sort\": {\"_id\": 1}},
-                                         {\"$project\": {\"_id\": false, \"count\": true}}]"
+                        :query      native-query}}}
+  (qp/process-query {:native   {:query      native-query
                                 :collection "venues"}
                      :type     :native
                      :database (:id (mongo-db))}))


CMR-1852: Added function to create short names from entry id

--- umm-spec-lib/src/cmr/umm_spec/util.clj
+++ umm-spec-lib/src/cmr/umm_spec/util.clj
@@ -52,4 +52,15 @@
 (defn nil-to-empty-string
   "Returns the string itself or empty string if it is nil."
   [s]
-  (if (some? s) s ""))+  (if (some? s) s ""))
+
+(defn gen-am-short-name
+  "Creates a short name from the associated metadata entry-id"
+  [am]
+  (let [entry-id (:EntryId am)]
+    (if-let [version-id (:Version am)]
+      (let [sn-index (.lastIndexOf entry-id (str "_" version-id))]
+        (if (> sn-index 0)
+          (subs entry-id 0 sn-index)
+          entry-id))
+      entry-id)))


CMR-3203 Finish integration test

CMR-3203 Finish integration test

--- system-int-test/test/cmr/system_int_test/search/collection_humanized_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_humanized_search_test.clj
@@ -1,6 +1,7 @@
 (ns cmr.system-int-test.search.collection-humanized-search-test
   "Integration test for CMR collection search by humanized fields"
   (:require [clojure.test :refer :all]
+            [clojure.string :as str]
             [cmr.system-int-test.utils.ingest-util :as ingest]
             [cmr.system-int-test.utils.search-util :as search]
             [cmr.system-int-test.utils.index-util :as index]
@@ -9,8 +10,6 @@
             [cmr.umm-spec.test.location-keywords-helper :as lkt]))

 (use-fixtures :each (ingest/reset-fixture {"provguid1" "PROV1"}))
-
-(def context (lkt/setup-context-for-test lkt/sample-keyword-map))

 ;; Note: These specs rely on data in the indexer's humanizers.json config
 ;;       file. Once humanizers can be set by the ingest service, these
@@ -27,15 +26,35 @@
 ;;  curl http://localhost:3003/humanizers/report

 (deftest humanizer-report
-  (let [coll1 (d/ingest "PROV1" (dc/collection {:platforms [(dc/platform {:short-name "TERRA"})]}))
-        coll2 (d/ingest "PROV1" (dc/collection {:platforms [(dc/platform {:short-name "AM-1"})]}))
-        coll3 (d/ingest "PROV1" (dc/collection {:platforms [(dc/platform {:short-name "Aqua"})]}))]
-    (index/wait-until-indexed)
-    ;; Refresh the metadata cache
-    (search/refresh-collection-metadata-cache)
-    (let [report (search/get-humanizers-report)]
-      (println report)
-      (proto-repl.saved-values/save 14))))
+  (d/ingest "PROV1" (dc/collection
+                     {:product {:short-name "A"
+                                :long-name "A"
+                                :version-id "V1"}
+                      :platforms [(dc/platform {:short-name "TERRA"
+                                                              :instruments
+                                                              [(dc/instrument {:short-name "GPS RECEIVERS"})]})]}))
+  (d/ingest "PROV1" (dc/collection
+                     {:product {:short-name "B"
+                                :long-name "B"
+                                :version-id "V2"}
+                      :platforms [(dc/platform {:short-name "AM-1"})]}))
+  (d/ingest "PROV1" (dc/collection
+                     {:product {:short-name "C"
+                                :long-name "C"
+                                :version-id "V3"}
+                      :projects (dc/projects "USGS_SOFIA")}))
+
+  (index/wait-until-indexed)
+  ;; Refresh the metadata cache
+  (search/refresh-collection-metadata-cache)
+  (testing "Humanizer report csv")
+  (let [report (search/get-humanizers-report)]
+    (is (= (str/split report #"\n")
+           ["provider,concept_id,short_name,version,original_value,humanized_value"
+            "PROV1,C1200000000-PROV1,A,V1,GPS RECEIVERS,GPS Receivers"
+            "PROV1,C1200000001-PROV1,B,V2,AM-1,Terra"
+            "PROV1,C1200000002-PROV1,C,V3,USGS_SOFIA,USGS SOFIA"]))))
+

 (deftest search-by-platform-humanized
   (let [coll1 (d/ingest "PROV1" (dc/collection {:platforms [(dc/platform {:short-name "TERRA"})]}))


write tests

write tests

--- test/clj/salava/badge/endorsement_test.clj
+++ test/clj/salava/badge/endorsement_test.clj
@@ -1,13 +1,47 @@
 (ns salava.badge.endorsement-test
- (:require [salava.core.migrator :as migrator]
-           [salava.core.test-utils :as t]
-           [clojure.test :refer :all]))
+  (:require [salava.core.migrator :as migrator]
+            [salava.core.test-utils :as t]
+            [clojure.test :refer :all]
+            [salava.badge.endorsement :as e]))
+
+(def user {:id 1 :role "user" :private false :activated true})
+(def user-2 (assoc user :id 4))
+(def user-3 (assoc user :id 5))
+
+(def badge 2)
+(def badge-2 7)

 (t/deftest-ctx endorsement-test [ctx]
   (testing "Endorsements"
-    (testing "Endorse")
-    (testing "Accept endorsment")
+      (testing "Endorse own badge"
+        (let [endorsement (e/endorse! ctx badge-2 (:id user-2) "i endorse this dude")]
+          (is (= (:status endorsement) "error"))))
+      (testing "Endorse badge"
+        (let [endorsement (e/endorse! ctx badge-2 (:id user) "i endorse this dude")
+              badge-endorsements (e/badge-endorsements ctx badge-2)]
+          (is (= (:status endorsement) "success"))
+          (is (= 1 (count badge-endorsements)))
+
+          (testing "Delete endorsement you do not own"
+            (let [connect (e/delete! ctx badge-2 (:id endorsement) (:id user-3))]
+              (is (= "error" (:status connect)))))
+
+          (testing "Delete own endorsement"
+            (let [connect (e/delete! ctx badge-2 (:id endorsement) (:id user))]
+              (is (= "success" (:status connect)))))
+          ))
+
+    (testing "Accept endorsment"
+      (let [endorsement (e/endorse! ctx badge-2 (:id user) "i endorse this dude")
+            connect (e/update-status! ctx (:id user-2) badge-2 (:id endorsement) "accepted")]
+        (is (= (:status endorsement) "success"))
+        (is (= (:status connect) "success"))
+        (let [check (e/badge-endorsements ctx badge-2)]
+          (is (= 1 (count check)))
+          (is (= "pending" (->> check first :status))))))
+
     (testing "Reject endorsment")
     (testing "Remove endorsement")))

+(migrator/reset-seeds (migrator/test-config))


update TODO

update TODO

--- test/com/billpiel/mem_tracer/core_test.clj
+++ test/com/billpiel/mem_tracer/core_test.clj
@@ -508,9 +508,9 @@
 (comment "
 TODO
 x tree query sibliings
-- use dynamic ns for storage instead of atom/map?!?!?!
+x use dynamic ns for storage instead of atom/map?!?!?!
 - save recordings
-- save/load workspaces
+x save/load workspaces
 - preserve arglists and other meta in core fns
   - use defn and docstring in core
 - optional print func log before and after children


Simplify management of tsplot divs.

Simplify management of tsplot divs.

--- metlog-vault/src-client/metlog_client/metlog.cljs
+++ metlog-vault/src-client/metlog_client/metlog.cljs
@@ -12,9 +12,6 @@
 (def dashboard-state (reagent/atom {:series [] :text ""}))

 (def window-width (reagent/atom nil))
-
-(def default-tsplot-width 1024)
-(def default-tsplot-height 180)

 (defn <<< [f & args]
   (let [c (chan)]
@@ -41,25 +38,9 @@
             {:query-window-secs query-window-secs}
             cb))

-(defn dom-node-width
-  ([ node default-width ]
-   (if node
-     (.-clientWidth node)
-     default-width))
-  ([ node ]
-   (dom-node-width node nil)))
-
-(defn dom-node-height
-  ([ node default-height ]
-   (if node
-     (.-clientHeight node)
-     default-height))
-  ([ node ]
-   (dom-node-height node nil)))
-
 (defn tsplot-draw [ canvas series-data ]
   (let [ ctx (.getContext canvas "2d")]
-    (tsplot/draw ctx (dom-node-width canvas) (dom-node-height canvas) series-data)))
+    (tsplot/draw ctx (.-clientWidth canvas) (.-clientHeight canvas) series-data)))

 (defn series-tsplot [ series ]
   (let [dom-node (reagent/atom nil)
@@ -81,8 +62,9 @@
         @window-width
         @series-state
         [:div
-         [:canvas {:width (dom-node-width @dom-node default-tsplot-width)
-                   :height (dom-node-height @dom-node default-tsplot-height)}]])})))
+         [:canvas (if-let [ node @dom-node ]
+                    {:width (.-clientWidth node)
+                     :height (.-clientHeight node)})]])})))

 (defn series-pane [ series ]
   [:div.series-pane
@@ -127,7 +109,6 @@
   (reagent/render [dashboard]
                   (js/document.getElementById "metlog"))
   (.addEventListener js/window "resize" on-window-resize)
-  (on-window-resize nil)
   (go
     (swap! dashboard-state assoc :series (<! (<<< fetch-series-names)))))


Require test-utils in partition-test for valid? helper.

--- test/merkle_db/partition_test.clj
+++ test/merkle_db/partition_test.clj
@@ -13,7 +13,8 @@
       [partition :as part]
       [patch :as patch]
       [record :as record]
-      [tablet :as tablet])))
+      [tablet :as tablet]
+      [test-utils :as tu])))

 ;; ## Unit Tests


Catch exceptions when parsing status update data

--- scheduler/src/cook/mesos/scheduler.clj
+++ scheduler/src/cook/mesos/scheduler.clj
@@ -209,8 +209,11 @@
                                      :task-killed
                                      :task-lost} :instance.status/failed)
                  prior-job-state (:job/state (d/entity db job))
-                 progress (when (:data status)
-                            (:percent (read-string (String. (:data status)))))
+                 progress (try
+                              (when (:data status)
+                                  (:percent (read-string (String. (:data status)))))
+                          (catch Exception e
+                              (log/debug e "Error parse mesos status data. Is it in the format we expect?")))
                  instance-runtime (- (.getTime (now)) ; Used for reporting
                                      (.getTime (:instance/start-time (d/entity db instance))))
                  job-resources (util/job-ent->resources job-ent)]


feat(backend): adapt pages tests to new api

--- backend/test/uxbox/tests/test_pages.clj
+++ backend/test/uxbox/tests/test_pages.clj
@@ -2,11 +2,9 @@
   (:require [clojure.test :as t]
             [promesa.core :as p]
             [suricatta.core :as sc]
-            [catacumba.testing :refer (with-server)]
-            [buddy.core.codecs :as codecs]
+            [uxbox.util.uuid :as uuid]
             [uxbox.db :as db]
-            [uxbox.util.uuid :as uuid]
-            [uxbox.frontend :as uft]
+            [uxbox.api :as uapi]
             [uxbox.services.projects :as uspr]
             [uxbox.services.pages :as uspg]
             [uxbox.services :as usv]
@@ -14,211 +12,211 @@

 (t/use-fixtures :each th/database-reset)

-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Frontend Test
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (t/deftest test-http-page-create
-;;   (with-open [conn (db/connection)]
-;;     (let [user (th/create-user conn 1)
-;;           proj (uspr/create-project conn {:user (:id user) :name "proj1"})]
-;;       (with-server {:handler (uft/routes)}
-;;         (let [uri (str th/+base-url+ "/api/pages")
-;;               params {:body {:project (:id proj)
-;;                              :name "page1"
-;;                              :data "1"
-;;                              :metadata "1"
-;;                              :width 200
-;;                              :height 200
-;;                              :layout "mobile"}}
-;;               [status data] (th/http-post user uri params)]
-;;           ;; (println "RESPONSE:" status data)
-;;           (t/is (= 201 status))
-;;           (t/is (= (:data (:body params)) (:data data)))
-;;           (t/is (= (:user data) (:id user)))
-;;           (t/is (= (:name data) "page1")))))))
-
-;; (t/deftest test-http-page-update
-;;   (with-open [conn (db/connection)]
-;;     (let [user (th/create-user conn 1)
-;;           proj (uspr/create-project conn {:user (:id user) :name "proj1"})
-;;           data {:id (uuid/random)
-;;                 :user (:id user)
-;;                 :project (:id proj)
-;;                 :version 0
-;;                 :data "1"
-;;                 :metadata "2"
-;;                 :name "page1"
-;;                 :width 200
-;;                 :height 200
-;;                 :layout "mobil"}
-;;           page (uspg/create-page conn data)]
-;;       (with-server {:handler (uft/routes)}
-;;         (let [uri (str th/+base-url+ (str "/api/pages/" (:id page)))
-;;               params {:body (assoc page :data "3")}
-;;               [status page'] (th/http-put user uri params)]
-;;           ;; (println "RESPONSE:" status page')
-;;           (t/is (= 200 status))
-;;           (t/is (= "3" (:data page')))
-;;           (t/is (= 1 (:version page')))
-;;           (t/is (= (:user page') (:id user)))
-;;           (t/is (= (:name data) "page1")))))))
-
-;; (t/deftest test-http-page-update-metadata
-;;   (with-open [conn (db/connection)]
-;;     (let [user (th/create-user conn 1)
-;;           proj (uspr/create-project conn {:user (:id user) :name "proj1"})
-;;           data {:id (uuid/random)
-;;                 :user (:id user)
-;;                 :project (:id proj)
-;;                 :version 0
-;;                 :data "1"
-;;                 :metadata "2"
-;;                 :name "page1"
-;;                 :width 200
-;;                 :height 200
-;;                 :layout "mobil"}
-;;           page (uspg/create-page conn data)]
-;;       (with-server {:handler (uft/routes)}
-;;         (let [uri (str th/+base-url+ (str "/api/pages/" (:id page) "/metadata"))
-;;               params {:body (assoc page :data "3")}
-;;               [status page'] (th/http-put user uri params)]
-;;           ;; (println "RESPONSE:" status page')
-;;           (t/is (= 200 status))
-;;           (t/is (= "1" (:data page')))
-;;           (t/is (= 1 (:version page')))
-;;           (t/is (= (:user page') (:id user)))
-;;           (t/is (= (:name data) "page1")))))))
-
-;; (t/deftest test-http-page-delete
-;;   (with-open [conn (db/connection)]
-;;     (let [user (th/create-user conn 1)
-;;           proj (uspr/create-project conn {:user (:id user) :name "proj1"})
-;;           data {:id (uuid/random)
-;;                 :user (:id user)
-;;                 :project (:id proj)
-;;                 :version 0
-;;                 :data "1"
-;;                 :metadata "2"
-;;                 :name "page1"
-;;                 :width 200
-;;                 :height 200
-;;                 :layout "mobil"}
-;;           page (uspg/create-page conn data)]
-;;       (with-server {:handler (uft/routes)}
-;;         (let [uri (str th/+base-url+ (str "/api/pages/" (:id page)))
-;;               [status response] (th/http-delete user uri)]
-;;           ;; (println "RESPONSE:" status response)
-;;           (t/is (= 204 status))
-;;           (let [sqlv ["SELECT * FROM pages WHERE \"user\"=? AND deleted_at is null"
-;;                       (:id user)]
-;;                 result (sc/fetch conn sqlv)]
-;;             (t/is (empty? result))))))))
-
-;; (t/deftest test-http-page-list-by-project
-;;   (with-open [conn (db/connection)]
-;;     (let [user (th/create-user conn 1)
-;;           proj1 (uspr/create-project conn {:user (:id user) :name "proj1"})
-;;           proj2 (uspr/create-project conn {:user (:id user) :name "proj2"})
-;;           data {:user (:id user)
-;;                 :version 0
-;;                 :data "1"
-;;                 :metadata "2"
-;;                 :name "page1"
-;;                 :width 200
-;;                 :height 200
-;;                 :layout "mobil"}
-;;           page1 (uspg/create-page conn (assoc data :project (:id proj1)))
-;;           page2 (uspg/create-page conn (assoc data :project (:id proj2)))]
-;;       (with-server {:handler (uft/routes)}
-;;         (let [uri (str th/+base-url+ (str "/api/projects/" (:id proj1) "/pages"))
-;;               [status response] (th/http-get user uri)]
-;;           ;; (println "RESPONSE:" status response)
-;;           (t/is (= 200 status))
-;;           (t/is (= 1 (count response)))
-;;           (t/is (= (:id (first response)) (:id page1))))))))
-
-;; (t/deftest test-http-page-history-retrieve
-;;   (with-open [conn (db/connection)]
-;;     (let [user (th/create-user conn 1)
-;;           proj (uspr/create-project conn {:user (:id user) :name "proj1"})
-;;           data {:id (uuid/random)
-;;                 :user (:id user)
-;;                 :project (:id proj)
-;;                 :version 0
-;;                 :data "1"
-;;                 :metadata "2"
-;;                 :name "page1"
-;;                 :width 200
-;;                 :height 200
-;;                 :layout "mobil"}
-;;           page (uspg/create-page conn data)]
-;;       (dotimes [i 100]
-;;         (let [page (uspg/get-page-by-id conn (:id data))]
-;;           (uspg/update-page conn (assoc page :data (str i)))))
-
-;;       ;; Check inserted history
-;;       (let [sqlv ["SELECT * FROM pages_history WHERE page=?" (:id data)]
-;;             result (sc/fetch conn sqlv)]
-;;         (t/is (= (count result) 101)))
-
-;;       ;; Check retrieve all items
-;;       (with-server {:handler (uft/routes)}
-;;         (let [uri (str th/+base-url+ "/api/pages/" (:id page) "/history")
-;;               [status result] (th/http-get user uri nil)]
-;;           ;; (println "RESPONSE:" status result)
-;;           (t/is (= (count result) 10))
-;;           (t/is (= 200 status))
-;;           (t/is (= 100 (:version (first result))))
-
-;;           (let [params {:query {:since (:version (last result))
-;;                                 :max 20}}
-;;                 [status result] (th/http-get user uri params)]
-;;             ;; (println "RESPONSE:" status result)
-;;             (t/is (= (count result) 20))
-;;             (t/is (= 200 status))
-;;             (t/is (= 90 (:version (first result))))))
-;;         ))))
-
-;; (t/deftest test-http-page-history-update
-;;   (with-open [conn (db/connection)]
-;;     (let [user (th/create-user conn 1)
-;;           proj (uspr/create-project conn {:user (:id user) :name "proj1"})
-;;           data {:id (uuid/random)
-;;                 :user (:id user)
-;;                 :project (:id proj)
-;;                 :version 0
-;;                 :data "1"
-;;                 :metadata "2"
-;;                 :name "page1"
-;;                 :width 200
-;;                 :height 200
-;;                 :layout "mobil"}
-;;           page (uspg/create-page conn data)]
-
-;;       (dotimes [i 10]
-;;         (let [page (uspg/get-page-by-id conn (:id data))]
-;;           (uspg/update-page conn (assoc page :data (str i)))))
-
-;;       ;; Check inserted history
-;;       (let [sql (str "SELECT * FROM pages_history "
-;;                      " WHERE page=? ORDER BY created_at DESC")
-;;             result (sc/fetch conn [sql (:id data)])
-;;             item (first result)]
-
-;;         (with-server {:handler (uft/routes)}
-;;           (let [uri (str th/+base-url+
-;;                          "/api/pages/" (:id page)
-;;                          "/history/" (:id item))
-;;                 params {:body {:label "test" :pinned true}}
-;;                 [status data] (th/http-put user uri params)]
-;;             ;; (println "RESPONSE:" status data)
-;;             (t/is (= 200 status))
-;;             (t/is (= (:id data) (:id item))))))
-
-;;       (let [sql (str "SELECT * FROM pages_history "
-;;                      " WHERE page=? AND pinned = true "
-;;                      " ORDER BY created_at DESC")
-;;             result (sc/fetch-one conn [sql (:id data)])]
-;;         (t/is (= "test" (:label result)))
-;;         (t/is (= true (:pinned result)))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Frontend Test
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(t/deftest test-http-page-create
+  (with-open [conn (db/connection)]
+    (let [user (th/create-user conn 1)
+          proj (uspr/create-project conn {:user (:id user) :name "proj1"})]
+      (th/with-server {:handler uapi/app}
+        (let [uri (str th/+base-url+ "/api/pages")
+              params {:body {:project (:id proj)
+                             :name "page1"
+                             :data "1"
+                             :metadata "1"
+                             :width 200
+                             :height 200
+                             :layout "mobile"}}
+              [status data] (th/http-post user uri params)]
+          ;; (println "RESPONSE:" status data)
+          (t/is (= 201 status))
+          (t/is (= (:data (:body params)) (:data data)))
+          (t/is (= (:user data) (:id user)))
+          (t/is (= (:name data) "page1")))))))
+
+(t/deftest test-http-page-update
+  (with-open [conn (db/connection)]
+    (let [user (th/create-user conn 1)
+          proj (uspr/create-project conn {:user (:id user) :name "proj1"})
+          data {:id (uuid/random)
+                :user (:id user)
+                :project (:id proj)
+                :version 0
+                :data "1"
+                :metadata "2"
+                :name "page1"
+                :width 200
+                :height 200
+                :layout "mobil"}
+          page (uspg/create-page conn data)]
+      (th/with-server {:handler uapi/app}
+        (let [uri (str th/+base-url+ (str "/api/pages/" (:id page)))
+              params {:body (assoc page :data "3")}
+              [status page'] (th/http-put user uri params)]
+          ;; (println "RESPONSE:" status page')
+          (t/is (= 200 status))
+          (t/is (= "3" (:data page')))
+          (t/is (= 1 (:version page')))
+          (t/is (= (:user page') (:id user)))
+          (t/is (= (:name data) "page1")))))))
+
+(t/deftest test-http-page-update-metadata
+  (with-open [conn (db/connection)]
+    (let [user (th/create-user conn 1)
+          proj (uspr/create-project conn {:user (:id user) :name "proj1"})
+          data {:id (uuid/random)
+                :user (:id user)
+                :project (:id proj)
+                :version 0
+                :data "1"
+                :metadata "2"
+                :name "page1"
+                :width 200
+                :height 200
+                :layout "mobil"}
+          page (uspg/create-page conn data)]
+      (th/with-server {:handler uapi/app}
+        (let [uri (str th/+base-url+ (str "/api/pages/" (:id page) "/metadata"))
+              params {:body (assoc page :data "3")}
+              [status page'] (th/http-put user uri params)]
+          ;; (println "RESPONSE:" status page')
+          (t/is (= 200 status))
+          (t/is (= "1" (:data page')))
+          (t/is (= 1 (:version page')))
+          (t/is (= (:user page') (:id user)))
+          (t/is (= (:name data) "page1")))))))
+
+(t/deftest test-http-page-delete
+  (with-open [conn (db/connection)]
+    (let [user (th/create-user conn 1)
+          proj (uspr/create-project conn {:user (:id user) :name "proj1"})
+          data {:id (uuid/random)
+                :user (:id user)
+                :project (:id proj)
+                :version 0
+                :data "1"
+                :metadata "2"
+                :name "page1"
+                :width 200
+                :height 200
+                :layout "mobil"}
+          page (uspg/create-page conn data)]
+      (th/with-server {:handler uapi/app}
+        (let [uri (str th/+base-url+ (str "/api/pages/" (:id page)))
+              [status response] (th/http-delete user uri)]
+          ;; (println "RESPONSE:" status response)
+          (t/is (= 204 status))
+          (let [sqlv ["SELECT * FROM pages WHERE \"user\"=? AND deleted_at is null"
+                      (:id user)]
+                result (sc/fetch conn sqlv)]
+            (t/is (empty? result))))))))
+
+(t/deftest test-http-page-list-by-project
+  (with-open [conn (db/connection)]
+    (let [user (th/create-user conn 1)
+          proj1 (uspr/create-project conn {:user (:id user) :name "proj1"})
+          proj2 (uspr/create-project conn {:user (:id user) :name "proj2"})
+          data {:user (:id user)
+                :version 0
+                :data "1"
+                :metadata "2"
+                :name "page1"
+                :width 200
+                :height 200
+                :layout "mobil"}
+          page1 (uspg/create-page conn (assoc data :project (:id proj1)))
+          page2 (uspg/create-page conn (assoc data :project (:id proj2)))]
+      (th/with-server {:handler uapi/app}
+        (let [uri (str th/+base-url+ (str "/api/pages?project=" (:id proj1)))
+              [status response] (th/http-get user uri)]
+          ;; (println "RESPONSE:" status response)
+          (t/is (= 200 status))
+          (t/is (= 1 (count response)))
+          (t/is (= (:id (first response)) (:id page1))))))))
+
+(t/deftest test-http-page-history-retrieve
+  (with-open [conn (db/connection)]
+    (let [user (th/create-user conn 1)
+          proj (uspr/create-project conn {:user (:id user) :name "proj1"})
+          data {:id (uuid/random)
+                :user (:id user)
+                :project (:id proj)
+                :version 0
+                :data "1"
+                :metadata "2"
+                :name "page1"
+                :width 200
+                :height 200
+                :layout "mobil"}
+          page (uspg/create-page conn data)]
+      (dotimes [i 100]
+        (let [page (uspg/get-page-by-id conn (:id data))]
+          (uspg/update-page conn (assoc page :data (str i)))))
+
+      ;; Check inserted history
+      (let [sqlv ["SELECT * FROM pages_history WHERE page=?" (:id data)]
+            result (sc/fetch conn sqlv)]
+        (t/is (= (count result) 101)))
+
+      ;; Check retrieve all items
+      (th/with-server {:handler uapi/app}
+        (let [uri (str th/+base-url+ "/api/pages/" (:id page) "/history")
+              [status result] (th/http-get user uri nil)]
+          ;; (println "RESPONSE:" status result)
+          (t/is (= (count result) 10))
+          (t/is (= 200 status))
+          (t/is (= 100 (:version (first result))))
+
+          (let [params {:query {:since (:version (last result))
+                                :max 20}}
+                [status result] (th/http-get user uri params)]
+            ;; (println "RESPONSE:" status result)
+            (t/is (= (count result) 20))
+            (t/is (= 200 status))
+            (t/is (= 90 (:version (first result))))))
+        ))))
+
+(t/deftest test-http-page-history-update
+  (with-open [conn (db/connection)]
+    (let [user (th/create-user conn 1)
+          proj (uspr/create-project conn {:user (:id user) :name "proj1"})
+          data {:id (uuid/random)
+                :user (:id user)
+                :project (:id proj)
+                :version 0
+                :data "1"
+                :metadata "2"
+                :name "page1"
+                :width 200
+                :height 200
+                :layout "mobil"}
+          page (uspg/create-page conn data)]
+
+      (dotimes [i 10]
+        (let [page (uspg/get-page-by-id conn (:id data))]
+          (uspg/update-page conn (assoc page :data (str i)))))
+
+      ;; Check inserted history
+      (let [sql (str "SELECT * FROM pages_history "
+                     " WHERE page=? ORDER BY created_at DESC")
+            result (sc/fetch conn [sql (:id data)])
+            item (first result)]
+
+        (th/with-server {:handler uapi/app}
+          (let [uri (str th/+base-url+
+                         "/api/pages/" (:id page)
+                         "/history/" (:id item))
+                params {:body {:label "test" :pinned true}}
+                [status data] (th/http-put user uri params)]
+            ;; (println "RESPONSE:" status data)
+            (t/is (= 200 status))
+            (t/is (= (:id data) (:id item))))))
+
+      (let [sql (str "SELECT * FROM pages_history "
+                     " WHERE page=? AND pinned = true "
+                     " ORDER BY created_at DESC")
+            result (sc/fetch-one conn [sql (:id data)])]
+        (t/is (= "test" (:label result)))
+        (t/is (= true (:pinned result)))))))


Fix circle.yml tab showing by default in v1

--- src-cljs/frontend/components/build_head.cljs
+++ src-cljs/frontend/components/build_head.cljs
@@ -748,7 +748,7 @@
         (build-model/in-usage-queue? build))
    :usage-queue
    ;; If there's no SSH info, build isn't finished, show the config
-   (build-model/running? build) :config
+   (build-model/running? build) (if (feature/enabled? :ui-v2) :config :commits)
    ;; Otherwise, just use the first one.
    :else :tests))


update cljs as well

update cljs as well

--- frontend/models/action.cljs
+++ frontend/models/action.cljs
@@ -26,7 +26,7 @@
 (defn new-converter [action type]
   (let [default-color (if (= :err :type) "red" "brblue")
         starting-state (clj->js (get-in action [:converters-state type]))]
-    (js/CI.terminal.ansiToHtmlConverter default-color starting-state)))
+    (js/CI.terminal.ansiToHtmlConverter default-color "brblack" starting-state)))

 (defn format-output [action output-index]
   (let [output (get-in action [:output output-index])


data-centers -> data-center

data-centers -> data-center

--- umm-spec-lib/test/cmr/umm_spec/test/xml_to_umm_mappings/echo10.clj
+++ umm-spec-lib/test/cmr/umm_spec/test/xml_to_umm_mappings/echo10.clj
@@ -37,9 +37,9 @@
                         </Contact>
                        </Contacts>
                       </Collection>")
-            data-centers (contact/parse-data-centers xml true)]
-        (is (= organization-name (:LongName (first data-centers))))
+            data-center (first (contact/parse-data-centers xml true))]
+        (is (= organization-name (:LongName data-center)))
         (is (= (subs organization-name 0 85)
-               (:ShortName (first data-centers))))
-        (is (= 85 (count (:ShortName (first data-centers)))))
-        (is (< 85 (count (:LongName (first data-centers))))))))))
+               (:ShortName data-center)))
+        (is (= 85 (count (:ShortName data-center))))
+        (is (< 85 (count (:LongName data-center)))))))))


Use destructuring to simplify play#.

Use destructuring to simplify play#.

--- src/overtunes/songs/canone_alla_quarta.clj
+++ src/overtunes/songs/canone_alla_quarta.clj
@@ -6,7 +6,7 @@
 (defn => [val & fs] (reduce #(apply %2 [%1]) val fs))

 (defn play# [notes]
-  (let [play-at# #(at (% 0) (piano# (% 1)))]
+  (let [play-at# (fn [[t p]] (at t (piano# p)))]
     (->> notes (map play-at#) dorun)))

 (defn demo# [pitches]


more appropriate naming

more appropriate naming


bump boot-reload and boot-cljs-repl dependencies

--- resources/leiningen/new/tenzing/build.boot
+++ resources/leiningen/new/tenzing/build.boot
@@ -1,9 +1,9 @@
 (set-env!
  :source-paths    {{{source-paths}}}
  :resource-paths  #{"resources"}
-                 [adzerk/boot-cljs-repl     "0.1.9"      :scope "test"]
-                 [adzerk/boot-reload        "0.3.1"      :scope "test"]
  :dependencies '[[adzerk/boot-cljs          "1.7.48-6"   :scope "test"]
+                 [adzerk/boot-cljs-repl     "0.2.0"      :scope "test"]
+                 [adzerk/boot-reload        "0.4.1"      :scope "test"]
                  [pandeiro/boot-http        "0.6.3"      :scope "test"]
                  [org.clojure/clojurescript "1.7.122"]{{{deps}}}])


[core] log telemetry messages to debug to make log-collecting on the info level more meaningful

--- core/src/gorillalabs/tesla/component/telemetry.clj
+++ core/src/gorillalabs/tesla/component/telemetry.clj
@@ -32,7 +32,7 @@
 (defn- flush-queue [client queue]
   (let [events (drain-queue queue)]
     (when (and client (seq events))
-      (log/infof "Sending %d event(s) to telemetry backend..." (count events))
+      (log/debugf "Sending %d event(s) to telemetry backend..." (count events))
       (riemann/send-events client events))))

 (defn- prepare-event [telemetry event]
@@ -63,8 +63,8 @@
                       result  expr
                       elapsed (list '- (list 'System/currentTimeMillis) start)
                       values  (list 'merge props {:service identifier :metric elapsed :unit "ms" :type "timed"})]
-                (list 'log/infof "[%s] took %dms." identifier elapsed)
                 (list 'gorillalabs.tesla.component.telemetry/enqueue 'gorillalabs.tesla.component.telemetry/telemetry values)
+                (list 'log/debugf "[%s] took %dms." identifier elapsed)
                 result)
           expr)))