Debug why server drops Initiate packets (WIP)

There are at least 3 different threads of changes worming through here.

Start making the conversion to functional logging. Had to do this
because we call a function in crypto that has also made that switch.

Unfortunately, it makes debugging the other problems more challenging.

Started refactoring a do-fork-child function out of the middle of
do-handle. Which used to be named handle!

And then I'm trying to debug why do-handle fails silently.

--- src/clojure/frereth_cp/server/initiate.clj
+++ src/clojure/frereth_cp/server/initiate.clj
@@ -12,6 +12,7 @@
              [bit-twiddling :as b-t]
              [constants :as K]
              [crypto :as crypto]
+             [logging :as log2]
              [serialization :as serial]
              [specs :as specs]
              [templates :as templates]]
@@ -255,11 +256,14 @@
             (serial/decompose templates/black-box-dscr vouch-buf)))))))

 (s/fdef open-client-crypto-box
-        :args (s/cat :initiate ::K/initiate-packet-spec
+  :args (s/cat :log-state ::log2/state
+               :initiate ::K/initiate-packet-spec
                      :current-client ::client-state)
-        :ret ::K/initiate-client-vouch-wrapper)
+  :ret (s/keys :req [::log2/state]
+               :opt [::K/initiate-client-vouch-wrapper]))
 (defn open-client-crypto-box
-  [{:keys [::K/outer-i-nonce]
+  [log-state
+   {:keys [::K/outer-i-nonce]
     ^bytes vouch-wrapper ::K/vouch-wrapper
     :as initiate}
    current-client]
@@ -267,19 +271,24 @@
   (log/info "Opening the Crypto box we just received from the client")
   (log/debug "The box we're opening is" (count vouch-wrapper) "bytes long")
   (let [message-length (- (count vouch-wrapper) K/minimum-vouch-length)]
-    (if-let [clear-text (crypto/open-box K/initiate-nonce-prefix
-                                         outer-i-nonce
-                                         vouch-wrapper
-                                         (get-in current-client [::state/shared-secrets
-                                                                 ::state/client-short<->server-short]))]
-      (do
-        (log/info "Decomposing...")
-        (serial/decompose (assoc-in K/initiate-client-vouch-wrapper
-                                    [::K/message ::K/length]
-                                    message-length)
-                          clear-text))
-      (do (log/info "Opening client crypto vouch failed")
-          nil))))
+    (let [{log-state ::log2/state
+           clear-text ::crypto/unboxed} (crypto/open-box log-state
+                                                         K/initiate-nonce-prefix
+                                                         outer-i-nonce
+                                                         vouch-wrapper
+                                                         (get-in current-client [::state/shared-secrets
+                                                                                ::state/client-short<->server-short]))]
+      (if clear-text
+        {::log/state (log2/info log-state
+                                ::open-client-crypto-box
+                                "Decomposing...")
+         ::K/initiate-client-vouch-wrapper (serial/decompose (assoc-in K/initiate-client-vouch-wrapper
+                                                                       [::K/message ::K/length]
+                                                                       message-length)
+                                                             clear-text)}
+        {::log/state (log2/warn log-state
+                                ::open-client-crypto-box
+                                "Opening client crypto vouch failed")}))))

 (s/fdef validate-server-name
         :args (s/cat :state ::state/state
@@ -363,133 +372,215 @@
           (.getBytes inner-pk-buf 0 inner-pk)
           (b-t/bytes= short-pk inner-pk))))))

+(s/fdef do-fork-child
+  :args (s/cat :state ::state/state
+               :active-client ::state/client-state
+               :client-long-pk ::shared/public-key
+               :client-short-pk ::shared/public-key
+               :server-short-sk ::shared/secret-key
+               :host ::shared/host
+               :port ::shared/port
+               :initiate ::serial/decomposed
+               :client-message-box ::K/initiate-client-vouch-wrapper)
+  :ret ::state/state)
+(defn do-fork-child
+  [{log-state ::log2/state
+    :as state}
+   active-client
+   client-long-pk
+   client-short-pk
+   server-short-sk
+   host
+   port
+   initiate
+   client-message-box]
+  (let [^ByteBuf rcvd-nonce-buffer (::K/outer-i-nonce initiate)
+        rcvd-nonce-array (byte-array specs/client-nonce-suffix-length)
+        _ (.getBytes rcvd-nonce-buffer 0 rcvd-nonce-array)
+        _ (.release rcvd-nonce-buffer)
+        rcvd-nonce (b-t/uint64-unpack rcvd-nonce-array)
+        active-client (assoc active-client
+                             ;; Seems very likely that I should convert this
+                             ;; to a byte-array
+                             ::client-extension (::K/clnt-xtn initiate)
+                             ::client-ip host
+                             ::client-port port
+                             ::state/received-nonce rcvd-nonce)
+        ;; API/design Q: Does it make sense for me to supply this?
+        ;; I'm responsible for writing to it, which means I should control
+        ;; when it closes...but it feels more than a little silly
+        writer (strm/stream)
+        ;; Q: Does it make sense to share the child-spawing code with
+        ;; the client?
+        ;; A: If not, then update that code to make it sensible.
+        spawner (::state/child-spawner! state)
+        child (spawner writer)
+        client-with-child (assoc active-client
+                                 ::state/child-interaction (assoc child
+                                                                  ::state/reader-consumed (message/add-listener! state child))
+                                 ;; Q: What is this for?
+                                 ;; It doesn't seem to match
+                                 ::state/message-len 0
+                                 ;; Reference implementation stores the client-short<->server-short
+                                 ;; keypair here again.
+                                 ;; But I already did that during a call to configure-shared-secrets
+                                 ::state/client-security (into (::state/client-security state)
+                                                               #:frereth-cp.shared.specs {:public-long client-long-pk
+                                                                                :public-short client-short-pk
+                                                                                :frereth-cp.server/server-short-sk server-short-sk}))
+        child-reader (::state/write->child child)
+        ;; This doesn't actually matter. That field should probably be
+        ;; considered a private black-box member from our perspective.
+        ;; But it seems helpful for keeping which is what straight
+        _ (assert (= writer child-reader))
+        state (state/alter-client-state state client-with-child)
+        ;; And then forward the message to our new(?) child
+        log-state (log2/debug log-state
+                              ::do-handle
+                              "Trying to send child-message from "
+                              {::message-box-keys (keys client-message-box)})
+        sent (strm/try-put! writer
+                            (::K/message client-message-box)
+                            K/send-child-message-timeout
+                            ::timeout)
+        forked-logs (log2/clean-fork log-state ::initiate-forwarded)
+        logger (::log2/logger state)]
+    (dfrd/on-realized sent
+                      (fn [x]
+                        (let [log-state
+                              (if (not= x ::timeout)
+                                (log2/info forked-logs
+                                           ::do-handle
+                                           "Message forwarded to new child"
+                                           {::success x})
+                                (log2/error forked-logs
+                                            ::do-handle
+                                            "Timed out trying to send message"
+                                            {::destination child}))]
+                          (log2/flush-logs! logger log-state)))
+                      (fn [x]
+                        (log2/flush-logs! logger
+                                          (log2/info forked-logs
+                                                     ::do-handle
+                                                     "Forwarding message to new child failed"
+                                                     {::problem x}))))
+    (assoc state ::log2/state log-state)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Public

-(s/fdef handle!
-        :args (s/cat :state ::state/state
-                     :packet ::shared/network-packet))
-(defn handle!
-  [state
+(s/fdef do-handle
+  :args (s/cat :state ::state/state
+               :packet ::shared/network-packet)
+  :ret ::state/state)
+(defn do-handle
+  "Deal with an incoming initiate packet
+
+  Called for side-effects"
+  [{log-state ::log2/state
+    :keys [::log2/logger]
+    :as state}
    {:keys [:host :port]
     message :message
     :as packet}]
-  (log/info "Handling incoming initiate packet: " packet)
-  (let [message (bytes message)]
+  (let [log-state (log2/info log-state
+                             ::handle!
+                             "Handling incoming initiate packet"
+                             packet)
+        message (bytes message)]
     (or
-     (let [n (count message)]
-       (if (>= n (+ K/box-zero-bytes packet-header-length))
-         ;; Note the extra 16 bytes
-         ;; The minimum packet length is actually
-         ;; (+ 544 K/box-zero-bytes)
-         ;; Because the message *has* to have the bytes for 0
-         ;; padding, even if it's 0 length.
-         (let [tmplt (update-in K/initiate-packet-dscr
-                                [::K/vouch-wrapper ::K/length]
-                                +
-                                (- n packet-header-length))
-               initiate (serial/decompose-array tmplt message)
-               client-short-pk (bytes (::K/clnt-short-pk initiate))]
-           (if-not (possibly-re-initiate-existing-client-connection! state initiate)
-             (let [active-client (state/find-client state client-short-pk)]
-               (if-let [cookie (extract-cookie (::state/cookie-cutter state)
-                                               initiate)]
-                 (do
-                   (log/info (str "Succssfully extracted cookie"))
-                   (let [server-short-sk (bytes (::templates/srvr-short-sk cookie))
-                         _ (assert server-short-sk (str "Missing ::templates/srvr-short-sk among "
-                                                        (keys cookie)))
-                         active-client (state/configure-shared-secrets active-client
-                                                                       client-short-pk
-                                                                       server-short-sk)]
-                     (state/alter-client-state! state active-client)
-                     ;; Now we've verified that the Initiate packet came from a
-                     ;; client that has the secret key associated with the short-term
-                     ;; public key.
-                     ;; It included a secret cookie that we generated sometime within the
-                     ;; past couple of minutes.
-                     ;; Now we're ready to tackle handling the main message body cryptobox.
-                     ;; This corresponds to line 373 in the reference implementation.
-                     (try
-                       (when-let [client-message-box (open-client-crypto-box initiate active-client)]
-                         (let [client-long-pk (bytes (::K/long-term-public-key client-message-box))]
-                           (try
-                             (log/info (str "Extracted message box from client's Initiate packet.\n"
-                                            "Keys:\n"
-                                            (keys client-message-box)
-                                            "\nThe long-term public key:\n"
-                                            (do
-                                              ;; This matches both the original log
-                                              ;; message and what we see below when we
-                                              ;; try to extract the inner hidden key
-                                              #_[0x63 0xA4 0x65 0xDE
-                                                 ,,,
-                                                 0x91 0xCC 0xE3 0x02]
-                                              (b-t/->string client-long-pk))))
-                             (if (validate-server-name state client-message-box)
-                               ;; This takes us down to line 381
-                               (when (verify-client-public-key-triad state client-short-pk client-message-box)
-                                 (let [^ByteBuf rcvd-nonce-buffer (::K/outer-i-nonce initiate)
-                                       rcvd-nonce-array (byte-array specs/client-nonce-suffix-length)
-                                       _ (.getBytes rcvd-nonce-buffer 0 rcvd-nonce-array)
-                                       _ (.release rcvd-nonce-buffer)
-                                       rcvd-nonce (b-t/uint64-unpack rcvd-nonce-array)
-                                       active-client (assoc active-client
-                                                            ;; Seems very likely that I should convert this
-                                                            ;; to a byte-array
-                                                            ::client-extension (::K/clnt-xtn initiate)
-                                                            ::client-ip host
-                                                            ::client-port port
-                                                            ::state/received-nonce rcvd-nonce)
-                                       ;; API/design Q: Does it make sense for me to supply this?
-                                       ;; I'm responsible for writing to it, which means I should control
-                                       ;; when it closes...but it feels more than a little silly
-                                       writer (strm/stream)
-                                       spawner (::state/child-spawner! state)
-                                       child (spawner writer)
-                                       client-with-child (assoc active-client
-                                                                ::state/child-interaction (assoc child
-                                                                                ::state/reader-consumed (message/add-listener! state child))
-                                                                ;; Q: What is this for?
-                                                                ;; It doesn't seem to match
-                                                                ::state/message-len 0
-                                                                ;; Reference implementation stores the client-short<->server-short
-                                                                ;; keypair here again.
-                                                                ;; But I already did that during a call to configure-shared-secrets
-                                                                ::state/client-security (into (::state/client-security state)
-                                                                                #:frereth-cp.shared.specs {:public-long client-long-pk
-                                                                                :public-short client-short-pk
-                                                                                :frereth-cp.server/server-short-sk server-short-sk}))
-                                       child-reader (::state/write->child child)]
-                                   ;; This doesn't actually matter. That field should probably be
-                                   ;; considered a private black-box member from our perspective.
-                                   ;; But it seems helpful for keeping which is what straight
-                                   (assert (= writer child-reader))
-                                   (state/alter-client-state! state client-with-child)
-
-                                   ;; And then forward the message to our new(?) child
-                                   (log/debug (str "Trying to send child-message from "
-                                                   (keys client-message-box)))
-                                   (let [sent (strm/try-put! writer
-                                                             (::K/message client-message-box)
-                                                             K/send-child-message-timeout
-                                                             ::timeout)]
-                                     (dfrd/on-realized sent
-                                                       (fn [x]
-                                                         (if (not= x ::timeout)
-                                                           (log/info "Message forwarded to new child: " x)
-                                                           (log/error "Timed out trying to send message to" child)))
-                                                       (fn [x] (log/info "Forwarding message to new child failed: " x))))
-                                   ;; Q: Will there ever be an opportunity for calling this in
-                                   ;; a purely functional manner?
-                                   ;; Surely there's more to this than just the side-effects
-                                   nil)))
-                             (catch ExceptionInfo ex
-                               (log/error ex "Failure after decrypting inner client cryptobox")))))
-                       (catch ExceptionInfo ex
-                         (log/error ex "Initiate packet looked good enough to establish client session, but failed later")))))
-                 (log/error "FIXME: Debug only: cookie extraction failed")))
-             (log/warn "TODO: Handle additional Initiate packet from " client-short-pk)))
-         (log/warn (str "Truncated initiate packet. Only received " n " bytes"))))
+     (let [n (count message)
+           state-delta (if (>= n (+ K/box-zero-bytes packet-header-length))
+                         ;; Note the extra 16 bytes
+                         ;; The minimum packet length is actually
+                         ;; (+ 544 K/box-zero-bytes)
+                         ;; Because the message *has* to have the bytes for 0
+                         ;; padding, even if it's 0 length.
+                         (let [tmplt (update-in K/initiate-packet-dscr
+                                                [::K/vouch-wrapper ::K/length]
+                                                +
+                                                (- n packet-header-length))
+                               initiate (serial/decompose-array tmplt message)
+                               client-short-pk (bytes (::K/clnt-short-pk initiate))]
+                           (if-not (possibly-re-initiate-existing-client-connection! state initiate)
+                             (let [active-client (state/find-client state client-short-pk)]
+                               (if-let [cookie (extract-cookie (::state/cookie-cutter state)
+                                                               initiate)]
+                                 (let [log-state (log2/info log-state
+                                                            ::handle!
+                                                            "Succssfully extracted cookie")
+                                       server-short-sk (bytes (::templates/srvr-short-sk cookie))
+                                       _ (assert server-short-sk (str "Missing ::templates/srvr-short-sk among "
+                                                                      (keys cookie)))
+                                       active-client (state/configure-shared-secrets active-client
+                                                                                client-short-pk
+                                                                                server-short-sk)
+                                       state (state/alter-client-state state active-client)]
+
+                                   ;; Now we've verified that the Initiate packet came from a
+                                   ;; client that has the secret key associated with the short-term
+                                   ;; public key.
+                                   ;; It included a secret cookie that we generated sometime within the
+                                   ;; past couple of minutes.
+                                   ;; Now we're ready to tackle handling the main message body cryptobox.
+                                   ;; This corresponds to line 373 in the reference implementation.
+                                   (try
+                                     (let [{log-state ::log2/state
+                                            client-message-box ::K/initiate-client-vouch-wrapper} (open-client-crypto-box log-state
+                                                                                initiate
+                                                                                active-client)]
+                                       (if client-message-box
+                                         (let [client-long-pk (bytes (::K/long-term-public-key client-message-box))
+                                               log-state (log2/info log-state
+                                                                    "Extracted message box from client's Initiate packet"
+                                                                    ;; This matches both the original log
+                                                                    ;; message and what we see below when we
+                                                                    ;; try to extract the inner hidden key
+                                                                    {::message-box-keys (keys client-message-box)
+                                                                     ::client-public-long-key (b-t/->string client-long-pk)})]
+                                           (try
+                                             (if (validate-server-name state client-message-box)
+                                               ;; This takes us down to line 381
+                                               (if (verify-client-public-key-triad state client-short-pk client-message-box)
+                                                 ;; Happy path involves updating more than just the log state
+                                                 ;; But not the full thing.
+                                                 ;; TODO: Limit this to what's actually needed
+                                                 (do-fork-child state
+                                                                active-client
+                                                                client-long-pk
+                                                                client-short-pk
+                                                                server-short-sk
+                                                                host
+                                                                port
+                                                                initiate
+                                                                client-message-box)
+                                                 {::log2/state (log2/warn log-state
+                                                                          ::do-handle
+                                                                          "Mismatched public keys"
+                                                                          {::FIXME "Show the extracted versions"
+                                                                           ::state/state state
+                                                                           ::client-short-pk client-short-pk
+                                                                           ::shared/message client-message-box})}))
+                                             (catch ExceptionInfo ex
+                                               {::log2/state (log2/exception log-state
+                                                                             ex
+                                                                             ::do-handle
+                                                                             "Failure after decrypting inner client cryptobox")})))
+                                         (assoc state ::log/state log-state)))
+                                     (catch ExceptionInfo ex
+                                       {::log2/state (log2/exception log-state
+                                                                     ex
+                                                                     ::do-handle
+                                                                     "Initiate packet looked good enough to establish client session, but failed later")})))
+                                 {::log2/state (log2/error log-state
+                                                           ::do-handle
+                                                           "FIXME: Debug only: cookie extraction failed")}))
+                             {::log2/state (log2/warn log-state
+                                                      ::do-handle
+                                                      "TODO: Handle additional Initiate packets from " client-short-pk)}))
+                         {::log2/state (log2/warn log-state
+                                                  ::do-handle
+                                                  (str "Truncated initiate packet. Only received " n " bytes"))})]
+       (into state state-delta))
      ;; If nothing's changing, just maintain status quo
      state)))


Fixing missing zookeeper client.

Fixing missing zookeeper client.

--- src/com/okl/tokenmgr/zookeeper_storage.clj
+++ src/com/okl/tokenmgr/zookeeper_storage.clj
@@ -21,7 +21,7 @@

 ;; function for setting the data in zookeeper
 (defn- zk-set [path value]
-  (let [client ()
+  (let [client (get-client)
         version (:version (zk/exists client path))
         data (if value
                (.getBytes value "UTF-8")


Bump up report format in exporter

Bump up report format in exporter

--- src/com/puppetlabs/puppetdb/cli/export.clj
+++ src/com/puppetlabs/puppetdb/cli/export.clj
@@ -101,7 +101,7 @@
     ;;  version of the `catalog` endpoint... or even to query what the latest
     ;;  version of a command is.  We should improve that.
     {:replace-catalog 2
-     :store-report 1}})
+     :store-report 2}})

 (defn get-catalog-for-node
   "Utility function for retrieving catalog data from the PuppetDB web service.


Kinda fix the test

Kinda fix the test

--- test/icecap/rest_test.clj
+++ test/icecap/rest_test.clj
@@ -1,5 +1,6 @@
 (ns icecap.rest-test
-  (:require [icecap.rest :refer :all]
+  (:require [manifold.deferred :refer [let-flow]]
+            [icecap.rest :refer :all]
             [clojure.test :refer :all]
             [icecap.crypto :as crypto]
             [icecap.rest :as rest]
@@ -28,9 +29,7 @@
                res (handler req)]
               (is (= (:status res) 201))))
   (testing "creating cap with bogus plan results in useful errors"
-    (is (let [response (handler (create-cap-req {:type :bogus}))
-              response (update response :body edn/read-string)]
-          (= response
-             {:status 400
-              :headers {"Content-Type" "application/edn"}
-              :message "Test"})))))
+    (let-flow [req (create-cap-req {:type :bogus})
+               {status :status headers :headers} (handler req)]
+              (is (= status 400))
+              (is (= headers {})))))


www/server.clj: added from v4

www/server.clj: added from v4

--- src/org/altlaw/www/server.clj
+++ src/org/altlaw/www/server.clj
@@ -1,10 +1,10 @@
 (ns org.altlaw.www.server
   (:gen-class)
   (:require [org.altlaw.util.context :as context]
-            [org.altlaw.rest.component :as component]
+            [org.altlaw.util.restlet :as component]
             org.altlaw.www.application
-            org.altlaw.rest.status_service_dev
-            org.altlaw.rest.status_service_public))
+            org.altlaw.util.restlet.status_service_dev
+            org.altlaw.www.status_service_public))

 (defn setup-logging [component]
   (let [service (.getLogService component)]
@@ -14,8 +14,8 @@
   (let [app (new org.altlaw.www.application)
         port (if (= (context/altlaw-env) "production") 80 8080)]
     (if (= (context/altlaw-env) "production")
-      (.setStatusService app (new org.altlaw.rest.status_service_public))
-      (.setStatusService app (new org.altlaw.rest.status_service_dev)))
+      (.setStatusService app (new org.altlaw.www.status_service_public))
+      (.setStatusService app (new org.altlaw.util.restlet.status_service_dev)))
     (println "Starting www server at port" port "in"
              (context/altlaw-env) "environment.")
     (let [component (component/make-component port app)]


only print filesize if we have it

only print filesize if we have it

--- src/overtone/helpers/file.clj
+++ src/overtone/helpers/file.clj
@@ -375,9 +375,10 @@

 (defn- print-download-file
   [url]
-  (let [size   (remote-file-size url)
-        p-size (pretty-file-size size)]
-    (print-if-verbose (str "Downloading file (" p-size ") - "  url))))
+  (let [size     (remote-file-size url)
+        p-size   (pretty-file-size size)
+        size-str (if (<= size 0) "" (str "(" p-size ")"))]
+    (print-if-verbose (str "Downloading file " size-str " - "  url))))

 (defn download-file
   "Downloads the file pointed to by url to local path. If no timeout


delete db-file as part of test db setup process.

--- test/metabase/test_utils.clj
+++ test/metabase/test_utils.clj
@@ -1,5 +1,6 @@
 (ns metabase.test-utils
-  (:require [clojure.tools.logging :as log]
+  (:require [clojure.java.io :as io]
+            [clojure.tools.logging :as log]
             [metabase.db :refer :all]
             [expectations :refer :all]))

@@ -8,6 +9,7 @@
   "setup database schema"
   {:expectations-options :before-run}
   []
+  (io/delete-file db-file)
   ; TODO - lets just completely delete the db before each test to ensure we start fresh
   (log/info "tearing down database and resetting to empty schema")
   (migrate :down)


Fix index-related tests

Fix index-related tests

--- test/clojure/clojurewerkz/cassaforte/cql_test.clj
+++ test/clojure/clojurewerkz/cassaforte/cql_test.clj
@@ -162,28 +162,41 @@
       (is (= 50000005000500 (-> s
                                 (select :user_counters)
                                 first
-                                :user_count))))))
-
-;; (deftest test-counter-2
-;;   (dotimes [i 100]
-;;     (update s :user_counters {:user_count [+ 1]} (where {:name "user1"})))
-;;   (is (= 100 (:user_count (first (select s :user_counters))))))
-
-;; (deftest test-index-filtering-range
-;;   (create-index s :users :city)
-;;   (create-index s :users :age)
-;;   (dotimes [i 10]
-;;     (insert s :users {:name (str "name_" i) :city "Munich" :age (int i)}))
-
-;;   (let [res (select s :users
-;;                     (where [[= :city "Munich"]
-;;                             [> :age (int 5)]])
-;;                     (allow-filtering true))]
-;;     (is (= (set (range 6 10))
-;;            (->> res
-;;                 (map :age)
-;;                 set))))
-;;   (truncate s :users))
+                                :user_count)))))
+
+  (deftest test-counter-2
+    (dotimes [i 100]
+      (update s :user_counters
+              {:user_count (new-query-api/increment)}
+              (where {:name "user1"})))
+    (is (= 100 (-> (select s :user_counters)
+                   first
+                   :user_count))))
+
+  (deftest test-index-filtering-range
+    (create-index s :city
+                  (new-query-api/on-table :users)
+                  (new-query-api/and-column :city)
+                  )
+    (create-index s :age
+                  (new-query-api/on-table :users)
+                  (new-query-api/and-column :age))
+
+    (dotimes [i 10]
+      (insert s :users {:name (str "name_" i)
+                        :city "Munich"
+                        :age  (int i)}))
+
+    (let [res (select s :users
+                      (where [[= :city "Munich"]
+                              [> :age (int 5)]])
+                      (allow-filtering))]
+      (is (= (set (range 6 10))
+             (->> res
+                  (map :age)
+                  set))))
+    ;; (truncate s :users)
+    ))

 ;; (deftest test-index-filtering-range-alt-syntax
 ;;   (create-index s :users :city)


Use sets for branch nodes on tests

Use sets for branch nodes on tests

--- test/com/wsscode/pathom/connect/planner_test.cljc
+++ test/com/wsscode/pathom/connect/planner_test.cljc
@@ -59,6 +59,7 @@
                                                      :style "filled"
                                                      :color (if (= node-id root) "blue" "#F3F3F3")
                                                      :label (str
+                                                              #_
                                                               (if attrs
                                                                 (str (str/join "," attrs) " | "))
                                                               (or
@@ -79,7 +80,6 @@
                                               (assoc
                                                 :fillcolor "cyan"))))})]
          (io/copy (tangle/dot->svg dot) (io/file (or file-name "out.svg")))
-         #_
          (io/copy (tangle/dot->image dot "png") (io/file (or file-name "out.png"))))))
   graph)

@@ -382,7 +382,7 @@
                                          ::pcp/after-nodes      #{3}}
                                       3 {::pcp/node-id  3
                                          ::pcp/requires {:b {} :a {} :c {}}
-                                         ::pcp/run-and  [2 1]}}
+                                         ::pcp/run-and  #{2 1}}}
              ::pcp/index-syms        {a #{1} b #{2}}
              ::pcp/unreachable-syms  #{}
              ::pcp/unreachable-attrs #{}
@@ -408,7 +408,7 @@
                                          ::pcp/after-nodes #{3}}
                                       3 {::pcp/node-id          3
                                          ::pcp/requires         {:a {}}
-                                         ::pcp/run-or           [1 2]
+                                         ::pcp/run-or           #{1 2}
                                          ::pcp/source-for-attrs #{:a}}}
              ::pcp/index-syms        {a #{1} a2 #{2}}
              ::pcp/unreachable-syms  #{}
@@ -437,7 +437,7 @@
                                          ::pcp/after-nodes      #{3}}
                                       3 {::pcp/node-id  3
                                          ::pcp/requires {:b {} :a {}}
-                                         ::pcp/run-and  [2 1]}}
+                                         ::pcp/run-and  #{2 1}}}
              ::pcp/index-syms        {a #{1} b #{2}}
              ::pcp/unreachable-syms  #{}
              ::pcp/unreachable-attrs #{}
@@ -466,7 +466,7 @@
                                          ::pcp/after-nodes      #{3}}
                                       3 {::pcp/node-id  3
                                          ::pcp/requires {:b {} :a {} :c {}}
-                                         ::pcp/run-and  [2 1 4]}
+                                         ::pcp/run-and  #{2 1 4}}
                                       4 {::pc/sym               c
                                          ::pcp/node-id          4
                                          ::pcp/requires         {:c {}}
@@ -514,7 +514,7 @@
                                          ::pcp/after-nodes      #{5}}
                                       5 {::pcp/node-id  5
                                          ::pcp/requires {:b {} :e {} :d {}}
-                                         ::pcp/run-and  [4 3 6]
+                                         ::pcp/run-and  #{4 3 6}
                                          ::pcp/run-next 1}
                                       6 {::pc/sym               d
                                          ::pcp/node-id          6
@@ -561,7 +561,7 @@
                                          ::pcp/after-nodes      #{4 6}}
                                       4 {::pcp/node-id     4
                                          ::pcp/requires    {:b {} :c {}}
-                                         ::pcp/run-and     [3 2]
+                                         ::pcp/run-and     #{3 2}
                                          ::pcp/run-next    1
                                          ::pcp/after-nodes #{7}}
                                       5 {::pc/sym               d
@@ -572,12 +572,12 @@
                                          ::pcp/source-for-attrs #{:d}}
                                       6 {::pcp/node-id     6
                                          ::pcp/requires    {:b {} :c {}}
-                                         ::pcp/run-and     [3 2]
+                                         ::pcp/run-and     #{3 2}
                                          ::pcp/run-next    5
                                          ::pcp/after-nodes #{7}}
                                       7 {::pcp/node-id  7
                                          ::pcp/requires {:b {} :c {}}
-                                         ::pcp/run-and  [6 4]}}
+                                         ::pcp/run-and  #{6 4}}}
              ::pcp/index-syms        {a #{1} c #{2} b #{3} d #{5}}
              ::pcp/unreachable-syms  #{}
              ::pcp/unreachable-attrs #{}
@@ -620,7 +620,7 @@
                                          ::pcp/after-nodes      #{7 4}}
                                       4 {::pcp/node-id     4
                                          ::pcp/requires    {:b {} :c {}}
-                                         ::pcp/run-and     [3 2]
+                                         ::pcp/run-and     #{3 2}
                                          ::pcp/run-next    1
                                          ::pcp/after-nodes #{8}}
                                       5 {::pc/sym               d
@@ -637,12 +637,12 @@
                                          ::pcp/after-nodes      #{7}}
                                       7 {::pcp/node-id     7
                                          ::pcp/requires    {:b {} :e {}}
-                                         ::pcp/run-and     [3 6]
+                                         ::pcp/run-and     #{3 6}
                                          ::pcp/run-next    5
                                          ::pcp/after-nodes #{8}}
                                       8 {::pcp/node-id  8
                                          ::pcp/requires {:b {} :e {} :c {}}
-                                         ::pcp/run-and  [7 4]}}
+                                         ::pcp/run-and  #{7 4}}}
              ::pcp/index-syms        {a #{1} c #{2} b #{3} d #{5} e #{6}}
              ::pcp/unreachable-syms  #{}
              ::pcp/unreachable-attrs #{}
@@ -782,7 +782,7 @@
                                          ::pcp/after-nodes      #{4}}
                                       4 {::pcp/node-id          4
                                          ::pcp/requires         {:a {}}
-                                         ::pcp/run-or           [3 1]
+                                         ::pcp/run-or           #{3 1}
                                          ::pcp/source-for-attrs #{:a}}}
              ::pcp/index-syms        {a #{1} a2 #{2} b #{3}}
              ::pcp/unreachable-syms  #{}
@@ -908,7 +908,7 @@
                                          ::pcp/after-nodes #{4}}
                                       4 {::pcp/node-id          4
                                          ::pcp/requires         {:a {}}
-                                         ::pcp/run-or           [2 3]
+                                         ::pcp/run-or           #{2 3}
                                          ::pcp/run-next         1
                                          ::pcp/source-for-attrs #{:a}}}
              ::pcp/index-syms        {b #{1} a #{2} a2 #{3}}
@@ -940,7 +940,7 @@
                                          ::pcp/after-nodes #{3}}
                                       3 {::pcp/node-id          3
                                          ::pcp/requires         {:b {}}
-                                         ::pcp/run-or           [1 2]
+                                         ::pcp/run-or           #{1 2}
                                          ::pcp/after-nodes      #{4}
                                          ::pcp/source-for-attrs #{:b}}
                                       4 {::pc/sym               a
@@ -985,7 +985,7 @@
                                          ::pcp/after-nodes      #{4}}
                                       4 {::pcp/node-id  4
                                          ::pcp/requires {:a {} :b {}}
-                                         ::pcp/run-and  [3 2]
+                                         ::pcp/run-and  #{3 2}
                                          ::pcp/run-next 1}}
              ::pcp/index-syms        {c #{1} b #{2} a #{3}}
              ::pcp/unreachable-syms  #{}
@@ -1058,12 +1058,12 @@
                                          ::pcp/after-nodes #{5}}
                                       5 {::pcp/node-id          5
                                          ::pcp/requires         {:a {}}
-                                         ::pcp/run-or           [3 4]
+                                         ::pcp/run-or           #{3 4}
                                          ::pcp/source-for-attrs #{:a}
                                          ::pcp/after-nodes      #{6}}
                                       6 {::pcp/node-id  6
                                          ::pcp/requires {:a {} :b {}}
-                                         ::pcp/run-and  [5 2]
+                                         ::pcp/run-and  #{5 2}
                                          ::pcp/run-next 1}}
              ::pcp/index-syms        {c #{1} b #{2} a #{3} a1 #{4}}
              ::pcp/unreachable-syms  #{}
@@ -1115,13 +1115,13 @@
                                          ::pcp/after-nodes #{6}}
                                       6 {::pcp/node-id          6
                                          ::pcp/requires         {:d {}}
-                                         ::pcp/run-or           [4 5]
+                                         ::pcp/run-or           #{4 5}
                                          ::pcp/run-next         3
                                          ::pcp/source-for-attrs #{:d}
                                          ::pcp/after-nodes      #{7}}
                                       7 {::pcp/node-id  7
                                          ::pcp/requires {:d {} :c {}}
-                                         ::pcp/run-and  [6 2]}}
+                                         ::pcp/run-and  #{6 2}}}
              ::pcp/index-syms        {a #{1} cd #{4 2} b #{3} d #{5}}
              ::pcp/unreachable-syms  #{}
              ::pcp/unreachable-attrs #{}
@@ -1161,7 +1161,7 @@
                                          ::pcp/source-for-attrs #{:b}}
                                       5 {::pcp/node-id     5
                                          ::pcp/requires    {:c {} :b {}}
-                                         ::pcp/run-and     [2 4]
+                                         ::pcp/run-and     #{2 4}
                                          ::pcp/after-nodes #{3}
                                          ::pcp/run-next    1}}
              ::pcp/index-syms        {d #{1} c #{2} a #{3} b #{4}}
@@ -1220,7 +1220,7 @@
                                          ::pcp/source-for-attrs #{:b}}
                                       6 {::pcp/node-id     6
                                          ::pcp/requires    {:c {} :b {}}
-                                         ::pcp/run-and     [2 5]
+                                         ::pcp/run-and     #{2 5}
                                          ::pcp/after-nodes #{3}
                                          ::pcp/run-next    1}}
              ::pcp/index-syms        {d #{1} c #{2} a #{3} z #{4} b #{5}}
@@ -1270,7 +1270,7 @@
                                          ::pcp/run-next         3}
                                       5 {::pcp/node-id     5
                                          ::pcp/requires    {:release/script {} :label/type {}}
-                                         ::pcp/run-and     [1 4]
+                                         ::pcp/run-and     #{1 4}
                                          ::pcp/after-nodes #{2}}}
              ::pcp/index-syms        {release-script #{1}
                                       id             #{2}
@@ -1767,7 +1767,7 @@
                                          ::pcp/after-nodes      #{4}}
                                       4 {::pcp/node-id  4
                                          ::pcp/requires {:l1 {} :d2 {}}
-                                         ::pcp/run-and  [3 2]
+                                         ::pcp/run-and  #{3 2}
                                          ::pcp/run-next 1}}
              ::pcp/index-syms        {dyn #{1 2} l1 #{3}}
              ::pcp/unreachable-syms  #{}
@@ -1936,7 +1936,7 @@
                             ::pc/sym          'a2
                             ::pcp/requires    {:a {}}}
                          3 {::pcp/node-id  3
-                            ::pcp/run-or   [1 2]
+                            ::pcp/run-or   #{1 2}
                             ::pcp/requires {:a {}}}}}))

     (testing "with run-next"
@@ -1966,7 +1966,7 @@
                                ::pcp/after-nodes #{4}}
                             4 {::pcp/node-id  4
                                ::pcp/requires {:a {}}
-                               ::pcp/run-or   [2 3]
+                               ::pcp/run-or   #{2 3}
                                ::pcp/run-next 1}}}))

       (testing "don't optimize when run next is different"
@@ -1995,7 +1995,7 @@
                                 ::pcp/requires    {:a {}}
                                 ::pcp/run-next    10}
                              4 {::pcp/node-id  4
-                                ::pcp/run-or   [2 3]
+                                ::pcp/run-or   #{2 3}
                                 ::pcp/requires {:a {}}}}})))))

   (testing "add to the runner"
@@ -2008,7 +2008,7 @@
                               ::pc/sym       'a2
                               ::pcp/requires {:a {}}}
                            3 {::pcp/node-id  3
-                              ::pcp/run-or   [1 2]
+                              ::pcp/run-or   #{1 2}
                               ::pcp/requires {:a {}}}
                            4 {::pcp/node-id  4
                               ::pc/sym       'a3
@@ -2023,7 +2023,7 @@
                             ::pc/sym       'a2
                             ::pcp/requires {:a {}}}
                          3 {::pcp/node-id  3
-                            ::pcp/run-or   [1 2 4]
+                            ::pcp/run-or   #{1 2 4}
                             ::pcp/requires {:a {}}}
                          4 {::pcp/node-id     4
                             ::pcp/after-nodes #{3}
@@ -2042,7 +2042,7 @@
                                      ::pc/sym       'a2
                                      ::pcp/requires {:a {}}}
                                   3 {::pcp/node-id  3
-                                     ::pcp/run-or   [1 2]
+                                     ::pcp/run-or   #{1 2}
                                      ::pcp/requires {:a {}}}
                                   4 {::pcp/node-id  4
                                      ::pc/sym       'a
@@ -2062,7 +2062,7 @@
                                   ::pcp/requires                  {:a {}}}
                                  3
                                  {::pcp/node-id  3
-                                  ::pcp/run-or   [1 2]
+                                  ::pcp/run-or   #{1 2}
                                   ::pcp/requires {:a {}}}}})))

     (testing "with run context"
@@ -2075,7 +2075,7 @@
                                 ::pc/sym       'a2
                                 ::pcp/requires {:a {}}}
                              3 {::pcp/node-id  3
-                                ::pcp/run-or   [1 2]
+                                ::pcp/run-or   #{1 2}
                                 ::pcp/requires {:a {}}
                                 ::pcp/run-next 10}
                              4 {::pcp/node-id  4
@@ -2093,7 +2093,7 @@
                               ::pc/sym       'a2
                               ::pcp/requires {:a {}}}
                            3 {::pcp/node-id  3
-                              ::pcp/run-or   [1 2 4]
+                              ::pcp/run-or   #{1 2 4}
                               ::pcp/requires {:a {}}
                               ::pcp/run-next 10}
                            4 {::pcp/node-id     4
@@ -2123,21 +2123,12 @@
                           5 {::pcp/after-nodes #{3}}
                           6 {::pcp/after-nodes #{5 4}}}}
            6)
-         [6 4 5 1 2 3]))
-
-  (is (= (pcp/node-ancestors
-           '{::pcp/nodes {1 {}
-                          2 {::pcp/after-nodes #{3 5}}
-                          3 {}
-                          4 {::pcp/after-nodes #{3 5}}
-                          5 {::pcp/after-nodes #{3}}}}
-           6)
          [6 4 5 1 2 3])))

 (deftest test-common-ancestor
   (is (= (pcp/first-common-ancestor
            '{::pcp/nodes {1 {::pcp/node-id 1
-                             ::pcp/run-and [2 3]}
+                             ::pcp/run-and #{2 3}}
                           2 {::pcp/after-nodes #{1}}
                           3 {::pcp/after-nodes #{1}}}}
            [2 3])
@@ -2145,7 +2136,7 @@

   (is (= (pcp/first-common-ancestor
            '{::pcp/nodes {1 {::pcp/node-id 1
-                             ::pcp/run-and [2 3]}
+                             ::pcp/run-and #{2 3}}
                           2 {::pcp/after-nodes #{1 4}}
                           3 {::pcp/after-nodes #{1}}
                           4 {}}}


fix ITs

fix ITs

--- test/shuppet/integration.clj
+++ test/shuppet/integration.clj
@@ -31,11 +31,11 @@

 (lazy-fact-group :integration
    (fact "Ping resource returns 200 HTTP response"
-         (let [response (http-get "/ping")]
+         (let [response (client/get (url+ "/ping") {:throw-exceptions false})]
            response => (contains {:status 200})))

    (fact "Status returns all required elements"
-         (let [response (http-get "/status")
+         (let [response (client/get (url+ "/status") {:throw-exceptions false})
                body (read-body response)]
            response => (contains {:status 200})))


Add the style to the harness

Add the style to the harness

--- test/wireframes/examples.clj
+++ test/wireframes/examples.clj
@@ -23,7 +23,7 @@
                        draw-fn filename size style color] :as opts}]
   (let [dir (str "doc/gallery/" (name style) "/")]
     (.mkdir (clojure.java.io/file dir))
-    (println filename)
+    (println style filename)
     (time
       (is
         (b/write-png


First pass fixing tests for Issue #194.

First pass fixing tests for Issue #194.

--- test/zprint/zprint_test.cljc
+++ test/zprint/zprint_test.cljc
@@ -39,6 +39,15 @@
   {:configured? true, :force-eol-blanks? false, :test-for-eol-blanks? true})

 (defexpect zprint-tests
+
+  ;;
+  ;; Trim exceptions
+  ;;
+
+  (defn clean-exception
+    "Clean out specific information from end of exceptions."
+    [s]
+    (clojure.string/replace s #"because:.*" "because:"))

   ;;
   ;; # Pretty Tests
@@ -2613,12 +2622,12 @@

   #?(:clj
        (expect
-         "java.lang.Exception:  When :list called an option-fn named 'test' it failed because: java.lang.ClassCastException: clojure.lang.Keyword cannot be cast to java.lang.Number"
+         "java.lang.Exception:  When :list called an option-fn named 'test' it failed because:"
          (try (zprint "(a b c)"
                       {:parse-string? true,
                        :list {:option-fn (fn ([] "test")
                                              ([options len sexpr] (+ :a 0)))}})
-              (catch Exception e (str e))))
+              (catch Exception e (clean-exception (str e)))))
      :cljs
        (expect
          "Error:  When :list called an option-fn named 'test' it failed because: Error: 0 is not ISeqable"
@@ -2630,11 +2639,11 @@

   #?(:clj
        (expect
-         "java.lang.Exception:  When :list called an option-fn it failed because: java.lang.ClassCastException: clojure.lang.Keyword cannot be cast to java.lang.Number"
+         "java.lang.Exception:  When :list called an option-fn it failed because:"
          (try (zprint "(a b c)"
                       {:parse-string? true,
                        :list {:option-fn (fn ([options len sexpr] (+ :a 0)))}})
-              (catch Exception e (str e))))
+              (catch Exception e (clean-exception (str e)))))
      :cljs
        (expect
          "Error:  When :list called an option-fn it failed because: Error: 0 is not ISeqable"
@@ -2645,12 +2654,12 @@

   #?(:clj
        (expect
-         "java.lang.Exception: When :vector called an option-fn-first with ':a' failed because: java.lang.ClassCastException: clojure.lang.Keyword cannot be cast to java.lang.Number"
+         "java.lang.Exception: When :vector called an option-fn-first with ':a' failed because:"
          (try (zprint "[:a :b :c]"
                       {:parse-string? true,
                        :vector {:option-fn-first (fn ([options sexpr]
                                                       (+ :a 0)))}})
-              (catch Exception e (str e))))
+              (catch Exception e (clean-exception (str e)))))
      :cljs
        (expect
          "Error: When :vector called an option-fn-first with ':a' failed because: Error: 0 is not ISeqable"
@@ -2662,12 +2671,12 @@

   #?(:clj
        (expect
-         "java.lang.Exception: When :vector called an option-fn-first named 'test' with ':a' failed because: java.lang.ClassCastException: clojure.lang.Keyword cannot be cast to java.lang.Number"
+         "java.lang.Exception: When :vector called an option-fn-first named 'test' with ':a' failed because:"
          (try (zprint "[:a :b :c]"
                       {:parse-string? true,
                        :vector {:option-fn-first
                                   (fn ([] "test") ([options sexpr] (+ :a 0)))}})
-              (catch Exception e (str e))))
+              (catch Exception e (clean-exception (str e)))))
      :cljs
        (expect
          "Error: When :vector called an option-fn-first named 'test' with ':a' failed because: Error: 0 is not ISeqable"


Trying to make CI happy, thought UTF-8 and UTF-16 make OSX sad.

--- modules/messaging/src/main/clojure/immutant/messaging/codecs.clj
+++ modules/messaging/src/main/clojure/immutant/messaging/codecs.clj
@@ -69,10 +69,10 @@
   (with-open [baos (java.io.ByteArrayOutputStream.)
               oos (java.io.ObjectOutputStream. baos)]
     (.writeObject oos object)
-    (.toString baos)))
+    (.toString baos "ISO-8859-1")))

 (defn deserialize [s]
-  (with-open [bais (java.io.ByteArrayInputStream. (.getBytes s))
+  (with-open [bais (java.io.ByteArrayInputStream. (.getBytes s "ISO-8859-1"))
               ois (java.io.ObjectInputStream. bais)]
     (.readObject ois)))


Show appropriate textarea placeholder

Show appropriate textarea placeholder

--- src/braid/client/mobile/views.cljs
+++ src/braid/client/mobile/views.cljs
@@ -12,15 +12,15 @@
             [retouch.core :refer [drawer-view swipe-view]])
   (:import [goog.events KeyCodes]))

-(defn new-message-view [thread-id]
+(defn new-message-view [config]
   (let [message (r/atom "")
         group-id (subscribe [:open-group-id])]
-    (fn [thread-id]
+    (fn [config]
       [:div.new.message
-       [upload-button-view {:thread-id thread-id
+       [upload-button-view {:thread-id (config :thread-id)
                             :group-id @group-id}]
        [:textarea {:value @message
-                   :placeholder "Reply..."
+                   :placeholder (config :placeholder)
                    :on-change
                    (fn [e]
                      (reset! message (.. e -target -value)))
@@ -30,7 +30,7 @@
                        KeyCodes.ENTER
                        (do
                          (dispatch [:new-message {:group-id @group-id
-                                                  :thread-id thread-id
+                                                  :thread-id (config :thread-id)
                                                   :content @message}])

                          (reset! message ""))
@@ -48,7 +48,11 @@
                                     (dispatch [:hide-thread {:thread-id (thread :id)}]))}])]]

        [messages-view thread]
-       [new-message-view (thread :id)]])))
+       [new-message-view {:thread-id (thread :id)
+                          :placeholder (if (thread :new?)
+                                         "Start a conversation..."
+                                         "Reply...")
+                          }]])))

 (defn header-view []
   (let [group-id (subscribe [:open-group-id])]


refine entity api responses

refine entity api responses

--- src/clj/clj_money/api/entities.clj
+++ src/clj/clj_money/api/entities.clj
@@ -4,6 +4,7 @@
             [ring.util.response :refer [status response header]]
             [cemerick.friend :refer [current-authentication]]
             [environ.core :refer [env]]
+            [cheshire.core :as json]
             [clj-money.validation :as validation]
             [clj-money.authorization :refer [authorize]]
             [clj-money.models.entities :as entities]
@@ -20,11 +21,16 @@
     (try
       (let [result (entities/update (env :db) updated)]
         (if (validation/has-error? result)
-          (-> (validation/error-messages result)
-              response))
-        (-> []
-            (response result)
-            (status 200)))
+          (-> {:message (validation/error-messages result)}
+              json/generate-string
+              response
+              (header "Content-Type" "application/json")
+              (status 422))
+          (-> result
+              json/generate-string
+              response
+              (header "Content-Type" "application/json")
+              (status 200))))
       (catch Exception e
         (->  (if (env :show-error-messages?)
                (.getMessage e)


full stack in dfs

full stack in dfs

--- src/clj/morpheus/traversal/dfs.clj
+++ src/clj/morpheus/traversal/dfs.clj
@@ -27,7 +27,7 @@

 (defn proc-forward-msg [task-id data]
   (let [[vertex-id stack] data
-        {:keys [filters max-deepth stop-cond with-edges?]} (compute/get-task task-id)
+        {:keys [filters max-deepth stop-cond with-edges? full-stack?]} (compute/get-task task-id)
         vertex (vertex/get-veterx-by-id vertex-id)
         vertex-criteria (get-in filters [:criteria :vertex])
         vertex-vailed (if vertex-criteria (AST/eval-with-data vertex vertex-criteria) true)
@@ -50,9 +50,10 @@
         next-depth (inc deepth)
         stack-verteics (set (map first stack))
         neighbour-oppisites (->> (map (fn [edge]
-                                        (let [opptsite-id (eb/get-oppisite edge vertex-id)]
-                                          (when (and opptsite-id (not (stack-verteics opptsite-id)))
-                                            [opptsite-id 0 next-depth vertex-id (when with-edges? edge)])))
+                                        (let [opptsite-id (eb/get-oppisite edge vertex-id)
+                                              exists? (stack-verteics opptsite-id)]
+                                          (when (and opptsite-id (or (not exists?) (and exists? full-stack?)))
+                                            [opptsite-id (if exists? 1 0) next-depth vertex-id (when with-edges? edge)])))
                                       neighbours)
                                  (filter identity))
         final-stack (if-not (> deepth (or max-deepth Long/MAX_VALUE))
@@ -71,7 +72,7 @@

-(defn dfs [vertex & {:keys [filters max-deepth timeout stop-cond with-edges? with-vertices?] :as extra-params
+(defn dfs [vertex & {:keys [filters max-deepth stop-cond full-stack? timeout with-edges? with-vertices?] :as extra-params
                      :or {timeout 60000}}]
   "Perform distributed deepth first search. stop-cond is for vertex."
   (let [task-id (neb/rand-cell-id)


Fix element class name

Fix element class name

The `view` keyword was bieing passed along to Sablono unmodified, breaking the layout, and other code that depends on the selector.

--- src/cljs/hatti/views/dataview.cljs
+++ src/cljs/hatti/views/dataview.cljs
@@ -103,7 +103,7 @@
            (map dv->link dataviews)
            (om/build dataview-infobar (-> app-state :dataset-info))]
           (for [{:keys [component view]} dataviews]
-            [:div {:class (str "tab-page " view "-page")
+            [:div {:class (str "tab-page " (name view) "-page")
                    :style {:display (view->display view)}}
              [:div.tab-content {:id (str "tab-content" view)}
               (om/build component app-state {:opts opts})]])])))))


Move placeholder.

Move placeholder.

--- src/cljs/nested_sortable/tree.cljs
+++ src/cljs/nested_sortable/tree.cljs
@@ -116,14 +116,15 @@
     (if-not is-root?
       [:div
        [display node path]
-       (if-not (:add-as-child @state)
-         [placeholder display path])])
+       ])
     [:div.children
      (if (:add-as-child @state)
        [placeholder display path])
      (if-not (empty? (:children node))
        (for [[pos child] (map vector (range) (:children node))]
-         [tree-node child (conj path pos) display false]))]]])
+         [tree-node child (conj path pos) display false]))]
+    (if-not (:add-as-child @state)
+         [placeholder display path])]])

 (defn tree [root-node]
   (let [display (fn [item path]


embed page

embed page

--- src/cljs/salava/page/ui/embed.cljs
+++ src/cljs/salava/page/ui/embed.cljs
@@ -4,12 +4,93 @@
             [salava.core.ui.layout :as layout]
             [salava.core.i18n :refer [t]]
             [salava.core.ui.helper :refer [navigate-to path-for]]
-            [salava.page.ui.helper :as ph]             ))
+            [salava.page.ui.helper :as ph]
+            [salava.core.ui.badge-grid :refer [badge-grid-element]]
+            [salava.core.time :refer [date-from-unix-time]]))
+
+(defn tag-block [block-atom]
+ (let [{:keys [tag badges format sort]} block-atom
+       container (case format
+                  "short" [:div#grid {:class "row"}]
+                  "long" [:div.tag-block])]
+
+  [:div#user-badges
+   [:div [:label (t :page/Tag ":")] (str " " tag)]
+   [:div
+     (let [sorted-badges (case sort
+                           "name" (sort-by :name < badges)
+                           "modified" (sort-by :mtime > badges)
+                           badges)]
+      (into container
+       (for [badge sorted-badges]
+         (if (= format "short")
+          (badge-grid-element badge nil "embed" nil)
+          (ph/badge-block (assoc badge :format "long"))))))]]))
+
+(defn showcase-block [block-atom]
+ (let [{:keys [badges format title]} block-atom
+        container (case format
+                    "short" [:div#grid {:class "row"}]
+                    "long" [:div.tag-block])]
+   [:div
+    [:div.heading-block
+     [:h2 title]]
+    [:div#user-badges
+     [:div
+      (doall (reduce (fn [r badge]
+                       (conj r (if (= format "short")
+                                   (badge-grid-element badge nil "embed" nil)
+                                   (ph/badge-block (assoc badge :format "long")))))
+                     container badges))]]]))
+
+(defn view-page [page]
+  (let [{:keys [id name description mtime user_id first_name last_name blocks theme border padding visibility qr_code]} page]
+    [:div {:id    (str "theme-" (or theme 0))
+           :class "page-content"}
+     (if id
+       [:div.panel
+        [:div.panel-left
+         [:div.panel-right
+          [:div.panel-content
+           (if (and qr_code (= visibility "public"))
+             [:div.row
+              [:div {:class "col-xs-12 text-center"}
+               [:img#print-qr-code {:src (str "data:image/png;base64," qr_code)}]]])
+           (if mtime
+             [:div.row
+              [:div {:class "col-md-12 page-mtime"}
+               (date-from-unix-time (* 1000 mtime))]])
+           [:div.row
+            [:div {:class "col-md-12 page-title"}
+             [:h1 name]]]
+           [:div.row
+            [:div {:class "col-md-12 page-author"}
+             [:a {:href "#" :on-click #(navigate-to (str "/profile/" user_id)) } (str first_name " " last_name)]]]
+           [:div.row
+            [:div {:class "col-md-12 page-summary"}
+             description]]
+           (into [:div.page-blocks]
+                 (for [block blocks]
+                   [:div {:class "block-wrapper"
+                          :style {:border-top-width (:width border)
+                                  :border-top-style (:style border)
+                                  :border-top-color (:color border)
+                                  :padding-top (str padding "px")
+                                  :margin-top (str padding "px")}}
+                    (case (:type block)
+                      "badge" (ph/badge-block block)
+                      "html" (ph/html-block block)
+                      "file" (ph/file-block block)
+                      "heading" (ph/heading-block block)
+                      "tag" (tag-block block)
+                      "showcase" (showcase-block block)
+                      "profile" (ph/profile-block block)
+                      nil)]))]]]])]))

 (defn page-content [page state]
   (let [show-link-or-embed-atom (cursor state [:show-link-or-embed-code])]
     [:div {:id "page-view"}
-     [ph/view-page page]]))
+     [view-page page]]))

 (defn content [state]
   (let [page (:page @state)]
@@ -23,8 +104,8 @@
      :keywords?       true
      :handler         (fn [data]
                         (swap! state assoc :page (:page data) :ask-password (:ask-password data)))
-     :error-handler   (fn [{:keys [status status-text]}]
-                        )}))
+     :error-handler   (fn [{:keys [status status-text]}])}))
+

 (defn handler [site-navi params]
   (let [id (:page-id params)


func: add IDs to instances function

func: add IDs to instances function

--- src/clojure/zensols/dataset/db.clj
+++ src/clojure/zensols/dataset/db.clj
@@ -321,9 +321,9 @@
   * **:set-type** is either `:train`, `:test`, `:train-test` (all) and defaults
   to [[set-default-set-type]] or `:train` if not set
   * **:include-ids?** if non-`nil` return keys in the map as well"
-  [& {:keys [set-type include-ids?]}]
+  [& {:keys [set-type include-ids? id-set]}]
   (let [conn (connection)]
-    (->> (ids :set-type set-type)
+    (->> (or id-set (ids :set-type set-type))
          (map (if include-ids?
                 #(assoc (instance-by-id conn %) :id %)
                 #(instance-by-id conn %))))))


Implement git-push by shelling out.

Implement git-push by shelling out.

--- src/incise/deploy/workflows/git_branch.clj
+++ src/incise/deploy/workflows/git_branch.clj
@@ -79,6 +79,13 @@
   (doseq [afile files]
     (git-add *repo* (.getPath afile))))

+(defn git-push
+  "Shell out to git and push the current branch to the given remote and branch."
+  [remote branch]
+  (let [{:keys [exit err]} (sh "git" "push" "-f" remote branch)]
+    (when-not (= exit 0)
+      (throw (RuntimeException. err)))))
+
 (defn deploy
   "Deploy to the given branch. Follow options for commit and push behaviour."
   [{:keys [path branch commit push]


[PDOK-2505] fix: parameter all-features incorrect

--- src/main/clojure/pdok/featured/timeline.clj
+++ src/main/clojure/pdok/featured/timeline.clj
@@ -104,8 +104,7 @@
       (update-in [:feature] pg/from-json)
       (update-in [:action] keyword)))

-(defn changed-features
-  ([{:keys [dataset] :as timeline} collection]
+(defn changed-features [{:keys [dataset] :as timeline} collection]
    (let [query (str "SELECT cl.collection, cl.feature_id, cl.old_version, cl.version, cl.action, tl.feature
  FROM " (qualified-changelog dataset) " AS cl
  LEFT JOIN
@@ -117,16 +116,16 @@
 ") as tl ON cl.collection = tl.collection AND cl.version = tl.version
  WHERE cl.collection = '" collection "'
  ORDER BY cl.id ASC")]
-     (query-with-results-on-channel timeline query upgrade-changelog))))
-
-(defn all-features [timeline dataset collection]
-  (let [query (str "SELECT dataset, collection, feature_id, NULL as old_version, version, 'new' as action, feature
-                    FROM " (qualified-current) "
-                    WHERE dataset = '" dataset "' and collection = '" collection "'
+     (query-with-results-on-channel timeline query upgrade-changelog)))
+
+(defn all-features [{:keys [dataset] :as timeline} collection]
+  (let [query (str "SELECT collection, feature_id, NULL as old_version, version, 'new' as action, feature
+                    FROM " (qualified-current dataset) "
+                    WHERE collection = '" collection "'
                     UNION ALL
-                    SELECT dataset, collection, feature_id, NULL as old_version, version, 'new' as action, feature
-                    FROM " (qualified-history) "
-                    WHERE dataset = '" dataset "' and collection = '" collection "'")]
+                    SELECT collection, feature_id, NULL as old_version, version, 'new' as action, feature
+                    FROM " (qualified-history dataset) "
+                    WHERE collection = '" collection "'")]
      (query-with-results-on-channel timeline query upgrade-changelog)))

 (defn delete-changelog [{:keys [db dataset]}]


Fixed construction of InstanceGroupConfig to use integers.

--- src/main/clj/com/climate/services/aws/emr.clj
+++ src/main/clj/com/climate/services/aws/emr.clj
@@ -172,6 +172,10 @@
           (log/error "Job failed. Jobflow id or step not found.")
           2)))))

+(defn instance-group-config
+  [group instance-type number]
+  (InstanceGroupConfig. group instance-type (Integer. number)))
+
 (defn instances-config [{:keys [master-type slave-type num-instances keypair keep-alive
                                 availability-zone spot-task-type spot-task-bid
                                 spot-task-num]
@@ -179,11 +183,11 @@
                               slave-type "m1.large"
                               num-instances 3
                               keep-alive false}}]
-  (let [master-config (InstanceGroupConfig. "MASTER" master-type 1)
+  (let [master-config (instance-group-config "MASTER" master-type 1)
         core-config (when (> num-instances 1)
-                      (InstanceGroupConfig. "CORE" slave-type (- num-instances 1)))
+                      (instance-group-config "CORE" slave-type (- num-instances 1)))
         task-config (when spot-task-num
-                      (doto (InstanceGroupConfig. "TASK" spot-task-type spot-task-num)
+                      (doto (instance-group-config "TASK" spot-task-type spot-task-num)
                         (.setBidPrice (str spot-task-bid))
                         (.setMarket "SPOT")))
         jf (doto (JobFlowInstancesConfig.)


Detection of whitelist/blacklist mode

Detection of whitelist/blacklist mode

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -26,6 +26,13 @@
         (println "-> " user-name)
         user-name))

+(defn zw-mode?
+    [request]
+    (-> (:configuration request)
+        :server
+        :mode
+        (= "zw")))
+
 (defn get-url-prefix
     [request]
     (-> (:configuration request)
@@ -33,7 +40,7 @@
         :url-prefix))

 (defn finish-processing
-    [request search-results message]
+    [request search-results message zw-mode]
     (let [params        (:params request)
           cookies       (:cookies request)
           word          (get params "word")
@@ -43,18 +50,18 @@
         (println word)
         (println search-results)
         (if user-name
-            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message url-prefix))
+            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message url-prefix zw-mode))
                 (http-response/set-cookie :user-name user-name {:max-age 36000000})
                 (http-response/content-type "text/html"))
-            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message url-prefix))
+            (-> (http-response/response (html-renderer/render-front-page word user-name search-results message url-prefix zw-mode))
                 (http-response/content-type "text/html")))))

 (defn process-front-page
-    [request]
+    [request zw-mode]
     (let [params         (:params request)
           word           (get params "word")
           search-results (if (not (empty? word)) (db-interface/read-words-for-pattern word))]
-        (finish-processing request search-results nil)))
+        (finish-processing request search-results nil zw-mode)))

 (defn store-words
     [words user-name]
@@ -73,6 +80,10 @@
     (if input
         (->> (clojure.string/split input #"[\s,]")
              (filter seq))))
+
+(defn process-add-word
+    [request]
+    )

 (defn process-add-words
     [request]
@@ -82,7 +93,7 @@
           message   (add-words-message words)]
           (if (seq words)
               (store-words words user-name))
-        (finish-processing request nil message)))
+        (finish-processing request nil message nil)))

 (defn perform-operation
     [request]
@@ -96,22 +107,22 @@
               (db-interface/undelete-word to-undelete))))

 (defn process-all-words
-    [request]
+    [request zw-mode]
     (perform-operation request)
     (let [search-results (db-interface/read-all-words)]
-        (finish-processing request search-results nil)))
+        (finish-processing request search-results nil zw-mode)))

 (defn process-deleted-words
-    [request]
+    [request zw-mode]
     (perform-operation request)
     (let [search-results (db-interface/read-deleted-words)]
-        (finish-processing request search-results nil)))
+        (finish-processing request search-results nil zw-mode)))

 (defn process-active-words
-    [request]
+    [request zw-mode]
     (perform-operation request)
     (let [search-results (db-interface/read-active-words)]
-        (finish-processing request search-results nil)))
+        (finish-processing request search-results nil zw-mode)))

 (defn read-changes-statistic
     []
@@ -126,7 +137,7 @@
     (db-interface/read-changes-for-user user-name))

 (defn process-user-list
-    [request]
+    [request zw-mode]
     (let [changes-statistic (read-changes-statistic)
           changes           (read-changes)
           user-name         (get-user-name request)
@@ -134,24 +145,24 @@
         (println "stat"    changes-statistic)
         (println "changes" changes)
         (if user-name
-            (-> (http-response/response (html-renderer/render-users user-name changes-statistic changes url-prefix))
+            (-> (http-response/response (html-renderer/render-users user-name changes-statistic changes url-prefix zw-mode))
                 (http-response/set-cookie :user-name user-name {:max-age 36000000})
                 (http-response/content-type "text/html"))
-            (-> (http-response/response (html-renderer/render-users user-name changes-statistic changes url-prefix))
+            (-> (http-response/response (html-renderer/render-users user-name changes-statistic changes url-prefix zw-mode))
                 (http-response/content-type "text/html")))))

 (defn process-user-info
-    [request]
+    [request zw-mode]
     (let [params            (:params request)
           selected-user     (get params "name")
           changes           (read-changes-for-user selected-user)
           user-name         (get-user-name request)
           url-prefix        (get-url-prefix request)]
         (if user-name
-            (-> (http-response/response (html-renderer/render-user-info selected-user changes url-prefix))
+            (-> (http-response/response (html-renderer/render-user-info selected-user changes url-prefix zw-mode))
                 (http-response/set-cookie :user-name user-name {:max-age 36000000})
                 (http-response/content-type "text/html"))
-            (-> (http-response/response (html-renderer/render-user-info selected-user changes url-prefix))
+            (-> (http-response/response (html-renderer/render-user-info selected-user changes url-prefix zw-mode))
                 (http-response/content-type "text/html")))))

 (defn words->json
@@ -168,9 +179,10 @@
         (xml/emit {:tag :whitelist :content (for [word words]
                                              {:tag :word :attrs {
                                                              :added-by     (:user word)
-                                                             :date-time (:datetime word)
-                                                             :deleted  (:deleted word)}
-                                                             :content  [(:word word)]})})))
+                                                             :date-time    (:datetime word)
+                                                             :deleted      (:deleted word)
+                                                             :description  (:description word)}
+                                                             :content      [(:word word)]})})))

 (defn process-wordlist-json
     [request]
@@ -221,20 +233,22 @@
     "Handler that is called by Ring for all requests received from user(s)."
     [request]
     (println-and-flush "request URI: " (request :uri))
-    (let [uri (request :uri)]
+    (let [uri     (request :uri)
+          zw-mode (zw-mode? request)]
         (condp = uri
             "/favicon.ico"       (return-file "favicon.ico" "image/x-icon")
             "/bootstrap.min.css" (return-file "bootstrap.min.css" "text/css")
             "/smearch.css"       (return-file "smearch.css" "text/css")
             "/bootstrap.min.js"  (return-file "bootstrap.min.js" "application/javascript")
-            "/"                  (process-front-page request)
-            "/all-words"         (process-all-words request)
-            "/deleted-words"     (process-deleted-words request)
-            "/active-words"      (process-active-words  request)
+            "/"                  (process-front-page    request zw-mode)
+            "/all-words"         (process-all-words     request zw-mode)
+            "/deleted-words"     (process-deleted-words request zw-mode)
+            "/active-words"      (process-active-words  request zw-mode)
+            "/add-word"          (process-add-word      request)
             ;"/find-words"       (process-find-words    request)
             "/add-words"         (process-add-words     request)
-            "/users"             (process-user-list     request)
-            "/user"              (process-user-info     request)
+            "/users"             (process-user-list     request zw-mode)
+            "/user"              (process-user-info     request zw-mode)
             "/wordlist/json"     (process-wordlist-json request)
             "/wordlist/text"     (process-wordlist-text request)
             "/wordlist/xml"      (process-wordlist-xml  request)


Fix typo

Fix typo

--- src-cljs/arcis/pages/admin/network_state.cljs
+++ src-cljs/arcis/pages/admin/network_state.cljs
@@ -1,6 +1,6 @@
 ;;      Filename: network_state.cljs
 ;; Creation Date: Sunday, 11 October 2015 10:39 AM AEDT
-;; Last Modified: Sunday, 11 October 2015 05:18 PM AEDT
+;; Last Modified: Sunday, 11 October 2015 05:28 PM AEDT
 ;;        Author: Tim Cross <theophilusx AT gmail.com>
 ;;   Description:
 ;;
@@ -10,7 +10,7 @@
             [arcis.ajax :as ajax]
             [arcis.state :as state]))

-(defn y-or-n-toogle [val]
+(defn y-or-n-toggle [val]
   (if (or (= val "Y") (= val "y"))
     "N"
     "Y"))
@@ -39,5 +39,5 @@
                            (if (or (= state "Y") (= state "y"))
                              "btn-success"
                              "btn-danger"))
-               :on-click #(update-state grp sub-grp (y-or-n-toogle state))}
+               :on-click #(update-state grp sub-grp (y-or-n-toggle state))}
       (y-or-n-text state)]]))


extend BaseModelView

extend BaseModelView

--- dada-core/src/main/clojure/org/dada/core/SimpleModelView.clj
+++ dada-core/src/main/clojure/org/dada/core/SimpleModelView.clj
@@ -10,11 +10,11 @@
      [org.dada.core Metadata Update]
      )
     (:gen-class
-     ;;:extends org.dada.core.BaseModelView
-     :implements [org.dada.core.ModelView]
+     :extends org.dada.core.BaseModelView
+     ;;:implements [org.dada.core.ModelView]
      :constructors {[String org.dada.core.Metadata]
-     ;;[String org.dada.core.Metadata]
-     []
+     [String org.dada.core.Metadata]
+     ;;[]
      }
      :methods []
      :init init
@@ -27,8 +27,8 @@
 (defn -init [#^String name #^Metadata metadata]

   [ ;; super ctor args
-   ;;[name metadata]
-   []
+   [name metadata]
+   ;;[]
    ;; instance state
    (let [key-getter (.getPrimaryGetter metadata)
 	 version-comparator (.getVersionComparator metadata)


lein updates

lein updates

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,4 +1,4 @@
 {:user {:plugins [
-                  [cider/cider-nrepl "0.9.1"]
-                  [lein-ancient "0.6.7"]
+                  [cider/cider-nrepl "0.11.0"]
+                  [lein-ancient "0.6.8"]
                  ]}}


make button white and add gh icon

make button white and add gh icon

--- frontend/components/language_landing.cljs
+++ frontend/components/language_landing.cljs
@@ -170,7 +170,9 @@
                       :on-click #(put! controls-ch [:track-external-link-clicked {:event "Auth GitHub"
                                                                                :properties {:source (:language template)}
                                                                                :path (auth-url)}])}
-                     "Sign Up With GitHub"]
+                     [:i.fa.fa-github-alt]
+                     " Sign Up With "
+                     [:strong "GitHub"]]
                     [:div.language-cta-trial "14-day free trial"]
                     ]
                    ]]


Note that test namespaces come first.

Note that test namespaces come first.

--- src/midje/internal_ideas/project_state.clj
+++ src/midje/internal_ideas/project_state.clj
@@ -23,12 +23,19 @@
  (defn directories []
    (try
      (let [project (project/read)]
+       ;; Note that order is important here; see below.
        (concat (:test-paths project) (:source-paths project)))
      (catch java.io.FileNotFoundException e
        ["test"])))

  (defn namespaces []
    (mapcat namespaces-in-dir (directories)))
+
+ ;; For some purposes, it matters that the :tests files
+ ;; come before the :sources files. That happens to always be
+ ;; true, but the names below emphasize it.
+ (def directories-test-first directories)
+ (def namespaces-test-first namespaces)

  (defn unglob-partial-namespaces [namespaces]
    (mapcat #(if (= \* (last %))


:bug: Set proper order on rendering shapes inside a frame.

--- frontend/src/uxbox/main/ui/shapes/frame.cljs
+++ frontend/src/uxbox/main/ui/shapes/frame.cljs
@@ -134,7 +134,7 @@

     [:svg {:x x :y y :width width :height height}
      [:& "rect" props]
-     (for [item childs]
+     (for [item (reverse childs)]
        [:& shape-wrapper {:shape (translate item) :key (:id item)}])]))

 (defn- translate-to-frame


:sparkles: Maintain artboard label size on zoom

--- frontend/src/uxbox/main/ui/shapes/frame.cljs
+++ frontend/src/uxbox/main/ui/shapes/frame.cljs
@@ -58,7 +58,10 @@
     {::mf/wrap [wrap-memo-frame]}
     [{:keys [shape objects] :as props}]
     (when (and shape (not (:hidden shape)))
-      (let [selected-iref (-> (mf/deps (:id shape))
+      (let [zoom (mf/deref refs/selected-zoom)
+            inv-zoom (/ 1 zoom)
+
+            selected-iref (-> (mf/deps (:id shape))
                               (mf/use-memo #(refs/make-selected (:id shape))))
             selected? (mf/deref selected-iref)
             on-mouse-down #(common/on-mouse-down % shape)
@@ -81,12 +84,18 @@
              :on-context-menu on-context-menu
              :on-double-click on-double-click
              :on-mouse-down on-mouse-down}
-         [:text {:x (:x label-pos)
-                 :y (:y label-pos)
+         [:text {:x 0
+                 :y 0
                  :width width
                  :height 20
                  :class-name "workspace-frame-label"
-                 :on-click on-double-click} ; user may also select with single click in the label
+                 ; Ensure that the label has always the same font size, regardless of zoom
+                 ; https://css-tricks.com/transforms-on-svg-elements/
+                 :transform (str
+                              "scale(" inv-zoom ", " inv-zoom ") "
+                              "translate(" (* zoom (:x label-pos)) ", " (* zoom (:y label-pos)) ")")
+                 ; User may also select the frame with single click in the label
+                 :on-click on-double-click}
           (:name shape)]
          [:& (frame-shape shape-wrapper) {:shape shape
                                           :childs childs}]]))))


more tests for swap-case

more tests for swap-case

--- test/str/core_test.clj
+++ test/str/core_test.clj
@@ -110,7 +110,7 @@
     "Foo" (str/capitalize "FoO")
     "Foo." (str/capitalize "FoO.")))

-(defspec invert-case-does-not-change-length 100
+(defspec swap-case-does-not-change-length 100
   (prop/for-all [s gen/string]
     (= (.length (str/swap-case s)) (.length s))))

@@ -126,11 +126,18 @@
       (if (Character/isUpperCase c) -1 1)
       0)))

-(defspec invert-case-changes-case 100
+(defspec swap-case-changes-case 100
   (prop/for-all [s gen/string]
     (let [cases1 (map case-to-int s)
           cases2 (map case-to-int (str/swap-case s))]
       (apply = 0 (map + cases1 cases2)))))
+
+(deftest swap-case
+  (are [expected actual] (= expected actual)
+    "Foo" (str/swap-case "fOO" )
+    "foo" (str/swap-case "FOO")
+    "åÅBERG" (str/swap-case "Ååberg")
+    "æÆå." (str/swap-case "ÆæÅ.")))

 (defspec slice-without-end-has-length-1 100
   (prop/for-all [vals (gen/bind (gen/not-empty gen/string)


Add nice klanky bells example from sc book now that klank works correctly

--- docs/sc-book/sc-one.clj
+++ docs/sc-book/sc-one.clj
@@ -705,3 +705,40 @@
               (* (sin-osc harm)
                  (maximum [0 0] (sin-osc:kr (/ (inc count) 4)))
                  (/ 1 (inc count))))))))
+
+
+;; Page 38
+
+;;(
+;;{
+;;        var scale, specs, freqs, amps, rings,
+;;         numRes = 5, bells = 20, pan;
+;;     scale = [60, 62, 64, 67, 69].midicps;
+;;         Mix.fill(bells, {
+;;                 freqs = Array.fill(numRes, {rrand(1, 15)*(scale.choose)});
+;;                 amps = Array.fill(numRes, {rrand(0.3, 0.9)});
+;;                 rings = Array.fill(numRes, {rrand(1.0, 4.0)});
+;;                 specs = [freqs, amps, rings].round(0.01);
+;;                 specs.postln;
+;;                 pan = (LFNoise1.kr(rrand(3,6))* 2).softclip;
+;;                 Pan2.ar(
+;;                     Klank.ar(`specs,
+;;                         Dust.ar(1/6, 0.03)),
+;;                         pan)
+;;         })
+;;}.play;
+;;)
+
+(demo 10
+      (let [num-res 5
+            bells   20
+            scale   (map midi->hz [60 62 64 67 69])
+            mk-bell (fn [] (let [freqs (repeatedly num-res #(* (ranged-rand 1 5) (choose scale)))
+                                amps  (repeatedly num-res #(ranged-rand 0.3 0.9))
+                                rings (repeatedly num-res #(ranged-rand 1 4))
+                                specs [freqs amps rings]
+                                _ (println specs)
+                                pan (softclip (* 2 (lf-noise1:kr (ranged-rand 3 6))))]
+                            (pan2 (klank specs (* 0.03 (dust (/ 1 6)) ))
+                                  pan)))]
+        (out 0 (mix (repeatedly bells mk-bell)))))


More options for random :knock-off-chip-off-the-old-block

--- src/clojush/pushgp/selection/preselection.clj
+++ src/clojush/pushgp/selection/preselection.clj
@@ -77,7 +77,11 @@
   outof many. If diffs is :random, then it is chosen randomly from the range from 1
   to outof. If outof is also :random, then the value should actually be a vector
   of the form [:random :random limit], and outof will be chosen from the range from
-  1 to limit."
+  1 to limit. If the value is of the form [:random :random limit minfrac] then diffs
+  will be chosen randomly from the range of (int (* minfrac outof)) to outof.
+  If the value is of the form [:random :random limit minfrac maxfrac] then diffs
+  will be chosen randomly from the range of (int (* minfrac outof)) to
+  (int (* maxfrac outof))."
   [pop argmap]
   (if (not (:knock-off-chip-off-the-old-block argmap))
     pop
@@ -96,7 +100,15 @@
               outof (second knock-spec)
               limit (if (= outof :random) (nth knock-spec 2) nil)
               outof (if (= outof :random) (inc (lrand-int limit)) outof)
-              diffs  (if (= diffs :random) (inc (lrand-int outof)) diffs)
+              diffs  (if (= diffs :random)
+                       (inc (if (> (count knock-spec) 3)
+                              (let [mindiff (int (* (nth knock-spec 3) outof))
+                                    maxdiff (if (> (count knock-spec) 4)
+                                              (int (* (nth knock-spec 4) outof))
+                                              outof)]
+                                (+ mindiff (lrand-int (max 1 (- maxdiff mindiff)))))
+                              (lrand-int outof)))
+                       diffs)
               changed (vec (filter #(or (< (count (:history %)) diffs)
                                         (>= (count (distinct (take outof (:history %))))
                                             diffs))


Une solution à l'exercice "Grade School" de Exercism dans la track Clojure

--- exercism/clojure/grade-school/src/grade_school.clj
+++ exercism/clojure/grade-school/src/grade_school.clj
@@ -1,13 +1,10 @@
 (ns grade-school)

-(defn grade [school grade]  ;; <- arglist goes here
-    ;; your code goes here
-)
+(defn grade [school grade]
+  (get school grade []))

-(defn add [school name grade]  ;; <- arglist goes here
-    ;; your code goes here
-)
+(defn add [school name grade]
+  (update school grade concat (vector name)))

-(defn sorted [school]  ;; <- arglist goes here
-    ;; your code goes here
-)
+(defn sorted [school]
+  (let [sorted-school (into (sorted-map) (sort-by key school))] (reduce-kv #(assoc %1 %2 (sort (vec %3))) (empty sorted-school) sorted-school)))


CMR-835: Scoping access value condition by provider id in acls when no entry titles are included in the acl.

--- src/cmr/search/services/acls/granule_acls.clj
+++ src/cmr/search/services/acls/granule_acls.clj
@@ -120,16 +120,20 @@
   on whether the user's query contained collection ids. This implementation assumes the query-coll-ids
   passed in are limited to the provider of the collection identifier."
   [context query-coll-ids provider-id collection-identifier]
-  (if-let [{:keys [entry-titles access-value]} collection-identifier]
-    (let [entry-titles-cond (provider+entry-titles->collection-condition
-                              context query-coll-ids provider-id entry-titles)
-          access-value-cond (some-> (access-value->query-condition access-value)
-                                    q/->CollectionQueryCondition)]
-      (if (and entry-titles-cond access-value-cond)
-        (gc/and-conds [entry-titles-cond access-value-cond])
-        (or entry-titles-cond access-value-cond)))
-    ;; No other collection info provided so every collection in provider is possible
-    (provider->collection-condition query-coll-ids provider-id)))
+  (let [colls-in-prov-cond (provider->collection-condition query-coll-ids provider-id)]
+    (if-let [{:keys [entry-titles access-value]} collection-identifier]
+      (let [entry-titles-cond (provider+entry-titles->collection-condition
+                                context query-coll-ids provider-id entry-titles)
+            access-value-cond (some-> (access-value->query-condition access-value)
+                                      q/->CollectionQueryCondition)]
+        (if (and entry-titles-cond access-value-cond)
+          (gc/and-conds [entry-titles-cond access-value-cond])
+          (or entry-titles-cond
+              ;; If there's no entry title condition the access value condition must be scoped
+              ;; by provider
+              (gc/and-conds [colls-in-prov-cond access-value-cond]))))
+      ;; No other collection info provided so every collection in provider is possible
+      colls-in-prov-cond)))

 (defn granule-identifier->query-cond
   "Converts an acl granule identifier into a query condition."
@@ -152,7 +156,6 @@
     (if (and collection-cond granule-cond)
       (gc/and-conds [collection-cond granule-cond])
       (or collection-cond granule-cond))))
-

 (defn acls->query-condition
   "Converts a list of acls into a query condition. coll-ids-by-prov should be a map of provider ids
@@ -188,9 +191,10 @@

 (comment

-  (def context {:system user/system})
-  (def context {:system (get-in user/system [:apps :search])})
-  (acl-service/add-acl-conditions-to-query context @last-query)
+  (def query (cmr.common.dev.capture-reveal/reveal query))
+  (def context (cmr.common.dev.capture-reveal/reveal context))
+
+  (acl-service/add-acl-conditions-to-query context query)

 )


make ref-attr? work with eids

make ref-attr? work with eids

--- src/shared/dato/db/utils.cljc
+++ src/shared/dato/db/utils.cljc
@@ -117,6 +117,8 @@
 (defn tx-report->transaction [report]
   (mapv datom->transaction (:tx-data report)))

-(defn ref-attr? [db attr-name]
-  (let [attr-value-type (:db/valueType (qe-by db :db/ident attr-name))]
-    (= :db.type/ref attr-value-type)))
+(defn ref-attr? [db attrid]
+  #?(:clj  (= :db.type/ref (:value-type (d/attribute db attrid)))
+     :cljs (-> (qe-by db :db/ident attr-name)
+               :db/valueType
+               (= :db.type/ref))))


Fix bug in java-patch

Fix bug in java-patch

--- src/shuriken/monkey_patch.clj
+++ src/shuriken/monkey_patch.clj
@@ -126,7 +126,8 @@
                     _#          (~f method#)
                     bytecode#   (.toBytecode ct-class#)
                     [class-name# _method-name# _parameter-types#]
-                    (conform! ::method-signature ~method-signature-sym)
+                    (conform! :shuriken.reflection/method-signature
+                              ~method-signature-sym)
                     definition# (java.lang.instrument.ClassDefinition.
                                   (Class/forName class-name#)
                                   bytecode#)]