Removed duplicate function definition.

Removed duplicate function definition.

--- src/ais/core.clj
+++ src/ais/core.clj
@@ -74,18 +74,6 @@
                           ((spec :fn) (subs b 0 block-len)))))
       a)))

-;; if line --> tag-block is nil, skip
-(defn parse-tag-block [acc collector block tags]
-  (loop [t tags
-         a acc]
-    (if-let [tag (first t)]
-      (let [spec (ais-mappings/tag-mapping tag)
-            value ((spec :ex-fn) block)]
-        (recur (rest t)
-               (collector a (spec :tag) (if (nil? value) nil ((spec :fn) value)))))
-      a)))
-
-
 (defn parse-tag-block [acc collector tags block]
   (loop [t tags
          a acc]
@@ -96,18 +84,16 @@
                (collector a (spec :tag) (if (nil? value) nil ((spec :fn) value)))))
       a)))

-;; if tag-block is nil, skip
 (defn parse [data-format tag-block payload fill-bits]
   (let [[acc collector] (data-collector data-format)
         bits (ais-util/pad (payload->binary payload) fill-bits)]
-    (decode-binary-payload (ais-mappings/parsing-rules bits)                       ; type specification
+    (decode-binary-payload (ais-mappings/parsing-rules bits)                    ; msg-type field decoding specs
                            (parse-tag-block acc
                                             collector
                                             ["c" "s" "n"]
-                                            (if (nil? tag-block)
-                                              "" tag-block))                       ; use metadata as initial accumulator
-                           collector                                               ; accumulator function
-                           bits)))                                                 ; raw binary payload
+                                            (if (nil? tag-block) "" tag-block)) ; use tag metadata as initial accumulator
+                           collector                                            ; accumulator function
+                           bits)))                                              ; raw binary payload

 (defn parse-ais
   ([data-format msg]
@@ -148,5 +134,5 @@
   "I don't do a whole lot ... yet."
   [& args]
   (let [data-format (nth args 0)
-        envelope (nth args 1)]
-   (println (json/write-str (parse data-format envelope)))))
+        message (nth args 1)]
+   (println (json/write-str (parse-ais data-format message)))))


Added 5 tests into test/clj_mrazik/schedule_test.clj

--- test/clj_mrazik/schedule_test.clj
+++ test/clj_mrazik/schedule_test.clj
@@ -23,3 +23,36 @@
     [function-name]
     (clojure.test/function? function-name))

+;
+; Tests for various functions
+;
+
+(deftest test-format-schedule-time-existence
+    "Check that the clj-mrazik.schedule/format-schedule-time definition exists."
+    (testing "if the clj-mrazik.schedule/format-schedule-time definition exists."
+        (is (callable? 'clj-mrazik.schedule/format-schedule-time))))
+
+
+(deftest test-schedule-entry-existence
+    "Check that the clj-mrazik.schedule/schedule-entry definition exists."
+    (testing "if the clj-mrazik.schedule/schedule-entry definition exists."
+        (is (callable? 'clj-mrazik.schedule/schedule-entry))))
+
+
+(deftest test-compute-schedule-existence
+    "Check that the clj-mrazik.schedule/compute-schedule definition exists."
+    (testing "if the clj-mrazik.schedule/compute-schedule definition exists."
+        (is (callable? 'clj-mrazik.schedule/compute-schedule))))
+
+
+(deftest test-get-sunset-existence
+    "Check that the clj-mrazik.schedule/get-sunset definition exists."
+    (testing "if the clj-mrazik.schedule/get-sunset definition exists."
+        (is (callable? 'clj-mrazik.schedule/get-sunset))))
+
+
+(deftest test-get-sunrise-existence
+    "Check that the clj-mrazik.schedule/get-sunrise definition exists."
+    (testing "if the clj-mrazik.schedule/get-sunrise definition exists."
+        (is (callable? 'clj-mrazik.schedule/get-sunrise))))
+


Simple cleanups

Simple cleanups

- indentation
- superfluous (testing ...) calls

--- test/flo_invest/database_test.clj
+++ test/flo_invest/database_test.clj
@@ -44,13 +44,16 @@
         )))

 (deftest test-constraints
+  "It is not allowed to leave out either one of name, isin or
+date_added when adding a new security to the database"
   (are [row] (thrown? SQLException (add-security test-conn row))
        {:name "revenue"}
-       {:isin "de1234567890"}))
+       {:isin "de1234567890"}
+       {:name "revenue" :isin "de1234567890"}))

 (deftest test-db-empty
-  (testing "loading test data succeeds"
-    (is (= (db-read-all test-conn) []))))
+  "loading test data succeeds"
+  (is (= (db-read-all test-conn) [])))

 (deftest uniqueness-constraint
   (testing "can't insert a row that only differs in the date added"
@@ -59,32 +62,30 @@
       (add-security test-conn row1)
       (add-security test-conn row2)
       (let [result (vec (db-read-all test-conn))]
-        (is (= result [(assoc  row1 :date_added (to-string (row1 :date_added)) :id 1)])))
-      )))
+        (is (= result [(assoc row1 :date_added (to-string (row1 :date_added)) :id 1)]))))))

 (defn mytest
   [order]
   (testing (str  "Test database state. Insert order" order)
-                  ;; Insert security date for ACME 2012-1-1
-                  ;; Add a new company also called ACME on 2012-5-1
-                  ;; Rename first ACME to Silly corp on 2013-1-1
-                  (let [rows [{:name "ACME corp"
-                               :isin "de1234567890" :date_added (date-time 2012 1 1)}
-                              {:name "ACME corp"
-                               :isin "de1234567891" :date_added (date-time 2012 5 1)}
-                              {:name "Silly corp (formerly ACME)"
-                               :isin "de1234567890" :date_added (date-time 2013 1 1)}]
-                        [res1 res2 res3] (for [[row num] (map vector rows (map (zipmap order [1 2 3]) [0 1 2]))]
-                                           (assoc row :date_added (to-string (row :date_added)) :id num))
-                        ]
-                    (is (= (set (db-read-all test-conn)) #{}) "Sanity check that db is empty. Must never fail.")
-                    (doseq [row (map rows order)] (add-security test-conn row))
-                    (is (= (set (db-read-all test-conn)) #{res1 res2 res3}))
-                    (is (= (set (db-read-date test-conn (date-time 2011))) #{}))
-                    (is (= (set (db-read-date test-conn (date-time 2012 2 1))) #{res1}))
-                    (is (= (set (db-read-date test-conn (date-time 2012 6 1))) #{res1 res2}))
-                    (is (= (set (db-read-date test-conn (date-time 2013 6 1))) #{res2 res3}))
-                    )))
+    ;; Insert security date for ACME 2012-1-1
+    ;; Add a new company also called ACME on 2012-5-1
+    ;; Rename first ACME to Silly corp on 2013-1-1
+    (let [rows [{:name "ACME corp"
+                 :isin "de1234567890" :date_added (date-time 2012 1 1)}
+                {:name "ACME corp"
+                 :isin "de1234567891" :date_added (date-time 2012 5 1)}
+                {:name "Silly corp (formerly ACME)"
+                 :isin "de1234567890" :date_added (date-time 2013 1 1)}]
+          [res1 res2 res3] (for [[row num] (map vector rows (map (zipmap order [1 2 3]) [0 1 2]))]
+                             (assoc row :date_added (to-string (row :date_added)) :id num))
+          ]
+      (is (= (set (db-read-all test-conn)) #{}) "Sanity check that db is empty. Must never fail.")
+      (doseq [row (map rows order)] (add-security test-conn row))
+      (is (= (set (db-read-all test-conn)) #{res1 res2 res3}))
+      (is (= (set (db-read-date test-conn (date-time 2011))) #{}))
+      (is (= (set (db-read-date test-conn (date-time 2012 2 1))) #{res1}))
+      (is (= (set (db-read-date test-conn (date-time 2012 6 1))) #{res1 res2}))
+      (is (= (set (db-read-date test-conn (date-time 2013 6 1))) #{res2 res3})))))

 (deftest query-date-snapshots-0-1-2 (mytest [0 1 2]))
 (deftest query-date-snapshots-0-2-1 (mytest [0 2 1]))


Stop thread-pool after test.

Stop thread-pool after test.

--- test/wonko/kafka/consume_test.clj
+++ test/wonko/kafka/consume_test.clj
@@ -43,4 +43,6 @@
         (is (= 1 (count @events)))

         (is (= "gauge" (-> @events first :metric-type)))
-        (is (= "second-metric" (-> @events first :metric-name)))))))
+        (is (= "second-metric" (-> @events first :metric-name)))
+
+        (sut/stop thread-pool)))))


(maint) reorder connection-states tests

(maint) reorder connection-states tests

Here we re-order the tests in connection-states-test so they match the order of
declaration of the tested functions in connection-states.

--- test/puppetlabs/cthun/connection_states_test.clj
+++ test/puppetlabs/cthun/connection_states_test.clj
@@ -12,12 +12,20 @@
 (def logged-in?  #'puppetlabs.cthun.connection-states/logged-in?)
 (def login-message?  #'puppetlabs.cthun.connection-states/login-message?)

-(def websocket {"localhost" {"test" {"1" "ws1" "2" "ws2"}}})
-
-
 (deftest make-endpoint-string-test
   (testing "It creates a correct endpoint string"
     (is (= "cth://localhost/controller" (make-endpoint-string "localhost" "controller")))))
+
+(deftest websocket-of-endpoint-test
+  (reset! endpoint-map {"cth://bill/agent" "ws1"
+                        "cth://bob/agent" "ws2"})
+  (testing "it finds a single websocket explictly"
+    (is (= "ws1"
+           (websocket-of-endpoint "cth://bill/agent"))))
+  (testing "it finds nothing by wildcard"
+    (is (not (websocket-of-endpoint "cth://*/agent"))))
+  (testing "it finds nothing when it's not there"
+    (is (not (websocket-of-endpoint "cth://bob/nonsuch")))))

 (deftest new-socket-test
   (testing "It returns a map that matches represents a new socket"
@@ -27,6 +35,35 @@
       (is (= (:status socket) "connected"))
       (is (= nil (:endpoint socket)))
       (is (not= nil (ks/datetime? (:created-at socket)))))))
+
+(deftest logged-in?-test
+    (testing "It returns true if the websocket is logged in"
+      (swap! connection-map assoc "ws" {:status "ready"})
+      (is (= (logged-in? "localhost" "ws") true)))
+    (testing "It returns false if the websocket is not logged in"
+      (swap! connection-map assoc "ws" {:status "connected"})
+      (is (= false (logged-in? "localhost" "ws")))))
+
+
+(deftest login-message?-test
+  (testing "It returns true when passed a login type messge"
+    (is (= true (login-message? {:endpoints ["cth://server"] :data_schema "http://puppetlabs.com/loginschema"}))))
+  (testing "It returns false when passed a message of an unknown type"
+    (is (= false (login-message? {:endpoints ["cth://server"] :data_schema "http://puppetlabs.com/kennylogginsschema"}))))
+  (testing "It returns false when passed a message not aimed to the server target"
+    (is (= false (login-message? {:endpoints ["cth://otherserver"] :data_schema "http://puppetlabs.com/loginschema"})))))
+
+(deftest add-connection-test
+  (testing "It should add a connection to the connection map"
+    (add-connection "localhost" "ws")
+    (is (= (get-in @connection-map ["ws" :status]) "connected"))))
+
+(deftest remove-connection-test
+  (reset! connection-map {})
+  (testing "It should remove a connection from the connection map"
+    (add-connection "localhost" "ws")
+    (remove-connection "localhost" "ws")
+    (is (= {} @connection-map))))

 (deftest process-login-message-test
   (with-redefs [puppetlabs.cthun.validation/validate-login-data (fn [data] true)
@@ -60,51 +97,12 @@
         (process-login-message "localhost" "ws" login-message))
       (is (not (process-login-message "localhost" "ws" login-message))))))

-(deftest websocket-of-endpoint-test
-  (reset! endpoint-map {"cth://bill/agent" "ws1"
-                        "cth://bob/agent" "ws2"})
-  (testing "it finds a single websocket explictly"
-    (is (= "ws1"
-           (websocket-of-endpoint "cth://bill/agent"))))
-  (testing "it finds nothing by wildcard"
-    (is (not (websocket-of-endpoint "cth://*/agent"))))
-  (testing "it finds nothing when it's not there"
-    (is (not (websocket-of-endpoint "cth://bob/nonsuch")))))
-
 (deftest process-server-message-test
   (with-redefs [puppetlabs.cthun.connection-states/process-login-message (fn [host ws message-body] true)]
     (testing "It should identify a login message from the data schema"
       (is (= (process-server-message "localhost" "w" {:data_schema "http://puppetlabs.com/loginschema"}) true)))
     (testing "It should not process an unkown type of server message"
       (is (= (process-server-message "localhost" "w" {:data_schema "http://puppetlabs.com"}) nil)))))
-
-(deftest logged-in?-test
-    (testing "It returns true if the websocket is logged in"
-      (swap! connection-map assoc "ws" {:status "ready"})
-      (is (= (logged-in? "localhost" "ws") true)))
-    (testing "It returns false if the websocket is not logged in"
-      (swap! connection-map assoc "ws" {:status "connected"})
-      (is (= false (logged-in? "localhost" "ws")))))
-
-(deftest login-message?-test
-  (testing "It returns true when passed a login type messge"
-    (is (= true (login-message? {:endpoints ["cth://server"] :data_schema "http://puppetlabs.com/loginschema"}))))
-  (testing "It returns false when passed a message of an unknown type"
-    (is (= false (login-message? {:endpoints ["cth://server"] :data_schema "http://puppetlabs.com/kennylogginsschema"}))))
-  (testing "It returns false when passed a message not aimed to the server target"
-    (is (= false (login-message? {:endpoints ["cth://otherserver"] :data_schema "http://puppetlabs.com/loginschema"})))))
-
-(deftest add-connection-test
-  (testing "It should add a connection to the connection map"
-    (add-connection "localhost" "ws")
-    (is (= (get-in @connection-map ["ws" :status]) "connected"))))
-
-(deftest remove-connection-test
-  (reset! connection-map {})
-  (testing "It should remove a connection from the connection map"
-    (add-connection "localhost" "ws")
-    (remove-connection "localhost" "ws")
-    (is (= {} @connection-map))))

 (deftest process-message-test
   (testing "It will ignore messages until the the client is logged in"


Fix typo in listen! docs

Fix typo in listen! docs

--- src/datascript/core.cljc
+++ src/datascript/core.cljc
@@ -555,7 +555,7 @@
   "Listen for changes on the given connection. Whenever a transaction is applied to the database via [[transact!]], the callback is called
    with the transaction report. `key` is any opaque unique value.

-   Idempotent. Calling [[listen!]] with the same twice will override old callback with the new value.
+   Idempotent. Calling [[listen!]] with the same key twice will override old callback with the new value.

    Returns the key under which this listener is registered. See also [[unlisten!]]."
   ([conn callback] (listen! conn (rand) callback))


working on b+tree

working on b+tree

--- sample/src/sample/btree.clj
+++ sample/src/sample/btree.clj
@@ -40,6 +40,32 @@

+#_(defn- binary-tree-leafnode? [{:keys [l r] :as this}]
+  (and (nil? l) (nil? r)))
+
+#_(defrecord Binary+TreeNode [k* v* l r]
+
+  TreeModify
+
+  (add [this k v]
+    (let [[l r] (if (<= (compare k k*) 0)
+                  [(if-not (nil? l)
+                     (add l k v)
+                     (Binary+TreeNode. k v nil nil))
+                   r]
+                  [l
+                   (if-not (nil? r)
+                     (add r k v)
+                     (Binary+TreeNode. k v nil nil))])]
+      (BinaryTreeNode. k* )))
+
+  TreeSearch
+
+  (search [this k]
+    ))
+
+
+
 #_(defrecord B+TreeChildren [children-map largest-child]

   TreeModify
@@ -60,31 +86,42 @@

-#_(defrecord B+Tree [b size key-fn children root? leaf?]
+(defrecord B+Tree [b size children leaf?]

   TreeModify

-  (add* [this v]
-    (let [k (key-fn v)]
+  (add [this k v]
+    (letfn [(new-leafnode []
+              (->B+Tree b 0 (rm/range-map :find-ceiling nil) true))
+            (new-interiornode []
+              (->B+Tree b 0 (rm/range-map :find-ceiling (->B+Tree b 0 (rm/range-map :find-ceiling nil))) false))
+            (balance [{:keys [children] :as this}]
+              (if (< (:size children) b)
+                this
+                ))]
+
       (if leaf?
-        (->B+Tree b (inc size) key-fn (assoc children k v) root? leaf?)
-        (if-let [child (get children k)]
-          (add child v)
-          (->B+Tree b (inc size) key-fn (assoc children k v) root? leaf?)))))
+        (if (< size b)
+          [(->B+Tree b (inc size) (assoc children k v) leaf?)]
+          (let [children (assoc children k v)
+                size (inc size)
+                [ks1 ks2] (partition-all (-> size (/ 2) Math/ceil int) (keys children))
+                [cs1 cs2] [(select-keys children ks1) (select-keys children ks2)]]
+            [(->B+Tree b (count cs1) cs1 leaf?)
+             (->B+Tree b (count cs2) cs2 leaf?)]))
+
+        (let [child (get children k)]
+          (add child k v)
+          #_(->B+Tree b (inc size) (assoc children k v) leaf?)))))

   TreeSearch

-  (search* [this k]
+  (search [this k]
     (when-let [child (get children k)]
       (if (satisfies? TreeSearch child)
         (search child k)
         child))))

-#_(defn b+tree [b key-fn & {:keys [root? leaf?]
-                          :or {root? true
-                               leaf? true}}]
-  (let [children (if leaf?
-                   {}
-                   (rm/range-map :find-ceiling))]
-    (->B+Tree b 0 key-fn children root? leaf?)))
+(defn b+tree [b]
+  (->B+Tree b 0 (rm/range-map :find-ceiling nil) true))


indenting license

indenting license

--- src/digital/provider.clj
+++ src/digital/provider.clj
@@ -1,13 +1,13 @@
 (comment
-      Celestial, Copyright 2012 Ronen Narkis, narkisr.com
-      Licensed under the Apache License,
-      Version 2.0  (the "License") you may not use this file except in compliance with the License.
-      You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
-      Unless required by applicable law or agreed to in writing, software
-      distributed under the License is distributed on an "AS IS" BASIS,
-      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-      See the License for the specific language governing permissions and
-      limitations under the License.)
+  Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+  Licensed under the Apache License,
+  Version 2.0  (the "License") you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.)

 (ns digital.provider
    "Digital ocean provider"


clarify http action mapping

clarify http action mapping

--- ssclj/jar/src/com/sixsq/slipstream/ssclj/resources/common/resource_protocols.clj
+++ ssclj/jar/src/com/sixsq/slipstream/ssclj/resources/common/resource_protocols.clj
@@ -93,6 +93,11 @@
   ;; which uses a data representation for routes, may be better for the case
   ;; where the routes are returned by a function rather than pulled from a var.
   ;;
+  ;; The routes provide the concrete mapping between the HTTP request actions and
+  ;; the SCRUD functions.  Generally, the HTTP actions are expected to work as in
+  ;; any standard REST API. See Section 4 of the CIMI specification for detailed
+  ;; information about the expected mapping.
+  ;;
   (routes [_]
     "Provides the list of (compojure) routes for this resource.")

@@ -111,10 +116,16 @@
   ;; with a map containing a relevant message, HTTP status code, and the resource
   ;; that was concerned.
   ;;
+  ;; Generally, the functions map to the HTTP actions as expected for REST APIs.
+  ;; See Section 4 of the CIMI specification for the common, expected behavior
+  ;; for all CIMI resources.  Details for a specific resource can be found
+  ;; in the section describing the schema of that resource.
+  ;;
   (query [_ request]
     "Uses the information in the given ring request to return a list of
      resources satisfying the specified criteria. This may be limited with the
-     CIMI range parameters or CIMI filters. Associated with HTTP POST requests.")
+     CIMI range parameters or CIMI filters. Associated with HTTP GET requests
+     on the collection URL.")
   (add [_ request]
     "Takes the information in the given ring request and creates a new
      instance of this resource. If the resource already exists, then this
@@ -127,7 +138,7 @@
     "Retrieves a given resource instance based on the information in the ring
      request. This is a convenience method that will extract the resource ID
      from the request and call the retrieve-by-id function. Associated with
-     HTTP GET requests.")
+     HTTP GET requests on the resource URL.")
   (edit [_ request]
     "Updates a particular resource instance identified through the request
      with the updated information in the request. If the resource does not
@@ -137,7 +148,7 @@
     "Deletes a particular resource instance identified by the request. If the
      resource does not exist, then the function must throw an exception as well
      as when the resource could not be deleted (e.g. because of lack of
-     authorization).")
+     authorization).  Associated with HTTP DELETE requests.")

   ;;
   ;; CIMI allows resources to have specialized actions in addition to the standard


CMR-1419: Fixed indentation

CMR-1419: Fixed indentation

--- system-int-test/test/cmr/system_int_test/search/concept_metadata_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/concept_metadata_search_test.clj
@@ -33,14 +33,14 @@
   [format-key umm response]
   (let [metadata-xml (:body response)
         metadata-umm (-> (umm-c/parse-collection metadata-xml)
-                             ;; parser prepends "gov.nasa.echo:" to entry-title for some reason
-                             (update-in [:entry-title]
-                                        (fn [entry-title]
-                                          (str/replace entry-title "gov.nasa.echo:" "")))
-                             ;; remove default added by parser
-                             (assoc :metadata-language nil)
-                             ;; remove default added by parser
-                             (assoc :use-constraints nil))]
+                         ;; parser prepends "gov.nasa.echo:" to entry-title for some reason
+                         (update-in [:entry-title]
+                                    (fn [entry-title]
+                                      (str/replace entry-title "gov.nasa.echo:" "")))
+                         ;; remove default added by parser
+                         (assoc :metadata-language nil)
+                         ;; remove default added by parser
+                         (assoc :use-constraints nil))]
     (is (= umm metadata-umm))))

 (defmethod result-matches? :default
@@ -153,11 +153,11 @@

       (testing "Requests for tombstone revision returns a 400 error"
         (let [{:keys [status errors] :as response} (search/get-search-failure-xml-data
-                                        (search/find-concept-metadata-by-id-and-revision
-                                                  (:concept-id coll2-1)
-                                                  2
-                                                  {:headers {transmit-config/token-header
-                                                             user1-token}}))]
+                                                     (search/find-concept-metadata-by-id-and-revision
+                                                       (:concept-id coll2-1)
+                                                       2
+                                                       {:headers {transmit-config/token-header
+                                                                  user1-token}}))]
           (is (= 400 status))
           (is (= #{"Deleted concepts do not contain metadata."}
                  (set errors)))))
@@ -165,10 +165,10 @@
       (testing "Unknown concept-id returns a 404 error"
         (let [{:keys [status errors]} (search/get-search-failure-xml-data
                                         [(search/find-concept-metadata-by-id-and-revision
-                                                  "C1234-PROV1"
-                                                  1
-                                                  {:headers {transmit-config/token-header
-                                                             user1-token}})])]
+                                           "C1234-PROV1"
+                                           1
+                                           {:headers {transmit-config/token-header
+                                                      user1-token}})])]
           (is (= 404 status))
           (is (= #{"Concept with concept-id [C1234-PROV1] and revision-id [1] does not exist."}
                  (set errors)))))
@@ -176,10 +176,10 @@
       (testing "Known concept-id with unavailable revision-id returns a 404 error"
         (let [{:keys [status errors]} (search/get-search-failure-xml-data
                                         (search/find-concept-metadata-by-id-and-revision
-                                                  "C1200000000-PROV1"
-                                                  1000000
-                                                  {:headers {transmit-config/token-header
-                                                             user1-token}}))]
+                                          "C1200000000-PROV1"
+                                          1000000
+                                          {:headers {transmit-config/token-header
+                                                     user1-token}}))]
           (is (= 404 status))
           (is (= #{"Concept with concept-id [C1200000000-PROV1] and revision-id [1000000] does not exist."}
                  (set errors)))))
@@ -187,10 +187,10 @@
       (testing "Non-integer revision id returns a 422 error"
         (let [{:keys [status errors]} (search/get-search-failure-xml-data
                                         (search/find-concept-metadata-by-id-and-revision
-                                                  "C1200000000-PROV1"
-                                                  "FOO"
-                                                  {:headers {transmit-config/token-header
-                                                             user1-token}}))]
+                                          "C1200000000-PROV1"
+                                          "FOO"
+                                          {:headers {transmit-config/token-header
+                                                     user1-token}}))]
           (is (= 422 status))
           (is (= #{"Revision id [FOO] must be an integer greater than 0."}
                  (set errors)))))


Fix TTL in update query of Cassandra Ring Session

--- systems/ring-session-cassandra/src/containium/systems/ring_session_cassandra.clj
+++ systems/ring-session-cassandra/src/containium/systems/ring_session_cassandra.clj
@@ -97,7 +97,7 @@
             read-q (prepare cassandra "SELECT data FROM ring.sessions WHERE key = ?;")
             ;; TTL in the database queure is twice as what is configured, as unchanged session
             ;; data is only written once in TTL minutes to the database.
-            write-q (prepare cassandra (str "UPDATE ring.sessions USING TTL " (* 2 ttl-mins)
+            write-q (prepare cassandra (str "UPDATE ring.sessions USING TTL " (* 2 60 ttl-mins)
                                             " SET data = ? WHERE key = ?;"))
             remove-q (prepare cassandra "DELETE FROM ring.sessions WHERE key = ?;")]
         (println "Embedded Cassandra Ring session store started.")


fix mention references

fix mention references

--- src/ceres_collector/pipeline.clj
+++ src/ceres_collector/pipeline.clj
@@ -102,12 +102,12 @@
         aid (get-author-id user)
         hids (doall (map (fn [{:keys [text]}] (get-hashtag-id text)) (:hashtags entities)))
         url-ids (doall (map #(get-url-id (:expanded_url %) news?) (:urls entities)))
-        me-ids (doall (map #(get-author-id %) (:user_mentions entities)))
+        me-ids (doall (map #(get-author-id (assoc % :mention true)) (:user_mentions entities)))
         type (get-type tweet)]
     (when news?
       (doall (map #(d/store-reference % mid "source") url-ids)))
     (d/store-reference aid mid "pub")
-    (doall (map #(d/store-reference mid (assoc % :mention true) "mention") me-ids))
+    (doall (map #(d/store-reference mid % "mention") me-ids))
     (doall (map #(d/store-reference mid % "url") url-ids))
     (doall (map #(d/store-reference mid % "tag") hids))
     (case type


Use config helpers from clj-utils

Use config helpers from clj-utils

--- src/cider_ci/dispatcher/main.clj
+++ src/cider_ci/dispatcher/main.clj
@@ -11,7 +11,7 @@
     [cider-ci.dispatcher.task :as task]
     [cider-ci.dispatcher.trial :as trial]
     [cider-ci.dispatcher.web :as web]
-    [cider-ci.utils.config :as config]
+    [cider-ci.utils.config :as config :refer [get-db-spec]]
     [cider-ci.utils.http :as http]
     [cider-ci.utils.messaging :as messaging]
     [cider-ci.utils.map :refer [deep-merge]]
@@ -22,19 +22,12 @@
     [clojure.tools.logging :as logging]
     ))

-(defn get-db-spec []
-  (let [conf (config/get-config)]
-    (deep-merge
-      (or (-> conf :database ) {} )
-      (or (-> conf :services :dispatcher :database ) {} ))))
-
-
 (defn -main [& args]
   (with/logging
-    (config/initialize ["../config/config_default.yml" "./config/config_default.yml" "./config/config.yml"])
+    (config/initialize)
+    (rdbms/initialize (get-db-spec :dispatcher))
     (let [conf (config/get-config)]
       (nrepl/initialize (-> conf :services :dispatcher :nrepl))
-      (rdbms/initialize (get-db-spec))
       (messaging/initialize (:messaging conf))
       (http/initialize conf)
       (task/initialize)


change post-auth redirect

change post-auth redirect

--- src/clj/clj_money/web/server.clj
+++ src/clj/clj_money/web/server.clj
@@ -204,7 +204,8 @@
     handler
     {:workflows [(workflows/interactive-form)]
      :credential-fn (partial clj-money.models.users/authenticate (env :db))
-     :redirect-on-auth? false}))
+     :redirect-on-auth? "/apps"
+     :default-landing-uri "/apps"}))

 (defn- api?
   [{uri :uri}]


only card-init faceup agenda if it's a Public agenda

--- src/clj/game/core-installing.clj
+++ src/clj/game/core-installing.clj
@@ -153,8 +153,10 @@
                  (when (= install-state :rezzed)
                    (rez state side moved-card))
                  (when (= install-state :face-up)
-                   (card-init state side
-                              (assoc (get-card state moved-card) :rezzed true :seen true) false))
+                   (if (:install-state cdef)
+                     (card-init state side
+                                (assoc (get-card state moved-card) :rezzed true :seen true) false)
+                     (update! state side (assoc (get-card state moved-card) :rezzed true :seen true))))
                  (when-let [dre (:derezzed-events cdef)]
                    (when-not (:rezzed (get-card state moved-card))
                      (register-events state side dre moved-card))))))


reports/budget takes a budget or an id

reports/budget takes a budget or an id

--- src/clj_money/models/reports.clj
+++ src/clj_money/models/reports.clj
@@ -230,9 +230,11 @@

 (defn budget
   "Returns a budget report"
-  [storage-spec budget-id as-of]
+  [storage-spec budget-or-id as-of]
   (with-storage [s storage-spec]
-    (let [budget (budgets/find-by-id s budget-id)
+    (let [budget (if (map? budget-or-id)
+                   budget-or-id
+                   (budgets/find-by-id s budget-or-id))
           period-count (+ 1 (budgets/period-containing budget as-of))
           items (->> (accounts/select-by-entity-id s
                                                    (:entity-id budget)


Clear completed in todomvc

Clear completed in todomvc

--- src/cljs/libx/todomvc/rules.cljs
+++ src/cljs/libx/todomvc/rules.cljs
@@ -74,6 +74,14 @@
   =>
   (trace "Responding to toggle done action " [(:id ?v) :todo/done (not (:old-val ?v))])
   (insert-unconditional! [(:id ?v) :todo/done (not (:old-val ?v))]))
+
+(def-tuple-rule handle-clear-completed-action
+  {:group :action}
+  [[_ :ui/clear-completed-action]]
+  [[?e :todo/done true]]
+  [?done-entity <- (acc/all) :from [?e :all]]
+  =>
+  (retract! ?done-entity))

 ;; Calculations
 (deflogical [?e :todo/visible :tag] :- [[_ :ui/visibility-filter :all]] [[?e :todo/title]])


Clean up

Clean up

--- src/cljs/whatishistory/core.cljs
+++ src/cljs/whatishistory/core.cljs
@@ -212,10 +212,9 @@
              :on-change (fn [evt]
                           (swap! app-atom assoc :email-confirm evt.target.value))}]
     [:span {:class "emailConfirm"}
-     (if (email-confirmed app-atom)
+     (if (email-confirmed app-atom)
        [:span {:class "check"} "\u2714"]
        [:span {:class "x-mark"} "\u2718"])]
-
     [:textarea {:class "defnInput twelve columns"
                 :placeholder "Please compose your definition here..."
                 :on-change (fn [evt]


fix autocompletion for jupyterlab (#59)

fix autocompletion for jupyterlab (#59)

* fix autocompletion for jupyterlab

* fix unclosed let block

--- src/clojupyter/misc/messages.clj
+++ src/clojupyter/misc/messages.clj
@@ -139,26 +139,15 @@
 (defn complete-reply-content
   [nrepl-comm
    message]
-  (let [find-symbol (fn [code]
-                      (loop
-                          [pairs (map-indexed vector (reverse code))
-                           matched ""
-                           delimiter  nil]
-                        (let [character (second (first pairs))
-                              delimiter-map {\( :code
-                                             \" :string
-                                             \% :magic}
-                              delimiter (get delimiter-map character)]
-                          (if (and (not-empty pairs)
-                                   (nil? delimiter))
-                            (recur (rest pairs) (str character matched) delimiter)
-                            [(last (str/split matched #" "))
-                             delimiter]))))
+  (let [delimiters #{\( \" \% \space}
         content (:content message)
         cursor_pos (:cursor_pos content)
         code (subs (:code content) 0 cursor_pos)
-        [sym sym_type] (find-symbol code)]
+        sym (as-> (reverse code) $
+                  (take-while #(not (contains? delimiters %)) $)
+                  (apply str (reverse $)))]
     {:matches (pnrepl/nrepl-complete nrepl-comm sym)
+     :metadata {:_jupyter_types_experimental []}
      :cursor_start (- cursor_pos (count sym))
      :cursor_end cursor_pos
      :status "ok"}))


Rearrange templates

Rearrange templates

--- src/clojure/nightmod/screens.clj
+++ src/clojure/nightmod/screens.clj
@@ -32,10 +32,10 @@
 (def ^:const tile-size 250)
 (def ^:const col-count 3)

-(def templates ["arcade"
-                "platformer"
+(def templates ["platformer"
                 "orthogonal"
                 "isometric"
+                "arcade"
                 "barebones"
                 "download"])


bug fixed

bug fixed

--- src/adventure/core.clj
+++ src/adventure/core.clj
@@ -89,7 +89,7 @@
        inv (get-in adv [:inventory])]
    (if-let [dest (get-in the-map [curr-room :content obj])]
     (if (contains? inv dest) (do (println "You already have the item") adv)
-        (update-in adv [:inventory] #(assoc % dest)))
+        (update-in adv [:inventory] #(conj % dest)))
      (do (println "There is no such item. ")
         adv) )))
 (defn dropItem [obj adv]
@@ -103,11 +103,15 @@
 (defn print_content [adv]
     (let [location (adv :location)]
     (do (print (str (-> the-map location :content)))adv)))
+
+(defn tp [location adv]
+    )
+
 (defn respond [inst adv]
   (if (contains? inst 1)
   (match [(inst 0)]
           [:pick] (pick (inst 1) adv)
-          [:dropItem] (drop (inst 1) adv)
+          [:dropItem] (dropItem (inst 1) adv)
           [_](do
               (println (str "I'm sorry Dave. I cannot allow you to do that."))
               adv)


Add flag to launch browser on starting web server.

--- src/afterglow/core.clj
+++ src/afterglow/core.clj
@@ -103,15 +103,18 @@
   (System/exit status))

 (defn start-web-server
-  "Start the embedded web UI server."
-  [port]
+  "Start the embedded web UI server on the specified port. If a truthy
+  value is supplied for browser, opens a web browser window on the
+  newly launched server."
+  [port browser]
   (when @web-server (throw (IllegalStateException. "Web UI server is already running.")))
   (reset! web-server
           (http-kit/run-server
            app
            {:port port}))
   ;;Start the expired session cleanup job
-  (reset! session-cleaner (session/start-cleanup-job!)))
+  (reset! session-cleaner (session/start-cleanup-job!))
+  (when browser (browse/browse-url (str "http://localhost:" port))))

 (defn start-nrepl
   "Start a network REPL for debugging or remote control."
@@ -147,8 +150,7 @@
     (init-logging)
     (.addShutdownHook (Runtime/getRuntime) (Thread. stop-servers))
     (clojure.pprint/pprint options)
-    (start-web-server (:web-port options))
+    (start-web-server (:web-port options) true)
     (timbre/info (str "\n-=[ afterglow started successfully"
                       (when (env :dev) "using the development profile") "]=-"))
-    (timbre/info "Web UI server on port:" (:web-port options))
-    (browse/browse-url (str "http://localhost:" (:web-port options)))))
+    (timbre/info "Web UI server on port:" (:web-port options))))


Delete dead code

Delete dead code

--- src-cljs/frontend/components/aside.cljs
+++ src-cljs/frontend/components/aside.cljs
@@ -17,58 +17,6 @@
             [frontend.utils.launchdarkly :as ld]
             [om.core :as om :include-macros true])
   (:require-macros [frontend.utils :refer [html]]))
-
-(defn status-ico-name [build]
-  (case (:status build)
-    "running" :busy-light
-
-    "success" :pass-light
-    "fixed"   :pass-light
-
-    "failed"   :fail-light
-    "timedout" :fail-light
-
-    "queued"      :hold-light
-    "not_running" :hold-light
-    "retried"     :hold-light
-    "scheduled"   :hold-light
-
-    "canceled"            :stop-light
-    "no_tests"            :stop-light
-    "not_run"             :stop-light
-    "infrastructure_fail" :stop-light
-    "killed"              :stop-light
-
-    :none-light))
-
-(defn sidebar-build [build {:keys [vcs_type org repo branch latest?]}]
-  [:a.status {:class (when latest? "latest")
-              :href (routes/v1-build-path vcs_type org repo nil (:build_num build))
-              :title (str (build-model/status-words build) ": " (:build_num build))}
-   (common/ico (status-ico-name build))])
-
-(defn branch [data owner]
-  (reify
-    om/IDisplayName (display-name [_] "Aside Branch Activity")
-    om/IRender
-    (render [_]
-      (let [{:keys [org repo branch-data vcs_type]} data
-            [name-kw branch-builds] branch-data
-            display-builds (take-last 5 (sort-by :build_num (concat (:running_builds branch-builds)
-                                                                    (:recent_builds branch-builds))))]
-        (html
-         [:li
-          [:div.branch
-           {:role "button"}
-           [:a {:href (routes/v1-dashboard-path {:org org
-                                                 :repo repo
-                                                 :branch (name name-kw)
-                                                 :vcs_type vcs_type})
-                :title (utils/display-branch name-kw)}
-            (-> name-kw utils/display-branch (utils/trim-middle 23))]]
-          [:div.statuses {:role "button"}
-           (for [build display-builds]
-             (sidebar-build build {:vcs_type vcs_type :org org :repo repo :branch (name name-kw)}))]])))))

 (defn project-settings-link [{:keys [project]} owner]
   (when (and (project-model/can-write-settings? project))


small performance improvements

small performance improvements


fix titles for pricing ctas

fix titles for pricing ctas

--- src-cljs/frontend/components/outer.cljs
+++ src-cljs/frontend/components/outer.cljs
@@ -252,7 +252,7 @@
              [:div.price-foot
               [:a.price-button
                {:href "/trial/solo"
-                :title "Try it free while we gather feedback."
+                :title "Start your free, 2 week trial."
                 :role "button"}
                "Start trial"]]]
             [:section.price-divide.left
@@ -269,7 +269,7 @@
              [:div.price-foot
               [:a.price-button
                {:href "/trial/team"
-                :title "Start trial"
+                :title "Start your free, 2 week trial."
                 :role "button"}
                "Start trial"]]]
             [:section.price-divide.right


Default 404 page

Default 404 page

--- src/asciinema/yada.clj
+++ src/asciinema/yada.clj
@@ -1,5 +1,15 @@
 (ns asciinema.yada
-  (:require [yada.yada :as yada]))
+  (:require [clojure.java.io :as io]
+            [yada.yada :as yada]))
+
+(defn not-found-response [ctx]
+  (case (yada/content-type ctx)
+    "text/html" (io/input-stream (io/resource "asciinema/errors/404.html"))
+    "Not found"))

 (defn resource [model]
-  (yada/resource model))
+  (-> model
+      (update-in [:responses 404] #(or %
+                                       {:produces #{"text/html" "text/plain"}
+                                        :response not-found-response}))
+      yada/resource))


made first page of glossary visible (untested)

--- src/distillery/view/glossary.clj
+++ src/distillery/view/glossary.clj
@@ -1,38 +1,54 @@
-(ns distillery.view.glossary
-  (:require [distillery.view.html :refer :all]))
-
-(defn- render-glossary-word
-  "Creates the HTML for a glossary entry."
-  [{:keys [id lexical-form occurrences] :as word}]
-  (list-item (jslink (str "word('" id "')") lexical-form)))
-
-(defn- glossary-partition-id
-  "Creates an identifier for a glossary partition by its letter."
-  [letter]
-  (if (= \? letter) "SYM" (str letter)))
-
-(defn- render-glossary-navigation
-  "Creates the HTML for the navigation bar of a glossary."
-  [pindex]
-  (let [letters (map char (concat (range 65 91) [63]))]
-    (div "glossary-nav"
-      (map (fn [l]
-             (if (contains? pindex l)
-               (jslink (str "glossary('" (glossary-partition-id l) "')") (str l "  "))
-               (str l "  ")))
-           letters))))
-
-(defn- render-glossary-partition
-  "Creates the HTML for a partion of a glossary."
-  [[letter index-part]]
-  {:tag :div
-   :attrs {:id (str "glossary-part-" (glossary-partition-id letter)) :class "glossary-part"}
-   :content [(ulist "glossary" (map render-glossary-word (vals index-part)))]})
-
-(defn render-glossary
-  "Create the HTML for a glossary."
-  [pindex]
-  (vec (cons
-        (render-glossary-navigation pindex)
-        (map render-glossary-partition pindex))))
-
+(ns distillery.view.glossary
+  (:require [distillery.view.html :refer :all]))
+
+(defn- render-glossary-word
+  "Creates the HTML for a glossary entry."
+  [{:keys [id lexical-form occurrences] :as word}]
+  (list-item (jslink (str "word('" id "')") lexical-form)))
+
+(defn- glossary-partition-id
+  "Creates an identifier for a glossary partition by its letter."
+  [letter]
+  (if (= \? letter) "SYM" (str letter)))
+
+(defn- letter-list
+  []
+  (map char (concat (range 65 91) [63])))
+
+(defn- render-glossary-navigation
+  "Creates the HTML for the navigation bar of a glossary."
+  [pindex]
+  (let [letters (letter-list)]
+    (div "glossary-nav"
+      (map (fn [l]
+             (if (contains? pindex l)
+               (jslink (str "glossary('" (glossary-partition-id l) "')") (str l "  "))
+               (str l "  ")))
+           letters))))
+
+(defn- first-letter
+  [pindex]
+  (let [index-letters (map first pindex)]
+    (->> (letter-list)
+         (map (fn [l] (map #(== % l) index-letters)))
+         first)))
+
+(defn- render-glossary-partition
+  "Creates the HTML for a partion of a glossary."
+  [first-letter [letter index-part]]
+  (let [is-first-letter (== letter first-letter)]
+    {:tag :div
+     :attrs {:id (str "glossary-part-" (glossary-partition-id letter))
+             :class "glossary-part"
+             :display (if is-first-letter "inherit" "none")}
+     :content [(ulist "glossary" (map render-glossary-word (vals index-part)))]}))
+
+(defn render-glossary
+  "Create the HTML for a glossary."
+  [pindex]
+  (let [fl (first-letter pindex)]
+    (vec (cons
+          (render-glossary-navigation pindex)
+          (map (partial render-glossary-partition fl) pindex)))))
+
+


clean db initialization up

clean db initialization up

make better reuse of existing helper functions
for defining the db map and remove some unused comment
code

--- src/block_chain/db.clj
+++ src/block_chain/db.clj
@@ -36,24 +36,14 @@
    :transaction-pool #{}
    :transactions {}})

-#_(str "/tmp" #_(env :db-dir) "/" "clarke-db" label)
 (defn make-db [path] (db-map (conn path)))

-;; (defonce empty-db  (make-db "/tmp/clarke-db-empty"))
-(def empty-db {:blocks {}
-               :default-key wallet/keypair
-               :children {}
-               :chains {}
-               :peers #{}
-               :transaction-pool #{}
-               :transactions {}})
+(defonce empty-db (make-db (env :db-path)))

-;; (defonce initial-db (-> (make-db "/tmp/clarke-db")
-;;                         (q/add-block genesis-block)))
-(def initial-db empty-db)
+(defonce initial-db (-> empty-db
+                        (q/add-block genesis-block)))

-;; (def db (atom initial-db))
-(def db (atom {}))
+(def db (atom initial-db))

 (defn wipe-db! [ldb-conn]
   (apply (partial ldb/delete ldb-conn)


I'm not proud of this routing. But it works.

--- markov-clj/src/markov_clj/server.clj
+++ markov-clj/src/markov_clj/server.clj
@@ -11,9 +11,13 @@
 (defn generate-commit-response [req])

 (cmpj/defroutes handler
-  (cmpj/GET "/" [] resp/file-response "/index.html" {:root "/public"})
+  (cmpj/GET "/" [] (resp/file-response "/index.html" {:root "public"}))
+  (cmpj/GET "/git" [] (resp/file-response "/git.html" {:root "public"}))
+  (cmpj/GET "/css/cover.css" [] (resp/file-response "/css/cover.css" {:root "public"}))
+  (cmpj/GET "/css/commits.css" [] (resp/file-response "/css/commits.css" {:root "public"}))
+  (cmpj/GET "/js/main.js" [] (resp/file-response "js/main.js" {:root "public"}))
   (cmpj/POST "/commits" [] generate-commit-response)
-  (route/resources "/")
+  (route/resources "/" {:root "public"})
   (route/not-found "
Page not found
"))

 (defn logging [chain] (fn [req]


Remove some dead code

Remove some dead code

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -40,7 +40,6 @@
             [clojure.set :as set]
             [io.aviso.tracker :as t]
             [io.aviso.rook.internals :as internals]
-            [io.aviso.rook.schema-validation :as sv]
             [clojure.string :as str]))

 (def ^:private default-mappings
@@ -242,20 +241,16 @@
                                (filter keyword? pathvec))
             context (:context (meta pathvec))
             arglist (first (:arglists metadata))
-            non-route-params (remove (set route-params) arglist)
             arg-resolvers (merge
                             extra-arg-resolvers
                             (binding [*ns* ns]
                               (eval (:arg-resolvers metadata))))
-            schema (:schema metadata)
             handler (cond->
                       {:middleware-sym   mw-sym
                        :route-params     route-params
-                       :non-route-params non-route-params
                        :verb-fn-sym      verb-fn-sym
                        :arglist          arglist
                        :arg-resolvers    arg-resolvers
-                       :schema           schema
                        :sync?            sync?
                        :metadata         metadata}
                       context
@@ -471,8 +466,8 @@
                                               apply-middleware-async
                                               apply-middleware-sync)

-                           {:keys [middleware-sym route-params non-route-params
-                                   verb-fn-sym arglist arg-resolvers schema sync?
+                           {:keys [middleware-sym route-params
+                                   verb-fn-sym arglist arg-resolvers sync?
                                    metadata context]}
                            (get handlers handler-sym)


Refresh U/I on time-travel.

Refresh U/I on time-travel.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -35,6 +35,13 @@
                      :reqs    {}   ; { opaque-ts => [req, [[reply-ts reply] ...] }.
                      :net     {}}) ; The :loop-state of the net-actx.
   (reset! prog-evts []))
+
+; ------------------------------------------------
+
+(defn render-net [target-el-id net prev-addrs]
+  (let [[addrs h] (cbfg.world.net/render-net-html net prev-addrs)]
+    (set-el-innerHTML target-el-id (apply str (flatten h)))
+    addrs))

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

@@ -99,9 +106,8 @@
 ; -------------------------------------------------------------------

 (defn on-prog-frame-focus [prog-frame]
-  (let [[addrs h] (cbfg.world.net/render-net-html (:net prog-frame) {})]
-    (set-el-innerHTML "net-hover" (apply str (flatten h)))
-    (.add gdom/classes (gdom/getElement "net-container") "hover")))
+  (render-net "net-hover" (:net prog-frame) {})
+  (.add gdom/classes (gdom/getElement "net-container") "hover"))

 (defn on-prog-frame-blur []
   (set-el-innerHTML "net-hover" "")
@@ -113,7 +119,10 @@
     (ago-restore (actx-agw (:world @prog-base)) ago-ss)
     (reset! prog-curr prog-frame)
     (swap! prog-evts #(vec (filter (fn [[s & _]] (<= s ts)) %)))
-    (swap! prog-ss #(into {} (filter (fn [[s _]] (<= s ts)) %)))))
+    (swap! prog-ss #(into {} (filter (fn [[s _]] (<= s ts)) %)))
+    (set-el-innerHTML "reqs" (render-reqs-html (:reqs prog-frame)))
+    (render-net "net-main" (:net prog-frame) {})
+    (on-prog-frame-blur)))

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

@@ -211,9 +220,7 @@
                      (when-let [net (get-in vis [:actxs @net-actx :loop-state])]
                        (when (not= net (:net @prog-curr))
                          (swap! prog-curr #(assoc % :net net))
-                         (let [[addrs h] (cbfg.world.net/render-net-html net @net-addrs)]
-                           (reset! net-addrs addrs)
-                           (set-el-innerHTML "net-main" (apply str (flatten h)))))))]
+                         (swap! net-addrs #(render-net "net-main" net %)))))]
         (prog-init world)
         (cbfg.vis/process-events vis event-delay cbfg.vis/vis-event-handlers
                                  event-ch step-ch event-run-ch)


fix missing argument error in thread-group-id

--- src/chat/server/db.clj
+++ src/chat/server/db.clj
@@ -507,7 +507,7 @@

 (defn thread-group-id
   [thread-id]
-  (some-> (d/pull (d/db *conn*) [{:thread/group [:group/id]}])
+  (some-> (d/pull (d/db *conn*) [{:thread/group [:group/id]}] [:thread/id thread-id])
           :thread/group :group/id))

 (defn thread-add-last-open-at [thread user-id]


Update tile-spec geometry calculation.

Update tile-spec geometry calculation.

The shift_x and shift_y value only took into account a pixel shift because source data was previously guaranteed to have upper-left/lower-right points that aligned to a grid that was an even multiple of tile sizes.

Now that sources conform to a grid that is not an even multiple of the tile-size (in the projection coordinate system) the value stored in shift_x and shift_y must be changed.

--- src/lcmap/aardvark/tile_spec.clj
+++ src/lcmap/aardvark/tile_spec.clj
@@ -85,8 +85,8 @@
           pixel_y (int py)
           tile_x  (int (* px dx))
           tile_y  (int (* py dy))
-          shift_x (int (mod rx pixel_x))
-          shift_y (int (mod ry pixel_y))]
+          shift_x (int (mod rx tile_x))
+          shift_y (int (mod ry tile_y))]
       {:wkt proj
        :pixel_x pixel_x
        :pixel_y pixel_y


Corrected -conatins-key? for PersistentHashMap

--- src/main/cljs/lean_map/core.cljs
+++ src/main/cljs/lean_map/core.cljs
@@ -233,12 +233,9 @@
         (PersistentHashMap. meta (if ^boolean (.-added changed?) (inc cnt) cnt) new-root  nil))))

   (-contains-key? [coll k]
-    #_(cond (nil? k)    has-nil?
-          (nil? root) false
-          :else       (not (identical? (.inode-lookup root 0 (hash k) k lookup-sentinel)
-                                       lookup-sentinel))))
-
-
+    (if (nil? root)
+      false
+      (not (identical? (.inode-lookup root 0 (hash k) k lookup-sentinel) lookup-sentinel))))

   IEditableCollection
   (-as-transient [coll]


do interruptions/rework by week of year

do interruptions/rework by week of year

--- src/miq/core.clj
+++ src/miq/core.clj
@@ -3,8 +3,17 @@
 (ns json.core
   (:require [clojure.data.json :as json])
   )
+(import '(java.util Calendar))
+
+
+

 (use '(incanter core charts stats ))
+
+; define some constants for column ids
+(def in-progress-column-id "53067ded5264b32b0bf1dbfa")
+(def next-column-id "53067ded5264b32b0bf1dbf9")
+

 ; map a .json file into a hash map
@@ -13,6 +22,11 @@
   (json/read-str (slurp file-path) :key-fn keyword)
   )

+; get resource path
+(defn resource-path []
+  (let [current-directory (System/getProperty "user.dir")]
+    (if (.contains current-directory "/src") (str current-directory "/../../resources") (str current-directory "/resources"))
+    ))

 ; some date stuff
@@ -33,6 +47,16 @@
 (defn to-millis [trello-date]
   (.getTime (.parse  (java.text.SimpleDateFormat. "yyyy-MM-dd'T'HH:mm:ss.SSS") (remove-from-end trello-date "Z")))
   )
+
+(defn week-of-year-from-date
+  [date]
+	(let [cal (Calendar/getInstance)]
+		(.setTime cal date)
+		(.get cal Calendar/WEEK_OF_YEAR)))
+
+
+(defn week-of-year-from-trello [card]
+  (week-of-year-from-date(to-date (:date card ))))

@@ -136,13 +160,64 @@

-
-
-(def json-map (file-to-map "/Users/taylor/Desktop/cd.json"))
+(defn is-rework? [movement-c]
+  (and
+   (not= (list-before-id movement-c) next-column-id)
+   (= (list-after-id movement-c) in-progress-column-id)
+   )
+  )
+
+(defn is-interruption? [movement-c]
+  (and
+   (= (list-after-id movement-c) next-column-id)
+   (= (list-before-id movement-c) in-progress-column-id)
+   )
+  )
+
+
+; start of analyis
+
+(def file-path (str (resource-path) "/cd.json"))
+(def json-map (file-to-map file-path))
 (def movements (card-movement json-map))
+(count movements)
+(def reworks  (filter is-rework? movements))
+(count reworks)
+(def interruptions  (filter is-interruption? movements))
+(count interruptions)
+
+(first interruptions)
+(week-of-year-from-trello (last interruptions ))
+
+
+(def p (map week-of-year-from-trello interruptions))
+(view (histogram p :nbins 20 :x-label "week number" :title "interrupions by week") )
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+(def interruptions-by-person (group-by (fn[c] (:fullName (:memberCreator c)) ) interruptions))
+(count  interruptions-by-person)
+
+

 (def taylor-movements (filter (fn[c] (= (:fullName (:memberCreator c)) "taylor")) movements))
+
+
 (def dates (reverse(map (fn[c] (to-millis (:date c))) taylor-movements)))
+

 (def y (flatten(repeat  (count dates) '(0 1 0))))
  (comment
@@ -166,18 +241,13 @@
               seq-of-times)
   )

-(defn create-blank-buckets [list-of-milli-sec-data bucket-size]
-  (let
-    [min (last seq-of-times)
-     max (first seq-of-times)
-     list list-of-milli-sec-data
-     results {}
-     ]
-    (if (empty? list) results
-      (recur min max (rest list) )
-    )
-  )
-  )
-
-
- (bucketize dates 100000000)
+
+
+
+
+
+
+
+
+
+


Remove commented-out nml-str code

Remove commented-out nml-str code

--- src/nml/core.clj
+++ src/nml/core.clj
@@ -120,53 +120,6 @@
       (let [[nml key val] (first s)]
         (if (nil? val) (fail (str "No value supplied for key '" key "'")))
         (recur (nml-set m nml key val) (rest s))))))
-
-;;(defn- nml-str [x]
-;; (let [key (first x)
-;;       val (rest x)
-;;       cjoin #(string/join "," %)
-;;       delegate #(map nml-str %)
-;;       delegate_sorted (fn [val] (delegate (sort-by #(nml-name %) val)))
-;;       list2str #(strmap nml-str %)
-;;       strfirst #(nml-str (first %))
-;;       strlast #(nml-str (last %))]
-;;   (apply str (case key
-;;                    :s                     (string/join "\n" (delegate_sorted val))
-;;                    :array                 [(strfirst val) (strlast val)]
-;;                    :c                     (strfirst val)
-;;                    :comment               ""
-;;                    :complex               ["(" (cjoin (delegate val)) ")"]
-;;                    :dataref               (delegate val)
-;;                    :dec                   ["." (strlast val)]
-;;                    :exp                   [(first val) (strlast val)]
-;;                    :false                 "f"
-;;                    :filler                ""
-;;                    :int                   (delegate val)
-;;                    :junk                  ""
-;;                    :logical               (strfirst val)
-;;                    :name                  (map string/lower-case val)
-;;                    :nv_sequence           val ;;(string/join " " (delegate_sorted val))
-;;                    :nv_subsequence        val ;;[(strfirst val) "=" (strlast val)]
-;;                    :nv_subsequence_begin  val
-;;                    :nv_subsequence_end    val
-;;                    :nv_subsequence_sep    val
-;;                    :partref               (strfirst val)
-;;                    :r                     (strfirst val)
-;;                    :real                  (delegate val)
-;;                    :sect                  ["(" (list2str val) ")"]
-;;                    :sign                  val
-;;                    :star                  val
-;;                    :stmt                  ["&" (strfirst val) " " (list2str (rest val)) " /"]
-;;                    :stmt_end              val
-;;                    :string                val
-;;                    :true                  "t"
-;;                    :uint                  val
-;;                    :value                 (delegate val)
-;;                    :values                (cjoin (delegate val))
-;;                    :values_sep            val
-;;                    :ws                    ""
-;;                    :wsopt                 ""
-;;                    val))))

 ;; nml public defns


Support interpretation of the new value->literal/variable, variable->object/scalar parsing.

--- src/isla/interpreter.clj
+++ src/isla/interpreter.clj
@@ -59,25 +59,16 @@
       (nreturn (:ctx env) return-val))))

 (defmethod interpret :value [node env]
-  (let [sub-node (utils/extract node [:c 0])]
-    (if (= :identifier (:tag sub-node))
-      (let [ref (interpret sub-node env)]
-        {:ref ref :val (resolve- {:ref ref} env)})
-      {:val (interpret sub-node env)})))
+  (evaluate (utils/extract node [:c 0]) env))

-(defmethod interpret :literal [node env]
-  (interpret (utils/extract node [:c 0]) env))
 (defmulti evaluate (fn [node _] (:tag node)))

-(defmethod interpret :identifier [node _]
-  (utils/extract node [:c 0]))
 (defmethod evaluate :literal [node env]
   {:val (interpret (utils/extract node [:c 0]) env)})

 (defmethod evaluate :variable [node env]
   (evaluate (utils/extract node [:c 0]) env))

-(defmethod interpret :assignee [node _]
 (defmethod evaluate :scalar [node env]
   (let [ref (interpret (utils/extract node [:c 0]) env)]
     {:ref ref :val (resolve- {:ref ref} env)}))
@@ -88,6 +79,8 @@
     {:ref [object-identifier attribute-identifier] ;; not used now, but won't work if used
      :val (get (resolve- {:ref object-identifier} env)
                attribute-identifier)}))
+
+(defmethod interpret :identifier [node _]
   (utils/extract node [:c 0]))

 (defmethod interpret :integer [node _]


use authenticated post url for notification link

--- src/oc/email/content.clj
+++ src/oc/email/content.clj
@@ -558,6 +558,8 @@
   (let [notification (:notification msg)
         content (:content notification)
         org (:org msg)
+        board (:board notification)
+        board-slug (:slug board)
         logo-url (:logo-url org)
         logo? (not (s/blank? logo-url))
         org-name (:name org)
@@ -576,7 +578,7 @@
         notification-author (:author notification)
         notification-author-name (:name notification-author)
         notification-author-url (fix-avatar-url (:avatar-url notification-author))
-        secure-uuid (:secure-uuid notification)
+        uuid (:uuid content)
         origin-url config/web-url
         token-claims {:org-id (:org-id notification)
                       :secure-uuid secure-uuid
@@ -589,8 +591,9 @@
         id-token (jwt/generate-id-token token-claims config/passphrase)
         entry-url (s/join "/" [origin-url
                                org-slug
+                               board-slug
                                "post"
-                               secure-uuid
+                               uuid
                                (str "?id=" id-token)])
         button-cta (if (or (not mention?) comment?)
                     "view_comment"


aggregations assembled

aggregations assembled

--- src/ophion/aggregate.clj
+++ src/ophion/aggregate.clj
@@ -247,40 +247,50 @@
     [{:$facet queries}]))

 (defn render-terms
-  [outer {:keys [key limit]}]
-  (let [k (str "$" (name (or key outer)))]
-    [outer [{:$sortByCount k} {:$limit (or limit 10)}]]))
+  [outer limit]
+  (let [dollar (str "$" (name outer))]
+    [outer
+     [[{:$sortByCount dollar}
+       {:$limit (or limit 10)}]
+      dollar
+      dollar]]))

 (defn render-percentile
-  [outer params]
+  [outer percentiles]
+  (let [key (keyword outer)
+        dollar (str "$" (name outer))]
+    [outer
+     [[{:$bucketAuto
+        {:groupBy dollar
+         :buckets 100}}]
+      {:$map
+       {:input percentiles
+        :as "index"
+        :in
+        {:percentile "$$index"
+         key {:$arrayElemAt [dollar, "$$index"]}}}}
+      {:$map
+       {:input dollar
+        :as "index"
+        :in
+        {:percentile "$$index.percentile"
+         :start (str "$$index." (name outer) "._id.max")}}}]]))
+
+(defn render-histogram
+  [outer interval]
+  (let [dollar (str "$" (name outer))])
   [outer
-   {:$bucketAuto
-    {:groupBy (str "$" (name outer))
-     :buckets 100}}])
-
-(def do-percentile
-  [{:$facet
-    {:start
-     [{:$bucketAuto
-       {:groupBy "$start"
-        :buckets 100}}]}}
-   {:$project
-    {:start
-     {:$map
-      {:input [1 5 10]
-       :as "index"
-       :in
-       {:percentile "$$index"
-        :start
-        {:$arrayElemAt ["$start", "$$index"]}}}}}}
-   {:$project
-    {:start
-     {:$map
-      {:input "$start"
-       :as "index"
-       :in
-       {:percentile "$$index.percentile"
-        :start "$$index.start._id.max"}}}}}])
+   [[{:$group
+      {:_id
+       {:$multiply
+        [interval
+         {:$ceil
+          {:$divide
+           [dollar interval]}}]}
+       :count {:$sum 1}}}
+     {:$sort {"_id" -1}}]
+    dollar
+    dollar]])

 (defn render-aggregate
   [[key query]]
@@ -291,13 +301,24 @@
       :percentile (render-percentile key params)
       :histogram (render-histogram key params))))

-(defn project-aggregate
-  [[key query]])
+(defn assemble-stages
+  [stages queries]
+  (reduce
+   (fn [outs [key query]]
+     (map
+      (fn [out stage]
+        (assoc out key query))
+      outs query))
+   (map (fn [_] {}) stages) queries))

 (defn aggregate
   [spec]
   (let [queries (into {} (filter identity (map render-aggregate spec)))]
-    [{:$facet queries}]))
+    (assemble-stages
+     [:$facet
+      :$project
+      :$project]
+     queries)))

 (def steps
   {:fromEdge from-edge
@@ -421,7 +442,6 @@
         path (or (:config env) "resources/config/ophion.clj")
         config (config/read-path path)
         graph (mongo/connect! (:mongo config))]
-    ;; (ingest-incrementally graph (:input env))
     (ingest-labels-from-path! graph (:input env))
     (log/info "ingest complete")))

@@ -437,3 +457,31 @@
 ;;         vedges (aggregate/evaluate db "featureOf" [[:where {:from gid :to {:$in fea}}]])]
 ;;     {:environments [(count env) (count compounds) (count cedges)]
 ;;      :features [(count fea) (count variants) (count vedges)]}))
+
+
+;; (def do-percentile
+;;   [{:$facet
+;;     {:start
+;;      [{:$bucketAuto
+;;        {:groupBy "$start"
+;;         :buckets 100}}]}}
+;;    {:$project
+;;     {:start
+;;      {:$map
+;;       {:input [1 5 10]
+;;        :as "index"
+;;        :in
+;;        {:percentile "$$index"
+;;         :start
+;;         {:$arrayElemAt ["$start", "$$index"]}}}}}}
+;;    {:$project
+;;     {:start
+;;      {:$map
+;;       {:input "$start"
+;;        :as "index"
+;;        :in
+;;        {:percentile "$$index.percentile"
+;;         :start "$$index.start._id.max"}}}}}])
+
+;; [{:$group {:_id {:$multiply [100000 {:$ceil {:$divide ["$end" 100000]}}]} :count {:$sum 1}}} {:$sort {"_id" -1}}]
+


rename overtone/core/sc/read-reply to await-promise. Also remove recv-and-wait preferring explit dereferencing.

--- src/overtone/core/sc.clj
+++ src/overtone/core/sc.clj
@@ -283,22 +283,14 @@
     (on path #(do (deliver p %) :done))
     p))

-(defn read-reply
+(defn await-promise
     "Read the reply received from the server, waiting for timeout ms if the message hasn't yet been received. Returns :timeout if a timeout occurs."
-    ([msg] (read-reply msg REPLY-TIMEOUT))
-    ([msg timeout]
+    ([prom] (await-promise msg REPLY-TIMEOUT))
+    ([prom timeout]
        (try
          (.get (future @msg) timeout TimeUnit/MILLISECONDS)
          (catch TimeoutException t
            :timeout))))
-
-(defn recv-and-wait
-  "Wait for a message associated with given path to be received from the server. If a timeout is specified then returns :timeout if no message has been received within timeout ms. Blocks current thread waiting for message"
-  [path & [timeout]]
-  (let [p (recv path)]
-    (if timeout
-      (read-reply p timeout)
-      @p)))

 (defn- parse-status [args]
   (let [[_ ugens synths groups loaded avg peak nominal actual] args]
@@ -334,7 +326,7 @@
   (let [sync-id (rand-int 999999)
         reply-p (recv "/synced")
         _ (snd "/sync" sync-id)
-        reply (read-reply reply-p (if timeout timeout REPLY-TIMEOUT))
+        reply (await-promise reply-p (if timeout timeout REPLY-TIMEOUT))
         reply-id (first (:args reply))]
     (= sync-id reply-id)))

@@ -641,7 +633,7 @@
    (let [ctls? (if (or (= 1 ctls?) (= true ctls?)) 1 0)]
      (let [reply-p (recv "/g_queryTree.reply")
            _ (snd "/g_queryTree" id ctls?)
-          tree (:args (read-reply reply-p))]
+          tree (:args (await-promise reply-p))]
        (with-meta (parse-node-tree tree)
          {:type ::node-tree})))))

@@ -668,7 +660,7 @@
 (defn sync-all
   "Wait until all asynchronous server operations have been completed."
   []
-  (recv-and-wait "/synced"))
+  @(recv "/synced"))

 ; The /done message just has a single argument:
 ; "/done" "s" <completed-command>
@@ -736,7 +728,7 @@
     (loop [recvd 0]
       (if (= recvd len)
         samples
-        (let [msg (recv-and-wait "/b_setn")
+        (let [msg @(recv "/b_setn")
               ;_ (println "b_setn msg: " (take 3 (:args msg)))
               [buf-id bstart blen & samps] (:args msg)]
           (loop [idx bstart
@@ -784,7 +776,7 @@

   (let [mesg-p (recv "/b_info")
         _   (snd "/b_query" (buffer-id buf))
-        msg (read-reply mesg-p)
+        msg (await-promise mesg-p)
         [buf-id n-frames n-channels rate] (:args msg)]
     {:n-frames n-frames
      :n-channels n-channels


making functions private

making functions private

--- src/overtone/core/sc.clj
+++ src/overtone/core/sc.clj
@@ -624,15 +624,15 @@
     (let [tree (:args (recv "/g_queryTree.reply" REPLY-TIMEOUT))]
       (parse-node-tree tree)))))

-(defn render-group-node-str-for-vijual
+(defn- render-group-node-str-for-vijual
   [node]
   (str "Group " (node :group)))

-(defn render-synth-node-str-for-vijual
+(defn- render-synth-node-str-for-vijual
   [node]
   (str "Synth " (node :id) " " (node :synth)))

-(defn render-node-str-for-vijual
+(defn- render-node-str-for-vijual
   [node]
   (cond
    (contains? node :group) (render-group-node-str-for-vijual node)
@@ -640,7 +640,7 @@
    (true) (throw (Exception. "Please implement a vijual node renderer for this node type"))
    ))

-(defn prepare-tree-for-vijual
+(defn- prepare-tree-for-vijual
   [tree]
   (let [node     (render-node-str-for-vijual (dissoc tree :children))
         children (tree :children)]


added the right parameters to connect

added the right parameters to connect

--- src/overtone/core/sc.clj
+++ src/overtone/core/sc.clj
@@ -439,7 +439,7 @@
       (log/debug "Booting SuperCollider server (scsynth)...")
       (.start sc-thread)
       (dosync (ref-set server-thread* sc-thread))
-      (connect)
+      (connect :external host port)
       :booting))))

 (defn boot


Allow groups to be created without explicit params (defaults to the :tail of the root group)

--- src/overtone/sc/node.clj
+++ src/overtone/sc/node.clj
@@ -133,14 +133,15 @@
 ;; RootNode and default_group for more info.

 (defn group
-  "Create a new synth group as a child of the target group."
-  [position target-id]
-  {:pre [(server-connected?)]}
-  (let [id (alloc-id :node)
-        pos (if (keyword? position) (get POSITION position) position)
-        pos (or pos 1)]
-    (snd "/g_new" id pos target-id)
-    id))
+  "Create a new synth group as a child of the target group. By default creates
+  a new group at the tail of the root group."
+  ([] (group :tail (root-group)))
+  ([position target-id]
+     (let [id (alloc-id :node)
+           pos (if (keyword? position) (get POSITION position) position)
+           pos (or pos 1)]
+       (snd "/g_new" id pos target-id)
+       id)))

 (defn group-free
   "Free synth groups, releasing their resources."


now supporting :append-sequence-set-num-outs mode and fixed expansion bug.

* adding missing support for the :append-sequence-set-num-outs mode which is
needed for the demand ugen

* fixed a bug in multi-channel expansion where the expand-flags weren't being
correctly passed through the reduction.  This was most likely the cause of some
serious tweakage.

--- src/overtone/sc/ugen.clj
+++ src/overtone/sc/ugen.clj
@@ -154,20 +154,20 @@
     (assoc ugen :args mapped-args)))

 (defn- append-seq-args
-  "Apply whatever mode specific functions need to be performed on the argument
-  list."
+  "Handles argument modes :append-sequence and :append-sequence-set-num-outs, where some ugens take a seq for one argument which needs to be appended to the end of the argument list when sent to SC."
   [spec ugen]
-  (let [args (:args ugen)
-        args-specs (args-with-specs args spec :mode)
-        [args to-append] (reduce (fn [[args to-append] [arg mode]]
-                                   (case mode
-                                         :append-sequence (if (and (coll? arg) (not (map? arg)))
-                                                            [args (concat to-append arg)]
-                                                            [args (conj to-append arg)])
-                                     [(conj args arg) to-append]))
-                                 [[] []]
-                                 args-specs)]
-    (assoc ugen :args (concat args to-append))))
+  (let [args-specs     (args-with-specs (:args ugen) spec :mode)
+        pred          #(or (= :append-sequence (second %))
+                           (= :append-sequence-set-num-outs (second %)))
+        normal-args    (map first (remove pred args-specs))
+        to-append      (filter pred args-specs)
+        to-append-args (map first to-append)
+        args           (flatten (conj normal-args to-append-args))
+        ugen           (assoc ugen :args args)]
+    (if-let [n-outs-arg (first (filter #(= :append-sequence-set-num-outs (second %))
+                                       to-append))]
+      (assoc ugen :n-outputs (count (first n-outs-arg)))
+      ugen)))

 (defn add-default-args [spec ugen]
   (let [args (:args ugen)
@@ -334,23 +334,23 @@
   [expand-flags args]
   (if (zero? (count args))
     [[]]
-    (let [gc-seqs (fn [[gcount seqs] arg]
+    (let [gc-seqs (fn [[gcount seqs flags] arg]
                     (cond
                       ; Infinite seqs can be used to generate values for expansion
                       (inf? arg) [gcount
                                   (conj seqs arg)
-                                  (next expand-flags)]
+                                  (next flags)]

                       ; Regular, non-infinite and non-map collections get expanded
                       (and (expandable? arg)
-                           (first expand-flags)) [(max gcount (count arg))
-                                                  (conj seqs (cycle-vals arg))
-                                                  (next expand-flags)]
+                           (first flags)) [(max gcount (count arg))
+                                           (conj seqs (cycle-vals arg))
+                                           (next flags)]

                       :else ; Basic values get used for all expansions
                       [gcount
                        (conj seqs (repeat arg))
-                       (next expand-flags)]))
+                       (next flags)]))
           [greatest-count seqs] (reduce gc-seqs [1 [] expand-flags] args)]
       (take greatest-count (apply parallel-seqs seqs)))))


up the limit over what we're actually transacting

--- src/pc/http/datomic2.clj
+++ src/pc/http/datomic2.clj
@@ -103,8 +103,8 @@
   [datoms {:keys [document-id client-id session-uuid cust-uuid]}]
   (cond (empty? datoms)
         {:status 400 :body (pr-str {:error "datoms is required and should be non-empty"})}
-        (< 1000 (count datoms))
-        {:status 400 :body (pr-str {:error "You can only transact 1000 datoms at once"})}
+        (< 1500 (count datoms))
+        {:status 400 :body (pr-str {:error "You can only transact 1500 datoms at once"})}
         (not (number? document-id))
         {:status 400 :body (pr-str {:error "document-id is required and should be an entity id"})}
         :else


adding ip-address grabber and fixing release

--- src/proxmox/provider.clj
+++ src/proxmox/provider.clj
@@ -77,19 +77,19 @@
       (trace "enabling feature" f)
       (vzctl this (<< "set ~(ct :vmid) --features \"~{f}\" --save")))) () )

-(defn- append-ip [[ct network]]
-  (into [ct network] [(or (ct :ip_address) (network :ip_address))]))
+(defn ip-address
+   "grabs ip address either from bridged settings or container settings"
+   ([{:keys [ct network]}] (ip-address ct network))
+   ([ct network] (or (ct :ip_address) (network :ip_address))))

 (defn assign-networking
   "Generate ip only if missing and not bridged"
   [ct {:keys [ip_address netif] :as network}]
-  (append-ip
-    (cond
-      (and ip_address netif) [(assoc ct :netif netif) (-> network (assoc :ip_address (mark ip_address :proxmox)) (dissoc :netif))]
-      (and (not ip_address) netif) [(assoc ct :netif netif) (-> network (gen-ip :proxmox :ip_address) (dissoc :netif))]
-      (and ip_address (not netif)) [(assoc ct :ip_address (mark ip_address :proxmox)) network]
-      (and (not ip_address) (not netif)) [(gen-ip ct :proxmox :ip_address) network]
-      )))
+  (cond
+    (and ip_address netif) [(assoc ct :netif netif) (-> network (assoc :ip_address (mark ip_address :proxmox)) (dissoc :netif))]
+    (and (not ip_address) netif) [(assoc ct :netif netif) (-> network (gen-ip :proxmox :ip_address) (dissoc :netif))]
+    (and ip_address (not netif)) [(assoc ct :ip_address (mark ip_address :proxmox)) network]
+    (and (not ip_address) (not netif)) [(gen-ip ct :proxmox :ip_address) network]))

 (defn- redhat-network
   "updates redhat bridged networking"
@@ -107,8 +107,7 @@
     (try
       (spit output (debian-interfaces (merge {:ip ip_address} network)))
       (copy output (<< "/var/lib/vz/private/~{vmid}/etc/network/") (get-node node))
-      (finally (delete-dir temp))))
-  )
+      (finally (delete-dir temp)))))

 (defn update-interfaces
   "uploads interfaces file for a ct if bridge is used"
@@ -129,36 +128,38 @@
      {:type ::proxmox:ssh-failed :message "Timed out while waiting for ssh" :timeout timeout}))

 (defconstrainedrecord Container [node ct extended network]
-  "ct should match proxmox expected input (see http://pve.proxmox.com/pve2-api-doc/)"
+  "ct should match proxmox expected input (see http://pve.proxmox.com/pve2-api-doc/)
+   network contains bridged settings (when applicaple)."
   [(validate-provider ct extended network) (not (nil? node))]
   Vm
   (create [this]
           (debug "creating" (:vmid ct))
-          (let [[ct* network* ip_address] (assign-networking ct network) {:keys [hostname vmid]} ct* id (extended :system-id)]
+          (let [[ct* network*] (assign-networking ct network) ip (ip-address ct* network*)
+                {:keys [hostname vmid]} ct* id (extended :system-id)]
             (try+
               (check-task node (prox-post (str "/nodes/" node "/openvz") ct*))
               (enable-features this)
               (when (p/system-exists? id)
-                (p/partial-system id {:proxmox {:vmid vmid} :machine {:ip ip_address}}))
+                (p/partial-system id {:proxmox {:vmid vmid} :machine {:ip ip}}))
               (when (ct* :netif)
-                (update-interfaces node (extended :flavor) ip_address network* vmid))
+                (update-interfaces node (extended :flavor) ip network* vmid))
               (->Container node ct* extended network*)
               (catch [:status 500] e
                 (warn "Container already exists" e) (throw e))
-              (catch Throwable e (release-ip ip_address :proxmox)))))
+              (catch Throwable e (release-ip ip :proxmox)))))

   (delete [this]
      (try
        (debug "deleting" (:vmid ct))
        (unmount this)
        (safe (prox-delete (str "/nodes/" node "/openvz/" (:vmid ct))))
-      (finally (release-ip (network :ip) :proxmox))))
+      (finally (release-ip (ip-address this) :proxmox))))

   (start [this]
          (debug "starting" (:vmid ct))
          (safe
            (prox-post (str "/nodes/" node "/openvz/" (:vmid ct) "/status/start")))
-           (wait-for-ssh (network :ip) (:user extended) [5 :minute]))
+           (wait-for-ssh (ip-address this) (:user extended) [5 :minute]))

   (stop [this]
         (debug "stopping" (:vmid ct))


[#176] Adapt form-instance endpoint

[#176] Adapt form-instance endpoint

--- api/src/clojure/org/akvo/flow_api/endpoint/form_instance.clj
+++ api/src/clojure/org/akvo/flow_api/endpoint/form_instance.clj
@@ -43,7 +43,7 @@
                                     :opt-un [::spec/cursor ::spec/page-size]))

 (defn endpoint* [{:keys [remote-api api-root]}]
-  (GET "/form_instances" {:keys [email instance-id alias params]}
+  (GET "/form_instances" {:keys [email instance-id alias params] :as req}
     (let [{:keys [survey-id
                   form-id
                   page-size
@@ -61,7 +61,7 @@
         (-> remote-api
             (form-instance/list instance-id user-id form {:page-size page-size
                                                           :cursor cursor})
-            (add-next-page-url api-root alias survey-id form-id page-size)
+            (add-next-page-url (utils/get-api-root req) alias survey-id form-id page-size)
             (response))
         {:status 404
          :body {"formId" form-id


::s/invalid works with ClojureScript

::s/invalid works with ClojureScript

--- src/spec_tools/core.cljc
+++ src/spec_tools/core.cljc
@@ -5,9 +5,6 @@
      (:import [java.util Date UUID])))

 (def ^:dynamic *conform-mode* nil)
-
-(def +error-code+ #?(:clj  :clojure.spec/invalid
-                     :cljs :cljs.spec/invalid))

 (defn- double-like? [x]
   (#?(:clj  double?
@@ -20,7 +17,7 @@
          :cljs (js/parseInt x 10))
       (catch #?(:clj  Exception
                 :cljs js/Error) _
-        +error-code+))))
+        ::s/invalid))))

 (defn string->long [x]
   (if (string? x)
@@ -29,7 +26,7 @@
          :cljs (js/parseInt x 10))
       (catch #?(:clj  Exception
                 :cljs js/Error) _
-        +error-code+))))
+        ::s/invalid))))

 (defn string->double [x]
   (if (string? x)
@@ -38,7 +35,7 @@
          :cljs (js/parseFloat x))
       (catch #?(:clj  Exception
                 :cljs js/Error) _
-        +error-code+))))
+        ::s/invalid))))

 (defn string->keyword [x]
   (if (string? x)
@@ -49,7 +46,7 @@
     (cond
       (= "true" x) true
       (= "false" x) false
-      :else +error-code+)))
+      :else ::s/invalid)))

 (defn string->uuid [x]
   (if (string? x)
@@ -58,7 +55,7 @@
          :cljs (uuid x))
       (catch #?(:clj  Exception
                 :cljs js/Error) _
-        +error-code+))))
+        ::s/invalid))))

 (defn string->inst [x]
   (if (string? x)
@@ -67,7 +64,7 @@
          :cljs (js/Date. (.getTime (goog.date.UtcDateTime.fromIsoString x))))
       (catch #?(:clj  Exception
                 :cljs js/Error) _
-        +error-code+))))
+        ::s/invalid))))

 (def +conformation+
   {:string [string? {integer? string->int
@@ -91,9 +88,9 @@
             (if (accept? x)
               (if-let [conformer (get conformers pred)]
                 (conformer x)
-                +error-code+)
-              +error-code+)
-            +error-code+))))
+                ::s/invalid)
+              ::s/invalid)
+            ::s/invalid))))
     {::pred pred}))

 (defn conform


Trivial move create-app to bottom

Trivial move create-app to bottom

--- src/clj/ji/service.clj
+++ src/clj/ji/service.clj
@@ -85,31 +85,6 @@
 (defn valid-game-id? [game-id]
   (boolean (re-find #"^[\w-]+$" game-id)))

-(defn create-app [game-envs]
-  (-> (routes
-        (POST "/games" {{game-id "game-id"} :params uri :uri}
-              (dosync
-                (cond
-                  (and game-id (not (valid-game-id? game-id)))
-                  (-> (resp/response "Invalid game") (resp/status 400))
-
-                  (and game-id (contains? @game-envs game-id))
-                  (-> (resp/response "Game already exists") (resp/status 409))
-
-                  :else
-                  (let [game-env (init-game-env! game-envs (or game-id (rand-game-id game-envs)))]
-                    (resp/redirect-after-post (str "/games/" (:id @game-env)))))))
-        (GET "/games" []
-             (tmpl/render-lobby @game-envs))
-        (GET "/games/:game-id" [game-id]
-             (if-let [game-env (get @game-envs game-id)]
-               (tmpl/render-game @game-env)
-               (route/not-found (tmpl/render-game-create game-id))))
-        (GET "/" [] {:status 302 :headers {"Location" "/games"} :body ""})
-        (route/files "/" {:root "out/public"})
-        (route/files "/" {:root "public"}))
-      (wrap-params)))
-
 (defn client-join!
   "Reads from new client channel, waits for JoinMessage and connects player to game.
   Returns a channel that will pass valid client or close"
@@ -137,3 +112,28 @@
               (close! (:out c)))
             (close! (:out c)))
           (recur)))))
+
+(defn create-app [game-envs]
+  (-> (routes
+        (POST "/games" {{game-id "game-id"} :params uri :uri}
+              (dosync
+                (cond
+                  (and game-id (not (valid-game-id? game-id)))
+                  (-> (resp/response "Invalid game") (resp/status 400))
+
+                  (and game-id (contains? @game-envs game-id))
+                  (-> (resp/response "Game already exists") (resp/status 409))
+
+                  :else
+                  (let [game-env (init-game-env! game-envs (or game-id (rand-game-id game-envs)))]
+                    (resp/redirect-after-post (str "/games/" (:id @game-env)))))))
+        (GET "/games" []
+             (tmpl/render-lobby @game-envs))
+        (GET "/games/:game-id" [game-id]
+             (if-let [game-env (get @game-envs game-id)]
+               (tmpl/render-game @game-env)
+               (route/not-found (tmpl/render-game-create game-id))))
+        (GET "/" [] {:status 302 :headers {"Location" "/games"} :body ""})
+        (route/files "/" {:root "out/public"})
+        (route/files "/" {:root "public"}))
+      (wrap-params)))


delete ToClojure extension for ByteBuffer: didn't make any sense given it just extracts the bytes

--- src/clj_kafka/core.clj
+++ src/clj_kafka/core.clj
@@ -28,14 +28,13 @@
   (to-clojure [x] (KafkaMessage. (.topic x) (.offset x) (.partition x) (.key x) (.message x)))

   MessageAndOffset
-  (to-clojure [x] (let [offset (.offset x)
-                        msg (.message x)]
-                    (KafkaMessage. nil offset nil (.key msg) (to-clojure (.payload msg)))))
-
-  ByteBuffer
-  (to-clojure [x] (let [b (byte-array (.remaining x))]
-                    (.get x b)
-                    b)))
+  (to-clojure [x]
+    (letfn [(byte-buffer-bytes [bb] (let [b (byte-array (.remaining bb))]
+                                      (.get bb b)
+                                      b))]
+      (let [offset (.offset x)
+            msg (.message x)]
+        (KafkaMessage. nil offset nil (.key msg) (byte-buffer-bytes (.payload msg)))))))

 (defn pipe
   "Returns a vector containing a sequence that will read from the


when accessing font list in headless mode exception is thrown

--- src/clojure2d/core.clj
+++ src/clojure2d/core.clj
@@ -1239,7 +1239,10 @@
 ;;

 (def ^{:doc "List of all available font names."
-       :metadoc/categories #{:write}} fonts-list (into [] (.getAvailableFontFamilyNames (java.awt.GraphicsEnvironment/getLocalGraphicsEnvironment))))
+       :metadoc/categories #{:write}} fonts-list
+  (try
+    (into [] (.getAvailableFontFamilyNames (java.awt.GraphicsEnvironment/getLocalGraphicsEnvironment)))
+    (catch Exception _ []))) ;; in headless mode function call fails

 (defn set-font
   "Set font by name."


Monkey patch the logger to test the event logger

--- test/ctia/logger_test.clj
+++ test/ctia/logger_test.clj
@@ -1,14 +1,36 @@
 (ns ctia.logger-test
-  (:require [ctia.events :as c :refer :all]
+  (:require [ctia.logging :refer :all]
+            [ctia.events :as c :refer :all]
             [clojure.test :as t :refer :all]
-            [schema.test :as st]))
+            [schema.test :as st]
+            [clojure.tools.logging :as log]
+            [clojure.string :as str]))

 (use-fixtures :once st/validate-schemas)

 (deftest test-setup
   (init!)
-  (let [{b :chan-buf c :chan m :mult} @central-channel]
+  (let [{b :chan-buf c :chan m :mult :as ev} @central-channel]
+    (log-channel ev)
     (send-create-event "tester" {} "TestModelType" {:data 1})
-    (send-create-event "tester" {} "TestModelType" {:data 2})
-    (send-event {:owner "tester" :http-params {} :data 3})))
+    (Thread/sleep 100))) ;; wait until the go loop is done

+(deftest test-logged
+  (init!)
+  (let [{b :chan-buf c :chan m :mult :as ev} @central-channel
+        sb (StringBuilder.)
+        ll log/log*
+        patched-log (fn [logger level throwable message]
+                      (.append sb message)
+                      (.append sb "\n"))]
+    (alter-var-root (var log/log*) (constantly patched-log))
+    (log-channel ev)
+    (send-create-event "tester" {} "TestModelType" {:data 1})
+    (send-event {:owner "tester" :http-params {} :data 2})
+    (Thread/sleep 100)   ;; wait until the go loop is done
+    (let [scrubbed (-> (str sb)
+                       (str/replace #"#inst \"[^\"]*\"" "#inst \"\"")
+                       (str/replace #":id event[^,]*" ":id event"))
+          expected "event: {:type CreatedModel, :owner tester, :timestamp #inst \"\", :http-params {}, :model-type TestModelType, :id event, :model {:data 1}}\nevent: {:owner tester, :http-params {}, :data 2, :timestamp #inst \"\"}\n"]
+      (is (= expected scrubbed)))
+    (alter-var-root (var log/log*) (constantly ll))))


Fix round-robin / percentage job scheduler reallocate-from-task? was trying to drop peers from a different job to reallocate-from-job? (which was called in volunteer?). This would mean that volunteer? would be successful but volunteer-from-task? would not be in circumstances where it should.

--- src/onyx/log/commands/common.clj
+++ src/onyx/log/commands/common.clj
@@ -494,7 +494,7 @@
         required (get allocations job)
         actual (count (apply concat (vals (get-in old [:allocations (:job allocation)]))))]
     (when (> actual required)
-      (let [peers-to-drop (drop-peers new job (- actual required))]
+      (let [peers-to-drop (drop-peers new (:job allocation) (- actual required))]
         (some #{(:id state)} (into #{} peers-to-drop))))))

 (defmethod reallocate-from-task? :onyx.task-scheduler/percentage
@@ -505,10 +505,10 @@
             n-peers (count (apply concat (vals (get-in new [:allocations job]))))
             balanced (percentage-balanced-taskload new job candidate-tasks n-peers)
             required (:allocation (get balanced (:task allocation)))
-            actual (count (get-in new [:allocations job (:task allocation)]))]
+            actual (count (get-in new [:allocations (:job allocation) (:task allocation)]))]
         (when (> actual required)
           (let [n (- actual required)
-                peers-to-drop (drop-peers new job n)]
+                peers-to-drop (drop-peers new (:job allocation) n)]
             (when (some #{(:id state)} (into #{} peers-to-drop))
               true)))))))