Rearrange message unit tests (WIP)

Rearrange message unit tests (WIP)

Trying to make the progression through them more natural.

--- test/frereth_cp/message/message_test.clj
+++ test/frereth_cp/message/message_test.clj
@@ -387,6 +387,249 @@
             (log/info "Comparing byte arrays")
             (is (time (b-t/bytes= chzbrgr dst)))))))))

+(deftest overflow-from-child
+  ;; If the child sends bytes faster than we can
+  ;; buffer/send, we need a way to signal back-pressure.
+  (let [opts {::specs/outgoing {::specs/pipe-from-child-size K/k-1}}
+        start-state (message/initial-state "Overflowing Test" true opts)
+        parent-cb (fn [out]
+                    (log/warn "parent-cb called with"
+                              (count out) bytes)
+                    (is (not out) "Should never get called"))
+        rcvd (atom [])
+        child-cb (fn [in]
+                   (log/info "child-cb received" in)
+                   (swap! rcvd conj in))
+        event-loop (message/start! start-state
+                                   parent-cb
+                                   child-cb)]
+    (is (= K/k-1 (get-in start-state [::specs/outgoing ::specs/pipe-from-child-size])))
+    (is (= K/k-1 (::specs/pipe-from-child-size event-loop)))
+    (is (= 0 (.available (::specs/child-out event-loop))))
+    (try
+      ;; Start by trying to send a buffer that's just flat-out too big
+      (is (not (message/child->! event-loop (byte-array K/k-4))))
+      ;; TODO: Send messages that are just long enough as fast as possible
+      ;; until one fails because it would have blocked.
+      ;; Then wait a bit and try again, with smaller block sizes
+      ;; Actually, don't do that here. The test is probably interesting
+      ;; for metrics, but it really needs a pair of i/o loops.
+      ;; And, really, it gets much more interesting when you add
+      ;; crypto to the mix.
+      (finally
+        ;; This is premature. Honestly, I need to call close! first,
+        ;; give the loop a chance to send out its EOF signal, and then
+        ;; kill it.
+        ;; It doesn't matter as much here as it does for the handshake
+        ;; test (since there's no "other side" loop to ACK the EOF, but
+        ;; it's worth doing if only to demonstrate the basic
+        ;; point.
+        (message/halt! event-loop)))))
+
+(deftest bigger-outbound
+  ;; Flip-side of echo: I want to see what happens
+  ;; when the child sends bytes that don't fit into
+  ;; a single message packet.
+  (let [test-run (gensym)
+        prelog (utils/pre-log test-run)]
+    (log/info prelog "Start testing writing big chunk of outbound data")
+    ;; TODO: split this into 2 tests
+    ;; 1 should stall out like the current implementation,
+    ;; waiting for ACKs (maybe drop every other packet?
+    ;; maybe send ACKs out of order?)
+    ;; The other should just send ACKs to get this working
+    ;; the way it did originally again
+    ;; TODO: Figure out a nice way to streamline the
+    ;; component setup without bringing in another 3rd
+    ;; party library
+    (let [start-time (System/nanoTime)
+          packet-count 9  ; trying to make life interesting
+          ;; Add an extra quarter-K just for giggles
+          msg-len (+ (* (dec packet-count) K/k-div2) K/k-div4)
+          response (promise)
+          srvr-child-state (atom {:count 0
+                                  :buffer []})
+          ;; I have a circular dependency between
+          ;; the client's child-cb, server-parent-cb,
+          ;; and initialized.
+          ;; The callbacks get called inside an
+          ;; agent send handler,
+          ;; which means I have the agent state
+          ;; directly available, but not the actual
+          ;; agent.
+          ;; That's what it needs, because child->!
+          ;; is going to trigger another send.
+          ;; Wrapping it inside an atom is obnoxious, but
+          ;; it works.
+          ;; Don't do anything like this for anything real.
+          client-io-atom (atom nil)
+          server-parent-cb (fn [bs]
+                             ;; TODO: Add a test that buffers these
+                             ;; up and then sends them
+                             ;; all at once
+                             (log/info (utils/pre-log test-run)
+                                       "Message from server to client."
+                                       "\nThis really should just be an ACK")
+                             (message/parent->! @client-io-atom bs))
+          server-child-cb (fn [incoming]
+                            (let [prelog (utils/pre-log test-run)]
+                              (log/info prelog "Incoming to server's child")
+
+                              ;; Q: Which version better depicts how the reference implementation works?
+                              ;; Better Q: Which approach makes more sense?
+                              ;; (Seems obvious...don't want to waste bandwidth if it's just going
+                              ;; to a broken router that will never deliver. But there's a lot of
+                              ;; experience behind this sort of thing, and it would be a terrible
+                              ;; mistake to ignore that accumulated wisdom)
+
+                              ;; That comment above is fairly rotten.
+                              ;; I think it stemmed from my scheduling algorithm
+                              ;; going off the rails and trying to send messages as fast as possible,
+                              ;; under some circumstances.
+                              ;; TODO: Check out the history, make sure this comment is
+                              ;; in the correct vicinity, and then hopefully delete them both.
+
+                              (let [response-state @srvr-child-state]
+                                (if (keyword? incoming)
+                                  (do
+                                    (is (s/valid? ::specs/eof-flag incoming))
+                                    (message/close! @client-io-atom))
+                                  (log/debug (str test-run
+                                                  "::server-child-cb ("
+                                                  (count incoming)
+                                                  " bytes): "
+                                                  (-> response-state
+                                                      (dissoc :buffer)
+                                                      (assoc :buffer-size (count (:buffer response-state)))))))
+                                ;; The first few blocks should max out the message size.
+                                ;; The way the test is set up, the last will be
+                                ;; (+ 512 64).
+                                ;; It doesn't seem worth the hoops it would take to validate that.
+                                (swap! srvr-child-state
+                                       (fn [cur]
+                                         (log/info prelog "Incrementing state count")
+                                         (-> cur
+                                             (update :count inc)
+                                             ;; Seems a little silly to include the ACKs.
+                                             ;; Should probably think this through more thoroughly
+                                             (update :buffer conj (vec incoming)))))
+                                ;; I would like to get 8 callbacks here:
+                                ;; 1 for each message packet the child tries to send.
+                                ;; I'm actually receiving 6:
+                                ;; 4 1K blocks, 256 bytes, and an EOF indicator.
+                                ;; It seems like this almost definitely involves
+                                ;; PipedStream buffering.
+                                ;; TODO: Need to double-check that and consider
+                                ;; very diligently what I think about it.
+                                ;; (At first glance, it seems totally incorrect).
+                                (when (= packet-count (:count @srvr-child-state))
+                                  (log/info prelog
+                                            "::srvr-child-cb Received all expected packets")
+                                  (deliver response @srvr-child-state)))))
+          srvr-initialized (message/initial-state (str "(test " test-run ") Server w/ Big Inbound")
+                                                  true
+                                                  {})
+          srvr-io-handle (message/start! srvr-initialized server-parent-cb server-child-cb)
+
+          parent-cb (fn [bs]
+                      (log/info (utils/pre-log test-run) "Forwarding buffer to server")
+                      ;; This approach is over-simplified for the sake
+                      ;; of testing.
+                      ;; In reality, we need to pull off this queue as
+                      ;; fast as possible.
+                      ;; And, realistically, push the message onto another
+                      ;; queue that handles all the details like encrypting
+                      ;; and actually writing bytes to the wire.
+                      (message/parent->! srvr-io-handle bs))
+          child-message-counter (atom 0)
+          strm-address (atom 0)
+          child-cb (fn [bs]
+                     ;; This is for messages from elsewhere to the child.
+                     ;; This test is all about the child spewing "lots" of data
+                     ;; TODO: Honestly, need a test that really does just start off by
+                     ;; sending megabytes (or gigabytes) of data as soon as the connection
+                     ;; is warmed up.
+                     ;; Library should be robust enough to handle that failure.
+                     ;; Q: (which failure? feature?)
+                     (is (not bs) "This should never get called"))
+          client-initialized (message/initial-state (str "(test " test-run ") Client w/ Big Outbound")
+                                                    false
+                                                    {})
+          client-io-handle (message/start! client-initialized parent-cb child-cb)]
+      (reset! client-io-atom client-io-handle)
+      (try
+        (let [;; Note that this is what the child sender should be supplying
+              message-body (byte-array (range msg-len))]
+          (log/debug prelog "Replicating child-send to " client-io-handle)
+          (try-multiple-sends message/child->!
+                              prelog
+                              5
+                              client-io-handle
+                              message-body
+                              (str "Buffered "
+                                   msg-len
+                                   " bytes to child")
+                              "Buffering big message from child failed"
+                              {::buffer-size msg-len})
+          (message/close! client-io-handle)
+          (let [outcome (deref response 10000 ::timeout)
+                end-time (System/nanoTime)]
+            (log/info prelog
+                      "Verifying that state hasn't errored out after"
+                      (float (utils/nanos->millis (- end-time start-time))) "milliseconds")
+            ;; Q: Can I do anything better in terms of checking for errors?
+            (let [client-state (message/get-state client-io-handle 500 ::timeout)]
+              (is outcome)
+              (is (not= ::timeout outcome))
+              (when (not= ::timeout outcome)
+                (is (not (instance? Exception outcome)))
+                (when-not (= outcome ::timeout)
+                  (let [result-buffer (:buffer outcome)]
+                    (is (= packet-count (count result-buffer)))
+                    (is (= K/max-bytes-in-initiate-message (count (first result-buffer))))
+                    (doseq [packet (butlast result-buffer)]
+                      (is (= (count packet) K/k-div2)))
+                    (let [final (last result-buffer)]
+                      (is (= (count final) K/k-div4)))
+                    (let [rcvd-strm
+                          (reduce (fn [acc block]
+                                    (conj acc block))
+                                  []
+                                  result-buffer)]
+                      (is (b-t/bytes= (->> rcvd-strm
+                                           first
+                                           byte-array)
+                                      (->> message-body
+                                           vec
+                                           (take K/max-bytes-in-initiate-message)
+                                           byte-array))))))))))
+        (let [{:keys [::specs/incoming
+                      ::specs/outgoing]
+               :as outcome} (message/get-state client-io-handle 500 ::time-out)]
+          (is (not= outcome ::time-out))
+          (when (not= outcome ::time-out)
+            (is outgoing)
+            (is (= msg-len (::specs/ackd-addr outgoing)))
+            (let [n-m-id (::specs/next-message-id outgoing)]
+              (is (= (inc packet-count) n-m-id)))
+            (is (= 0 (from-child/buffer-size outcome)))
+            ;; TODO: I do need a test that triggers EOF
+            (is (= ::specs/false (::specs/send-eof outgoing)))
+            ;; Keeping around as a reminder for when the implementation changes
+            ;; and I need to see what's really going on again
+            (comment (is (not outcome) "What should we have here?"))))
+      (finally
+          (log/info "Ending test" prelog)
+          (try
+            (message/halt! client-io-handle)
+            (catch RuntimeException ex
+              (is not ex)))
+          (try
+            (message/halt! srvr-io-handle)
+            (catch RuntimeException ex
+              (is not ex))))))))
+(comment (bigger-echo))
+
 (deftest handshake
   ;; The stop values going back to to-child/consolidate-message-block
   ;; are gibberish. This probably ties in with my failures to cope with
@@ -680,249 +923,6 @@
     (is (= K/k-1 (get-in start-state [::specs/outgoing ::specs/pipe-from-child-size])))
     (is (= K/k-4 (get-in start-state [::specs/incoming ::specs/pipe-to-child-size])))))

-(deftest overflow-from-child
-  ;; If the child sends bytes faster than we can
-  ;; buffer/send, we need a way to signal back-pressure.
-  (let [opts {::specs/outgoing {::specs/pipe-from-child-size K/k-1}}
-        start-state (message/initial-state "Overflowing Test" true opts)
-        parent-cb (fn [out]
-                    (log/warn "parent-cb called with"
-                              (count out) bytes)
-                    (is (not out) "Should never get called"))
-        rcvd (atom [])
-        child-cb (fn [in]
-                   (log/info "child-cb received" in)
-                   (swap! rcvd conj in))
-        event-loop (message/start! start-state
-                                   parent-cb
-                                   child-cb)]
-    (is (= K/k-1 (get-in start-state [::specs/outgoing ::specs/pipe-from-child-size])))
-    (is (= K/k-1 (::specs/pipe-from-child-size event-loop)))
-    (is (= 0 (.available (::specs/child-out event-loop))))
-    (try
-      ;; Start by trying to send a buffer that's just flat-out too big
-      (is (not (message/child->! event-loop (byte-array K/k-4))))
-      ;; TODO: Send messages that are just long enough as fast as possible
-      ;; until one fails because it would have blocked.
-      ;; Then wait a bit and try again, with smaller block sizes
-      ;; Actually, don't do that here. The test is probably interesting
-      ;; for metrics, but it really needs a pair of i/o loops.
-      ;; And, really, it gets much more interesting when you add
-      ;; crypto to the mix.
-      (finally
-        ;; This is premature. Honestly, I need to call close! first,
-        ;; give the loop a chance to send out its EOF signal, and then
-        ;; kill it.
-        ;; It doesn't matter as much here as it does for the handshake
-        ;; test (since there's no "other side" loop to ACK the EOF, but
-        ;; it's worth doing if only to demonstrate the basic
-        ;; point.
-        (message/halt! event-loop)))))
-
-(deftest bigger-outbound
-  ;; Flip-side of echo: I want to see what happens
-  ;; when the child sends bytes that don't fit into
-  ;; a single message packet.
-  (let [test-run (gensym)
-        prelog (utils/pre-log test-run)]
-    (log/info prelog "Start testing writing big chunk of outbound data")
-    ;; TODO: split this into 2 tests
-    ;; 1 should stall out like the current implementation,
-    ;; waiting for ACKs (maybe drop every other packet?
-    ;; maybe send ACKs out of order?)
-    ;; The other should just send ACKs to get this working
-    ;; the way it did originally again
-    ;; TODO: Figure out a nice way to streamline the
-    ;; component setup without bringing in another 3rd
-    ;; party library
-    (let [start-time (System/nanoTime)
-          packet-count 9  ; trying to make life interesting
-          ;; Add an extra quarter-K just for giggles
-          msg-len (+ (* (dec packet-count) K/k-div2) K/k-div4)
-          response (promise)
-          srvr-child-state (atom {:count 0
-                                  :buffer []})
-          ;; I have a circular dependency between
-          ;; the client's child-cb, server-parent-cb,
-          ;; and initialized.
-          ;; The callbacks get called inside an
-          ;; agent send handler,
-          ;; which means I have the agent state
-          ;; directly available, but not the actual
-          ;; agent.
-          ;; That's what it needs, because child->!
-          ;; is going to trigger another send.
-          ;; Wrapping it inside an atom is obnoxious, but
-          ;; it works.
-          ;; Don't do anything like this for anything real.
-          client-io-atom (atom nil)
-          server-parent-cb (fn [bs]
-                             ;; TODO: Add a test that buffers these
-                             ;; up and then sends them
-                             ;; all at once
-                             (log/info (utils/pre-log test-run)
-                                       "Message from server to client."
-                                       "\nThis really should just be an ACK")
-                             (message/parent->! @client-io-atom bs))
-          server-child-cb (fn [incoming]
-                            (let [prelog (utils/pre-log test-run)]
-                              (log/info prelog "Incoming to server's child")
-
-                              ;; Q: Which version better depicts how the reference implementation works?
-                              ;; Better Q: Which approach makes more sense?
-                              ;; (Seems obvious...don't want to waste bandwidth if it's just going
-                              ;; to a broken router that will never deliver. But there's a lot of
-                              ;; experience behind this sort of thing, and it would be a terrible
-                              ;; mistake to ignore that accumulated wisdom)
-
-                              ;; That comment above is fairly rotten.
-                              ;; I think it stemmed from my scheduling algorithm
-                              ;; going off the rails and trying to send messages as fast as possible,
-                              ;; under some circumstances.
-                              ;; TODO: Check out the history, make sure this comment is
-                              ;; in the correct vicinity, and then hopefully delete them both.
-
-                              (let [response-state @srvr-child-state]
-                                (if (keyword? incoming)
-                                  (do
-                                    (is (s/valid? ::specs/eof-flag incoming))
-                                    (message/close! @client-io-atom))
-                                  (log/debug (str test-run
-                                                  "::server-child-cb ("
-                                                  (count incoming)
-                                                  " bytes): "
-                                                  (-> response-state
-                                                      (dissoc :buffer)
-                                                      (assoc :buffer-size (count (:buffer response-state)))))))
-                                ;; The first few blocks should max out the message size.
-                                ;; The way the test is set up, the last will be
-                                ;; (+ 512 64).
-                                ;; It doesn't seem worth the hoops it would take to validate that.
-                                (swap! srvr-child-state
-                                       (fn [cur]
-                                         (log/info prelog "Incrementing state count")
-                                         (-> cur
-                                             (update :count inc)
-                                             ;; Seems a little silly to include the ACKs.
-                                             ;; Should probably think this through more thoroughly
-                                             (update :buffer conj (vec incoming)))))
-                                ;; I would like to get 8 callbacks here:
-                                ;; 1 for each message packet the child tries to send.
-                                ;; I'm actually receiving 6:
-                                ;; 4 1K blocks, 256 bytes, and an EOF indicator.
-                                ;; It seems like this almost definitely involves
-                                ;; PipedStream buffering.
-                                ;; TODO: Need to double-check that and consider
-                                ;; very diligently what I think about it.
-                                ;; (At first glance, it seems totally incorrect).
-                                (when (= packet-count (:count @srvr-child-state))
-                                  (log/info prelog
-                                            "::srvr-child-cb Received all expected packets")
-                                  (deliver response @srvr-child-state)))))
-          srvr-initialized (message/initial-state (str "(test " test-run ") Server w/ Big Inbound")
-                                                  true
-                                                  {})
-          srvr-io-handle (message/start! srvr-initialized server-parent-cb server-child-cb)
-
-          parent-cb (fn [bs]
-                      (log/info (utils/pre-log test-run) "Forwarding buffer to server")
-                      ;; This approach is over-simplified for the sake
-                      ;; of testing.
-                      ;; In reality, we need to pull off this queue as
-                      ;; fast as possible.
-                      ;; And, realistically, push the message onto another
-                      ;; queue that handles all the details like encrypting
-                      ;; and actually writing bytes to the wire.
-                      (message/parent->! srvr-io-handle bs))
-          child-message-counter (atom 0)
-          strm-address (atom 0)
-          child-cb (fn [bs]
-                     ;; This is for messages from elsewhere to the child.
-                     ;; This test is all about the child spewing "lots" of data
-                     ;; TODO: Honestly, need a test that really does just start off by
-                     ;; sending megabytes (or gigabytes) of data as soon as the connection
-                     ;; is warmed up.
-                     ;; Library should be robust enough to handle that failure.
-                     ;; Q: (which failure? feature?)
-                     (is (not bs) "This should never get called"))
-          client-initialized (message/initial-state (str "(test " test-run ") Client w/ Big Outbound")
-                                                    false
-                                                    {})
-          client-io-handle (message/start! client-initialized parent-cb child-cb)]
-      (reset! client-io-atom client-io-handle)
-      (try
-        (let [;; Note that this is what the child sender should be supplying
-              message-body (byte-array (range msg-len))]
-          (log/debug prelog "Replicating child-send to " client-io-handle)
-          (try-multiple-sends message/child->!
-                              prelog
-                              5
-                              client-io-handle
-                              message-body
-                              (str "Buffered "
-                                   msg-len
-                                   " bytes to child")
-                              "Buffering big message from child failed"
-                              {::buffer-size msg-len})
-          (message/close! client-io-handle)
-          (let [outcome (deref response 10000 ::timeout)
-                end-time (System/nanoTime)]
-            (log/info prelog
-                      "Verifying that state hasn't errored out after"
-                      (float (utils/nanos->millis (- end-time start-time))) "milliseconds")
-            ;; Q: Can I do anything better in terms of checking for errors?
-            (let [client-state (message/get-state client-io-handle 500 ::timeout)]
-              (is outcome)
-              (is (not= ::timeout outcome))
-              (when (not= ::timeout outcome)
-                (is (not (instance? Exception outcome)))
-                (when-not (= outcome ::timeout)
-                  (let [result-buffer (:buffer outcome)]
-                    (is (= packet-count (count result-buffer)))
-                    (is (= K/max-bytes-in-initiate-message (count (first result-buffer))))
-                    (doseq [packet (butlast result-buffer)]
-                      (is (= (count packet) K/k-div2)))
-                    (let [final (last result-buffer)]
-                      (is (= (count final) K/k-div4)))
-                    (let [rcvd-strm
-                          (reduce (fn [acc block]
-                                    (conj acc block))
-                                  []
-                                  result-buffer)]
-                      (is (b-t/bytes= (->> rcvd-strm
-                                           first
-                                           byte-array)
-                                      (->> message-body
-                                           vec
-                                           (take K/max-bytes-in-initiate-message)
-                                           byte-array))))))))))
-        (let [{:keys [::specs/incoming
-                      ::specs/outgoing]
-               :as outcome} (message/get-state client-io-handle 500 ::time-out)]
-          (is (not= outcome ::time-out))
-          (when (not= outcome ::time-out)
-            (is outgoing)
-            (is (= msg-len (::specs/ackd-addr outgoing)))
-            (let [n-m-id (::specs/next-message-id outgoing)]
-              (is (= (inc packet-count) n-m-id)))
-            (is (= 0 (from-child/buffer-size outcome)))
-            ;; TODO: I do need a test that triggers EOF
-            (is (= ::specs/false (::specs/send-eof outgoing)))
-            ;; Keeping around as a reminder for when the implementation changes
-            ;; and I need to see what's really going on again
-            (comment (is (not outcome) "What should we have here?"))))
-      (finally
-          (log/info "Ending test" prelog)
-          (try
-            (message/halt! client-io-handle)
-            (catch RuntimeException ex
-              (is not ex)))
-          (try
-            (message/halt! srvr-io-handle)
-            (catch RuntimeException ex
-              (is not ex))))))))
-(comment (bigger-echo))
-
 (deftest smarter-overflowing
   ;; Should be a smarter version of bigger-echo
   ;; I want to try keeping the child's outbound pipe


Remove unneeded prints. Better formatting.

--- src/myshelf/core.clj
+++ src/myshelf/core.clj
@@ -49,7 +49,9 @@
 (defn rank-to-read-books
   [consumer access-token user-id]
   (table [:id :title :author]
-         (take 10 (rank-books-on-shelf consumer access-token user-id "to-read"))))
+         (take 10
+               (rank-books-on-shelf consumer access-token
+                                    user-id "to-read"))))

 (defn handle-socket-command
   [consumer access-token user-id ins outs]
@@ -57,24 +59,21 @@
             *out* (writer outs)]
     (try
       (let [incoming (read-line)
-            [cmd args] (clojure.string/split incoming #"\|")]
-        (println "received: " incoming)
-        (let [ret (cond
-                    (= "find" cmd) (find-book consumer
-                                              access-token
-                                              args)
-                    (= "add" cmd) (add-book-to-shelf consumer access-token
-                                                     args "to-read")
-                    (= "rank" cmd) (rank-to-read-books consumer access-token
-                                                       user-id))]
-          (println ret)))
+            [cmd args] (clojure.string/split incoming #"\|")
+            ret (cond
+                  (= "find" cmd) (find-book consumer
+                                            access-token
+                                            args)
+                  (= "add" cmd) (add-book-to-shelf consumer access-token
+                                                   args "to-read")
+                  (= "rank" cmd) (rank-to-read-books consumer access-token
+                                                     user-id))]
+        (println ret))
       (catch Exception ex
         (println "oh noes!" (.getMessage ex))))))

 (defn -main
   [& [key secret]]
-  (println "in main")
-  (println "received key and secret:" key secret)
   (let [consumer (get-consumer key secret)
         request-token (get-request-token consumer)
         approval-uri (find-approval-uri consumer request-token)]


fix passing comment id via auth

fix passing comment id via auth

--- src/ontrail/core.clj
+++ src/ontrail/core.clj
@@ -57,7 +57,7 @@
   (POST "/rest/v1/ex/:user" {params :params cookies :cookies}
         (is-authenticated? params cookies (json-response (create-ex params))))

-  (POST "/rest/v1/ex/comment/:id/:user" {params :params cookies :cookies}
+  (POST "/rest/v1/ex/comment/:id" {params :params cookies :cookies}
      (is-authenticated? params cookies (json-response (comment-ex params))))

   (route/resources "/")


Fix up schema.

Fix up schema.

--- src/onyx/schema.cljc
+++ src/onyx/schema.cljc
@@ -725,6 +725,7 @@
    (s/optional-key :onyx.peer.metrics/lifecycles) [LifecycleState]
    (s/optional-key :onyx.peer/storage) Storage
    (s/optional-key :onyx.peer/storage.timeout) s/Int
+   (s/optional-key :onyx.peer/insanely-allow-zk-window-checkpointing) s/Bool
    (s/optional-key :onyx.peer/storage.s3.auth-type) (s/enum :provider-chain :config)
    (s/optional-key :onyx.peer/storage.s3.auth.access-key) s/Str
    (s/optional-key :onyx.peer/storage.s3.auth.secret-key) s/Str


whitespace

whitespace

--- src/clojure/zensols/nlparse/stanford.clj
+++ src/clojure/zensols/nlparse/stanford.clj
@@ -123,7 +123,7 @@
                        (edu.stanford.nlp.pipeline.EntityMentionsAnnotator.)
                        (zensols.stanford.nlp.TokenRegexEntityMentionsAnnotator.)]
                       flatten vec)}
-
+
     :parse-tree
     {:name :parse-tree
      :annotators [(edu.stanford.nlp.pipeline.ParserAnnotator. false -1)]}
@@ -261,7 +261,7 @@
       (map #(trav % nil) (.getRoots graph)))))

 (defn coref-tree-to-map [anon]
-  (->> anon coref- vals
+  (->> anon coref- vals
        (map (fn [chain]
               (let [mentions (.getMentionsInTextualOrder chain)]
                 {:id (.getChainID chain)


corrected a bug in :paredit-expand-left

corrected a bug in :paredit-expand-left

--- src/paredit/core.clj
+++ src/paredit/core.clj
@@ -424,7 +424,9 @@
                  "foo (bar [ba|z] |foo)" "foo (bar |[baz] |foo)"
                  "foo (bar [ba|z]) (foo [bar (b|az)])" "foo |(bar [baz]) (foo [bar (baz)])|"
                  "foo |(bar [baz (b|am)])" "foo |(bar [baz (bam)])|"
-                 "(foo bar|)" "(foo |bar|)";
+                 "(foo bar|)" "(foo |bar|)"
+                 "fooz foo |(bar)| baz" "fooz foo| (bar)| baz";;
+                 "fooz foo| (bar)| baz" "fooz |foo (bar)| baz"
                  }]
      ["Shift+Alt+Right" :paredit-expand-right
                 {
@@ -910,7 +912,7 @@
             _ (spy (zip/node l))
             _ (spy (when r (zip/node r)))
             l (if (sel-match-normalized? offset length [l r])
-                (if-let [nl (zip/left l)] nl (zip/up l))
+                (if-let [nl (zip/left l)] nl (if (punct-loc? l) (zip/left (zip/up l)) (zip/up l)))
                 (do
                   (spy [(zip/node l) (and r (zip/node r))])
                   (spy "not normalized!" l)))


Set up for postgres-large dest

Set up for postgres-large dest

--- src/pg_demo/core.clj
+++ src/pg_demo/core.clj
@@ -45,12 +45,20 @@
     :user           "ubuntu"
   } )

+; (def dest-spec
+;   { :classname    "oracle.jdbc.OracleDriver"  ; must be in classpath
+;     :subprotocol  "oracle"
+;     :subname      "thin:@//ora-test-1.cksh17mdz5oo.us-west-1.rds.amazonaws.com:1521/ORCL"
+;     :user         "rxlogix"
+;     :password     "rxlogix123"
+;   } )
+
 (def dest-spec
-  { :classname    "oracle.jdbc.OracleDriver"  ; must be in classpath
-    :subprotocol  "oracle"
-    :subname      "thin:@//ora-test-1.cksh17mdz5oo.us-west-1.rds.amazonaws.com:1521/ORCL"
-    :user         "rxlogix"
-    :password     "rxlogix123"
+  { :classname      "org.postgresql.Driver"
+    :subprotocol    "postgresql"
+    :subname        "//pg-test-1.cksh17mdz5oo.us-west-1.rds.amazonaws.com:5432/postal"
+    :user           "rxlogix"
+    :password       "rxlogix123"
   } )

 (def column-name-corrections


Fix up .cljs operation.

Fix up .cljs operation.

--- src/zprint/core.cljc
+++ src/zprint/core.cljc
@@ -24,11 +24,12 @@
             [zprint.focus :refer [range-ssv]]
             [rewrite-clj.parser :as p]
             #_[clojure.spec.alpha :as s])
-  (:import
-           #?@(:clj ((java.net URL URLConnection)))
+  #?@(:clj ((:import
+           (java.net URL URLConnection)
            (java.util.concurrent Executors)
            (java.io File)
            (java.util Date)))
+	   ))

 ;;
 ;; zprint
@@ -100,7 +101,9 @@
 ;; Clean up the API a bit by putting all of the public functions
 ;; in zprint.core
 ;;
-(def ^:dynamic *cache-path* (str (System/getProperty "user.home") File/separator ".zprint"))
+(def ^:dynamic *cache-path*
+  #?(:clj (str (System/getProperty "user.home") File/separator ".zprint")
+     :cljs nil))

 (defn set-options!
   "There is an internal options-map containing default values which is


Translate is a more correct term than transpose, which refers to y translation only.

--- src/overtunes/songs/variatio-12.clj
+++ src/overtunes/songs/variatio-12.clj
@@ -13,9 +13,9 @@
 (def g-major #(-> % major (+ 67)))

 (defn bpm [per-minute] #(-> % (/ per-minute) (* 60) (* 1000)))
-(defn transpose [f x y] #(-> % (+ x) f (+ y)))
-(def from #(transpose %1 0 %2))
-(def after #(transpose %1 %2 0))
+(defn translate [f x y] #(-> % (+ x) f (+ y)))
+(def from #(translate %1 0 %2))
+(def after #(translate %1 %2 0))
 (defn syncopate [timing durations] #(->> % (sum-n durations) timing))


Make a note that chain-step-tests is a bit flaky


Remove unnecessary parens around EMPTY queue

Fixes BB compatibility

--- src/aero/alpha/core.cljc
+++ src/aero/alpha/core.cljc
@@ -3,7 +3,7 @@
 ;; Queue utilities
 (defn- queue
   [& xs]
-  (into #?(:clj (clojure.lang.PersistentQueue/EMPTY)
+  (into #?(:clj clojure.lang.PersistentQueue/EMPTY
            :cljs cljs.core/PersistentQueue.EMPTY)
         xs))


Make gensym work at runtime, apparently.

--- lib/shin/cljs/cljs/core.cljs
+++ lib/shin/cljs/cljs/core.cljs
@@ -998,9 +998,17 @@
     false
     true))

+(def fresh-sym-seed 0)
+(defn builtin-fresh-sym []
+  (set! fresh-sym-seed (inc fresh-sym-seed))
+  (fresh-sym-seed))
+
 (defn gensym [stem]
   (let [stem (if stem stem "G__")]
-    (symbol (str stem (fresh_sym)))))
+    (let [f (if (*js-bop != (*js-uop typeof fresh_sym) "undefined")
+              (fresh_sym)
+              (builtin-fresh-sym))]
+      (symbol (str stem f)))))

 ;; Keyword


[hotfix][tests] Shut down HDFS and YARN cleanly.

Use provided scripts to shut down HDFS and YARN instead of grepkill! function.
Using grepkill! one can run situations where flink and hadoop processes are
killed concurrently, which results in an exception.

--- flink-jepsen/src/jepsen/flink/hadoop.clj
+++ flink-jepsen/src/jepsen/flink/hadoop.clj
@@ -115,17 +115,36 @@
     (info "Start DataNode")
     (c/exec (str install-dir "/sbin/hadoop-daemon.sh") :--config hadoop-conf-dir :--script :hdfs :start :datanode)))

+(defn stop-data-node!
+  []
+  (c/exec (str install-dir "/sbin/hadoop-daemon.sh") :--config hadoop-conf-dir :--script :hdfs :stop :datanode))
+
 (defn start-resource-manager!
   [test node]
   (when (= node (resource-manager (:nodes test)))
     (info "Start ResourceManager")
     (c/exec (str install-dir "/sbin/yarn-daemon.sh") :--config hadoop-conf-dir :start :resourcemanager)))

+(defn stop-resource-manager!
+  []
+  (c/exec (str install-dir "/sbin/yarn-daemon.sh") :--config hadoop-conf-dir :stop :resourcemanager))
+
 (defn start-node-manager!
   [test node]
   (when (some #{node} (data-nodes (:nodes test)))
     (info "Start NodeManager")
     (c/exec (str install-dir "/sbin/yarn-daemon.sh") :--config hadoop-conf-dir :start :nodemanager)))
+
+(defn stop-node-manager!
+  []
+  (c/exec (str install-dir "/sbin/yarn-daemon.sh") :--config hadoop-conf-dir :stop :nodemanager))
+
+(defn stop-all!
+  []
+  (stop-name-node!)
+  (stop-data-node!)
+  (stop-resource-manager!)
+  (stop-node-manager!))

 (defn db
   [url]
@@ -143,7 +162,7 @@
     (teardown! [_ _ _]
       (info "Teardown Hadoop")
       (c/su
-        (cu/grepkill! "hadoop")
+        (stop-all!)
         (c/exec :rm :-rf install-dir)))

     db/LogFiles


Fix missing spaces in default board descriptions

--- src/kanban/state.cljs
+++ src/kanban/state.cljs
@@ -4,22 +4,22 @@
   {:boards
    [{:id 1
      :name "Development"
-     :description (str
-                    "Kanban board for developers. Developers select work"
-                    "from Issues and the Backlog. When they start working,"
-                    "they move these cards to doing and assign them to"
-                    "themselves. Once completed, they move the card to"
-                    "Test for testers to verify the results of the work.")
+     :description
+     (str "Kanban board for developers. Developers select work "
+          "from Issues and the Backlog. When they start working, "
+          "they move these cards to doing and assign them to "
+          "themselves. Once completed, they move the card to "
+          "Test for testers to verify the results of the work.")
      :lanes [{:id 10} {:id 11} {:id 12} {:id 13}]}
     {:id 2
      :name "Testing"
-     :description (str
-                    "Kanban board for testers. Testers pick up the work that"
-                    "developers have completed and moved to Test. They then"
-                    "move these cards to Testing and assign them to themselves."
-                    "If testing is successful, cards are moved to Done, otherwise"
-                    "they are moved to Issues, where they are again picked up by"
-                    "developers for another round.")
+     :description
+     (str "Kanban board for testers. Testers pick up the work that "
+          "developers have completed and moved to Test. They then "
+          "move these cards to Testing and assign them to themselves. "
+          "If testing is successful, cards are moved to Done, otherwise "
+          "they are moved to Issues, where they are again picked up by "
+          "developers for another round.")
      :lanes [{:id 13} {:id 14} {:id 15} {:id 10}]}]
    :lanes
    [{:id 10 :name "Issues" :cards [{:id 102}]}


Use the shell wrapper from resources/ if present rather than templating.

--- src/leiningen/jar.clj
+++ src/leiningen/jar.clj
@@ -24,20 +24,25 @@
                              group (.replaceAll group "\\." "/")]]
                    (local-repo-path (name dep) group version)))))

-(defn- shell-wrapper-bin [project]
+(defn- shell-wrapper-name [project]
   (or (:bin (:shell-wrapper project)
             (format "bin/%s" (:name project)))))

-;; TODO: look for a custom bin in resources before using default one
+(defn- shell-wrapper-contents [project bin-name main]
+  (if-let [is (-> (.getContextClassLoader (Thread/currentThread))
+                  (.getResourceAsStream bin-name))]
+    (slurp* is)
+    (format bin-template
+            (script-classpath-for project) main)))
+
 (defn- shell-wrapper-filespecs [project]
   (when (:shell-wrapper project)
     (let [main (or (:main (:shell-wrapper project)) (:main project))
-          bin (shell-wrapper-bin project)]
+          bin-name (shell-wrapper-name project)
+          bin (shell-wrapper-contents project bin-name main)]
       [{:type :bytes
-        :path bin
-        :bytes (.getBytes (format bin-template
-                                  (script-classpath-for project)
-                                  main))}])))
+        :path bin-name
+        :bytes (.getBytes bin)}])))

 (def default-manifest
      {"Created-By" (str "Leiningen " (System/getProperty "leiningen.version"))
@@ -53,7 +58,7 @@
              "Manifest-Version: 1.0"
              (merge default-manifest (:manifest project)
                     (when (:shell-wrapper project)
-                      {"Leiningen-shell-wrapper" (shell-wrapper-bin project)})
+                      {"Leiningen-shell-wrapper" (shell-wrapper-name project)})
                     (when-let [main (:main project)]
                       {"Main-Class" (.replaceAll (str main) "-" "_")})))))))


any nonalphanumeric or whitespace characters removed from index

--- src/help_me_im_dumb/index.clj
+++ src/help_me_im_dumb/index.clj
@@ -25,7 +25,7 @@
         comment-string (concat (map #(get % "text") comments))]
     (->
      (apply str body url comment-string)
-     (clojure.string/replace #"[,!'.%?]" "")
+     (clojure.string/replace #"[^a-zA-Z\s]" "")
      (clojure.string/split #"\s+"))))

 (defn token-seq-from-file


remove unused params from event-msg-handler methods

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -52,7 +52,7 @@
   :stop (router))

 (defmethod event-msg-handler :default
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
+  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
   (let [session (:session ring-req)
         uid     (:uid     session)]
     (debugf "Unhandled event: %s" event)
@@ -187,15 +187,15 @@
   )

 (defmethod event-msg-handler :chsk/uidport-open
-  [{:as ev-msg :keys [event id ring-req user-id]}]
+  [{:as ev-msg :keys [user-id]}]
   (broadcast-user-change user-id [:user/connected user-id]))

 (defmethod event-msg-handler :chsk/uidport-close
-  [{:as ev-msg :keys [event id user-id]}]
+  [{:as ev-msg :keys [user-id]}]
   (broadcast-user-change user-id [:user/disconnected user-id]))

 (defmethod event-msg-handler :chat/new-message
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (let [new-message (-> ?data
                         (update :mentioned-tag-ids vec)
                         (update :mentioned-user-ids vec)
@@ -215,15 +215,15 @@
           (cb :braid/error))))))

 (defmethod event-msg-handler :user/subscribe-to-tag
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (db/user-subscribe-to-tag! user-id ?data))

 (defmethod event-msg-handler :user/unsubscribe-from-tag
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (db/user-unsubscribe-from-tag! user-id ?data))

 (defmethod event-msg-handler :user/set-nickname
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (if (valid-nickname? (?data :nickname))
     (try
       (do (db/set-nickname! user-id (?data :nickname))
@@ -236,7 +236,7 @@
     (when ?reply-fn (?reply-fn {:error "Invalid nickname"}))))

 (defmethod event-msg-handler :user/set-avatar
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (if (valid-url? ?data)
     (do (db/set-user-avatar! user-id ?data)
         (broadcast-user-change user-id [:user/new-avatar {:user-id user-id
@@ -246,7 +246,7 @@
         (when-let [r ?reply-fn] (r {:braid/error "Bad url for avatar"})))))

 (defmethod event-msg-handler :user/set-password
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (if (string/blank? (?data :password))
     (when ?reply-fn (?reply-fn {:error "Password cannot be blank"}))
     (do
@@ -254,27 +254,27 @@
       (when ?reply-fn (?reply-fn {:ok true})))))

 (defmethod event-msg-handler :user/set-preferences
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (doseq [[k v] ?data]
     (db/user-set-preference! user-id k v))
   (when ?reply-fn (?reply-fn :braid/ok)))

 (defmethod event-msg-handler :chat/hide-thread
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (db/user-hide-thread! user-id ?data)
   (chsk-send! user-id [:chat/hide-thread ?data]))

 (defmethod event-msg-handler :chat/unsub-thread
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (db/user-unsubscribe-from-thread! user-id ?data)
   (chsk-send! user-id [:chat/hide-thread ?data]))

 (defmethod event-msg-handler :chat/mark-thread-read
-  [{:as ev-msg :keys [ring-req ?data user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (db/update-thread-last-open! ?data user-id))

 (defmethod event-msg-handler :chat/create-tag
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (if (db/user-in-group? user-id (?data :group-id))
     (if (valid-tag-name? (?data :name))
       (let [new-tag (db/create-tag! (select-keys ?data [:id :name :group-id]))
@@ -294,7 +294,7 @@
                   user-id (?data :name) (?data :group-id))))

 (defmethod event-msg-handler :chat/set-tag-description
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (let [{:keys [tag-id description]} ?data]
     (when (and tag-id description)
       (let [group-id (db/tag-group-id tag-id)]
@@ -304,7 +304,7 @@
             group-id [:group/tag-descrption-change [tag-id description]]))))))

 (defmethod event-msg-handler :chat/create-group
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (cond
     (string/blank? (?data :name))
     (do
@@ -325,7 +325,7 @@
       (db/user-make-group-admin! user-id (new-group :id)))))

 (defmethod event-msg-handler :chat/search
-  [{:keys [event id ?data ring-req ?reply-fn send-fn user-id] :as ev-msg}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   ; this can take a while, so move it to a future
   (future
     (let [user-tags (db/tag-ids-for-user user-id)
@@ -336,7 +336,7 @@
         (?reply-fn {:threads threads :thread-ids thread-ids})))))

 (defmethod event-msg-handler :chat/load-threads
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (let [user-tags (db/tag-ids-for-user user-id)
         filter-tags (fn [t] (update-in t [:tag-ids] (partial into #{} (filter user-tags))))
         thread-ids (filter (partial db/user-can-see-thread? user-id) ?data)
@@ -345,7 +345,7 @@
       (?reply-fn {:threads threads}))))

 (defmethod event-msg-handler :chat/threads-for-tag
-  [{:keys [event id ?data ring-req ?reply-fn send-fn user-id] :as ev-msg}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (let [user-tags (db/tag-ids-for-user user-id)
         filter-tags (fn [t] (update-in t [:tag-ids]
                                        (partial into #{} (filter user-tags))))
@@ -357,7 +357,7 @@
       (?reply-fn threads))))

 (defmethod event-msg-handler :chat/invite-to-group
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (if (db/user-in-group? user-id (?data :group-id))
     (let [data (assoc ?data :inviter-id user-id)
           invitation (db/create-invitation! data)]
@@ -370,7 +370,7 @@
       user-id (?data :invitee-email) (?data :group-id))))

 (defmethod event-msg-handler :chat/generate-invite-link
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (if (db/user-in-group? user-id (?data :group-id))
     (let [{:keys [group-id expires]} ?data]
       (?reply-fn {:link (invites/make-open-invite-link group-id expires)}))
@@ -380,7 +380,7 @@
         (?reply-fn {:braid/error :not-allowed}))))

 (defmethod event-msg-handler :chat/invitation-accept
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (if-let [invite (db/invite-by-id (?data :id))]
     (do
       (db/user-add-to-group! user-id (invite :group-id))
@@ -395,14 +395,14 @@
                   user-id (?data :id))))

 (defmethod event-msg-handler :chat/invitation-decline
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (if-let [invite (db/invite-by-id (?data :id))]
     (db/retract-invitation! (invite :id))
     (timbre/warnf "User %s attempted to decline nonexistant invitaiton %s"
                   user-id (?data :id))))

 (defmethod event-msg-handler :chat/make-user-admin
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (let [{new-admin-id :user-id group-id :group-id} ?data]
     (when (and new-admin-id group-id
             (db/user-is-group-admin? user-id group-id))
@@ -411,7 +411,7 @@
                               [:group/new-admin [group-id new-admin-id]]))))

 (defmethod event-msg-handler :chat/remove-from-group
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (let [{group-id :group-id to-remove-id :user-id} ?data]
     (when (and group-id to-remove-id
             (or (= to-remove-id user-id)
@@ -424,28 +424,28 @@
         [:user/left-group [group-id (:name (db/group-by-id group-id))]]))))

 (defmethod event-msg-handler :chat/set-group-intro
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (let [{:keys [group-id intro]} ?data]
     (when (and group-id (db/user-is-group-admin? user-id group-id))
       (db/group-set! group-id :intro intro)
       (broadcast-group-change group-id [:group/new-intro [group-id intro]]))))

 (defmethod event-msg-handler :chat/set-group-avatar
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (let [{:keys [group-id avatar]} ?data]
     (when (and group-id (db/user-is-group-admin? user-id group-id))
       (db/group-set! group-id :avatar avatar)
       (broadcast-group-change group-id [:group/new-avatar [group-id avatar]]))))

 (defmethod event-msg-handler :chat/set-group-publicity
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data user-id]}]
   (let [[group-id publicity] ?data]
     (when (and group-id (db/user-is-group-admin? user-id group-id))
       (db/group-set! group-id :public? publicity)
       (broadcast-group-change group-id [:group/publicity-changed [group-id publicity]]))))

 (defmethod event-msg-handler :chat/create-bot
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (let [bot ?data
         reply-fn (or ?reply-fn (constantly nil))]
     (when (and (bot :group-id) (db/user-is-group-admin? user-id (bot :group-id)))
@@ -472,13 +472,13 @@
                                   [:group/new-bot [(bot :group-id) (bot->display created)]]))))))

 (defmethod event-msg-handler :chat/get-bot-info
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [?data ?reply-fn user-id]}]
   (let [bot (db/bot-by-id ?data)]
     (when (and bot (db/user-is-group-admin? user-id (bot :group-id)) ?reply-fn)
       (?reply-fn {:braid/ok bot}))))

 (defmethod event-msg-handler :session/start
-  [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn user-id]}]
+  [{:as ev-msg :keys [user-id]}]
   (let [connected (set (:any @connected-uids))]
     (chsk-send!
       user-id


Don't insert null issue dates (there are quite a lot of missing ones).

--- src/chronograph/data.clj
+++ src/chronograph/data.clj
@@ -267,7 +267,11 @@
                   updated (apply crdate/crossref-date updatedInput)
                   updatedDate (coerce/to-sql-date (crdate/as-date updated))]
               ; Insert in background, will take less time than the API fetch.
-              (go (insert-event the-doi issued-type-id metadata-source-id issuedDate 1 issuedString nil nil))
+
+              ; Some issue dates are missing. Don't insert.
+              (when issued-input-ok
+                (go (insert-event the-doi issued-type-id metadata-source-id issuedDate 1 issuedString nil nil)))
+
               (go (insert-event the-doi updated-type-id metadata-source-id updatedDate 1 nil nil nil)))))
         (prn "Next" (t/now)))))


Load cljs/nodecli.cljs from the classpath.

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -632,7 +632,7 @@
                      (apply add-dependencies opts compiled)
                      (add-dependencies opts compiled))
         js-sources (if (= :nodejs (:target opts))
-                     (concat js-sources [(-compile "src/cljs/cljs/nodecli.cljs" opts)])
+                     (concat js-sources [(-compile (io/resource "cljs/nodecli.cljs") opts)])
                      js-sources)]
     (if (:optimizations opts)
       (->> js-sources
@@ -648,7 +648,6 @@
                     (defn ^:export sum [xs] 42)]
                   {:optimizations :simple :flags #{:pretty-print}}))

-
   ;; build a project with optimizations
   (build "samples/hello/src" {:optimizations :advanced})
   (build "samples/hello/src" {:optimizations :advanced :output-to "samples/hello/hello.js"})


Lazy init all components to not require react...

unless we display the overlay

--- src/cljs/klang/core.cljs
+++ src/cljs/klang/core.cljs
@@ -39,7 +39,7 @@
 (defn dom-el
   "Ensures there is a div element in the body and returns it."
   []
-  (let [domid "__klang2__id__"
+  (let [domid "__klang__id__"
         domel (js/document.getElementById domid)]
     (or domel
         (let [newdom (doto (js/document.createElement "div")
@@ -47,17 +47,7 @@
           (js/document.body.appendChild newdom)
           newdom))))

-(defn add-array
-  [ary xs]
-  (reduce (fn [ary x] (.push ary x) ary)
-          ary xs)
-  ary)
-
-(defn h
-  "Helper for creating dom elements."
-  [tag props & children]
-  (.apply js/React.createElement js/React.createElement
-          (add-array #js[tag props] children)))
+(def h js/React.createElement)

 (defn possibly-set-lifecycle!
   "This is all done for performance... Smaller and more used functions can easier get optimized."
@@ -248,21 +238,22 @@

 (def render-log-event
   "Renders a single log message."
-  (component
-    #js{:name "LogEvent"
-        :key-fn (fn [props] (:id props))
-        :should-update #(-> false)}
-    (fn [{:keys [time ns type msg] :as lg-ev}]
-      (h "li" #js{:style #js{:listStyleType "none"}}
-         (format-time time)
-         " "
-         ns
-         (when-not (empty? ns) "/")
-         (h "span" #js{:style #js{:color (severity->color type)}} type)
-         " "
-         (h "span" #js{:style #js{:cursor "pointer"}
-                       :onClick #(dump-to-console! lg-ev)}
-            (render-msg msg))))))
+  (delay
+    (component
+      #js{:name "LogEvent"
+          :key-fn (fn [props] (:id props))
+          :should-update #(-> false)}
+      (fn [{:keys [time ns type msg] :as lg-ev}]
+        (h "li" #js{:style #js{:listStyleType "none"}}
+           (format-time time)
+           " "
+           ns
+           (when-not (empty? ns) "/")
+           (h "span" #js{:style #js{:color (severity->color type)}} type)
+           " "
+           (h "span" #js{:style #js{:cursor "pointer"}
+                         :onClick #(dump-to-console! lg-ev)}
+              (render-msg msg)))))))

 (defn search-filter-fn
   "Returns a transducer that filters given the log messages according to the
@@ -309,28 +300,29 @@
        (dotimes [i last-to-start]
          (let [lg-ev (aget logs (- last-to-start i 1))]
            (when ^boolean (filter-fn lg-ev)
-             (.push aout (render-log-event lg-ev)))))
+             (.push aout (@render-log-event lg-ev)))))
        aout)))

 (def render-search-box
-  (let [search-box-id "klang-search"]
-    (component #js{:name "KlangSearch"
-                   :key-fn (fn [props] (:id props))
-                   :did-mount (fn [state]
-                                (let [el (js/document.getElementById search-box-id)]
-                                  (.select el))
-                                state)}
-               (fn [default-value]
-                 (h "input" #js{:style #js{:background "#000"
-                                           :color "white"
-                                           :width "350px"}
-                                :id search-box-id
-                                :tabIndex 1
-                                :onChange (fn [e] (!! assoc :search (.. e -target -value)))
-                                :autoFocus true
-                                :type "text"
-                                :defaultValue default-value
-                                :placeholder "Search"})))))
+  (delay
+    (let [search-box-id "klang-search"]
+      (component #js{:name "KlangSearch"
+                     :key-fn (fn [props] (:id props))
+                     :did-mount (fn [state]
+                                  (let [el (js/document.getElementById search-box-id)]
+                                    (.select el))
+                                  state)}
+                 (fn [default-value]
+                   (h "input" #js{:style #js{:background "#000"
+                                             :color "white"
+                                             :width "350px"}
+                                  :id search-box-id
+                                  :tabIndex 1
+                                  :onChange (fn [e] (!! assoc :search (.. e -target -value)))
+                                  :autoFocus true
+                                  :type "text"
+                                  :defaultValue default-value
+                                  :placeholder "Search"}))))))

 (defn- render-overlay
   "Renders the entire log message overlay in a div when :showing? is true."
@@ -349,7 +341,7 @@
                              :justifyContent "center"
                              :display "flex"}}
         (if (:showing? @db)
-          (render-search-box (:search @db ""))
+          (@render-search-box (:search @db ""))
           (h "span" #js{}))
         (h "button" #js{:style #js{:cursor "pointer"
                                    :color (if (:frozen-at @db) "orange" "green")}


infinite floor; players + bullets positions should be fixed or added some kind of visual teleports on edges

--- src/cljs/mpd/assets.cljs
+++ src/cljs/mpd/assets.cljs
@@ -44,8 +44,8 @@
   (puke_sprite "images/crosshair.png" 1.0 false))

 (def background_tiling_sprite
-  (let [bg (PIXI.extras.TilingSprite.fromImage "images/floor.png" 5000 5000)]
-    ;(aset bg "anchor" (js-obj "x" 0.5 "y" 0.5))
+  (let [bg (PIXI.extras.TilingSprite.fromImage "images/floor.png" 15000 15000)]
+    (aset bg "anchor" (js-obj "x" 0.5 "y" 0.5))
     bg))

 ;sounds


Better messaging behavior

Better messaging behavior

Also more history

--- src/cljs/tilde/core.cljs
+++ src/cljs/tilde/core.cljs
@@ -68,8 +68,11 @@
   (push-current-user))

 (defn handle-update-message [e app owner]
-  (swap! prefs assoc :message (-> e .-target .-value))
-  (push-current-user))
+  (when (== (.-which e) 13)
+    (let [target (.-target e)]
+     (swap! prefs assoc :message (.-value target))
+     (set! (.-value target) ""))
+    (push-current-user)))

 (defn update-coords! [move-x move-y]
   (swap! prefs (fn [{[x y] :coords :as prefs}]
@@ -99,12 +102,12 @@
                 (dom/input
                  #js {:placeholder "color"
                       :onChange #(handle-update-color % app owner)})
-                (dom/span #js {:style #js {"color" "grey" "margin-left" "5px"}} "use your arrow keys to move around")
+                (dom/span #js {:style #js {"color" "grey" "margin-left" "5px"}} "use your arrow keys to move around - hit return in the message box to post a message")
                 (om/build-all player-view players)))
        om/IWillMount
        (will-mount [_]
          (-> firebase
-             (.limit 100)
+             (.limit 1000)
              (.on "child_added" (fn [snapshot]
                                   (let [{:keys [id name coords] :as updated-player} (js->clj (.val snapshot) :keywordize-keys true)]
                                     (om/update! players id updated-player)))))


Formatting...

Formatting...

--- src/cljs_game/input.cljs
+++ src/cljs_game/input.cljs
@@ -10,14 +10,14 @@
 (defonce input-queue (atom cljs.core/PersistentQueue.EMPTY))

 (defonce input-mapping (atom
-                    { "w" {:type :input :action :up :target :player
-                           :execute (fn [entity] (update-in entity [:components :position-component :y] - 10))}
-                     "a" {:type :input :action :left :target :player
-                          :execute (fn [entity] (update-in entity [:components :position-component :x] - 10))}
-                     "s" {:type :input :action :down :target :player
-                          :execute (fn [entity] (update-in entity [:components :position-component :y] + 10))}
-                     "d" {:type :input :action :right :target :player
-                          :execute (fn [entity] (update-in entity [:components :position-component :x] + 10))}}))
+                         {"w" {:type :input :action :up :target :player
+                               :execute (fn [entity] (update-in entity [:components :position-component :y] - 10))}
+                          "a" {:type :input :action :left :target :player
+                               :execute (fn [entity] (update-in entity [:components :position-component :x] - 10))}
+                          "s" {:type :input :action :down :target :player
+                               :execute (fn [entity] (update-in entity [:components :position-component :y] + 10))}
+                          "d" {:type :input :action :right :target :player
+                               :execute (fn [entity] (update-in entity [:components :position-component :x] + 10))}}))

 (defn ^:export handle-input [event]
   (let [key (.-key event)
@@ -39,9 +39,9 @@
   (let [command (peek @input-queue)]
     (if (and command (> attempts 0))
       (do (swap! input-queue pop)
-          (pull-from-input
-           (conj command-stream command)
-           (dec attempts)))
+        (pull-from-input
+          (conj command-stream command)
+          (dec attempts)))
       command-stream)))

 (defn ^:export process-input [entities]


Expose current namespace function

Expose current namespace function

--- src/cljs_mancy/core.cljs
+++ src/cljs_mancy/core.cljs
@@ -140,6 +140,7 @@
 (set! make-js-eval-fn fake-eval-fn!)
 (set! process-in-ns process-in-ns!)
 (set! replumb.repl/base-eval-opts! base-eval-opts)
+(defn current-ns [] (:ns @copts))

 (set! *main-cli-fn* (fn [] nil))


Bug fixed.

Bug fixed.

--- src/cloprand/handler.clj
+++ src/cloprand/handler.clj
@@ -24,7 +24,7 @@
     (println absolute_path)))

 (defroutes app-routes
-  (GET "/get_data" [type ids] (response (get-files type ids)))
+  (GET "/get_data" [type ids] (response/response (get-files type ids)))
   ;(GET "/:system-name/:application-name/index.html" [system-name application-name]
   (GET "/:system-name/:application-name/index.html" [system-name application-name]
     (println (format "System Name     : %s\nApplication Name: %s\n" system-name application-name))


Echobot

Echobot

--- slackbot/src/org/teamweek/slackbot.clj
+++ slackbot/src/org/teamweek/slackbot.clj
@@ -20,12 +20,12 @@
                           (json/generate-string {:id (rand-int 1e6)
                                                  :type "ping"})))))

-(defn route-messages [ws-conn incoming-messages]
+(defn route-messages [conn incoming-messages]
   (future (while true
-            (let [msg (json/parse-string @(stream/take! ws-conn) true)]
+            (let [msg (json/parse-string @(stream/take! (:ws-conn conn)) true)]
               (condp = (:type msg)
-                "message" (do (println "OK")
-                              (async/put! incoming-messages msg))
+                "message" (when-not (= (:user msg) (:id (:self conn)))
+                            (async/put! incoming-messages msg))
                 (do #_ignore))))))

 (defn websocket-client [url incoming-messages]
@@ -34,7 +34,7 @@
     (when-not (= first-msg {"type" "hello"})
       (throw (ex-info "Unable to connect" first-msg)))
     (keep-alive conn)
-    (route-messages conn incoming-messages)
+
     conn))

 (defn connect [token]
@@ -46,10 +46,12 @@
                       (json/parse-string true))
         incoming-messages (async/chan)
         ws-conn (websocket-client (:url conn-data)
-                                  incoming-messages)]
-    (assoc conn-data
-           :ws-conn ws-conn
-           :incoming-messages incoming-messages)))
+                                  incoming-messages)
+        conn (assoc conn-data
+                    :ws-conn ws-conn
+                    :incoming-messages incoming-messages)]
+    (route-messages conn incoming-messages)
+    conn))

 (defn find-user-dm-id [conn user]
   (let [user-id (some #(if (= (:name %) user)
@@ -82,16 +84,31 @@
                                        :channel (find-channel-id conn channel)
                                        :text msg})))

+(defn find-username [conn user-id]
+  (if-let [username (some #(if (= (:id %) user-id)
+                             (:name %))
+                          (:users conn))]
+    username
+    (throw (ex-info "No such user" {:user-id user-id}))))
+
 (comment
   (def conn (connect slack-token))

-  (send-to-user! conn "jonas" "no need to leave emacs ;)")
+  conn
+
+  (send-to-user! conn "ivan" "Send me a message!")
+

   (async/thread
     (loop [msg (async/<!! (:incoming-messages conn))]
       (when msg
-        (prn msg)
-        (recur (async/<!! (:incoming-messages conn))))))
+        (let [user-id (:user msg)
+              _ (assert (not= (:user msg) (:id (:self conn))))
+              username (find-username conn user-id)
+              dm? (.startsWith (:channel msg) "D")]
+          (if dm?
+            (send-to-user! conn username (format "Hi %s! You said \"%s\"" username (:text msg))))
+          (recur (async/<!! (:incoming-messages conn)))))))

   )


remove unnecessary namespace

remove unnecessary namespace

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -392,7 +392,7 @@
                        :sem {:pred :read
                              :subj {:pred :woman}}
                        :subcat '()}}
-        lbs (babel.generate/lightning-bolts med spec 0 6)
+        lbs (lightning-bolts med spec 0 6)
         good-lb (first (filter #(and (= (get-in % [:head :rule])
                                         "transitive-vp-nonphrasal-head")
                                      (= (get-in % [:head :head :english :english])


fix test

fix test

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -147,7 +147,8 @@
                                          :of {:pred :Juana}}
                                   :pred :cane}}})]
     (is (not (nil? result)))
-    (is (= "Juana's dog" (fo result)))))
+    (is (= :cane
+           (get-in result [:synsem :sem :pred])))))

 (deftest generate-with-possessive-2
   (let [result


don't println expressions by default

don't println expressions by default

--- test/babel/test/en.cljc
+++ test/babel/test/en.cljc
@@ -181,7 +181,9 @@
 (deftest no-failed-bolts
   (let [result
         (->>
-         (repeatedly #(println
+         (repeatedly #((fn [x]
+                         (if false (println x)
+                             x))
                        (let [generated
                              (generate
                               {:comp {:synsem {:pronoun true}}


Add platform number key to Elevio info (#1796)

--- src-cljs/frontend/controllers/api.cljs
+++ src-cljs/frontend/controllers/api.cljs
@@ -333,7 +333,7 @@
                            :vcs-type vcs_type}))
     ;; Attach information about this build so support knows the last build a user
     ;; was viewing before the sent in a support ticket.
-    (elevio/add-user-traits! {:last-build-viewed (merge (select-keys build [:vcs_url :build_url :build_num :branch])
+    (elevio/add-user-traits! {:last-build-viewed (merge (select-keys build [:vcs_url :build_url :build_num :branch :platform])
                                                         {:repo-name (:reponame build)
                                                          :org-name (-> build :vcs_url vcs-url/org-name)
                                                          :scopes scopes})})


(TK-103) DRYed up Clojure client request

This commit removes some repeated code from the Clojure sync request
function and changes the surrounding try/catch/finally block to make use
of the Clojure `with-open` macro.

--- src/clj/puppetlabs/http/client/sync.clj
+++ src/clj/puppetlabs/http/client/sync.clj
@@ -30,14 +30,8 @@

 (defn request
   [req]
-  (let [client (async/create-default-client (extract-client-opts req))]
-    (try
-      (let [{:keys [error] :as resp} @(async/request-with-client req nil client)]
-        (if error
-          (throw error)
-          resp))
-      (finally
-        (.close client)))))
+  (with-open [client (async/create-default-client (extract-client-opts req))]
+    (request-with-client req client)))

 (schema/defn create-client :- common/HTTPClient
   [opts :- common/ClientOptions]


Consolidate basic integration tests (#116)

--- waiter/integration/waiter/basic_test.clj
+++ waiter/integration/waiter/basic_test.clj
@@ -20,107 +20,97 @@
             [waiter.service-description :as sd])
   (:import java.io.ByteArrayInputStream))

-(deftest ^:parallel ^:integration-fast test-basic-secrun
-  (testing-using-waiter-url
-    (log/info (str "Basic test using endpoint: /secrun"))
-    (let [{:keys [body service-id] :as response}
+(deftest ^:parallel ^:integration-fast test-basic-functionality
+  (testing-using-waiter-url
+    (let [{:keys [service-id request-headers]}
           (make-request-with-debug-info
             {:x-waiter-name (rand-name)}
-            #(make-kitchen-request waiter-url % :path "/secrun"))]
-      (assert-response-status response 200)
-      (is (= "Hello World" body))
-      (delete-service waiter-url service-id))))
-
-(deftest ^:parallel ^:integration-fast test-basic-no-content
-  (testing-using-waiter-url
-    (log/info "Basic test for empty body in request")
-    (let [{:keys [body service-id]} (make-request-with-debug-info
-                                      {:x-waiter-name (rand-name)
-                                       :accept "text/plain"}
-                                      #(make-kitchen-request waiter-url % :path "/request-info"))
-          body-json (json/read-str (str body))]
-      (is (get-in body-json ["headers" "authorization"]) (str body))
-      (is (get-in body-json ["headers" "x-waiter-auth-principal"]) (str body))
-      (is (get-in body-json ["headers" "x-cid"]) (str body))
-      (is (nil? (get-in body-json ["headers" "content-type"])) (str body))
-      (is (= "0" (get-in body-json ["headers" "content-length"])) (str body))
-      (is (= "text/plain" (get-in body-json ["headers" "accept"])) (str body))
-      (delete-service waiter-url service-id))))
-
-(deftest ^:parallel ^:integration-fast test-basic-http-methods-support
-  (testing-using-waiter-url
-    (log/info "Basic test for empty body in request")
-    (let [{:keys [request-headers service-id]} (make-request-with-debug-info
-                                                 {:x-waiter-name (rand-name)
-                                                  :accept "text/plain"}
-                                                 #(make-kitchen-request waiter-url % :path "/hello"))
-          http-method-helper (fn http-method-helper [http-method]
-                               (fn inner-http-method-helper [client url & [req]]
-                                 (http/request client (merge req {:method http-method :url url}))))]
-      (testing "verifying whether request method HEAD works"
-        (let [response (make-kitchen-request waiter-url request-headers
-                                             :http-method-fn (http-method-helper :head)
-                                             :path "/request-info")]
+            #(make-kitchen-request waiter-url % :path "/hello"))]
+
+      (testing "secrun"
+        (log/info (str "Basic test using endpoint: /secrun"))
+        (let [{:keys [body] :as response}
+              (make-kitchen-request waiter-url request-headers :path "/secrun")]
           (assert-response-status response 200)
-          (is (str/blank? (:body response)))))
-      (doseq [request-method [:delete :copy :get :move :patch :post :put]]
-        (testing (str "verifying whether request method " (-> request-method name str/upper-case) " works")
-          (let [{:keys [body] :as response} (make-kitchen-request waiter-url request-headers
-                                                                  :http-method-fn (http-method-helper request-method)
-                                                                  :path "/request-info")
-                body-json (json/read-str (str body))]
-            (assert-response-status response 200)
-            (is (= (name request-method) (get body-json "request-method"))))))
-      (delete-service waiter-url service-id))))
-
-(deftest ^:parallel ^:integration-fast test-request-content-headers
-  (testing-using-waiter-url
-    (let [request-length 100000
-          long-request (apply str (repeat request-length "a"))
-          headers {:x-waiter-name (rand-name)}
-          {:keys [service-id cookies] :as plain-resp} (make-request-with-debug-info
-                                                        headers
-                                                        #(make-kitchen-request waiter-url % :path "/request-info" :body long-request))
-          chunked-resp (make-request-with-debug-info
-                         headers
-                         #(make-kitchen-request waiter-url % :path "/request-info"
-                                                ; force a chunked request
-                                                :body (ByteArrayInputStream. (.getBytes long-request))
-                                                :cookies cookies))
-          plain-body-json (json/read-str (str (:body plain-resp)))
-          chunked-body-json (json/read-str (str (:body chunked-resp)))]
-      (is (= (str request-length) (get-in plain-body-json ["headers" "content-length"])))
-      (is (nil? (get-in plain-body-json ["headers" "transfer-encoding"])))
-      (is (= "chunked" (get-in chunked-body-json ["headers" "transfer-encoding"])))
-      (is (nil? (get-in chunked-body-json ["headers" "content-length"])))
-      (delete-service waiter-url service-id))))
-
-(deftest ^:parallel ^:integration-fast test-large-header
-  (testing-using-waiter-url
-    (log/info (str "Basic test using endpoint: /secrun"))
-    (let [service-name (rand-name)
-          request-headers {:x-waiter-name service-name}
-          canary-response (make-request-with-debug-info request-headers #(make-kitchen-request waiter-url % :path "/secrun"))
-          all-chars (map char (range 33 127))
-          random-string (fn [n] (reduce str (take n (repeatedly #(rand-nth all-chars)))))
-          make-request (fn [header-size]
-                         (log/info "making request with header size" header-size)
-                         (make-kitchen-request waiter-url
-                                               (assoc request-headers :x-kitchen-long-string
-                                                                      (random-string header-size))))]
-      (let [response (make-request 2000)]
-        (assert-response-status response 200))
-      (let [response (make-request 4000)]
-        (assert-response-status response 200))
-      (let [response (make-request 8000)]
-        (assert-response-status response 200))
-      (let [response (make-request 16000)]
-        (assert-response-status response 200))
-      (let [response (make-request 20000)]
-        (assert-response-status response 200))
-      (let [response (make-request 24000)]
-        (assert-response-status response 200))
-      (delete-service waiter-url (:service-id canary-response)))))
+          (is (= "Hello World" body))))
+
+      (testing "empty-body"
+        (log/info "Basic test for empty body in request")
+        (let [{:keys [body]} (make-kitchen-request
+                               waiter-url
+                               (assoc request-headers
+                                      :accept "text/plain")
+                               :path "/request-info")
+              body-json (json/read-str (str body))]
+          (is (get-in body-json ["headers" "authorization"]) (str body))
+          (is (get-in body-json ["headers" "x-waiter-auth-principal"]) (str body))
+          (is (get-in body-json ["headers" "x-cid"]) (str body))
+          (is (nil? (get-in body-json ["headers" "content-type"])) (str body))
+          (is (= "0" (get-in body-json ["headers" "content-length"])) (str body))
+          (is (= "text/plain" (get-in body-json ["headers" "accept"])) (str body))))
+
+      (testing "http methods"
+        (log/info "Basic test for empty body in request")
+        (let [http-method-helper (fn http-method-helper [http-method]
+                                   (fn inner-http-method-helper [client url & [req]]
+                                     (http/request client (merge req {:method http-method :url url}))))]
+          (testing "http method: HEAD"
+            (let [response (make-kitchen-request waiter-url request-headers
+                                                 :http-method-fn (http-method-helper :head)
+                                                 :path "/request-info")]
+              (assert-response-status response 200)
+              (is (str/blank? (:body response)))))
+          (doseq [request-method [:delete :copy :get :move :patch :post :put]]
+            (testing (str "http method: " (-> request-method name str/upper-case))
+              (let [{:keys [body] :as response} (make-kitchen-request waiter-url request-headers
+                                                                      :http-method-fn (http-method-helper request-method)
+                                                                      :path "/request-info")
+                    body-json (json/read-str (str body))]
+                (assert-response-status response 200)
+                (is (= (name request-method) (get body-json "request-method"))))))))
+
+      (testing "content headers"
+        (let [request-length 100000
+              long-request (apply str (repeat request-length "a"))
+              plain-resp (make-kitchen-request
+                           waiter-url request-headers
+                           :path "/request-info"
+                           :body long-request)
+              chunked-resp (make-kitchen-request
+                             waiter-url
+                             request-headers
+                             :path "/request-info"
+                             ; force a chunked request
+                             :body (ByteArrayInputStream. (.getBytes long-request)))
+              plain-body-json (json/read-str (str (:body plain-resp)))
+              chunked-body-json (json/read-str (str (:body chunked-resp)))]
+          (is (= (str request-length) (get-in plain-body-json ["headers" "content-length"])))
+          (is (nil? (get-in plain-body-json ["headers" "transfer-encoding"])))
+          (is (= "chunked" (get-in chunked-body-json ["headers" "transfer-encoding"])))
+          (is (nil? (get-in chunked-body-json ["headers" "content-length"])))))
+
+      (testing "large header"
+        (let [all-chars (map char (range 33 127))
+              random-string (fn [n] (reduce str (take n (repeatedly #(rand-nth all-chars)))))
+              make-request (fn [header-size]
+                             (log/info "making request with header size" header-size)
+                             (make-kitchen-request waiter-url
+                                                   (assoc request-headers :x-kitchen-long-string
+                                                          (random-string header-size))))]
+          (let [response (make-request 2000)]
+            (assert-response-status response 200))
+          (let [response (make-request 4000)]
+            (assert-response-status response 200))
+          (let [response (make-request 8000)]
+            (assert-response-status response 200))
+          (let [response (make-request 16000)]
+            (assert-response-status response 200))
+          (let [response (make-request 20000)]
+            (assert-response-status response 200))
+          (let [response (make-request 24000)]
+            (assert-response-status response 200))))
+
+      (delete-service waiter-url service-id))))

 ; Marked explicit due to:
 ; FAIL in (test-basic-logs)


Exporting to EDN should use proper maps, not just sequences


First cut at on-wall-place

First cut at on-wall-place

--- src/dactyl_keyboard/dactyl-manuform.clj
+++ src/dactyl_keyboard/dactyl-manuform.clj
@@ -11,6 +11,9 @@
 (def cornerrow (dec lastrow))
 (def α (/ π 12))                        ; curvature of the columns
 (def β (/ π (if (= nrows 4) 26 36)))    ; curvature of the rows
+(def centerrow (- cornerrow 1))         ; controls front-back tilt
+(def centercol 3)                       ; controls left-right tilt / tenting
+

 ;;;;;;;;;;;;;;;;;
 ;; Switch Hole ;;
@@ -108,15 +111,13 @@
 (defn key-place [column row shape]
   (let [row-placed-shape (->> shape
                               (translate [0 0 (- row-radius)])
-                              (rotate (* α
-                                        (- cornerrow row 1) ; controls front-back tilt
-                                      ) [1 0 0])
+                              (rotate (* α (- centerrow row)) [1 0 0])
                               (translate [0 0 row-radius]))
         column-offset (cond
                         (= column 2) [0 2.82 -4.5]
                         (>= column 4) [0 -5.8 5.64]
                         :else [0 0 0])
-        column-angle (* β (- 3 column))                      ; controls left-right tilt / tenting
+        column-angle (* β (- centercol column))
         placed-shape (->> row-placed-shape
                           (translate [0 0 (- column-radius)])
                           (rotate column-angle [0 1 0])
@@ -435,9 +436,21 @@
    (wall-brace thumb-tr-place  0 -1 thumb-post-br (partial key-place 3 lastrow)  0 -1 web-post-bl)
   ))

+(defn on-wall-place [column depth shape]
+  (key-place column 0
+    (->> shape
+         (rotate (* α centerrow) [-1 0 0])
+         (rotate (+ (* β (- centercol column)) (/ π 12)) [0 -1 0])
+         (translate [0 (/ mount-height 2) -15])
+                        ; (Math/sin (/ α 2)))
+         )))
+(def test-shape (on-wall-place 1 20 (cube 5 30 10)))
+
 (def teensy-width 20)
 (def teensy-height 12)
 (def teensy-length 33)
+(def teensy-pcb-thickness 1.6)
+(def teensy-offset-height 5)

 (def usb-cutout
   (let [hole-height 6.2
@@ -449,11 +462,11 @@
     (->> (color [20/255 163/255 163/255 1])
          (hull side-cylinder
                (mirror [-1 0 0] side-cylinder))
-         (rotate (/ π 2) [1 0 0])
          (translate [0 (/ teensy-length 2) (- side-radius)])
          (translate [0 0 (- 1)])
          (translate [0 0 (- teensy-offset-height)])
-         (key-place 0 1))))
+         (on-wall-place 1 20))))
+

 (spit "repl.scad"
@@ -463,6 +476,7 @@
                    thumb
                    thumb-connectors
                    case-walls
+                   test-shape
                   ;  usb-cutout
                   ;  thumbcaps
                   ;  caps


Parsing key-val files generated by GuideStatistic

--- src/emender_jenkins/metadata_reader.clj
+++ src/emender_jenkins/metadata_reader.clj
@@ -59,9 +59,21 @@
     [jenkins-url job-name]
 )

+(defn find-value-on-line
+    [lines prefix]
+    (let [line (first (filter #(.startsWith % prefix) lines))]
+        (if line
+            (-> (subs line (count prefix))
+                clojure.string/trim))))
+
 (defn read-and-parse-other-parts-count
     [jenkins-url job-name]
-)
+    (let [raw-data  (jenkins-api/read-file-from-artifact jenkins-url job-name (:other-parts-count GuideStatisticResultNames) nil)
+          lines     (if raw-data (clojure.string/split-lines raw-data))]
+          {:tables           (-> (find-value-on-line lines "tables")           str)
+           :procedures       (-> (find-value-on-line lines "procedures")       str)
+           :command-examples (-> (find-value-on-line lines "command examples") str)
+           :code-samples     (-> (find-value-on-line lines "code samples")     str)}))

 (defn read-and-parse-program-listing
     [jenkins-url job-name]


Edit vertex sizes.

Edit vertex sizes.

--- src/constraint/core.cljs
+++ src/constraint/core.cljs
@@ -128,26 +128,34 @@
     edge))

 (defn move-the-vertex [world-state event]
-  (let [moving (:vertex-moving world-state)
+  (let [moving (:selected world-state)
         rect (.getBoundingClientRect (dommy.core/sel1 :svg))
         pos [(- (.-clientX event) (.-left rect))
              (- (.-clientY event) (.-top rect))]]
-    (-> world-state
-        (update-in [:vertices moving 1] (constantly pos))
-        (update-in [:moving?] not))))
-
+    (update-in world-state [:vertices moving 1] (constantly pos))))
+
+
+(defn edit-vertex-or-connections [clicked-vertex world-state]
+  (let [selected (:selected world-state)]
+    (if (= selected clicked-vertex)
+      (update-in world-state [:vertices selected 0] #(inc (mod % 2)))
+      world-state ; connect/disconnect
+      )))

 (defn handle-editing [event world-state]
   (let [clicked-what (event->targetid event)
         clicked-edge? (re-matches #"edge.*" clicked-what)
         clicked-vertex? (re-matches #"vertex.*" clicked-what)]
-    (cond
-      (:moving? world-state) (move-the-vertex world-state event)
-      clicked-edge? (update-in world-state [:edges clicked-what 2]
-                               #(if (= :blue %) :red :blue))
-      clicked-vertex? (merge world-state {:moving? true
-                                          :vertex-moving clicked-what})
-      :else world-state)))
+    (if (:selected world-state)
+      (merge (if clicked-vertex?
+               (edit-vertex-or-connections clicked-what world-state)
+               (move-the-vertex world-state event))
+        {:selected nil})
+      (cond
+        clicked-edge? (update-in world-state [:edges clicked-what 2]
+                                 #(if (= :blue %) :red :blue))
+        clicked-vertex? (merge world-state {:selected clicked-what})
+        :else world-state))))

 (defn handle-playing [clicked-what world-state]
@@ -167,8 +175,7 @@
         is-vertex? (re-matches #"vertex.*" clicked-what)]
     (if (:editing? world-state)
       (if clicked-edit?
-        (merge world-state {:moving? false
-                            :vertex-moving nil
+        (merge world-state {:selected nil
                             :editing? false})
         (handle-editing event world-state))
       (handle-playing clicked-what world-state))))
@@ -179,8 +186,7 @@
                                (comp name-vertices-in-all-edges name-edges))
         named-vertices (update-in named-edges [:vertices] name-vertices)
         added-edit (merge named-vertices {:editing? false
-                                          :vertex-moving nil
-                                          :moving? false})]
+                                          :selected nil})]
     added-edit))


change test name

change test name

--- test/java_time_test.clj
+++ test/java_time_test.clj
@@ -952,7 +952,7 @@

   (import [org.joda.time Duration Period DateTimeZone
            LocalDate LocalTime LocalDateTime DateTime Instant])
-  (deftest joda
+  (deftest joda-test
     (testing "duration from duration and period"
       (is (= (j/duration 1 :millis)
             (j/duration (Duration/millis 1))


snapshot: working on satisfaction vector

--- src/main/cljs/emotions_demo/client.cljs
+++ src/main/cljs/emotions_demo/client.cljs
@@ -59,12 +59,16 @@
                           {:label "Arousal"
                            :path [:cur-state :arousal]}})))))

-(defn satisfaction-vector [app owner opts]
+(defn satisfaction-vector [{:keys [data] :as c} owner opts]
   (reify
     om/IRender
     (render [_]
       (dom/div #js {:className "satisfaction_vector"}
-               (dom/span nil "Satisfaction vector")))))
+               (dom/h2 nil "Satisfaction vector")
+               (dom/div #js {:className "contents"}
+                        (om/build-all sv-value
+                                      (:motivations data)
+                                      {:key :id}))))))

 (defn motivations [app owner opts]
   (reify


#6 - Tweaked styling and added verse and book hiliter.

--- src/biblecli/commands/staticpages.cljs
+++ src/biblecli/commands/staticpages.cljs
@@ -23,9 +23,9 @@
 (def node-path (js/require "path"))

 (defn style []
-"
-body {
-  background-color: #EEE;
+"body {
+  background-color: #DDD;
+  overflow-y: scroll;
 }
 a:link, a:visited {
   text-decoration: none;
@@ -36,6 +36,7 @@
   color: #77f;
 }
 .content {
+  font-size: 125%;
   width: 600px;
   margin: 25px auto 15px auto;
   padding: 25px;
@@ -47,18 +48,21 @@
   box-shadow: 0px 0px 23px 3px rgba(135,135,135,0.77);
 }
 .menu {
+  position: fixed;
+}
+.menu2 {
+  white-space: nowrap;
+  font-family: Arial, sans-serif;
+  font-size: 80%;
   position: absolute;
-  left: 0;
-  top: 0;
-}
-.menu2 {
-  font-family: Arial, sans-serif;
-  position: fixed;
-  background-color: #DDD;
-  border-right: 1px solid #BBB;
+  right: 24px;
+  background-color: #FFFFFF;
+  border-left: 1px solid #BBB;
   border-bottom: 1px solid #BBB;
+  border-top: 1px solid #BBB;
   padding: 6px;
-  border-bottom-right-radius: 4px;
+  border-bottom-left-radius: 6px;
+  border-top-left-radius: 6px;
 }
 .ref {
   display: none;
@@ -81,8 +85,8 @@
   page-break-before: always;
 }
 .verse {
-  margin-top: 0.125em;
-  margin-bottom: 0.125em;
+  padding: 0.18em 0.25em;
+  margin: 0;
   line-height: 1.2em;
   text-indent: 0;
 }
@@ -98,12 +102,64 @@
 }
 .tocp {
     text-indent: -2em;
-    padding-left: 2em;
+    padding: 0.18em 0.25em 0.18em 2.25em;
     margin-bottom: 0.25em;
     margin-top: 0;
     text-align: left;
 }
-")
+.hilite {
+  background-color: #FFFF99;
+}
+.about {
+  font-size: 60%;
+  font-style: italic;
+  text-align: center;
+  margin: 0.5em 0 -0.25em 0;
+}")
+
+(defn js []
+"// NOTE: Experimental
+document.lastElem = null;
+
+function RemoveHilite(el) {
+    if(el) {
+        var t = el.className;
+        t = t.replace('hilite', '').trim();
+        el.className = t;
+    }
+}
+
+function AddHilite(el) {
+    if(el) {
+        var t = el.className;
+        t = t.replace('hilite', '').trim();
+        t += ' hilite';
+        el.className = t;
+    }
+}
+
+function SetHilight()
+{
+    var el;
+    if(document.lastElem) {
+        el = document.getElementById(document.lastElem);
+        RemoveHilite(el);
+    }
+
+    var id = window.location.hash.substr(1);
+    el = document.getElementById(id);
+    if(el) {
+        document.lastElem = id;
+        AddHilite(el);
+    }
+}
+
+document.addEventListener('DOMContentLoaded', function(e) {
+    SetHilight();
+    window.addEventListener('hashchange', function(e) {
+        SetHilight();
+    });
+});")

 (defn book-name [book-id]
   (let [m {
@@ -175,6 +231,9 @@
     :Revelation     "Revelation"}]
     (get m book-id)))

+(defn book-elem-id [book-id]
+  (s/replace (book-name book-id) " " "-"))
+
 (defn chapter-name
   ([book-id chap-num chap-count]
     (if (> chap-count 1)
@@ -194,7 +253,7 @@
     (rel-url book-id chap-num chap-cnt)))

 (defn toc-book [b]
-  [:p.tocp {:id (book-name (:id b))}
+  [:p.tocp {:id (book-elem-id (:id b))}
     [:span.chapter (book-name (:id b))]
     " "
     (->> (:chapters b)
@@ -219,7 +278,10 @@
           [:h2 "The New Testament"]
           (->> m
             (drop 39)
-            (map toc-book))]]]))
+            (map toc-book))
+
+          [:div.about [:a {:href "https://github.com/pstephens/EverlastingBible/blob/master/README.md"} "About EverlastingBible.com"]]]
+        [:script {:type "text/javascript" :src "hiliter.js"}]]]))

 (defn chapters [m]
   (->> m
@@ -285,18 +347,29 @@
     (let [[_ acc] (tokens-to-markup tokens '())]
       acc)))

-(defn number-markup [i {subtitle :subtitle :as ch}]
+(defn verse-num [i {chapter-has-subtitle :subtitle :as ch}]
   (cond
-    (postscript? i ch) ""
-    (subtitle? i ch) ""
+    (postscript? i ch) nil
+    (subtitle? i ch) nil
     :else
-    (let [delta (if subtitle 0 1)
+    (let [delta (if chapter-has-subtitle 0 1)
           verse-num (+ i delta)]
-      (str verse-num " "))))
+      verse-num)))
+
+(defn number-markup [i ch]
+  (if-let [num (verse-num i ch)]
+    (list [:a {:href (str (rel-url ch) "#" num)} num] " ")
+    ""))
+
+(defn verse-id [i ch]
+  (if-let [num (verse-num i ch)]
+    {:id num}
+    {}))

 (defn verse [i ch v]
   (let [tokens (tokenize v)]
-    [:p {:class (verse-class i ch)}
+    [:p
+      (merge {:class (verse-class i ch)} (verse-id i ch))
       (number-markup i ch)
       (tokens-to-markup tokens)]))

@@ -319,17 +392,19 @@
         [:title (str (chapter-name ch) " - The King James Bible")]
         [:link {:rel "stylesheet" :type "text/css" :href "styles.css"}]]
       [:body
-        [:body.content
+        [:div.content
           [:div.menu
             [:div.menu2
+              [:a {:href (str ".#" (book-elem-id book-id))} (chapter-name ch)]
+              "  "
               (chapter-url prev-ch "<<")
-              " "
-              (chapter-url next-ch ">>")
-              " "
-              [:a {:href (str ".#" (book-name book-id))} (chapter-name ch)]]]
+              "  "
+              (chapter-url next-ch ">>")]]
           [:h1.chap
             (chapter-name ch)]
-          (map-indexed #(verse %1 ch %2) verses)]]]))
+          (map-indexed #(verse %1 ch %2) verses)
+          [:div.about [:a {:href "https://github.com/pstephens/EverlastingBible/blob/master/README.md"} "About EverlastingBible.com"]]
+          [:script {:type "text/javascript" :src "hiliter.js"}]]]]))

 (defn next-chapter [all-chapters i]
   (get all-chapters (inc i)))
@@ -346,6 +421,7 @@
   (let [m (parse parser src)
         all-chapters (chapters m)]
     (write! output-dir "styles.css" (style))
+    (write! output-dir "hiliter.js" (js))
     (write! output-dir "7ce12f75-f371-4e85-a3e9-b7749a65f140.html" (toc m))
     (dorun
       (map-indexed


Fix execute-el bug found by property test

--- src/asciinema/player/vt.cljc
+++ src/asciinema/player/vt.cljc
@@ -476,7 +476,8 @@
       vt)))

 (defn execute-el [{:keys [width height char-attrs] {:keys [x y]} :cursor :as vt}]
-  (let [n (get-param vt 0 0)]
+  (let [n (get-param vt 0 0)
+        x (min x (dec width))]
     (update-in vt [:lines y] (fn [line]
                                (case n
                                  0 (clear-line-right line x char-attrs)


Do all the io

Do all the io

--- src/aurora/runtime/core.cljs
+++ src/aurora/runtime/core.cljs
@@ -51,6 +51,7 @@
       (language/add-facts-compat cur :known|pretended init-facts)
       (language/add-facts-compat cur :known|pretended aurora-facts)
       (language/fixpoint! cur)
+      (tick-watchers cur (:watchers env) (:feeder-fn env))
       (loop [cur cur
              prev prev
              i 0]