Fix sorting of unread items.

Fix sorting of unread items.

--- src/oc/storage/db/common.clj
+++ src/oc/storage/db/common.clj
@@ -255,7 +255,8 @@
              (pos? limit))
          (boolean? count)]}
   (let [order-fn (if (= order :desc) r/desc r/asc)
-        unread-cap-seconds (* 60 60 24 config/threads-unread-cap-days)]
+        unread-cap-seconds (* 60 60 24 config/threads-unread-cap-days)
+        read-items-map (r/coerce-to (zipmap (map :item-id read-items) (map :read-at read-items)) :object)]
     (db-common/with-timeout db-common/default-timeout
       (as-> (r/table "interactions") query
        (r/get-all query [[org-uuid true true]] {:index :org-uuid-root-comments})
@@ -278,15 +279,22 @@
                                (r/default (r/get-field row :created-at))
                                (r/iso8601)
                                (r/to-epoch-time))
-              entries-base (-> (r/table "entries") (r/get (r/get-field row [:resource-uuid])))]
+              entries-base (-> (r/table "entries") (r/get (r/get-field row [:resource-uuid])))
+              unread-thread? (r/or (r/not (r/contains (r/keys read-items-map) (r/get-field row :resource-uuid)))
+                                   (r/gt (-> last-activity-at (r/iso8601) (r/to-epoch-time) (r/round))
+                                         (-> (r/get-field row :resource-uuid)
+                                          (as-> x (r/get-field read-items-map x))
+                                          (r/iso8601)
+                                          (r/to-epoch-time)
+                                          (r/round))))
+              unread-with-cap? (r/or unread-thread?
+                                     (r/gt (-> last-activity-at (r/iso8601) (r/to-epoch-time) (r/round))
+                                           (-> (r/now) (r/to-epoch-time) (r/sub unread-cap-seconds) (r/round))))]
           {:reply-count (r/count interactions-base)
            ;; Date of the last added comment on this thread
            :last-activity-at last-activity-at
-           ; :sort-value (clj-time.coerce/to-long (t/minus (t/now) (t/hours (int (rand 1000)))))
-           :sort-value (r/branch (r/and (r/not (r/contains (vec read-items) (r/get-field row :resource-uuid)))
-                                        (r/or (r/eq config/threads-unread-cap-days 0)
-                                              (r/gt (-> last-activity-at (r/iso8601) (r/to-epoch-time) (r/round))
-                                                    (-> (r/now) (r/to-epoch-time) (r/sub unread-cap-seconds) (r/round)))))
+           :unread-thread unread-with-cap?
+           :sort-value (r/branch unread-with-cap?
                          ;; If the item is unread and was published in the cap window
                          ;; let's add the cap window to the publish timestamp so it will sort before the read items
                          (-> sort-value-base


asserting machine existence in provided values

--- src/celestial/persistency/systems.clj
+++ src/celestial/persistency/systems.clj
@@ -190,7 +190,8 @@

 (defn templatize
   "Create a system from a template"
-   [name {:keys [env] :as provided}]
+   [name {:keys [env machine] :as provided}]
+   {:pre [machine (machine :hostname) (machine :domain)]}
    (let [{:keys [defaults] :as t} (get-template! name)]
      (add-system (merge-with merge t (defaults env) provided))))


rn conform-spec compile-spec

rn conform-spec compile-spec

--- src/cljc/commos/delta/compscribe.cljc
+++ src/cljc/commos/delta/compscribe.cljc
@@ -33,16 +33,17 @@
              {}
              m))

-(defn- conform-spec
+(defn- compile-spec
   "Recursively transform spec [endpoint hooks] [endpoint
   flattened-keys-hooks flattened-keys-hooks-grouped-by-pks hooks].
   The resulting structure provides fast lookups required during live
   dispatch."
   [spec]
-  (let [mark-spec #(vary-meta % assoc ::spec? true)]
+  (let [spec? #(::spec (meta %))
+        mark-spec #(vary-meta % assoc ::spec true)]
     (->> (mark-spec spec)
          (prewalk (fn [form]
-                    (if (::spec? (meta form))
+                    (if (spec? form)
                       (let [[endpoint specs] form]
                         (mark-spec
                          (if (vector? specs)
@@ -53,7 +54,7 @@
                                                     (vals specs)))]))))
                       form)))
          (postwalk (fn [form]
-                     (if (::spec? (meta form))
+                     (if (spec? form)
                        (let [[endpoint specs] form]
                          [endpoint specs (group-by-pks specs)])
                        form))))))


show all bookmarks

show all bookmarks

--- src/cljs/lesezeichen/client/core.cljs
+++ src/cljs/lesezeichen/client/core.cljs
@@ -189,7 +189,7 @@
                         :verify-token (do
                                         (om/transact! app :user (fn [old new] (assoc-in old [:token-status] data)))
                                         (case data
-                                          :valid (>! ws-channel {:topic :get-user-bookmarks :data (:email local-store) :token (:token local-store)})
+                                          :valid (>! ws-channel {:topic :get-all-bookmarks :data (:email local-store) :token (:token local-store)})
                                           :invalid (om/set-state! owner :info-text "invalid token")
                                           :expired (om/set-state! owner :info-text "token expired")))
                         (println "Unknown topic"))


add gdpr status to session

add gdpr status to session

--- src/cljs/salava/core/ui/dispatch.cljs
+++ src/cljs/salava/core/ui/dispatch.cljs
@@ -31,6 +31,7 @@
 (session/put! :private (:private ctx))
 (session/put! :footer (:footer ctx))
 (session/put! :factory-url (:factory-url ctx))
+(session/put! :gdpr-disabled? (:gdpr-disabled? ctx))
 ;;;


test hook

test hook

--- src/main/cawala/api/read.clj
+++ src/main/cawala/api/read.clj
@@ -6,7 +6,7 @@
                      :person/relation :friend}
                  2  {:db/id 2 :person/name "Sally" :person/age 22
                      :person/relation :friend}
-                 3  {:db/id 3 :person/name "Allie" :person/age 54
+                 3  {:db/id 3 :person/name "Allie" :person/age 55
                      :person/relation :enemy}
                  4  {:db/id 4 :person/name "Zoe" :person/age 32
                      :person/relation :friend}


Spelling correction in log message.

Spelling correction in log message.

--- src/cmr/metadata_db/services/jobs.clj
+++ src/cmr/metadata_db/services/jobs.clj
@@ -21,7 +21,7 @@

 (defjob ExpiredConceptCleanupJob
   [ctx]
-  (info "Excuting expired concepts cleanup.")
+  (info "Executing expired concepts cleanup.")
   (try
     (let [db (db-holder/get-db)]
       (doseq [provider (provider-db/get-providers db)]


Use eval to return numbers

Use eval to return numbers

--- src/play_clj/core_basics.clj
+++ src/play_clj/core_basics.clj
@@ -113,7 +113,7 @@
     (key-code :a)
     (key-code :page-down)"
   [k]
-  (u/gdx-field "Input$Keys" (u/key->upper k)))
+  (eval (u/gdx-field "Input$Keys" (u/key->upper k))))

 (defmacro key-pressed?
   "Returns a boolean indicating if the key cooresponding to `k` is being pressed.
@@ -128,7 +128,7 @@

     (button-code :left)"
   [k]
-  (u/gdx-field "Input$Buttons" (u/key->upper k)))
+  (eval (u/gdx-field "Input$Buttons" (u/key->upper k))))

 (defmacro button-pressed?
   "Returns a boolean indicating if the button cooresponding to `k` is being pressed.


<forgot to include this file in earlier checkin>

--- src/midje/checkers/simple.clj
+++ src/midje/checkers/simple.clj
@@ -10,11 +10,13 @@
   [actual]
   (and (not (captured-exception? actual))
        (not (not actual))))
+(def TRUTHY truthy)

 (defchecker falsey
   "Returns precisely true if actual is nil or false."
   [actual]
   (not actual))
+(def FALSEY falsey)

 (defchecker anything
   "Accepts any value"


Remove and recreate the FIFO prior to starting mplayer

--- src/moodseer_clj/process.clj
+++ src/moodseer_clj/process.clj
@@ -36,6 +36,8 @@

 (defn start-player [& playlist]
   (do
+    (mkfifo)
+    (Thread/sleep 200)
     (println (str player-cmd " " (clojure.string/join " " playlist) " 1>/tmp/mplayer-out.log 2>&1 & \n echo $!"))
     (sh "bash" "-c" (str player-cmd " " (first playlist) " 1>/tmp/mplayer-out.log 2>&1 & \n echo $!"))))


Add sum cgen and make it behave similar to mix. Modify mix to divide the signal by the number of inputs being mixed.

--- src/overtone/sc/cgens/mix.clj
+++ src/overtone/sc/cgens/mix.clj
@@ -3,11 +3,17 @@
         [overtone.helpers lib]
         [overtone.helpers stereo]))

+(defcgen sum
+  "sum a list of input channels into a single channel."
+  [ins {:default [] :doc "list of input channels to sum"}]
+  "Sum the list of input channels by summing them together. Be careful about summing too many channels together as the resulting signal will be progressively amplified."
+  (:ar (apply + ins)))
+
 (defcgen mix
-  "Mix down (sum) a list of input channels into a single channel."
+  "Mix a list of input channels into a single channel."
   [ins {:default [] :doc "list of input channels to mix"}]
-  "Mixes down the list of input channels by summing them together. Be careful about mixing too many channels together as the resulting signal will be progressively amplified."
-  (:ar (apply + ins)))
+  "Mix the list of input channels by summing them together and dividing by the number of input signals. See sum if you wish to just add the signals together."
+  (:ar (* (apply + ins) (/ 1 (count ins)))))

 (defcgen splay
   "Spread input channels across a stereo field"


Make Eastwood happy. Thanks Eastwood.

Make Eastwood happy. Thanks Eastwood.

--- src/oc/storage/api/polls.clj
+++ src/oc/storage/api/polls.clj
@@ -1,8 +1,6 @@
 (ns oc.storage.api.polls
   "Liberator API for poll resources."
-  (:require [clojure.string :as s]
-            [defun.core :refer (defun-)]
-            [if-let.core :refer (if-let* when-let*)]
+  (:require [if-let.core :refer (if-let* when-let*)]
             [taoensso.timbre :as timbre]
             [compojure.core :as compojure :refer (OPTIONS POST DELETE)]
             [liberator.core :refer (defresource by-method)]
@@ -95,7 +93,7 @@
   :available-media-types (by-method {
                             :post [mt/poll-reply-media-type]})
   :handle-not-acceptable (by-method {
-                            :post (api-common/only-accept 406 mt/entry-poll-media-type)})
+                            :post (api-common/only-accept 406 mt/poll-media-type)})

   ;; Media type client sends
   :known-content-type? (by-method {
@@ -152,7 +150,7 @@
   :available-media-types (by-method {
                             :delete [mt/poll-reply-media-type]})
   :handle-not-acceptable (by-method {
-                            :delete (api-common/only-accept 406 mt/entry-poll-media-type)})
+                            :delete (api-common/only-accept 406 mt/poll-media-type)})

   ;; Media type client sends
   :known-content-type? true
@@ -202,8 +200,8 @@

   ;; Media type client accepts
   :available-media-types (by-method {
-                            :post [mt/entry-poll-media-type]
-                            :delete [mt/entry-poll-media-type]})
+                            :post [mt/poll-media-type]
+                            :delete [mt/poll-media-type]})
   :handle-not-acceptable (by-method {
                             :post (api-common/only-accept 406 mt/entry-media-type)
                             :delete (api-common/only-accept 406 mt/entry-collection-media-type)})


Add test string

Add test string

--- test/cljs/fatlip/core_test.cljs
+++ test/cljs/fatlip/core_test.cljs
@@ -146,7 +146,8 @@
            (assoc next-layer :measures {nl-node-1 0
                                         nl-node-2 1
                                         nl-node-3 0
-                                        nl-node-4 1})))))
+                                        nl-node-4 1}))
+        "Measures are set correctly")))

 (deftest test-single-edge-sub-crossings


Cosmetic changes on core-tests.

Cosmetic changes on core-tests.

--- test/catacumba/core_tests.clj
+++ test/catacumba/core_tests.clj
@@ -112,7 +112,7 @@

 (deftest form-parsing
-  (testing "Multipart form parsing."
+  (testing "Multipart form parsing with multiple files."
     (let [p (promise)
           handler (fn [context]
                     (let [form (parse/parse context)]


Fix an interest op test to be more correct

--- test/picard/test/net/server.clj
+++ test/picard/test/net/server.clj
@@ -197,14 +197,17 @@
      (receive ch2 (fn [_] (dn :resume nil)))
      (let [latch (atom true)]
        (fn [evt val]
-         (enqueue ch1 [evt val])
+         (when-not (#{:pause :resume} evt)
+           (enqueue ch1 [evt val]))
          (when (and (= :message evt) @latch)
            (dn :pause nil)
            (reset! latch false))))))

   (write-socket "Hello world")
   (flush-socket)
+
   (Thread/sleep 50)
+
   (write-socket "Goodbye world")
   (close-socket)

@@ -219,7 +222,3 @@
        ch1
        :message "Goodbye world"
        :close   nil)))
-
-;; TODO: Tests for interest ops
-
-


Remove unused dependency

Remove unused dependency

--- test/icecap/e2e/http_test.clj
+++ test/icecap/e2e/http_test.clj
@@ -3,7 +3,6 @@
   (:require [icecap.e2e.common :refer :all]
             [clojure.test :refer :all]
             [aleph.http :as http]
-            [manifold.deferred :refer [let-flow]]
             [taoensso.timbre :refer [info spy]]))

 (def http-server


(maint) Mark -open? as private

(maint) Mark -open? as private

Had overlooked making this function private in the original pass of converting
to a protocol.

--- src/puppetlabs/pcp/client.clj
+++ src/puppetlabs/pcp/client.clj
@@ -103,7 +103,7 @@
   [client :- Client]
   (= (state client) :connecting))

-(s/defn ^:always-validate -open? :- s/Bool
+(s/defn ^:always-validate ^:private -open? :- s/Bool
   [client :- Client]
   (= (state client) :open))


(PCP-700) Manage heartbeat thread automatically

Starts the heartbeat thread when a connection is established, so the
caller doesn't need to know about heartbeats.

--- src/puppetlabs/pcp/client.clj
+++ src/puppetlabs/pcp/client.clj
@@ -34,13 +34,7 @@

      NOTE: you must invoke this function to properly close the connection,
      otherwise reconnection attempts may happen and the heartbeat thread will
-     persist, in case it was previously started.")
-  (start-heartbeat-thread [client]
-    "Start a thread that will periodically send WebSocket pings to the pcp-broker.
-    The heartbeat thread will be stopped once the 'close' is invoked.
-    Propagate any unhandled exception thrown while attempting to connect.
-    Will raise ::not-connected if the client is not currently connected with the
-    pcp-broker."))
+     persist, in case it was previously started."))

 (def Handlers
   "schema for handler map. String keys are data_schema handlers,
@@ -51,8 +45,7 @@
 ;; with the dash so they're not clashing with the versions defined by
 ;; ClientInterface
 (declare -connecting? -connected?
-         -wait-for-connection -send! -close
-         -start-heartbeat-thread)
+         -wait-for-connection -send! -close)

 (s/defrecord Client
   [server :- s/Str
@@ -67,8 +60,7 @@
   (connected? [client] (-connected? client))
   (wait-for-connection [client timeout] (-wait-for-connection client timeout))
   (send! [client message] (-send! client message))
-  (close [client] (-close client))
-  (start-heartbeat-thread [client] (-start-heartbeat-thread client)))
+  (close [client] (-close client)))

 (s/defn ^:private -connecting? :- s/Bool
   [client :- Client]
@@ -122,26 +114,13 @@
   current set of connections as long as the 'should-stop' promise has
   not been delivered. Will keep a connection alive, or detect a
   stalled connection earlier."
-  [client :- Client]
-  (let [{:keys [should-stop websocket-client]} client]
-    (while (not (deref should-stop 15000 false))
-      (let [sessions (.getOpenSessions websocket-client)]
-        (log/debug (i18n/trs "Sending WebSocket ping"))
-        (doseq [session sessions]
-          (.. session (getRemote) (sendPing (ByteBuffer/allocate 1))))))
-    (log/debug (i18n/trs "WebSocket heartbeat task is about to finish"))))
-
-(s/defn ^:private -start-heartbeat-thread
-  "Ensures that the WebSocket connection is established and starts the WebSocket
-  heartbeat task. Propagates any unhandled exception thrown while attempting
-  to connect. Rasises ::not-connected in case the connection was not established."
-  [client :- Client]
-  (log/trace (i18n/trs "Ensuring that the WebSocket is connected"))
-  (when-not (-connected? client)
-    (throw+ {:type ::not-connected}))
-  (log/debug (i18n/trs "WebSocket heartbeat task is about to start {0}" client))
-  (.start (Thread. (partial heartbeat client))))
-
+  [websocket-client should-stop]
+  (while (not (deref should-stop 15000 false))
+    (let [sessions (.getOpenSessions websocket-client)]
+      (log/debug (i18n/trs "Sending WebSocket ping"))
+      (doseq [session sessions]
+        (.. session (getRemote) (sendPing (ByteBuffer/allocate 1))))))
+  (log/debug (i18n/trs "WebSocket heartbeat task is about to finish")))

 (s/defn ^:private make-connection :- Object
   "Returns a connected WebSocket connection. In case of a SSLHandShakeException
@@ -152,18 +131,23 @@
         initial-sleep 200
         sleep-multiplier 2
         maximum-sleep (* 15 1000)]
-    (loop [retry-sleep initial-sleep]
+    ;; Use a separate promise for ensuring the heartbeat stops when connection is closed.
+    ;; If a new connection is established, a new heartbeat thread will start.
+    (loop [retry-sleep initial-sleep
+           stop-heartbeat (promise)]
       (or (try+
             (log/debug (i18n/trs "Making connection to {0}" server))
             (ws/connect server
                         :client websocket-client
                         :on-connect (fn [session]
-                                      (log/debug (i18n/trs "WebSocket connected")))
+                                      (log/debug (i18n/trs "WebSocket connected, heartbeat task starting"))
+                                      (.start (Thread. (partial heartbeat websocket-client stop-heartbeat))))
                         :on-error (fn [error]
                                     (log/error error (i18n/trs "WebSocket error")))
                         :on-close (fn [code message]
                                     ;; Format error code as a string rather than a localized number, i.e. 1,234.
                                     (log/debug (i18n/trs "WebSocket closed {0} {1}" (str code) message))
+                                    (deliver stop-heartbeat true)
                                     (let [{:keys [should-stop websocket-connection]} client]
                                       ;; Ensure disconnect state is immediately registered as connecting.
                                       (log/debug (i18n/trs "Sleeping for up to {0} ms to retry" retry-sleep))
@@ -189,7 +173,7 @@
             (catch Object _
               (log/error (:throwable &throw-context) (i18n/trs "Unexpected error"))
               (throw+)))
-          (recur (min maximum-sleep (* retry-sleep sleep-multiplier)))))))
+          (recur (min maximum-sleep (* retry-sleep sleep-multiplier)) (promise))))))

 (s/defn -wait-for-connection :- (s/maybe Client)
   "Waits until a client is connected. If timeout is hit, returns falsey"


round: Simplify apply-point-acceleration with reductions

--- src/rpi_challenger/core/round.clj
+++ src/rpi_challenger/core/round.clj
@@ -75,13 +75,12 @@

 (def ^:dynamic acceleration 1)

-(defn- points-based-on-acceleration [round previous-round]
+(defn- points-based-on-acceleration [previous-round round]
   (let [max-points (:points round)
         previous-points (:points previous-round 0)]
-    (-> round
-      (assoc :max-points max-points)
-      (assoc :points (min max-points (+ acceleration previous-points))))))
+    (assoc round
+      :max-points max-points
+      :points (min max-points (+ acceleration previous-points)))))

-; TODO: this might be rewriteable with http://clojuredocs.org/clojure_core/clojure.core/reductions
 (defn apply-point-acceleration [rounds]
-  (reduce (fn [previous-rounds round] (conj previous-rounds (points-based-on-acceleration round (last previous-rounds)))) [] rounds))
+  (rest (reductions points-based-on-acceleration nil rounds)))


Implement computing ad feature scores for a set of ads

--- domain/src/domain/core.clj
+++ domain/src/domain/core.clj
@@ -44,8 +44,44 @@
    :advertiser2 #{:ad3}
    :advertiser3 #{:ad4}})

+(defn get-scored-ads [current-ad->features resulting-features]
+  "Given a map of resulting features, compute the score for the features preferences set to each ad"
+  ; we'll reduce over our current ads-features map assigning a score to it
+  ; updated-ads-feature is the resulting map. ad is the ad id, feature-preferences is the feature-map
+  (reduce (fn [updated-ads->feature [ad feature-preferences]]
+            ; we only care about feature-map entries whose keys appear in the resulting map. select these.
+            (let [matching-features (select-keys
+                                      feature-preferences
+                                      (keys resulting-features))
+                  ; now comes the juicy part.
+                  ; we'll reduce each feature-map to a single score for that map.
+                  matching-features-score (reduce-kv
+                                            ; init score is 0, (k v) is the current map entry
+                                            (fn [init k v]
+                                              ; check if the value of this feature and the
+                                              ; value of the resulting feature match up
+                                              (if (= v (resulting-features k))
+                                                ; if so, increment the score
+                                                (inc init)
+                                                ; or just pass it along
+                                                init))
+                                            ; score starts at zero
+                                            0
+                                            ; the entry we're reducing over
+                                            matching-features)]
+              ; finally, put ads->features back together
+              (assoc updated-ads->feature
+                ; by associating the ad
+                ad
+                ; with the an extra entry that contains the score for that feature
+                (assoc feature-preferences :score matching-features-score))))
+          ; a new map to put everything in
+          {}
+          ; the map we want to reduce over
+          current-ad->features))
+
 (defroutes app-routes
-  (GET "/status" [] "OMG HI!")
+  (GET "/" [] "OMG HI!")
   (route/not-found "Not Found"))

 (def app


Fixing weasel to allow for in browser repl

--- env/dev/clj/corona/dev.clj
+++ env/dev/clj/corona/dev.clj
@@ -18,7 +18,7 @@

 (defn browser-repl []
   (let [repl-env (weasel/repl-env :ip "0.0.0.0" :port 9001)]
-    (piggieback/cljs-repl :repl-env repl-env)))
+    (piggieback/cljs-repl repl-env)))

 (defn start-figwheel []
   (let [server (fig/start-server { :css-dirs ["resources/public/css"] })


autofocus search, thanks html5

autofocus search, thanks html5

--- src/semtag_web/views/main.clj
+++ src/semtag_web/views/main.clj
@@ -12,7 +12,7 @@
     [:body
       [:div#main
        [:div.top_box
-        [:input {:type "text" :id "url_search_text"}]
+        [:input {:type "text" :autofocus "autofocus" :id "url_search_text"}]
         [:button {:class "btn-primary" :id "url_search_button"} "Search"]
         [:h2 "No search results yet"]
         [:table#search_table {:class "table table-bordered table-striped"}


1.2.2  Tree Recursion

1.2.2  Tree Recursion

--- src/sicp/chapter1/2_2.clj
+++ src/sicp/chapter1/2_2.clj
@@ -3,3 +3,50 @@
 ;;;; 1.2  Procedures and the Processes They Generate

 ;;; 1.2.2  Tree Recursion
+
+(defn fib [n]
+  (cond (== n 0) 0
+        (== n 1) 1
+        :else (+ (fib (- n 1))
+                 (fib (- n 2)))))
+
+(defn fib-iter [a b cnt]
+  (if (zero? cnt)
+    b
+    (recur (+ a b) a (dec cnt))))
+
+(defn fib' [n]
+  (fib-iter 1 0 n))
+
+(defn first-denomination [kinds-of-coins]
+  (case kinds-of-coins
+    1 1
+    2 5
+    3 10
+    4 25
+    5 50
+    nil))
+
+(defn cc [amount kinds-of-coins]
+  (cond (zero? amount) 1
+        (or (< amount 0) (= kinds-of-coins 0)) 0
+        :else (+ (cc amount
+                     (dec kinds-of-coins))
+                 (cc (- amount
+                        (first-denomination kinds-of-coins))
+                     kinds-of-coins))))
+
+(defn count-change [amount]
+  (cc amount 5))
+
+(count-change 100)
+
+;; Exercise 1.11
+;; TODO
+
+;; Exercise 1.12
+
+;; TODO
+
+;; Exercise 1.13
+;; TODO


check function refacto

check function refacto

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -890,27 +890,18 @@
 ;;122 Read a binary number
 #(Integer/parseInt % 2)

-;;
+;;124
 (def r '[[e e e e]
          [e w b e]
          [e b w e]
          [e e e e]])
-(defn ray [f1 f2 s] (rest (iterate (fn [[y x]] [(f1 y) (f2 x)]) s)))
-(defn d1 [s]
-  (for [p (ray inc inc s) :while (not= 'e (get-in r p))] (get-in r p)))
-(defn d2 [s]
-  (for [p (ray dec dec s) :when (get-in r p)] (get-in r p)))
-(defn d3 [s]
-  (for [p (ray inc dec s) :when (get-in r p)] (get-in r p)))
-(defn d4 [s]
-  (for [p (ray dec inc s) :when (get-in r p)] (get-in r p)))
-(defn v1 [s]
-  (for [p (ray dec identity s) :when (get-in r p)] (get-in r p)))
-(defn v2 [s]
-  (for [p (ray inc identity s) :when (get-in r p)] (get-in r p)))
-(defn h1 [s]
-  (for [p (ray identity dec s) :when (get-in r p)] (get-in r p)))
-(defn h2 [s]
-  (for [p (ray identity inc s) :when (get-in r p)] (get-in r p)))
-
-
+
+(defn chk
+  ([[y x] fy fx] (chk [(fy y) (fx x)] fy fx []))
+  ([[y x :as p] fy fx res]
+   (cond
+     (= 'w (get-in r p)) (chk [(fy y) (fx x)] fy fx (conj res p))
+     (= 'b (get-in r p)) res
+     :else [])))
+
+


tilemap example code

tilemap example code

--- examples/tilemap/src/tilemap/core.cljs
+++ examples/tilemap/src/tilemap/core.cljs
@@ -1,16 +1,71 @@
 (ns tilemap.core
-  (:require ))
+  (:require  [infinitelives.pixi.canvas :as c]
+             [infinitelives.pixi.resources :as r]
+             [infinitelives.pixi.tilemap :as tm]
+             [infinitelives.utils.events :as e]
+             [infinitelives.utils.console :refer [log]]
+)
+
+  (:require-macros [cljs.core.async.macros :refer [go]]
+                   [infinitelives.pixi.macros :as m]))
+

 (enable-console-print!)

-(println "This text is printed from src/tilemap/core.cljs. Go ahead and edit it and see reloading in action.")
+(defonce bg-colour 0x0D0711)

-;; define your app data so that it doesn't get over-written on reload
+(def tile-map-chars
+  [
+   "┌──────╖"
+   "│o   oo║"
+   "│ .    ║"
+   "│     o║"
+   "│o   . ║"
+   "│o .  o║"
+   "│oo  oo║"
+   "╘══════╝"])

-(defonce app-state (atom {:text "Hello world!"}))
+(def key-for
+  {
+   "┌" :wall-top-left
+   "╖" :wall-top-right
+   "╘" :wall-bottom-left
+   "╝" :wall-bottom-right
+   "─" :wall-top
+   "│" :wall-left
+   "║" :wall-right
+   "═" :wall-bottom
+   " " :floor
+   "." :floor-2
+   "o" :floor-3})

-(defn on-js-reload []
-  ;; optionally touch your app-state to force rerendering depending on
-  ;; your application
-  ;; (swap! app-state update-in [:__figwheel_counter] inc)
-)
+(def tile-set-mapping
+  {
+   :wall-top-left [48 0]
+   :wall-top-right [64 0]
+   :wall-bottom-left [48 16]
+   :wall-bottom-right [64 16]
+   :wall-top [16 32]
+   :wall-left [32 16]
+   :wall-right [0 16]
+   :wall-bottom [16 0]
+   :floor [96 0]
+   :floor-2 [112 0]
+   :floor-3 [128 32]})
+
+(defonce canvas
+  (c/init {:layers [:bg :tilemap :ui]
+           :background bg-colour
+           :expand true}))
+
+(defonce main
+  (go
+    ;; load resource url with tile sheet
+    (<! (r/load-resources canvas :ui ["img/tiles.png"]))
+
+    (let [tile-set (tm/make-tile-set :tiles tile-set-mapping [16 16])]
+      (log "tile-set:" tile-set)
+      (m/with-sprite :tilemap
+        [tile-map (tm/make-tilemap tile-set key-for tile-map-chars
+                                   :scale 4)]
+        (<! (e/wait-frames 10000))))))


Couple of comment edits for todomvc

Couple of comment edits for todomvc

--- examples/todomvc/src/todomvc/subs.cljs
+++ examples/todomvc/src/todomvc/subs.cljs
@@ -91,18 +91,18 @@
       (filter filter-fn todos))))

 ;; -------------------------------------------------------------------------------------
-;; HEY, WAIT ON
+;; Hey, wait on!!
 ;;
-;; How did those two simple registrations at the top work, I hear you ask?
-;; We supplied only one function in those registrations, not two?
-;; I'm glad you asked.
-;; You see, when the signal-returning-fn is omitted, register-pure-sub provides a default.
-;; And it looks like this:
+;; How did those two simple registrations at the top work?
+;; We only supplied one function in those registrations, not two?
+;; Very observant of you, I'm glad you asked.
+;; When the signal-returning-fn is omitted, re-sub provides a default,
+;; and it looks like this:
 ;;    (fn [_ _] re-frame.db/app-db)
-;; You can see that it returns one signal, and that signal is app-db itself.
+;; It returns one signal, and that signal is app-db itself.
 ;;
-;; So that's why those two simple registrations didn't provide a signal-fn, but they
-;; still got the value in app-db supplied as that first parameter.
+;; So the two simple registrations at the top didn't need to provide a signal-fn,
+;; because they operated only on the value in app-db, supplied as 'db' in the 1st arguement.

 ;; -------------------------------------------------------------------------------------
 ;; SUGAR ?
@@ -115,7 +115,7 @@
 ;; register-pure-sub provides some macro sugar so you can nominate a very minimal
 ;; vector of input signals. The 1st function is not needed.
 ;; Here is the example above rewritten using the sugar.
-#_(reg-sub)
+#_(reg-sub
   :visible-todos
   :<- [:todos]
   :<- [:showing]
@@ -124,7 +124,7 @@
                       :active (complement :done)
                       :done   :done
                       :all    identity)]
-      (filter filter-fn todos)))
+      (filter filter-fn todos))))

 (reg-sub
@@ -140,7 +140,7 @@
     (count (filter :done todos))))

 (reg-sub
-  :footer-counts                     ;; XXXX different from original. Now does not return showing
+  :footer-counts
   :<- [:todos]
   :<- [:completed-count]
   (fn [[todos completed] _]


lost in merges

lost in merges

--- stash/src/stash/core_sql.clj
+++ stash/src/stash/core_sql.clj
@@ -5,6 +5,9 @@

 (def- +where-operator-strings+
   {:= "=", :> ">", :>= ">=", :< "<", :<= "<=", :not= "<>"})
+
+(def- +where-nil-operator-strings+
+  {:= "IS", :not= "IS NOT"})

 (defn- where-conjunction-sql
   [conjunction]
@@ -15,6 +18,11 @@
   [operator]
   (or (+where-operator-strings+ operator)
       (throwf "invalid operator: %s" operator)))
+
+(defn- where-nil-operator-sql
+  [operator]
+  (or (+where-nil-operator-strings+ operator)
+      (throwf "invalid nil operator: %s" operator)))

 (defn- where-exp-sql
   [model where-exp]
@@ -41,7 +49,9 @@
     ; [:foo :> 20]
     :else
       (str "(" (name (where-exp 0)) " "
-               (where-operator-sql (where-exp 1)) " "
+               (if (nil? (where-exp 2))
+                 (where-nil-operator-sql (where-exp 1))
+                 (where-operator-sql (where-exp 1))) " "
                (((quoters-by-name model) (where-exp 0)) (where-exp 2)) ")")))

 (defn- where-sql


Better keybindings on OS X.

Better keybindings on OS X.

--- src/sqls/ui/worksheet.clj
+++ src/sqls/ui/worksheet.clj
@@ -18,23 +18,20 @@
            [org.fife.ui.rsyntaxtextarea RSyntaxTextAreaDefaultInputMap]])

-(defn fix-textarea-bindings
+(defn fix-textarea-bindings!
   ^JTextArea
   [^JTextArea t]
   (let [is-osx (-> (System/getProperty "os.name") (.toLowerCase) (.startsWith "mac os x"))]
     (when is-osx
-      (let [fix-map (fn [^InputMap m]
-                      (let [default-modifier (-> (Toolkit/getDefaultToolkit) (.getMenuShortcutKeyMask))
-                            shift InputEvent/SHIFT_MASK]
-                        (.put m (KeyStroke/getKeyStroke KeyEvent/VK_LEFT (bit-or default-modifier shift)) DefaultEditorKit/selectionBeginLineAction)
-                        (.put m (KeyStroke/getKeyStroke KeyEvent/VK_RIGHT (bit-or default-modifier shift)) DefaultEditorKit/selectionEndLineAction)
-                        (.put m (KeyStroke/getKeyStroke KeyEvent/VK_HOME shift) DefaultEditorKit/selectionBeginAction)
-                        (.put m (KeyStroke/getKeyStroke KeyEvent/VK_END shift) DefaultEditorKit/selectionEndAction)
-                        m))
-            base-map (RSyntaxTextAreaDefaultInputMap.)
-            new-map (fix-map base-map)]
-        (.setInputMap t JComponent/WHEN_FOCUSED new-map)))
-    t))
+      (let [m (.getInputMap t)]
+        (assert (not (nil? m)))
+        (let [default-modifier (-> (Toolkit/getDefaultToolkit) (.getMenuShortcutKeyMask))
+              shift InputEvent/SHIFT_MASK]
+          (.put m (KeyStroke/getKeyStroke KeyEvent/VK_LEFT (bit-or default-modifier shift)) DefaultEditorKit/selectionBeginLineAction)
+          (.put m (KeyStroke/getKeyStroke KeyEvent/VK_RIGHT (bit-or default-modifier shift)) DefaultEditorKit/selectionEndLineAction)
+          (.put m (KeyStroke/getKeyStroke KeyEvent/VK_HOME shift) DefaultEditorKit/selectionBeginAction)
+          (.put m (KeyStroke/getKeyStroke KeyEvent/VK_END shift) DefaultEditorKit/selectionEndAction)))))
+  t)

 (defn create-worksheet-frame
@@ -73,10 +70,10 @@
         ;            (let [[_ _ w h] dimensions]
         ;              [h :by w]))
         ;_ (println (format "pref size: %s" pref-size))
-        query-text-area (fix-textarea-bindings (seesaw.rsyntax/text-area :id :sql
-                                                                         :syntax :sql
-                                                                         :columns 80
-                                                                         :rows 25))
+        query-text-area (fix-textarea-bindings! (seesaw.rsyntax/text-area :id :sql
+                                                                          :syntax :sql
+                                                                          :columns 80
+                                                                          :rows 25))
         query-text-area-scrollable (seesaw.core/scrollable query-text-area)
         results-panel (seesaw.core/vertical-panel :id :results-panel
                                                   :preferred-size [800 :by 400])


ranking

ranking

--- src/4clojure/drop-nth.clj
+++ src/4clojure/drop-nth.clj
@@ -57,4 +57,9 @@
 (fn [coll n]
   (->> (partition-all n coll)
        (map (partial take (dec n)))
-       (flatten)))+       (flatten)))
+
+
+;; Username: ekhart
+;; Rank: 5047 out of 47109
+;; Problems Solved: 57 / 156


Make logic clearer

Make logic clearer

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -480,21 +480,19 @@
                     :subnets private-subnets
                     :lifecycle {:create_before_destroy true}
                     :elb []
-                    :alb (let [listeners (map #(assoc % :account-number account-number) slave-alb-listeners)]
-                           (if (seq listeners)
-                             [{:name "internal-tasks"
-                               :internal true
-                               :listeners listeners
-                               :subnets elb-private-subnets
-                               :security-groups (concat [(cluster-id-of "aws_security_group" "slave-alb-sg")]
-                                                        remote-default-sgs)}]
-                             []))})
-              (let [listeners (map #(assoc % :account-number account-number) slave-alb-listeners)]
-                (if (seq listeners)
-                  (vpc/private-route53-record "slaves"
-                                              environment-dns
-                                              environment-dns-identifier
-                                              {:zone_id (remote-output-of "vpc" "private-dns-zone")
-                                               :alias {:name (cluster-output-of "aws_alb" "internal-tasks" "dns_name")
-                                                       :zone_id (cluster-output-of "aws_alb" "internal-tasks" "zone_id")
-                                                       :evaluate_target_health true}}))))))))
+                    :alb (if (seq slave-alb-listeners)
+                           [{:name "internal-tasks"
+                             :internal true
+                             :listeners (map #(assoc % :account-number account-number) slave-alb-listeners)
+                             :subnets elb-private-subnets
+                             :security-groups (concat [(cluster-id-of "aws_security_group" "slave-alb-sg")]
+                                                      remote-default-sgs)}]
+                           [])})
+              (if (seq slave-alb-listeners)
+                (vpc/private-route53-record "slaves"
+                                            environment-dns
+                                            environment-dns-identifier
+                                            {:zone_id (remote-output-of "vpc" "private-dns-zone")
+                                             :alias {:name (cluster-output-of "aws_alb" "internal-tasks" "dns_name")
+                                                     :zone_id (cluster-output-of "aws_alb" "internal-tasks" "zone_id")
+                                                       :evaluate_target_health true}})))))))


allow custom IAM policies for applications

--- src/terraboot/cluster.clj
+++ src/terraboot/cluster.clj
@@ -109,7 +109,7 @@
                                                 {:path "/etc/mesosphere/roles/aws"
                                                  :content ""}]})))

-(defn exhibitor-bucket-policy [bucket-name]
+(defn bucket-policy [bucket-name]
   (let [bucket-arn (arn-of "aws_s3_bucket" bucket-name)]
     (policy {"Action" ["s3:AbortMultipartUpload",
                        "s3:DeleteObject",
@@ -249,6 +249,7 @@
            mesos-ami
            public-slave-alb-listeners
            public-slave-alb-sg
+           application-policies
            account-number]}]
   (let [vpc-unique (vpc-unique-fn vpc-name)
         vpc-id-of (id-of-fn vpc-unique)
@@ -332,34 +333,32 @@
              (cluster-resource "aws_iam_user_policy" "mesos-user-policy-s3"
                                {:name "mesos-user-policy-s3"
                                 :user (cluster-id-of "aws_iam_user" "mesos-user")
-                                :policy (exhibitor-bucket-policy (cluster-unique "exhibitor-s3-bucket"))})
+                                :policy (bucket-policy (cluster-unique "exhibitor-s3-bucket"))})
              (cluster-resource "aws_iam_access_key" "host-key" {:user (cluster-id-of "aws_iam_user" "mesos-user")})

              (iam-role "master-role"
                        cluster-unique
                        {:name "master-s3"
-                        :policy (exhibitor-bucket-policy (cluster-unique "exhibitor-s3-bucket"))}
+                        :policy (bucket-policy (cluster-unique "exhibitor-s3-bucket"))}
                        {:name "master-auto-scaling-policy"
                         :policy auto-scaling-policy}                       )

-             (iam-role "slave-role"
-                       cluster-unique
-                       {:name "amazon-s3-policy"
-                        :policy full-amazon-s3-access}
-                       {:name "cloudwatch-policy"
-                        :policy cloudwatch-metrics-policy}
-                       {:name "slave-eip-policy"
-                        :policy (policy {"Action" ["ec2:AssociateAddress"]})}
-                       {:name "slave-cloudwatch-policy"
-                        :policy (policy { "Action" ["cloudwatch:GetMetricStatistics",
-                                                    "cloudwatch:ListMetrics",
-                                                    "cloudwatch:PutMetricData",
-                                                    "EC2:DescribeTags" ]
-                                         "Condition" {"Bool" { "aws:SecureTransport" "true"}}})}
-                       {:name "slave-email-policy"
-                        :policy send-email-policy})
+             (apply (partial iam-role "slave-role"
+                             cluster-unique)
+                    (concat [{:name "cloudwatch-policy"
+                              :policy cloudwatch-metrics-policy}
+                             {:name "slave-eip-policy"
+                              :policy (policy {"Action" ["ec2:AssociateAddress"]})}
+                             {:name "slave-cloudwatch-policy"
+                              :policy (policy { "Action" ["cloudwatch:GetMetricStatistics",
+                                                          "cloudwatch:ListMetrics",
+                                                          "cloudwatch:PutMetricData",
+                                                          "EC2:DescribeTags" ]
+                                               "Condition" {"Bool" { "aws:SecureTransport" "true"}}})}
+                             {:name "slave-email-policy"
+                              :policy send-email-policy}] application-policies))

              (cluster-resource "template_file" "master-user-data"


A better order for response lookup

A better order for response lookup

--- src/themis/validators.clj
+++ src/themis/validators.clj
@@ -6,12 +6,15 @@
 ;; -----------------

 (defn response
+  "Resolve and return a validator's response;
+  The value of :response in the opt-map, the response-data passed directly
+  to the `response` fn or the default return via *default-response*"
   ([response-data]
    (response response-data {}))
   ([response-data opt-map]
    (or (:response opt-map)
-        *default-response*
-        response-data)))
+        response-data
+        *default-response*)))

 (defn from-predicate
   "Given a  predicate function that takes a single arg,
@@ -51,10 +54,6 @@
   (when (nil? data-point)
     (response "required value is nil" opt-map)))

-(defn numeric
-  ""
-  [t data-point opt-map])
-
 (comment

   )


Fixes #111

Fixes #111

--- src/yada/interceptors.clj
+++ src/yada/interceptors.clj
@@ -11,6 +11,7 @@
    [ring.middleware.params :refer [assoc-query-params]]
    [ring.swagger.coerce :as rsc]
    [ring.swagger.schema :as rs]
+   ring.util.time
    [schema.core :as s]
    [schema.coerce :as sc]
    [schema.utils :refer [error?]]


core: drop

core: drop

--- data/core.clj
+++ data/core.clj
@@ -1411,3 +1411,14 @@
    (when-let [s (seq coll)]
      (when (pred (first s))
        (cons (first s) (take-while pred (rest s)))))))
+
+(defn drop
+  "Returns a lazy sequence of all but the first n items in coll."
+  {:added "1.0"}
+  [n coll]
+  (let [step (fn [n coll]
+               (let [s (seq coll)]
+                 (if (and (pos? n) s)
+                   (recur (dec n) (rest s))
+                   s)))]
+    (lazy-seq (step n coll))))


Update worker project.cljs

Update worker project.cljs

--- example/worker/project.clj
+++ example/worker/project.clj
@@ -15,8 +15,8 @@
                  [net.polyc0l0r/hasch "0.2.3"]
                  ]

-  :npm {:dependencies [[xmlhttprequest "*"]
-                       [source-map-support "*"]
+  :npm {:dependencies [[xmlhttprequest "1.8.0"]
+                       [source-map-support "0.4.0"]
                        ; Added by Daigo
                        [mongoose "latest"]
                        [amqplib "latest"]


Fix development-mode version lookup.

Fix development-mode version lookup.

--- src/afterglow/version.clj
+++ src/afterglow/version.clj
@@ -10,7 +10,8 @@
   mode, or from the JAR manifest if running from a production build."
   []
   (or (env :afterglow-version)
-      (.getSpecificationVersion (.getPackage (class context/set-default-show!)))
+      (when-let [pkg (.getPackage (class context/set-default-show!))]
+        (.getSpecificationVersion pkg))
       "DEV")) ; Must be running in dev mode embedded in another project

 (defn title
@@ -19,5 +20,6 @@
   mode, or from the JAR manifest if running from a production build."
   []
   (or (env :afterglow-title)
-      (.getSpecificationTitle (.getPackage (class context/set-default-show!)))
+      (when-let [pkg (.getPackage (class context/set-default-show!))]
+        (.getSpecificationTitle pkg))
       "afterglow"))


Add test for invalid command in embedded CLI.

--- test/cli4clj/test/cli.clj
+++ test/cli4clj/test/cli.clj
@@ -228,6 +228,11 @@
         cli-fn (cli/embedded-cli-fn cli-opts)]
     (test/is (= "ERROR: Divide by zero" (cli-fn "divide 1 0")))))

+(test/deftest embedded-cli-unknown-command-test
+  (let [cli-opts {:cmds {:divide {:fn (fn [x y] (/ x y))}}}
+        cli-fn (cli/embedded-cli-fn cli-opts)]
+    (test/is (= "ERROR: Invalid command: \"[foo 1 0]\". Please type \"help\" to get an overview of commands." (cli-fn "foo 1 0")))))
+
 (test/deftest embedded-cli-multiline-out-test
   (let [cli-opts {:cmds {:print {:fn #(println % "\n" % "\n" %)}}}
         cli-fn (cli/embedded-cli-fn cli-opts)]


Fixed iplayer-down-cmd to use --working-directory

--- src/beebster_clj/core.clj
+++ src/beebster_clj/core.clj
@@ -71,8 +71,9 @@
 (defn iplayer-download-command
   "concatenate index and mode to download command"
    [index mode]
-   (list "gnome-terminal" "-e" (apply str "get-iplayer" " --modes=" mode "1"
-                                       " output=/home/martin/Videos" " -g " index)))
+   (list "gnome-terminal"
+         (apply str "--working-directory=" (System/getenv "HOME") "/Videos") "-e"  (apply str "get-iplayer" " --modes=" mode "1" " -g " index)))
+

 (defn get-url


Add missing bytes ns import on crypto ns.

--- src/buddy/core/crypto.clj
+++ src/buddy/core/crypto.clj
@@ -14,7 +14,8 @@

 (ns buddy.core.crypto
   "Modes implementation"
-  (:require [buddy.core.bytes :as bytes :refer [bytes?]])
+  (:require [buddy.core.bytes :as bytes]
+            [buddy.core.codecs :as codecs])
   (:import org.bouncycastle.crypto.engines.TwofishEngine
            org.bouncycastle.crypto.engines.BlowfishEngine
            org.bouncycastle.crypto.engines.AESEngine


Remove writer monad from labs.

Remove writer monad from labs.

--- src/cats/labs/writer.cljc
+++ src/cats/labs/writer.cljc
@@ -1,206 +0,0 @@
-;; Copyright (c) 2014-2015 Andrey Antukh <niwi@niwi.nz>
-;; Copyright (c) 2014-2015 Alejandro Gómez <alejandro@dialelo.com>
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;;    notice, this list of conditions and the following disclaimer.
-;; 2. Redistributions in binary form must reproduce the above copyright
-;;    notice, this list of conditions and the following disclaimer in the
-;;    documentation and/or other materials provided with the distribution.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
-;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
-;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
-;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
-;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-(ns cats.labs.writer
-  "The Writer Monad."
-  #?(:cljs (:require [cats.protocols :as p]
-                     [cats.builtin :as b]
-                     [cats.context :as ctx :include-macros true]
-                     [cats.data :as d]
-                     [cats.util :as util])
-     :clj  (:require [cats.protocols :as p]
-                     [cats.builtin :as b]
-                     [cats.context :as ctx]
-                     [cats.data :as d]
-                     [cats.util :as util])))
-
-(declare context)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Protocol declaration
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defprotocol MonadWriter
-  "A specific case of Monad abstraction that
-  allows emulate write operations in pure functional
-  way.
-
-  A great example is writing a log message."
-  (-listen [m mv] "Given a writer, yield a (value, log) pair as a value.")
-  (-tell [m v] "Add the given value to the log.")
-  (-pass [m mv]
-    "Given a writer whose value is a pair with a function as its second element,
-     yield a writer which has the first element of the pair as the value and
-     the result of applying the aforementioned function to the log as the new log."))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Type constructors and functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(deftype Writer [mfn]
-  p/Contextual
-  (-get-context [_] context)
-
-  #?@(:cljs [cljs.core/IFn
-             (-invoke [self seed]
-               (mfn seed))]
-      :clj  [clojure.lang.IFn
-             (invoke [self seed]
-               (mfn seed))]))
-
-(alter-meta! #'->Writer assoc :private true)
-
-(defn writer
-  "The Writer type constructor.
-
-  The purpose of Writer type is wrap a simple
-  function that fullfills the Writer signature.
-
-  It exists to avoid extending the Clojure
-  function type (it is already very generic) ."
-  [f]
-  (Writer. f))
-
-(defn writer?
-  "Return true if `s` is an instance
-  of the Writer type."
-  [s]
-  (instance? Writer s))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Monad definition
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^{:no-doc true}
-  context
-  (reify
-    p/Context
-    (-get-level [_] ctx/+level-default+)
-
-    p/Monad
-    (-mreturn [_ v]
-      (d/pair v (p/-mempty b/vector-context)))
-
-    (-mbind [_ mv f]
-      (let [[v log] mv
-            [v' log'] (f v)]
-        (d/pair v' (p/-mappend (p/-get-context log) log log'))))
-
-    MonadWriter
-    (-tell [_ v]
-      (d/pair nil [v]))
-
-    (-listen [_ mv]
-      (d/pair mv (second mv)))
-
-    (-pass [_ mv]
-      (let [[v f] (first mv)]
-        (d/pair v (f (second mv)))))
-
-    p/Printable
-    (-repr [_]
-      #"<Writer>")))
-
-(util/make-printable (type context))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Monad Transformer
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn writer-t
-  "The Writer transformer constructor."
-  [inner-context]
-  (reify
-    p/Context
-    (-get-level [_] ctx/+level-transformer+)
-
-    p/Monad
-    (-mreturn [_ v]
-      (p/-mreturn inner-context
-                  (d/pair v (p/-mempty b/vector-context))))
-
-    (-mbind [_ mv f]
-      (p/-mbind inner-context
-                mv
-                (fn [[v log]]
-                  (p/-mbind inner-context
-                            (f v)
-                            (fn [[v' log']]
-                              (p/-mreturn inner-context
-                                          (d/pair v' (p/-mappend (p/-get-context log) log log'))))))))
-
-    MonadWriter
-    (-tell [_ v]
-      (p/-mreturn inner-context (d/pair nil [v])))
-
-    (-listen [_ mv]
-      (p/-mbind inner-context
-                mv
-                (fn [mv]
-                  (p/-mreturn inner-context
-                              (d/pair mv (second mv))))))
-
-    (-pass [_ mv]
-      (p/-mbind inner-context
-                mv
-                (fn [w]
-                  (let [[v f] (first w)
-                        log   (second w)]
-                    (p/-mreturn inner-context
-                                (d/pair v (f log)))))))
-
-    p/MonadTrans
-    (-lift [_ mv]
-      (p/-mbind inner-context
-                mv
-                (fn [v]
-                  (p/-mreturn inner-context
-                              (d/pair v (p/-mempty b/vector-context))))))
-
-    p/Printable
-    (-repr [_]
-      #"<Writer-T>")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Writer monad functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn tell
-  "Add the value to the log."
-  [v]
-  (-tell (ctx/get-current context) v))
-
-(defn listen
-  "Get the value from the log."
-  [mv]
-  (-listen (ctx/get-current context) mv))
-
-(defn pass
-  "Apply a function to the log."
-  [mv]
-  (-pass (ctx/get-current context) mv))
-
-(def value first)
-(def log second)


reformat prop/for-all

reformat prop/for-all

--- test/com/wsscode/pathom/gen_test.cljc
+++ test/com/wsscode/pathom/gen_test.cljc
@@ -81,20 +81,20 @@
   (let [props (->> (keys (::sgen/settings gen-env))
                    (filter keyword?))]
     (prop/for-all [query (eql/make-gen
-                            {::eql/gen-property
-                             (fn [_] (gen/elements props))
-
-                             ::eql/gen-ident-key
-                             (fn [_] (gen/elements props))
-
-                             ::eql/gen-union-key
-                             (fn [_] (gen/elements props))
-
-                             ::eql/gen-params
-                             (fn [_] (gen/return {}))}
-
-                            ::eql/gen-query)]
-                   (sgen/query->props gen-env query))))
+                           {::eql/gen-property
+                            (fn [_] (gen/elements props))
+
+                            ::eql/gen-ident-key
+                            (fn [_] (gen/elements props))
+
+                            ::eql/gen-union-key
+                            (fn [_] (gen/elements props))
+
+                            ::eql/gen-params
+                            (fn [_] (gen/return {}))}
+
+                           ::eql/gen-query)]
+      (sgen/query->props gen-env query))))

 (deftest test-comp->props
   (is (= (sgen/comp->props Component)


Test for NPE in job-name->product-name

Test for NPE in job-name->product-name

--- test/emender_jenkins/results_test.clj
+++ test/emender_jenkins/results_test.clj
@@ -189,7 +189,7 @@
 ; Test behaviour of functions
 ;

-(deftest test-job-name->product-name
+(deftest test-job-name->product-name-1
     "Check the emender-jenkins.results/job-name->product-name function."
     (testing "the emender-jenkins.results/job-name->product-name function."
         (are [x y] (= x y)
@@ -198,6 +198,11 @@
             "Red Hat Enterprise Linux" (job-name->product-name "test-Red_Hat_Enterprise_Linux-6.2-Book_Name_1-en-US (preview)")
             "Red Hat Enterprise Linux" (job-name->product-name "test-Red_Hat_Enterprise_Linux-7-Book_Name_1-en-US (preview)"))))

+(deftest test-job-name->product-name-2
+    "Check the emender-jenkins.results/job-name->product-name function."
+    (testing "the emender-jenkins.results/job-name->product-name function."
+        (is (= "unknown"   (job-name->product-name nil)))))
+
 (deftest test-job-name->version-1
     "Check the emender-jenkins.results/job-name->version function."
     (testing "the emender-jenkins.results/job-name->version function."
@@ -216,7 +221,7 @@
             "unknown" (job-name->version "test-Red_Hat_Enterprise_Linux-6.beta-Book_Name_1-en-US (preview)")
             "unknown" (job-name->version "test-Red_Hat_Enterprise_Linux-Book_Name_1-en-US (preview)"))))

-(deftest test-job-name->book-name
+(deftest test-job-name->book-name-1
     "Check the emender-jenkins.results/job-name->book-name function."
     (testing "the emender-jenkins.results/job-name->book-name function."
         (are [x y] (= x y)


Rename variables in exists-tree?

Rename variables in exists-tree?

--- src/chapter3/leibniz.cljs
+++ src/chapter3/leibniz.cljs
@@ -18,14 +18,14 @@
    (fn [d] 1)
    "diff-x-rule"))
 (with-test
-  (defn exists-tree? [f v1]
-    (if (atom? f)
-      (= f v1)
-      (some (fn [x]
-              (if (atom? x)
-                (= x v1)
-                (exists-tree? x v1)))
-            f)))
+  (defn exists-tree? [tree x]
+    (if (atom? tree)
+      (= tree x)
+      (some (fn [child]
+              (if (atom? child)
+                (= child x)
+                (exists-tree? child x)))
+            tree)))
   (is (exists-tree? '(1 2 3) 1))
   (is (not (exists-tree? '(1 2 3) 4)))
   (is (not (exists-tree? '((2 3) (4 (5) 3) 2 2) 1)))


Made open-door! safer

Made open-door! safer

--- src/chicken_coop/core.clj
+++ src/chicken_coop/core.clj
@@ -79,6 +79,7 @@
   (let [door-close-wait 500 ; time to wait after door closes for latches to lock
         n-retries       3
         max-time-secs   120
+        max-time-ms     (* max-time-secs 1000)
         lower-with-log  (fn []
                           (log "Lowering door")
                           (hb/forward! hb))
@@ -102,7 +103,7 @@
                                   (log "Reeling complete; trying again.")
                                   (lower-with-log))
                                 (recur (inc tries)))
-        (> (- (System/currentTimeMillis) start-time) max-time-secs)
+        (> (- (System/currentTimeMillis) start-time) max-time-ms)
                             (do (log "ERROR: Maxed out on time; Shutting down.")
                                 (update-status! :errors)
                                 (hb/stop! hb))
@@ -110,14 +111,23 @@

-
 (defn open-door! [hb floor-btn roof-btn]
   (log "Opening door")
-  (hb/reverse! hb)
-  (wait-till (closed? roof-btn)
-    (log "Stopping door")
+  (let [max-time-secs 30
+        max-time-ms   (* max-time-secs 1000)
+        start-time    (System/currentTimeMillis)]
+    (hb/reverse! hb)
+    (loop []
+      (cond
+        (closed? roof-btn)
+          :pass
+        (> (- (System/currentTimeMillis) start-time) max-time-ms)
+          (do
+            (log "ERROR: Unable to shut door.")
+            (update-status! :errors))
+        :else (recur)))
     (hb/stop! hb)))
-
+

 (defn time-sm [state day-fn! night-fn!]
   (let [dusk 0.04


Add bindings integration test.

Add bindings integration test.

--- test/lein_xjc/t_integration_tests.clj
+++ test/lein_xjc/t_integration_tests.clj
@@ -50,6 +50,8 @@
              (every? file-exists? class-files))))

 (def read-single-xsd-project (read-test-project "single-xsd"))
+(def read-mult-xsd-with-bindings-project
+  (read-test-project "mult-xsd-with-bindings"))

 (fact "running 'lein xjc' generates the java sources for
       the simple.xsd schema."
@@ -67,3 +69,14 @@
                                        project
                                        ["com.example.ObjectFactory"
                                         "com.example.Something"])))
+
+(fact "specifying a bindings file via the :bindings keyword makes xjc
+      take it into account"
+      :integration-test
+      (let [project (read-mult-xsd-with-bindings-project)]
+        (xjc/xjc project) => (java-sources-created
+                               project
+                               ["test.first.binding.ObjectFactory"
+                                "test.first.binding.FirstXsdType1"
+                                "test.second.binding.ObjectFactory"
+                                "test.second.binding.SecondXsdType1"])))


Make the clojure side read specs from projects, when present

--- src/circle/model/spec.clj
+++ src/circle/model/spec.clj
@@ -4,5 +4,7 @@
 (def spec-coll :specs)

 (defn get-spec-for-project [project]
-  (-> (mongo/fetch-one spec-coll :where {:project_id (:_id project)})
-      (dissoc :version :versions)))+  (if (not (nil? (-> project :setup)))
+    (select-keys project [:setup :dependencies :compile :test])
+    (-> (mongo/fetch-one spec-coll :where {:project_id (:_id project)})
+        (dissoc :version :versions))))


CLJS-422: avoid analysis infinite loop case around cyclic dependencies when namespaces don't have any definitions.

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -564,7 +564,7 @@

 (defn analyze-deps [deps]
   (doseq [dep deps]
-    (when-not (:defs (@namespaces dep))
+    (when-not (contains? @namespaces dep)
       (let [relpath (ns->relpath dep)]
         (when (io/resource relpath)
           (analyze-file relpath))))))


make json schema compatible with cli format

--- src/clj/datasplash/bq.clj
+++ src/clj/datasplash/bq.clj
@@ -182,7 +182,11 @@
    {:schema {:docstr "Specifies bq schema."
              :action (fn [transform schema] (.withSchema transform (->schema schema)))}
     :json-schema {:docstr "Specifies bq schema in json"
-                  :action (fn [transform json-schema] (.withJsonSchema transform json-schema))}
+                  :action (fn [transform json-schema] (let [sch (cheshire.core/decode json-schema)
+                                                            full-sch (if (get sch "fields")
+                                                                       (cheshire.core/encode sch)
+                                                                       (cheshire.core/encode {"fields" sch}))]
+                                                        (.withJsonSchema transform full-sch)))}
     :write-disposition {:docstr "Choose write disposition."
                         :enum write-disposition-enum
                         :action (select-enum-option-fn


Bill's quest to destructure everything.

Bill's quest to destructure everything.

--- src/clj/freefrog/lang.clj
+++ src/clj/freefrog/lang.clj
@@ -48,25 +48,25 @@
 (defn convert-role [anchor-circle {:keys [name]}]
   (g/convert-to-circle anchor-circle name))

-(defn update-purpose-conditionally [anchor-circle circle-name purpose]
+(defn update-purpose-conditionally [anchor-circle circle-name [purpose]]
   (if purpose
-    (g/update-role-purpose anchor-circle circle-name (first purpose))
+    (g/update-role-purpose anchor-circle circle-name purpose)
     anchor-circle))

-(defn rename-conditionally [anchor-circle old-name new-name]
+(defn rename-conditionally [anchor-circle old-name [new-name]]
   (if new-name
-    (g/rename-role anchor-circle old-name (first new-name))
+    (g/rename-role anchor-circle old-name new-name)
     anchor-circle))

 (def update-conversions {:accountabilities "accountability"
                          :domains          "domain"})

-(defn apply-collection-update [circle role-name update-type op]
-  (let [component (first op)
-        function-name (format "%s-role-%s"
+(defn apply-collection-update [circle role-name update-type
+                               [component & params]]
+  (let [function-name (format "%s-role-%s"
                               update-type (update-conversions component))
         fn (resolve (symbol "freefrog.governance" function-name))]
-    (reduce #(fn %1 role-name %2) circle (rest op))))
+    (reduce #(fn %1 role-name %2) circle params)))

 (defn apply-collection-updates [circle role-name update-type ops]
   (reduce #(apply-collection-update %1 role-name update-type %2) circle ops))
@@ -81,7 +81,7 @@

 (def update-circle update-role)

-(defn convert-to-pair
+(defn- convert-to-pair
   "Convert the given vector into a key/value pair. The first
    value of the vector is the first value, whereas the rest
    is the second value as a vector. Unless the key is :purpose,
@@ -102,12 +102,11 @@
            (RuntimeException.
              (format "Unable to execute governance record: %s " record) e)))))

-(defn modify-entity [circle record function-primary]
-  (let [function-secondary (first (second record))
-        function-name (format "%s-%s"
+(defn modify-entity [circle [_ [function-secondary] entity-name :as record]
+                     function-primary]
+  (let [function-name (format "%s-%s"
                               (name function-primary) (name function-secondary))
         fn (resolve (symbol "freefrog.lang" function-name))
-        entity-name (nth record 2)
         params (->> record
                     (drop 3)
                     (map convert-to-pair)
@@ -116,11 +115,11 @@
                     (merge {:name entity-name}))]
     (execute-governance-function record fn circle params)))

-(defn define-policy [circle record _]
-  (g/add-policy circle (second record) (nth record 2)))
+(defn define-policy [circle [_ policy-name policy-text] _]
+  (g/add-policy circle policy-name policy-text))

-(defn strike-policy [circle record _]
-  (g/remove-policy circle (second record)))
+(defn strike-policy [circle [_ policy-name] _]
+  (g/remove-policy circle policy-name))

 (def elected-role-mapping {"facilitator" g/facilitator-name
                            "secretary"   g/secretary-name
@@ -128,17 +127,15 @@

 (def formatter (f/formatter "yyyy-MM-dd"))

-(defn elect [circle record _]
-  (g/elect-to-role circle (elected-role-mapping (nth record 2))
-                   (second record) (f/parse formatter (nth record 3))))
+(defn elect [circle [_ person-name role-name expiration] _]
+  (g/elect-to-role circle (elected-role-mapping role-name)
+                   person-name (f/parse formatter expiration)))

-(defn appoint [circle record _]
-  (if (= 4 (count record))
-    (g/appoint-to-role circle (nth record 2) (second record) (nth record 3))
-    (g/appoint-to-role circle (nth record 2) (second record))))
+(defn appoint [circle [_ person-name role-name focus] _]
+  (g/appoint-to-role circle role-name person-name focus))

-(defn unappoint [circle record _]
-  (g/unappoint-from-role circle (nth record 2) (second record)))
+(defn unappoint [circle [_ person-name role-name] _]
+  (g/unappoint-from-role circle role-name person-name))

 (def commands {:create    modify-entity
                :delete    modify-entity
@@ -153,9 +150,8 @@
 (defn process-command
   "Execute the given governance transformation on the given
    circle, returning the new circle."
-  [circle record]
-  (let [function-primary (first record)
-        command (function-primary commands)]
+  [circle [function-primary :as record]]
+  (let [command (function-primary commands)]
     (if command
       (command circle record function-primary)
       (do


healthcheck

healthcheck

--- src/clj/tictag/server.clj
+++ src/clj/tictag/server.clj
@@ -18,7 +18,7 @@
             [tictag.beeminder :as beeminder]
             [tictag.slack :as slack]))

-(defn index []
+(def index
   (html5
    [:html {:lang "en"}
     [:head
@@ -117,19 +117,28 @@
                                     (dissoc :username :password))]))))
   {:status 200 :body ""})

+(defn health-check [component]
+  (fn [request]
+    (let [db (:db component)]
+      (if (db/test-query! db)
+        {:status  200
+         :headers {"Content-Type" "text/plain"}
+         :body    "healthy!"}
+        {:status 500
+         :headers {"Content-Type" "text/plain"}
+         :body "ERROR - NO DB CONNECTION"}))))
+
 (defn routes [component]
   (compojure.core/routes
    (POST "/slack" _ (partial slack component))
    (PUT "/time/:timestamp" _ (partial timestamp component))
    (GET "/pings" _ (partial pings component))
-   (GET "/" _ (index))
+   (GET "/" _ index)
    (GET "/config" _ {:headers {"Content-Type" "application/edn"}
                      :status 200
                      :body (pr-str {:tagtime-seed (:seed (:tagtime component))
                                     :tagtime-gap  (:gap (:tagtime component))})})
-   (GET "/healthcheck" _ {:status  200
-                          :headers {"Content-Type" "text/plain"}
-                          :body    "healthy!"})))
+   (GET "/healthcheck" _ (health-check component))))

 (defrecord Server [db config tagtime]
   component/Lifecycle


send the user a slack message when parse fails

--- src/clj/tictag/server.clj
+++ src/clj/tictag/server.clj
@@ -89,11 +89,9 @@

 (defn slack-text [slack-message]
   (str
-   (->> (str/replace (get-in slack-message [:event :text]) #"^<.+> " "")
-        (str/lower-case))
-   "\n"))
-
-(def command-parser (insta/parser (clojure.java.io/resource "parser.bnf")))
+   (str/replace (get-in slack-message [:event :text]) #"^<.+> " "") "\n"))
+
+(def command-parser (insta/parser (clojure.java.io/resource "parser.bnf") :string-ci true))

 (defmulti evaluate (fn [context [v & vs]] v))

@@ -115,7 +113,7 @@
   (vec (:tags (second (db/last-pings db user 2)))))

 (defmethod evaluate :TAG [_ [_ tag]]
-  tag)
+  (str/lower-case tag))

 (defmethod evaluate :HELP [_ v] v)

@@ -202,10 +200,19 @@
     valid?))

 (defn eval-command [ctx s]
-  (try (evaluate ctx (command-parser s))
-       (catch Exception e
-         (timbre/error e)
-         (timbre/error (command-parser s)))))
+  (let [parse-result (command-parser s)]
+    (if (insta/failure? parse-result)
+      (do
+        (slack/send-message
+         (:user ctx)
+         (format "%s\n```%s```\n%s"
+                 "Uh-oh! We had an error parsing your response! Maybe this will help:"
+                 (pr-str parse-result)
+                 "If you can't figure out what went wrong, let me know!"))
+        (timbre/error "PARSE ERROR" (:user ctx) s parse-result))
+      (try (evaluate ctx parse-result)
+           (catch Exception e
+             (timbre/error "EVAL ERROR" (:user ctx) e s parse-result))))))

 (defn slack [{:keys [db tagtime] :as component} {:keys [params]}]
   (taoensso.timbre/logged-future


Naming consistency, with-qs -> plus-qs

Naming consistency, with-qs -> plus-qs

--- src/cljs/fatlip/core.cljs
+++ src/cljs/fatlip/core.cljs
@@ -304,7 +304,7 @@
                                  (contains? qs (:dest %)))
                           (:dest %)
                           %)))
-        with-qs (loop [f flat
+        plus-qs (loop [f flat
                        seg-c (first segment-containers)
                        layer []]
                   (if (empty? f)
@@ -317,7 +317,7 @@
                         (if (empty? (:segments seg-c))
                           (recur (rest f) seg-c (conj layer item))
                           (recur (rest f) (first segment-containers) (conj layer seg-c item)))))))]
-    (assoc next-layer :with-qs with-qs)))
+    (assoc next-layer :plus-qs plus-qs)))

 (defn ensure-alternating
@@ -329,7 +329,7 @@
   and then a separate algorithm that counts the crossings that result from the
   orderings on those two layers (step 5)."
   [next-layer]
-  (->> (:with-qs next-layer)
+  (->> (:plus-qs next-layer)
        (partition-by #(instance? SegmentContainer %))
        (mapcat (fn [items]
                  (if (instance? SegmentContainer (first items))


show the layers as they're being drawn if the mouse is shared

--- src-cljs/frontend/components/canvas.cljs
+++ src-cljs/frontend/components/canvas.cljs
@@ -122,6 +122,16 @@
     (render [_]
       (apply dom/g nil
              (om/build-all cursor (dissoc subscribers client-uuid) {:opts {:client-uuid client-uuid}})))))
+
+(defn subscriber-layers [{:keys [layers camera]} owner]
+  (reify
+    om/IRender
+    (render [_]
+      (if-not (seq layers)
+        (dom/g nil nil)
+        (apply dom/g nil (mapv (fn [l] (svg-element camera #{} (merge (utils/inspect l) {:strokeDasharray "5,5"
+                                                                            :fillOpacity "0.25"})))
+                               layers))))))

 (defn svg-canvas [payload owner opts]
   (reify
@@ -222,6 +232,16 @@
                                 :y (get-in payload [:mouse :y])
                                 :className "mouse-stats"}
                            (pr-str (:mouse payload)))
+                 (om/build subscriber-layers {:layers (reduce (fn [acc [id subscriber]]
+                                                                (if-let [layer (:layer subscriber)]
+                                                                  (conj acc (assoc layer
+                                                                              :layer/end-x (:layer/current-x layer)
+                                                                              :layer/end-y (:layer/current-y layer)
+                                                                              :stroke (apply str "#" (take 6 id))
+                                                                              :layer/stroke (apply str "#" (take 6 id))))
+                                                                  acc))
+                                                              [] (:subscribers payload))
+                                              :camera (:camers payload)})
                  (when-let [sel (cond
                                  (settings/selection-in-progress? payload) (settings/selection payload)
                                  (settings/drawing-in-progress? payload) (settings/drawing payload)


Fix leiningen boilerplate test failure

Fix leiningen boilerplate test failure

--- test/enduro_session/core_test.clj
+++ test/enduro_session/core_test.clj
@@ -4,4 +4,4 @@

 (deftest a-test
   (testing "FIXME, I fail."
-    (is (= 0 1))))
+    (is (= 1 1))))


record-layer :prepare? test

record-layer :prepare? test

--- test/er_cassandra/record_test.clj
+++ test/er_cassandra/record_test.clj
@@ -31,3 +31,27 @@
                 t)]
         (is (= nil
                @(r/select-one tu/*session* :stmt_test :id t)))))))
+
+
+(deftest prepared-insert-select-delete-test
+  (let [_ (tu/create-table :stmt_test "(id timeuuid primary key)")
+
+        t (uuid/v1)
+        ;; insert with record layer to trigger truncates on session close
+        _ @(r/insert
+            tu/*session*
+            :stmt_test
+            {:id t}
+            {:prepare? true})]
+    (testing "simple select-one"
+      (is (= {:id t}
+             @(r/select-one tu/*session* :stmt_test :id t {:prepare? true}))))
+    (testing "delete"
+      (let [_ @(r/delete
+                tu/*session*
+                :stmt_test
+                :id
+                t
+                {:prepare? true})]
+        (is (= nil
+               @(r/select-one tu/*session* :stmt_test :id t {:prepare? true})))))))


more tests

more tests

--- test/lein_fore_prob/test/core.clj
+++ test/lein_fore_prob/test/core.clj
@@ -1,6 +1,7 @@
 (ns lein-fore-prob.test.core
   (:use clojure.test)
-  (:require [leiningen.fore-prob :as fp]))
+  (:require [leiningen.fore-prob :as fp])
+  (:import  [java.io File]))

 (deftest project->path
   (testing "empty ns"
@@ -66,6 +67,57 @@
   (testing "UNIX line-ending only"
     (is (= (re-find #"\r\n" (#'fp/desc->comments "foo\r\nbar\nq\r\na")) nil))))

+(def sep (File/separator))
+
+(def   src-dir "src")
+(def tests-dir "test")
+
+(def tests-file "core_test.clj")
+(def   src-file "core.clj")
+
+(defn mk-path
+  "tests helper: make a path from one or more string(s)"
+  [& parts]
+  (apply str (interpose sep parts)))
+
+(deftest tests-path
+  (testing "class"
+    (is (= (type (#'fp/tests-path {:group "foo"})) java.io.File)))
+  (testing "empty namespace"
+    (is (= (. (#'fp/tests-path {:group ""}) getPath)
+           (mk-path tests-dir tests-file))))
+  (testing "one-word namespace"
+    (is (= (. (#'fp/tests-path {:group "foo"}) getPath)
+           (mk-path tests-dir "foo" tests-file))))
+  (testing "namespace with dots"
+    (is (= (. (#'fp/tests-path {:group "foo.bar"}) getPath)
+           (mk-path tests-dir "foo" "bar" tests-file))))
+  (testing "dashed namespace"
+    (is (= (. (#'fp/tests-path {:group "foo-bar"}) getPath)
+           (mk-path tests-dir "foo_bar" tests-file))))
+  (testing "dashed namespace with dots"
+    (is (= (. (#'fp/tests-path {:group "foo-bar.qux"}) getPath)
+           (mk-path tests-dir "foo_bar" "qux" tests-file)))))
+
+(deftest src-path
+  (testing "class"
+    (is (= (type (#'fp/src-path {:group "foo"})) java.io.File)))
+  (testing "empty namespace"
+    (is (= (. (#'fp/src-path {:group ""}) getPath)
+           (mk-path src-dir src-file))))
+  (testing "one-word namespace"
+    (is (= (. (#'fp/src-path {:group "foo"}) getPath)
+           (mk-path src-dir "foo" src-file))))
+  (testing "namespace with dots"
+    (is (= (. (#'fp/src-path {:group "foo.bar"}) getPath)
+           (mk-path src-dir "foo" "bar" src-file))))
+  (testing "dashed namespace"
+    (is (= (. (#'fp/src-path {:group "foo-bar"}) getPath)
+           (mk-path src-dir "foo_bar" src-file))))
+  (testing "dashed namespace with dots"
+    (is (= (. (#'fp/src-path {:group "foo-bar.qux"}) getPath)
+           (mk-path src-dir "foo_bar" "qux" src-file)))))
+
 (def sample-prob1
   {:title "Foo Bar"
    :description "write a foo bar"
@@ -77,11 +129,10 @@
    :tags ["bar"]
    :tests ["(= (__ 42) 21)" "(= (__ 21) 42)"]})

-(deftest expand-prob-tests) ; TODO
-(deftest tests-path)
-(deftest src-path)
-(deftest has-problem-tests?)
-(deftest has-problem-src?)
+(deftest expand-prob-tests)  ; TODO
+
+(deftest has-problem-tests?) ; TODO
+(deftest has-problem-src?)   ; TODO

 ;; TODO we need to use sample and/or temporary files for these ones
 ;; http://my.safaribooksonline.com/book/programming/clojure/9781449366384/4dot-local-io/_using_temporary_files_html


fix payloads

fix payloads

--- perf-test/clj/reitit/trie.cljc
+++ perf-test/clj/reitit/trie.cljc
@@ -29,6 +29,7 @@
   (lookup [this path params])
   (get-segment [this])
   (update-segment [this subs lcs])
+  (set-data [this data])
   (add-child [this key child])
   (insert-child [this key path-spec o]))

@@ -58,6 +59,8 @@
             (->Match data (assoc params param path)))))
       (get-segment [this]
         segment)
+      (set-data [this data]
+        (wild-node segment param children data))
       (add-child [this key child]
         (wild-node segment param (assoc children key child) data))
       (insert-child [this key path-spec o]
@@ -92,10 +95,12 @@
         segment)
       (update-segment [this subs lcs]
         (static-node (subs segment lcs) children data))
+      (set-data [this data]
+        (static-node segment children data))
       (add-child [this key child]
         (static-node segment (assoc children key child) data))
-      (insert-child [this key path-spec o]
-        (static-node segment (update children key insert path-spec o) data)))))
+      (insert-child [this key path-spec child-data]
+        (static-node segment (update children key insert path-spec child-data) data)))))

 (defn- wild? [s]
   (contains? #{\: \*} (first s)))
@@ -138,22 +143,22 @@
 (defn- make-node
   "Given a path-spec segment string and a payload object, return a new
   tree node."
-  [segment o]
+  [segment data]
   (cond
     (wild-param? segment)
-    (wild-node segment (keyword (subs segment 1)) nil o)
+    (wild-node segment (keyword (subs segment 1)) nil data)

     (catch-all-param? segment)
-    (catch-all-node segment (keyword (subs segment 1)) nil o)
+    (catch-all-node segment (keyword (subs segment 1)) nil data)

     :else
-    (static-node segment nil o)))
+    (static-node segment nil data)))

 (defn- new-node
   "Given a path-spec and a payload object, return a new tree node. If
   the path-spec contains wildcards or catch-alls, will return parent
   node of a tree (linked list)."
-  [path-spec o]
+  [path-spec data]
   (if (contains-wilds? path-spec)
     (let [parts (partition-wilds path-spec)]
       (reduce (fn [child segment]
@@ -163,9 +168,9 @@
                 (-> (make-node segment nil)
                     (add-child (subs (get-segment child) 0 1) child)))
               (let [segment (last parts)]
-                (make-node segment o))
+                (make-node segment data))
               (reverse (butlast parts))))
-    (make-node path-spec o)))
+    (make-node path-spec data)))

 (defn- calc-lcs
   "Given two strings, return the end index of the longest common
@@ -188,27 +193,27 @@
   old contents of node and the new item as children.
   lcs is the index of the longest common string in path-spec and the
   segment of node."
-  [node path-spec o lcs]
+  [node path-spec data lcs]
   (let [segment (get-segment node)
         common (subs path-spec 0 lcs)
         parent (new-node common nil)]
     (if (= common path-spec)
-      (-> parent
+      (-> (set-data parent data)
           (add-child (char-key segment lcs) (update-segment node subs lcs)))
       (-> parent
           (add-child (char-key segment lcs) (update-segment node subs lcs))
-          (insert-child (char-key path-spec lcs) (subs path-spec lcs) o)))))
+          (insert-child (char-key path-spec lcs) (subs path-spec lcs) data)))))

 (defn insert
   "Given a tree node, a path-spec and a payload object, return a new
   tree with payload inserted."
-  [node path-spec o]
+  [node path-spec data]
   (let [segment (get-segment node)]
     (cond (nil? node)
-          (new-node path-spec o)
+          (new-node path-spec data)

           (= segment path-spec)
-          node
+          (set-data node data)

           ;; handle case where path-spec is a wildcard param
           (wild-param? path-spec)
@@ -216,7 +221,7 @@
                 common (subs path-spec 0 lcs)]
             (if (= common segment)
               (let [path-spec (subs path-spec (inc lcs))]
-                (insert-child node (subs path-spec 0 1) path-spec o))
+                (insert-child node (subs path-spec 0 1) path-spec data))
               (throw (ex-info "route conflict"
                               {:node node
                                :path-spec path-spec
@@ -233,10 +238,10 @@
           :else
           (let [lcs (calc-lcs segment path-spec)]
             (cond (= lcs (count segment))
-                  (insert-child node (char-key path-spec lcs) (subs path-spec lcs) o)
+                  (insert-child node (char-key path-spec lcs) (subs path-spec lcs) data)

                   :else
-                  (split node path-spec o lcs))))))
+                  (split node path-spec data lcs))))))

 ;;
 ;; testing
@@ -321,4 +326,5 @@
   ;; 1.3ms (reified protocols)
   ;; 0.8ms (flattened matching)
   ;; 0.8ms (return route-data)
+  ;; 0.8ms (fix payloads)
   (cc/quick-bench (dotimes [_ 1000] (lookup tree-new "/v1/orgs/1/topics" {}))))


Fix add-group helper for new way of structuring users in groups

--- src/braid/core/client/state/helpers.cljs
+++ src/braid/core/client/state/helpers.cljs
@@ -121,7 +121,8 @@

 (defn add-group [state group]
   (-> state
-      (update-in [:groups] assoc (group :id) group)
+      (update-in [:groups] assoc (group :id)
+                 (update group :users key-by-id))
       (update-in [:temp-threads] assoc (group :id) (schema/make-temp-thread (group :id)))))

 (defn remove-group [state group-id]


fixed bugs in transition function

fixed bugs in transition function

--- src/clj/backtype/storm/daemon/nimbus.clj
+++ src/clj/backtype/storm/daemon/nimbus.clj
@@ -139,7 +139,7 @@
      (transition! nimbus storm-id event false))
   ([nimbus storm-id event error-on-no-transition?]
      (locking (:submit-lock nimbus)
-       (let [[event event-args] (if (keyword? event) [event []] event)
+       (let [[event & event-args] (if (keyword? event) [event] event)
              status (topology-status nimbus storm-id)]
          (if status ; handles the case where event was scheduled but has been removed
            (let [get-event (fn [m e]
@@ -148,10 +148,10 @@
                                (when error-on-no-transition?
                                  (throw-runtime "No transition for event: " event
                                                 ", status: " status,
-                                                "storm-id: " storm-id)
+                                                " storm-id: " storm-id)
                                  )))
                  transition (-> (state-transitions nimbus storm-id status)
-                                (:type status)
+                                (get (:type status))
                                 (get-event event))
                  transition (if (or (nil? transition)
                                     (keyword? transition))


Add gecco2016-plus1 diversification test

--- src/clojush/pushgp/genetic_operators.clj
+++ src/clojush/pushgp/genetic_operators.clj
@@ -835,6 +835,18 @@
       (and (> (reduce min diffs) 0) ;; diversification threshold set here
            (> (count (distinct diffs)) 1)))))

+(defn gecco2016-plus1-diversifying?
+  [ind argmap]
+  (let [g (:genome ind)
+        delta #(expressed-difference
+                 g
+                 (produce-child-genome-by-autoconstruction g g argmap)
+                 argmap)
+        diffs (repeatedly 3 delta)]
+    (assoc ind :diversifying
+      (and (> (reduce min diffs) 0) ;; diversification threshold set here
+           (> (count (distinct diffs)) 2)))))
+
 (defn doesnt-clone-diversifying?
   [ind argmap]
   (let [g (:genome ind)]
@@ -1182,6 +1194,7 @@
       i
       (recur ((case (first tests)
                 :gecco2016 gecco2016-diversifying?
+                :gecco2016-plus1 gecco2016-plus1-diversifying?
                 :three-gens-diff-diffs three-gens-diff-diffs-diversifying?
                 :three-gens-same-inputs-diff-diffs three-gens-same-inputs-diff-diffs-diversifying?
                 :four-gens-same-inputs-diff-diffs four-gens-same-inputs-diff-diffs-diversifying?


Start implementing index tree test validations.

--- test/merkle_db/index_test.clj
+++ test/merkle_db/index_test.clj
@@ -9,18 +9,84 @@
     (merkle-db
       [generators :as mdgen]
       [index :as index]
-      [key :as key])))
+      [key :as key]
+      [partition :as part]
+      [record :as record])))

-; Index tree properties:
-; - Root node is nil if tree is empty
-; - Root is a partition if tree has fewer than p-1 records
-; - Root node has between [2, b] children
-; - Index nodes have one fewer key than child links
-; - All keys in a subtree are within the correct bounds
-; - ::record/count attributes are accurate
-; - Index nodes with height = 1 have partitions as children
-; - All internal index nodes have height one less than their parent
-; - All internal index nodes have between [ceil(b/2), b] children
-; - All node data passes spec
-; - Partition nodes have at least ceil(p/2) records if the total number of records is at least that much.
+(defn validate-partition-node
+  [store params part]
+  (is (valid? ::part/node-data part)
+      "partition node data spec is valid")
+  ; TODO: warn when partition limit or families don't match params
+  (when (<= (::part/limit part) (::record/count params))
+    (is (<= (Math/ceil (/ (::part/limit part) 2)) (::record/count part))
+            "partition is at least half full if tree has at least :merkle-db.partition/limit records"))
+  (when (::first-key params)
+    (is (not (key/before? (::part/first-key part) (::first-key params)))
+        "first key in partition is not before the subtree boundary"))
+  (when (::last-key params)
+    (is (not (key/after? (::part/last-key part) (::last-key params)))
+        "last key in partition is not after the subtree boundary"))
+  ; TODO: check tablets for validity
+  ,,,)
+
+
+(defn validate-index-node
+  [store params index]
+  (is (valid? ::index/node-data index)
+      "index node data spec is valid")
+  (if (::root? params)
+    (is (<= 2
+            (count (::index/children index))
+            (::index/branching-factor params))
+        "root index node has at between [2, b] children")
+    (is (<= (int (Math/ceil (/ (::index/branching-factor params) 2)))
+            (count (::index/children index)))
+        "internal index node has between [ceil(b/2), b] children"))
+  (is (= (dec (count (::index/children index)))
+         (count (::index/keys index)))
+      "index nodes have one fewer key than child links")
+  (is (= (::height params) (::index/height index))
+      "index node has expected height")
+  (let [result (reduce
+                 (fn test-child
+                   [result [first-key child-link last-key]]
+                   (let [params' (assoc params
+                                        ::root? false
+                                        ::height (dec (::index/height index))
+                                        ::first-key first-key
+                                        ::last-key last-key)
+                         child (mdag/get-data store child-link)
+                         child-result (if (zero? (::height params'))
+                                        (validate-partition-node store params' child)
+                                        (validate-index-node store params' child))]
+                     (update result ::record/count + (::record/count child-result))))
+                 {::record/count 0}
+                 (map vector
+                      (cons (::first-key params) (::index/keys index))
+                      (::index/children index)
+                      (conj (::index/keys index) (::last-key params))))]
+    (is (= (::record/count result) (::record/count index))
+        "index ::record/count matches actual subtree count")))
+
+
+(defn validate-tree
+  [store params root-id]
+  (let [root (mdag/get-data store root-id)]
+    (cond
+      (zero? (::record/count params))
+        (is (nil? root-id) "root node is nil if tree is empty")
+      (<= (::record/count params) (::part/limit params))
+        (do (is (= part/data-type (:data/type root))
+                "root node is a partition if tree has fewer than :merkle-db.partition/limit records")
+            (validate-partition-node store params root))
+      :else
+        (do (is (= index/data-type (:data/type root))
+                "root node is an index node if tree has more than one partition")
+            (validate-index-node
+              store
+              (assoc params
+                     ::root? true
+                     ::height (::index/height root))
+              root)))))


adding octree impl

adding octree impl

--- org/babel/quadtree.clj
+++ org/babel/quadtree.clj
@@ -35,7 +35,8 @@
                 (commit-path path))))
         (commit-path (assoc this :data p) path)))))

-(def ^:const qtchildren [nil nil nil nil])
+(def ^{:const true :private true} qt-children [nil nil nil nil])
+(def ^{:const true :private true} ot-children [nil nil nil nil nil nil nil nil])

 (defrecord QuadtreeNode [x y w h children data]
   TreeOps
@@ -55,7 +56,34 @@
   (node-bounds [this]
     (thi.ng.geom.types.Rect. (g/vec2 x y) (* w 2) (* h 2)))
   (split-node [this]
-    (assoc this :children qtchildren :data nil))
+    (assoc this :children qt-children :data nil))
+  (add-point
+    [this p]
+    (if (g/contains-point? (node-bounds this) p)
+      (add-point* this p [])
+      this)))
+
+(defrecord OctreeNode [x y z w h d children data]
+  TreeOps
+  (child-index-for-point [this [px py pz]]
+    (+ (if (< pz (+ z d)) 0 4)
+       (if (< px (+ x w))
+         (if (< py (+ y h)) 0 2)
+         (if (< py (+ y h)) 1 3))))
+  (child-for-point [this p]
+    (let [idx (child-index-for-point this p)] [(children idx) idx]))
+  (make-child-for-point [this p add?]
+    (let [idx (child-index-for-point this p)]
+      (if (children idx)
+        [(children idx) idx]
+        (let [cx (if (pos? (bit-and idx 1)) (+ x w) x)
+              cy (if (pos? (bit-and idx 2)) (+ y h) y)
+              cz (if (pos? (bit-and idx 4)) (+ z d) z)]
+          [(OctreeNode. cx cy cz (* 0.5 w) (* 0.5 h) (* 0.5 d) nil (if add? p)) idx]))))
+  (node-bounds [this]
+    (thi.ng.geom.types.AABB. (g/vec3 x y z) (g/vec3 (* w 2) (* h 2) (* d 2))))
+  (split-node [this]
+    (assoc this :children ot-children :data nil))
   (add-point
     [this p]
     (if (g/contains-point? (node-bounds this) p)
@@ -66,6 +94,11 @@
   "Create a new quadtree root node with the given XY position & dimensions."
   [x y w h]
   (QuadtreeNode. x y (* 0.5 w) (* 0.5 h) nil nil))
+
+(defn octree
+  "Create a new octree root node with the given XYZ position & dimensions."
+  [x y z w h d]
+  (OctreeNode. x y z (* 0.5 w) (* 0.5 h) (* 0.5 d) nil nil))

 (defn select-with
   "Produces a seq of points in the tree within a given region.
@@ -89,3 +122,4 @@
   [s q] (select-with #(g/intersect-shape s %) #(g/contains-point? s %) q))

 (def q (time (reduce add-point (quadtree 0 0 100 100) [[55 10] [25 10] [55 11]])))
+(def o (time (reduce add-point (octree 0 0 0 100 100 100) [[55 10 25] [25 10 55] [55 11 25]])))


CMR-6288: Add test-out alias to es-spatial-plugin.

--- es-spatial-plugin/project.clj
+++ es-spatial-plugin/project.clj
@@ -105,6 +105,8 @@
             "build-all" ["do"
                          "install-es-deps,"
                          "install-es-plugin,"]
+            ;; Alias to test2junit for consistency with lein-test-out
+            "test-out" ["test2junit"]
             "package-all" ["do"
                            "install-es-deps,"
                            "package-es-plugin,"


Fixed a bug where environments were not converted to javascript objects before sending them to objc.

Signed-off-by: Mike Fikes <a17fed27eaa842282862ff7c1b9c8395a26ac320@fikesfarm.com>

--- planck-cljs/src/planck/sh.cljs
+++ planck-cljs/src/planck/sh.cljs
@@ -35,4 +35,4 @@
   [& args]
   (let [[cmd opts] (parse-args args)
          {:keys [in in-enc out-enc env dir]} opts]
-    (js->clj (js/PLANCK_SHELL_SH (clj->js cmd) in in-enc out-enc env dir) :keywordize-keys true)))
+    (js->clj (js/PLANCK_SHELL_SH (clj->js cmd) in in-enc out-enc (clj->js env) dir) :keywordize-keys true)))


Three new tests for parse-float: min value, max value, and bad input

--- test/clouseau/test_utils.clj
+++ test/clouseau/test_utils.clj
@@ -478,4 +478,18 @@
         -1e10 (parse-float "-10000000000")
         -1e10 (parse-float "-1e10")))

-
+(deftest test-parse-float-min-value
+    "Check the behaviour of function emender-jenkins.config/parse-int."
+    (is (== Float/MIN_VALUE (parse-float "0x0.000002P-126f"))))
+
+(deftest test-parse-float-max-value
+    "Check the behaviour of function emender-jenkins.config/parse-int."
+    (is (== Float/MAX_VALUE (parse-float "0x1.fffffeP+127f"))))
+
+(deftest test-parse-float-bad-input
+    "Check the behaviour of function emender-jenkins.config/parse-float."
+    (are [x] (thrown? NumberFormatException x)
+        (parse-float "")
+        (parse-float "xyzzy")
+        (parse-float "-1xyzzy")))
+


Floating point numbers parsing: normal positive and negative values

--- test/clouseau/test_utils.clj
+++ test/clouseau/test_utils.clj
@@ -454,4 +454,28 @@
         0.0 (parse-float "-00")
         0.0 (parse-float "-000")))

-
+(deftest test-parse-float-positive-values
+    "Check the behaviour of function emender-jenkins.config/parse-float."
+    (are [x y] (== x y)
+        0.5 (parse-float "0.5")
+        1.0 (parse-float "1.0")
+        1.5 (parse-float "1.5")
+        2.0 (parse-float "2")
+        1000.0 (parse-float "1000")
+        10000.0 (parse-float "10000")
+        1e10 (parse-float "10000000000")
+        1e10 (parse-float "1e10")))
+
+(deftest test-parse-float-negative-values
+    "Check the behaviour of function emender-jenkins.config/parse-float."
+    (are [x y] (== x y)
+        -0.5 (parse-float "-0.5")
+        -1.0 (parse-float "-1.0")
+        -1.5 (parse-float "-1.5")
+        -2.0 (parse-float "-2")
+        -1000.0 (parse-float "-1000")
+        -10000.0 (parse-float "-10000")
+        -1e10 (parse-float "-10000000000")
+        -1e10 (parse-float "-1e10")))
+
+


Not like I had those anyway

Not like I had those anyway

--- test/lein_grim/core_test.clj
+++ test/lein_grim/core_test.clj
@@ -1,7 +0,0 @@
-(ns lein-grim.core-test
-  (:require [clojure.test :refer :all]
-            [lein-grim.core :refer :all]))
-
-(deftest a-test
-  (testing "FIXME, I fail."
-    (is (= 0 1))))


say: update example with @haus' suggestions

--- exercises/say/src/example.clj
+++ exercises/say/src/example.clj
@@ -1,11 +1,9 @@
 (ns say
-    (:require [clojure.pprint :as pp])
-    (:require [clojure.string :as s]))
+    (:require [clojure.pprint :as pp]
+              [clojure.string :as s]))

 (defn number [input]
   (if
     (or (< input 0) (> input 999999999999))
     (throw (IllegalArgumentException. "Out of range"))
-    (s/replace (pp/cl-format nil "~R" input) #"," "")
-  )
-)
+    (s/replace (pp/cl-format nil "~R" input) #"," "")))


respect specification

respect specification

--- test/s7p/slave/core_test.clj
+++ test/s7p/slave/core_test.clj
@@ -72,7 +72,7 @@

     (testing "one valid response with fp, and bidPrice is over the fp"
       (let [fp 4.0
-            bid-price 4.1
+            bid-price 4100.0
             arg [{:dsp dsp1 :response {:id "1", :bidPrice bid-price :advertiserId "2"}}]
             ret (auction fp arg)]
        (is ret)
@@ -81,29 +81,29 @@

     (testing "one valid response without fp"
       (let [fp nil
-            bid-price 4.1
+            bid-price 4000.0
             arg [{:dsp dsp1 :response {:id "1", :bidPrice bid-price :advertiserId "2"}}]
             ret (auction fp arg)]
        (is ret)
        (is (= dsp1 (:dsp ret)))
-       (is (= bid-price (:win-price ret)))))
+       (is (= (/ bid-price 1000) (:win-price ret)))))

     (testing "more than 1 valid response"
       (let [fp 4.0
-            bid-price1 4.1
-            bid-price2 4.2
+            bid-price1 4100
+            bid-price2 4200
             arg [{:dsp dsp1 :response {:id "1", :bidPrice bid-price1 :advertiserId "2"}}
                  {:dsp dsp2 :response {:id "1", :bidPrice bid-price2 :advertiserId "2"}}]
             ret (auction fp arg)]
         (is ret)
         (is (= dsp2 (:dsp ret)))
-        (is (= bid-price1 (:win-price ret)))))
+        (is (= (float (/ bid-price1 1000)) (:win-price ret)))))

     (testing "more than 1 valid response with same bid price"
       (let [fp 4.0
-            bid-price1 4.1
+            bid-price1 4100
             arg [{:dsp dsp1 :response {:id "1", :bidPrice bid-price1 :advertiserId "2"}}
                  {:dsp dsp2 :response {:id "1", :bidPrice bid-price1 :advertiserId "2"}}]
             ret (auction fp arg)]
         (is ret)
-        (is (= bid-price1 (:win-price ret)))))))
+        (is (= (float (/ bid-price1 1000)) (:win-price ret)))))))