Sort through options for server clients (WIP)

Adjust the function for coping with follow-up Initiate packets. The
basic idea still throws a NotImplementedException, but I think the docs
about what could/should happen make sense.

If there's a reason to forward along a message to an existing child, the
relevant code should be the same, whether that message is going to a new
one or is coming from a new Initiate packet.

Refactored the code for setting up a new client into its own function.

It still doesn't work, but it least I've established some isolation
around it.

--- src/clojure/frereth_cp/server/initiate.clj
+++ src/clojure/frereth_cp/server/initiate.clj
@@ -74,7 +74,8 @@
         :args (s/cat :state ::state
                      :initiate-packet ::K/initiate-packet-spec)
         :ret (s/keys :req [::log2/state]
-                     :opt [::handled?]))
+                     :opt [::handled?
+                           ::state/client-state]))
 (defn possibly-re-initiate-existing-client-connection!
   "Client can send as many Initiate packets as it likes.

@@ -117,6 +118,14 @@
                                                       packet-nonce-bytes
                                                       vouch)]
               ;; Line 351
+              ;; This is totally broken.
+              ;; First, really should use find-client to get to this one.
+              ;; But then we still need to inject the new packet-nonce.
+              ;; assoc-in makes sense for that, but not update-in.
+              ;; This seems worth adding something like an update-client fn,
+              ;; or even update-client-packet-nonce.
+              ;; Need something along those lines.
+              ;; Key point: don't duplicate the message-forwarding code.
               (let [state (update-in state [client-short-key ::state/received-nonce] packet-nonce)]
                 ;; That takes us down to line 352.
                 ;; Q: What's going on there?
@@ -129,6 +138,9 @@
                 ;; before sending the array to the associated child
                 ;; process in the next line:
                 ;; writeall(activeclients[i].tochild, text+383, r-543)
+                ;; Ultimately, we should just return this.
+                {::log2/state log-state
+                 ::state/client-state (state/find-client state client-short-key)}
                 (throw (RuntimeException. "start back here")))
               {::log/state (log2/warn log-state
                                       log-label
@@ -520,7 +532,7 @@
           (.getBytes inner-pk-buf 0 inner-pk)
           (b-t/bytes= short-pk inner-pk))))))

-(s/fdef do-fork-child
+(s/fdef do-fork-child!
   :args (s/cat :state ::state/state
                :active-client ::state/client-state
                :client-long-pk ::shared/public-key
@@ -531,7 +543,7 @@
                :initiate ::serial/decomposed
                :client-message-box ::K/initiate-client-vouch-wrapper)
   :ret ::state/state)
-(defn do-fork-child
+(defn do-fork-child!
   [{log-state ::log2/state
     :as state}
    active-client
@@ -614,10 +626,108 @@
                                                      {::problem x}))))
     (assoc state ::log2/state log-state)))

+(s/fdef build-new-client!
+  :args (s/cat :log-state-atom ::log2/state-atom
+               :state ::state/state
+               :packet ::shared/network-packet
+               :initiate ::K/initiate-packet-spec)
+  ;; Q: Is it worth calling out the log-state as something
+  ;; special?
+  :ret (s/keys :req [::log2/state]
+               :opt [::state/delta]))
+(defn build-new-client!
+  [log-state-atom
+   {log-state ::log2/state
+    :as state}
+   {:keys [:host :port]
+    :as packet}
+   {:keys [::K/clnt-short-pk]
+    :as initiate}]
+  (let [{cookie ::templates/cookie-spec
+         log-state ::log2/state
+         :as cookie-extraction} (extract-cookie log-state
+                                                (::state/cookie-cutter state)
+                                                initiate)]
+    (reset! log-state-atom log-state)
+    (if cookie
+      (let [log-state (swap! log-state-atom #(log2/info %
+                                                        ::handle!
+                                                        "Succssfully extracted cookie"))
+            client-short-pk (bytes clnt-short-pk)
+            {active-client ::state/client-state
+             server-short-sk ::shared/secret-key
+             {log-state ::log2/state
+              :as state} ::state/state} (configure-new-active-client (assoc state ::log2/state log-state)
+                                                                     client-short-pk
+                                                                     cookie)]
+        (reset! log-state-atom log-state)
+        ;; 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
+          (println "Mark: trying to open the client's crypto box")
+          (let [{log-state ::log2/state
+                 client-message-box ::K/initiate-client-vouch-wrapper} (open-client-crypto-box log-state
+                                                                                initiate
+                                                                                active-client)]
+            (println "Mark: real result from opening crypto box:"
+                     client-message-box)
+            (reset! log-state-atom log-state)
+            (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)})]
+                (reset! log-state-atom log-state)
+                (try
+                  (println "Mark: validating server name")
+                  (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)
+                      ;; TODO: Limit the state parameter and return value 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-atom
+                                                  ex
+                                                  ::do-handle
+                                                  "Failure after decrypting inner client cryptobox")})))
+              (assoc state ::log2/state log-state)))
+          (catch Exception ex
+            {::log2/state (log2/exception @log-state-atom
+                                          ex
+                                          ::do-handle
+                                          "Initiate packet looked good enough to establish client session, but failed later")})))
+      ;; Just log a quick message about the failure for now.
+      ;; It seems likely that we should really gather more info, especially in terms
+      ;; of identifying the source of garbage.
+      {::log2/state (log2/error log-state
+                                ::do-handle
+                                "FIXME: Debug only: cookie extraction failed")})))
+
 (s/fdef decompose-initiate-packet
   :args (s/cat :packet-length nat-int?
                :message-packet ::shared/message)
-  :ret ::serial/decomposed)
+  :ret ::K/initiate-packet-spec)
 (defn decompose-initiate-packet
   [packet-length
    message-packet]
@@ -646,8 +756,7 @@
   [{log-state ::log2/state
     :keys [::log2/logger]
     :as state}
-   {:keys [:host :port]
-    message :message
+   {:keys [:message]
     :as packet}]
   (let [log-state-atom (atom (log2/info log-state
                                         ::handle!
@@ -658,10 +767,10 @@
     (try
       (let [n (count message)]
         (if (>= n (+ K/box-zero-bytes packet-header-length))
-          (let [initiate (decompose-initiate-packet n message)
-                client-short-pk (bytes (::K/clnt-short-pk initiate))]
+          (let [initiate (decompose-initiate-packet n message)]
             (println "Mark: Check for re-initiate")
-            (let [{:keys [::handled]
+            (let [{:keys [::handled
+                          ::state/client-state]
                    ;; The way this is handled is wrong.
                    ;; Have this return the active client, if any.
                    ;; Then we can eliminate the message-forwarding duplication
@@ -670,87 +779,16 @@
                                                                                initiate)]
               (reset! log-state-atom log-state)
               (if-not handled
-                (let [{cookie ::templates/cookie-spec
-                       log-state ::log2/state
-                       :as cookie-extraction} (extract-cookie log-state
-                                                              (::state/cookie-cutter state)
-
-                                                              initiate)]
-                  (reset! log-state-atom log-state)
-                  (if cookie
-                    (let [log-state (log2/info log-state
-                                               ::handle!
-                                               "Succssfully extracted cookie")
-                          {active-client ::state/client-state
-                           server-short-sk ::shared/secret-key
-                           {log-state ::log2/state
-                            :as state} ::state/state} (configure-new-active-client (assoc state ::log2/state log-state)
-                                                                                client-short-pk
-                                                                                cookie)]
-                      (reset! log-state-atom log-state)
-                      ;; 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
-                        (println "Mark: trying to open the client's crypto box")
-                        (let [{log-state ::log2/state
-                               client-message-box ::K/initiate-client-vouch-wrapper} (open-client-crypto-box log-state
-                                                                                initiate
-                                                                                active-client)]
-                          (println "Mark: real result from opening crypto box:"
-                                   client-message-box)
-                          (reset! log-state-atom log-state)
-                          (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)})]
-                              (reset! log-state-atom log-state)
-                              (try
-                                (println "Mark: validating server name")
-                                (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)
-                                    ;; TODO: Limit the state parameter and return value 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-atom
-                                                                ex
-                                                                ::do-handle
-                                                                "Failure after decrypting inner client cryptobox")})))
-                            (assoc state ::log2/state log-state)))
-                        (catch Exception ex
-                          {::log2/state (log2/exception @log-state-atom
-                                                        ex
-                                                        ::do-handle
-                                                        "Initiate packet looked good enough to establish client session, but failed later")})))
-                    ;; Just log a quick message about the failure for now.
-                    ;; It seems likely that we should really gather more info, especially in terms
-                    ;; of identifying the source of garbage.
-                    {::log2/state (log2/error log-state
-                                              ::do-handle
-                                              "FIXME: Debug only: cookie extraction failed")}))
-                (throw (RuntimeException. "TODO: Handle additional Initiate packets from " client-short-pk)))))
+                (let [client-state (or client-state
+                                       (build-new-client! log-state-atom
+                                                          state
+                                                          packet
+                                                          initiate))]
+                  (throw (RuntimeException. "Forward along the message portion")))
+                (throw (RuntimeException. "TODO: Handle additional Initiate packets from " (-> initiate
+                                                                                ::K/clnt-short-pk
+                                                                                bytes
+                                                                                vec))))))
           {::log2/state (log2/warn log-state
                                    ::do-handle
                                    (str "Truncated initiate packet. Only received " n " bytes"))}))


Make arbitrary length n-grams

Make arbitrary length n-grams

--- src/shokunin/word.clj
+++ src/shokunin/word.clj
@@ -45,11 +45,10 @@

 (defn word-chain
   "Build a word chain out of word tokens."
-  [word-seq]
+  [word-seq n]
   (let [word-seq* (concat [:start] word-seq [:end])
-        tri-grams (n-gram 3 word-seq*)]
+        tri-grams (n-gram n word-seq*)]
     (apply merge-with clojure.set/union (map word-link tri-grams))))
-

 (defn sentence-tokens
   "Turn a seq of words into sentences."
@@ -70,7 +69,7 @@
          words           (concat (rest start) [choice])]
      (markov-sentence chain words)))
   ([chain words]
-   (if (or (= :end (last words)) (> (count words) 50)) words
+   (if (or (= :end (last words)) (> (count words) 100)) words
      (let [prefix-pair   (reverse (take 2 (reverse words)))
            choices       (get chain prefix-pair)
            choice        (rand-nth (seq choices))]
@@ -78,7 +77,7 @@

 ; an example
 (def sentences (-> (slurp "resources/01/federalist.txt") lower-case sentence-tokens))
-(def sentences-chains (map word-chain (map word-tokens sentences)))
+(def sentences-chains (map word-chain (map word-tokens sentences) 2))
 (def federalist-chains (apply merge-with clojure.set/union fed-chain))
 (markov-sentence federalist-chains)


Simplify actions; allow restart after winning

--- src/sojoban/core.cljs
+++ src/sojoban/core.cljs
@@ -103,40 +103,45 @@

 (def dirs #{:up :down :left :right})

-(defn get-init-state []
-  (let [level-set yoshio-levels
-        current-level 3
-        board (level-set current-level)]
-    {:level-set level-set
-     :current-level current-level
-     :board board
-     :history []}))
+(defn start-level [state-value level-set level-number]
+  (assoc state-value
+         :level-set level-set
+         :level-number level-number
+         :board (level-set level-number)
+         :history []
+         :won false))

-(def state (atom (get-init-state)))
+(defn undo [state-value]
+  (if (> (count (:history state-value)))
+    (-> state-value
+        (assoc :board (peek (:history state-value)))
+        (update-in [:history] pop))
+    state-value))
+
+(def init-state
+  (start-level {} yoshio-levels 0))
+
+(def state (atom init-state))
+
+(defn process-action [action]
+  (cond
+    (and (dirs action)
+         (not (:won @state)))
+    (do
+      (swap! state process-move action)
+      (when (:won @state)
+        (js/alert (str "You win, in " (count (:history @state)) " moves!"))))
+
+    (= action :restart)
+    (swap! state #(start-level % (:level-set %) (:level-number %)))
+
+    (and (= action :undo)
+         (not (:won @state)))
+    (swap! state undo)))

 (defn process-keydown [ev]
   (when-let [action (keycode->action (.-keyCode ev))]
-    (when-not (:won @state)
-      (cond
-        (dirs action)
-        (do
-          (swap! state process-move action)
-          (when (:won @state)
-            (js/alert (str "You win, in " (count (:history @state)) " moves!"))))
-
-        ; FIXME: doesn't matter because JS is single-threaded, but semantically
-        ; shouldn't deref/read state before modifying it - should do that
-        ; inside the update function. (for restart and undo)
-
-        (= action :restart)
-        (when (> (count (:history @state)) 0)
-          (swap! state #(let [orig-board (first (:history %))]
-            (assoc % :board orig-board :history [orig-board]))))
-
-        (= action :undo)
-        (when (> (count (:history @state)) 0)
-          (swap! state #(assoc % :board (peek (:history %))
-                                 :history (pop (:history %)))))))
+    (process-action action)
     (.preventDefault ev)))

 (defn board-widget [data owner]


Allow seeking to next and prev level

Allow seeking to next and prev level

--- src/sojoban/core.cljs
+++ src/sojoban/core.cljs
@@ -99,7 +99,9 @@
    37 :left
    39 :right
    82 :restart  ; XXX: not sure why (int \R) doesn't work?
-   85 :undo})
+   85 :undo
+   78 :next-level
+   80 :prev-level})

 (def dirs #{:up :down :left :right})

@@ -117,6 +119,12 @@
         (assoc :board (peek (:history state-value)))
         (update-in [:history] pop))
     state-value))
+
+(defn try-seek-level [state-value diff]
+  (let [new-level-num (+ diff (:level-number state-value))]
+    (if (<= 0 new-level-num (dec (count (:level-set state-value))))
+      (start-level state-value (:level-set state-value) new-level-num)
+      state-value)))

 (def init-state
   (start-level {} yoshio-levels 0))
@@ -137,7 +145,13 @@

     (and (= action :undo)
          (not (:won @state)))
-    (swap! state undo)))
+    (swap! state undo)
+
+    (= action :prev-level)
+    (swap! state try-seek-level -1)
+
+    (= action :next-level)
+    (swap! state try-seek-level 1)))

 (defn no-key-modifiers? [ev]
   (and


Created common input wrapper that handles numbers well.

--- src/startrek/core.clj
+++ src/startrek/core.clj
@@ -19,13 +19,14 @@
        edn/read-string
        (map :page)))

-; only needed for reading numbers from command line
-(let [m (.getDeclaredMethod clojure.lang.LispReader
-                            "matchNumber"
-                            (into-array [String]))]
-  (.setAccessible m true)
-  (defn parse-number [s]
-    (.invoke m clojure.lang.LispReader (into-array [s]))))
+(defn parse-number
+  "Reads a number from a string. Returns nil if not a number."
+  [s]
+  (if (re-find #"^-?\d+\.?\d*$" s)
+    (read-string s)
+    (let [s2 (str "0" s)]
+      (if (re-find #"^-?\d+\.?\d*$" s2)
+        (read-string s2)))))

 (defn print-instructions [pause]
   (loop [p pages]
@@ -99,9 +100,12 @@
   (println "   7 = CALL ON LIBRARY COMPUTER")
   (println))

+(defn user-input []
+  (parse-number (read-line)))
+
 (defn play-game []
   (w/new-game-state game-state)
-  (w/enter-sector)
+  (w/enter-quadrant game-state)
   (let [stop-condition (ref false)]
     (while (not (deref stop-condition))
       ; check to see if the Enterprise is destroyed
@@ -113,13 +117,13 @@
           (println "COMMAND")
           (let [choice (read-line)]
             (condp = choice
-              "0" (n/set-course-command)
-              "1" (w/short-range-scan-command)
-              "2" (w/long-range-scan-command)
-              "3" (e/fire-phasers-command)
-              "4" (e/fire-torpedoes-command)
-              "5" (e/shield-control-command)
-              "6" (e/damage-control-report-command)
+              "0" (n/set-course-command game-state)
+              "1" (w/short-range-scan-command game-state)
+              "2" (w/long-range-scan-command game-state)
+              "3" (e/fire-phasers-command game-state)
+              "4" (e/fire-torpedoes-command game-state)
+              "5" (e/shield-control-command game-state)
+              "6" (e/damage-control-report-command game-state)
               "7" (library-computer)
               "q" (dosync (alter stop-condition (fn [_] true)))
               (command-help)
@@ -144,5 +148,10 @@
   (let [seed (parse-number (read-line))]
     (binding  [gen/*rnd*  (java.util.Random. seed)])

-    (with-redefs [u/message println]
+    (with-redefs [u/message println
+                  n/pick-course user-input
+                  n/pick-warp-factor user-input
+                  e/pick-phaser-power user-input
+                  e/pick-torpedo-course user-input
+                  e/pick-shield-power user-input ]
     (play-game))))


Make stop-tracking! more atomic

Make stop-tracking! more atomic

--- src/clj/onyx_dashboard/http/server.clj
+++ src/clj/onyx_dashboard/http/server.clj
@@ -130,9 +130,12 @@
                                 :tracking-id tracking-id}))

 (defn stop-tracking! [user-id]
-  (when-let [tracking-manager (@tracking user-id)]
-    (component/stop tracking-manager)
-    (swap! tracking dissoc user-id)))
+  (swap! tracking
+         (fn [tr]
+           (if-let [manager (tr user-id)]
+             (do (component/stop manager)
+                 (dissoc tr user-id))
+             tr))))

 (defn start-tracking! [send-fn! peer-config {:keys [deployment-id tracking-id]} user-id]
   (println deployment-id " tracking id " tracking-id peer-config)


continue to work on account form

continue to work on account form

--- src/cljs/clj_money/views/accounts.cljs
+++ src/cljs/clj_money/views/accounts.cljs
@@ -13,14 +13,14 @@
                                      select-input
                                      required]]))

-(def ^:private accounts (r/atom []))
+(def ^:private *accounts* (r/atom []))

 (defn- delete
   [account accounts]
   (js/alert "not implemented."))

 (defn- account-row
-  [account depth accounts]
+  [account depth]
   ^{:key (str "account-" (:id account))}
   [:tr
    [:td [:span {:class (str "account-depth-" depth)}
@@ -33,56 +33,80 @@
                     :class "btn btn-info btn-xs"
                     :title "Click here to edit this account."})
      (util/button nil
-                  #(delete account accounts)
+                  #(delete account *accounts*)
                   {:icon :remove
                    :class "btn btn-danger btn-xs"
                    :title "Click here to remove this account."})]]])

 (defn- account-and-child-rows
-  ([account accounts]
-   (account-and-child-rows account accounts 0 []))
-  ([account accounts depth result]
+  ([account]
+   (account-and-child-rows account 0 []))
+  ([account depth result]
    (-> []
-       (conj (account-row account depth accounts))
-       (concat (map #(account-and-child-rows % accounts (+ 1 depth) result)
+       (conj (account-row account depth))
+       (concat (map #(account-and-child-rows % (+ 1 depth) result)
                     (:children account))))))

 (defn- account-type-rows
-  [{:keys [type accounts] :as group} all-accounts]
+  [{:keys [type accounts] :as group}]
   (-> '()
       (conj ^{:key (str "account-type" type)}
             [:tr.account-type {:id (str "account-type-" type)}
              [:td type]
              [:td (util/space)]])
-      (concat (mapcat #(account-and-child-rows % all-accounts) accounts))))
+      (concat (mapcat #(account-and-child-rows %) accounts))))

 (defn- account-list
-  [accounts]
+  []
   [:table.table.table-striped.table-hover
    [:tbody
     [:tr
      [:th "Name"]
      [:th (util/space)]]
-    (for [row (mapcat #(account-type-rows % accounts) (nest @accounts))]
+    (for [row (mapcat #(account-type-rows %) (nest @*accounts*))]
       row)]])

 (defn- accounts-page []
+  (accounts/get-all (:id @state/current-entity)
+                    #(reset! *accounts* %)
+                    notify/danger)
   (with-layout
     [:section
      [:h1 "Accounts"]
-     (accounts/get-all (:id @state/current-entity)
-                       #(reset! accounts %)
-                       notify/danger)
-     [account-list accounts]
+     [account-list]
      (util/add-button "/accounts/new")]))
+
+(defn- accounts-source
+  [text]
+  (let [result (->> @*accounts*
+                    (filter #(not= -1 (-> (:name %)
+                                          (.toLowerCase)
+                                          (.indexOf text))))
+                    (mapv (juxt :name :id)))]
+    result))

 (def ^:private account-form
   [:form
    (text-input :name :required)
-   (select-input :parent-id (map ))
-   ])
+   [:div.form-group
+    [:label.control-label {:for :parent-id} "Parent"]
+    [:div {:field :typeahead
+           :id :parent-id
+           :input-class "form-control"
+           :list-class "typeahead-list"
+           :item-class "typeahead-item"
+           :data-source accounts-source
+           :in-fn (fn [id]
+                    ((juxt :name :id) (->> @*accounts*
+                                           (filter #(= id (:id %)))
+                                           first)))
+           :out-fn (fn [[name id]] id)
+           :result-fn (fn [[name id]] name)}]]])

 (defn- new-account []
+  (accounts/get-all (:id @state/current-entity)
+                    #(reset! *accounts* %)
+                    notify/danger)
   (with-layout
     [:div.row
      [:div.col-md-6


Ensure that background color is drawn properly when exporting animations

--- src/cljs/goya/components/mainmenu.cljs
+++ src/cljs/goya/components/mainmenu.cljs
@@ -118,6 +118,7 @@
         width (get-in @app/app-state [:main-app :canvas-width])
         height (get-in @app/app-state [:main-app :canvas-height])
         animation (get-in @app/app-state [:main-app :animation])
+        background-color (get-in @app/app-state [:main-app :background-color])
         gif (js/GIF. #js {:workers 4
                           :quality 1
                           :width width
@@ -129,7 +130,7 @@
       (let [frame (nth animation x)
             image-data (get-in frame [:image-data])
             context (.getContext render-canvas "2d")]
-        (canvasdrawing/draw-image-to-canvas image-data render-canvas width height 1)
+        (canvasdrawing/draw-image-to-canvas image-data render-canvas width height 1 background-color)
         (.addFrame gif context #js {:copy true :delay 300})))
     (.on gif "finished" #(download-history-animation % owner))
     (.on gif "progress" #(show-progress % owner))


cleanup chart keys

cleanup chart keys

--- src/cljs/material/component/chart.cljs
+++ src/cljs/material/component/chart.cljs
@@ -6,13 +6,13 @@
   (let [hashd (hash data)]
     (html
       [:div {:className className
-             :key       (str "p-" id "-" hashd)}
+             :key       (str "pie-wrapper-" id "-" hashd)}
        (comp/responsive-container
-         {:key     (str "rc-" id)}
+         {}
          (comp/pie-chart
-           {:key (str "pc-" id)}
+           {}
            (comp/pie
-             {:key               (str "pp-" id)
+             {:key               (str "pie-" id)
               :data              data
               :dataKey           "value"
               :isAnimationActive false
@@ -25,14 +25,11 @@
              (map-indexed
                (fn [index item]
                  (comp/cell {:fill (:color item)
-                             :key  (str "pce-" id "-" index)})) data)
+                             :key  (str "pie-cell-" id "-" index)})) data)
              (comp/re-label
-               {:key      (str "pl-" id)
-                :width    30
+               {:width    30
                 :position "center"} label))
            (when tooltip
-             (comp/tooltip-chart
-               (merge tooltip
-                      {:key (str "pt-" id)})))))])))
+             (comp/tooltip-chart tooltip))))])))


fix atom embedded in code errors on compile

--- src/clojure/zensols/actioncli/util.clj
+++ src/clojure/zensols/actioncli/util.clj
@@ -61,7 +61,7 @@
   (let [args (java.util.LinkedList. arg-list)
         mres (transient {})]
     (if (and (.peek args)
-             (= (type (.peek args))) java.lang.String)
+             (= (type (.peek args)) java.lang.String))
       (assoc! mres :doc (.pop args)))
     (if (empty? args)
       (-> (format "Missing [params*] argument list: %s" arg-list)
@@ -82,12 +82,10 @@

   The result it saves is kept in the metadata under key `:init-resource`."
   [name & args]
-  (let [init-inst (atom nil)
-        {:keys [doc args forms]} (parse-macro-arguments args)]
-    `(do
-       (def ^:private monitor# (Object.))
-       (def ^:private init-inst# ~init-inst)
-       (defn ~(vary-meta name assoc :init-resource init-inst :doc doc) ~args
+  (let [{:keys [doc args forms]} (parse-macro-arguments args)]
+    `(let [init-inst# (atom nil)
+           monitor# (Object.)]
+       (defn ~(vary-meta name assoc :doc doc) ~args
          (letfn [(create-fn# ~args
                    (do ~@forms))]
            (let [res# (volatile! nil)]
@@ -102,7 +100,9 @@
                (do (log/debug "reusing prime result")
                    (deref res#))
                (do (log/debug "no prime result, calling now")
-                   (apply create-fn# ~args)))))))))
+                   (apply create-fn# ~args))))))
+       (alter-meta! (var ~name) assoc :init-resource init-inst#)
+       (var ~name))))

 (defmacro def-lockres
   "Just like `defn` but create an atom instance used to generate the result
@@ -115,22 +115,22 @@

   The result it saves is kept in the metadata under key `:init-resource`."
   [name & args]
-  (let [init-inst (atom nil)
-        {:keys [doc args forms]} (parse-macro-arguments args)]
-    `(do
-       (def ^:private monitor# (Object.))
-       (def ^:private init-inst# ~init-inst)
-       (defn ~(vary-meta name assoc :init-resource init-inst :doc doc) ~args
+  (let [{:keys [doc args forms]} (parse-macro-arguments args)]
+    `(let [init-inst# (atom nil)
+           monitor# (Object.)]
+       (defn ~(vary-meta name assoc :doc doc) ~args
          (let [res# (volatile! nil)
                res-name# ~name]
            (log/debugf "fetching resource: %s" res-name#)
-           (locking monitor#
+           (locking init-inst#
              (when-not (deref init-inst#)
                (log/debugf "creating resource: %s" res-name#)
                (swap! init-inst#
                       #(or % (do ~@forms)))
                (log/debug "create resource")))
-           (deref init-inst#))))))
+           (deref init-inst#)))
+       (alter-meta! (var ~name) assoc :init-resource init-inst#)
+       (var ~name))))

 (doseq [var-fn [#'def-prime #'def-lockres]]
   (alter-meta! var-fn assoc


Changed definition of compound?

Changed definition of compound?

which now uses seq?.

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/dl/framework/syntax.clj
+++ src/conexp/contrib/dl/framework/syntax.clj
@@ -125,8 +125,7 @@
   "Returns true iff given expression is a compound expression."
   [dl-expression]
   (let [expr (expression dl-expression)]
-    (or (list? expr)
-	(instance? clojure.lang.Cons expr))))
+    (seq? expr)))

 (defn atomic?
   "Returns true iff given expression is an atomic expression."


clean domain name and clean list

clean domain name and clean list

--- src/ads_txt_crawler/domains.clj
+++ src/ads_txt_crawler/domains.clj
@@ -23,31 +23,39 @@
    (clojure.string/starts-with? line "#")
    (clojure.string/blank? line))))

-(defn clean-domain-name
+(defn clean-name
+  "Clean a domain name into a proper format:
+
+  - Trim leading and trailing whitespace
+  - Remove http[s]:// prefixes
+  - Remove www. prefixes
+  - Lower case"
   [domain]
-  ;; - trim leading and trailing whitespace
-  ;; - remove http[s]:// prefixes
-  ;; - remove www. prefixes
-  ;; - lower case
   (-> domain
       (clojure.string/lower-case)
       (clojure.string/trim)
       (hostname)
       (strip-www)))

-(defn read-domain-file [fname]
-  ;; read file and return list of non-commented lines
-  ;; - remove commented lines
+(defn read-file
+  "Read file of domaain names. Ignore blank lines and commentted lines.
+  Clean remaining domain names into the proper format"
+  [fname]
   (with-open [r (clojure.java.io/reader fname)]
     (doall
      (->> (line-seq r)
           (filter ignore-line)
-          (map clean-domain-name)))))
+          (map clean-name)))))

-(defn domains
-  "For a given file read it's list of domain names and return them"
-  [fname]
-  (read-domain-file fname))
+(defn clean-list
+  "For a given list of domains clean them into the proper format"
+  [domains]
+  (map clean-name domains))
+
+;; (defn domains
+;;   "For a given file read it's list of domain names and return them"
+;;   [fname]
+;;   (read-domain-file fname))


Remove unnecessary refer

Remove unnecessary refer

--- src/github_changelog/schema_generators.clj
+++ src/github_changelog/schema_generators.clj
@@ -1,6 +1,6 @@
 (ns github-changelog.schema-generators
   (:require [github-changelog.schema :as schema]
-            [clojure.string :refer [join upper-case]]
+            [clojure.string :refer [join]]
             [schema.experimental.generators :as gen]
             [clojure.test.check.generators :as check-generators]))


cleanup

cleanup

--- src/babel/francais/grammar.cljc
+++ src/babel/francais/grammar.cljc
@@ -7,7 +7,7 @@
    [babel.francais.lexicon :as lexicon :refer [lexicon]]
    [babel.francais.morphology :as morph :refer [fo]]
    [babel.generate :as generate :refer [lightning-bolts]]
-   [babel.index :refer [build-lex-sch-index create-indices lookup-spec]]
+   [babel.index :refer [create-indices lookup-spec]]
    [babel.lexiconfn :refer [read-lexicon]]
    [babel.parse :as parse]
    [babel.ug :refer [comp-modifies-head comp-specs-head head-principle


whitespace

whitespace

--- src/babel/francais/lexicon.cljc
+++ src/babel/francais/lexicon.cljc
@@ -115,7 +115,6 @@
    (default {:synsem {:cat :verb}
              :d-verb-reg-present true
              :français {:present {:regular true}}})
-

    ;; Prevent irregular infinitives ({:present :regular false})
    ;; from matching phrase structure rules intended for non-infinitives.


added ballare

added ballare

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -13,18 +13,18 @@
    [dag_unify.core :refer [fail? get-in merge]]))

 (def lexicon-source
-  {"Antonia"
-   {:synsem {:sem {:pred :antonia
+  {"Luisa"
+   {:synsem {:sem {:pred :luisa
                    :human true}
              :agr {:number :sing
                    :person :3rd
                    :gender :fem}
              :propernoun true}}
-   "Antonio"
+   "Gianluca"
    {:synsem {:agr {:number :sing
                    :person :3rd
                    :gender :masc}
-             :sem {:pred :antonio
+             :sem {:pred :gianluca
                    :human true}
              :propernoun true}}
    "a"
@@ -123,10 +123,9 @@
    "aggiungere" {:synsem {:cat :verb
                           :sem {:pred :add}}}
    "aiutare"
-   {:synsem {:cat :verb
-             :essere false
-             :sem {:pred :aiutare
-                   :activity true
+    {:synsem {:essere false
+              :sem {:pred :aiutare
+                    :activity true
                     :obj {:human true}}}}
    "alto"
    [;; non-comparative:
@@ -354,6 +353,10 @@
                                 :agr agr-of-subj-of-main-verb
                                 :subcat {:1 {:agr agr-of-subj-of-main-verb}
                                          :2 '()}}}}}))])
+
+   "ballare" [ {:synsem {:cat :verb
+                            :sem {:pred :dance}}}
+
    "bello"
    [;; non-comparative
     (unify adjective
@@ -524,9 +527,11 @@
                           :pet true
                           :pred :cane}}})

+
    "capire" {:italiano {:boot-stem1 "capisc"}
              :synsem {:cat :verb
                       :sem {:pred :understand}}}
+
    "casa"
     (unify agreement-noun
            common-noun
@@ -652,19 +657,17 @@
                    (merge common
                           {:synsem {:cat :verb
                                     :sem {:pred :strike}}})])
-   "cominciare"
-   [{:synsem {:cat :verb
-              :essere false
-              :sem {:activity true
-                    :discrete false
-                    :pred :begin
-                    :subj {:animate true}}}}
-    {:synsem {:cat :verb
-              :essere false
-              :sem {:activity true
-                    :discrete false
-                    :pred :start
-                    :subj {:animate true}}}}]
+      "cominciare"
+      [{:synsem {:essere false
+                          :sem {:activity true
+                                :discrete false
+                                :pred :begin
+                                :subj {:animate true}}}}
+       {:synsem {:essere false
+                 :sem {:activity true
+                       :discrete false
+                       :pred :start
+                       :subj {:animate true}}}}]
       "compito"
       (unify agreement-noun
              common-noun
@@ -785,21 +788,19 @@
       "dei"
       {:synsem {:cat :det
                 :def :partitivo
-                :agr {:gender :masc
-                      :number :plur}}}
+                :number :plur
+                :gender :masc}}

       "delle"
       {:synsem {:cat :det
                 :def :partitivo
                 :number :plur
-                :agr {:gender :fem
-                      :number :plur}}}
+                :gender :fem}}

       "deludere"
        {:italiano {:passato "deluso"}
-        :synsem {:cat :verb
-                 :essere false
+        :synsem {:essere false
                  :sem {:deliberate false
                        :discrete true
                        :activity false
@@ -829,22 +830,22 @@
       "di la"
       {:synsem {:cat :det
                 :def :partitivo
-                :agr {:gender :fem
-                      :number :sing}
-                :mass true}}
+                :number :sing
+                :mass true
+                :gender :fem}}

       "di le"
       {:synsem {:cat :det
                 :def :partitivo
-                :agr {:gender :fem
-                      :number :plur}}}
+                :number :plur
+                :gender :fem}}

       "di il"
       {:synsem {:cat :det
                 :def :partitivo
-                :agr {:gender :masc
-                      :number :sing}
-                :mass true}}
+                :number :sing
+                :mass true
+                :gender :masc}}

       "difficile"
       ;; non-comparative
@@ -906,12 +907,13 @@

       "donna"
       (unify agreement-noun
-             common-noun
-             countable-noun
-             feminine-noun
-             {:synsem {:sem {:human true
-                             :pred :donna
-                             :child false}}})
+              common-noun
+              countable-noun
+              feminine-noun
+              {:synsem {:sem {:human true
+                              :pred :donna
+                              :child false}}})
+
       "dopodomani"
       (unify sentential-adverb
               {:synsem {:cat :sent-modifier
@@ -919,6 +921,7 @@
                         :subcat {:1 {:infl :future
                                      :sem {:tense :future}
                                      :subcat '()}}}})
+
       "dormire"
       {:synsem {:cat :verb
                 :essere false
@@ -1077,9 +1080,9 @@
                                   :2plur "fate"
                                   :3plur "fanno"}}}]
         [(merge shared-part-of-fare
-                {:synsem {:sem {:pred :do}}})
+                {:synsem {:pred :do}})
          (merge shared-part-of-fare
-                {:synsem {:sem {:pred :make}}})
+                {:synsem {:pred :make}})
          (merge shared-part-of-fare
                 (let [subject-semantics (atom {:human true})
                       subject-agr (atom :top)]
@@ -1166,14 +1169,16 @@
       (unify determiner
              {:synsem {:cat :det
                        :def :def
-                       :agr {:gender :masc
-                             :number :plur}}})
+                       :gender :masc
+                       :number :plur}})
+
+
       "il"
       (unify determiner
               {:synsem {:cat :det
                         :def :def
-                        :agr {:number :sing
-                              :gender :masc}}})
+                        :gender :masc
+                        :number :sing}})

       "imparare"  {:synsem {:cat :verb
                             :sem {:pred :learn}}}
@@ -1260,30 +1265,30 @@
        ;; 3. article
        {:synsem {:cat :det
                  :def :def
-                 :agr {:gender :fem
-                       :number :sing}}}]
+                 :gender :fem
+                 :number :sing}}]
+
       "la loro"
       {:synsem {:cat :det
                 :def :possessive
-                :agr {:gender :fem
-                      :number :sing}
+                :gender :fem
+                :number :sing
                 :sem {:number :plur
                       :person :3rd}}}

       "la mia"
       {:synsem {:cat :det
                 :def :possessive
-                :agr {:gender :fem
-                      :number :sing}
+                :gender :fem
+                :number :sing
                 :sem {:number :sing
                       :person :1st}}}

       "la nostra"
       {:synsem {:cat :det
                 :def :possessive
+                :gender :fem
                 :number :sing
-                :agr {:gender :fem
-                      :number :sing}
                 :sem {:number :plur
                       :person :1st}}}

@@ -1292,30 +1297,25 @@
    "la sua"
    {:synsem {:cat :det
              :def :possessive
-             :agr {:gender :fem
-                   :person :3rd
-                   :number :sing}
+             :gender :fem
+             :number :sing
              :sem {:number :sing
                    :person :3rd}}}
    "la tua"
    [{:synsem {:cat :det
               :def :possessive
-              :agr {:gender :fem
-                    :person :2nd
-                    :number :sing}
+              :gender :fem
               :number :sing
               :sem {:number :sing
                     :person :2nd}}}
-    {:synsem {:cat :noun
-              :case :acc
-              :pronoun true
+
+    {:synsem {:cat :det
               :def :possessive
-              :agr {:gender :fem
-                    :person :2nd
-                    :number :sing}
-              :sem {:number :sing
-                    :person :2nd}}}]
-
+              :gender :fem
+              :number :sing
+                :sem {:number :plur
+                      :person :2nd}}}]
+
    "lavarsi" (let [subject-semantics (atom :top)
                    subject-agr (atom :top)]
               {:synsem {:cat :verb
@@ -1337,8 +1337,8 @@
    "le"
    {:synsem {:cat :det
              :def :def
-             :agr {:gender :fem
-                   :number :plur}}}
+             :gender :fem
+             :number :plur}}
    "lei"
    (let [common {:synsem {:cat :noun
                           :pronoun true
@@ -1641,11 +1641,11 @@
                                :2plur "potete"
                                :3plur "possono"}}}]
      [(merge shared-part-of-potere
-             {:synsem {:sem {:pred :can}}})
+             {:synsem {:pred :can}})
       (merge shared-part-of-potere
-             {:synsem {:sem {:pred :may}}})
+             {:synsem {:pred :may}})
       (merge shared-part-of-potere
-             {:synsem {:sem {:pred :be-able-to}}})])
+             {:synsem {:pred :be-able-to}})])

    "prendere" {:synsem {:cat :verb :sem {:pred :grab}}
                :italiano {:passato "preso"}}
@@ -1670,7 +1670,7 @@
    {:synsem {:cat :det
              :def :indef
              :mass false
-             :agr {:number :sing}}}
+             :number :sing}}

    "racontare" {:synsem {:cat :verb
                          :sem {:pred :recount}}}
@@ -1691,13 +1691,13 @@
    "ricordare"  {:synsem {:cat :verb
                           :sem {:pred :ricordare}}}

-   "rimanere" {:synsem {:cat :verb
-                        :essere true
-                        :sem {:pred :remain}}
-               :italiano {:passato "rimasto"
-                          :present {:1sing "rimango"
-                                    :3plur "rimangono"}
-                          :future-stem "rimarr"}}
+"rimanere" {:synsem {:cat :verb
+                      :essere true
+                      :sem {:pred :remain}}
+             :italiano {:passato "rimasto"
+                        :present {:1sing "rimango"
+                                  :3plur "rimangono"}
+                        :future-stem "rimarr"}}

    "riposare" {:synsem {:cat :verb
                         :sem {:pred :rest}}}
@@ -1925,17 +1925,17 @@
               :subcat '()}}]

    "un"
-   {:synsem {:cat :det
-             :def :indef
-             :mass false
-             :agr {:number :sing
-                   :gender :masc}}}
+   [{:synsem {:cat :det
+              :def :indef
+              :mass false
+              :gender :masc
+              :number :sing}}]
    "una"
-   {:synsem {:cat :det
-             :def :indef
-             :mass false
-             :agr {:number :sing
-                   :gender :fem}}}
+   [{:synsem {:cat :det
+              :def :indef
+              :mass false
+              :gender :fem
+              :number :sing}}]

    "usare"  {:synsem {:cat :verb
                       :sem {:pred :usare}}}


Use `defonce` instead of `def`

Use `defonce` instead of `def`

Fixes navigation breaking when hot code reloading.

--- src/leiningen/new/re_frame/src/routes.cljs
+++ src/leiningen/new/re_frame/src/routes.cljs
@@ -26,7 +26,7 @@
   (let [panel (keyword (str (name (:handler route)) "-panel"))]
     (re-frame/dispatch [::events/set-active-panel panel])))

-(def history
+(defonce history
   (pushy/pushy dispatch parse))

 (defn navigate!


Add -f flag to recursive GNUGPHOME rm

Add -f flag to recursive GNUGPHOME rm

...otherwise the build sometimes failed due to a race condition of files
disappearing between reading the dir listing and deleting them. But we
don't really care as long as they're all gone by the end.

--- src/docker_clojure/dockerfile/lein.clj
+++ src/docker_clojure/dockerfile/lein.clj
@@ -45,7 +45,7 @@
            "echo \"Verifying file PGP signature...\""
            "gpg --batch --verify leiningen-$LEIN_VERSION-standalone.$FILENAME_EXT.asc leiningen-$LEIN_VERSION-standalone.$FILENAME_EXT"
            "gpgconf --kill all"
-           "rm -r \"$GNUPGHOME\" leiningen-$LEIN_VERSION-standalone.$FILENAME_EXT.asc"
+           "rm -rf \"$GNUPGHOME\" leiningen-$LEIN_VERSION-standalone.$FILENAME_EXT.asc"
            "mkdir -p /usr/share/java"
            "mv leiningen-$LEIN_VERSION-standalone.$FILENAME_EXT /usr/share/java/leiningen-$LEIN_VERSION-standalone.jar"]
           (empty? uninstall-dep-cmds))


Refine marhsaling of ints for MessagePack

- explicitly handle BigInt and BigInteger
- boundary (+ and -) is 2^63
- write strings outside the boundary

--- src/transit/write.clj
+++ src/transit/write.clj
@@ -150,7 +150,7 @@
   (flush-writer [^JsonGenerator jg _] (.flush jg))
   (prefers-strings [_] true))

-(def MSGPACK_INT_MAX (Math/pow 2 64))
+(def MSGPACK_INT_MAX (Math/pow 2 63))
 (def MSGPACK_INT_MIN (- 0 MSGPACK_INT_MAX))

 (extend-protocol Emitter
@@ -164,11 +164,13 @@
   (emit-boolean [^Packer p b as-map-key cache] (.write p b))

   (emit-integer [^Packer p i as-map-key cache]
-    ;; using Long MAX and MIN because i is passed to write as long
-    ;; should be able to use MSGPACK_INT_MAX/MIN - ???
-    (if (or (string? i) (> i Long/MAX_VALUE) (< i Long/MIN_VALUE))
+    (if (or (string? i) (> i MSGPACK_INT_MIN) (< i MSGPACK_INT_MAX))
       (emit-string p ESC "i" i as-map-key cache)
-      (.write p ^long i)))
+      (if (instance? clojure.lang.BigInt i)
+        (.write p ^BigInteger (biginteger i))
+        (if (instance? BigInteger i)
+          (.write p ^BigInteger i)
+          (.write p (long i))))))

   (emit-double [^Packer p d as-map-key cache] (.write p ^double d))


Transform Facebook auth params to use keys as keywords so that OAuth2 library can retrieve access token@

--- src/checkin/routes/facebook.clj
+++ src/checkin/routes/facebook.clj
@@ -1,5 +1,6 @@
 (ns checkin.routes.facebook
-  (:use compojure.core)
+  (:use [compojure.core]
+        [clojure.walk])
   (:require [clj-oauth2.client :as oauth2]
             [clj-http.client :as client]
             [cheshire.core :as parse]
@@ -29,5 +30,7 @@
   (response/redirect (:uri auth-request)))

 (defn process-auth-response [params]
-  (let [access-token (oauth2/get-access-token facebook-oauth2 params auth-request)]
+  (let [_ (println "auth code received from FB:" (get params "code"))
+        params-as-keys (keywordize-keys params)
+        access-token (oauth2/get-access-token facebook-oauth2 params-as-keys auth-request)]
     (str "Access token is " access-token)))


Add id's to the manga site maps

Add id's to the manga site maps

--- src/clj/comic_reader/scrape.clj
+++ src/clj/comic_reader/scrape.clj
@@ -7,7 +7,8 @@
   [(let [canonical-url "http://mangafox.me"
          manga-url (format "%s/manga/" canonical-url)
          manga-pattern (re-pattern (str manga-url "(.*?)/"))]
-     {:name "Manga Fox"
+     {:id :manga-fox
+      :name "Manga Fox"
       :url manga-url
       :selector [:div.manga_list :ul :li :a]
       :normalize (fn [{[name] :content
@@ -20,7 +21,8 @@
                             second
                             (format "%s/rss/%s.xml" canonical-url)))})
    (let [canonical-url "http://www.mangareader.net/"]
-     {:name "Manga Reader"
+     {:id :manga-reader
+      :name "Manga Reader"
       :url (str canonical-url "alphabetical")
       :selector [:div.series_alpha :ul :li :a]
       :normalize (fn [{[name] :content


Add a test for mixing remote and local connections in a transaction [IMMUTANT-69]

--- integration-tests/apps/tx/src/tx/core.clj
+++ integration-tests/apps/tx/src/tx/core.clj
@@ -7,6 +7,7 @@

 ;;; Create a JMS queue
 (imsg/start "/queue/test")
+(imsg/start "/queue/remote-test")

 ;;; And an Infinispan cache
 (def cache (ic/cache "test"))
@@ -42,6 +43,7 @@
     (ixa/transaction
      (write-thing-to-db {:datasource db} "kiwi")
      (imsg/publish "/queue/test" "kiwi")
+     (imsg/publish "/queue/remote-test" "starfruit" :host "localhost" :port 5445)
      (ic/put cache :a 1)
      (if f (f)))
     (catch Exception _)))
@@ -50,13 +52,15 @@
   (is (= "kiwi" (:name (read-thing-from-db {:datasource db} "kiwi"))))
   (is (= 1 (count-things-in-db {:datasource db})))
   (is (= "kiwi" (imsg/receive "/queue/test")))
+  (is (= "starfruit" (imsg/receive "/queue/remote-test")))
   (is (= 1 (:a cache))))

 (defn verify-transaction-failure [db]
   (is (nil? (read-thing-from-db {:datasource db} "kiwi")))
   (is (= 0 (count-things-in-db {:datasource db})))
   (is (nil? (:a cache)))
-  (is (nil? (imsg/receive "/queue/test" :timeout 2000))))
+  (is (nil? (imsg/receive "/queue/test" :timeout 2000)))
+  (is (nil? (imsg/receive "/queue/remote-test" :timeout 2000))))

 (defn define-tests [db]
   (eval `(let [ds# (var-get (resolve (symbol ~db)))]
@@ -86,4 +90,4 @@
     (apply use-fixtures :each cache-fixture (map #(db-fixture (var-get (resolve (symbol %)))) dbs))
     (doseq [db dbs]
       (define-tests db))
-    (run-tests)))+    (run-tests)))


further investigation needed: run analysis in new thread

--- src/clj_css_analyzer/server.clj
+++ src/clj_css_analyzer/server.clj
@@ -13,28 +13,44 @@
 ;;
 ;; global state
 ;;
-(def mem-store (mem/memory-store))
+(defonce mem-store (mem/memory-store))

-
-
+;
 ; /^(https?:\/\/)?([\da-z\.-]+)\.([a-z\.]{2,6})([\/\w \.-]*)*\/?$/

 (defn analyze![session-key url-map]
-  (println "foo")
-  (let [{css-urls :css
-         html-urls :html} url-map]
+    (.start (Thread.
+             (fn []

-          (println "session is: " session-key)
-          (print "css ")
-          (pprint css-urls)
-          (print "\nhtml ")
-          (pprint html-urls)
+               (def session (atom (.read-session mem-store session-key)))

-          ; do async processing here
+               (println @session)

-          ))
+               #_(while (not @session)
+
+                 (println "no session for " session-key ". Waiting.")
+
+                 (try
+                   (Thread/sleep 1000)
+                   (catch Exception e nil)
+                 )
+                 (reset! session (.read-session mem-store session-key))
+                 )
+
+                 (let [
+                       {css-urls :css
+                     html-urls :html} url-map]
+
+                      (println "lets dance! session-key: " session-key)
+                      ;(print "css ")
+                      ;(pprint css-urls)
+                      ;(print "\nhtml ")
+                      ;(pprint html-urls)
+
+                      )
+                ))))

 (defn- prepare-urls[url-map]
@@ -51,12 +67,17 @@

 (defn analyze-handler [{data :form-params session-data :session session-key :session/key}]
-  (if (:started session-data)
+  (if (:started (:status session-data))
      (status-handler {:session session-data :session/key session-key})
-     (let [status { :started (System/currentTimeMillis) }]
+     (let [status { :started (if (:started session-data)
+                                 (:started session-data)
+                                 (System/currentTimeMillis)) }]
              (->
                  (r/response (json/write-str session-key))
-                 (assoc :session (assoc session-data :status status))))))
+                 (merge {:session (assoc session-data :status status)
+                         :session/key :session/key})
+
+              ))))

 (defn handler [request]
@@ -93,10 +114,9 @@
   (fn [request]
       (let [response (app request)
             session-key (get-session-key request response)]
-
         (if (and (= "/analyze" (:uri request))
                  (not (:started (:status (:session request)))))
-          (analyze! session-key (prepare-urls (:params request))))
+            (analyze! session-key (prepare-urls (:params request))))

           response)))


final push

final push

--- src/cljs/bracketology/core.cljs
+++ src/cljs/bracketology/core.cljs
@@ -5,8 +5,7 @@
 (enable-console-print!)

 (defonce app-state* (atom {:text "Hello FooBar!"
-                           :brackets [
-                                      [[["goo"
+                           :brackets [[[["goo"
                                          "bar"]
                                         ["biz"
                                          "boz"]]
@@ -33,9 +32,7 @@
                                          "boz"]]
                                        [["foo"
                                          "biz"]]
-                                       [["biz"]]]
-                                      ]}))
-
+                                       [["biz"]]]]}))

 (defn game
@@ -48,7 +45,7 @@

 (defn bracket
   [games idx]
-  (println idx)
+  (js/console.log "idx" idx)
   [:ul.col-sm-6
    (for [round (if (even? idx) games (reverse games))]
      ^{:key round}
@@ -60,11 +57,12 @@

 (defn app-view
   [app]
-  [:div.container
-   [:h1 "Bracket"]
-   (for [b (:brackets @app) idx (range (count (:brackets @app)))]
-     ^{:key b}
-     [bracket b idx])])
+  (let [i (atom -1)]
+    [:div.container
+     [:h1 "Bracket"]
+     (for [b (:brackets @app)]
+       ^{:key b}
+       [bracket b (swap! i inc)])]))

 (defn main []


Initialise story item as uncollapsed

Initialise story item as uncollapsed

--- src/cljs/hacker_agent/core.cljs
+++ src/cljs/hacker_agent/core.cljs
@@ -38,7 +38,7 @@

 (defn story [data]
   (let [local (atom {:collapse? false
-                     :collapse-comments? false})]
+                     :collapse-comments? true})]
     (fn [data]
       (let [{:keys [id by title kids type time url score]} data]
         (when id


Back should go home even if you came straight to the board.

--- src/cljs/retroboard/client.cljs
+++ src/cljs/retroboard/client.cljs
@@ -460,6 +460,11 @@
                     :title (str (:user-count app) " people are in this board")}
                (:user-count app)))))

+(defn back-or-home []
+  (if (empty? (.-referrer js/document))
+    (set! (.-location js/document) "/")
+    (.back js/history)))
+
 (defn view [app owner]
   (reify
     om/IInitState
@@ -495,7 +500,7 @@
                      (dom/div #js {:className "board"}
                               (dom/div #js {:id "header"}
                                        (dom/span #js {:id "back"
-                                                      :onClick #(.back js/history)})
+                                                      :onClick back-or-home})
                                        (om/build create-column-button (:connection app))
                                        (om/build user-count-view (:state app))
                                        (om/build copy-url-view nil))


Remove "A" from end of file.

Remove "A" from end of file.

--- src/clojure/clj_chess/game.cljc
+++ src/clojure/clj_chess/game.cljc
@@ -857,5 +857,4 @@
                         :pgn))]
        (if (= format :pgn)
          (map #(from-ecn % :san true) (pgn/games-in-file file-name))
-         (map #(from-ecn % :san false) (ecn/games-in-file file-name))))))
-A+         (map #(from-ecn % :san false) (ecn/games-in-file file-name))))))


fix getting the client ip when behind a load balancer

--- src/clojure_web_app/handler.clj
+++ src/clojure_web_app/handler.clj
@@ -8,11 +8,14 @@
             [ring.util.response :refer [response status]]
             [compojure.route :as route]
             [clojure.data.json :as json]
+            [clojure.string :as str]
             [clojure.java.io :as io]
             [ring.adapter.jetty :as jetty]
             [clj-http.client :as client]
             [environ.core :refer [env]]
             [ring.middleware.defaults :refer [wrap-defaults site-defaults]]))
+
+(def production (or (env :production) false))

 (defn location-by-ip [ip]
   (json/read-str ((client/get (format "http://freegeoip.net/json/%s" ip)) :body) :key-fn keyword))
@@ -32,10 +35,14 @@
            (GET "/print-query-params" [& args] (response args))
            (GET "/cheapest-near-me" [limit distance fuel]
              (fn [request]
-               (let [location (location-by-ip (:remote-addr request))]
+               (let [location (location-by-ip (if production
+                                                ((:headers request) "http_x_forwarded_for")
+                                                (:remote-addr request)))]
                  (response (nearby-fuel-prices (location :latitude) (location :longitude) limit distance fuel)))))
            (GET "/my-location" []
-             (fn [request] (response (location-by-ip (:remote-addr request)))))
+             (fn [request] (response (location-by-ip (if production
+                                                       ((:headers request) "http_x_forwarded_for")
+                                                       (:remote-addr request))))))
            (GET "/my-ip" []
              (fn [request]
                {:status 200


more aliases in core

more aliases in core

--- src/com/billpiel/sayid/core.clj
+++ src/com/billpiel/sayid/core.clj
@@ -84,6 +84,7 @@
 (defmacro ws-add-trace-fn!
   [fn-sym]
   `(ws-add-trace-fn!* (util/fully-qualify-sym '~fn-sym)))
+(util/defalias-macro w-atf! ws-add-trace-fn!)

 (defn ws-add-deep-trace-fn!*
   "`fn-sym` is a symbol that references an existing function. Applies an
@@ -98,6 +99,7 @@
 (defmacro ws-add-deep-trace-fn!
   [fn-sym]
   `(ws-add-deep-trace-fn!* (util/fully-qualify-sym '~fn-sym)))
+(util/defalias-macro w-adtf! ws-add-deep-trace-fn!)

 (defn ws-add-trace-ns!*
   "`ns-sym` is a symbol that references an existing namespace. Applies an enabled
@@ -294,13 +296,13 @@
 (defn ws-print
   [& [ws]]
   (#'com.billpiel.sayid.string-output/print-tree (or ws
-                                                          (ws-deref!))))
-(util/defalias w-print ws-print)
+                                                     (ws-deref!))))
+(util/defalias w-pr ws-print)

 (defn rec-print
   [& [rec]]
   (#'com.billpiel.sayid.string-output/print-tree (or rec
-                                                          @recording)))
-(util/defalias r-print rec-print)
+                                                     @recording)))
+(util/defalias r-pr rec-print)

 ;; === END String Output functions


fixed exsception on invalid json

fixed exsception on invalid json

--- src/io/sarnowski/swagger1st/parser.clj
+++ src/io/sarnowski/swagger1st/parser.clj
@@ -84,8 +84,8 @@
         (try
           (deserialize-fn (:body request))
           (catch Exception e
-            (throw (ex-info ("Malformed body. (" (str e)) {:http-code    400
-                                                           :content-type content-type}))))
+            (throw (ex-info (str "Malformed body. (" (str e)) {:http-code    400
+                                                               :content-type content-type}))))
         ; TODO check during setup
         (throw-value-error nil parameter-definition [(get parameter-definition "in") (get parameter-definition "name")] "its content-type is not supported"))
       (throw (ex-info "Content type not allowed."


Limit the number of reactions per entry for render using config/max-reaction-count.

--- src/oc/storage/representations/content.clj
+++ src/oc/storage/representations/content.clj
@@ -93,8 +93,8 @@
                                  (group-by :reaction reactions)) ; reactions grouped by unicode character
         counted-reactions-map (map-kv count grouped-reactions) ; how many for each character?
         counted-reactions (map #(vec [% (get counted-reactions-map %)]) (keys counted-reactions-map)) ; map -> sequence
-        top-three-reactions (take 3 (sort-by reaction-selection-sort counted-reactions)) ; top 3 reactions
-        sorted-reactions (sort-by reaction-order-sort top-three-reactions)] ; top 3 sorted
+        all-reactions (take config/max-reaction-count (sort-by reaction-selection-sort counted-reactions)) ; top 3 reactions
+        sorted-reactions (sort-by reaction-order-sort all-reactions)] ; top 3 sorted
     (map #(reaction-and-link org-uuid board-uuid resource-uuid (first %) (last %)
             (some (fn [reaction] (= user-id (-> reaction :author :user-id))) ; the user left one of these reactions?
               (get grouped-reactions (first %))))


Got both voices working.

Got both voices working.

--- src/overtunes/songs/canone_alla_quarta.clj
+++ src/overtunes/songs/canone_alla_quarta.clj
@@ -28,6 +28,7 @@
      (sum-n (cycle intervals) %)))

 (defn translate [f x y] #(-> % (+ x) f (+ y)))
+(defn shift [f x] (connect #(+ x %) f))
 (def major (scale [2 2 1 2 2 2 1]))
 (def g-major (translate major 0 74))

@@ -58,18 +59,18 @@
     (dorun (map play-at (:time notes) (:pitch notes)))))

 (defn update [k f] #(update-in % [k] f))
-(def mirror (update :pitch #(connect % -)))
-(defn echo [beats] (update :time #(translate % 0 beats)))
-(defn transpose [interval] (update :pitch #(translate % interval 0)))
-(def canone-alla-quarta (reduce connect [(echo 3) (transpose -3) mirror]))
+(def mirror (update :pitch #(connect - %)))
+(defn after [beats] (update :time #(shift % beats)))
+(defn transpose [interval] (update :pitch #(shift % interval)))
+(def canone-alla-quarta (reduce connect [(after 3) (transpose -3) mirror]))

 (defn play# []
   (let [from-now #(translate % 0 (now))
         beat (from-now (bpm 120))
-        with-beat #(update-in % [:time] (partial connect beat))
-        in-key #(update-in % [:pitch] (partial connect g-major))
-        leader (-> melody with-beat in-key)]
-  ;(-> leader canone-alla-quarta melody#)))
-  (-> leader melody#)))
+        with-beat (update :time (partial connect beat))
+        in-key (update :pitch (partial connect g-major))]
+    (-> melody canone-alla-quarta in-key with-beat melody#)
+    (-> melody in-key with-beat melody#)
+    ))

 (play#)


Made some functions in c.c.retracts private

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/contrib/retracts.clj
+++ src/conexp/contrib/retracts.clj
@@ -8,20 +8,20 @@
 		       make-context,
 		       set-of)]))

-(defn homomorphism-by-csc
+(defn- homomorphism-by-csc
   "Returns the homomorphisms obtained by resticting every concept to the
   given compatible subcontext. (csc == compatible subcontext)"
   [subcontext]
   (fn [concept]
     (restrict-concept concept subcontext)))

-(defn homomorphisms-by-cscs
+(defn- homomorphisms-by-cscs
   "Returns all homomorphisms originating from compatible
   subcontexts. context has to be reduced."
   [context]
   (map homomorphism-by-csc (compatible-subcontexts context)))

-(defn endofunctions-as-hash ; name is misleading
+(defn- endofunctions-as-hash ; name is misleading
   "Given a homomorphisms which has been obtained by a compatible
   subcontext this function computes a hash representing all
   endofunctions of context originating from this homomorphism. The
@@ -33,7 +33,7 @@
 	  {}
 	  (concepts context)))

-(defn endofunctions-from-hash ; name is misleading
+(defn- endofunctions-from-hash ; name is misleading
   "Computes all endofunctions (as a hash) in endo-hash."
   [endo-hash]
   (let [runner (fn runner [func rem]
@@ -46,12 +46,12 @@
 		       fun))))]
     (runner {} (seq endo-hash))))

-(defn endofunctions-by-homomorphism ; name is misleading
+(defn- endofunctions-by-homomorphism ; name is misleading
   "Returns all endofunctions obtained by homomorphism."
   [context hom]
   (endofunctions-from-hash (endofunctions-as-hash context hom)))

-(defn retract?
+(defn- retract?
   "Tests whether given concept endofunction, given as hash-map, is a
   retract of context or not."
   [context endo]


more info in #briefing entry

more info in #briefing entry

--- src/cljs/iwaswhere_web/ui/entry/briefing.cljs
+++ src/cljs/iwaswhere_web/ui/entry/briefing.cljs
@@ -35,7 +35,7 @@
            [:div "Logged: " [:strong dur] " in " (:total day-stats) " entries."]
            [:hr]
            [:svg
-            {:viewBox (str "0 0 300 10")}
+            {:viewBox (str "0 0 300 15")}
             [:g (for [[book {:keys [x v]}] time-by-book]
                   (let [w (* y-scale v)
                         x (* y-scale x)
@@ -45,7 +45,7 @@
                             :y       0
                             :x       x
                             :width   w
-                            :height  10}]))]]
+                            :height  15}]))]]
            (for [[book v] (:time-by-book day-stats)]
              (let [book-name (or (:book-name (get books book)) "No book")]
                ^{:key book}
@@ -55,7 +55,7 @@
                 [:strong book-name] ": " (u/duration-string v)]))
            [:hr]
            [:svg
-            {:viewBox (str "0 0 300 10")}
+            {:viewBox (str "0 0 300 15")}
             [:g (for [[story {:keys [x v]}] time-by-story]
                   (let [w (* y-scale v)
                         x (* y-scale x)
@@ -65,7 +65,7 @@
                             :y       0
                             :x       x
                             :width   w
-                            :height  10}]))]]
+                            :height  15}]))]]
            (for [[story v] (:time-by-story day-stats)]
              (let [story-name (or (:story-name (get stories story)) "No story")]
                ^{:key story}
@@ -77,6 +77,7 @@
 (defn briefing-view
   [entry put-fn edit-mode?]
   (let [chart-data (subscribe [:chart-data])
+        stats (subscribe [:stats])
         input-fn
         (fn [entry]
           (fn [ev]
@@ -96,7 +97,9 @@
                     daily-summary-stats media-stats]} @chart-data
             day (-> entry :briefing :day)
             day-stats (get pomodoro-stats day)
-            {:keys [tasks-cnt done-cnt closed-cnt]} (get task-stats day)]
+            word-stats (get wordcount-stats day)
+            {:keys [tasks-cnt done-cnt closed-cnt]} (get task-stats day)
+            started (:started-tasks-cnt @stats)]
         (when (contains? (:tags entry) "#briefing")
           [:form.task-details
            [:fieldset
@@ -112,4 +115,8 @@
                "Tasks: " [:strong tasks-cnt] " created, "
                [:strong done-cnt] " done, "
                [:strong closed-cnt] " closed"])
+            (when word-stats
+              [:div
+               [:strong (:started-tasks-cnt @stats)] " started tasks, "
+               [:strong (:word-count word-stats)] " words written." ])
             (when day-stats [time-by-stories-list day-stats])]])))))


Fix typo

Fix typo

--- src/restaurant_inspections_api/schemas.clj
+++ src/restaurant_inspections_api/schemas.clj
@@ -166,7 +166,7 @@
                                         :parameters {:query {(s/optional-key :countyNumber) s/Int
                                                               (s/optional-key :zipCodes) s/Str
                                                               (s/optional-key :perPage) s/Int
-                                                              (s/optional-ket :page) s/Int}}
+                                                              (s/optional-key :page) s/Int}}
                                         :summary "Get all businesses"}}

                    "/businesses/:licenseNumber" {:get {:responses {200 {:schema Business


default port for test-model-session

default port for test-model-session

--- src/er_cassandra/model/alia/model_session.clj
+++ src/er_cassandra/model/alia/model_session.clj
@@ -1,6 +1,7 @@
 (ns er-cassandra.model.alia.model-session
   (:require
    [plumbing.core :refer :all]
+   [environ.core :refer [env]]
    [er-cassandra.session :as s]
    [er-cassandra.session.alia :as a]
    [er-cassandra.model.model-session :as ms
@@ -138,7 +139,9 @@
            (merge
             args
             {:contact-points (or contact-points ["localhost"])
-             :port (or port 9042)
+             :port (or port
+                       (some-> (env :cassandra-port) Integer/parseInt)
+                       9042)
              :datacenter datacenter
              :init-statements
              [(str "CREATE KEYSPACE IF NOT EXISTS "


Hint key comparisons. Inline arguments to key comparisons.

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -41,7 +41,7 @@
               1)))
         0))))

-(defn prefix-not= [as bs max-len]
+(defn ^boolean prefix-not= [as bs max-len]
   (loop [i 0]
     (if (< i max-len)
       (let [a (aget as i)
@@ -51,22 +51,22 @@
           true))
       false)))

-(defn key= [as bs]
+(defn ^boolean key= [as bs]
   (== 0 (key-compare as bs)))

-(defn key-not= [as bs]
+(defn ^boolean key-not= [as bs]
   (not (== 0 (key-compare as bs))))

-(defn key-lt [as bs]
+(defn ^boolean key-lt [as bs]
   (== -1 (key-compare as bs)))

-(defn key-gt [as bs]
+(defn ^boolean key-gt [as bs]
   (== 1 (key-compare as bs)))

-(defn key-lte [as bs]
+(defn ^boolean key-lte [as bs]
   (not (== 1 (key-compare as bs))))

-(defn key-gte [as bs]
+(defn ^boolean key-gte [as bs]
   (not (== -1 (key-compare as bs))))

 ;; TREES
@@ -360,31 +360,29 @@
               start-ix ix]
           (when (false? end?)
             (loop []
-              (let [upper (.-upper node)]
-                (if (key-lt upper key)
-                  (if (instance? Node (.-parent node))
+              (if (key-lt (.-upper node) key)
+                (if (instance? Node (.-parent node))
+                  (do
+                    (set! ix (.-parent-ix node))
+                    (set! node (.-parent node))
+                    (recur))
+                  (set! end? true))
+                (loop []
+                  (set! ix (.seek node key ix))
+                  (if (>= ix (alength (.-keys node)))
                     (do
-                      (set! ix (.-parent-ix node))
-                      (set! node (.-parent node))
+                      (set! node (aget (.-children node) ix))
+                      (set! ix 0)
                       (recur))
-                    (set! end? true))
-                  (loop []
-                    (set! ix (.seek node key ix))
-                    (if (>= ix (alength (.-keys node)))
+                    (if (or (and (identical? node start-node) (== ix start-ix))
+                            (key= key (aget (.-keys node) ix))
+                            (nil? (.-children node))
+                            (key-lt (.-upper (aget (.-children node) ix)) key))
+                      nil
                       (do
                         (set! node (aget (.-children node) ix))
                         (set! ix 0)
-                        (recur))
-                      (if (or (and (identical? node start-node) (== ix start-ix))
-                              (key= key (aget (.-keys node) ix))
-                              (nil? (.-children node))
-                              (let [lower (.-upper (aget (.-children node) ix))]
-                                (key-lt lower key)))
-                        nil
-                        (do
-                          (set! node (aget (.-children node) ix))
-                          (set! ix 0)
-                          (recur)))))))))))
+                        (recur))))))))))
   (undo [this]
         (set! node old-node)
         (set! ix old-ix)


Some more vector op optimizations

Some more vector op optimizations

--- src/brevis/vector.clj
+++ src/brevis/vector.clj
@@ -52,10 +52,24 @@
    [^Vector4f v1 ^Vector4f v2] (Vector4f/sub v1 v2 nil))

 (defn div
-  "Divide a Vector3f by a scalar."
+  "Divide a vector by a scalar."
   [v s]
   (let [vr (if (vec3? v) ^Vector3f (Vector3f. v) ^Vector4f (Vector4f. v))]
     (.scale vr (double (/ s)))
+    vr))
+
+(defn div-vec3
+  "Divide a Vector3f by a scalar."
+  [v s]
+  (let [^Vector3f vr (Vector3f. v)]
+    (.scale vr ^double (double (/ s)))
+    vr))
+
+(defn div-vec4
+  "Divide a Vector4f by a scalar."
+  [v s]
+  (let [^Vector4f vr (Vector4f. v)]
+    (.scale vr ^double (double (/ s)))
     vr))

 (defn add
@@ -81,6 +95,20 @@
     (.scale vr (double s))
     vr))

+(defn mul-vec3
+  "Multiply a Vector3f by a scalar."
+  [v s]
+  (let [^Vector3f vr (Vector3f. v)]
+    (.scale vr ^double (double s))
+    vr))
+
+(defn mul-vec4
+  "Multiply a Vector4f by a scalar."
+  [v s]
+  (let [^Vector4f vr (Vector4f. v)]
+    (.scale vr ^double (double s))
+    vr))
+
 (defn elmul
   "Multiply a Vector3f by a scalar."
   [v w]
@@ -88,6 +116,24 @@
     (.setX vr (double (* (.x w) (.x v))))
     (.setY vr (double (* (.y w) (.y v))))
     (.setZ vr (double (* (.z w) (.z v))))
+    vr))
+
+(defn elmul-vec3
+  "Multiply a Vector3f by a scalar."
+  [^Vector3f v ^Vector3f w]
+  (let [^Vector3f vr (Vector3f. v)]
+    (.setX vr ^double (double (* (.x w) (.x v))))
+    (.setY vr ^double (double (* (.y w) (.y v))))
+    (.setZ vr ^double (double (* (.z w) (.z v))))
+    vr))
+
+(defn elmul-vec4
+  "Multiply a Vector3f by a scalar."
+  [^Vector4f v ^Vector4f w]
+  (let [^Vector4f vr (Vector4f. v)]
+    (.setX vr ^double (double (* (.x w) (.x v))))
+    (.setY vr ^double (double (* (.y w) (.y v))))
+    (.setZ vr ^double (double (* (.z w) (.z v))))
     vr))

 (defn dot


Remove require of now removed bytes ns.

Remove require of now removed bytes ns.

--- src/bytebuf/spec.cljx
+++ src/bytebuf/spec.cljx
@@ -1,8 +1,7 @@
 (ns bytebuf.spec
   (:refer-clojure :exclude [type read float double long short byte bytes])
   (:require [bytebuf.proto :as proto :refer [IStaticSize]]
-            [bytebuf.buffer :as buffer]
-            [bytebuf.bytes :as bytes]))
+            [bytebuf.buffer :as buffer]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Abstraction definition


add border-crossing condition for score function

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -44,13 +44,17 @@
        (for [angle [1 nrows (dec nrows) (inc nrows)]]
          ;; Count length of
          (count
-          (for [dir [- +] ;; in both directions
+          (for [dir [- +]                       ;; in both directions
                 j (reductions + (repeat angle)) ;; straight line
                 :let [k (dir i j)]
                 ;; while position is
                 :while (and
                         ;; on the board
                         (<= 0 k (dec (* ncols nrows)))
+                        ;; hasn't crossed a border
+                        (not=
+                         (mod k nrows)
+                         (case dir + 0 - (dec nrows)))
                         ;; the symbol as the candidate
                         (= cand (state-val k)))]
             true)))


Fix aggregation with complex WHERE bug

Fix aggregation with complex WHERE bug

aggregation maps are now serialized to EDN before storing in the DB

--- src/cfpb/qu/cache.clj
+++ src/cfpb/qu/cache.clj
@@ -14,7 +14,8 @@
             [cfpb.qu.data.aggregation :as agg]
             [clojure.string :as str]
             [clojure.core.cache :as cache :refer [defcache]]
-            [clj-time.core :refer [now]]
+            [clj-time.core :refer [now]]
+            [clojure.edn :as edn]
             [lonocloud.synthread :as ->]
             [monger
              [core :as mongo :refer [with-db get-db]]
@@ -176,7 +177,7 @@
   "Given a map-reduce job, tells Mongo to perform the job.
    Returns true on success, false on failure."
   [worker job]
-  (add-to-cache (:cache worker) (:aggmap job)))
+  (add-to-cache (:cache worker) (edn/read-string (:aggmap job))))

 (defn- update-cache
   "Update the query cache to reflect that the map-reduce job is
@@ -184,12 +185,13 @@

   Returns updated record."
   [worker job]
-  (let [cache (:cache worker)]
+  (let [cache (:cache worker)
+        aggmap (edn/read-string (:aggmap job))]
     (coll/update *work-collection*
                  {:_id (:_id job)}
                  {"$set" {:status "processed"
                           :finished (now)}})
-    (touch-cache cache (get-in job [:aggmap :query]))))
+    (touch-cache cache (:query aggmap))))

 (defn- process-next-job
   [worker]
@@ -224,7 +226,7 @@
       (coll/insert-and-return *work-collection* {:_id (:to aggmap)
                                                  :status "unprocessed"
                                                  :created (now)
-                                                 :aggmap aggmap})
+                                                 :aggmap (pr-str aggmap)})
       (catch MongoException$DuplicateKey e
         (coll/find-map-by-id *work-collection* (:to aggmap))))))


generate-stream returns a BufferedWriter

Update the type hint to match the actual return type.

--- src/cheshire/core.clj
+++ src/cheshire/core.clj
@@ -36,7 +36,7 @@
      (.flush generator)
      (.toString sw))))

-(defn ^String generate-stream
+(defn ^BufferedWriter generate-stream
   "Returns a BufferedWriter for the given Clojure object with the JSON-encoded
   data written to the writer. Takes an optional date format string that Date
   objects will be encoded with.


add k8s config

add k8s config

--- src/ci3/repo/core.clj
+++ src/ci3/repo/core.clj
@@ -5,7 +5,8 @@
             [ci3.repo.github :as github]
             [ci3.k8s :as k8s]
             [unifn.core :as u]
-            [clojure.tools.logging :as log]))
+            [clojure.tools.logging :as log]
+            [unifn.env :as e]))

 (defmethod u/*fn
   ::load-repo
@@ -50,11 +51,15 @@
   {:ci3.repo.core/build
    (clojure.walk/keywordize-keys (k8s/create cfg :builds build))})

+(defmethod u/*fn ::init [arg] {:k8s k8s/cfg})
+
 (defmethod u/*fn
   ::webhook
   [arg]
   (u/*apply
-   [::load-repo
+   [::init
+    ::e/env
+    ::load-repo
     ::mk-build-name
     ::mk-build
     ::create-build


* src/clj/cljs/core.clj: fix satisfies

* src/clj/cljs/core.clj: fix satisfies

Signed-off-by: fogus <d91a03199f4a73d6265d5e01d9b8326f801668cb@gmail.com>

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -249,7 +249,7 @@
   (let [p (:name (cljs.compiler/resolve-var (dissoc &env :locals) psym))
         prefix (protocol-prefix p)]
     `(let [x# ~x]
-       (if (and x# (. x# ~(symbol prefix)))
+       (if (and x# (. x# ~(symbol prefix)) (not (. x# (~'hasOwnProperty ~prefix))))
 	 true
 	 (cljs.core/type_satisfies_ ~psym x#)))))


need to pass the entire original error value so that REPLs can easily do host target specific parsing

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -106,9 +106,10 @@
   (-repl-options [_] nil))

 (defprotocol IParseStacktrace
-  (-parse-stacktrace [repl-env stacktrace build-options]
-    "Given the original JavaScript stacktrace string and current compiler build
-     options, parse the stacktrace into the canonical form:
+  (-parse-stacktrace [repl-env stacktrace error build-options]
+    "Given the original JavaScript stacktrace string, the entire original error
+     value and current compiler build options, parse the stacktrace into the
+     canonical form:

      [{:file <string>
        :function <string>
@@ -273,7 +274,7 @@
       (if (and (true? (:source-map opts))
                (satisfies? IParseStacktrace repl-env))
         (print-mapped-stacktrace
-          (-parse-stacktrace repl-env st opts) opts)
+          (-parse-stacktrace repl-env st ret opts) opts)
         (println st))
       (flush))))


working `cljs.test/run-tests` macro

working `cljs.test/run-tests` macro

--- src/clj/cljs/test.clj
+++ src/clj/cljs/test.clj
@@ -225,15 +225,21 @@
              (fn [[quote ns]] (and (= quote 'quote) (symbol? ns)))
              namespaces)
      "All arguments to run-tests must be quoted symbols")
-   `(let [summary# (apply merge-with +
-                     [~@(map
-                          (fn [ns]
-                            `(cljs.test/test-ns
-                               (assoc ~env :return true) ~ns))
-                          namespaces)])]
-      (do-report summary#
-        (assoc (:report-counters summary#) :type :summary))
-      summary#)))
+   (let [env-sym (gensym "env")]
+     `(let [~env-sym (assoc ~env :return true)
+            summary# (reduce
+                       (fn [acc# res#]
+                         (merge-with +
+                           acc#
+                           (:report-counters res#)))
+                       {:test 0 :pass 0 :fail 0 :error 0}
+                       [~@(map
+                            (fn [ns]
+                              `(cljs.test/test-ns ~env-sym ~ns))
+                            namespaces)])]
+        (do-report ~env-sym
+          (assoc summary# :type :summary))
+        summary#))))

 (defmacro run-all-tests
   "Runs all tests in all namespaces; prints results.


CLJS-749: In cases where *clojurescript-version* is unbound (as when running from source), return empty string from (clojurescript-version) instead of ".".

--- src/clj/cljs/util.clj
+++ src/clj/cljs/util.clj
@@ -17,16 +17,18 @@
 (defn clojurescript-version
   "Returns clojurescript version as a printable string."
   []
-  (str
-    (:major *clojurescript-version*)
-    "."
-    (:minor *clojurescript-version*)
-    (when-let [i (:incremental *clojurescript-version*)]
-      (str "." i))
-    (when-let [q (:qualifier *clojurescript-version*)]
-      (str "-" q))
-    (when (:interim *clojurescript-version*)
-      "-SNAPSHOT")))
+  (if (bound? #'*clojurescript-version*)
+    (str
+     (:major *clojurescript-version*)
+     "."
+     (:minor *clojurescript-version*)
+     (when-let [i (:incremental *clojurescript-version*)]
+       (str "." i))
+     (when-let [q (:qualifier *clojurescript-version*)]
+       (str "-" q))
+     (when (:interim *clojurescript-version*)
+       "-SNAPSHOT"))
+    ""))

 (defn compiled-by-version [^File f]
   (with-open [reader (io/reader f)]


Fix for trash-bonus.

Fix for trash-bonus.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -403,8 +403,8 @@
 (defn trash-cost-bonus [state side n]
   (swap! state update-in [:bonus :trash] (fnil #(+ % n) 0)))

-(defn trash-cost [state side {:keys [cost] :as card}]
-  (-> cost
+(defn trash-cost [state side {:keys [trash] :as card}]
+  (-> trash
       (+ (or (get-in @state [:bonus :trash]) 0))
       (max 0)))

@@ -613,6 +613,7 @@

 (defn handle-access [state side cards]
   (swap! state assoc :access true)
+  (swap! state update-in [:bonus] dissoc :trash)
   (doseq [c cards]
     (let [cdef (card-def c)
           c (assoc c :seen true)]
@@ -620,7 +621,8 @@
         (when-let [access-effect (:access cdef)]
           (resolve-ability state (to-keyword (:side c)) access-effect c nil))
         (when (not= (:zone c) [:discard])
-          (if-let [trash-cost (trash-cost state side (:trash c))]
+          (trigger-event state side :pre-trash c)
+          (if-let [trash-cost (trash-cost state side c)]
             (let [card (assoc c :seen true)]
               (optional-ability state :runner card (str "Pay " trash-cost "[Credits] to trash " name "?")
                                 {:cost [:credit trash-cost]


Re-add support for specifying CookieStore in `*cookie-store*`

Relates to #318

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -166,6 +166,8 @@
 (def proxy-move-with-body (make-proxy-method-with-body :move))
 (def proxy-patch-with-body (make-proxy-method-with-body :patch))

+(def ^:dynamic *cookie-store* nil)
+
 (defn make-proxy-method [method url]
   (doto (proxy [HttpRequestBase] []
           (getMethod
@@ -273,8 +275,8 @@
                                   request-method http-url body)]
     (when-not (conn/reusable? conn-mgr)
       (.addHeader http-req "Connection" "close"))
-    (when cookie-store
-      (.setCookieStore context cookie-store))
+    (when-let [cookie-jar (or cookie-store *cookie-store*)]
+      (.setCookieStore context cookie-jar))
     (when-let [[user pass] digest-auth]
       (.setCredentialsProvider
        context


Add missing brace

Add missing brace

--- src/cljs/app/app.cljs
+++ src/cljs/app/app.cljs
@@ -92,7 +92,7 @@
                                        result-map)]])})

 (deftemplate result-cards "templates/results.html" []
-  {[:.card] (kioo/content (map result-card (get-in @state [:results :_source])}))})
+  {[:.card] (kioo/content (map result-card (get-in @state [:results :_source])))})

 (deftemplate page "index.html" []
   {[:.results] (kioo/content (result-cards))})


link greasing now honours server and port

--- src/complico/core.clj
+++ src/complico/core.clj
@@ -6,21 +6,21 @@
             [clj-http.client :as client]))

 ; make a http request to url and download the body as string
-(defn make-get-request [url]
+(defn request-url-page [url]
   (:body (client/get url)))

-(def link-greasing-js
-"
-")
+(defn create-link-greasing-js [server port]
+  (str "
+  "))

 (def start-page-html
   "Show prices")
@@ -32,8 +32,8 @@
     start-page-html)
   (GET "/test_page_with_prices" []
     price-page-html)
-  (GET "/convert" {params :query-params}
-    (str (make-get-request (params "url")) link-greasing-js)))
+  (GET "/convert" {params :query-params server :server-name port :server-port}
+    (str (request-url-page (params "url")) (create-link-greasing-js server port))))

 ; needed to gain access to query parameters in my-handler
 (def app


It's more natural to use reduce than apply.

--- src/overtunes/songs/row_row_row_your_boat.clj
+++ src/overtunes/songs/row_row_row_your_boat.clj
@@ -3,7 +3,7 @@
     [overtone.live :only [at now]]
     [overtone.inst.sampled-piano :only [sampled-piano]]))

-(defn sum-up-to [series n] (apply + (take n series)))
+(defn sum-up-to [series n] (reduce + (take n series)))
 (def major-scale #(sum-up-to (cycle [2 2 1 2 2 2 1]) %))
 (def g-major #(-> % major-scale (+ 67)))


Futures

Futures

Futures in make-unscored-baby and one-seasonal-cycle

--- src/simple_symbolic_regression_clojure/gp.clj
+++ src/simple_symbolic_regression_clojure/gp.clj
@@ -121,11 +121,11 @@
 (defn make-unscored-baby
   "creates a new *unscored* Individual by sampling a population (with uniform probability) and applying one-pt crossover and mutation"
   [population mutation-rate]
-  (let [mom (:script (rand-nth population))
-        dad (:script (rand-nth population))
+  (let [mom (future (:script (rand-nth population)))
+        dad (future (:script (rand-nth population)))
         crossover (if (< (rand) 0.5) one-point-crossover uniform-crossover)
         baby-script (uniform-mutation
-                     (crossover mom dad)
+                     (crossover @mom @dad)
                      token-generator
                      mutation-rate)]
     (make-individual baby-script)))
@@ -134,12 +134,12 @@
 (defn one-seasonal-cycle
   "doubles the population size by calling `make-baby`, sorts the entire population by score (worse is bigger), removes the worst-scoring ones"
   [population mutation-rate rubrics]
-  (let [carrying-capacity (count population)
+  (let [carrying-capacity (future (count population))
         new-brood (repeatedly
-                    carrying-capacity
+                    @carrying-capacity
                     #(make-unscored-baby population mutation-rate))
         scored-brood (score-population new-brood rubrics)]
-    (take carrying-capacity (sort-by get-score (concat population scored-brood)))
+    (take @carrying-capacity (sort-by get-score (concat population scored-brood)))
     ))

@@ -154,7 +154,7 @@
   a list containing all the Individuals with the lowest non-nil score;
   if no Individual has been scored, it returns an empty list"
   [individuals]
-  (let [scored-ones (filter #(some? (get-score %)) individuals)
-        best (get-score (first (sort-by get-score scored-ones)))]
-    (filter #(= best (get-score %)) scored-ones)
+  (let [scored-ones (future (filter #(some? (get-score %)) individuals))
+        best (get-score (first (sort-by get-score @scored-ones)))]
+    (filter #(= best (get-score %)) @scored-ones)
   ))


Hotfix #71: worker errors terminate worker loop

This is mostly an issue for transient connection errors. The new behaviour is more robust
and will retry indefinitely after an exponential backoff.

--- src/taoensso/carmine/message_queue.clj
+++ src/taoensso/carmine/message_queue.clj
@@ -336,23 +336,36 @@
             qk (partial qkey qname)
             start-polling-loop!
             (fn []
-              (try
-                (while @running?
-                  (let [[poll-reply ndruns mid-circle-size]
-                        (wcar conn (dequeue qname opts)
-                                   (car/get  (qk :ndry-runs))
-                                   (car/llen (qk :mid-circle)))]
-
-                    (when monitor (monitor {:mid-circle-size mid-circle-size
-                                            :ndry-runs       (or ndruns 0)
-                                            :poll-reply      poll-reply}))
-
-                    (if (= poll-reply "eoq-backoff")
-                      (Thread/sleep (max (wcar conn (car/pttl (qk :eoq-backoff?)))
-                                         10))
-                      (handle1 conn qname handler poll-reply)))
-                  (when throttle-ms (Thread/sleep throttle-ms)))
-                (catch Throwable t (timbre/fatalf t "Worker error!") (throw t))))]
+              (loop [nerrors 0]
+                (when @running?
+                  (let [?error
+                        (try
+                          (let [[poll-reply ndruns mid-circle-size]
+                                (wcar conn (dequeue qname opts)
+                                           (car/get  (qk :ndry-runs))
+                                           (car/llen (qk :mid-circle)))]
+
+                            (when monitor
+                              (monitor {:mid-circle-size mid-circle-size
+                                        :ndry-runs       (or ndruns 0)
+                                        :poll-reply      poll-reply}))
+
+                            (if (= poll-reply "eoq-backoff")
+                              (Thread/sleep
+                               (max (wcar conn (car/pttl (qk :eoq-backoff?)))
+                                    10))
+                              (handle1 conn qname handler poll-reply))
+
+                            (when throttle-ms (Thread/sleep throttle-ms)))
+                          nil ; Successful worker loop
+                          (catch Throwable t t))]
+
+                    (if-not ?error (recur 0)
+                      (let [t ?error]
+                        (timbre/errorf t "Worker error! Will backoff & retry.")
+                        (Thread/sleep (exp-backoff (inc nerrors)))
+                        (recur (inc nerrors))))))))]
+
         (dorun (repeatedly nthreads (fn [] (future (start-polling-loop!))))))
       true)))


Use server side num icons value on icons dashboard page.

--- src/uxbox/main/ui/dashboard/icons.cljs
+++ src/uxbox/main/ui/dashboard/icons.cljs
@@ -130,11 +130,11 @@

 (mx/defc nav-item
   {:mixins [mx/static mx/reactive]}
-  [{:keys [id type name] :as coll} selected?]
+  [{:keys [id type name num-icons] :as coll} selected?]
   (letfn [(on-click [event]
             (let [type (or type :own)]
               (rs/emit! (di/select-collection type id))))]
-    (let [num-icons (react-count-icons id)]
+    (let [num-icons (or num-icons (react-count-icons id))]
       [:li {:on-click on-click
             :class-name (when selected? "current")}
        [:span.element-title
@@ -290,10 +290,10 @@

 (mx/defc menu
   {:mixins [mx/static mx/reactive]}
-  [state {:keys [id] :as coll}]
+  [state {:keys [id num-icons] :as coll}]
   (let [ordering (:order state :name)
         filtering (:filter state "")
-        num-icons (react-count-icons id)]
+        num-icons (or num-icons (react-count-icons id))]
     (letfn [(on-term-change [event]
               (let [term (-> (dom/get-target event)
                              (dom/get-value))]


return empty string instead of nil

return empty string instead of nil

--- src/vignette/storage/static_assets.clj
+++ src/vignette/storage/static_assets.clj
@@ -7,7 +7,7 @@
 (defn- parse-content-disp
   [header]
   (when-let [m (if header (re-find #"(?i)filename=\"(.*)\"" header))]
-    (second m)))
+    (or (second m) "")))

 (defrecord AsyncResponseStoredObject [response] StoredObjectProtocol
   (file-stream [this] (-> this :response :body))