Continue refactoring message to new logging (WIP)

By line count, I'm about halfway through the file. So far, I'm working
around the pieces that look like they might be interesting.

Thoroughly untested, except for checking that it compiles.

--- src/clojure/frereth_cp/message.clj
+++ src/clojure/frereth_cp/message.clj
@@ -63,6 +63,7 @@

 (s/def ::source-tags #{::child-> ::parent-> ::query-state})
 (s/def ::input (s/tuple ::source-tags bytes?))
+(s/def ::next-action-time nat-int?)

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Internal API
@@ -161,7 +162,12 @@
    {{:keys [::specs/next-action]} ::specs/flow-control
     :keys [::specs/message-loop-name]
     :as state}]
-  (let [prelog (utils/pre-log message-loop-name)]
+  (let [state (update state
+                      ::log2/state
+                      #(log2/debug %
+                                   ::trigger-output
+                                   "Possibly sending message to parent"
+                                   {::specs/message-loop-name message-loop-name}))]
     ;; I have at least 1 unit test that receives input
     ;; from parent, forwards that to child, then
     ;; echoes it back.
@@ -171,9 +177,8 @@
     ;; just queued, and starts over.
     ;; It's very tempting to try to account for
     ;; that scenario here, but it would involve
-    ;; enough extra stateful contortions (we'd
-    ;; have to peek
-    (log/debug prelog "Possibly sending message to parent")
+    ;; enough extra stateful contortions.
+
     ;; This is a scenario when it seems like it would
     ;; be nice to be able to peek into io-handle's stream.
     ;; If a message from the child just got buffered, it
@@ -238,11 +243,13 @@
     :keys [::specs/message-loop-name]
     :as state}]
   {:pre [callback]}
-  (let [prelog (utils/pre-log message-loop-name)]
-    (log/info prelog
-              "trigger-from-child"
-              "\nSent stream address:"
-              strm-hwm)
+  (let [state (update state
+                      ::log2/state
+                      #(log2/info %
+                                  ::trigger-from-child
+                                  "Sent stream address"
+                                  {::specs/strm-hwm strm-hwm
+                                   ::specs/message-loop-name message-loop-name}))]
     (deliver accepted? true)
     (let [state' (callback state)]
       ;; TODO: check whether we can do output now.
@@ -411,7 +418,7 @@
             ;; Actually, should probably add an optional client-supplied
             ;; error handler for situations like this
             (assoc state
-                   ::log/state
+                   ::log2/state
                    (log2/warn log-state
                               ::trigger-from-parent
                               "Incoming message too large"
@@ -420,7 +427,7 @@
         ;; TODO: Need a way to apply back-pressure
         ;; to child
         (assoc state
-               ::log/state
+               ::log2/state
                (log2/warn log-state
                           ::trigger-from-parent
                           "Child buffer overflow\nWait!"
@@ -435,11 +442,16 @@
   ;; But (at least in theory) it could also trigger
   ;; output to-child.
   ;; So leave it be for now.
-  (log/debug (utils/pre-log message-loop-name) "I/O triggered by timer")
+
   ;; I keep thinking that I need to check data arriving from
   ;; the child, but the main point to this logic branch is
   ;; to resend an outbound block that hasn't been ACK'd yet.
-  (trigger-output io-handle state))
+  (trigger-output io-handle (update state
+                                    ::log2/state
+                                    #(log2/debug %
+                                                 ::trigger-from-timer
+                                                 "I/O triggered by timer"
+                                                 {::specs/message-loop-name message-loop-name}))))

 (defn condensed-choose-next-scheduled-time
   [{{:keys [::specs/n-sec-per-block
@@ -544,7 +556,8 @@
 (s/fdef choose-next-scheduled-time
         :args (s/cat :state ::specs/state
                      :to-child-done? ::specs/to-child-done?)
-        :ret nat-int?)
+        :ret (s/keys :req [::next-action-time
+                           ::log2/state]))
 (defn choose-next-scheduled-time
   [{{:keys [::specs/n-sec-per-block
             ::specs/rtt-timeout]} ::specs/flow-control
@@ -559,6 +572,7 @@
      :as outgoing} ::specs/outgoing
     :keys [::specs/message-loop-name
            ::specs/recent]
+    log-state ::log2/state
     :as state}
    to-child-done?]
   ;;; This amounts to lines 286-305
@@ -703,25 +717,32 @@
                                     (long based-on-closed-child)))
         mid2-time (System/nanoTime)
         alt (condensed-choose-next-scheduled-time state to-child-done?)
-        end-time (System/nanoTime)]
-    (log/debug prelog "Scheduling considerations\n" log-message)
-    (when-not (= actual-next alt)
-      (log/warn prelog
-                "Scheduling Mismatch!"))
-    (log/debug prelog
-               ;; alt approach seems ~4 orders of magnitude
-               ;; faster.
-               ;; Q: Is that due to reduced logging?
-               (cl-format nil (str "Calculating next scheduled time took"
-                                   " ~:d nanoseconds and calculated ~:d."
-                                   "\nBuilding the messages about this took ~:d nanoseconds"
-                                   "\nAlt approach took ~:d and calculated ~:d")
-                          (- mid1-time now)
-                          (long actual-next)
-                          (- mid2-time mid1-time)
-                          (- end-time mid2-time)
-                          (long alt)))
-    actual-next))
+        end-time (System/nanoTime)
+        log-state (log2/debug log-state
+                              ::choose-next-scheduled-time
+                              (str "Scheduling considerations\n"
+                                   log-message))
+        log-state (if (= actual-next alt)
+                    log-state
+                    (log2/warn log-state
+                               ::choose-next-scheduled-time
+                               "Scheduling Mismatch!"))
+        log-state (log2/debug log-state
+                              ::choose-next-scheduled-time
+                              ;; alt approach seems ~4 orders of magnitude
+                              ;; faster.
+                              ;; Q: Is that due to reduced logging?
+                              (cl-format nil (str "Calculating next scheduled time took"
+                                                  " ~:d nanoseconds and calculated ~:d."
+                                                  "\nBuilding the messages about this took ~:d nanoseconds"
+                                                  "\nAlt approach took ~:d and calculated ~:d")
+                                         (- mid1-time now)
+                                         (long actual-next)
+                                         (- mid2-time mid1-time)
+                                         (- end-time mid2-time)
+                                         (long alt)))]
+    {::next-action-time actual-next
+     ::log2/state log-state}))

 (declare schedule-next-timeout!)
 (defn action-trigger
@@ -731,7 +752,8 @@
     :as timing-details}
    {:keys [::specs/message-loop-name]
     :as io-handle}
-   state
+   {log-state ::log2/state
+    :as state}
    ;; This is a variant that consists of a [tag callback] pair
    ;; It's tempting to destructure this here.
    ;; That makes the code a little more concise,
@@ -747,11 +769,11 @@
    ;; then destructure args later. But that makes
    ;; it less obviously a win.
    success]
-  (let [prelog (utils/pre-log message-loop-name)  ; might be on a different thread
+  (let [now (System/nanoTime)
+        prelog (utils/pre-log message-loop-name)  ; might be on a different thread
         fmt (str "Awakening event loop that was sleeping for ~g ms "
                  "after ~:d at ~:d\n"
                  "at ~:d because: ~a")
-        now (System/nanoTime)
         ;; Line 337
         ;; Doing this now instead of after trying to receive data from the
         ;; child seems like a fairly significant change from the reference
@@ -759,160 +781,173 @@
         ;; TODO: Compare with other higher-level implementations
         ;; TODO: Ask cryptographers and protocol experts whether this is
         ;; a choice I'll really regret
-        state (assoc state ::specs/recent now)]
-    (try
-      (log/debug prelog
-                 (cl-format nil
-                            fmt
-                            delta_f
-                            scheduling-time
-                            (or actual-next -1)
-                            now
-                            success))
-      (catch NullPointerException ex
-        (log/error ex (str "Error building the event loop Awakening message\n"
-                           {::delta_f delta_f
-                            ::scheduling-time scheduling-time
-                            ::actual-next actual-next
-                            ::now now
-                            ::success success})))
-      (catch NumberFormatException ex
-        (log/error ex (str "Error formatting the event loop Awakening message\n"
-                           {::delta_f delta_f
-                            ::scheduling-time scheduling-time
-                            ::actual-next actual-next
-                            ::now now
-                            ::success success}))))
-    (let [tag (try (first success)
-                   (catch IllegalArgumentException ex
-                     (log/error ex
-                                prelog
-                                "Should have been a variant")
-                     ::no-op))
-          updater
-          ;; Q: Is this worth switching to something like core.match or a multimethod?
-          (case tag
-            ::specs/child-> (let [[_ callback ack] success]
-                              (partial trigger-from-child io-handle callback ack))
-            ::drained (do (log/warn prelog
-                                    ;; Actually, this seems like a strong argument for
-                                    ;; having a pair of streams. Child could still have
-                                    ;; bytes to send to the parent after the latter's
-                                    ;; stopped sending, or vice versa.
-                                    ;; I'm pretty sure the complexity I haven't finished
-                                    ;; translating stems from that case.
-                                    ;; TODO: Another piece to revisit once the basics
-                                    ;; work.
-                                    "Stream closed. Surely there's more to do")
-                          (constantly nil))
-            ::parent-> (partial trigger-from-parent
-                                io-handle
-                                (second success))
-            ::no-op identity
-            ;; This can throw off the timer, since we're basic the delay on
-            ;; the delta from recent (which doesn't change) rather than now.
-            ;; But we're basing the actual delay from now, which does change.
-            ;; e.g. If the scheduled delay is 980 ms, and someone triggers a
-            ;; query-state that takes 20 ms after 20 ms, the new delay will
-            ;; still be 980 ms rather than the 940 that would have been
-            ;; appropriate.
-            ;; Q: What's the best way to avoid this?
-            ::query-state (fn [state]
-                            (if-let [dst (second success)]
-                              (deliver dst state)
-                              (log/warn prelog "state-query request missing required deferred"))
-                            state)
-            ::timed-out (do
-                          (log/debug prelog
-                                     (cl-format nil
-                                                "Timer for ~:d ms after ~:d timed out. Re-triggering Output"
-                                                delta_f
-                                                scheduling-time))
-                          (partial trigger-from-timer io-handle)))]
-      (when (not= tag ::drained)
-        (log/debug prelog "Processing event:" tag)
-        ;; At the end of the main ioloop in the refernce
-        ;; implementation, there's a block that closes the pipe
-        ;; to the child if we're done.
-        ;; I think the point is that we'll quit polling on
-        ;; that and start short-circuiting out of the blocks
-        ;; that might do the send, once we've hit EOF
-        ;; Q: What can I do here to
-        ;; produce the same effect?
-        ;; TODO: Worry about that once the basic idea works.
-
-        ;; If the child sent a big batch of data to go out
-        ;; all at once, don't waste time setting up a timeout
-        ;; scheduler. The poll in the original would have
-        ;; returned immediately anyway.
-        ;; Except that n-sec-per-block puts a hard limit on how
-        ;; fast we can send.
-        (let [start (System/nanoTime)
-              ;; TODO: Break these pieces into something
-              ;; like the interceptor-chain idea. They should
-              ;; return a value that includes a key for a
-              ;; seq of functions to run to perform the
-              ;; side-effects.
-              ;; I'd still have to call updater, get
-              ;; that updating seq, and update the state
-              ;; to recurse.
-
-              ;; I'd prefer to do these next two
-              ;; pieces in a single step.
-
-              ;; TODO: Read up on Executors. I could wind up
-              ;; with really nasty interactions now that I
-              ;; don't have an agent to keep this single-
-              ;; threaded.
-              ;; Actually, it should be safe as written.
-              ;; Just be sure to keep everything synchronized
-              ;; around takes from the i/o handle. (Not
-              ;; needing to do that manually is
-              ;; a great reason to not introduce a second
-              ;; one for bytes travelling the other direction)
-              state' (try (updater state)
-                          (catch ExceptionInfo ex
-                            (log/error ex
-                                       (str
-                                        prelog
-                                        "Running updater failed.\nDetails:\n"
-                                        (.getData ex))))
-                          (catch RuntimeException ex
-                            (log/error ex
-                                       prelog
-                                       "Running updater failed")
-                            ;; The eternal question in this scenario:
-                            ;; Fail fast, or hope we can keep limping
-                            ;; along?
-                            ;; TODO: Add prod vs. dev environment options
-                            ;; to give the caller control over what
-                            ;; should happen here.
-                            ;; (Note that, either way, it really should
-                            ;; include a callback to some
-                            ;; currently-undefined status updater
-                            (comment state)))
-              state' (update state'
-                             ::log2/state
-                             #(log2/flush-logs! (::log2/logger io-handle) %))
-              mid (System/nanoTime)
-              ;; This is taking a ludicrous amount of time.
-              ;; Q: How much should I blame on logging?
-              _ (schedule-next-timeout! io-handle state')
-              end (System/nanoTime)]
-          ;; FIXME: This needs to change to new logging system.
-          ;; Although, really, that's more trouble than it's worth.
-          ;; I'd have to fork the logs to send one half to schedule-next-timeout!
-          ;; and then flush this again.
-          ;; Better to fix my scheduling mismatch and just ditch my initial approach.
-          (log/debug prelog
-                     (cl-format nil
-                                (str
-                                 "Handling ~a event took ~:d nanoseconds\n"
-                                 "Scheduling next timeout took ~:d  nanoseconds")
-                                tag
-                                (- mid start)
-                                (- end mid)))
-          nil)))))
+        state (assoc state ::specs/recent now)
+        log-state
+        (try
+          (log2/debug log-state
+                      ::action-trigger
+                      (cl-format nil
+                                 fmt
+                                 delta_f
+                                 scheduling-time
+                                 (or actual-next -1)
+                                 now
+                                 success))
+          (catch NullPointerException ex
+            (log2/exception log-state
+                            ex
+                            ::action-trigger
+                            "Error building the event loop Awakening message"
+                            {::delta_f delta_f
+                             ::scheduling-time scheduling-time
+                             ::actual-next actual-next
+                             ::now now
+                             ::success success}))
+          (catch NumberFormatException ex
+            (log2/exception log-state
+                            ex
+                            ::action-trigger
+                            "Error formatting the event loop Awakening message"
+                            {::delta_f delta_f
+                             ::scheduling-time scheduling-time
+                             ::actual-next actual-next
+                             ::now now
+                             ::success success})))
+        [tag
+         log-state] (try [(first success) log-state]
+                         (catch IllegalArgumentException ex
+                           [::no-op
+                            (log2/exception log-state
+                                            ex
+                                            ::action-trigger
+                                            "Should have been a variant")]))
+        ;; TODO: Really should add something like a transaction ID to the state
+        ;; to assist in tracing the action
+        updater
+        ;; Q: Is this worth switching to something like core.match or a multimethod?
+        (case tag
+          ::specs/child-> (let [[_ callback ack] success]
+                            (partial trigger-from-child io-handle callback ack))
+          ::drained (do (throw (RuntimeException. "Start back here, after I've checked handshake test"))
+                        (log/warn prelog
+                                  ;; Actually, this seems like a strong argument for
+                                  ;; having a pair of streams. Child could still have
+                                  ;; bytes to send to the parent after the latter's
+                                  ;; stopped sending, or vice versa.
+                                  ;; I'm pretty sure the complexity I haven't finished
+                                  ;; translating stems from that case.
+                                  ;; TODO: Another piece to revisit once the basics
+                                  ;; work.
+                                  "Stream closed. Surely there's more to do")
+                        (constantly nil))
+          ::parent-> (partial trigger-from-parent
+                              io-handle
+                              (second success))
+          ::no-op identity
+          ;; This can throw off the timer, since we're basic the delay on
+          ;; the delta from recent (which doesn't change) rather than now.
+          ;; But we're basing the actual delay from now, which does change.
+          ;; e.g. If the scheduled delay is 980 ms, and someone triggers a
+          ;; query-state that takes 20 ms after 20 ms, the new delay will
+          ;; still be 980 ms rather than the 940 that would have been
+          ;; appropriate.
+          ;; Q: What's the best way to avoid this?
+          ::query-state (fn [state]
+                          (if-let [dst (second success)]
+                            (deliver dst state)
+                            (log/warn prelog "state-query request missing required deferred"))
+                          state)
+          ::timed-out (do
+                        (log/debug prelog
+                                   (cl-format nil
+                                              "Timer for ~:d ms after ~:d timed out. Re-triggering Output"
+                                              delta_f
+                                              scheduling-time))
+                        (partial trigger-from-timer io-handle)))]
+    (when (not= tag ::drained)
+      (log/debug prelog "Processing event:" tag)
+      ;; At the end of the main ioloop in the refernce
+      ;; implementation, there's a block that closes the pipe
+      ;; to the child if we're done.
+      ;; I think the point is that we'll quit polling on
+      ;; that and start short-circuiting out of the blocks
+      ;; that might do the send, once we've hit EOF
+      ;; Q: What can I do here to
+      ;; produce the same effect?
+      ;; TODO: Worry about that once the basic idea works.
+
+      ;; If the child sent a big batch of data to go out
+      ;; all at once, don't waste time setting up a timeout
+      ;; scheduler. The poll in the original would have
+      ;; returned immediately anyway.
+      ;; Except that n-sec-per-block puts a hard limit on how
+      ;; fast we can send.
+      (let [start (System/nanoTime)
+            ;; TODO: Break these pieces into something
+            ;; like the interceptor-chain idea. They should
+            ;; return a value that includes a key for a
+            ;; seq of functions to run to perform the
+            ;; side-effects.
+            ;; I'd still have to call updater, get
+            ;; that updating seq, and update the state
+            ;; to recurse.
+
+            ;; I'd prefer to do these next two
+            ;; pieces in a single step.
+
+            ;; TODO: Read up on Executors. I could wind up
+            ;; with really nasty interactions now that I
+            ;; don't have an agent to keep this single-
+            ;; threaded.
+            ;; Actually, it should be safe as written.
+            ;; Just be sure to keep everything synchronized
+            ;; around takes from the i/o handle. (Not
+            ;; needing to do that manually is
+            ;; a great reason to not introduce a second
+            ;; one for bytes travelling the other direction)
+            state' (try (updater state)
+                        (catch ExceptionInfo ex
+                          (log/error ex
+                                     (str
+                                      prelog
+                                      "Running updater failed.\nDetails:\n"
+                                      (.getData ex))))
+                        (catch RuntimeException ex
+                          (log/error ex
+                                     prelog
+                                     "Running updater failed")
+                          ;; The eternal question in this scenario:
+                          ;; Fail fast, or hope we can keep limping
+                          ;; along?
+                          ;; TODO: Add prod vs. dev environment options
+                          ;; to give the caller control over what
+                          ;; should happen here.
+                          ;; (Note that, either way, it really should
+                          ;; include a callback to some
+                          ;; currently-undefined status updater
+                          (comment state)))
+            state' (update state'
+                           ::log2/state
+                           #(log2/flush-logs! (::log2/logger io-handle) %))
+            mid (System/nanoTime)
+            ;; This is taking a ludicrous amount of time.
+            ;; Q: How much should I blame on logging?
+            _ (schedule-next-timeout! io-handle state')
+            end (System/nanoTime)]
+        ;; FIXME: This needs to change to new logging system.
+        ;; Although, really, that's more trouble than it's worth.
+        ;; I'd have to fork the logs to send one half to schedule-next-timeout!
+        ;; and then flush this again.
+        ;; Better to fix my scheduling mismatch and just ditch my initial approach.
+        (log/debug prelog
+                   (cl-format nil
+                              (str
+                               "Handling ~a event took ~:d nanoseconds\n"
+                               "Scheduling next timeout took ~:d  nanoseconds")
+                              tag
+                              (- mid start)
+                              (- end mid)))
+        nil))))

 (comment
   (let [delta_f ##Inf,
@@ -972,6 +1007,7 @@
             ::specs/receive-total-bytes
             ::specs/receive-written]} ::specs/incoming
     {:keys [::specs/send-eof-acked]} ::specs/outgoing
+    log-state ::log2/state
     :as state}]
   {:pre [recent]}
   (let [{{:keys [::specs/next-action]
@@ -983,7 +1019,8 @@
                           "Top of scheduler at ~:d"
                           now))
     (if (not (strm/closed? stream))
-      (let [actual-next
+      (let [{actual-next ::next-action-time
+             log-state ::log2/state}
             ;; TODO: Reframe this logic around
             ;; whether child-input-loop and
             ;; child-output-loop have been realized
@@ -991,20 +1028,19 @@
             (if (and send-eof-acked
                      (not= receive-eof ::specs/false)
                      (= receive-written receive-total-bytes))
-              (do
-                ;; Note that we can't *really* exit until
-                ;; the caller closes the stream.
-                ;; After all, unit tests want/need to
-                ;; examine the final system state (which
-                ;; means calling into this loop)
-                (log/warn (str prelog
-                               "Main ioloop is done."
-                               "\nsend-eof-acked: " send-eof-acked
-                               "\nreceive-eof: " receive-eof
-                               "\nreceive-written: " receive-written
-                               "\nreceive-total-bytes: " receive-total-bytes
-                               "\nIdling"))
-                nil)
+              {::next-action-time nil
+               ;; Note that we can't *really* exit until
+               ;; the caller closes the stream.
+               ;; After all, unit tests want/need to
+               ;; examine the final system state (which
+               ;; means calling into this loop)
+               ::log2/state (log2/warn log-state
+                                       "Main ioloop is done. Idling."
+                                       {::specs/message-loop-name message-loop-name
+                                        ::specs/receive-eof receive-eof
+                                        ::specs/receive-written receive-written
+                                        ::specs/receive-total-bytes receive-total-bytes
+                                        ::specs/send-eof-acked send-eof-acked})}
               (choose-next-scheduled-time state to-child-done?))
             {:keys [::delta_f
                     ::next-action]}


Reduce state-wrapper parameters in message (WIP)

It wasn't needed in most of the places where I was using it.

Also got pickier about the wrapper function for building the log prefix
when I have that instead of the plain state value.

This is really just an incremental refactoring checkin. It compiles, but
I haven't run any tests yet.

--- src/clojure/frereth_cp/message.clj
+++ src/clojure/frereth_cp/message.clj
@@ -60,8 +60,9 @@
 (s/def ::stream (s/and strm/sink?
                        strm/source?))

-(s/def ::state-wrapper (s/keys :req [::specs/state-atom]
-                               :opt [::stream]))
+(s/def ::unstarted-state-wrapper (s/keys :req [::specs/state-atom]))
+(s/def ::state-wrapper (s/merge ::unstarted-state-wrapper
+                                (s/keys :req [::stream])))

 (s/def ::source-tags #{::child-> ::parent->})
 (s/def ::input (s/tuple ::source-tags bytes?))
@@ -70,10 +71,10 @@
 ;;; Internal API

 (s/fdef pre-log
-        :args (s/cat :wrapper ::state-wrapper)
+        :args (s/cat :wrapper ::state-atom)
         :ret string?)
 (defn pre-log
-  [{:keys [::specs/state-atom]}]
+  [state-atom]
   (-> state-atom
       deref
       ::specs/message-loop-name
@@ -168,9 +169,12 @@
   ;; and get an ACK in the past, that would be awesome.
   ;; TODO: Be smarter about the timeout.
   (let [now (System/nanoTime)
-        ;; TODO: This seems to be screaming for cond->
+        ;; TODO: Switch to the alt version using cond->
+        ;; But first, see whether the performance diffence
+        ;; goes away if I just eliminate all the logging
         min-resend-time (+ last-block-time n-sec-per-block)
-        _ (log/debug (utils/pre-log message-loop-name)
+        prelog (utils/pre-log message-loop-name)
+        _ (log/debug prelog
                      (cl-format nil
                                 (str "Minimum send time: ~:d\n"
                                      "which is ~:d nanoseconds\n"
@@ -187,13 +191,13 @@
                                 last-block-time
                                 (- now recent)))
         default-next (+ recent (utils/seconds->nanos 60))  ; by default, wait 1 minute
-        _ (log/debug (cl-format nil
-                                "~a: Default +1 minute: ~:d from ~:d"
-                                message-loop-name
+        _ (log/debug prelog
+                     (cl-format nil
+                                "Default +1 minute: ~:d from ~:d"
                                 default-next
                                 recent))
         ;; Lines 286-289
-        _ (log/debug (str message-loop-name ": Scheduling based on want-ping value '" want-ping "'"))
+        _ (log/debug prelog (str "Scheduling based on want-ping value '" want-ping "'"))
         next-based-on-ping (if want-ping
                              ;; Go with the assumption that this matches wantping 1 in the original
                              ;; I think the point there is for the
@@ -202,10 +206,9 @@
                                (+ recent (utils/seconds->nanos 1))
                                (min default-next min-resend-time))
                              default-next)
-        _ (log/debug (cl-format nil
-                                "~a: Based on ping settings, adjusted next time to: ~:d"
-                                message-loop-name
-                                next-based-on-ping))
+        _ (log/debug prelog (cl-format nil
+                                        "Based on ping settings, adjusted next time to: ~:d"
+                                        next-based-on-ping))
         ;; Lines 290-292
         ;; Q: What is the actual point to this?
         ;; (the logic seems really screwy, but that's almost definitely
@@ -234,7 +237,8 @@
                                     ;; attempt seems to agree).
                                     ;; TODO: Double-check the reference
                                     (min next-based-on-ping min-resend-time)]
-                                (log/debug "EOF/unsent criteria:\nun-ackd-count:"
+                                (log/debug prelog
+                                           "EOF/unsent criteria:\nun-ackd-count:"
                                            un-ackd-count
                                            "\nun-sent-count:"
                                            un-sent-count
@@ -243,12 +247,13 @@
                                            "\nsend-eof-processed:"
                                            send-eof-processed)
                                 (when (= 0 un-sent-count)
-                                  (log/warn "Double-check reference against empty un-ACK'd"))
+                                  (log/warn prelog
+                                            "Double-check reference against empty un-ACK'd"))
                                 next-time)
                               next-based-on-ping))
-        _ (log/debug (cl-format nil
-                                "~a: Due to EOF status: ~:d"
-                                message-loop-name
+        _ (log/debug prelog
+                     (cl-format nil
+                                "Due to EOF status: ~:d"
                                 next-based-on-eof))
         ;; Lines 293-296
         rtt-resend-time (+ earliest-time rtt-timeout)
@@ -266,10 +271,10 @@
                                                       min-resend-time))
                                             (min next-based-on-eof rtt-resend-time)
                                             next-based-on-eof)
-        _ (log/debug (cl-format nil
-                                  "~a: Adjusted for RTT: ~:d"
-                                  message-loop-name
-                                  next-based-on-earliest-block-time))
+        _ (log/debug prelog
+                     (cl-format nil
+                                "Adjusted for RTT: ~:d"
+                                next-based-on-earliest-block-time))
         ;; There's one last caveat, from 298-300:
         ;; It all swirls around watchtochild, which gets set up
         ;; between lines 276-279.
@@ -282,9 +287,9 @@
                                        (nil? watch-to-child))
                                 0
                                 next-based-on-earliest-block-time)
-        _ (log/debug (cl-format nil
-                                "~a: After [pretending to] adjusting for closed/ignored child watcher: ~:d"
-                                message-loop-name
+        _ (log/debug prelog
+                     (cl-format nil
+                                "After [pretending to] adjusting for closed/ignored child watcher: ~:d"
                                 based-on-closed-child))
         ;; Lines 302-305
         actual-next (max based-on-closed-child recent)
@@ -309,9 +314,9 @@
                    (>= rtt-resend-time min-resend-time)) (min rtt-resend-time))
         end-time (System/nanoTime)]
     (when-not (= actual-next alt)
-      (log/warn (utils/pre-log message-loop-name)
+      (log/warn prelog
                 "Scheduling Mismatch!"))
-    (log/debug (utils/pre-log message-loop-name)
+    (log/debug prelog
                ;; alt approach seems ~4 orders of magnitude
                ;; faster.
                ;; Q: Is that due to reduced logging?
@@ -332,6 +337,11 @@
 (declare trigger-from-child
          trigger-from-parent
          trigger-from-timer)
+;; Those functions pretty much all require the
+;; full-blown state-wrapper parameter, since
+;; they recurse back into here.
+;; Pretty much nothing else anywhere should.
+;; TODO: Track that down and make it so.
 (s/fdef schedule-next-timeout!
         :args (s/cat :state-wrapper ::state-wrapper)
         :ret ::state-wrapper)
@@ -344,10 +354,10 @@
          {:keys [::specs/next-action]
           :as flow-control} ::specs/flow-control
          :as state} @state-atom
-        pre-log (pre-log state-wrapper)
+        prelog (pre-log (::specs/state-atom state-wrapper))
         now (System/nanoTime)]
     (assert recent)
-    (log/debug pre-log
+    (log/debug prelog
                (cl-format nil
                           "Top of scheduler at ~:d"
                           now))
@@ -376,7 +386,7 @@
               ;; For printing
               delta_f (float delta)
               next-action (strm/try-take! stream [::drained] delta_f [::timed-out])]
-          (log/debug pre-log
+          (log/debug prelog
                      (cl-format nil
                                 "Initially calculated scheduled delay: ~:d nanoseconds after ~:d vs. ~:d"
                                 scheduled-delay
@@ -388,8 +398,9 @@
                                              "after ~:d at ~:d "
                                              "possibly "
                                              "because input arrived "
-                                             "from elsewhere at ~:d:\n~a")]
-                                (log/debug pre-log
+                                             "from elsewhere at ~:d:\n~a")
+                                    tag (first success)]
+                                (log/debug prelog
                                            (cl-format nil
                                                       fmt
                                                       delta_f
@@ -397,8 +408,8 @@
                                                       actual-next
                                                       (System/nanoTime)
                                                       success))
-                                (case (first success)
-                                  ::drained (do (log/warn pre-log
+                                (case tag
+                                  ::drained (do (log/warn prelog
                                                           ;; Actually, this seems like a strong argument for
                                                           ;; having a pair of streams. Child could still have
                                                           ;; bytes to send to the parent after the latter's
@@ -409,23 +420,35 @@
                                                           ;; work.
                                                           "Stream closed. Surely there's more to do"))
                                   ::timed-out (do
-                                                (log/debug pre-log
+                                                (log/debug prelog
                                                            (cl-format nil
                                                                       "~Timer for ~:d ms after ~:d timed out. Re-triggering Output"
                                                                       delta_f
                                                                       now))
-                                                (trigger-from-timer state-wrapper))
-                                  ::parent-> (trigger-from-parent state-wrapper (second success))
-                                  ::child-> (trigger-from-child state (second success)))))
+                                                (trigger-from-timer state))
+                                  ::parent-> (trigger-from-parent state (second success))
+                                  ::child-> (trigger-from-child state (second success)))
+                                (when (not= tag ::drained)
+                                        (log/debug prelog "Scheduling next timeout")
+                                        ;; This is taking a ludicrous amount of time.
+                                        (let [start (System/nanoTime)
+                                              ;; Q: How much should I blame on logging?
+                                              result (schedule-next-timeout! state-wrapper)
+                                              end (System/nanoTime)]
+                                          (log/debug prelog
+                                                     (cl-format nil
+                                                                "Scheduling next timeout took ~:d  nanoseconds"
+                                                                (- end start)))
+                                          result))))
                             (fn [failure]
                               (log/error failure
-                                         pre-log
+                                         prelog
                                          (cl-format nil
                                                     "~a: Waiting on some I/O to happen in timeout ~:d ms after ~:d"
                                                     delta_f
                                                     now))
                               (reset! state-atom failure)))
-          (log/debug pre-log
+          (log/debug prelog
                      (cl-format nil
                                 "Setting timer to trigger in ~:d ms (vs ~:d scheduled)"
                                 delta_f
@@ -433,21 +456,12 @@
           (swap! state-atom (fn [{:keys [::specs/flow-control]
                                   :as cur}]
                               (assoc-in cur [::specs/flow-control ::specs/next-action] next-action)))))
-      (log/warn pre-log "I/O Stream closed"))
+      (log/warn prelog "I/O Stream closed"))
     state-wrapper))

-(comment
-  (let [s (strm/stream)
-        out (strm/try-take! s ::drained 250 ::timeout)]
-    (dfrd/on-realized out
-                      (fn [success] (println {::succeeded success}))
-                      (fn [failure] (println [::failed failure])))
-    @out))
-
 (s/fdef start-event-loops!
-        :args (s/cat :state-agent ::specs/state-agent
-                     :state ::specs/state)
-        :ret ::specs/state)
+        :args (s/cat :state-wrapper ::unstarted-state-wrapper)
+        :ret ::state-wrapper)
 ;;; TODO: This next lineno reference needs to move elsewhere.
 ;;; Although, really, it isn't even applicable any more.
 ;;; Caller provides ->parent and ->child callbacks for us
@@ -474,73 +488,64 @@
     (schedule-next-timeout! (assoc state-wrapper ::stream io-stream))))

 (s/fdef trigger-output
-        :args (s/cat :state-agent ::specs/state-agent
-                     :state ::specs/state)
+        :args (s/cat :state ::specs/state)
         :ret ::specs/state)
 (defn trigger-output
   [{{:keys [::specs/->child]} ::specs/incoming
     {:keys [::specs/next-action]} ::specs/flow-control
     :keys [::specs/message-loop-name]
     :as state}]
-  (log/debug (utils/pre-log message-loop-name) "Triggering Output")
-  ;; Originally, it seemed like it would make sense to cancel
-  ;; the timer here, to avoid duplicating the call when I
-  ;; get input from either the parent or the child.
-  ;; Doing it that way entails too much delay. If the
-  ;; timer is running in a tight loop, it might trigger
-  ;; several more times before they get around to
-  ;; actually calling this.
-  (let [state
-        (as-> state state
-          (assoc state ::specs/recent (System/nanoTime))
-          ;; It doesn't make any sense to call this if
-          ;; we were triggered by a message coming in from
-          ;; the parent.
-          ;; Even if there pending blocks are ready to
-          ;; send, outgoing messages are throttled by
-          ;; the flow-control logic.
-          ;; Likewise, there isn't a lot of sense in
-          ;; calling it from the child, due to the same
-          ;; throttling issues.
-          ;; This really only makes sense when the
-          ;; timer triggers to let us know that it's
-          ;; OK to send a new message.
-          ;; The timeout on that may completely change
-          ;; when the child schedules another send,
-          ;; or a message arrives from parent to
-          ;; update the RTT.
-          (to-parent/maybe-send-block! state))]
-    ;; At the end of the main ioloop in the refernce
-    ;; implementation, there's a block that closes the pipe
-    ;; to the child if we're done.
-    ;; I think the point is that we'll quit polling on
-    ;; that and start short-circuiting out of the blocks
-    ;; that might do the send, once we've hit EOF
-    ;; Q: What can I do here to
-    ;; produce the same effect?
-    ;; TODO: Worry about that once the basic idea works.
-
-    ;; If the child sent a big batch of data to go out
-    ;; all at once, don't waste time setting up a timeout
-    ;; scheduler. The poll in the original would have
-    ;; returned immediately anyway.
-    ;; Except that n-sec-per-block puts a hard limit on how
-    ;; fast we can send.
-    (comment
-      (let [unsent-blocks-from-child? (from-child/blocks-not-sent? state)]
-        (if unsent-blocks-from-child?
-          (recur state)
-          (schedule-next-timeout! state))))
-    (log/debug (str message-loop-name ": Scheduling next timeout"))
-    ;; This is taking a ludicrous amount of time.
-    (let [start (System/nanoTime)
-          ;; Q: How much should I blame on logging?
-          result (schedule-next-timeout! state)
-          end (System/nanoTime)]
-      (log/debug (utils/pre-log message-loop-name)
-                 (cl-format nil  "Scheduling next timeout took ~:d  nanoseconds"
-                            (- end start)))
-      result)))
+  (let [prelog (utils/pre-log message-loop-name)]
+    (log/debug prelog "Triggering Output")
+    ;; Originally, it seemed like it would make sense to cancel
+    ;; the timer here, to avoid duplicating the call when I
+    ;; get input from either the parent or the child.
+    ;; Doing it that way entails too much delay. If the
+    ;; timer is running in a tight loop, it might trigger
+    ;; several more times before they get around to
+    ;; actually calling this.
+    (let [state
+          (as-> state state
+            (assoc state ::specs/recent (System/nanoTime))
+            ;; It doesn't make any sense to call this if
+            ;; we were triggered by a message coming in from
+            ;; the parent.
+            ;; Even if there pending blocks are ready to
+            ;; send, outgoing messages are throttled by
+            ;; the flow-control logic.
+            ;; Likewise, there isn't a lot of sense in
+            ;; calling it from the child, due to the same
+            ;; throttling issues.
+            ;; This really only makes sense when the
+            ;; timer triggers to let us know that it's
+            ;; OK to send a new message.
+            ;; The timeout on that may completely change
+            ;; when the child schedules another send,
+            ;; or a message arrives from parent to
+            ;; update the RTT.
+            (to-parent/maybe-send-block! state))]
+      ;; At the end of the main ioloop in the refernce
+      ;; implementation, there's a block that closes the pipe
+      ;; to the child if we're done.
+      ;; I think the point is that we'll quit polling on
+      ;; that and start short-circuiting out of the blocks
+      ;; that might do the send, once we've hit EOF
+      ;; Q: What can I do here to
+      ;; produce the same effect?
+      ;; TODO: Worry about that once the basic idea works.
+
+      ;; If the child sent a big batch of data to go out
+      ;; all at once, don't waste time setting up a timeout
+      ;; scheduler. The poll in the original would have
+      ;; returned immediately anyway.
+      ;; Except that n-sec-per-block puts a hard limit on how
+      ;; fast we can send.
+      (comment
+        (let [unsent-blocks-from-child? (from-child/blocks-not-sent? state)]
+          (if unsent-blocks-from-child?
+            (recur state)
+            (schedule-next-timeout! state))))
+      state)))

 (s/fdef trigger-from-child
         :args (s/cat :state ::specs/state
@@ -553,58 +558,58 @@
     :as state}
    array-o-bytes]
   {:pre [array-o-bytes]}
-  (log/info (utils/pre-log message-loop-name)
-            "trigger-from-child\nSent stream address: "
-            strm-hwm)
-  (let [state' (if (from-child/room-for-child-bytes? state)
-                 (do
-                   (log/debug (utils/pre-log message-loop-name)
-                              "There is room for another message")
-                   (let [result (from-child/consume-from-child state array-o-bytes)]
-                     result))
-                 ;; trigger-output does some state management, even
-                 ;; if we discard the incoming bytes because our
-                 ;; buffer is full.
-                 ;; TODO: Need a way to signal the child to
-                 ;; try again shortly
-                 (do
-                   (log/error (utils/pre-log message-loop-name)
-                              "Discarding incoming bytes, silently")
-                   state))]
-    ;; TODO: check whether we can do output now.
-    ;; It's pointless to call this if we just have
-    ;; to wait for the timer to expire.
-    (let [state'' (trigger-output
-                   state')]
-      (log/debug (utils/pre-log message-loop-name)
-                 "Truly updating agent state due to input from child")
-      state'')))
+  (let [prelog (utils/pre-log message-loop-name)]
+    (log/info prelog
+              "trigger-from-child\nSent stream address: "
+              strm-hwm)
+    (let [state' (if (from-child/room-for-child-bytes? state)
+                   (do
+                     (log/debug prelog
+                                "There is room for another message")
+                     (let [result (from-child/consume-from-child state array-o-bytes)]
+                       result))
+                   ;; trigger-output does some state management, even
+                   ;; if we discard the incoming bytes because our
+                   ;; buffer is full.
+                   ;; TODO: Need a way to signal the child to
+                   ;; try again shortly
+                   (do
+                     (log/error prelog
+                                "Discarding incoming bytes, silently")
+                     state))]
+      ;; TODO: check whether we can do output now.
+      ;; It's pointless to call this if we just have
+      ;; to wait for the timer to expire.
+      (let [state'' (trigger-output
+                     state')]
+        (log/debug prelog
+                   "Truly updating agent state due to input from child")
+        state''))))

 (s/fdef trigger-from-parent
-        :args (s/cat :state-wrapper ::state-wrapper
+        :args (s/cat :specs/state ::specs/state
                      :array-o-bytes bytes?)
-        :ret ::state-wrapper)
+        :ret ::specs/state)
 (defn trigger-from-parent
   "Message block arrived from parent. Agent has been handed work"
   ;; TODO: Move as much of this as possible into from-parent
   ;; The only reason I haven't already moved the whole thing
   ;; is that we need to use to-parent to send the ACK, and I'd
   ;; really rather not introduce dependencies between those namespaces
-  [{:keys [::specs/state-agent]
-    :as state-wrapper}
+  [{{:keys [::specs/->child]
+     :as incoming} ::specs/incoming
+    :keys [::specs/message-loop-name]
+    :as state}
    ^bytes message]
-  (let [{{:keys [::specs/->child]
-          :as incoming} ::specs/incoming
-         :keys [::specs/message-loop-name]
-         :as state} state-agent]
+  (let [prelog (utils/pre-log message-loop-name)]
     (when-not ->child
-      (throw (ex-info (str (utils/pre-log message-loop-name)
+      (throw (ex-info (str prelog
                            "Missing ->child")
                       {::detail-keys (keys incoming)
                        ::top-level-keys (keys state)
                        ::details state})))

-    (log/debug (str message-loop-name ": Incoming from parent"))
+    (log/debug prelog "Incoming from parent")

     ;; This is basically an iteration of the top-level
     ;; event-loop handler from main().
@@ -639,19 +644,21 @@
         (trigger-output state'))
       (catch RuntimeException ex
         (log/error ex
-                   "Trying to cope with a message arriving from parent")))))
+                   (str prelog
+                        "Trying to cope with a message arriving from parent"))))))

 (defn trigger-from-timer
-  [state-wrapper]
+  [{:keys [::specs/message-loop-name]
+    :as state}]
   ;; It's really tempting to move this to to-parent.
   ;; But (at least in theory) it could also trigger
   ;; output to-child.
   ;; So leave it be for now.
-  (log/debug (pre-log state-wrapper) "I/O triggered by timer")
+  (log/debug (utils/pre-log message-loop-name) "I/O triggered by timer")
   ;; I keep thinking that I need to check data arriving from
   ;; the child, but the main point to this logic branch is
   ;; to resend an outbound block that hasn't been ACK'd yet.
-  (trigger-output state-wrapper))
+  (trigger-output state))

 (defn build-un-ackd-blocks
   []
@@ -791,7 +798,7 @@
 (defn halt!
   [{:keys [::stream]
     :as state-wrapper}]
-  (log/info (pre-log state-wrapper) "Halting")
+  (log/info (pre-log (::specs/state-atem state-wrapper)) "Halting")
   (strm/close! stream))

 (s/fdef child->
@@ -878,11 +885,11 @@
     (let [{{:keys [::specs/->child-buffer]} ::specs/incoming
            :keys [::specs/message-loop-name]
            :as state} @state-atom
-          pre-log (utils/pre-log message-loop-name)]
-      (log/info pre-log
+          prelog (utils/pre-log message-loop-name)]
+      (log/info prelog
                 "Top of parent->")
       (when-not state
-        (log/warn pre-log
+        (log/warn prelog
                   "nil state. Things went sideways recently"))
       ;; It seems very wrong to do this here. But I really need
       ;; it to happen as fast as possible, because it tends to
@@ -906,7 +913,7 @@
                                                     (map (fn [^bytes buf]
                                                            (count buf))
                                                          ->child-buffer))]
-          (log/debug pre-log
+          (log/debug prelog
                      "Have"
                      previously-buffered-message-bytes
                      "bytes in"
@@ -927,7 +934,7 @@
               ;; any filtering I can do outside an an agent send is a win.
               ;; TODO: As soon as the manifold version is working, revisit
               ;; that decision.
-              (log/debug pre-log
+              (log/debug prelog
                          "Message is small enough. Passing along to stream to handle")
               (strm/put! stream [::parent-> buf]))
             (do
@@ -936,13 +943,13 @@
               ;; TODO: More extensive error handling.
               ;; Actually, should probably add an optional client-supplied
               ;; error handler for situations like this
-              (log/warn pre-log
+              (log/warn prelog
                         (str "Message too large\n"
                              "Incoming message is " incoming-size
                              " / " K/max-msg-len))
               (schedule-next-timeout! state-wrapper))))
         (do
-          (log/warn pre-log
+          (log/warn prelog
                     (str "Child buffer overflow\n"
                          "Have " (count ->child-buffer)
                          "/"


Make caller responsible for stopping main ioloop

Mainly because my handshake test queries for state after everything else
is finished. And that sort of post-mortem analysis seems reasonable to
me.

This version almost looks like that test is really close to passing. The
only obvious failure now is that the client receives more messages than
expected.

I could adjust that easily, but it would be a false positive.

If you pay attention to the logs, there are still issues.

--- src/clojure/frereth_cp/message.clj
+++ src/clojure/frereth_cp/message.clj
@@ -360,6 +360,9 @@
                                      (assoc-in state
                                                [::specs/incoming ::specs/parent->buffer]
                                                message))
+                      ;; This is a prime example of something that should
+                      ;; be queued up to be called for side-effects.
+                      ;; TODO: Split those out and make that happen.
                       state' (to-child/forward! io-handle (or pre-processed
                                                             state))]
                   ;; This will update recent.
@@ -633,7 +636,7 @@
    ;; it less obviously a win.
    success]
   (let [prelog (utils/pre-log message-loop-name)  ; might be on a different thread
-        fmt (str "Awakening event loop that was sleeping for ~:d ms "
+        fmt (str "Awakening event loop that was sleeping for ~g ms "
                  "after ~:d at ~:d\n"
                  "at ~:d because: ~a")
         now (System/nanoTime)
@@ -645,14 +648,29 @@
         ;; TODO: Ask cryptographers and protocol experts whether this is
         ;; a choice I'll really regret
         state (assoc state ::specs/recent now)]
-    (log/debug prelog
-               (cl-format nil
-                          fmt
-                          delta_f
-                          scheduling-time
-                          actual-next
-                          now
-                          success))
+    (try
+      (log/debug prelog
+                 (cl-format nil
+                            fmt
+                            delta_f
+                            scheduling-time
+                            (or actual-next -1)
+                            now
+                            success))
+      (catch NullPointerException ex
+        (log/error ex (str "Error building the event loop Awakening message\n"
+                           {::delta_f delta_f
+                            ::scheduling-time scheduling-time
+                            ::actual-next actual-next
+                            ::now now
+                            ::success success})))
+      (catch NumberFormatException ex
+        (log/error ex (str "Error formatting the event loop Awakening message\n"
+                           {::delta_f delta_f
+                            ::scheduling-time scheduling-time
+                            ::actual-next actual-next
+                            ::now now
+                            ::success success}))))
     (let [tag (try (first success)
                    (catch IllegalArgumentException ex
                      (log/error ex
@@ -776,6 +794,23 @@
                                 (- end mid)))
           nil)))))

+(comment
+  (let [delta_f ##Inf,
+        scheduling-time 8820859844762393,
+        actual-next nil
+        now 8820859845124380
+        success [:frereth-cp.message/query-state ::whatever]
+        fmt (str "Awakening event loop that was sleeping for ~g ms "
+                 "after ~:d at ~:d\n"
+                 "at ~:d because: ~a")]
+    (cl-format nil
+               fmt
+               delta_f #_1.0
+               scheduling-time
+               (or actual-next -1)
+               now
+               success)))
+
 ;;; I really want to move schedule-next-timeout! to flow-control.
 ;;; But it has a circular dependency with trigger-from-timer.
 ;;; Which...honestly also belongs in there.
@@ -827,70 +862,89 @@
                           "Top of scheduler at ~:d"
                           now))
     (if (not (strm/closed? stream))
-      ;; TODO: Reframe this logic around
-      ;; whether child-input-loop and
-      ;; child-output-loop have been realized
-      ;; instead.
-      (if (and send-eof-acked
-               (not= receive-eof ::specs/false)
-               (= receive-written receive-total-bytes))
-        (log/warn (str prelog
-                       "Main ioloop is done."
-                       "\nsend-eof-acked: " send-eof-acked
-                       "\nreceive-eof: " receive-eof
-                       "\nreceive-written: " receive-written
-                       "\nreceive-total-bytes: " receive-total-bytes
-                       "\nExiting"))
-        ;; TODO: add a debugging step that stores state and the
-        ;; calculated time so I can just look at exactly what I have
-        ;; when everything goes sideways
-        (let [actual-next (choose-next-scheduled-time state)
-              ;; It seems like it would make more sense to have the delay happen from
-              ;; "now" instead of "recent"
-              ;; Doing that throws lots of sand into the gears.
-              ;; Stick with this approach for now, because it *does*
-              ;; match the reference implementation.
-              ;; It seems very incorrect, but it also supplies an adjustment
-              ;; for the time it took this event loop iteration to process.
-              ;; Q: Is that fair/accurate?
-              scheduled-delay (- actual-next recent)
-              ;; Make sure that at least it isn't negative
-              ;; (I keep running across bugs that have issues with this,
-              ;; and it wreaks havoc with my REPL)
-              delta-nanos (max 0 scheduled-delay)
-              delta (if (< delta-nanos 0)
-                      0
-                      (inc (utils/nanos->millis delta-nanos)))
-              ;; For printing
-              delta_f (float delta)
-              next-action (strm/try-take! stream [::drained] delta_f [::timed-out])]
-          (log/debug prelog
-                     (cl-format nil
-                                "Initially calculated scheduled delay: ~:d nanoseconds after ~:d vs. ~:d"
-                                scheduled-delay
-                                recent
-                                now))
-          (dfrd/on-realized next-action
-                            (partial action-trigger
-                                     {::actual-next actual-next
-                                      ::delta_f delta_f
-                                      ::scheduling-time now}
-                                     io-handle
-                                     state)
-                            (fn [failure]
-                              (log/error failure
-                                         prelog
-                                         (cl-format nil
-                                                    "~a: Waiting on some I/O to happen in timeout ~:d ms after ~:d"
-                                                    delta_f
-                                                    now))
-                              (strm/close! io-handle)))
-          (log/debug prelog
-                     (cl-format nil
-                                "Set timer to trigger in ~:d ms (vs ~:d scheduled) on ~a"
-                                delta_f
-                                (float (utils/nanos->millis scheduled-delay))
-                                stream))))
+      (let [actual-next
+            ;; TODO: Reframe this logic around
+            ;; whether child-input-loop and
+            ;; child-output-loop have been realized
+            ;; instead.
+            (if (and send-eof-acked
+                     (not= receive-eof ::specs/false)
+                     (= receive-written receive-total-bytes))
+              (do
+                ;; Note that we can't *really* exit until
+                ;; the caller closes the stream.
+                ;; After all, unit tests want/need to
+                ;; examine the final system state.
+                (log/warn (str prelog
+                               "Main ioloop is done."
+                               "\nsend-eof-acked: " send-eof-acked
+                               "\nreceive-eof: " receive-eof
+                               "\nreceive-written: " receive-written
+                               "\nreceive-total-bytes: " receive-total-bytes
+                               "\nExiting"))
+                nil)
+              (choose-next-scheduled-time state))
+            {:keys [::delta_f
+                    ::next-action]}
+            (if actual-next
+              ;; TODO: add an optional debugging step that stores state and the
+              ;; calculated time so I can just look at exactly what I have
+              ;; when everything goes sideways
+              (let [
+                    ;; It seems like it would make more sense to have the delay happen from
+                    ;; "now" instead of "recent"
+                    ;; Doing that throws lots of sand into the gears.
+                    ;; Stick with this approach for now, because it *does*
+                    ;; match the reference implementation.
+                    ;; It seems very incorrect, but it also supplies an adjustment
+                    ;; for the time it took this event loop iteration to process.
+                    ;; Q: Is that fair/accurate?
+                    scheduled-delay (- actual-next recent)
+                    ;; Make sure that at least it isn't negative
+                    ;; (I keep running across bugs that have issues with this,
+                    ;; and it wreaks havoc with my REPL)
+                    delta-nanos (max 0 scheduled-delay)
+                    delta (if (< delta-nanos 0)
+                            0
+                            (inc (utils/nanos->millis delta-nanos)))
+                    ;; For printing
+                    delta_f (float delta)]
+                (log/debug prelog
+                           (cl-format nil
+                                      (str "Initially calculated scheduled delay: ~:d nanoseconds after ~:d vs. ~:d"
+                                           "\nSetting timer to trigger in ~:d ms (vs ~:d scheduled) on ~a")
+                                      scheduled-delay
+                                      recent
+                                      now
+                                      delta_f
+                                      (float (utils/nanos->millis scheduled-delay))
+                                      stream))
+                {::delta_f delta_f
+                 ::next-action (strm/try-take! stream [::drained] delta_f [::timed-out])})
+              ;; The i/o portion of this loop is finished.
+              ;; But we still need to wait on the caller to close the underlying stream.
+              ;; If nothing else, it may still want/need to query state.
+              {::delta_f ##Inf
+               ::next-action (strm/take! stream [::drained])})]
+        (dfrd/on-realized next-action
+                          (partial action-trigger
+                                   {::actual-next actual-next
+                                    ::delta_f delta_f
+                                    ::scheduling-time now}
+                                   io-handle
+                                   state)
+                          (fn [failure]
+                            (log/error failure
+                                       prelog
+                                       (cl-format nil
+                                                  "~a: Waiting on some I/O to happen in timeout ~:d ms after ~:d"
+                                                  delta_f
+                                                  now))
+                            ;; We don't have any business doing this here, but the
+                            ;; alternatives don't seem appealing.
+                            ;; Well, we could recurse manually without a scheduled
+                            ;; time.
+                            (strm/close! stream))))
       (log/warn prelog "I/O Handle closed"))
     ;; Don't rely on the return value of a function called for side-effects
     nil))
@@ -1175,7 +1229,7 @@
         :ret (s/or :success ::specs/state
                    :timed-out any?)
         ;; If this timed out, should return the supplied
-        ;; time-out paremeter (or ::timed-out, if none).
+        ;; time-out parameter (or ::timed-out, if none).
         ;; Otherwise, the requested state.
         ;; TODO: Verify that this spec does what I expect.
         :fn (fn [{:keys [:args :ret]}]


Catch errors and re-throw with current system attached

--- src/com/stuartsierra/component.clj
+++ src/com/stuartsierra/component.clj
@@ -55,13 +55,19 @@
   (let [graph (dependency-graph system component-keys)]
     (reduce (fn [system key]
               (let [component (get system key)]
-                (assoc system key
-                       (start
-                        (reduce-kv (fn [component dependency-key system-key]
-                                     (assoc component dependency-key
-                                            (get system system-key)))
-                                   component
-                                   (dependencies component))))))
+                (try
+                  (assoc system key
+                         (start
+                          (reduce-kv (fn [component dependency-key system-key]
+                                       (assoc component dependency-key
+                                              (get system system-key)))
+                                     component
+                                     (dependencies component))))
+                  (catch Throwable t
+                    (throw (ex-info "Error starting component"
+                                    {:component component
+                                     :system system}
+                                    t))))))
             system
             (sort (dep/topo-comparator graph) component-keys))))

@@ -72,7 +78,13 @@
   (let [graph (dependency-graph system component-keys)]
     (reduce (fn [system key]
               (let [component (get system key)]
-                (assoc system key (stop component))))
+                (try
+                  (assoc system key (stop component))
+                  (catch Throwable t
+                    (throw (ex-info "Error stopping component"
+                                    {:component component
+                                     :system system}
+                                    t))))))
             system
             (reverse (sort (dep/topo-comparator graph) component-keys)))))


tweak logging

tweak logging

--- src/doctopus/doctopus/tentacle.clj
+++ src/doctopus/doctopus/tentacle.clj
@@ -51,8 +51,9 @@
   TentacleMethods
   (load-html [this]
     (if (= 0 (count-records-for-tentacle backend this))
-      (do (log/debug "Generating") (generate-html this))
-      (log/info "Found html for" (:name this) ", count is:" (count-records-for-tentacle backend (:name this)) "for name:" (:name this))))
+      (do (log/info "No HTML found for" (:name this))
+          (generate-html this))
+      (log/info "Found html for" (:name this))))
   (generate-html [this]
     (log/info "Generating HTML for" (:name this))
     (let [{:keys [html-commands source-location output-root]} this


fix: completely remove runner.cljs from test option

Fixes #104

--- src/leiningen/new/options/test.clj
+++ src/leiningen/new/options/test.clj
@@ -4,5 +4,4 @@
 (def option "+test")

 (defn files [data]
-  [["test/cljs/{{sanitized}}/runner.cljs" (helpers/render "test/cljs/runner.cljs" data)]
-   ["test/cljs/{{sanitized}}/core_test.cljs" (helpers/render "test/cljs/core_test.cljs" data)]])
+  [["test/cljs/{{sanitized}}/core_test.cljs" (helpers/render "test/cljs/core_test.cljs" data)]])


default streaminging timeout is 20,000 ms , so increase to 120,000 ms for this test (#1487)

--- waiter/integration/waiter/instance_tracker_integration_test.clj
+++ waiter/integration/waiter/instance_tracker_integration_test.clj
@@ -419,6 +419,7 @@
       (testing "streams updated healthy instances for service-ids that match service description filter"
         (let [watch (start-watch waiter-url cookies
                                  :query-params {"metadata.foo" "random-value-required"
+                                                "streaming-timeout" "120000"
                                                 "watch" "true"})
               {:keys [service-id] :as response}
               (make-request-with-debug-info


Helper method for support.

Helper method for support.

--- src/oc/storage/resources/entry.clj
+++ src/oc/storage/resources/entry.clj
@@ -351,7 +351,11 @@
   Given the UUID of the org, an order, one of `:asc` or `:desc`, a start date as an ISO8601 timestamp,
   and a direction, one of `:before` or `:after`, return the published entries for the org with any interactions.
   "
-  [conn org-uuid :- lib-schema/UniqueID order start :- lib-schema/ISO8601 direction allowed-boards :- [lib-schema/UniqueID] {:keys [must-see count] :or {must-see false count false}}]
+  ([conn org-uuid :- lib-schema/UniqueID]
+  {:pre [(db-common/conn? conn)]}
+  (db-common/read-resources conn table-name :org-uuid org-uuid))
+
+  ([conn org-uuid :- lib-schema/UniqueID order start :- lib-schema/ISO8601 direction allowed-boards :- [lib-schema/UniqueID] {:keys [must-see count] :or {must-see false count false}}]
   {:pre [(db-common/conn? conn)
           (#{:desc :asc} order)
           (#{:before :after} direction)]}
@@ -366,7 +370,7 @@
       filter-map
       :interactions common/interaction-table-name :uuid :resource-uuid
       ["uuid" "headline" "body" "reaction" "author"
-       "published-at" "created-at" "updated-at"] {:count count})))
+       "published-at" "created-at" "updated-at"] {:count count}))))

 (schema/defn ^:always-validate paginated-entries-by-board


Creating each enemy texture once, instead of for each

--- desktop/src-common/ds3/enemy.clj
+++ desktop/src-common/ds3/enemy.clj
@@ -23,8 +23,8 @@
                   {:x 3, :y 8} {:x 1, :y 9} {:x 2, :y 9} {:x 3, :y 9} {:x 4, :y 9} {:x 3, :y 10} {:x 4, :y 10} {:x 5, :y 10}]}})

-(defn create-enemy-entity! [screen seed col]
-  (let [pixel-ship (ship/create-pixel-ship-texture seed)]
+(defn create-enemy-entity! [screen ship-texture col]
+  (let [pixel-ship (texture ship-texture)]
     (doto (assoc pixel-ship
             :body (create-enemy-body! screen)
             :width (c/screen-to-world 16) :height (c/screen-to-world 16)
@@ -43,12 +43,12 @@

 (defn create-enemies [screen]
-  (let [seeds (into [] (take c/enemy-height (repeatedly #(rand-int Integer/MAX_VALUE))))]
+  (let [ship-textures (into [] (take c/enemy-height (repeatedly #(ship/create-pixel-ship-texture (rand-int Integer/MAX_VALUE)))))]
          (for [row (range c/enemy-rows)
                col (range c/enemy-columns)
                :let [x (+ c/enemy-start-x (* col c/enemy-width-start))
                      y (+ c/enemy-start-y (* row c/enemy-height))]]
-           (doto (create-enemy-entity! screen (nth seeds row) col)
+           (doto (create-enemy-entity! screen (nth ship-textures row) col)
              (body-position! (c/screen-to-world x) (c/screen-to-world y) 0)
              (assoc :row row :col col)))))


Apply 'can always start the repl pattern'.

Actually this can still fail in the presence of aot'd files. have you
tried lein clean?

--- dev/user.clj
+++ dev/user.clj
@@ -1,14 +1,18 @@
 (ns user
-  (:require [uswitch.bifrost.system :refer (make-system)]
-            [clojure.tools.logging :refer (error)]
+  (:require [clojure.tools.logging :refer (error)]
             [clojure.tools.namespace.repl :refer (refresh)]
             [com.stuartsierra.component :as component]))

 (def system nil)

 (defn init []
-  (alter-var-root #'system
-                  (constantly (make-system (read-string (slurp "./etc/config.edn"))))))
+  ;; We do some gymnastics here to make sure that the REPL can always start
+  ;; even in the presence of compilation errors.
+  (require '[uswitch.bifrost.system])
+
+  (let [make-system (resolve 'uswitch.bifrost.system/make-system)]
+    (alter-var-root #'system
+                  (constantly (make-system (read-string (slurp "./etc/config.edn")))))))

 (defn start []
   (alter-var-root #'system (fn [s] (try (component/start s)


Remove a load of hacky Clojure injections

--- clojure/lein.symlink/profiles.clj
+++ clojure/lein.symlink/profiles.clj
@@ -1,6 +1,4 @@
 {:user {:dependencies [[clj-stacktrace "0.2.7"]
-                       [im.chit/vinyasa "0.1.0"]
-                       [io.aviso/pretty "0.1.8"]
                        [org.clojure/tools.namespace "0.2.4"]
                        [slamhound "1.3.1"]
                        [spyscope "0.1.4"]
@@ -18,23 +16,7 @@
                   [lein-swank "1.4.4"]]

         :injections [(require 'spyscope.core
-                              'vinyasa.inject
-                              'io.aviso.repl
-                              'clojure.repl
-                              'clojure.main
-                              '[criterium.core :refer [bench quick-bench]])
-
-                     (vinyasa.inject/inject
-                       'clojure.core
-                       '[[vinyasa.inject [inject inject]]
-                         [vinyasa.pull [pull pull]]
-                         [vinyasa.lein [lein lein]]
-                         [clojure.repl apropos dir doc find-doc source
-                          [root-cause cause]]
-                         [clojure.tools.namespace.repl [refresh refresh]]
-                         [clojure.pprint [pprint >pprint]]
-                         [io.aviso.binary [write-binary >bin]]])]
+                              '[criterium.core :refer [bench quick-bench]])]

         :aliases {"slamhound" ["run" "-m" "slam.hound"]}
-        :source-paths ["/Users/jcf/.lein/dev"]
         :search-page-size 30}}


Use more idiomatic form for optional map parameter

Related to #2

Fix 9f9abfd

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -280,19 +280,23 @@

 (defn execute-xquery
   "Execute the given xquery query as a request to the database
-  connection defined by the given session. Apply request options or
-  variables if given. Applies default type conversion, overridden by
-  `types` map if given."
-  [session query & [{:keys [options variables types]}]]
-  (submit-request (.newAdhocQuery session query) session query options variables types))
+  connection defined by the given session. Takes an optional map
+  describing request `options`, `variables`, and overrides of default
+  type conversion in `types`."
+  ([session query]
+   (execute-xquery session query {}))
+  ([session query [{:keys [options variables types]}]]
+   (submit-request (.newAdhocQuery session query) session query options variables types)))

 (defn execute-module
   "Execute the named module as a request to the database connection
-  defined by the given session. Apply request options or variables if
-  given. Applies default type conversion, overridden by `types` map if
-  given."
-  [session module & [{:keys [options variables types]}]]
-  (submit-request (.newModuleInvoke session module) session module options variables types))
+  defined by the given session. Takes an optional map describing
+  request `options`, `variables`, and overrides of default type
+  conversion in `types`."
+  ([session module]
+   (execute-module session module {}))
+  ([session module {:keys [options variables types]}]
+   (submit-request (.newModuleInvoke session module) session module options variables types)))

 ;;;;;


Wrap all request exceptions with .toString

This constitutes the smallest possible fix for #5. In my setup, users must still manually TAB to expand the second error in *cider-error* in order to see the additional info that e.g. XQueryException adds to the message, but all info is present.

--- src/uruk/core.clj
+++ src/uruk/core.clj
@@ -275,8 +275,11 @@
                              acc)
                            (doto request-factory (.setOptions ro))
                            variables)]
-    (cond (= :raw types) (.submitRequest session request)
-          :else (convert-types (.submitRequest session request) types))))
+    (let [req (try (.submitRequest session request)
+                   (catch Exception e
+                     (throw (Exception. (.toString e) e))))]
+      (cond (= :raw types) req
+            :else          (convert-types req types)))))

 (defn execute-xquery
   "Execute the given xquery query as a request to the database


Reflect olalonde's project name change in link.

--- src/uk/me/iwilcox/poltree/s11n.clj
+++ src/uk/me/iwilcox/poltree/s11n.clj
@@ -7,7 +7,7 @@
 ; file LICENCE.txt or copy at <http://www.boost.org/LICENSE_1_0.txt>.
 ;
 ; Serialisation to/from formats described in section "Serialized data formats"
-; of <https://github.com/olalonde/blind-liability-proof>.
+; of <https://github.com/olalonde/proof-of-liabilities>.
 ;
 (ns uk.me.iwilcox.poltree.s11n
     (:require [clojure.data.json :as json])


Correctly filter by project

Correctly filter by project

--- src/zooniverse_live/data_init.cljs
+++ src/zooniverse_live/data_init.cljs
@@ -11,12 +11,12 @@
   (comp #(js->clj % :keywordize-keys true) #(.parse js/JSON %)))

 (defn format-msgs
-  [{:keys [projects]}]
+  [app]
   (comp (map #(.-data %))
         (map trim-newline)
         (filter #(not (some (apply set %) ["Heartbeat" "Stream Start" ""])))
         (map str->clj)
-        (filter #(contains? (keyword (:project %)) projects))))
+        (filter #(contains? (:projects @app) (keyword (:project %))))))

 (defn request
   [url callback-fn & {:keys [type] :or {type "GET"}}]


Optimize tx-id? in clj

Optimize tx-id? in clj

--- src/datascript/db.cljc
+++ src/datascript/db.cljc
@@ -1047,13 +1047,21 @@
   ^long [db]
   (inc (long (:max-eid db))))

-(defn- #?@(:clj  [^Boolean tx-id?]
-           :cljs [^boolean tx-id?])
-  [e]
-  (or (= e :db/current-tx)
-      (= e ":db/current-tx") ;; for datascript.js interop
-      (= e "datomic.tx")
-      (= e "datascript.tx")))
+#?(:clj
+   (defn- ^Boolean tx-id?
+     [e]
+     (or (identical? :db/current-tx e)
+         (.equals ":db/current-tx" e) ;; for datascript.js interop
+         (.equals "datomic.tx" e)
+         (.equals "datascript.tx" e)))
+
+   :cljs
+   (defn- ^boolean tx-id?
+     [e]
+     (or (= e :db/current-tx)
+         (= e ":db/current-tx") ;; for datascript.js interop
+         (= e "datomic.tx")
+         (= e "datascript.tx"))))

 (defn- #?@(:clj  [^Boolean tempid?]
            :cljs [^boolean tempid?])


Rewrite cljs-formatter using comp

Rewrite cljs-formatter using comp

--- src/devtools/core.cljs
+++ src/devtools/core.cljs
@@ -227,11 +227,16 @@
         (call-original-formatter? value)))))

 (defn cljs-formatter [original-formatter]
-  (let [hook-wrapper (fn [name hook] (debug/hook-monitor name (chain name original-formatter (sanitize hook))))]
-    (js-obj
-      "header" (hook-wrapper "header" header-hook)
-      "hasBody" (hook-wrapper "hasBody" has-body-hook)
-      "body" (hook-wrapper "body" body-hook))))
+  (let [api [["header" header-hook]
+             ["hasBody" has-body-hook]
+             ["body" body-hook]]
+        hook-wrapper (fn [name hook]
+                       (let [monitor (partial debug/hook-monitor name)
+                             chainer (partial chain name original-formatter)
+                             sanitizer sanitize]
+                         ((comp monitor chainer sanitizer) hook)))
+        api-gen (fn [[name hook]] [name (hook-wrapper name hook)])]
+    (apply js-obj (mapcat #(api-gen %) api))))

 (defn install-devtools! []
   (if *devtools-installed*


Minor

Minor

--- src/discuss/views.cljs
+++ src/discuss/views.cljs
@@ -187,8 +187,8 @@
                                          :onClick   #(com/dispatch-add-action statement (lib/get-selection))
                                          :disabled  (> 10 (count statement))}
                                     (remaining-characters statement))
+                        (dom/hr nil)
                         (dom/p #js {:className "text-muted text-center"}
-                               (dom/hr nil)
                                "Das Markieren von Textpassagen über mehrere Absätze hinweg und das doppelte markieren schon markierter Textstellen wurde noch nicht implementiert."))))))

 (defn- build-with-buttons


Update cider-nrepl for Leiningen

Update cider-nrepl for Leiningen

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,3 +1,3 @@
-{:repl {:plugins [[cider/cider-nrepl "0.15.1"]]
+{:repl {:plugins [[cider/cider-nrepl "0.16.0"]]
         :dependencies [[org.clojure/tools.nrepl "0.2.13"]]}
  :user {:plugins [[lein-pprint "1.2.0"]]}}


Fix formatting of comment in profiles.clj

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -90,7 +90,7 @@
                             `(~(symbol "vinyasa.inject/in")
                               ~'[clojure.tools.namespace.repl refresh])))]}

- ;;; END profiles with optional injections
+ ;; END profiles with optional injections

  :lint {:plugins [;; Miscellaneous linting
                   [jonase/eastwood "0.2.3"]


minor

minor

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -38,16 +38,20 @@
                                            [clojure.set :as set]
                                            [clojure.java.io :as io]))
                                (defn library
-                                 "require ns by symbols or ns-clusters by keywords:
+                                 "
+  require namespaces by symbols or clusters of namespaces by keywords:
+
   add-dep cemerick.pomegranate
   b criterium.core
   c clojure.core.async
   match clojure.core.match
+
   :logic
   v    clojure.core.logic
   fd   clojure.core.logic.fd
   nom  clojure.core.logic.nominal
   pldb clojure.core.logic.pldb
+
   :array
   a      clojure.core.matrix
   sel    clojure.core.matrix.selection
@@ -55,9 +59,11 @@
   rand   clojure.core.matrix.random
   stats  clojure.core.matrix.stats
   ds     clojure.core.matrix.datasets
+
   :data
   z   clojure.data.int-map
-  csv clojure.data.csv"
+  csv clojure.data.csv
+  "
                                  ([lib & libs] (mapv library (cons lib libs)))
                                  ([lib]
                                   (case lib


Kibit suggested improvements

Kibit suggested improvements

--- src/exploud/asgard.clj
+++ src/exploud/asgard.clj
@@ -150,7 +150,7 @@

 (defn- munge-task [task]
   "Converts an Asgard task to a desired form"
-  (update-in task [:log] (fn [log] (map #(split-log-message %) log))))
+  (update-in task [:log] (fn [log] (map split-log-message log))))

 (defn task [region run-id workflow-id]
   "Retrives information about a task from Asgard"
@@ -206,7 +206,7 @@

 (defn applications []
   (let [application-list (application-list)]
-    (map (fn [app] (:name app)) application-list)))
+    (map :name application-list)))

 (defn upsert-application [application-name {:keys [description email owner]}]
   (http/simple-post (upsert-application-url) {:form-params {:description description
@@ -221,7 +221,7 @@

 (defn auto-scaling-group-exists? [region application-name]
   (let [application (application region application-name)]
-    (< 0 (count (:groups application)))))
+    (pos? (count (:groups application)))))

 (defn- create-asgard-params [params]
   (for [[k v] (seq params)


Deletes some code

Deletes some code

--- src/expound/paths.cljc
+++ src/expound/paths.cljc
@@ -58,13 +58,8 @@
       (= ::not-found form)
       ::not-found

-      ;; TODO - make this more restrictive on value
-      ;; since we have special clause for sequence matching
       (and (empty? in)
-           (or (= form val)
-               (and (seq? val)
-                    (= form
-                       (first val)))))
+           (= form val))
       in'

       ;; detect a `:in` path that points to a key/value pair in a coll-of spec
@@ -112,14 +107,8 @@
     form
     (let [[k & rst] in]
       (cond
-
-        ;; TODO - make this more restrictive on value
-        ;; since we have special clause for sequence matching
         (and (empty? in)
-             (or (= form val)
-                 (and (seq? val)
-                      (= form
-                         (first val)))))
+             (= form val))
         in'

         (associative? form)


Remove extraneous 'ancestor? parameter from 'ancestoro.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1093,12 +1093,12 @@
              (file-patho next-sha new-path fname fsha tree-path))]))

 (def ancestoro
-  (l/tabled [childer parenter ancestor?]
+  (l/tabled [childer parenter]
           (l/conde
-           [(r-commit-parent childer parenter) (l/== ancestor? true)]
+           [(r-commit-parent childer parenter)]
            [(l/fresh [nparent]
                      (r-commit-parent childer nparent)
-                     (ancestoro nparent parenter ancestor?))])))
+                     (ancestoro nparent parenter))])))

 (comment
   (def xdb1 (pldb/db [r-tree :a :b :c :d]))
@@ -1133,8 +1133,9 @@
          p (str->sha "65691217cd9aa2b2738518dbebd3fdc7d58b162f")]
      (doall
       (pldb/with-db db
-        (l/run 10 [q]
-               (ancestoro c p q))))))
+        (l/run 1 [q]
+               (ancestoro c p)
+               (l/== q true))))))

   (pldb/with-db db
     (l/run* [filename]


[voom.clj] Update git clone --reference flag for modern git.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -732,7 +732,7 @@
         (safe-delete-repo checkout pdir))
       (if (.exists ^File checkout)
         (git g "fetch" "--all")
-        (git {} "clone" repo "--refer" gitdir checkout))
+        (git {} "clone" repo "--reference" gitdir checkout))
       (safe-checkout checkout sha) ; must detach head for update...
       (git g "branch" "-f" branch sha)
       (git g "checkout" branch)


Adjust 'q walk to be a bit clearer about '_ -> lvar upgrading.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1148,9 +1148,7 @@
         run-mode (if count
                    '[l/run count]
                    '[l/run*])
-        body (walk/postwalk #(if (= % '_)
-                               '(l/lvar)
-                               %)
+        body (walk/postwalk #(get '{_ (l/lvar)} % %)
                             body)]
     `(pldb/with-db ~db
        (~@run-mode ~rfresh


tried to create phase shifting effect with no luck

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -160,9 +160,19 @@
 )

 (defn light-sawtooth-phase
-  "Change light of fixtures with phase shift"
+  "Change light of fixtures with phase shift. WIP."
   [beat-ratio]
+  (let [phase-gradient (params/build-spatial-param  ; Spread a phase shift across fixtures
+      (show/all-fixtures)
+      (fn [head] (- (:x head) (:min-x @(:dimensions *show*)))) :max 1)]
+    (let [light-param (params/build-oscillated-param
+      (oscillators/sawtooth-beat :beat-ratio beat-ratio :down? true :phase phase-gradient) :max :max-lightness)]
+      (show/add-effect! :color (global-color-effect
+        (params/build-color-param :s 100 :l light-param :h :main-hue))
+      )
+    )
   )
+)

 (defn sync-midi-clock
   "Sync MIDI clock to Ableton live session over network"


print number of found namespaces

print number of found namespaces

--- etc/repl.clj
+++ etc/repl.clj
@@ -43,7 +43,10 @@
 (defn find-ns
   "Find namespace vars by a regex"
   [re]
-  (vec (filter #(re-find re (str %)) (list-ns))))
+  (let [nss (vec (filter #(re-find re (str %)) (list-ns)))]
+    (printf "found %s ns\n" (count nss))
+    nss
+    ))

 (defn find-test-ns
@@ -52,8 +55,10 @@
   (let [re (cond
              (string? pattern) (re-pattern pattern)
              (= java.util.regex.Pattern (class pattern)) pattern
-             :else (throw (ex-info "this is not a patternable thing" {:pattern pattern})))]
-  (vec (filter #(re-find re (str %)) (list-ns "./test/")))))
+             :else (throw (ex-info "this is not a patternable thing" {:pattern pattern})))
+        nss (vec (filter #(re-find re (str %)) (list-ns "./test/")))]
+    (printf "found %s nss\n" (count nss))
+    nss))

 (def system-status (atom {}))


New version of suchwow requires explicit `require`

--- src/midje/checkers.clj
+++ src/midje/checkers.clj
@@ -2,7 +2,12 @@
   "Checkers are for checking results of checkables, or checking
    that appropriate arguments are passed to prerequisites"
   (require [such.vars :as var]
-           [such.immigration :as immigrate]))
+           [such.immigration :as immigrate])
+  (require midje.checking.checkers.defining
+           midje.checking.checkers.chatty
+           midje.checking.checkers.simple
+           midje.checking.checkers.combining
+           midje.checking.checkers.collection))

 (when-not (resolve '&)
   (let [docstring "This var is defined so that Midje prerequisites can use & for optional args without having to quote it."]


Create top-level? pattern

Create top-level? pattern

--- src/oxcart/pattern.clj
+++ src/oxcart/pattern.clj
@@ -38,6 +38,14 @@
   [ast]
   (when (def? ast)
     (:name ast)))
+
+
+(defn top-level?
+  "λ AST → Boolean
+
+  Indicates whether the argument AST is a top level form."
+  [ast]
+  (:top-level ast))

 (defn fn?


Example code was using removed function

Example code was using removed function

--- src/palletops/hyde.clj
+++ src/palletops/hyde.clj
@@ -168,7 +168,7 @@
   (create-collections-dirs! root site-config)
   (write-gemfile! root jekyll-config)
   (write-config! root site-config)
-  (copy-resources root (:template site-config))
+  (copy-resources! root site-config)
   (write-document! root {:path "_posts/2012-01-01-my-example.md"
                          :content "this is a *test*!"
                          :front-matter


Fix bug with virtual streams created from input events

--- src/photon/streams.clj
+++ src/photon/streams.clj
@@ -120,7 +120,8 @@
       (if (nil? p)
         (let [c (chan 1)
               new-p {:channel c
-                     :p (pub c (fn [ev] (get ev "stream-name")))}]
+                     :p (pub c (fn [ev] (get ev "stream-name"
+                                             (get ev :stream-name))))}]
           (alter publications assoc async-stream new-p)
           new-p)
         p))))
@@ -153,8 +154,9 @@
        {:m m} (str "stream/" stream-name)
        (fn [params]
          (stream this
-                 (assoc params
-                        "stream-name" stream-name))))))
+                 (assoc (assoc params
+                               "stream-name" stream-name)
+                        :stream-name stream-name))))))
   (streams [this]
     {:streams
      (let [active-streams (get @active-streams this)]
@@ -222,7 +224,8 @@
   (process-event! [this msg]
     ;; Think about the order of store+send to taps
     (println "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! " (pr-str msg))
-    (update-streams! this (get msg "stream-name"))
+    (update-streams! this (get msg "stream-name"
+                               (get msg :stream-name)))
     (go (>! (:channel (global-channel this)) msg)
         (>! (:channel (publisher this)) msg))
     (db/store db msg)
@@ -232,7 +235,8 @@
   (log/info "cold-stream" (pr-str params))
   (let [ch (chan (buffer 1))
         full-s (data-from a-stream
-                          (get params "stream-name" "__all__")
+                          (get params "stream-name"
+                               (get params :stream-name "__all__"))
                           (extract-date params))
         full-s (if (and (contains? params :limit)
                         (not (nil? (:limit params))))
@@ -257,7 +261,8 @@
   (log/info "Initialising hot-cold stream with params" (pr-str params))
   (let [date (extract-date params)
         ch (chan (buffer 1))
-        stream-name (get params "stream-name" "__all__")
+        stream-name (get params "stream-name"
+                         (get params :stream-name "__all__"))
         full-s (data-from a-stream
                           stream-name
                           (extract-date params))]
@@ -285,7 +290,8 @@

 (defmethod stream "hot" [a-stream params]
   (let [ch (chan 1)
-        stream-name (get params "stream-name" "__all__")]
+        stream-name (get params "stream-name"
+                         (get params :stream-name "__all__"))]
     (if (= stream-name "__all__")
       (tap (:mult-channel (global-channel a-stream)) ch)
       (sub (:p (publisher a-stream)) stream-name ch))


Allow local address configuration for multihomed hosts

:localhost sets the host name used in the EHLO command.

:localaddress sets the address to bind to when generating the outbound
connection (for multihomed hosts).

--- src/postal/support.clj
+++ src/postal/support.clj
@@ -31,14 +31,16 @@
   `(when ~condition
      (doto ~arg ~@body)))

-(defn make-props [sender {:keys [host port user tls]}]
+(defn make-props [sender {:keys [host port user tls localhost localaddress]}]
   (doto (Properties.)
     (.put "mail.smtp.host" (or host "not.provided"))
     (.put "mail.smtp.port" (or port "25"))
     (.put "mail.smtp.auth" (if user "true" "false"))
     (do-when sender (.put "mail.smtp.from" sender))
     (do-when user (.put "mail.smtp.user" user))
-    (do-when tls  (.put "mail.smtp.starttls.enable" "true"))))
+    (do-when tls  (.put "mail.smtp.starttls.enable" "true"))
+    (do-when localhost (.put "mail.smtp.localhost" localhost))
+    (do-when localaddress (.put "mail.smtp.localaddress" localaddress))))

 (defn hostname []
   (.getHostName (java.net.InetAddress/getLocalHost)))


Fix up ctx registration

Fix up ctx registration

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -6,7 +6,9 @@
     [re-frame.router     :as router]
     [re-frame.loggers    :as loggers]
     [re-frame.registrar  :as registrar]
-    [re-frame.interceptor :as interceptor :refer [base ->interceptor db-handler->interceptor fx-handler->interceptor]]))
+    [re-frame.interceptor :as interceptor :refer [base ->interceptor
+                                                  db-handler->interceptor fx-handler->interceptor
+                                                  ctx-handler->interceptor]]))

 ;; --  dispatch
@@ -69,12 +71,12 @@
    (events/register id [base interceptors (fx-handler->interceptor fx-handler)])))   ;; XXX add a base-interceptor

-(defn reg-event-context
+(defn reg-event-ctx
   ([id handler]
-   (reg-event-context id nil handler))
+   (reg-event-ctx id nil handler))

   ([id interceptors handler]
-   (events/register id [base interceptors handler])))   ;;   XXX can't just put in handler, must wrap it
+   (events/register id [base interceptors (ctx-handler->interceptor handler)])))

 ;; --  Logging -----


corrected problem with broken 'open declaration' command

--- ccw.core/src/ccw/editors/antlrbased/ClojureHyperlinkDetector.clj
+++ ccw.core/src/ccw/editors/antlrbased/ClojureHyperlinkDetector.clj
@@ -42,8 +42,7 @@
       (do
         (.setStatusLineErrorMessage editor ClojureEditorMessages/You_need_a_running_repl)
         nil)
-      (let [[result2] (repl/response-values (send command))
-            [file line ns :as result] (result2 "response")]
+      (let [[ [file line _ ns] ] (repl/response-values (send command))]
         (if (and file line ns)
           {"file" file
            "line" (Integer/valueOf line)