CMR-1759: Added a test.

CMR-1759: Added a test.

--- system-int-test/test/cmr/system_int_test/search/collection_temporal_search_test.clj
+++ system-int-test/test/cmr/system_int_test/search/collection_temporal_search_test.clj
@@ -191,6 +191,12 @@
           {:temporal {:start_date "2010-13-12T12:00:00" :end_date "2011-13-12T12:00:00"}}
           {"end_date" "2011-13-12T12:00:00" "start_date" "2010-13-12T12:00:00"}))

+  (testing "search by empty temporal"
+    (let [{:keys [status errors]} (search/find-refs-with-json-query :collection {} {:temporal {}})]
+      (is (= 400 status))
+      (is (= "/condition/temporal object has too few properties (found 0 but schema requires at least 1)"
+             (first errors)))))
+
   (testing "search by invalid exclude_boundary format"
     (let [{:keys [status errors]} (search/find-refs-with-json-query :collection {} {:temporal {:exclude_boundary "false"}})]
       (is (= 400 status))


Handle all unhandled exceptions.

Handle all unhandled exceptions.

--- src/clj/hatnik/web/server/handler.clj
+++ src/clj/hatnik/web/server/handler.clj
@@ -85,6 +85,15 @@
       (monger-store (mg/get-db conn db) "sessions"))
     (memory-store)))

+(defn wrap-exceptions [handler]
+  (fn [req]
+    (try
+      (handler req)
+      (catch Exception e
+        (timbre/error e)
+        (resp/response {:result :error
+                        :message "Something bad happened on server"})))))
+
 (def app
   (-> #'app-routes
       dump-request
@@ -92,9 +101,9 @@
                                               :max-age (* 60 60 24 14)
                                               :http-only true}
                                :store (get-session-store)}})
+      wrap-exceptions
       (json/wrap-json-body {:keywords? true})
-      json/wrap-json-response
-      stacktrace/wrap-stacktrace))
+      json/wrap-json-response))

 (comment


No need to flood the log with every conrad note we add.

--- src/clj/qualityclj/linters/conrad.clj
+++ src/clj/qualityclj/linters/conrad.clj
@@ -10,7 +10,6 @@
 (defn- add-note
   "Add a note from conrad to the database."
   [note repo-path]
-  (info "Adding note: " note)
   (let [path (s/replace-first (:filename note)
                               (re-pattern (str ".*" repo-path "/")) "")]
     (db/add-note path (:line-num note) (:message note) :conrad)))


rework update propagation

rework update propagation

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -307,22 +307,21 @@
        (map before-save-item)
        (mapv #(update-item storage %))))

-(defn- process-dereferenced-accounts
-  "Finds any accounts that used to be referenced by the transaction
-  but no longer are and recalculates balances and indexes for those
-  accounts"
+(defn- dereferenced-accounts
+  "Given an existing transaction and an update of the
+  same transaction, returns the IDs of the accounts
+  that were referenced in the original but are not
+  referenced now"
+  [existing updated]
+  (apply difference (map #(->> (:items %)
+                               (map :account-id)
+                               (into #{}))
+                         [existing updated])))
+
+(defn reload
+  "Returns an updated copy of the transaction"
   [storage-spec transaction]
-  (let [old-trans (find-by-id storage-spec (:id transaction))
-        old-accounts (->> (:items old-trans)
-                          (map :account-id)
-                          (into #{}))
-        current-accounts (->> (:items transaction)
-                              (map :account-id)
-                              (into #{}))]
-    (->> (difference old-accounts current-accounts)
-         (map #(hash-map :account-id % :id -1)) ; fake out an item because that's what get-previous-item expects
-         (map #(get-previous-item storage-spec % (:transaction-date transaction)))
-         (update-affected-balances storage-spec))))
+  (find-by-id storage-spec (:id transaction)))

 (defn update
   "Updates the specified transaction"
@@ -331,15 +330,22 @@
         validated (validate Transaction transaction)]
     (if (validation/has-error? validated)
       validated
-      (let [items-with-balances (calculate-balances-and-indexes storage
+      (let [existing-trans (reload storage transaction)
+            dereferenced-account-ids (dereferenced-accounts
+                                       existing-trans
+                                       validated)
+            dereferenced-base-items (->> dereferenced-account-ids
+                                         (map #(hash-map :account-id % :id -1)) ; fake out an item because that's what get-previous-item expects
+                                         (map #(get-previous-item storage-spec % (:transaction-date transaction))))
+            items-with-balances (calculate-balances-and-indexes storage
                                                                 (:transaction-date validated)
-                                                                (:items validated))
-            _ (process-dereferenced-accounts storage validated) ; this relies on old values still being in the database
-            _ (update-affected-balances storage
-                                        items-with-balances
-                                        (:transaction-date validated))
-            processed-items (process-item-updates storage items-with-balances)]
-        (assoc validated [:items] processed-items)))))
+                                                                (:items validated))]
+        (process-item-updates storage items-with-balances)
+        (update-affected-balances storage
+                                  (concat items-with-balances
+                                          dereferenced-base-items)
+                                  (:transaction-date validated))
+        (reload storage validated)))))

 (defn- get-preceding-items
   "Returns the items that precede each item in the
@@ -366,8 +372,3 @@
     (delete-transaction-items-by-transaction-id storage transaction-id)
     (delete-transaction storage transaction-id)
     (update-affected-balances storage preceding-items)))
-
-(defn reload
-  "Returns an updated copy of the transaction"
-  [storage-spec transaction]
-  (find-by-id storage-spec (:id transaction)))


remove redundant/dead code

remove redundant/dead code

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -239,61 +239,6 @@
        :index -1
        :balance 0M}))

-(defn- process-item-balance-and-index
-  "Accepts a context containing
-    :previous-index   - The index of the previous item
-    :previous-balance - The balance of the previous item
-    :items            - The items processed so far
-    :storage          - Storage service
-
-  Returns the context with these updates
-    :previous-index   - updated to the index of the item just processed
-    :previous-balance - updated to the balance of the item just processed
-    :items            - appended with the item just processed
-    :storage          - Unchanged storage service"
-  [context item]
-  (let [next-index (+ 1 (:previous-index context))
-        account (accounts/find-by-id (:storage context) (:account-id item)) ; TODO: remove redundant calls to find the account
-        polarized-amount (accounts/polarize-amount item account)
-        next-balance (+ (:previous-balance context) polarized-amount)
-        updated-item (-> item
-                         (assoc :balance next-balance
-                                :index next-index))]
-    (-> context
-        (assoc :previous-index next-index
-               :previous-balance next-balance)
-        (update-in [:items] #(conj % updated-item)))))
-
-(defn- add-item-balance-and-index
-  "Updates the specified items, which belong to the specified account
-  with new balance and index values"
-  [storage [account-id items]]
-  (let [sorted-items (sort-by :index items)
-        previous-item (get-previous-item storage (first sorted-items))
-        previous-balance (or (get previous-item :balance)
-                             (bigdec 0))
-        previous-index (or (get previous-item :index) -1)]
-    (:items (reduce process-item-balance-and-index
-                    {:previous-index previous-index
-                     :previous-balance previous-balance
-                     :items []
-                     :storage storage}
-                    sorted-items))))
-
-(defn- subsequent-items
-  "Returns items in the specified account on or after the specified
-  transaction date, excluding the reference-item"
-  ([storage-spec reference-item]
-   (with-storage [s storage-spec]
-     (->> (select-transaction-items
-            s
-            {:account-id (:account-id reference-item)
-             :index [:>= (:index reference-item)]
-             :transaction-date [:>= (:transaction-date reference-item)]}
-            {:sort [[:index :asc]]})
-          (remove #(= (:id reference-item) (:id %)))
-          (map after-item-read)))))
-
 (defn find-item-by-id
   [storage-spec id transaction-date]
   (first (select-transaction-items storage-spec
@@ -320,53 +265,6 @@
                                     s
                                     (before-save-item item)))]
       (> records-affected 0))))
-
-(defn- calculate-item-index-and-balance
-  "Accepts a transaction item and a context containing
-    :index   - a transaction item index
-    :balance - a transaction item balance
-    :storage - service used to communicate with the data store
-
-  Calculates the new index and balance for the item and updates
-  them in the data store
-
-  Returns a context containing
-    :index   - the new index
-    :balance - the new balance
-    :storage - unchanged
-
-  This is done in the context of updating existing transaction
-  items that are affected by a new or updated transaction"
-  [{:keys [index balance storage]} item]
-  (let [new-index (+ 1 index)
-        account (accounts/find-by-id storage (:account-id item)) ; TODO: remove redundant calls to find the account
-        polarized-amount (accounts/polarize-amount item account)
-        new-balance (+ balance polarized-amount)
-        value-changed (update-item-index-and-balance storage (assoc item
-                                                                    :index new-index
-                                                                    :balance new-balance))
-        result {:index new-index
-                :balance new-balance
-                :storage storage}]
-    (if value-changed
-      result
-      (-> result
-          (assoc ::skip-account-update true)
-          reduced))))
-
-(defn- update-affected-balances
-  "Updates transaction items and corresponding accounts that
-  succeed the specified items"
-  [storage-spec items transaction-date]
-  (doseq [[account-id items] (group-by :account-id items)]
-    (let [last-item (last items) ; these should already be sorted
-          account (accounts/find-by-id storage-spec account-id)
-          subsequent-items (subsequent-items storage-spec last-item)
-          final (reduce calculate-item-index-and-balance
-                        (assoc last-item :storage storage-spec)
-                        subsequent-items)]
-      (when-not (::skip-account-update final)
-        (accounts/update storage-spec (assoc account :balance (:balance final)))))))

 (declare reload)
 (defn- no-reconciled-items-changed?
@@ -495,17 +393,6 @@
   ([storage-spec criteria options]
    (with-storage [s storage-spec]
      (map after-item-read (select-transaction-items s criteria options)))))
-
-; TODO: This should be lazy
-(defn- account-items-after
-  "Returns the items in the specified account
-  that occur on or after the specified date"
-  [storage account-id date index]
-  (search-items storage
-                {:account-id account-id
-                 :transaction-date [:>= date]
-                 :index [:> index]}
-                {:sort [:transaction-date :index]}))

 (defn- recalculate-account-item
   "Accepts a processing context and an item, updates
@@ -531,16 +418,21 @@
           (dissoc :last-balance)
           reduced))))

-(defn- recalculate-account-items
+(defn recalculate-account-items
   "Accepts a tuple containing an account-id and a base item,
   selects all subsequent items and recalculates the items until
   all item for the account have been recalculated or until
   a balance is unchanged.
   Returns the new balance of the account of the balance changed,
   or nil if te balance didn't change."
-  [storage {:keys [account-id transaction-date index balance id]}]
+  [storage {:keys [account-id transaction-date index balance id] :as item}]
   (let [account (accounts/find-by-id storage account-id)
-        items (account-items-after storage account-id transaction-date index)
+        items (search-items storage
+                            (cond-> {:account-id account-id
+                                     :index [:> index]}
+                              transaction-date
+                              (assoc :transaction-date [:>= transaction-date]))
+                            {:sort [:transaction-date :index]})
         result (reduce recalculate-account-item
                        {:account account
                         :storage storage
@@ -549,17 +441,6 @@
                        (remove #(= id (:id %)) items))]
     (when-let [last-balance (:last-balance result)]
       (accounts/update storage (assoc account :balance last-balance)))))
-
-; At this point, there should only be one item
-; per account
-(defn- recalculate-items
-  "Accepts a list of transaction items that precede a given
-  transaction. Base items are items have the correct index
-  and balance values that will serve as the basis for
-  calculating the indexes and balances of the items
-  that follow."
-  [storage base-items]
-  (mapv #(recalculate-account-items storage %) base-items))

 (defn- link-lots
   [storage transaction]
@@ -597,8 +478,8 @@
       (if (validation/has-error? validated)
         validated
         (if (delay-balances? (:entity-id transaction))
-            (create-transaction-without-balances s validated)
-            (create-transaction-and-adjust-balances s validated))))))
+          (create-transaction-without-balances s validated)
+          (create-transaction-and-adjust-balances s validated))))))

 (defn find-by-id
   "Returns the specified transaction"
@@ -849,7 +730,8 @@
           preceding-items (get-preceding-items s transaction)]
       (delete-transaction-items-by-transaction-id s transaction-id transaction-date)
       (delete-transaction s transaction-id transaction-date)
-      (update-affected-balances s preceding-items transaction-date))))
+      (doseq [item preceding-items]
+        (recalculate-account-items s item)))))

 (defn- find-last-item-before
   [storage-spec account-id date]
@@ -895,21 +777,6 @@
     storage-spec
     {:id ids
      :transaction-date (vec (concat [:between] date-range))}))
-
-(defn recalculate-balances
-  "Recalculates balances for the specified account and all
-  related transaction items"
-  [storage-spec account-id]
-  (with-storage [s storage-spec]
-    (let [result (->> {:account-id account-id}
-                      (search-items storage-spec)
-                      (reduce calculate-item-index-and-balance {:index 0
-                                                                :balance 0M
-                                                                :storage s}))]
-      (when-not (::skip-account-update result)
-        (accounts/update storage-spec (-> (accounts/find-by-id s account-id)
-                                          (assoc :balance (:balance result))))))))
-

 (defmacro with-delayed-balancing
   [storage-spec entity-id & body]
@@ -924,8 +791,10 @@
      ~@body

      ; Recalculate balances for affected accounts
-     (doseq [account-id# (get-in @ambient-settings [~entity-id :delayed-account-ids])]
-       (recalculate-balances ~storage-spec account-id#))
+     (->> (get-in @ambient-settings [~entity-id :delayed-account-ids])
+          (map #(hash-map :account-id % :index -1 :balance 0M))
+          (map #(recalculate-account-items ~storage-spec %))
+          doall)

      ; clean up the ambient settings as if we were never here
      (swap! ambient-settings dissoc ~entity-id)))


add coercion to transactions

add coercion to transactions

--- src/clj_money/models/transactions.clj
+++ src/clj_money/models/transactions.clj
@@ -102,12 +102,15 @@
       (string? (:id item))
       (not (empty? (:id item)))) (update-in [:id] #(Integer. %))))

+(def ^:private coercion-rules
+  [(coercion/rule :integer [:id])
+   (coercion/rule :integer [:entity-id])
+   (coercion/rule :local-date [:transaction-date])])
+
 (defn- before-validation
   "Performs operations required before validation"
   [transaction]
-  (-> transaction
-      (update-in [:id] #(when % (Integer. %)))
-      (update-in [:transaction-date] ensure-local-date)
+  (-> (coercion/coerce transaction coercion-rules)
       (update-in [:items] #(map before-item-validation %))))

 (defn- before-save


Fix names duplication in components.

Fix names duplication in components.

--- src/oc/storage/components.clj
+++ src/oc/storage/components.clj
@@ -5,8 +5,8 @@
             [oc.lib.db.pool :as pool]
             [oc.lib.sqs :as sqs]
             [oc.storage.async.notification :as notification]
-            [oc.storage.async.auth-notification :as auth-notification]
-            [oc.storage.async.storage-notification :as storage-notification]
+            [oc.storage.async.auth-notification :as auth-notif]
+            [oc.storage.async.storage-notification :as storage-notif]
             [oc.storage.config :as c]))

 (defrecord HttpKit [options handler]
@@ -79,7 +79,7 @@

   (start [component]
     (timbre/info "[auth-notifcation] starting...")
-    (auth-notification/start component)
+    (auth-notif/start component)
     (timbre/info "[auth-notification] started")
     (assoc component :auth-notification true))

@@ -87,7 +87,7 @@
     (if auth-notification
       (do
         (timbre/info "[auth-notification] stopping...")
-        (auth-notification/stop)
+        (auth-notif/stop)
         (timbre/info "[auth-notification] stopped")
         (dissoc component :auth-notification))
       component)))
@@ -101,11 +101,11 @@
     (timbre/info "[storage-notification] started")
     (assoc component :storage-notification true))

-  (stop [{:keys [auth-notification] :as component}]
-    (if auth-notification
+  (stop [{:keys [storage-notification] :as component}]
+    (if storage-notification
       (do
         (timbre/info "[storage-notification] stopping...")
-        (storage-notification/stop)
+        (storage-notif/stop)
         (timbre/info "[storage-notification] stopped")
         (dissoc component :storage-notification))
       component)))


[#391 #318] PR housekeeping

[#391 #318] PR housekeeping

Changes:

  - Tweaked docstrings.
  - Retain old behaviour of `send-websocket-handshake!` to prevent a breaking
    change for that; new behaviour is instead introduced in a new fn
    (`send-checked-websocket-handshake!`).
  - `with-channel`: move body evaluation *before* websocket handshake
    as per original PR intention.
  - `with-channel`: mention new limitation in docstring.

--- src/org/httpkit/server.clj
+++ src/org/httpkit/server.clj
@@ -161,20 +161,29 @@
 (def accept "DEPRECATED for `sec-websocket-accept" sec-websocket-accept)

 (defn websocket-handshake-check
-  "Returns sec-ws-accept iff received a valid WebSocket request."
+  "Returns `sec-ws-accept` string iff given Ring request is a valid
+  WebSocket handshake."
   [^AsyncChannel ch ring-req]
   (when-let [sec-ws-key (get-in ring-req [:headers "sec-websocket-key"])]
-    (when-let [sec-ws-accept (try (sec-websocket-accept sec-ws-key)
-                                  (catch Exception _))]
-      sec-ws-accept)))
+    (try
+      (sec-websocket-accept sec-ws-key)
+      (catch Exception _ nil))))
+
+(defn send-checked-websocket-handshake!
+  "Given an AsyncChannel and `sec-ws-accept` string, unconditionally
+  sends handshake to upgrade given AsyncChannel to a WebSocket.
+  See also `websocket-handshake-check`."
+  [^AsyncChannel ch ^String sec-ws-accept]
+  (.sendHandshake ch
+    {"Upgrade" "websocket"
+     "Connection" "Upgrade"
+     "Sec-WebSocket-Accept" sec-ws-accept}))

 (defn send-websocket-handshake!
-  "Upgrade to WebSocket connection."
-  [^AsyncChannel ch ^String sec-ws-accept]
-  (.sendHandshake ch
-    {"Upgrade" "websocket"
-     "Connection" "Upgrade"
-     "Sec-WebSocket-Accept" sec-ws-accept}))
+  "Returns true iff successfully upgraded a valid WebSocket request."
+  [^AsyncChannel ch ring-req]
+  (when-let [sec-ws-accept (websocket-handshake-check ch ring-req)]
+    (send-checked-websocket-handshake! ch sec-ws-accept)))

 ;; (defn websocket-req? [ring-req] (:websocket?    ring-req))
 ;; (defn async-channel  [ring-req] (:async-channel ring-req))
@@ -184,6 +193,9 @@
   "Evaluates body with `ch-name` bound to the request's underlying
   asynchronous HTTP or WebSocket channel, and returns {:body AsyncChannel}
   as an implementation detail.
+
+  Note: for WebSocket requests, WebSocket handshake will be sent *after*
+  body is evaluated. I.e. body cannot call `send!`.

   ;; Asynchronous HTTP response (with optional streaming)
   (defn my-async-handler [request]
@@ -223,8 +235,9 @@

      (if (:websocket? ring-req#)
        (if-let [sec-ws-accept# (websocket-handshake-check ~ch-name ring-req#)]
-         (do (send-websocket-handshake! ~ch-name sec-ws-accept#)
-             ~@body
-             {:body ~ch-name})
+         (do
+           ~@body ; Eval body before handshake to allow hooks to be established, Ref. #318
+           (send-checked-websocket-handshake! ~ch-name sec-ws-accept#)
+           {:body ~ch-name})
          {:status 400 :body "Bad Sec-WebSocket-Key header"})
        (do ~@body {:body ~ch-name}))))


Работа над внешним видом

Работа над внешним видом

--- src/ixinfestor/core_web_bootstrap.clj
+++ src/ixinfestor/core_web_bootstrap.clj
@@ -27,8 +27,6 @@
            [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}]
            [:title (:title page-params "Page Title")]

-           (:header-additions page-params nil)
-
            "<!-- HTML5 Shim and Respond.js IE8 support of HTML5 elements and media queries -->"
            "<!-- WARNING: Respond.js doesn't work if you view the page via file:// -->"
            "<!--[if lt IE 9]>"
@@ -43,6 +41,8 @@
            ;;(include-css "/bootstrap/css/bootstrap-theme.min.css")

            (include-js "/bootstrap/js/bootstrap.min.js")
+
+           (:header-additions page-params nil)
            ]
           [:body
            body
@@ -103,9 +103,8 @@
 (defn navbar-header [href title]
   [:div.navbar-header
    [:button.navbar-toggle
-    {:data-target ".navbar-collapse",
-     :data-toggle "collapse",
-     :type        "button"}
+    {:type "button" :class "navbar-toggle collapsed" :data-toggle "collapse"
+     :data-target "#navbar" :aria-expanded "false" :aria-controls "navbar"}
     [:span.sr-only "Toggle navigation"]
     [:span.icon-bar]
     [:span.icon-bar]


Release version 0.10.0.0-beta8.

Release version 0.10.0.0-beta8.

--- project.clj
+++ project.clj
@@ -1,4 +1,4 @@
-(defproject onyx-cheat-sheet "0.10.0.0-SNAPSHOT"
+(defproject onyx-cheat-sheet "0.10.0.0-beta8"
   :description "Cheat sheet for Onyx"
   :url "https://github.com/onyx-platform/onyx-cheat-sheet"
   :license {:name "Eclipse Public License"
@@ -16,7 +16,7 @@
                  [compojure "1.5.2"]
                  [enlive "1.1.6"]
                  ^{:voom {:repo "git@github.com:onyx-platform/onyx.git" :branch "master"}}
-                 [org.onyxplatform/onyx "0.10.0-beta7"]
+                 [org.onyxplatform/onyx "0.10.0-beta8"]
                  [prismatic/om-tools "0.4.0"]
                  [markdown-clj "0.9.94"]
                  [org.omcljs/om "0.9.0"]


Changed from float to bigdec.

Changed from float to bigdec.

--- src/simulacrum/bigfive.clj
+++ src/simulacrum/bigfive.clj
@@ -56,7 +56,7 @@
 (def normalized-compatibility-matrix
   "Convert the compatibilty matrix to one whose values have been normalized."
   (matrix/emap
-    float
+    bigdec
     (div five-point-compatibility-matrix const/max-value)))

 (def questions-base


Warn on reflection

Warn on reflection

--- dungeon-crawler/desktop/src-common/dungeon_crawler/core.clj
+++ dungeon-crawler/desktop/src-common/dungeon_crawler/core.clj
@@ -1,3 +1,5 @@
+(set! *warn-on-reflection* true)
+
 (ns dungeon-crawler.core
   (:require [dungeon-crawler.entities :as e]
             [dungeon-crawler.rooms :as r]


JC | default http-allowed to true

JC | default http-allowed to true

--- src/stonecutter/config.clj
+++ src/stonecutter/config.clj
@@ -1,5 +1,6 @@
 (ns stonecutter.config
-  (:require [environ.core :as env]))
+  (:require [environ.core :as env]
+            [clojure.tools.logging :as log]))

 (defn port []
   (Integer. (get env/env :port "3000")))
@@ -24,4 +25,4 @@
   (get env/env :theme))

 (defn http-allowed? []
-  (= "true" (get env/env :http-allowed)))
+  (= "true" (get env/env :http-allowed "true")))


Handle profile results

Handle profile results

--- src/trak/action_handlers.cljs
+++ src/trak/action_handlers.cljs
@@ -34,5 +34,12 @@
 (defmethod api-result-handler :find-albums [action response *db]
   (utils/info "Action received " action response)
   (when-let [{{{albums :items} :albums} :body} response]
-    (d/transact! *db (json-to-datascript albums :album))))
     (d/transact! *db (db/json-to-datascript albums :album))))
+
+(defmethod api-result-handler :me [action response *db]
+  (utils/info "Action received " action response)
+  (cond
+    (= 401 (:status response)) (d/transact! *db [{:me/identifier :me :me/status :logged-out}])
+    (= 200 (:status response))
+    (d/transact! *db [(merge {:me/identifier :me :me/status :logged-in}
+                             (db/convert-atrrs-to-datascript (:body response) :me))])))


Add todo comment.

Add todo comment.

--- src/uxbox/data/workspace.cljs
+++ src/uxbox/data/workspace.cljs
@@ -225,6 +225,7 @@
                  (when x {:x x})
                  (when y {:y y})))))

+;; TODO: rename fill to "color" for consistency.
 (defn update-shape-fill
   [sid {:keys [fill opacity] :as opts}]
   (sc/validate! +shape-update-fill-schema+ opts)


consolidate grid-drawing logic

consolidate grid-drawing logic

--- src/voke/world/visualize.cljs
+++ src/voke/world/visualize.cljs
@@ -117,16 +117,23 @@
       ::generate/grid
       draw-grid))

+(defn generate-grid-and-draw []
+  (condp = @selected-tab
+    :drunkard (draw-grid ((generate/drunkards-walk grid-width grid-height @num-empty-cells)
+                           ::generate/grid))
+    :automata (draw-automata-grid!)
+    :final (draw-grid ((generate/automata 400 400 0.45 4 5 400000 12)
+                        ::generate/grid))))
+
 ;; Reagent components

-(defn slider [an-atom min max step callback]
+(defn slider [an-atom min max step]
   (let [_ @an-atom]
     [:input {:type      "range" :value @an-atom :min min :max max :step step
              :style     {:width "100%"}
              :on-change (fn [e]
                           (reset! an-atom (js/parseFloat (.-target.value e)))
-                          (when callback
-                            (callback)))}]))
+                          (generate-grid-and-draw))}]))

 (defn tab
   [tab-kw text]
@@ -136,7 +143,7 @@
                 :on-click (fn [e]
                             (.preventDefault e)
                             (reset! selected-tab tab-kw)
-                            (reset-visualization-state!))}
+                            (generate-grid-and-draw))}
    text])

 (defn ui [visualization-state]
@@ -150,35 +157,28 @@
    (when (= @selected-tab :drunkard)
      [:div.drunkard-specific
       [:p (str "Dig until there are " @num-empty-cells " empty cells in the grid")]
-      [slider num-empty-cells 0 1000 50
-       #(draw-grid ((generate/drunkards-walk grid-width grid-height @num-empty-cells)
-                     ::generate/grid))]])
+      [slider num-empty-cells 0 1000 50]])

    (when (= @selected-tab :automata)
      [:div.cellular-specific
       [:p (str "Chance for a given cell to be filled during intialization pass: "
                @initial-fill-chance)]
-      [slider initial-fill-chance 0 1 0.01 draw-automata-grid!]
+      [slider initial-fill-chance 0 1 0.01]
       [:p (str "Mininum # of neighbors for an alive cell to survive: " @min-neighbors-to-survive)]
-      [slider min-neighbors-to-survive 0 8 1 draw-automata-grid!]
+      [slider min-neighbors-to-survive 0 8 1]
       [:p (str "Mininum # of neighbors for a cell to be born: " @min-neighbors-to-birth)]
-      [slider min-neighbors-to-birth 0 8 1 draw-automata-grid!]
+      [slider min-neighbors-to-birth 0 8 1]
       [:p (str "Number of times to apply automata rules to random individual cells: " @num-iterations)]
-      [slider num-iterations 0 40000 5000 draw-automata-grid!]
+      [slider num-iterations 0 40000 5000]
       [:p (str "Number of smoothing passes: " @smoothing-passes)]
-      [slider smoothing-passes 0 12 1 draw-automata-grid!]])
+      [slider smoothing-passes 0 12 1]])

    [:div.button-wrapper
     [:a.generate-button
      {:href     "#"
       :on-click (fn [e]
                   (.preventDefault e)
-                  (condp = @selected-tab
-                    :drunkard (draw-grid ((generate/drunkards-walk grid-width grid-height @num-empty-cells)
-                                           ::generate/grid))
-                    :automata (draw-automata-grid!)
-                    :final (draw-grid ((generate/automata 400 400 0.45 4 5 400000 12)
-                                        ::generate/grid))))}
+                  (generate-grid-and-draw))}
      "generate"]]

    [:canvas {:id     "visualization-canvas"


include species id in packed species

include species id in packed species

--- src/wb_es/web/integration.clj
+++ src/wb_es/web/integration.clj
@@ -12,7 +12,12 @@
   (if species-name
     (let [[genus-name species-name] (clojure.string/split species-name #"\s+" 2)]
       {:genus genus-name
-       :species species-name})))
+       :species species-name
+       :id (format "%s_%s"
+                   (->> genus-name
+                        (first)
+                        (clojure.string/lower-case))
+                   species-name)})))

 (defn- get-obj [doc]
   (let [search-obj (pack-search-obj doc)


Code cleanup

Code cleanup

--- src/video_server/video.clj
+++ src/video_server/video.clj
@@ -109,7 +109,7 @@
   "Returns the video title based on the metadata or filename."
   [container info]
   (title-info (or (-> info :format :title)
-                  (-> container :filename))))
+                  (:filename container))))

 (defn sorting-title
   "Returns a title suitable for sorting."


152 not optimized solution

152 not optimized solution

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -1299,46 +1299,71 @@
          (cons new-num (f (+ lbase base))))))))

 ;;152 Latin Square Slicing
-(defn lsqr? [sq]
-  (let [cnt (count sq)
-        tsq (apply map vector sq)
-        xsq (concat tsq sq)
-        cnts (map #((comp count into) #{} %) xsq)]
-    (and (= cnt (count (reduce into #{} sq)))
-         (every? #(= cnt %) cnts))))
-
-(defn subv
-  ([v lenmax] (map vec (subv v lenmax [])))
-  ([v lenmax res]
-   (let [space " "
-         lenrest (- lenmax (count v))]
-     (if (<= lenrest 0)
-       (conj res v)
-       (subv (concat [space] v)
-             lenmax
-             (conj res (concat v (take lenrest (repeat space)))))))))
-
-(defn superpos [[fst & rst]]
-  (if-not (seq rst)
-    (map list fst)
-    (for [x fst y (superpos rst)] (conj y x))))
-
-(defn maxlen [xs]
-  (apply max (map count xs)))
-
-(defn all-superpos [xs]
-  (let [maxlen (apply max (map count xs))]
-    (->> (map #(subv % maxlen) xs)
-         (superpos)
-         (map vec))))
-
-(defn sqrs-coords [h w]
-  (for [y (range h) l1 (range 2 (- (inc h) y))
-        x (range w) l2 (range 2 (- (inc w) x))
-        :when (= l1 l2)] [y x l1]))
-
-(defn sqr [[y x side] area]
-  (let [sub-area (for [dy (range side) dx (range side)]
-                   (get-in area [(+ y dy) (+ x dx)]))]
-    (->> (partition side sub-area)
-         (mapv vec))))
+(letfn
+    [(latin? [sq]
+       (let [cnt (count sq)
+             tsq (apply map vector sq)
+             xsq (concat tsq sq)
+             cnts (map #((comp count into) #{} %) xsq)]
+         (and (= cnt (count (reduce into #{} sq)))
+              (every? #(= cnt %) cnts))))
+
+     (containsEmpty? [sq]
+       (let [vals (reduce into #{} sq)]
+         (some #(or (= % nil) (= % " ")) vals)))
+
+     (subv
+       ([v lenmax] (map vec (subv v lenmax [])))
+       ([v lenmax res]
+        (let [space " "
+              lenrest (- lenmax (count v))]
+          (if (<= lenrest 0)
+            (conj res v)
+            (subv (concat [space] v)
+                  lenmax
+                  (conj res (concat v (take lenrest (repeat space)))))))))
+
+     (make-superpos [[fst & rst]]
+       (if-not (seq rst)
+         (map list fst)
+         (for [x fst y (make-superpos rst)] (conj y x))))
+
+     (all-superpos [xs]
+       (let [maxlen (apply max (map count xs))]
+         (->> (map #(subv % maxlen) xs)
+              (make-superpos)
+              (map vec))))
+
+     (get-sqr [area y x side]
+       (let [sub-area (for [dy (range side) dx (range side)]
+                        (get-in area [(+ y dy) (+ x dx)]))]
+         (->> (partition side sub-area)
+              (mapv vec))))
+
+     (pos-sqrs
+       ([area y x] (pos-sqrs area y x 2 []))
+       ([area y x side res]
+        (let [sqr (get-sqr area y x side)]
+          (cond
+            (containsEmpty? sqr) res
+            (latin? sqr) (recur area y x (inc side) (conj res sqr))
+            :else (recur area y x (inc side) res)))))
+
+     (all-sqrs [superpos]
+       (->> (for [y (range (count superpos))
+                  x (range (count (first superpos)))
+                  :when (not= (get-in superpos [y x]) " ")]
+              (pos-sqrs superpos y x))
+            (apply concat)))
+     ]
+  (defn deb [xs]
+    (->> (all-superpos xs)
+         (mapcat all-sqrs)
+         (set)))
+  (defn count-latins [xs]
+    (->> (all-superpos xs)
+         (mapcat all-sqrs)
+         (set)
+         (map count)
+         (frequencies)
+        )))


Removed exec function + import std modules by default


Updating the versions of proto-repl and proto-repl-charts in the default leiningen project.- Fixed

--- proto-no-proj/project.clj
+++ proto-no-proj/project.clj
@@ -1,8 +1,8 @@
 (defproject proto-no-proj "0.1.0-SNAPSHOT"
   :description "A default leiningen project to use when there is no project."
   :dependencies [[org.clojure/clojure "1.8.0"]
-                 [proto-repl-charts "0.3.0"]
-                 [proto-repl "0.3.1"]]
+                 [proto-repl-charts "0.3.1"]
+                 [proto-repl "0.3.0"]]

   :profiles
   {:dev {:source-paths ["dev" "src"]}})


Make force reset optional for now

Make force reset optional for now


Simplest test I can think of

Simplest test I can think of

--- test/desdemona/query_test.clj
+++ test/desdemona/query_test.clj
@@ -2,6 +2,13 @@
   (:require
    [desdemona.query :as q]
    [clojure.test :refer [deftest is]]))
+
+(def dsl->logic
+  @#'desdemona.query/dsl->logic)
+
+(deftest dsl->logic-tests
+  (is (= '(l/featurec x {:ip "10.0.0.1"})
+         (dsl->logic '(= (:ip x) "10.0.0.1")))))

 (deftest logic-query-tests
   (is (= []


Also test dsl->logic featurec commutativity

--- test/desdemona/query_test.clj
+++ test/desdemona/query_test.clj
@@ -8,7 +8,8 @@

 (deftest dsl->logic-tests
   (is (= '(clojure.core.logic/featurec x {:ip "10.0.0.1"})
-         (dsl->logic '(= (:ip x) "10.0.0.1")))))
+         (dsl->logic '(= (:ip x) "10.0.0.1"))
+         (dsl->logic '(= "10.0.0.1" (:ip x))))))

 (def events
   [{:ip "10.0.0.1"}])


copy improvement for oss

copy improvement for oss

--- frontend/components/landing_b.cljs
+++ frontend/components/landing_b.cljs
@@ -408,7 +408,7 @@
                [:li "Build artifacts"]
                [:li "Clean build environments"]
                [:li "GitHub Integration"]
-               [:li "Open Source Support"]]]]]
+               [:li "Free Open Source Support"]]]]]
            [:div.home-drawings
             [:figure]
             [:figure]


remove confusing copy

remove confusing copy

--- frontend/components/pricing-b.cljs
+++ frontend/components/pricing-b.cljs
@@ -84,7 +84,7 @@
                  [:strong {:class (when (> container-count 9) "double-digits")} (str container-count)]
                  [:span " containers and "]
                  [:strong (str pricing-parallelism)]
-                 [:span " parallelism. (Adjustable per project.)"]]
+                 [:span " parallelism."]]
                 [:div.parallelism-options
                  (for [p [1 4 8 12 16]]
                  [:button {:on-click #(do


Minor naming improvements.

Minor naming improvements.

--- frontend/uxbox/data/dashboard.cljs
+++ frontend/uxbox/data/dashboard.cljs
@@ -68,8 +68,8 @@
   (letfn [(select-first [state]
             (if (= type :builtin)
               (assoc-in state [:dashboard :collection-id] 1)
-              (let [coll (sort-by :id (vals (:colors-by-id state)))]
-                (assoc-in state [:dashboard :collection-id] (:id (first coll))))))]
+              (let [colls (sort-by :id (vals (:colors-by-id state)))]
+                (assoc-in state [:dashboard :collection-id] (:id (first colls))))))]
     (reify
       rs/UpdateEvent
       (-apply-update [_ state]


Component: we don't throw such structured errors. Commenting out tests.

--- test/yadic/component_test.clj
+++ test/yadic/component_test.clj
@@ -172,43 +172,45 @@
           (assoc (system-1) :c (error-start-c error)))
         (catch Exception e e))))

-(deftest error-thrown-with-partial-system
-  (let [ex (setup-error)]
-    (is (started? (-> ex ex-data :system :b :a)))))
-
-(deftest error-thrown-with-component-dependencies
-  (let [ex (setup-error)]
-    (is (started? (-> ex ex-data :component :a)))
-    (is (started? (-> ex ex-data :component :b)))))
-
-(deftest error-thrown-with-cause
-  (let [error (ex-info "Boom!" {})
-        ex (setup-error error)]
-    (is (identical? error (.getCause ^Exception ex)))))
-
-(deftest error-is-from-component
-  (let [error (ex-info "Boom!" {})
-        ex (setup-error error)]
-    (is (component/ex-component? ex))))
-
-(deftest error-is-not-from-component
-  (is (not (component/ex-component? (ex-info "Boom!" {})))))
-
-(deftest remove-components-from-error
-  (let [error (ex-info (str (rand-int Integer/MAX_VALUE)) {})
-        ^Exception ex (setup-error error)
-        ^Exception ex-without (component/ex-without-components ex)]
-    (is (contains? (ex-data ex) :component))
-    (is (contains? (ex-data ex) :system))
-    (is (not (contains? (ex-data ex-without) :component)))
-    (is (not (contains? (ex-data ex-without) :system)))
-    (is (= (.getMessage ex)
-           (.getMessage ex-without)))
-    (is (= (.getCause ex)
-           (.getCause ex-without)))
-    (is (java.util.Arrays/equals
-          (.getStackTrace ex)
-          (.getStackTrace ex-without)))))
+"Yadic throws less structured errors than Component"
+#_(
+    (deftest error-thrown-with-partial-system
+   (let [ex (setup-error)]
+     (is (started? (-> ex ex-data :system :b :a)))))
+
+  (deftest error-thrown-with-component-dependencies
+    (let [ex (setup-error)]
+      (is (started? (-> ex ex-data :component :a)))
+      (is (started? (-> ex ex-data :component :b)))))
+
+  (deftest error-thrown-with-cause
+    (let [error (ex-info "Boom!" {})
+          ex    (setup-error error)]
+      (is (identical? error (.getCause ^Exception ex)))))
+
+  (deftest error-is-from-component
+    (let [error (ex-info "Boom!" {})
+          ex    (setup-error error)]
+      (is (component/ex-component? ex))))
+
+  (deftest error-is-not-from-component
+    (is (not (component/ex-component? (ex-info "Boom!" {})))))
+
+  (deftest remove-components-from-error
+    (let [error                 (ex-info (str (rand-int Integer/MAX_VALUE)) {})
+          ^Exception ex         (setup-error error)
+          ^Exception ex-without (component/ex-without-components ex)]
+      (is (contains? (ex-data ex) :component))
+      (is (contains? (ex-data ex) :system))
+      (is (not (contains? (ex-data ex-without) :component)))
+      (is (not (contains? (ex-data ex-without) :system)))
+      (is (= (.getMessage ex)
+             (.getMessage ex-without)))
+      (is (= (.getCause ex)
+             (.getCause ex-without)))
+      (is (java.util.Arrays/equals
+            (.getStackTrace ex)
+            (.getStackTrace ex-without))))))

 (defrecord System2b [one]
   component/Lifecycle


(PE-3868) More tests for validate-dns-alt-names!

--- test/puppetlabs/puppetserver/certificate_authority_test.clj
+++ test/puppetlabs/puppetserver/certificate_authority_test.clj
@@ -866,3 +866,20 @@
            :message "Certificate names must be lower case."}
           (validate-subject! "Host-With-Capital-Letters"
                              "Host-With-Capital-Letters")))))
+
+(deftest validate-dns-alt-names!-test
+  (testing "Only DNS alt names are allowed"
+    (is (thrown-with-slingshot?
+          {:type    :invalid-alt-name
+           :message "Only DNS names are allowed in the Subject Alternative Names extension"}
+          (validate-dns-alt-names! {:oid "2.5.29.17"
+                                    :critical false
+                                    :value {:ip-address ["12.34.5.6"]}}))))
+
+  (testing "No DNS wildcards are allowed"
+    (is (thrown-with-slingshot?
+          {:type    :invalid-alt-name
+           :message "Cert subjectAltName contains a wildcard, which is not allowed: foo*bar"}
+          (validate-dns-alt-names! {:oid "2.5.29.17"
+                                    :critical false
+                                    :value {:dns-name ["ahostname" "foo*bar"]}})))))


Update deep-merge and deep-unmerge for SerializingSessionStore

--- systems/ring-session-cassandra/src/containium/utils/session_store.clj
+++ systems/ring-session-cassandra/src/containium/utils/session_store.clj
@@ -12,18 +12,18 @@
 (defn deep-merge
   "Like merge-with, but merges maps recursively."
   [& maps]
-  (apply
-   (fn m [& maps]
-     (if (every? map? maps)
-       (apply merge-with m maps)
-       (last maps)))
-   maps))
+  (apply merge-with
+         (fn m [& maps]
+           (if (every? map? maps)
+             (apply merge-with m maps)
+             (last maps)))
+         maps))

 (defn deep-unmerge
   [m kss]
   (reduce (fn [[extracted leftover] ks]
-            [(assoc-in extracted ks (get-in m ks))
+            [(if-let [v (get-in m ks)] (assoc-in extracted ks v) extracted)
              (update-in leftover (butlast ks) dissoc (last ks))])
           [{} m]
           kss))
@@ -40,7 +40,8 @@
   SessionStore
   (read-session [_ key]
     (when-let [data (session/read-session session-store key)]
-      (deep-merge data (deserialize (::serialized data)))))
+      (deep-merge data (when-let [to-deserialize (::serialized data)]
+                         (deserialize to-deserialize)))))
   (write-session [_ key data]
     (let [[plain to-serialize] (deep-unmerge data (:plain options))
           serialized (assoc plain ::serialized (serialize to-serialize))]


RS CC Add question to title tag

RS CC Add question to title tag

--- src/objective8/handlers/front_end.clj
+++ src/objective8/handlers/front_end.clj
@@ -167,8 +167,8 @@
            (= status ::http-api/success)
            (rendered-response question-view-page {:translation     t'
                                                   :locale          (subs (str locale) 1)
-                                                  :doc-title       (str (:title question) " | Objective[8]")
-                                                  :doc-description (:title question)
+                                                  :doc-title       (str (:question question) " | Objective[8]")
+                                                  :doc-description (:question question)
                                                   :message         message
                                                   :question        question
                                                   :answers         answers


Let the client-id key be empty to avoid errors.

--- src/oc/storage/async/notification.clj
+++ src/oc/storage/async/notification.clj
@@ -37,7 +37,7 @@
   {(schema/optional-key :dismiss-at) lib-schema/ISO8601
    (schema/optional-key :follow) schema/Bool
    (schema/optional-key :unfollow) schema/Bool
-   (schema/optional-key :client-id) lib-schema/UUIDStr
+   (schema/optional-key :client-id) (schema/maybe lib-schema/UUIDStr)
    (schema/optional-key :comment-add) schema/Bool})

 (def NotificationTrigger


(maint) Rename jruby to jruby-protocol in request_handler_core_test

--- test/unit/puppetlabs/services/request_handler/request_handler_core_test.clj
+++ test/unit/puppetlabs/services/request_handler/request_handler_core_test.clj
@@ -8,7 +8,7 @@
             [clojure.test :refer :all]
             [ring.util.codec :as ring-codec]
             [slingshot.test :refer :all]
-            [puppetlabs.services.protocols.jruby-puppet :as jruby]))
+            [puppetlabs.services.protocols.jruby-puppet :as jruby-protocol]))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; Test Data
@@ -261,13 +261,13 @@
                         ring-codec/url-encode))))))

 (deftest request-handler-test
-  (let [dummy-service (reify jruby/JRubyPuppetService
+  (let [dummy-service (reify jruby-protocol/JRubyPuppetService
                         (borrow-instance [_ _] {})
                         (return-instance [_ _ _])
                         (free-instance-count [_])
                         (mark-all-environments-expired! [_])
                         (flush-jruby-pool! [_]))
-        dummy-service-with-timeout (reify jruby/JRubyPuppetService
+        dummy-service-with-timeout (reify jruby-protocol/JRubyPuppetService
                                      (borrow-instance [_ _] nil)
                                      (return-instance [_ _ _])
                                      (free-instance-count [_])


Translate hints

Translate hints

--- test/obb_api/core/hints.clj
+++ test/obb_api/core/hints.clj
@@ -3,16 +3,21 @@
   (:require [obb-rules.game :as game]
             [obb-rules.element :as element]
             [obb-rules.simplifier :as simplify]
+            [obb-rules.translator :as translator]
             [obb-rules.actions.move :as move]
             [obb-rules.board :as board]))

+(defn- all-possible-moves
+  "Gets all possible moves, with the coordinate translated"
+  [board viewer element]
+  (->> (move/find-all-possible-destinations-with-cost board element)
+       (reduce (fn [col [coord cost]] (assoc col (translator/coordinate viewer coord) cost)) {})))
+
 (defn- hints-for-element
   "Gathers the hints for a specific element"
-  [board element]
-  ;{:pre [(element/assert-element element)]}
-  {:coord (element/element-coordinate element)
-   :goto (move/find-all-possible-destinations-with-cost board element)
-   })
+  [board viewer element]
+  {:coord (translator/coordinate viewer (element/element-coordinate element))
+   :goto (all-possible-moves board viewer element)})

 (defn for-game
   "Returns to the given hash hints to use to move the elements"
@@ -20,7 +25,7 @@
   (when (and viewer (simplify/name= viewer (get-in game [:board :state])))
     (let [board (:board game)
           elements (board/board-elements board viewer)
-          hints-for-element (partial hints-for-element board)
+          hints-for-element (partial hints-for-element board viewer)
           hints (map hints-for-element elements)]
       hints)))


Add pragma

Add pragma


Bump basic clojure profile dependencies

Bump basic clojure profile dependencies

--- dot/lein/profiles.clj
+++ dot/lein/profiles.clj
@@ -1,7 +1,7 @@
 {:user
  {:plugins [[lein-vanity "0.2.0"]
             [lein-ancient "0.5.5"]
-            [jonase/eastwood "0.1.4"]
-            [cider/cider-nrepl "0.8.0-SNAPSHOT"]]
+            [jonase/eastwood "0.2.0"]
+            [cider/cider-nrepl "0.8.1"]]
   :dependencies [[slamhound "1.5.5"]]
   :aliases {"slamhound" ["run" "-m" "slam.hound"]}}}


tidying

tidying

--- test/merlion/core_test.clj
+++ test/merlion/core_test.clj
@@ -10,6 +10,8 @@
             ))

 (log/set-level! :trace)
+
+(def excerpt-txt (slurp "test/fixtures/excerpt.txt"))

 (defn socat-pipe [command]
   (let [p (shell/proc "/usr/bin/env"
@@ -43,7 +45,7 @@

 (def port (if-let [p (System/getenv "PORT")]
             (Integer/parseInt p)
-            8087))
+            8095))

 (def domain-name "test.merlion.telent.net")
 (def prefix
@@ -116,7 +118,7 @@
       (with-running-server [prefix port]
         (add-backend "aaa" (:port be-process))
         (Thread/sleep 500)
-        (is (= (slurp "test/fixtures/excerpt.txt")
+        (is (= excerpt-txt
                (tcp-slurp port)))))))

@@ -126,7 +128,7 @@
       (with-running-server [prefix port]
         (add-backend "aaa" (:port be-process))
         (Thread/sleep 500)
-        (is (= (slurp "test/fixtures/excerpt.txt")
+        (is (= excerpt-txt
                (tcp-slurp port)))
         ))))

@@ -142,7 +144,7 @@
                 (Thread/sleep 4000)
                 f))]
         (async/put! @server :quit)
-        (is (= (slurp "test/fixtures/excerpt.txt") @fut))
+        (is (= excerpt-txt @fut))
         ))))

 (deftest quit-backend
@@ -154,7 +156,7 @@
         (let [f (future (tcp-slurp port))]
           (Thread/sleep 4000)
           (etcd-rm (str "service/" domain-name "/aaa"))
-          (is (= (slurp "test/fixtures/excerpt.txt") @f)))))))
+          (is (= excerpt-txt @f)))))))

 (deftest no-backend
   (testing "fetches hang when no backends"
@@ -190,7 +192,7 @@
           (etcdctl (str "/conf/merlion/" domain-name "/listen-address")
                    (str "localhost:" new-port))
           (Thread/sleep 500)
-          (is (= (slurp "test/fixtures/excerpt.txt") (tcp-slurp new-port))))))))
+          (is (= excerpt-txt (tcp-slurp new-port))))))))

 (deftest change-listener-no-interruption
   (testing "changing the listening port does not break existing transfers"
@@ -205,7 +207,8 @@
             (etcdctl (str "/conf/merlion/" domain-name "/listen-address")
                      (str "localhost:" new-port))
             (Thread/sleep 2000)
-            (is (= (slurp "test/fixtures/excerpt.txt") @f))))))))
+            (is (= excerpt-txt @f))))))))
+
 (deftest error-when-backend-down
   (testing "a broken upstream does not kill the backend silently"
     (with-running-server [prefix port]


wip: submitting state

wip: submitting state

--- src/cljs/foosball/locations/report_match.cljs
+++ src/cljs/foosball/locations/report_match.cljs
@@ -26,7 +26,7 @@
         (when-not (@app :players)
           (data/go-update-data! "/api/players" app :players))
         (let [empty-team {:player1 nil :player2 nil :score nil :valid-score? true}]
-          (om/transact! app [:report-match] (fn [rm] (merge rm
+          (om/transact! app [:match-report] (fn [rm] (merge rm
                                                            {:team1 empty-team
                                                             :team2 empty-team
                                                             :matchdate (tc/now)}))))
@@ -93,13 +93,13 @@
     (when (= 1 (count difference))
       (first difference))))

-(defn- render-team-controls [{:keys [report-match active-players] :as app}
+(defn- render-team-controls [{:keys [match-report active-players] :as app}
                              team-num
                              {:keys [score player1 player2] :as chans}]
   (let [team-sel       (team-selector team-num)
         other-team-sel (other-team team-sel)
-        team           (team-sel report-match)
-        other-team     (other-team-sel report-match)
+        team           (team-sel match-report)
+        other-team     (other-team-sel match-report)
         render-player  (fn [num change-ch]
                          (let [selected-player ((player-selector num) team)]
                            (om/build team-player-component team
@@ -115,7 +115,7 @@
      (render-player 1 player1)
      (render-player 2 player2)
      (om/build team-score-component
-               (get report-match (team-selector team-num))
+               (get match-report (team-selector team-num))
                {:opts {:score-ch score}})]))

 (defn matchdate-component [matchdate owner {:keys [change-ch]}]
@@ -137,49 +137,49 @@
 (defn valid-score? [this other]
   (:team1score (vm/validate-scores [this other])))

-(defn update-score! [report-match team score other-score]
+(defn update-score! [match-report team score other-score]
   (let [valid-score? (valid-score? score other-score)]
-    (om/transact! report-match team (fn [v] (merge v
+    (om/transact! match-report team (fn [v] (merge v
                                                   {:score score}
                                                   {:valid-score? valid-score?})))))

-(defn handle-score-update [report-match [team _] [type val]]
+(defn handle-score-update [match-report [team _] [type val]]
   (when (= :foosball.editable/blur type)
     (if-let [score (c/->int val)]
       (let [other (other-team team)
-            other-score (get-in @report-match [other :score])]
-        (update-score! report-match team score other-score)
+            other-score (get-in @match-report [other :score])]
+        (update-score! match-report team score other-score)
         (when other-score
-          (update-score! report-match other other-score score))))))
-
-(defn handle-player-update [report-match path player]
-  (om/update! report-match path player))
-
-(defn handle-matchdate-update [report-match path js-date]
+          (update-score! match-report other other-score score))))))
+
+(defn handle-player-update [match-report path player]
+  (om/update! match-report path player))
+
+(defn handle-matchdate-update [match-report path js-date]
   (let [matchdate (dc/to-date-time js-date)]
-    (om/update! report-match path matchdate)))
+    (om/update! match-report path matchdate)))

 (defn valid-team-to-report? [{:keys [player1 player2 valid-score?]}]
   (and player1 player2 valid-score?))

-(defn valid-report? [{:keys [team1 team2 matchdate] :as report-match}]
+(defn valid-report? [{:keys [team1 team2 matchdate] :as match-report}]
   (and (valid-team-to-report? team1)
        (valid-team-to-report? team2)
        matchdate))

-(defn submit-report! [{:keys [team1 team2 matchdate] :as report-match}]
+(defn submit-report! [match-report]
   (let [id (uuid/make-random-uuid)
+        {:keys [team1 team2 matchdate]} @match-report
         report {:team1 team1
                 :team2 team2
                 :matchdate matchdate
                 :id id
                 :status :pending}]
-    (debug "submitting" report)
-    (om/transact! report-match :submits (fn [s] (if s
-                                                 (conj s report)
-                                                 [report])))))
-
-(defn report-match-component [{:keys [active-players report-match submits] :as app} owner]
+    (debug "doing submit" report)
+    (om/transact! match-report
+                  (fn [mr] (merge mr {:submitting report})))))
+
+(defn match-report-component [{:keys [active-players match-report] :as app} owner]
   (reify
     om/IInitState
     (init-state [_]
@@ -203,22 +203,24 @@
           (let [[v c] (alts! (keys chan-to-path-map))
                 path (get chan-to-path-map c)]
             (condp some (-> path)
-              #{:score} (handle-score-update report-match path v)
-              #{:player1 :player2} (handle-player-update report-match path v)
-              #{:matchdate} (handle-matchdate-update report-match path v)
+              #{:score} (handle-score-update match-report path v)
+              #{:player1 :player2} (handle-player-update match-report path v)
+              #{:matchdate} (handle-matchdate-update match-report path v)
               nil)
             (recur)))))

     om/IRenderState
     (render-state [_ {:keys [team1 team2 matchdate]}]
-      (let [_   (debug "players" (map (fn [p] (str "'" (:name p) "'"))
-                                     (selected-players (:team1 report-match)
-                                                       (:team2 report-match))))
-            __  (debug "scores" (map (fn [kw] (get-in report-match [kw :score])) [:team1 :team2]))
-            ___ (debug "matchdate" (-> report-match :matchdate d/->str))
-            ____ (debug "submits" submits)
+      (let [submitting (:submitting match-report)
+            _    (debug "players" (map (fn [p] (str "'" (:name p) "'"))
+                                     (selected-players (:team1 match-report)
+                                                       (:team2 match-report))))
+            __   (debug "scores" (map (fn [kw] (get-in match-report [kw :score])) [:team1 :team2]))
+            ___  (debug "matchdate" (-> match-report :matchdate d/->str))
+            ____ (debug "submitting" submitting)
             render-team (partial render-team-controls app)
-            enabled? (valid-report? report-match)]
+            enabled? (and (not submitting)
+                          (valid-report? match-report))]
         (html
          [:div
           [:h1 "Report Match Result"]
@@ -234,20 +236,22 @@
             (render-team 2 team2)]

            (om/build matchdate-component
-                     (:matchdate report-match)
+                     (:matchdate match-report)
                      {:opts {:change-ch matchdate}})

            [:div.form-group.col-lg-12
             [:div.form-group.col-lg-5.pull-right
              [:button.btn.btn-primary.btn-lg.btn-block
-              (merge {:on-click (fn [e] (submit-report! @report-match))}
+              (merge {:on-click (fn [e] (submit-report! match-report))}
                      (when-not enabled? {:disabled "disabled"}))
-              "Report Match Result " [:span.glyphicon.glyphicon-ok]]]]]])))))
+              "Report Match Result " (if submitting
+                                       [:span.glyphicon.glyphicon-time]
+                                       [:span.glyphicon.glyphicon-ok])]]]]])))))

 (defn render [app]
   (if (:auth app)
-    (om/build report-match-component app
-              {:fn (fn [{:keys [report-match players]}]
-                     {:report-match   report-match
+    (om/build match-report-component app
+              {:fn (fn [{:keys [match-report players]}]
+                     {:match-report   match-report
                       :active-players (filterv :active players)})})
     (spinner)))


Removed unneeded code.

Removed unneeded code.

--- src/cljs/wombats_web_client/panels/games.cljs
+++ src/cljs/wombats_web_client/panels/games.cljs
@@ -107,11 +107,7 @@
                 (= github-username current-username))) players)))

 (defn main-panel [cmpnt-state]
-  (let [open-games (re-frame/subscribe [:open-games])
-        closed-games (re-frame/subscribe [:closed-games])
-        my-open (re-frame/subscribe [:my-open-games])
-        my-closed (re-frame/subscribe [:my-closed-games])
-        polling (open-game-polling)
+  (let [polling (open-game-polling)
         current-user (re-frame/subscribe [:current-user])
         games (re-frame/subscribe [:games])]

@@ -119,17 +115,11 @@

     (fn []
       (let [current-user @current-user
-            open @open-games
-            closed @closed-games
             show-my-games (:show-my-games @cmpnt-state)
             show-open (:show-open @cmpnt-state)
             games-sorted (get-sorted-games {:show-open show-open
                                             :show-my-games show-my-games
-                                            :open open
-                                            :closed closed
                                             :games @games
-                                            :my-open @my-open
-                                            :my-closed @my-closed
                                             :current-user current-user})]

         (swap! cmpnt-state assoc :polling polling)


Fix concatenation

Fix concatenation

--- src/desdemona/launcher/aeron_media_driver.clj
+++ src/desdemona/launcher/aeron_media_driver.clj
@@ -54,5 +54,5 @@
   (let [{:keys [options errors summary]} (parse-opts args cli-options)]
     (cond
       (options :help) (exit! 0 (usage summary))
-      errors (exit! 1 (concat (cli-error-msg errors) ( q)))
+      errors (exit! 1 (concat (cli-error-msg errors) (usage summary)))
       :else (run-media-driver-and-block! options))))


change exception handling in log printer

should stop printing if the socket is closed

--- src/main/shadow/cljs/devtools/server/util.clj
+++ src/main/shadow/cljs/devtools/server/util.clj
@@ -13,7 +13,8 @@
     [shadow.cljs.devtools.server.runtime :as runtime]
     [clojure.set :as set]
     [clojure.core.async.impl.protocols :as async-prot])
-  (:import (java.io Writer InputStreamReader BufferedReader IOException ByteArrayOutputStream ByteArrayInputStream)))
+  (:import (java.io Writer InputStreamReader BufferedReader IOException ByteArrayOutputStream ByteArrayInputStream)
+           [java.net SocketException]))

 (defn chan? [x]
   (satisfies? async-prot/ReadPort x))
@@ -152,60 +153,71 @@
   #_ (errors/user-friendly-error e))

 (defn print-worker-out [x verbose]
-  (locking build-log/stdout-lock
-    (binding [*out* *err*]
-      (case (:type x)
-        :build-log
-        (when verbose
-          (println (build-log/event-text (:event x))))
-
-        :build-configure
-        (println (format "[%s] Configuring build." (:build-id x)))
-
-        :build-start
-        (print-build-start x)
-
-        :build-failure
-        (print-build-failure x)
-
-        :build-complete
-        (print-build-complete x)
-
-        :build-shutdown
-        (println "Build shutdown.")
-
-        :repl/action
-        (let [warnings (get-in x [:action :warnings])]
-          (print-warnings warnings))
-
-        ;; should have been handled somewhere else
-        :repl/result
-        :ignored
-
-        :repl/error
-        :ignored ;; also handled by out
-
-        :repl/runtime-connect
-        (println "JS runtime connected.")
-
-        :repl/runtime-disconnect
-        (println "JS runtime disconnected.")
-
-        :worker-shutdown
-        (println "Worker shutdown.")
-
-        :println
-        (println (:msg x))
-
-        ;; handled in dedicated channel as they should not mix with build output
-        :repl/out
-        :ignored
-
-        :repl/err
-        :ignored
-
-        ;; default
-        (prn [:log x])))))
+  (try
+
+    (locking build-log/stdout-lock
+      (binding [*out* *err*]
+        (case (:type x)
+          :build-log
+          (when verbose
+            (println (build-log/event-text (:event x))))
+
+          :build-configure
+          (println (format "[%s] Configuring build." (:build-id x)))
+
+          :build-start
+          (print-build-start x)
+
+          :build-failure
+          (print-build-failure x)
+
+          :build-complete
+          (print-build-complete x)
+
+          :build-shutdown
+          (println "Build shutdown.")
+
+          :repl/action
+          (let [warnings (get-in x [:action :warnings])]
+            (print-warnings warnings))
+
+          ;; should have been handled somewhere else
+          :repl/result
+          :ignored
+
+          :repl/error
+          :ignored ;; also handled by out
+
+          :repl/runtime-connect
+          (println "JS runtime connected.")
+
+          :repl/runtime-disconnect
+          (println "JS runtime disconnected.")
+
+          :worker-shutdown
+          (println "Worker shutdown.")
+
+          :println
+          (println (:msg x))
+
+          ;; handled in dedicated channel as they should not mix with build output
+          :repl/out
+          :ignored
+
+          :repl/err
+          :ignored
+
+          ;; default
+          (prn [:log x]))))
+
+    true
+    (catch SocketException e
+      ;; was printing to a socket that disconnected.
+      ;; no need to continue printing
+      false)
+    (catch Exception e
+      (log/debug-ex e ::stdout-ex {:x x})
+      true)))

 (defn stdout-dump [verbose]
   (let [chan
@@ -215,15 +227,10 @@
     (async/go
       (loop []
         (when-some [x (<! chan)]
-          (try
-            (print-worker-out x verbose)
-            (catch Exception e
-              (prn [:stdout-dump-ex e])))
-          (recur)
-          )))
-
-    chan
-    ))
+          (when (print-worker-out x verbose)
+            (recur)))))
+
+    chan))

 (defmacro thread
   "same as core async thread but does not preserve bindings"


WIP - 1ere version des bots pour "mean max buggy road" en Ligue Wood 2

--- clojure/codingame/competition/mean-max/src/mean_max/core.clj
+++ clojure/codingame/competition/mean-max/src/mean_max/core.clj
@@ -8,6 +8,9 @@
 ; the standard input according to the problem statement.

 (require '[clojure.string :as string])
+
+;;unitType 0 (Reaper), 1 (Destroyer), 3 (Tanker), 4 (Wreck)
+(def unit-types [:reaper :destroyer :placeholder :tanker :wreck])

 (defrecord Unit
   [unit-id unit-type player-id mass radius x y vx vy extra extra2])
@@ -26,10 +29,17 @@
   "Test whether 'my-unit' is 'in' the 'other-unit'"
   (< (distance (:x my-unit) (:y my-unit) (:x other-unit) (:y other-unit)) (:radius other-unit)))

-(defn compute-action [my-unit next-wreck]
+(defn compute-reaper-action [my-reaper next-wreck]
   (cond
-    (in my-unit next-wreck) "WAIT"
-    true (str (:x next-wreck) " " (:y next-wreck) " 150")))
+    (nil? next-wreck) "WAIT"
+    (in my-reaper next-wreck) "WAIT"
+    true (str (:x next-wreck) " " (:y next-wreck) " 200")))
+
+(defn compute-destroyer-action [my-destroyer next-tanker]
+  (cond
+    (nil? next-tanker) "WAIT"
+    (in my-destroyer next-tanker) (str (:x next-tanker) " " (:y next-tanker) " 0")
+    true (str (:x next-tanker) " " (:y next-tanker) " 300")))

 (defn -main [& args]
   (while true
@@ -37,7 +47,7 @@
       (loop [i unit-count]
         (when (> i 0)
           (let [unit-id (read)
-                unit-type (read)
+                unit-type (nth unit-types (read))
                 player-id (read)
                 mass (read)
                 radius (read)
@@ -50,19 +60,30 @@
                 unit (Unit. unit-id unit-type player-id mass radius x y vx vy extra extra2)]
             (swap! units conj unit)
             (recur (dec i)))))
-      (let [wrecks (filter #(= (:unit-type %) 4) @units)
+      (let [wrecks (filter #(= (:unit-type %) :wreck) @units)
             wrecks-with-water (filter #(> (:extra %) 0) wrecks)
-            mobile-units (filter #(= (:unit-type %) 0) @units)
-            enemy-mobile-units (filter #(not= (:player-id %) 0) mobile-units)
-            my-unit (first (filter #(= (:player-id %) 0) mobile-units))
-            next-wreck (first (sort-by #(distance (:x my-unit) (:y my-unit) (:x %) (:y %)) wrecks-with-water))]
+            tankers (filter #(= (:unit-type %) :tanker) @units)
+            reapers (filter #(= (:unit-type %) :reaper) @units)
+            destroyers (filter #(= (:unit-type %) :destroyer) @units)
+            enemy-reapers (filter #(not= (:player-id %) 0) reapers)
+            enemy-destroyers (filter #(not= (:player-id %) 0) destroyers)
+            my-reaper (first (filter #(= (:player-id %) 0) reapers))
+            my-destroyer (first (filter #(= (:player-id %) 0) destroyers))
+            next-wreck (first (sort-by #(distance (:x my-reaper) (:y my-reaper) (:x %) (:y %)) wrecks-with-water))
+            next-tanker (first (sort-by #(distance (:x my-destroyer) (:y my-destroyer) (:x %) (:y %)) tankers))]
         (binding [*out* *err*] (println "wrecks : " (string/join " " (map #(into {} %) wrecks)))
-                               (println "mobile-units : " (string/join " " (map #(into {} %) mobile-units)))
-                               (println "enemy-mobile-units : " (string/join " " (map #(into {} %) enemy-mobile-units)))
-                               (println "my-unit : " (string/join " " my-unit))
-                               (println "next-wreck : " (string/join " " next-wreck)))
-        (println (compute-action my-unit next-wreck))
-        (println "WAIT")
+                               (println "wrecks with water: " (string/join " " (map #(into {} %) wrecks-with-water)))
+                               (println "tankers : " (string/join " " (map #(into {} %) tankers)))
+                               (println "reapers : " (string/join " " (map #(into {} %) reapers)))
+                               (println "destroyers : " (string/join " " (map #(into {} %) destroyers)))
+                               (println "enemy reapers: " (string/join " " (map #(into {} %) enemy-reapers)))
+                               (println "enemy destroyers: " (string/join " " (map #(into {} %) enemy-destroyers)))
+                               (println "my reaper : " (string/join " " my-reaper))
+                               (println "my-destroyer : " (string/join " " my-destroyer))
+                               (println "next-wreck : " (string/join " " next-wreck))
+                               (println "next-tanker : " (string/join " " next-tanker)))
+        (println (compute-reaper-action my-reaper next-wreck))
+        (println (compute-destroyer-action my-destroyer next-tanker))
         (println "WAIT")))))

       ; (binding [*out* *err*]


Fix some tests that were still failing ...

--- paredit.clj/test/paredit/loc_utils_test.clj
+++ paredit.clj/test/paredit/loc_utils_test.clj
@@ -31,32 +31,28 @@
                                   :length length})]
       (is (= expected-text-after text-after)))

-      ; this is a little weird: the caret is placed to the final
-      ; position in the text, but the text represents only the
-      ; modif for shifting the rest
+       "|\nb" "a" nil
+       "| |a\n b" "" "|a\n b"

-       "|\nb" "a" nil
-       "| |a\n b" "" nil
+       "|a\nb"  " "  " |a\nb"
+       "(|foo\nbar)"  " "  "( |foo\nbar)"
+       "(|foo\n bar)"  " "  "( |foo\n bar)"
+       "(|foo\n  bar)"  " "  "( |foo\n  bar)"
+       "(|foo\n\n  bar)"   " "   "( |foo\n\n  bar)"
+       "(|foo\n \n  bar)"   " "   "( |foo\n \n  bar)"
+
+       "(|foo\n\n  (bar\n    baz))"  " " "( |foo\n\n  (bar\n    baz))"
+
+       "| |a\n b"   ""   "|a\n b"
+
+       " |\n b"   "a"   nil;" a|\n b"

-       "|a\nb"  " "  nil
-       "(|foo\nbar)"  " "  nil
-       "(|foo\n bar)"  " "  nil
-       "(|foo\n  bar)"  " "  nil
-       "(|foo\n\n  bar)"   " "   nil
-       "(|foo\n \n  bar)"   " "   nil
-
-       "(|foo\n\n  (bar\n    baz))"  " " nil
-
-       "| |a\n b"   ""   nil
-
-       " |\n b"   "a"   nil
-
-       " |\n b\n c"   " " nil
-       "|(\n) b\n  c"   " "   nil
+       " |\n b\n c"   " " nil;"  |\n b\n c"
+       "|(\n) b\n  c"   " "   " |(\n) b\n  c"

        "|\n(\na)"  " " nil

-       ";\n| |(\n )"   ""   ";\n| (\n)"
+       ";\n| |(\n )"   ""   ";\n|(\n)"

        "|\na"   ";"   nil

@@ -64,13 +60,13 @@

        "|a\nb" ";" nil

-       "(|a) (b\n      c)"   " "   "(a|) (b\n       c)"
+       "(|a) (b\n      c)"   " "   "( |a) (b\n       c)"

-       "(|a)\nb\nc"   " "   nil
+       "(|a)\nb\nc"   " "   "( |a)\nb\nc"

        "(\n  a)|\n|"  ""   nil

        "(\n  a)|b|" "" nil

-       "( |(a\n    b)\n  c)"   " "   "( (|a\n     b)\n  c)"
+       "( |(a\n    b)\n  c)"   " "   "(  |(a\n     b)\n  c)"
        ))


use cookie session time

use cookie session time

--- src/server/daveconservatoire/server/core.cljs
+++ src/server/daveconservatoire/server/core.cljs
@@ -58,7 +58,7 @@
                           :store             (RedisStore. #js {})
                           :resave            true
                           :saveUninitialized false
-                          :cookie            #js {:maxAge 600000}}))
+                          :cookie            #js {}}))
 (ex/use app (.initialize passport/passport))
 (ex/use app (.session passport/passport))


[feature] match target subimgs by l2 distance

--- src/video_feed_transformer/transform_feed.clj
+++ src/video_feed_transformer/transform_feed.clj
@@ -61,43 +61,46 @@
      :g-avg g-avg
      :b-avg b-avg}))

+(defn rgb-dist [{:keys [r1 r2 g1 g2 b1 b2]}]
+  (Math/sqrt (+
+               (Math/pow (- r2 r1) 2)
+               (Math/pow (- g2 g1) 2)
+               (Math/pow (- b2 b1) 2))))

+(defn match-by-rgb-avg [target corpus]
+  (let [with-dist (map #(assoc % :dist (rgb-dist {:r1 (:r-avg target)
+                                                  :g1 (:g-avg target)
+                                                  :b1 (:b-avg target)
+                                                  :r2 (:r-avg %)
+                                                  :g2 (:g-avg %)
+                                                  :b2 (:b-avg %)}))
+                       corpus)
+        sorted    (sort-by :dist with-dist)]
+    {:target  target
+     :matched (first sorted)}))

 (defn build-mosaic [target-img img-coll col-width row-height rows cols]
   ""
-  (let [target-rects     (get-grid-boxes col-width row-height rows cols)
-        target-w-subimgs (map #(assoc %
-                                 :subimage (get-rect-from-img target-img %))
-                              target-rects)
-        target-w-rgb-avg (map #(assoc %
-                                 :rgb-avg (get-rgb-avg-of-img
-                                            (:subimage %)))
-                              target-w-subimgs)
+  (let [target-w-rects                          (get-grid-boxes col-width row-height rows cols)

-        corpus-w-rgb-avg (map #(hash-map
-                                 :rgb-avg (get-rgb-avg-of-img %)
-                                 :image %) img-coll)
+        target-w-grid-subimgs                   (map #(assoc %
+                                                        :subimage (get-rect-from-img target-img %))
+                                                     target-w-rects)

-        ]))
+        target-w-grid-subimgs-and-their-rgb-avg (map #(assoc %
+                                                        :rgb-avg (get-rgb-avg-of-img
+                                                                   (:subimage %)))
+                                                     target-w-grid-subimgs)

-(defn- get-matching-img-to-corpus [img corpus]
-  "given an image and a collection of imgs, return best match from corpus")
-(defn- assemble-imgs-onto-canvas [canvas imgs-and-rects]
-  "given a set of images, their rect coordinates, and a canvas, assemble the imgs
-  using the grid coords onto the canvas")
+        corpus-for-mosaic-w-rgb-avg             (map #(hash-map
+                                                        :rgb-avg (get-rgb-avg-of-img %)
+                                                        :image %) img-coll)

-
-(defn- find-closest-match-by-rgb-l2 [img-rgb corpus-rgb]
-  "")
-
-(defn- step-with-new-frame [frame]
-  "")
-
-(defn- persist-frame [frame]
-  "")
-
-(defn- re-mosaic [new-frame]
-  "")
+        target-subimgs-and-their-matches        (map
+                                                  #(match-by-rgb-avg
+                                                     (:rgb-avg %)
+                                                     (map :rgb-avg corpus-for-mosaic-w-rgb-avg))
+                                                  target-w-grid-subimgs-and-their-rgb-avg)]))

 (defn- move-file [src-file dest-dir] ""
   (fs/copy+ src-file dest-dir))


Use more efficient spec for vector-of-two-elements

--- src/validation_benchmark/lib/spec.clj
+++ src/validation_benchmark/lib/spec.clj
@@ -25,8 +25,7 @@
          #(number? (nth % 2))))
 (s/def ::typed-person (s/and ::Person?
                              (s/keys :req-un [::name ::saiyan? ::age])))
-(s/def ::vector-of-two-elements (s/and (s/coll-of nil [])
-                                       (s/tuple nil nil)))
+(s/def ::vector-of-two-elements (s/and vector? #(= 2 (count %))))

 (defn atomic-keyword [v]


Fix spec name

Fix spec name

--- test/com/wsscode/pathom/gen_test.cljc
+++ test/com/wsscode/pathom/gen_test.cljc
@@ -51,7 +51,7 @@
   (is (= (sgen/query->props [[::fixed-number '_]])
          {::fixed-number 42})))

-(test/defspec parser-integrity {:max-size 18 :num-tests 100}
+(test/defspec generate-props {:max-size 18 :num-tests 100}
   (props/for-all [query (spec.query/make-gen
                           {::spec.query/gen-property
                            (fn [_] (gen/elements (keys (::sgen/settings gen-env))))


added test for classifier that conforms with current forma taps

--- test/forma/classify/logistic_test.clj
+++ test/forma/classify/logistic_test.clj
@@ -7,7 +7,8 @@
         [midje.cascalog])
   (:import [org.jblas FloatMatrix])
   (:require [incanter.core :as i]
-            [forma.testing :as t]))
+            [forma.testing :as t]
+            [forma.date-time :as date]))

 (defn read-mys-csv
   "returns a properly adjusted list of the malaysia test data."
@@ -106,3 +107,75 @@
                           (> ?prob 0.5))]
      alerts-query => (produces [["eco1" [31] 0.9999999999963644]
                                 ["eco1" [49] 0.9999999999765928]]))))
+
+(def est-map {:t-res "16"
+              :est-start "2005-12-31"
+              :ridge-const 1e-8
+              :convergence-thresh 1e-6
+              :max-iterations 500})
+
+(defn random-ints [] (take 5 (repeatedly #(rand-int 100))))
+
+(defn random-eco []
+  (if (zero? (rand-int 2)) 22220 22221))
+
+(def sample-dynamic-tap
+  (vec (for [[h v s l] modis-sample
+             pd (range 827 837)]
+         ["500" pd h v s l (random-ints) (random-ints)])))
+
+(def sample-static-tap
+  (vec (for [[h v s l] modis-sample]
+         ["500" h v s l 14141 35 (random-eco) (rand-int 2)])))
+
+(defbufferop [logistic-beta-wrap [r c m]]
+  "returns a vector of parameter coefficients.  note that this is
+  where the intercept is added (to the front of each stacked vector in
+  the feature matrix"
+  [tuples]
+  (let [label-seq    (map first tuples)
+        val-mat      (map (comp vec (partial cons 1) second)
+                          tuples)
+        neighbor-mat (map last tuples)
+        feature-mat  (map concat val-mat neighbor-mat)]
+    [[(logistic-beta-vector label-seq feature-mat r c m)]]))
+
+(defn logistic-prob-wrap
+  [beta-vec val neighbor-val]
+  (let [feature-vec (concat val neighbor-val)]
+    (logistic-prob beta-vec feature-vec)))
+
+(defbufferop mk-timeseries
+  [tuples]
+  [[(map second (sort-by first tuples))]])
+
+(defn beta-generator
+  [{:keys [t-res est-start ridge-const convergence-thresh max-iterations]}]
+  (let [first-idx (date/datetime->period t-res est-start)]
+    (<- [?s-res ?eco ?beta]
+        (sample-dynamic-tap ?s-res ?pd ?mod-h ?mod-v ?s ?l ?val ?neighbor-val)
+        (sample-static-tap ?s-res ?mod-h ?mod-v ?s ?l ?gadm ?vcf ?eco ?hansen)
+        (= ?pd first-idx)
+        (logistic-beta-wrap [ridge-const convergence-thresh max-iterations]
+                            ?hansen ?val ?neighbor-val :> ?beta))))
+
+(defn forma-query
+  [path est-map]
+  (let [{:keys [t-res est-start ridge-const convergence-thresh max-iterations]}
+        est-map
+        beta-src (beta-generator est-map)]
+    (?<- (hfs-seqfile path)
+         [?s-res ?mod-h ?mod-v ?s ?l ?prob-series]
+         (beta-src ?s-res ?eco ?beta)
+         (sample-dynamic-tap ?s-res ?pd ?mod-h ?mod-v ?s ?l ?val ?neighbor-val)
+         (sample-static-tap ?s-res ?mod-h ?mod-v ?s ?l ?gadm ?vcf ?eco ?hansen)
+         (logistic-prob-wrap ?beta ?val ?neighbor-val :> ?prob)
+         (mk-timeseries ?pd ?prob :> ?prob-series))))
+
+(defn grab-forma-output
+  [path]
+  (let [src (hfs-seqfile path)]
+    (?<- (stdout)
+         [?s ?l ?prob-series]
+         (src _ _ _ ?s ?l ?prob-series)
+         (:distinct false))))


Better key names.

Better key names.

--- src/algebolic/algorithms/spea2.clj
+++ src/algebolic/algorithms/spea2.clj
@@ -10,7 +10,7 @@
   calculates the strength for each member of the population, and assocs it into the individual."
   [keys population]
   (map
-    #(assoc % :strength (pareto/dominated-count keys population %))
+    #(assoc % :spea2-strength (pareto/dominated-count keys population %))
     population))

 (defn- calculate-raw-fitness
@@ -18,28 +18,17 @@
   The smaller this fitness measure the better."
   [keys population i]
   (let [dominators (pareto/dominator-set keys population i)]
-    (apply + (map :strength dominators))))
+    (apply + (map :spea2-strength dominators))))

 (defn- calculate-raw-fitnesses
   "Calculates raw fitnesses for each individual in a population and assocs it into the individual's
-  under the :raw-fitness key"
+  under the :spea2-raw-fitness key"
   [keys population]
   (let [counted-pop (calculate-strength keys population)]
     (map
-      #(assoc % :raw-fitness (calculate-raw-fitness keys counted-pop %))
+      #(assoc % :spea2-raw-fitness (calculate-raw-fitness keys counted-pop %))
       population)))
-
-;(defn- distance
-;  [[k1 k2] i1 i2]
-;  (Math/sqrt
-;    (+
-;      (Math/pow (- (k1 i1) (k1 i2)) 2)
-;      (Math/pow (- (k2 i1) (k2 i2)) 2))))
-;
-;(defn- kth-nearest-distance
-;  [keys k population i]
-;  (nth (sort < (map (partial distance keys i) population)) k))

 (defn coords-from-individual
   "Get the individuals coordinates in objective space as a vector."
@@ -65,14 +54,15 @@
         ;; so we can efficiently find the nearest neighbours.
         coords (map (partial coords-from-individual [k1 k2]) population)
         tree (kdtree/build-tree coords)]
-    (map #(assoc % :density
+    (map #(assoc % :spea2-density
                    (calculate-density
                      (kth-nearest-distance tree k (coords-from-individual [k1 k2] %))))
          population)))

 (defn calculate-fitnesses
+  "Calculates the SPEA2 fitness values with respect to the given keys. Assocs"
   [keys population]
-  (map #(assoc % :fitness (+ (:raw-fitness %) (:density %)))
+  (map #(assoc % :spea2-fitness (+ (:spea2-raw-fitness %) (:spea2-density %)))
        (->> population
             (calculate-densities keys)
             (calculate-raw-fitnesses keys))))


improve delete message

improve delete message

--- src-cljs/cljsbuild_ui/pages/main.cljs
+++ src-cljs/cljsbuild_ui/pages/main.cljs
@@ -2,6 +2,7 @@
   (:require-macros
     [cljs.core.async.macros :refer [go]])
   (:require
+    [clojure.string :refer [replace]]
     [cljs.core.async :refer [<!]]
     [quiescent :include-macros true]
     [sablono.core :as sablono :include-macros true]
@@ -211,12 +212,16 @@
                            :order filenames)]
     (swap! state assoc :projects project-map)))

+(def delete-confirm-msg (str
+  "Remove % from the build tool?\n\n"
+  "This action will have no effect on the filesystem."))
+
 (defn try-remove-project!
-  [filename]
-  (let [msg "Remove this project? (This will NOT delete it from filesystem.)"
-        proceed (.confirm js/window msg)]
-  (when proceed
-    (.send ipc "request-remove-project" filename))))
+  [prj-name filename]
+  (let [msg (replace delete-confirm-msg "%" prj-name)
+        delete? (.confirm js/window msg)]
+    (when delete?
+      (.send ipc "request-remove-project" filename))))

 (defn try-add-existing-project! []
   (.send ipc "request-add-existing-project"))
@@ -668,7 +673,7 @@
                   ;; NOTE: hiding edit link for now
                   ;; [:i.fa.fa-edit.project-icon-1711d]
                   [:i.fa.fa-times.project-icon-1711d
-                    {:on-click #(try-remove-project! prj-key)}]))]]
+                    {:on-click #(try-remove-project! (:name prj) prj-key)}]))]]
           [:div.right-f5656
             (case (:state prj)
               :auto (auto-state prj-key)


only show drawing for logged-out users

only show drawing for logged-out users

--- src-cljs/frontend/components/app.cljs
+++ src-cljs/frontend/components/app.cljs
@@ -49,7 +49,8 @@
     (render [_]
       (if (:navigation-point app)
         (dom/div #js {:id "app" :className "app"}
-          (when (:document/id app)
+          (when (and (:document/id app)
+                     (not (:cust app)))
             (om/build drawing/signup-button {:db/id (:document/id app)}))
           (om/build overlay/main-menu-button (select-in app [state/overlays-path state/main-menu-learned-path]))
           (when (overlay-visible? app)


explicitly add tbody, prevents rendering bug

--- frontend/src/leftover/ui.cljs
+++ frontend/src/leftover/ui.cljs
@@ -32,7 +32,7 @@
                               ; (dom/th  "When")
                               (dom/th  "Location")
                               (dom/th  "Amount")))
-                          (map hist->tr (:previous-payments data)))
+                          (dom/tbody (map hist->tr (:previous-payments data))))
                ))))

 (defn handle-change


more cleanup that seems to eliminate the stack-overflow problem

--- src/babel/italiano/morphology.cljc
+++ src/babel/italiano/morphology.cljc
@@ -1704,45 +1704,33 @@
                           (log/trace (str "lexeme key:" k))
                           (log/trace (str (first lexeme-kv) " generating exception for path: " path))
                           (mapcat (fn [lexeme]
-                                    ;; this is where a unify/dissoc that supported
-                                    ;; non-maps like :top and :fail, would be useful:
-                                    ;; would not need the (if (not (fail? lexeme)..)) check
-                                    ;; to avoid a difficult-to-understand "java.lang.ClassCastException:
-                                    ;; clojure.lang.Keyword cannot be cast to clojure.lang.IPersistentMap" error.
-                                    (let [debug (log/debug (str "lexeme: " lexeme))
-                                          lexeme (cond (= lexeme :fail)
-                                                       :fail
-                                                       (= lexeme :top)
-                                                       :top
+                                    (if (not (= :none (get-in lexeme path :none)))
+                                      (do (log/debug (str (first lexeme-kv) " generating lexeme exceptional surface form: " (surface-form-fn lexeme)))
+                                          (list {(surface-form-fn lexeme)
+                                                 [(reduce
+                                                   (fn [a b]
+                                                     (cond
+                                                       (= a :fail)
+                                                       (do
+                                                         (log/warn (str ":fail in exception rule:"
+                                                                        (:label path-and-merge-fn)
+                                                                        "; lexeme's italiano:"
+                                                                        (strip-refs (get-in lexeme [:italiano]))))
+                                                         :fail)
+                                                       (= b :fail)
+                                                       (do
+                                                         (log/warn (str ":fail in exception rule:"
+                                                                        (:label path-and-merge-fn)
+                                                                        "; lexeme:"
+                                                                        (or (strip-refs (get-in lexeme [:italiano :italiano]))
+                                                                            (strip-refs (get-in lexeme [:italiano])))))
+                                                         :fail)
                                                        true
-                                                       lexeme)]
-                                      (if (not (= :none (get-in lexeme path :none)))
-                                        (do (log/debug (str (first lexeme-kv) " generating lexeme exceptional surface form: " (surface-form-fn lexeme)))
-                                            (list {(surface-form-fn lexeme)
-                                                   [(reduce
-                                                     (fn [a b]
-                                                       (cond
-                                                         (= a :fail)
-                                                         (do
-                                                           (log/warn (str ":fail in exception rule:"
-                                                                          (:label path-and-merge-fn)
-                                                                          "; lexeme's italiano:"
-                                                                          (strip-refs (get-in lexeme [:italiano]))))
-                                                           :fail)
-                                                         (= b :fail)
-                                                         (do
-                                                           (log/warn (str ":fail in exception rule:"
-                                                                          (:label path-and-merge-fn)
-                                                                          "; lexeme:"
-                                                                          (or (strip-refs (get-in lexeme [:italiano :italiano]))
-                                                                              (strip-refs (get-in lexeme [:italiano])))))
-                                                           :fail)
-                                                         true
-                                                         (unify a b)))
-                                                     [(dissoc-paths lexeme [[:italiano :italiano]])
-                                                      (merge-fn lexeme)
-                                                      {:italiano {:infinitive k
-                                                                  :exception true}}])]})))))
+                                                       (unify a b)))
+                                                   [(dissoc-paths lexeme [[:italiano :italiano]])
+                                                    (merge-fn lexeme)
+                                                    {:italiano {:infinitive k
+                                                                :exception true}}])]}))))
                                   lexemes)))
                       exceptions-rules))))
         (sort (keys lexicon)))))


Work around vh not working on mobile by using percentage

See
https://stackoverflow.com/questions/37112218/css3-100vh-not-constant-in-mobile-browser.
Basically, vh doesn't work on mobile because the viewport height
changes depending on if the bottom bar is showing & if the url field
is in collapsed mode.

--- src/braid/client/mobile/style.cljs
+++ src/braid/client/mobile/style.cljs
@@ -55,7 +55,7 @@

               [:>.global-settings
                {:overflow-y "auto"
-                :height "90vh"
+                :height "90%"
                 :margin-left "5em"}]

               [:>.group-header
@@ -80,9 +80,7 @@
                  {:flex-grow 2}]]]

               [:>.threads
-               {:padding-top "2.5rem"
-                :margin-top "-2.5rem"
-                :height "100%"
+               {:height "100%"
                 :box-sizing "border-box"}

                [:>.container
@@ -108,7 +106,7 @@
                   [:>.thread
                    mixins/flex
                    {:width "100vw"
-                    :height "calc(100vh - 2.5rem)"
+                    :height "calc(100% - 2.5rem)"
                     :background "#bbb"
                     :flex-direction "column"
                     :justify-content "flex-end"


make Sage check for correct subtypes on encountered ice

--- src/clj/game/cards-icebreakers.clj
+++ src/clj/game/cards-icebreakers.clj
@@ -301,7 +301,9 @@
                                  {:cost [:credit 1] :msg "add 3 strength" :effect (effect (pump card 3)) :pump 3}]})

    "Sage"
-   {:abilities [{:cost [:credit 2] :msg "break 1 code gate or barrier subroutine"}]
+   {:abilities [{:cost [:credit 2] :req (req (or (has? current-ice :subtype "Barrier")
+                                                 (has? current-ice :subtype "Code Gate")))
+                 :msg "break 1 code gate or barrier subroutine"}]
     :effect (req (add-watch state (keyword (str "sage" (:cid card)))
                             (fn [k ref old new]
                               (when (not= (get-in old [:runner :memory]) (get-in new [:runner :memory]))
@@ -372,4 +374,4 @@
    (cloud-icebreaker
      (auto-icebreaker ["Code Gate"]
                       {:abilities [{:cost [:credit 1] :msg "break 1 code gate subroutine"}
-                                   {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]}))})+                                   {:cost [:credit 1] :msg "add 1 strength" :effect (effect (pump card 1)) :pump 1}]}))})


Remove unnecessary lazy-load-key (#96)

Remove unnecessary lazy-load-key (#96)

--- src/cljs/snapshot/lumo/common.cljs
+++ src/cljs/snapshot/lumo/common.cljs
@@ -24,25 +24,23 @@
               :requires :uses :defs :require-macros :cljs.analyzer/constants :doc]]
     (letfn [(load-key [key]
               (let [resource (js/$$LUMO_GLOBALS.load (str file-prefix (munge key) JSON_EXT))]
-                (transit-json->cljs resource)))
-            (lazy-load-key [key]
-              (load-key key))]
+                (transit-json->cljs resource)))]
       (cljs/load-analysis-cache! state ns-sym
         (if eager?
           (zipmap keys (map load-key keys))
           (lazy-map
-            {:rename-macros           (lazy-load-key :rename-macros)
-             :renames                 (lazy-load-key :renames)
-             :use-macros              (lazy-load-key :use-macros)
-             :excludes                (lazy-load-key :excludes)
-             :name                    (lazy-load-key :name)
-             :imports                 (lazy-load-key :imports)
-             :requires                (lazy-load-key :requires)
-             :uses                    (lazy-load-key :uses)
-             :defs                    (lazy-load-key :defs)
-             :require-macros          (lazy-load-key :require-macros)
-             :cljs.analyzer/constants (lazy-load-key :cljs.analyzer/constants)
-             :doc                     (lazy-load-key :doc)}))))))
+            {:rename-macros           (load-key :rename-macros)
+             :renames                 (load-key :renames)
+             :use-macros              (load-key :use-macros)
+             :excludes                (load-key :excludes)
+             :name                    (load-key :name)
+             :imports                 (load-key :imports)
+             :requires                (load-key :requires)
+             :uses                    (load-key :uses)
+             :defs                    (load-key :defs)
+             :require-macros          (load-key :require-macros)
+             :cljs.analyzer/constants (load-key :cljs.analyzer/constants)
+             :doc                     (load-key :doc)}))))))

 (defn- load-core-analysis-caches [state eager?]
   (load-core-analysis-cache state eager? 'cljs.core "cljs/core.cljs.cache.aot.")


remove comment

remove comment

--- src/cljs/tictactoe/logic/turn.cljs
+++ src/cljs/tictactoe/logic/turn.cljs
@@ -26,7 +26,7 @@
   {:board (board/new-empty-board)
    :player :cell/cross})

-(defn game-over?                                            ;; TODO - Applies on board, not turn... fails the unit test
+(defn game-over?
   [{:keys [board]}]
   (or
     (board/full-board? board)


Remove unused file

Remove unused file

--- src/clojure_fabric/grpc_server.clj
+++ src/clojure_fabric/grpc_server.clj
@@ -1,24 +0,0 @@
-;; Copyright 2017 Jong-won Choi <oz.jongwon.choi@gmail.com>
-;;
-;; Licensed under the Apache License, Version 2.0 (the "License")
-;; you may not use this file except in compliance with the License.
-;; You may obtain a copy of the License at
-;;
-;;     http://www.apache.org/licenses/LICENSE-2.0
-;;
-;; Unless required by applicable law or agreed to in writing, software
-;; distributed under the License is distributed on an "AS IS" BASIS,
-;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-;; See the License for the specific language governing permissions and
-;; limitations under the License.
-
-(ns clojure-fabric.grpc-server
-  #_
-  (:gen-class
-   :name clojure-fabric.grpc-server.RouteGuideServer
-   :extends io.grpc.examples.routeguide.RouteGuideGrpc$RouteGuideImplBase)
-  #_
-  (:import [io.grpc.stub StreamObserver])
-  #_
-  (:use [grpc-clj.util]))
-


Show more of code fragment form when not hovering over it

Using display: none when not hovering instead of visibility: hidden
means that we can use the full width of the code fragment when we are
not hovering over it.

--- src/day8/re_frame_10x/view/fx.cljs
+++ src/day8/re_frame_10x/view/fx.cljs
@@ -22,6 +22,8 @@
      :background-color code-hover-background-color}]
    [:.code-fragment
     {:background-color common/white-background-color}
+    [:.code-fragment__content
+     {:height "19px"}]
     [:.code-fragment__result
      {:visibility "hidden"
       :color "#b4b4b4"}] ;; Was common/medium-gray
@@ -30,8 +32,7 @@
      [:.code-fragment__result
       {:visibility "visible"}]]
     [:.code-fragment__button
-     {:visibility   "hidden"
-      :height       "19px"
+     {:display "none"
       :padding-left "6px"
       :margin-left  "6px"
       :border-left  "1px solid #cdd8df"
@@ -39,7 +40,7 @@
       :color        common/blue-modern-color}]
     [:&:hover
      [:.code-fragment__button
-      {:visibility "visible"}]]
+      {:display "grid"}]]
     ]])

 ;; Terminology: