Refactor old log ns from message-test

Refactor old log ns from message-test

--- test/frereth_cp/message/message_test.clj
+++ test/frereth_cp/message/message_test.clj
@@ -4,7 +4,6 @@
             [clojure.pprint :refer (pprint)]
             [clojure.spec.alpha :as s]
             [clojure.test :refer (are deftest is testing)]
-            [clojure.tools.logging :as log]
             [frereth-cp.message :as message]
             [frereth-cp.message.constants :as K]
             [frereth-cp.message.from-child :as from-child]
@@ -15,7 +14,7 @@
             [frereth-cp.message.to-child :as to-child]
             [frereth-cp.message.to-parent :as to-parent]
             [frereth-cp.shared.bit-twiddling :as b-t]
-            [frereth-cp.shared.logging :as log2]
+            [frereth-cp.shared.logging :as log]
             [frereth-cp.util :as utils]
             [manifold.deferred :as dfrd]
             [manifold.stream :as strm])
@@ -51,22 +50,22 @@
   ;; FIXME: This really should be a fork
   ;; (which means the caller needs to supply
   ;; its log state)
-  (let [logs (log2/init ::try-multiple-sends 0)]
+  (let [logs (log/init ::try-multiple-sends 0)]
     (loop [m n]
       (if (f io-handle payload)
-        (let [logs (log2/info logs ::succeeded success-message)
-              logs (log2/debug logs
+        (let [logs (log/info logs ::succeeded success-message)
+              logs (log/debug logs
                                ::succeeded
                                (str "Sending took" (- (inc n) m) "attempt(s)"))]
-          (log2/flush-logs! logger logs))
+          (log/flush-logs! logger logs))
         (if (> 0 m)
           (let [failure (ex-info failure-message
                                  failure-body)
-                logs (log2/exception logs
+                logs (log/exception logs
                                      failure
                                      ::failed
                                      failure-message)]
-            (log2/flush-logs! logger logs)
+            (log/flush-logs! logger logs)
             ;; Need to make double-extra certain that
             ;; this exception doesn't just disappear
             (throw failure))
@@ -88,8 +87,8 @@
   ;; TODO: Revisit this decision. See whether it's uglier
   ;; with 2 sides to "communicate"
   (let [loop-name "Echo Test"
-        log-atom (atom (log2/init ::basic-echo 0))
-        logger (log2/std-out-log-factory)
+        log-atom (atom (log/init ::basic-echo 0))
+        logger (log/std-out-log-factory)
         src (Unpooled/buffer K/k-1)  ; w/ header, this takes it to the 1088 limit
         msg-len (- K/max-msg-len K/header-length K/min-padding-length)
         ;; Note that this is what the child sender should be supplying
@@ -102,12 +101,12 @@
     (is (= msg-len K/k-1))
     (.writeBytes src message-body)
     (let [{incoming ::specs/bs-or-eof
-           log-state ::log2/state} (to-parent/build-message-block-description @log-atom
-                                                                              {::specs/buf src
-                                                                               ::specs/length msg-len
-                                                                               ::specs/message-id message-id
-                                                                               ::specs/send-eof ::specs/false
-                                                                               ::specs/start-pos 0})]
+           log-state ::log/state} (to-parent/build-message-block-description @log-atom
+                                                                             {::specs/buf src
+                                                                              ::specs/length msg-len
+                                                                              ::specs/message-id message-id
+                                                                              ::specs/send-eof ::specs/false
+                                                                              ::specs/start-pos 0})]
       (reset! log-atom log-state)
       (is (= K/max-msg-len (count incoming)))
       (let [response (dfrd/deferred)
@@ -129,11 +128,11 @@
                         ;; might do.
                         (is (s/valid? bytes? buf))
                         (let [response-state @parent-state
-                              logs (log2/debug @log-atom
-                                               ::echo-parent-cb
-                                               "Top of callback"
-                                               {::response-state response-state
-                                                ::called-from (utils/get-stack-trace (Exception.))})
+                              logs (log/debug @log-atom
+                                              ::echo-parent-cb
+                                              "Top of callback"
+                                              {::response-state response-state
+                                               ::called-from (utils/get-stack-trace (Exception.))})
                               new-state (swap! parent-state inc)
                               ;; I'd like to get 3 message packets here:
                               ;; 1. ACK
@@ -154,9 +153,9 @@
                               ;; much more robust because of them.
                               ;; FIXME: Revisit this soon.
                               logs (if (= 3 new-state)
-                                     (let [logs (log2/info logs
-                                                           ::echo-parent-cb
-                                                           "Echo sent. Pretending other child triggers done")
+                                     (let [logs (log/info logs
+                                                          ::echo-parent-cb
+                                                          "Echo sent. Pretending other child triggers done")
                                            ;; This seems like a good time for the parent
                                            ;; to send EOF
                                            io-handle @io-handle-atom]
@@ -171,7 +170,7 @@
                                        (deliver response buf)
                                        logs)
                                      logs)
-                              logs (log2/flush-logs! logger logs)]
+                              logs (log/flush-logs! logger logs)]
                           (reset! log-atom logs)))
             child-message-counter (atom 0)
             strm-address (atom 0)
@@ -181,11 +180,11 @@
                        ;; TODO: Add another similar test that throws an
                        ;; exception here, for the sake of hardening the
                        ;; caller
-                       (let [logs (log2/info @log-atom
-                                             ::echo-child-cb
-                                             "Incoming to child"
-                                             {::rcvd array-o-bytes
-                                              ::type (class array-o-bytes)})]
+                       (let [logs (log/info @log-atom
+                                            ::echo-child-cb
+                                            "Incoming to child"
+                                            {::rcvd array-o-bytes
+                                             ::type (class array-o-bytes)})]
                          (is array-o-bytes "Falsey reached callback")
                          (try
                            (let [logs
@@ -193,18 +192,18 @@
                                    (let [msg-len (count array-o-bytes)
                                          locator (Exception.)
                                          logs (if (not= 0 msg-len)
-                                                (let [logs (log2/debug logs
+                                                (let [logs (log/debug logs
+                                                                      ::echo-child-cb
+                                                                      "Echoing back an incoming message"
+                                                                      {::msg-len msg-len
+                                                                       ::called-from (utils/get-stack-trace (Exception.))})
+                                                      logs (if (not= K/k-1 msg-len)
+                                                             (log/warn logs
                                                                        ::echo-child-cb
-                                                                       "Echoing back an incoming message"
-                                                                       {::msg-len msg-len
-                                                                        ::called-from (utils/get-stack-trace (Exception.))})
-                                                      logs (if (not= K/k-1 msg-len)
-                                                             (log2/warn logs
-                                                                        ::echo-child-cb
-                                                                        "Incoming message doesn't match length we sent"
-                                                                        {::expected K/k-1
-                                                                         ::actual msg-len
-                                                                         ::details (vec array-o-bytes)})
+                                                                       "Incoming message doesn't match length we sent"
+                                                                       {::expected K/k-1
+                                                                        ::actual msg-len
+                                                                        ::details (vec array-o-bytes)})
                                                              logs)
                                                       ;; Just echo it directly back.
                                                       io-handle @io-handle-atom]
@@ -224,23 +223,23 @@
                                                       (message/child-close! @io-handle-atom)
                                                       ;; This is called purely for side-effects.
                                                       ;; The return value does not matter.
-                                                      (let [[_ inner-logs] (log2/fork logs ::child-done)
-                                                            inner-logs (log2/info inner-logs
-                                                                                ::echo-child-cb
-                                                                                "Sent EOF after the message block")]
-                                                        (log2/flush-logs! logger inner-logs))))
+                                                      (let [[_ inner-logs] (log/fork logs ::child-done)
+                                                            inner-logs (log/info inner-logs
+                                                                                ::echo-child-cb
+                                                                                "Sent EOF after the message block")]
+                                                        (log/flush-logs! logger inner-logs))))
                                                   logs))]
-                                     (log2/warn logs :echo-child-cb "Empty incoming message. Highly suspicious"))
+                                     (log/warn logs :echo-child-cb "Empty incoming message. Highly suspicious"))
                                    (let [{:keys [::specs/from-child]
                                             :as io-handle} @io-handle-atom
-                                           logs (log2/warn logs
-                                                           ::echo-child-cb
-                                                           "Child received what should be EOF. Mark done.")]
+                                           logs (log/warn logs
+                                                          ::echo-child-cb
+                                                          "Child received what should be EOF. Mark done.")]
                                        (message/child-close! io-handle)
                                        (is (s/valid? ::specs/eof-flag array-o-bytes))
                                        (deliver child-finished array-o-bytes)
                                        logs))
-                                 logs (log2/flush-logs! logger logs)]
+                                 logs (log/flush-logs! logger logs)]
                              (reset! log-atom logs))
                            (catch Exception ex
                              (println "child-cb Failed:" ex)
@@ -254,14 +253,17 @@
             ;; message arrives.
             ;; Maybe it doesn't matter, since I'm trying to send the initial
             ;; message quickly, but the behavior seems suspicious.
-            initialized (message/initial-state loop-name true {} logger)
+            initialized (message/initial-state loop-name
+                                               true
+                                               {::log/state log-state}
+                                               logger)
             {:keys [::specs/io-handle]} (message/start! initialized logger parent-cb child-cb)]
         (dfrd/on-realized child-finished
                           (fn [success]
-                            (let [logs (log2/info @log-atom
+                            (let [logs (log/info @log-atom
                                                   ::child-finished
                                                   "Child just signalled EOF")
-                                  logs (log2/flush-logs! logger logs)]
+                                  logs (log/flush-logs! logger logs)]
                               (reset! log-atom logs))
                             (is (= ::specs/normal success)))
                           (fn [failure]
@@ -273,7 +275,7 @@
               (reset! io-handle-atom io-handle)
               (let [problem (s/explain-data ::specs/state state)]
                 (when problem
-                  (let [log-ctx (get-in state [::log2/state ::log2/context])]
+                  (let [log-ctx (get-in state [::log/state ::log/context])]
                     (is (not problem) (str "Latest breakage is due to "
                                            log-ctx
                                            " a "
@@ -283,14 +285,14 @@
               ;; gibberish messages
               (let [wrote (dfrd/future
                             (let [logs @log-atom
-                                  logs (log2/debug logs
-                                                   ::echo-initial-write
-                                                   "Writing message from parent")]
+                                  logs (log/debug logs
+                                                  ::echo-initial-write
+                                                  "Writing message from parent")]
                               (message/parent->! io-handle incoming)
-                              (let [logs (log2/debug logs
-                                                     ::echo-initial-write
-                                                     "Message should be headed to child")
-                                    logs (log2/flush-logs! logger logs)]
+                              (let [logs (log/debug logs
+                                                    ::echo-initial-write
+                                                    "Message should be headed to child")
+                                    logs (log/flush-logs! logger logs)]
                                 (reset! log-atom logs))))
                     ;; The time delay here is pretty crazy.
                     ;; It seems as though it should never take human-noticeable time.
@@ -317,23 +319,23 @@
                 ;; Note that state is fine here, but we're about to overwrite it
                 (is (not (s/explain-data ::specs/state state)))
                 (let [state (message/get-state io-handle 500 ::time-out)
-                      ;; FIXME: Need to merge this into state's ::log2/state
+                      ;; FIXME: Need to merge this into state's ::log/state
                       ;; key.
                       ;; But not before a bigger FIXME:
                       ;; How/where did the state logs get messed up?
-                      logs (log2/info @log-atom
-                                      ::echo-examination
-                                      "Final state query returned")]
+                      logs (log/info @log-atom
+                                     ::echo-examination
+                                     "Final state query returned")]
                   (is (not= state ::timeout))
                   (when (not= state ::timeout)
                     (is (not
-                         ;; This fails because ::log2/state is a map that only
-                         ;; contains a ::log2/entries key.
+                         ;; This fails because ::log/state is a map that only
+                         ;; contains a ::log/entries key.
                          ;; The value for that key looks like the actual expected log-state
                          (s/explain-data ::specs/state state)))
-                    (let [logs (log2/info logs
-                                          ::echo-examination
-                                          "Checking test outcome")]
+                    (let [logs (log/info logs
+                                         ::echo-examination
+                                         "Checking test outcome")]
                       (let [child-completion (deref child-finished 500 ::child-timed-out)]
                         (is (= ::specs/normal child-completion)))

@@ -364,20 +366,20 @@
                         ;; Keeping around as a reminder for when the implementation changes
                         ;; and I need to see what's really going on again
                         (comment (is (not outcome) "What should we have here?")))
-                      (let [logs (log2/flush-logs! logger logs)]
+                      (let [logs (log/flush-logs! logger logs)]
                         (reset! log-atom logs))))))))
           (catch ExceptionInfo ex
-            (let [logs (log2/exception @log-atom
+            (let [logs (log/exception @log-atom
                                        ex
                                        ::echo-failure
                                        "Starting the event loop")
-                  logs (log2/flush-logs! logger logs)]
+                  logs (log/flush-logs! logger logs)]
               (reset! log-atom logs)))
           (finally
-            (let [logs (log2/warn (second (log2/fork @log-atom ::echo-clean-up))
-                                  ::signal-halt
-                                  "")
-                  logs (log2/flush-logs! logger logs)]
+            (let [logs (log/warn (second (log/fork @log-atom ::echo-clean-up))
+                                 ::signal-halt
+                                 "")
+                  logs (log/flush-logs! logger logs)]
               (reset! log-atom logs)
               (message/halt! io-handle))))))))
 (comment (basic-echo))
@@ -409,23 +411,23 @@
                                        ::specs/strm-hwm 0
                                        ::specs/un-sent-blocks PersistentQueue/EMPTY}
                      ::specs/recent (System/nanoTime)}
-        logger (log2/std-out-log-factory)
-        log-state (log2/init ::wrap-chzbrgr-test 0)
+        logger (log/std-out-log-factory)
+        log-state (log/init ::wrap-chzbrgr-test 0)
         ;; TODO: Keep this magic number in sync
         ;; And verify the action with sizes that cross packet boundaries
         chzbrgr-lngth 182
         chzbrgr (byte-array (range chzbrgr-lngth))
         {consumer ::from-child/callback
-         log-state ::log2/state} (from-child/build-byte-consumer message-loop-name log-state chzbrgr)
-        log-state (log2/info log-state
-                             ::wrap-chzbrgr
-                             "Reading chzbrgr from child")
+         log-state ::log/state} (from-child/build-byte-consumer message-loop-name log-state chzbrgr)
+        log-state (log/info log-state
+                            ::wrap-chzbrgr
+                            "Reading chzbrgr from child")
         ;; This is much slower than I'd like
         {:keys [::specs/outgoing
                 ::specs/recent]
-         log-state ::log2/state
+         log-state ::log/state
          :as state'} (time (consumer (assoc start-state
-                                            ::log2/state log-state)))]
+                                            ::log/state log-state)))]
     (is (= 1 (count (::specs/un-sent-blocks outgoing))))
     (is (= chzbrgr-lngth (::specs/strm-hwm outgoing)))
     (let [current-message  (-> outgoing
@@ -440,12 +442,12 @@
                                 (update ::specs/transmissions inc)
                                 (assoc ::specs/time recent)
                                 (assoc ::specs/message-id current-message-id))
-            log-state (log2/info log-state
-                                 ::wrap-chzbrgr
-                                 "Building message block to send to parent")
+            log-state (log/info log-state
+                                ::wrap-chzbrgr
+                                "Building message block to send to parent")
             {buf ::specs/bs-or-eof
-             log-state ::log2/state} (time (to-parent/build-message-block-description log-state
-                                                                                updated-message))]
+             log-state ::log/state} (time (to-parent/build-message-block-description log-state
+                                                                                updated-message))]
         ;;; Start with the very basics
         ;; Q: Did that return what we expected?
         (is (s/valid? bytes? buf))
@@ -454,65 +456,74 @@
         (is (b-t/bytes= (.array out-buf) chzbrgr))
         (is (= read-index (.readerIndex out-buf)))
         (is (= write-index (.writerIndex out-buf)))
-        ;; Now, what does the decoded version look like?
-        ;; TODO: This is another piece that's just
-        ;; screaming for generative testing
-        (log/info "Deserializing message from parent")
-        (let [{{:keys [::specs/acked-message
-                       ::specs/ack-length-1
-                       ::specs/ack-length-2
-                       ::specs/ack-length-3
-                       ::specs/ack-length-4
-                       ::specs/ack-length-5
-                       ::specs/ack-length-6
-                       ::specs/ack-gap-1->2
-                       ::specs/ack-gap-2->3
-                       ::specs/ack-gap-3->4
-                       ::specs/ack-gap-4->5
-                       ::specs/ack-gap-5->6
-                       ::specs/buf
-                       ::specs/message-id
-                       ::specs/size-and-flags]} ::specs/packet
-               log-state ::log2/state
-               :as packet} (time (from-parent/deserialize log-state buf))]
-          (comment (is (not packet)))
-          (is (= chzbrgr-lngth size-and-flags))
-          (are [expected actual] (= expected actual)
-            0 acked-message
-            0 ack-length-1
-            0 ack-length-2
-            0 ack-length-3
-            0 ack-length-4
-            0 ack-length-5
-            0 ack-length-6
-            0 ack-gap-1->2
-            0 ack-gap-2->3
-            0 ack-gap-3->4
-            0 ack-gap-4->5
-            0 ack-gap-5->6)
-          (is (= message-id current-message-id))
-          (let [bytes-rcvd (.readableBytes buf)
-                dst (byte-array bytes-rcvd)]
-            (is (= chzbrgr-lngth bytes-rcvd))
-            (.readBytes buf dst)
-            (log2/flush-logs! logger (log2/info log-state
+        (let [log-state (log/info log-state ::wrap-chzbrgr "Deserializing message from parent")]
+          ;; Now, what does the decoded version look like?
+          ;; TODO: This is another piece that's just
+          ;; screaming for generative testing
+          (let [{{:keys [::specs/acked-message
+                         ::specs/ack-length-1
+                         ::specs/ack-length-2
+                         ::specs/ack-length-3
+                         ::specs/ack-length-4
+                         ::specs/ack-length-5
+                         ::specs/ack-length-6
+                         ::specs/ack-gap-1->2
+                         ::specs/ack-gap-2->3
+                         ::specs/ack-gap-3->4
+                         ::specs/ack-gap-4->5
+                         ::specs/ack-gap-5->6
+                         ::specs/buf
+                         ::specs/message-id
+                         ::specs/size-and-flags]} ::specs/packet
+                 log-state ::log/state
+                 :as packet} (time (from-parent/deserialize log-state buf))]
+            (comment (is (not packet)))
+            (is (= chzbrgr-lngth size-and-flags))
+            (are [expected actual] (= expected actual)
+              0 acked-message
+              0 ack-length-1
+              0 ack-length-2
+              0 ack-length-3
+              0 ack-length-4
+              0 ack-length-5
+              0 ack-length-6
+              0 ack-gap-1->2
+              0 ack-gap-2->3
+              0 ack-gap-3->4
+              0 ack-gap-4->5
+              0 ack-gap-5->6)
+            (is (= message-id current-message-id))
+            (let [bytes-rcvd (.readableBytes buf)
+                  dst (byte-array bytes-rcvd)]
+              (is (= chzbrgr-lngth bytes-rcvd))
+              (.readBytes buf dst)
+              (log/flush-logs! logger (log/info log-state
                                                 ::wrap-chzbrgr
                                                 "Comparing byte arrays"))
-            (is (time (b-t/bytes= chzbrgr dst)))))))))
+              (is (time (b-t/bytes= chzbrgr dst))))))))))

 (deftest overflow-from-child
   ;; If the child sends bytes faster than we can
   ;; buffer/send, we need a way to signal back-pressure.
-  (let [opts {::specs/outgoing {::specs/pipe-from-child-size K/k-1}}
-        logger (log2/std-out-log-factory)
+  (let [log-state (log/init ::overflow-from-child 0)
+        opts {::specs/outgoing {::specs/pipe-from-child-size K/k-1}
+              ::log/state log-state}
+        logger (log/std-out-log-factory)
         start-state (message/initial-state "Overflowing Test" true opts logger)
         parent-cb (fn [out]
-                    (log/warn "parent-cb called with"
-                              (count out) bytes)
+                    (log/flush-logs! logger
+                                     (log/warn log-state
+                                               ::parent-cb
+                                               ""
+                                               {::length (count out)}))
                     (is (not out) "Should never get called"))
         rcvd (atom [])
         child-cb (fn [in]
-                   (log/info "child-cb received" in)
+                   (log/flush-logs! logger
+                                    (log/info log-state
+                                              ::child-cb
+                                              ""
+                                              {::received in}))
                    (swap! rcvd conj in))
         {event-loop ::specs/io-handle} (message/start! start-state
                                                        logger
@@ -547,10 +558,10 @@
   ;; a single message packet.
   (let [test-run (gensym)
         prelog (utils/pre-log test-run)
-        logger (log2/file-writer-factory "/tmp/message-test.bigger-outbound.clj")
-        log-atom (atom (log2/info (log2/init ::bigger-outbound 0)
-                                  ::test-top
-                                  ""))]
+        logger (log/file-writer-factory "/tmp/message-test.bigger-outbound.clj")
+        log-atom (atom (log/info (log/init ::bigger-outbound 0)
+                                 ::test-top
+                                 ""))]
     ;; TODO: split this into 2 tests
     ;; 1 should stall out like the current implementation,
     ;; waiting for ACKs (maybe drop every other packet?
@@ -585,7 +596,7 @@
                              ;; up and then sends them
                              ;; all at once
                              (swap! log-atom
-                                    log2/info
+                                    log/info
                                     ::server-parent-cb
                                     (str "Message from server to client."
                                          "\nThis really should just be an ACK"))
@@ -594,7 +605,7 @@
           server-child-cb (fn [incoming]
                             (let [prelog (utils/pre-log test-run)]
                               (swap! log-atom
-                                     log2/info
+                                     log/info
                                      ::server-child-cb
                                      "Incoming to server's child")

@@ -619,26 +630,26 @@
                                 (if (keyword? incoming)
                                   (do
                                     (swap! log-atom
-                                           #(log2/warn %
-                                                       ::server-child-cb
-                                                       "Received EOF"
-                                                       incoming))
+                                           #(log/warn %
+                                                      ::server-child-cb
+                                                      "Received EOF"
+                                                      incoming))
                                     (is (s/valid? ::specs/eof-flag incoming))
                                     (message/child-close! @client-io-atom))
                                   (swap! log-atom
-                                         #(log2/debug %
-                                                      ::server-child-cb
-                                                      "Received message bytes"
-                                                      (-> response-state
-                                                          (dissoc :buffer)
-                                                          (assoc :buffer-size (count (:buffer response-state)))
-                                                          (assoc ::packet-size packet-size)))))
+                                         #(log/debug %
+                                                     ::server-child-cb
+                                                     "Received message bytes"
+                                                     (-> response-state
+                                                         (dissoc :buffer)
+                                                         (assoc :buffer-size (count (:buffer response-state)))
+                                                         (assoc ::packet-size packet-size)))))
                                 (swap! srvr-child-state
                                        (fn [cur]
                                          (swap! log-atom
-                                                #(log2/info %
-                                                            ::server-child-cb
-                                                            "Incrementing state count"))
+                                                #(log/info %
+                                                           ::server-child-cb
+                                                           "Incrementing state count"))
                                          (let [incoming (if (keyword? incoming)
                                                           [incoming]
                                                           incoming)]
@@ -652,7 +663,7 @@
                                                (update :address + packet-size)))))
                                 (when (= msg-len (:address @srvr-child-state))
                                   (swap! log-atom
-                                         log2/info
+                                         log/info
                                          ::srvr-child-cb
                                          "Received all expected bytes")
                                   (deliver response @srvr-child-state)
@@ -668,7 +679,7 @@

           parent-cb (fn [bs]
                       (swap! log-atom
-                             log2/info
+                             log/info
                              ::client-parent-cb
                              "Forwarding buffer to server")
                       ;; This approach is over-simplified for the sake
@@ -691,7 +702,7 @@
                      ;; ACKs.
                      ;; Q: Why aren't we?
                      (swap! log-atom
-                            log2/debug
+                            log/debug
                             ::client-child-cb
                             "Incoming"
                             {::payload eof})
@@ -713,7 +724,7 @@
         (let [;; Note that this is what the child sender should be supplying
               message-body (byte-array (range msg-len))]
           (swap! log-atom
-                 log2/debug
+                 log/debug
                  ::bigger-outbound
                  "Replicating child-send"
                  {::to client-io-handle})
@@ -732,7 +743,7 @@
                 end-time (System/currentTimeMillis)]
             (is (not= outcome ::timeout))
             (swap! log-atom
-                   log2/info
+                   log/info
                    ::bigger-outbound
                    "Verifying that state hasn't errored out"
                    {::elapsed-ms (- end-time start-time)})
@@ -750,7 +761,7 @@
                           ;; Q: Why not?
                           byte-seq (into [] (apply concat rcvd-blocks))
                           _ (swap! log-atom
-                                   log2/debug
+                                   log/debug
                                    ::bigger-outbound
                                    "Trying to recreate the incoming stream"
                                    {::rcvd-msg-packet-count (count byte-seq)
@@ -778,10 +789,10 @@
             (comment (is (not outcome) "What should we have here?"))))
         (finally
           (swap! log-atom
-                 log2/info
+                 log/info
                  ::bigger-outbound
                  "Ending test")
-          (log2/flush-logs! logger @log-atom)
+          (log/flush-logs! logger @log-atom)
           (try
             (message/halt! client-io-handle)
             (catch RuntimeException ex


Fix locations highlighting

Fix locations highlighting

--- src/eion/directories/locations.cljs
+++ src/eion/directories/locations.cljs
@@ -7,7 +7,7 @@
             [eion.bindings.electron :as electron]))

 (defn make-route [path]
-  (npm/path-to-regexp (str path ":nested*")))
+  (npm/path-to-regexp (str path "*")))

 (defn make-location [path name]
   { :path path :name name :route (make-route path) })


Fix skip to end button to also update app-db

Fixes #183

--- src/day8/re_frame_10x/events.cljs
+++ src/day8/re_frame_10x/events.cljs
@@ -665,6 +665,7 @@
       ;; Else
       {:db db})))

+;; TODO: this code is a bit messy, needs refactoring and cleaning up.
 (rf/reg-event-fx
   :epochs/previous-epoch
   [(rf/path [:epochs])]
@@ -694,12 +695,13 @@
         {:db         (assoc db :current-epoch-id new-id)
          :dispatch   [:snapshot/reset-current-epoch-app-db new-id]}))))

-(rf/reg-event-db
+(rf/reg-event-fx
   :epochs/most-recent-epoch
   [(rf/path [:epochs])]
-  (fn [db _]
-    (assoc db :current-epoch-index nil
-              :current-epoch-id nil)))
+  (fn [{:keys [db]} _]
+    {:db (assoc db :current-epoch-index nil
+                   :current-epoch-id nil)
+     :dispatch [:snapshot/reset-current-epoch-app-db (utils/last-in-vec (:match-ids db))]}))

 (rf/reg-event-db
   :epochs/replay


unique key deletion

unique key deletion

--- src/er_cassandra/model/upsert.clj
+++ src/er_cassandra/model/upsert.clj
@@ -32,12 +32,12 @@
    returns a Deferred[Either], with Right values describing how
    they were successful, and Left values describing errors"

-  [session ^Model model unique-key-table record]
+  [session ^Model model unique-key-table unique-key-record]

   (m/with-monad dm/either-deferred-monad
     (m/mlet [insert-response (re/insert session
                                         (:name unique-key-table)
-                                        record
+                                        unique-key-record
                                         {:if-not-exists true})

              inserted? (m/return (applied? insert-response))
@@ -45,7 +45,7 @@
              owned? (m/return
                       (applied-or-owned?
                        model
-                       (t/extract-uber-key-value model record)
+                       (t/extract-uber-key-value model unique-key-record)
                        insert-response))

              live-ref? (if-not owned?
@@ -63,7 +63,7 @@
                                       session
                                       (:name unique-key-table)
                                       (:key unique-key-table)
-                                      record
+                                      unique-key-record
                                       {:only-if
                                        (t/extract-uber-key-equality-clause
                                         model
@@ -111,6 +111,26 @@
                                    :key-value key-value}
                                   reason]))))))

+(defn remove-unique-key
+  "remove a single unique key"
+  [session ^Model model unique-key-table uber-key-value key-value]
+  (let [uber-key (t/uber-key model)
+        key (:key unique-key-table)]
+    (m/with-monad dm/either-deferred-monad
+      (m/mlet [delete-result (re/delete session
+                                        (:name unique-key-table)
+                                        key
+                                        key-value
+                                        {:only-if
+                                         (k/key-equality-clause
+                                          uber-key
+                                          uber-key-value)})
+               deleted? (m/return (applied? delete-result))]
+              (m/return
+               (cond
+                 deleted? [:ok :deleted]
+                 :else    [:ok :stale]))))))
+
 (defn acquire-singular-unique-key
   "attempt to acquire a singular unique key, returning a
    Deferred[Right[[:ok key info]]] or a Deferred[Right[[:fail key reason]]]"
@@ -155,7 +175,6 @@

-
 (defn upsert
   "upsert a single instance, creating primary, secondary, unique-key and
    lookup records as required"


AB & RS | Change /sign-in to /login in kerodon tests

--- test/stonecutter/integration/kerodon.clj
+++ test/stonecutter/integration/kerodon.clj
@@ -38,7 +38,7 @@
            (k/visit "/")
            (k/follow-redirect)
            (page-title-is "Sign in")
-           (page-uri-is "/sign-in")))
+           (page-uri-is "/login")))

 (facts "User is returned to same page when email is invalid"
        (-> (k/session h/app)
@@ -62,7 +62,7 @@
        (-> (k/session h/app)
            (k/visit "/profile")
            (k/follow-redirect)
-           (page-uri-is "/sign-in")))
+           (page-uri-is "/login")))

 (facts "User can sign in"
        (-> (k/session h/app)
@@ -76,7 +76,7 @@

 (facts "Home url redirects to profile page if user is signed in"
        (-> (k/session h/app)
-           (k/visit "/sign-in")
+           (k/visit "/login")
            (k/fill-in :.func--email__input "email@server.com")
            (k/fill-in :.func--password__input "valid-password")
            (k/press :.func--sign-in__button)


Sort map keys properly to prevent failures when keys are heterogeneous

Fixes #7

--- src/io/aviso/twixt/exceptions.clj
+++ src/io/aviso/twixt/exceptions.clj
@@ -136,8 +136,8 @@
       (when-not (empty? properties)
         [:dl
          (apply concat
-                (for [k (-> properties keys sort)]
-                  [[:dt (-> k name h)] [:dd (-> (get properties k) to-markup)]]))
+                (for [[k v] (sort-by str properties)]
+                  [[:dt (-> k h)] [:dd (to-markup v)]]))
          ])]
      (if root
        (list


fix classpath issue when files in ~/.m2 get deleted

checks if all previously downloaded files still exist and
rebuilds everything when anything is missing.

see #77

--- src/main/shadow/cljs/npm/cli.cljs
+++ src/main/shadow/cljs/npm/cli.cljs
@@ -159,7 +159,7 @@
                 (reduce-kv conj [dep-id version] mods))))
        (into [])))

-(defn get-classpath [project-root {:keys [cache-root version] :as config}]
+(defn get-classpath [project-root {:keys [cache-root] :as config}]
   (let [cp-file
         (path/resolve project-root cache-root "classpath.edn")

@@ -176,14 +176,27 @@
                   (modified-dependencies? cp-file classpath-config))
           ;; re-create classpath by running the java helper
           (let [jar (js/require "shadow-cljs-jar/path")]
-            (run-java project-root ["-jar" jar] {:input (pr-str classpath-config)
-                                                 :stdio [nil js/process.stdout js/process.stderr]})
-            true))]
-
-    ;; only return :files since the rest is just cache info
-    (-> (util/slurp cp-file)
-        (reader/read-string)
-        (assoc :updated? updated?))))
+            (run-java
+              project-root
+              ["-jar" jar]
+              {:input (pr-str classpath-config)
+               :stdio [nil js/process.stdout js/process.stderr]})
+            true))
+
+        {:keys [files] :as classpath-data}
+        (-> (util/slurp cp-file)
+            (reader/read-string)
+            (assoc :updated? updated?))]
+
+    ;; if something in the ~/.m2 directory is deleted we need to re-fetch it
+    ;; otherwise we end up with weird errors at runtime
+    (if (every? #(fs/existsSync %) files)
+      classpath-data
+      ;; if anything is missing delete the classpath.edn and start over
+      (do (fs/unlinkSync cp-file)
+          (log "WARN: missing dependencies, reconstructing classpath.")
+          (recur project-root config)
+          ))))

 (defn print-error [ex]
   (let [{:keys [tag] :as data}


(SERVER-325) Add test for flushing while an instance is borrowed

--- test/integration/puppetlabs/services/jruby/jruby_pool_int_test.clj
+++ test/integration/puppetlabs/services/jruby/jruby_pool_int_test.clj
@@ -37,6 +37,50 @@
    :ssl-key     localhost-key
    :ssl-ca-cert ca-cert})

+(def script-to-check-if-constant-is-defined
+  "begin; InstanceID; true; rescue NameError; false; end")
+
+(defn add-watch-for-flush-complete
+  [pool-context]
+  (let [flush-complete (promise)]
+    (add-watch (:pool-agent pool-context) :flush-callback
+               (fn [k a old-state new-state]
+                 (when (= k :flush-callback)
+                   (remove-watch a :flush-callback)
+                   (deliver flush-complete true))))
+    flush-complete))
+
+(defn set-constants-and-verify
+  [pool-context]
+  ;; here we set a constant called 'InstanceId' in each instance
+  (jruby-testutils/reduce-over-jrubies! pool-context 4 #(format "InstanceID = %s" %))
+  ;; and validate that we can read that value back from each instance
+  (= #{0 1 2 3}
+     (-> (jruby-testutils/reduce-over-jrubies! pool-context 4 (constantly "InstanceID"))
+         set)))
+
+(defn constant-defined?
+  [jruby-instance]
+  (let [sc (:scripting-container jruby-instance)]
+    (.runScriptlet sc script-to-check-if-constant-is-defined)))
+
+(defn verify-no-constants
+  [pool-context]
+  ;; verify that the constants are cleared out from the instances by looping
+  ;; over them and expecting a 'NameError' when we reference the constant by name.
+  (every? false?
+          (jruby-testutils/reduce-over-jrubies!
+            pool-context
+            4
+            (constantly script-to-check-if-constant-is-defined))))
+
+(defn trigger-flush
+  []
+  (let [response (http-client/delete
+                   "https://localhost:8140/puppet-admin-api/v1/jruby-pool"
+                   ssl-request-options)]
+    (= 204 (:status response))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Tests

@@ -49,21 +93,41 @@
       (let [jruby-service (tk-app/get-service app :JRubyPuppetService)
             context (tk-services/service-context jruby-service)
             pool-context (:pool-context context)]
-        (jruby-testutils/reduce-over-jrubies! pool-context 4 #(format "InstanceID = %s" %))
-        (is (= #{0 1 2 3}
-               (-> (jruby-testutils/reduce-over-jrubies! pool-context 4 (constantly "InstanceID"))
-                   set)))
-        (let [response (http-client/delete
-                         "https://localhost:8140/puppet-admin-api/v1/jruby-pool"
-                         ssl-request-options)]
-          (is (= 204 (:status response))))
-        ; wait until the flush is complete
-        (await (:pool-agent pool-context))
-        (is (every? true?
-                    (jruby-testutils/reduce-over-jrubies!
-                      pool-context
-                      4
-                      (constantly
-                        "begin; InstanceID; false; rescue NameError; true; end"))))))))
+        ;; set a ruby constant in each instance so that we can recognize them
+        (is (true? (set-constants-and-verify pool-context)))
+        (let [flush-complete (add-watch-for-flush-complete pool-context)]
+          (is (true? (trigger-flush)))
+          @flush-complete)
+        ;; now the pool is flushed, so the constants should be cleared
+        (is (true? (verify-no-constants pool-context)))))))

-;; TODO: test flush instance while pool flush is in progress
+(deftest ^:integration hold-instance-while-pool-flush-in-progress-test
+  (testing "instance borrowed from old pool before pool flush begins and returned *after* new pool is available"
+    (bootstrap/with-puppetserver-running
+      app
+      {:puppet-admin {:client-whitelist ["localhost"]}
+       :jruby-puppet {:max-active-instances 4}}
+      (let [jruby-service (tk-app/get-service app :JRubyPuppetService)
+            context (tk-services/service-context jruby-service)
+            pool-context (:pool-context context)]
+        ;; set a ruby constant in each instance so that we can recognize them
+        (is (true? (set-constants-and-verify pool-context)))
+        (let [flush-complete (add-watch-for-flush-complete pool-context)
+              ;; borrow an instance and hold the reference to it.
+              instance (jruby-protocol/borrow-instance jruby-service)]
+          ;; trigger a flush
+          (is (true? (trigger-flush)))
+          ;; borrow until we get an instance that doesn't have a constant,
+          ;; so we'll know that the new pool is online
+          (loop [instance (jruby-protocol/borrow-instance jruby-service)]
+            (let [has-constant? (constant-defined? instance)]
+              (jruby-protocol/return-instance jruby-service instance)
+              (when has-constant?
+                (recur (jruby-protocol/borrow-instance jruby-service)))))
+          ;; return the instance
+          (jruby-protocol/return-instance jruby-service instance)
+          ;; wait until the flush is complete
+          @flush-complete)
+        ;; now the pool is flushed, and the constants should be cleared
+        (is (true? (verify-no-constants pool-context)))))))
+


wip on mouse events

wip on mouse events

--- informing/src/app/core.cljs
+++ informing/src/app/core.cljs
@@ -41,7 +41,9 @@
           :env-mouse-move nil
           :env-mouse-up nil
           }
-    :env {:mouse nil
+    :env {:mouse-down nil
+          :mouse-move nil
+          :mouse-up nil
           :time nil
           }
     :gui {:click-count 0
@@ -71,10 +73,14 @@

 (defonce setup-event-channels!
   (do
-    (swap-event-channel! :dom-viewport-resize
-                         (poly/channel-for-viewport-resize!))
-    (swap-event-channel! :env-mouse-move
-                         (poly/channel-for-mouse-move! js/window))
+    (swap-event-channel!
+     :dom-viewport-resize (poly/channel-for-viewport-resize!))
+    (swap-event-channel!
+     :env-mouse-down (poly/listen-put! js/window :mouse-down (poly/e-chan)))
+    (swap-event-channel!
+     :env-mouse-move (poly/channel-for-mouse-move! js/window))
+    (swap-event-channel!
+     :env-mouse-up (poly/listen-put! js/window :mouse-up (poly/e-chan)))
     true))

@@ -116,8 +122,14 @@
 (defonce rc-dom-viewport-w
   (cc-dom [:viewport :width]))

-(defonce rc-env-mouse
-  (cc-env [:mouse]))
+(defonce rc-env-mouse-down
+  (cc-env [:mouse-down]))
+
+(defonce rc-env-mouse-move
+  (cc-env [:mouse-move]))
+
+(defonce rc-env-mouse-up
+  (cc-env [:mouse-up]))

 ;; (defonce rc-env-mouse-pos-x
 ;;   (cc-env [:mouse-pos :x]))
@@ -145,8 +157,14 @@
 (defn mutate-env-time! []
   (reset! rc-env-time (poly/js-now)))

-(defn mutate-env-mouse! [mouse]
-  (reset! rc-env-mouse mouse))
+(defn mutate-env-mouse-down! [m]
+  (reset! rc-env-mouse-down m))
+
+(defn mutate-env-mouse-move! [m]
+  (reset! rc-env-mouse-move m))
+
+(defn mutate-env-mouse-up! [m]
+  (reset! rc-env-mouse-up m))

 (defn mutate-gui-click-count! []
   (reset! rc-gui-click-count))
@@ -161,8 +179,14 @@
 (defn on-dom-window-load [e]
   (mutate-dom-viewport-size! (poly/get-viewport-width) (poly/get-viewport-height)))

-(defn on-env-mouse-move [mouse]
-  (mutate-env-mouse! mouse))
+(defn on-env-mouse-down [m]
+  (mutate-env-mouse-down! m))
+
+(defn on-env-mouse-move [m]
+  (mutate-env-mouse-move! m))
+
+(defn on-env-mouse-up [m]
+  (mutate-env-mouse-up! m))

 (defn on-env-time-interval []
   (mutate-env-time!))
@@ -183,8 +207,14 @@
 (defonce listen-for-dom-window-load!
   (poly/listen! js/window "load" on-dom-window-load))

+(defonce listen-for-env-mouse-down!
+  (poly/listen-take! (get-event-channel :env-mouse-down) on-env-mouse-down))
+
 (defonce listen-for-env-mouse-move!
   (poly/listen-take! (get-event-channel :env-mouse-move) on-env-mouse-move))
+
+(defonce listen-for-env-mouse-up!
+  (poly/listen-take! (get-event-channel :env-mouse-up) on-env-mouse-up))

 ;; -----------------------------------------------------------------------------
@@ -308,7 +338,9 @@
     [:p "Document height " rc-dom-document-h "px"]
 ;    [:p "Document scroll " rc-dom-document-scroll-x " by " rc-dom-document-scroll-y]
 ;    [:p "Mouse position " "(" rc-env-mouse-pos-x ", " rc-env-mouse-pos-y ")"]
-    [:p "Mouse " (rx (str (into (sorted-map) @rc-env-mouse)))]
+    [:p "Mouse Move " (rx (str (into (sorted-map) @rc-env-mouse-move)))]
+    [:p "Mouse Down " (rx (str (into (sorted-map) @rc-env-mouse-down)))]
+    [:p "Mouse Up " (rx (str (into (sorted-map) @rc-env-mouse-up)))]
     [:p "Frames/second (60 max) " rdom/fps]
     [:p "Button Clicks " rc-gui-click-count " "
      [:button {:on-click on-gui-button-click} "Click Me!"]]


Update Github Pages.

Update Github Pages.

--- examples/hello_world/src/hello_world.cljs
+++ examples/hello_world/src/hello_world.cljs
@@ -12,13 +12,14 @@
       (f/with-options {:form {:horizontal (:orientation-horizontal data)}}
                       (f/panel
                         "Hello, world"
+
                         (f/form
-                          {:on-submit #(js/alert "Submitted")}
                           (f/text "Your name" "Type your name here" data [:name])
                           (f/form-buttons
                             (f/button-primary "Submit" #(js/alert (:name @data)))
-                            (f/button-default "Cancel" #(js/alert "Cancel!")))
-                          (f/checkbox "Horizontal form" data [:orientation-horizontal])))))))
+                            (f/button-default "Cancel" #(js/alert "Cancel!"))))
+
+                        )))))

 (defn main-view
   [app-state _owner]


Use `keep` in a remaining place

Use `keep` in a remaining place

--- src/refactor_nrepl/ns/tracker.clj
+++ src/refactor_nrepl/ns/tracker.clj
@@ -99,6 +99,5 @@
                                   ignore-errors?))
          nses (dep/topo-sort (:clojure.tools.namespace.track/deps tracker))
          filemap (:clojure.tools.namespace.file/filemap tracker)
-         ns2file (zipmap (vals filemap) (keys filemap))]
-     (->> (map ns2file nses)
-          (remove nil?)))))
+         ns->file (zipmap (vals filemap) (keys filemap))]
+     (keep ns->file nses))))


print eval errors with more info

print eval errors with more info

--- src/rksm/cloxp_cljs_repl/core.clj
+++ src/rksm/cloxp_cljs_repl/core.clj
@@ -7,6 +7,7 @@
             [clojure.tools.reader :as reader]
             [clojure.tools.reader.reader-types :as readers]
             [rksm.cloxp-repl :as cloxp-repl]
+            [rksm.cloxp-repl.exception :as ex]
             [rksm.cloxp-cljs.analyzer :as cloxp-ana]
             [rksm.cloxp-com.server :as server]
             [rksm.cloxp-com.messenger :as msg]
@@ -115,7 +116,12 @@
        :as opts}]]
   (let [add-to-meta {} ;(select-keys parsed [:line :column :source])
         {:keys [error] :as result} (eval-cljs form cloxp-repl-env
-                                              (update-in opts [:add-meta] merge add-to-meta))]
+                                              (update-in opts [:add-meta] merge add-to-meta))
+        error (when error (cond
+                            (and (instance? clojure.lang.ExceptionInfo error)
+                                 (-> error .getData :type (= :js-eval-exception)))
+                            (ex-info (-> error ex/process-error :printed) (ex-data error))
+                            :default error))]
     (if (and error throw-errors?)
       (throw error)
       (assoc result :parsed parsed))))


used the 3-arity intern function to remove extra code

--- src/midje/internal_ideas/report.clj
+++ src/midje/internal_ideas/report.clj
@@ -8,9 +8,7 @@
         [midje.util.form-utils :only [pred-cond]])
   (:require [midje.util.colorize :as color]))

-(let [^clojure.lang.Var the-var (intern (the-ns 'clojure.test) 'old-report)]
-  (when-not (.hasRoot the-var)
-    (.bindRoot the-var clojure.test/report)))
+(intern (the-ns 'clojure.test) 'old-report clojure.test/report)

 (def #^:dynamic #^:private *renderer* println)


(SERVER-1142) Add a failing test for static-file-content

In order to validate future changes, this commit adds a test case for
the static file content endpoint that has legacy auth enabled. This case
is known to fail because the request parameters will not be correctly
processed.

--- test/integration/puppetlabs/general_puppet/general_puppet_int_test.clj
+++ test/integration/puppetlabs/general_puppet/general_puppet_int_test.clj
@@ -154,3 +154,18 @@
         (is (= 500 (:status response)))
         (is (re-matches #".*Cannot retrieve code content because the \"versioned-code\.code-content-command\" setting is not present in configuration.*"
                         (:body response))))))))
+
+(deftest ^:integration static-file-content-works-with-legacy-auth
+  (testing "The static_file_content endpoint works even if legacy-auth is enabled."
+    ;; with-test-logging is used here to supress a warning about running with legacy auth enabled.
+    (logging/with-test-logging
+     (bootstrap/with-puppetserver-running
+      app
+      {:jruby-puppet {:use-legacy-auth-conf true}
+       :versioned-code
+       {:code-content-command (script-path "echo")
+        :code-id-command (script-path "echo")}}
+      (testing "for legacy puppet routes"
+        (let [response (get-static-file-content "modules/foo/files/bar?code_id=foobar&environment=test")]
+          (is (= 200 (:status response)) (ks/pprint-to-string response))
+          (is (= "test foobar modules/foo/files/bar\n" (:body response)) (ks/pprint-to-string response))))))))


(PDB-1653) Add a buffer to the internal response-chan

--- src/puppetlabs/puppetdb/command.clj
+++ src/puppetlabs/puppetdb/command.clj
@@ -371,7 +371,7 @@
   [[:PuppetDBServer shared-globals]
    [:MessageListenerService register-listener]]
   (init [this context]
-    (let [response-chan (async/chan)
+    (let [response-chan (async/chan 1000)
           response-mult (async/mult response-chan)
           response-chan-for-pub (async/chan)]
       (async/tap response-mult response-chan-for-pub)


Added comment about ISO error

Added comment about ISO error

--- umm-lib/src/cmr/umm/validation/utils.clj
+++ umm-lib/src/cmr/umm/validation/utils.clj
@@ -33,6 +33,7 @@

    [:iso19115 :collection]
    ;; TODO Update to use the :xpath notation once it is finished, for now just hardcode a string
+   ;; I emailed Katie to ask her what name should go here.
    {:projects "MI_Metadata/acquisitionInformation/MI_AcquisitionInformation/operation/MI_Operation"}
    })


New test: test-get-calendar-3

New test: test-get-calendar-3

--- test/clj_calendar/calendar_test.clj
+++ test/clj_calendar/calendar_test.clj
@@ -142,3 +142,19 @@
             (is (=  (.get calendar (java.util.Calendar/DAY_OF_MONTH)) 1)))
 ))

+(deftest test-get-calendar-3
+    "Check the function clj-calendar.calendar.calendar/get-calendar."
+    (testing "the function clj-calendar.calendar.calendar/get-calendar."
+        (is (not (nil? (get-calendar))))
+        (is (>= (.get (get-calendar) (java.util.Calendar/HOUR)) 0))
+        (is (<= (.get (get-calendar) (java.util.Calendar/HOUR)) 11))
+        (is (>= (.get (get-calendar) (java.util.Calendar/HOUR_OF_DAY)) 0))
+        (is (<= (.get (get-calendar) (java.util.Calendar/HOUR_OF_DAY)) 23))
+        (is (>= (.get (get-calendar) (java.util.Calendar/MINUTE)) 0))
+        (is (<= (.get (get-calendar) (java.util.Calendar/MINUTE)) 59))
+        (is (>= (.get (get-calendar) (java.util.Calendar/SECOND)) 0))
+        (is (<= (.get (get-calendar) (java.util.Calendar/SECOND)) 59))
+        (is (>= (.get (get-calendar) (java.util.Calendar/MILLISECOND)) 0))
+        (is (<= (.get (get-calendar) (java.util.Calendar/MILLISECOND)) 999))
+))
+


New test: test-calculate-first-day-of-week-2

--- test/clj_calendar/calendar_test.clj
+++ test/clj_calendar/calendar_test.clj
@@ -303,3 +303,13 @@
                 ; must be zero, because we get 1st day of each week
                 (is (zero? (calculate-first-day-of-week (get-calendar-for-week year week))))))))

+(deftest test-calculate-first-day-of-week-2
+    "Check the function clj-calendar.calendar/calculate-first-day-of-week"
+    (testing "the function clj-calendar.calendar/calculate-first-day-of-week"
+        (let [calendar (get-calendar)]
+            (doseq [day (range 1 365)]
+                ; don't change the year!
+                (.set calendar java.util.Calendar/YEAR 2001)
+                (.set calendar java.util.Calendar/DAY_OF_YEAR day)
+                (is (= (- 0 (mod day 7)) (calculate-first-day-of-week calendar)))))))
+


Mongo test fix :wrench: [ci drivers]

Mongo test fix :wrench: [ci drivers]

--- test/metabase/driver/mongo_test.clj
+++ test/metabase/driver/mongo_test.clj
@@ -74,7 +74,6 @@
   {:status    :completed
    :row_count 1
    :data      {:rows        [[1]]
-               :annotate?   nil
                :columns     ["count"]
                :cols        [{:name "count", :base_type :type/Integer}]
                :native_form {:collection "venues"


Adding convenience macro for when a test assertion needs access to the rendered component

--- web-client/test/test_burgerboard/huh.clj
+++ web-client/test/test_burgerboard/huh.clj
@@ -11,3 +11,9 @@
                 )
      )
   )
+
+(defmacro with-rendered [params assertion]
+  `(fn ~params
+     (~assertion ~(nth params 0))
+     )
+  )


Fix ns name

Fix ns name

--- test/provisdom/spectomic/t_core.clj
+++ test/provisdom/spectomic/t_core.clj
@@ -1,4 +1,4 @@
-(ns provisdom.spectomic.core-test
+(ns provisdom.spectomic.t-core
   (:require
     [clojure.test :refer :all]
     [clojure.spec :as s]


(maint) Fix race condition in tests

(maint) Fix race condition in tests

The state of a dummy PCP client used by some tests in this project
was racy as it contained a `(future )` field which may have or
may have not been realized at the time the tests were testing it,
which was causing occasional test failures.
This commit makes sure the state of the dummy PCP client is stable
(i.e. its `(future )` field is realized) before its handed over to
the tests.

--- test/puppetlabs/pcp/client_test.clj
+++ test/puppetlabs/pcp/client_test.clj
@@ -10,14 +10,16 @@
 (defn make-test-client
   "A dummied up client object"
   ([user-data]
-   (map->Client {:server "wss://localhost:8142/pcp/v1"
-                 :identity "pcp://the_identity/the_type"
-                 :websocket-client ""
-                 :websocket-connection (atom (future true))
-                 :associate-response (atom (promise))
-                 :handlers {}
-                 :should-stop (promise)
-                 :user-data user-data}))
+   (let [realized-future (future true)]
+     (deref realized-future)                                ; make sure the future is realized
+     (map->Client {:server "wss://localhost:8142/pcp/v1"
+                   :identity "pcp://the_identity/the_type"
+                   :websocket-client ""
+                   :websocket-connection (atom realized-future)
+                   :associate-response (atom (promise))
+                   :handlers {}
+                   :should-stop (promise)
+                   :user-data user-data})))
   ([]
    (make-test-client nil)))


Something incorrectly a future fact

Something incorrectly a future fact

--- test/such/f_relational.clj
+++ test/such/f_relational.clj
@@ -130,7 +130,7 @@

     (fact "making an index and then selecting"
-      (future-fact "1-N 1-N 1-N"
+      (fact "1-N 1-N 1-N"
         (let [combined-index (subject/combined-index-on one-to-many-top-index
                                                         :foreign one-to-many-middle-index
                                                         :foreign one-to-many-bottom-index)]


(PE-16504) Add `get-status` arity w/timeout arg

Add a new arity to the `get-status` method of the StatusService
protocol. This arity takes a timeout argument that overrides the default
timeout value for the level.

--- src/puppetlabs/trapperkeeper/services/status/status_service.clj
+++ src/puppetlabs/trapperkeeper/services/status/status_service.clj
@@ -12,8 +12,11 @@
     the given level.  The return value of the callback function must satisfy
     the puppetlabs.trapperkeeper.services.status.status-core/StatusCallbackResponse
     schema.")
-  (get-status [this service-name level status-version]
-    "Call the status function for a registered service."))
+  (get-status
+    [this service-name level status-version]
+    [this service-name level status-version timeout]
+    "Call the status function for a registered service, optionally providing
+    a timeout to override the default timeout value for the level."))

 (defservice status-service
   StatusService
@@ -43,6 +46,8 @@
                                        service-name service-version status-version status-fn))

   (get-status [this service-name level status-version]
-              (let [status-fn (status-core/get-status-fn (:status-fns (service-context this)) service-name status-version)
-                    timeout (status-core/check-timeout level)]
-                (status-core/guarded-status-fn-call status-fn level timeout))))
+    (get-status this service-name level status-version (status-core/check-timeout level)))
+
+  (get-status [this service-name level status-version timeout]
+    (let [status-fn (status-core/get-status-fn (:status-fns (service-context this)) service-name status-version)]
+      (status-core/guarded-status-fn-call status-fn level timeout))))


use new combine-observes-fn

use new combine-observes-fn


Add more examples

Add more examples

--- src/clojure/clojure_walkthrough/cjia/ch08_xx.clj
+++ src/clojure/clojure_walkthrough/cjia/ch08_xx.clj
@@ -357,3 +357,39 @@

 ; try this out
 (def nancy (Person :new))
+
+(nancy :set! :name "Nancy Drew")
+
+(nancy :get :name) ;; "Nancy Drew"
+
+;; Defining methods
+; we would like to get the following
+;; (defclass Person
+;;   (method age []
+;;      (* 2 10))
+;;   (method greet [visitor]
+;;      (str "Hello there, " visitor)))
+
+(defn method-spec [sexpr]
+  (let [name (keyword (second sexpr))
+        body (next sexpr)]
+    [name (conj body 'fn)]))
+
+(method-spec '(method age [] (* 2 10))) ;; [:age (fn age [] (* 2 10))]
+
+(defn method-specs [sexprs]
+  (->> sexprs
+       (filter #(= 'method (first %)))
+       (mapcat method-spec)
+       (apply hash-map)))
+
+; sample usage
+(method-specs '((method age [] (* 2 10))
+                (method greet [visitor] (str "Hello there, " visitor))))
+;;=> {:age (fn age [] (* 2 10)), :greet (fn greet [visitor] (str "Hello there, " visitor))}
+
+(defn new-class [class-name methods]
+  (fn klass [command & args]
+    (case command
+      :name (name class-name)
+      :new (new-object klass))))


Add justification comment for java version manipulation

--- src/clojure/clojurewerkz/cassaforte/embedded.clj
+++ src/clojure/clojurewerkz/cassaforte/embedded.clj
@@ -25,7 +25,9 @@
 (defn start-server!
   []
   (System/setProperty "cassandra.config" (str (io/resource "cassandra.yaml")))
-  (System/setProperty "java.version" "1.7.0_15") ;; WTF
+  ;; If you're running Cassandra on Mac Os X on 1.7, you'll get in trouble with parsing version, because
+  ;; "1.7.0_06-ea" ea doesn't parse as int. That's a workaround
+  (System/setProperty "java.version" "1.7.0_15")
   (System/setProperty "cassandra-foreground" "yes")
   (System/setProperty "log4j.defaultInitOverride" "false")
   (System/setProperty "log4j.appender.R.File" "/var/log/cassandra/system.log")


Fixed issue with allow_missing when a provider does not exist.

--- src/cmr/metadata_db/services/concept_service.clj
+++ src/cmr/metadata_db/services/concept_service.clj
@@ -187,6 +187,12 @@
           {}
           concept-ids))

+(defn- filter-non-existant-providers
+  "Removes providers that don't exist from a map of provider-ids to values."
+  [db provider-id-map]
+  (let [existing-provider-ids (set (provider-db/get-providers db))]
+    (into {} (filter (comp existing-provider-ids first) provider-id-map))))
+
 (deftracefn get-concepts
   "Get multiple concepts by concept-id and revision-id. Returns concepts in order requested"
   [context concept-id-revision-id-tuples allow-missing?]
@@ -196,8 +202,13 @@
         parallel-chunk-size (get-in context [:system :parallel-chunk-size])
         db (util/context->db context)
         ;; Split the tuples so they can be requested separately for each provider and concept type
-        split-tuples-map (split-concept-id-revision-id-tuples concept-id-revision-id-tuples)]
-    (validate-providers-exist db (keys split-tuples-map))
+        split-tuples-map (split-concept-id-revision-id-tuples concept-id-revision-id-tuples)
+        split-tuples-map (if allow-missing?
+                           (filter-non-existant-providers db split-tuples-map)
+                           (do
+                             (validate-providers-exist db (keys split-tuples-map))
+                             split-tuples-map))]
+
     (let [concepts (apply concat
                           (for [[provider-id concept-type-tuples-map] split-tuples-map
                                 [concept-type tuples] concept-type-tuples-map]
@@ -234,8 +245,12 @@
         parallel-chunk-size (get-in context [:system :parallel-chunk-size])
         db (util/context->db context)
         ;; Split the concept-ids so they can be requested separately for each provider and concept type
-        split-concept-ids-map (split-concept-ids concept-ids)]
-    (validate-providers-exist db (keys split-concept-ids-map))
+        split-concept-ids-map (split-concept-ids concept-ids)
+        split-concept-ids-map (if allow-missing?
+                                (filter-non-existant-providers db split-concept-ids-map)
+                                (do
+                                  (validate-providers-exist db (keys split-concept-ids-map))
+                                  split-concept-ids-map))]
     (let [concepts (apply concat
                           (for [[provider-id concept-type-concept-id-map] split-concept-ids-map
                                 [concept-type cids] concept-type-concept-id-map]


AEAD: add more tests

AEAD: add more tests

Add more tests/assertions for

- ciphertext verification errors
- keygen functions

--- test/caesium/crypto/aead_test.clj
+++ test/caesium/crypto/aead_test.clj
@@ -3,8 +3,8 @@
             [caesium.test-utils :refer [const-test]]
             [caesium.vectors :as v]
             [clojure.test :refer [is deftest]]
-            [caesium.util :as u]
-            [caesium.byte-bufs :as bb]))
+            [caesium.byte-bufs :as bb])
+  (:import (java.nio ByteBuffer)))

 (const-test
  aead/chacha20poly1305-ietf-keybytes 32
@@ -22,6 +22,15 @@
  aead/xchacha20poly1305-ietf-npubbytes 24
  aead/xchacha20poly1305-ietf-abytes 16)

+(defn rand-bit-flip
+  "Randomly flip a bit in the byte array"
+  [^bytes bs]
+  (let [bs (aclone bs)
+        i  (rand-int (alength bs))
+        v  (aget bs i)]
+    (aset bs i (byte (bit-flip v (rand-int 7))))
+    bs))
+
 (def aead-chacha20poly1305-ietf-vector
   (comp v/hex-resource (partial str "vectors/aead/chacha20poly1305ietf/")))

@@ -37,7 +46,10 @@
     (is (bb/bytes= ptext (aead/chacha20poly1305-ietf-decrypt ctext ad nonce k)))
     (is (bb/bytes= ptext (aead/chacha20poly1305-ietf-decrypt
                           (aead/chacha20poly1305-ietf-encrypt ptext ad generated-nonce generated-keygen)
-                          ad generated-nonce generated-keygen)))))
+                          ad generated-nonce generated-keygen)))
+    (is (thrown-with-msg?
+         RuntimeException #"Ciphertext verification failed"
+         (aead/chacha20poly1305-ietf-decrypt (rand-bit-flip ctext) ad nonce k)))))

 (deftest chacha20poly1305-ietf-encrypt-decrypt-detached-test
   (let [k (aead-chacha20poly1305-ietf-vector "key")
@@ -49,7 +61,16 @@
         {:keys [c mac]} (aead/chacha20poly1305-ietf-encrypt-detached ptext ad nonce k)]
     (is (bb/bytes= ctext c))
     (is (bb/bytes= mtext mac))
-    (is (bb/bytes= ptext (aead/chacha20poly1305-ietf-decrypt-detached ctext mac ad nonce k)))))
+    (is (bb/bytes= ptext (aead/chacha20poly1305-ietf-decrypt-detached ctext mac ad nonce k)))
+    (is (thrown-with-msg?
+         RuntimeException #"Ciphertext verification failed"
+         (aead/chacha20poly1305-ietf-decrypt-detached (rand-bit-flip ctext) mac ad nonce k)))))
+
+(deftest chacha20poly1305-ietf-keygen-test
+  (let [ks (set (repeatedly 100 aead/chacha20poly1305-ietf-keygen))]
+    (is (= 100 (count ks)))
+    (doseq [^ByteBuffer k ks]
+      (is (= aead/chacha20poly1305-ietf-keybytes (.limit k))))))

 (def aead-chacha20poly1305-vector
   (comp v/hex-resource (partial str "vectors/aead/chacha20poly1305/")))
@@ -66,7 +87,10 @@
     (is (bb/bytes= ptext (aead/chacha20poly1305-decrypt ctext ad nonce k)))
     (is (bb/bytes= ptext (aead/chacha20poly1305-decrypt
                           (aead/chacha20poly1305-encrypt ptext ad generated-nonce generated-keygen)
-                          ad generated-nonce generated-keygen)))))
+                          ad generated-nonce generated-keygen)))
+    (is (thrown-with-msg?
+         RuntimeException #"Ciphertext verification failed"
+         (aead/chacha20poly1305-decrypt (rand-bit-flip ctext) ad nonce k)))))

 (deftest chacha20poly1305-encrypt-decrypt-detached-test
   (let [k (aead-chacha20poly1305-vector "key")
@@ -78,7 +102,16 @@
         {:keys [c mac]} (aead/chacha20poly1305-encrypt-detached ptext ad nonce k)]
     (is (bb/bytes= ctext c))
     (is (bb/bytes= mtext mac))
-    (is (bb/bytes= ptext (aead/chacha20poly1305-decrypt-detached ctext mac ad nonce k)))))
+    (is (bb/bytes= ptext (aead/chacha20poly1305-decrypt-detached ctext mac ad nonce k)))
+    (is (thrown-with-msg?
+         RuntimeException #"Ciphertext verification failed"
+         (aead/chacha20poly1305-decrypt-detached (rand-bit-flip ctext) mac ad nonce k)))))
+
+(deftest chacha20poly1305-keygen-test
+  (let [ks (set (repeatedly 100 aead/chacha20poly1305-keygen))]
+    (is (= 100 (count ks)))
+    (doseq [^ByteBuffer k ks]
+      (is (= aead/chacha20poly1305-keybytes (.limit k))))))

 (def aead-xchacha20poly1305-ietf-vector
   (comp v/hex-resource (partial str "vectors/aead/xchacha20poly1305ietf/")))
@@ -88,11 +121,14 @@
         ptext (aead-xchacha20poly1305-ietf-vector "plaintext")
         ad (aead-xchacha20poly1305-ietf-vector "ad")
         nonce (aead/new-xchacha20poly1305-ietf-nonce)
-        generated-key (aead/xchacha20poly1305-ietf-keygen)]
-    (is (bb/bytes= ptext (aead/xchacha20poly1305-ietf-decrypt
-                          (aead/xchacha20poly1305-ietf-encrypt ptext ad nonce k) ad nonce k)))
-    (is (bb/bytes= ptext (aead/xchacha20poly1305-ietf-decrypt
-                          (aead/xchacha20poly1305-ietf-encrypt ptext ad nonce generated-key) ad nonce generated-key)))))
+        generated-key (aead/xchacha20poly1305-ietf-keygen)
+        ctext1 (aead/xchacha20poly1305-ietf-encrypt ptext ad nonce k)
+        ctext2 (aead/xchacha20poly1305-ietf-encrypt ptext ad nonce generated-key)]
+    (is (bb/bytes= ptext (aead/xchacha20poly1305-ietf-decrypt ctext1 ad nonce k)))
+    (is (bb/bytes= ptext (aead/xchacha20poly1305-ietf-decrypt ctext2 ad nonce generated-key)))
+    (is (thrown-with-msg?
+         RuntimeException #"Ciphertext verification failed"
+         (aead/xchacha20poly1305-ietf-decrypt (rand-bit-flip ctext1) ad nonce k)))))

 (deftest xchacha20poly1305-ietf-encrypt-decrypt-detached-test
   (let [k (aead-xchacha20poly1305-ietf-vector "key")
@@ -100,4 +136,13 @@
         ad (aead-xchacha20poly1305-ietf-vector "ad")
         nonce (aead/new-xchacha20poly1305-ietf-nonce)
         {:keys [c mac]} (aead/xchacha20poly1305-ietf-encrypt-detached ptext ad nonce k)]
-    (is (bb/bytes= ptext (aead/xchacha20poly1305-ietf-decrypt-detached c mac ad nonce k)))))
+    (is (bb/bytes= ptext (aead/xchacha20poly1305-ietf-decrypt-detached c mac ad nonce k)))
+    (is (thrown-with-msg?
+         RuntimeException #"Ciphertext verification failed"
+         (aead/xchacha20poly1305-ietf-decrypt-detached (rand-bit-flip c) mac ad nonce k)))))
+
+(deftest xchacha20poly1305-ietf-keygen-test
+  (let [ks (set (repeatedly 100 aead/xchacha20poly1305-ietf-keygen))]
+    (is (= 100 (count ks)))
+    (doseq [^ByteBuffer k ks]
+      (is (= aead/xchacha20poly1305-ietf-keybytes (.limit k))))))


Hack to reduce flakiness.

Hack to reduce flakiness.

--- test/clj/hatnik/selenium/core.clj
+++ test/clj/hatnik/selenium/core.clj
@@ -92,7 +92,11 @@
   (.until (WebDriverWait. driver 10)
           (-> type dialog-invisible-selector
               By/cssSelector
-              ExpectedConditions/invisibilityOfElementLocated)))
+              ExpectedConditions/invisibilityOfElementLocated))
+  ; Usually we're waiting until dialog becomes invisible as a sign
+  ; of completed action. But it's not reliable as some om/react stuff
+  ; might be async. So let's just wait for a little more longer explicitly.
+  (Thread/sleep 2000))

 (defn wait-until [driver condition message]
   (doto (WebDriverWait. driver 10)


require-macros REPL special

require-macros REPL special

--- ClojureScript/planck/src/planck/core.cljs
+++ ClojureScript/planck/src/planck/core.cljs
@@ -38,18 +38,21 @@
 (defn ns-form? [form]
   (and (seq? form) (= 'ns (first form))))

-(def repl-specials '#{in-ns require doc})
+(def repl-specials '#{in-ns require require-macros doc})

 (defn repl-special? [form]
   (and (seq? form) (repl-specials (first form))))

 (def repl-special-doc-map
-  '{in-ns   {:arglists ([name])
-             :doc      "Sets *cljs-ns* to the namespace named by the symbol, creating it if needed."}
-    require {:arglists ([& args])
-             :doc      "Loads libs, skipping any that are already loaded."}
-    doc     {:arglists ([name])
-             :doc      "Prints documentation for a var or special form given its name"}})
+  '{in-ns          {:arglists ([name])
+                    :doc      "Sets *cljs-ns* to the namespace named by the symbol, creating it if needed."}
+    require        {:arglists ([& args])
+                    :doc      "Loads libs, skipping any that are already loaded."}
+    require-macros {:arglists ([& args])
+                    :doc      "Similar to the require REPL special function but
+                    only for macros."}
+    doc            {:arglists ([name])
+                    :doc      "Prints documentation for a var or special form given its name"}})

 (defn- repl-special-doc [name-symbol]
   (assoc (repl-special-doc-map name-symbol)
@@ -106,7 +109,7 @@
 (defn eval [{:keys [source]}]
   (js/eval source))

-(defn require [args]
+(defn require [macros-ns? args]
   (let [[[_ sym] reload] args]
     (prn "sym" sym)
     (prn "reload" reload)
@@ -117,7 +120,8 @@
        :*eval-fn*      eval}
       sym
       reload
-      nil
+      {:macros-ns macros-ns?
+       :verbose   true}
       (fn [res]
         (println "require result:" res)))))

@@ -131,7 +135,8 @@
       (if (repl-special? form)
         (case (first form)
           in-ns (reset! current-ns (second (second form)))
-          require (planck.core/require (rest form))
+          require (planck.core/require false (rest form))
+          require-macros (planck.core/require true (rest form))
           doc (if (repl-specials (second form))
                 (repl/print-doc (repl-special-doc (second form)))
                 (repl/print-doc


:bug: Fix data inconsistency on wrong deletion ordering.

--- frontend/src/uxbox/main/data/workspace.cljs
+++ frontend/src/uxbox/main/data/workspace.cljs
@@ -1253,15 +1253,12 @@

 (defn- delete-shapes
   [ids]
-  (us/assert ::set-of-uuid ids)
+  (us/assert (s/coll-of ::us/uuid) ids)
   (ptk/reify ::delete-shapes
     ptk/WatchEvent
     (watch [_ state stream]
       (let [objects (get-in state [:workspace-data :objects])
             session-id (:session-id state)
-
-            ids (seq ids)
-
             rchanges (mapv #(array-map :type :del-obj :id %) ids)
             uchanges (mapv (fn [id]
                              (let [obj (get objects id)
@@ -1282,7 +1279,7 @@
     (watch [_ state stream]
       (let [objects (get-in state [:workspace-data :objects])
             obj (get objects id)
-            ids (d/concat #{} (:shapes obj) [(:id obj)])]
+            ids (d/concat [] (:shapes obj) [(:id obj)])]
         (rx/of (delete-shapes ids))))))

 (def delete-selected


Remove old test

Remove old test

--- test/sormilla/drone_comm_test.clj
+++ test/sormilla/drone_comm_test.clj
@@ -1,10 +1,3 @@
 (ns sormilla.drone-comm-test
   (:require [sormilla.drone-comm :refer :all]
             [midje.sweet :refer :all]))
-
-(facts "parse-nav-state"
-  (parse-nav-state  0x00000000) => (contains {:flying :landed :emergency :ok})
-  (parse-nav-state  0x00000001) => (contains {:flying :flying :emergency :ok})
-  (parse-nav-state  0x80000000) => (contains {:flying :landed :emergency :detected})
-  (parse-nav-state  0x80000001) => (contains {:flying :flying :emergency :detected}))
-


keep state between figwheel reloads

keep state between figwheel reloads

--- frontend/src/leftover/core.cljs
+++ frontend/src/leftover/core.cljs
@@ -11,7 +11,7 @@
 (enable-console-print!)

 (def actions (chan))
-(def app-state (atom {:state :loading
+(defonce app-state (atom {:state :loading
                       :data {}}))

 (def base-url (str "http://" (.. js/document -location -hostname) ":8000"))


AHHHH fixed the typo with a typo...   .chuckSize is now .chunkSize

--- gaeshi/src/gaeshi/datastore.clj
+++ gaeshi/src/gaeshi/datastore.clj
@@ -306,7 +306,7 @@
       (when limit (.limit fetch-options limit))
       (when offset (.offset fetch-options offset))
       (when prefetch-size (.prefetchSize fetch-options prefetch-size))
-      (when chunk-size (.chuckSize fetch-options chunk-size))
+      (when chunk-size (.chunkSize fetch-options chunk-size))
       (when start-cursor (.startCursor fetch-options start-cursor))
       (when end-cursor (.endCursor fetch-options end-cursor))
       fetch-options)))


Connect tids to values; remove join fields

--- src/clj/cglossa/data_import/metadata_values.clj
+++ src/clj/cglossa/data_import/metadata_values.clj
@@ -13,12 +13,11 @@
    :source       {:file {:path "###TSV-PATH###"}}
    :extractor    {:row {}}
    :transformers [{:csv {:separator "\t"}}
-                  {:vertex {:class "MetadataValue" :skipDuplicates true}}
+                  {:vertex {:class "MetadataValue"}}
                   {:edge
-                   {:class                "HasMetadataValue"
+                   {:class                "InCategory"
                     :lookup               "MetadataCategory.corpus_cat"
                     :joinFieldName        "corpus_cat"
-                    :direction            "in"
                     :unresolvedLinkAction "ERROR"}}]
    :loader       {:orientdb
                   {:dbURL               "remote:localhost/Glossa"
@@ -36,11 +35,12 @@
    :extractor    {:row {}}
    :transformers [{:csv {:separator "\t"}}
                   {:vertex {:class "MetadataValue"}}
+                  {:field {:fieldName "value" :expression "tid"}}
+                  {:field {:fieldName "tid" :operation "remove"}}
                   {:edge
-                   {:class                "HasMetadataValue"
+                   {:class                "InCategory"
                     :lookup               "MetadataCategory.corpus_cat"
                     :joinValue            "###CORPUS###_tid"
-                    :direction            "in"
                     :unresolvedLinkAction "ERROR"}}]
    :loader       {:orientdb
                   {:dbURL               "remote:localhost/Glossa"
@@ -49,37 +49,41 @@
                    :useLightweightEdges true
                    :classes             [{:name "MetadataCategory" :extends "V"}
                                          {:name "MetadataValue" :extends "V"}]
-                   :indexes             [{:class "MetadataCategory" :fields ["corpus_cat:string"] :type "UNIQUE"}]}}})
+                   :indexes             [{:class  "MetadataCategory"
+                                          :fields ["corpus_cat:string"]
+                                          :type   "UNIQUE"}
+                                         {:class  "MetadataValue"
+                                          :fields ["corpus_cat:string" "value:string"]
+                                          :type   "UNIQUE"}]}}})

-(defn- create-non-tids-config! [config-path tsv-path]
+(defn- create-non-tid-config! [config-path tsv-path]
   (spit config-path (-> non-tids-template
                         (cheshire/generate-string {:pretty true})
                         (str/replace "###TSV-PATH###" tsv-path))))

-(defn- create-non-tids-tsv! [corpus tsv-path]
-  (let [orig-tsv-path (-> (str "data/metadata_values/" corpus ".tsv") io/resource .getPath)]
-    (with-open [orig-tsv-file (io/reader orig-tsv-path)
-                tsv-file      (io/writer tsv-path)]
-      (let [[headers & rows] (utils/read-csv orig-tsv-file)
-            [tid-header & other-headers] headers
-            non-blank? (complement str/blank?)]
-        (assert (= "tid" tid-header)
-                (str "Format error: Expected first line to contain column headers "
-                     "with 'tid' (text ID) as the first header."))
-        (utils/write-csv tsv-file (->> rows
-                                       (apply map list)     ; Convert rows to columns
-                                       rest                 ; Skip 'tid' column
-                                       ;; Startpos and endpos are not metadata values; for the
-                                       ;; other columns, construct a [header column] vector
-                                       (keep-indexed (fn [index col]
-                                                       (let [header (get (vec other-headers) index)]
-                                                         (when-not (get #{"startpos" "endpos"} header)
-                                                           [header col]))))
-                                       (mapcat (fn [[header col-vals]]
-                                                 (map (fn [val] [(str corpus "_" header) val]) col-vals)))
-                                       set
-                                       (filter #(non-blank? (second %)))
-                                       (cons ["corpus_cat" "value"])))))))
+(defn- create-non-tid-tsv! [corpus orig-tsv-path tsv-path]
+  (with-open [orig-tsv-file (io/reader orig-tsv-path)
+              tsv-file      (io/writer tsv-path)]
+    (let [[headers & rows] (utils/read-csv orig-tsv-file)
+          [tid-header & other-headers] headers
+          non-blank? (complement str/blank?)]
+      (assert (= "tid" tid-header)
+              (str "Format error: Expected first line to contain column headers "
+                   "with 'tid' (text ID) as the first header."))
+      (utils/write-csv tsv-file (->> rows
+                                     (apply map list)       ; Convert rows to columns
+                                     rest                   ; Skip 'tid' column
+                                     ;; Startpos and endpos are not metadata values; for the
+                                     ;; other columns, construct a [header column] vector
+                                     (keep-indexed (fn [index col]
+                                                     (let [header (get (vec other-headers) index)]
+                                                       (when-not (get #{"startpos" "endpos"} header)
+                                                         [header col]))))
+                                     (mapcat (fn [[header col-vals]]
+                                               (map (fn [val] [(str corpus "_" header) val]) col-vals)))
+                                     set
+                                     (filter #(non-blank? (second %)))
+                                     (cons ["corpus_cat" "value"]))))))

 (defn- create-tid-tsv! [corpus tsv-path]
   (let [orig-tsv-path (-> (str "data/metadata_values/" corpus ".tsv") io/resource .getPath)]
@@ -95,20 +99,37 @@
                                                [(str corpus "_tid") (first row)])
                                              rows)))))))

-(defn- create-tid-config! [corpus config-path tsv-path]
-  (spit config-path (-> tids-template
-                        (cheshire/generate-string {:pretty true})
-                        (str/replace "###TSV-PATH###" tsv-path)
-                        (str/replace "###CORPUS###" corpus))))
+(defn- create-tid-config! [corpus config-path orig-tsv-path]
+  (with-open [tsv-file (io/reader orig-tsv-path)]
+    (let [other-cats     (->> (utils/read-csv tsv-file)
+                              first
+                              rest
+                              (filter #(not (get #{"startpos" "endpos"} %1))))
+          cat-edges      (map (fn [cat]
+                                {:edge {:class                "HasMetadataValue"
+                                        :lookup               (str "SELECT from MetadataValue WHERE corpus_cat = '"
+                                                                   (str corpus "_" cat)
+                                                                   "' AND value = ?")
+                                        :joinFieldName        cat
+                                        :unresolvedLinkAction "ERROR"}})
+                              other-cats)
+          field-removals (map (fn [cat]
+                                {:field {:fieldName cat
+                                         :operation "remove"}})
+                              other-cats)]
+      (spit config-path (-> tids-template
+                            (update-in [:transformers] concat cat-edges field-removals)
+                            (cheshire/generate-string {:pretty true})
+                            (str/replace "###TSV-PATH###" orig-tsv-path)
+                            (str/replace "###CORPUS###" corpus))))))

 (defn import! [corpus]
-  (let [tid-tsv-path         (.getPath (fs/temp-file "tids"))
-        non-tids-tsv-path    (.getPath (fs/temp-file "metadata_vals"))
-        tid-config-path      (.getPath (fs/temp-file "tid_config"))
-        non-tids-config-path (.getPath (fs/temp-file "metadata_val_config"))]
-    (create-non-tids-tsv! corpus non-tids-tsv-path)
-    (create-non-tids-config! non-tids-config-path non-tids-tsv-path)
-    #_(create-tid-tsv! corpus tid-tsv-path)
-    #_(create-tid-config! corpus tid-config-path tid-tsv-path)
-    (utils/run-etl non-tids-config-path)
-    #_(utils/run-etl tid-config-path)))
+  (let [orig-tsv-path       (-> (str "data/metadata_values/" corpus ".tsv") io/resource .getPath)
+        non-tid-tsv-path    (.getPath (fs/temp-file "metadata_vals"))
+        tid-config-path     (.getPath (fs/temp-file "tid_config"))
+        non-tid-config-path (.getPath (fs/temp-file "metadata_val_config"))]
+    (create-non-tid-tsv! corpus orig-tsv-path non-tid-tsv-path)
+    (create-non-tid-config! non-tid-config-path non-tid-tsv-path)
+    (create-tid-config! corpus tid-config-path orig-tsv-path)
+    (utils/run-etl non-tid-config-path)
+    (utils/run-etl tid-config-path)))


Fix map-file bug.

Fix map-file bug.

--- src/clojure/uncomplicate/neanderthal/native.clj
+++ src/clojure/uncomplicate/neanderthal/native.clj
@@ -387,6 +387,6 @@
      (map-channel fact channel n-or-flag)))
   ([fact file]
    (let [channel (if (instance? FileChannel file) file (channel file))]
-     (map-channel channel file)))
+     (map-channel fact channel)))
   ([file]
    (map-file native-float file)))


add project cleaning on dependency change

--- plugin/src/leiningen/figwheel.clj
+++ plugin/src/leiningen/figwheel.clj
@@ -5,6 +5,7 @@
    [leiningen.core.eval :as leval]
    [leiningen.core.project :as lproj]
    [leiningen.core.utils :as lutils]
+   [leiningen.clean :as clean]
    [clojure.java.io :as io]
    [figwheel-sidecar.config :as fc]
    [figwheel-sidecar.config-check.ansi :refer [with-color]]))
@@ -95,11 +96,24 @@
             "You may need to run \"lein clean\" \n"
             "Running \"lein deps :tree\" can help you see your dependency tree.")))))

+(defn clean-on-dependency-change [{:keys [target-path dependencies] :as project}]
+  (when (and target-path dependencies)
+    (fc/on-stamp-change
+     {:file (io/file
+             target-path
+             "stale"
+             "leiningen.figwheel.clean-on-dependency-change")
+      :signature (pr-str (sort-by str dependencies))}
+     #(do
+        (println "Figwheel: Cleaning because dependencies changed")
+        (clean/clean project)))))
+
 (defn figwheel
   "Autocompile ClojureScript and serve the changes over a websocket (+ plus static file server)."
   [project & build-ids]
   (check-version-match)
   (fc/system-asserts)
+  (clean-on-dependency-change project)
   (when-let [config-data (validate-figwheel-conf project)]
     (let [{:keys [data] :as figwheel-internal-data}
           (-> config-data


Just kidding. Back to the old style.

Just kidding. Back to the old style.

--- resources/code/1.1.4.3.clj
+++ resources/code/1.1.4.3.clj
@@ -1 +1 @@
-(defn <name> [<formal parameters>] <body>)
+(defn <-name-> [<-formal parameters->] <-body->)


bump version in project.clj bootstrap

bump version in project.clj bootstrap

--- streamparse/bootstrap/project/project.jinja2.clj
+++ streamparse/bootstrap/project/project.jinja2.clj
@@ -7,7 +7,7 @@
   :dependencies [     [org.clojure/data.json "0.2.4"]
                       [org.clojure/tools.cli "0.3.1"]
                       [org.apache.storm/storm-core "0.9.1-incubating"]
-                      [com.parsely/streamparse "0.0.1-SNAPSHOT"]]
+                      [com.parsely/streamparse "0.0.2-SNAPSHOT"]]
   :jar-exclusions     [#"log4j\.properties" #"backtype" #"trident" #"META-INF" #"meta-inf" #"\.yaml"]
   :uberjar-exclusions [#"log4j\.properties" #"backtype" #"trident" #"META-INF" #"meta-inf" #"\.yaml"]
   )


use :require instead of :use in do-create-migration (#94)

--- joplin.core/src/joplin/core.clj
+++ joplin.core/src/joplin/core.clj
@@ -202,7 +202,7 @@
       (println "creating" path)
       (try
         (spit path (format "(ns %s
-  (:use [%s]))
+  (:require [%s :refer :all]))

 (defn up [db]
   ;; TODO - up migration code here