なぞいが再開できるように

なぞいが再開できるように

--- src/clojure/com/illiichi/main.clj
+++ src/clojure/com/illiichi/main.clj
@@ -23,9 +23,10 @@
                  (apply osc-send @client (str "/" id) (map mean coll)))
                [])]
     (every interval #(send-off stack task) my-pool)))
-
+
 (defn push-vector [stack vals]
   (let [push (fn [xs xss]
+               (prn (first (seq xs)))
                (if (empty? xss)
                  (map vector xs)
                  (map conj xss xs)))]
@@ -53,23 +54,29 @@
     [(create "rotate" Sensor/TYPE_ROTATION_VECTOR rotate-stack)
      (create "acc" Sensor/TYPE_LINEAR_ACCELERATION acc-stack)]))

-(defn start-send [address port interval sensorManager]
+(def sensorManager (atom nil))
+
+(defn start-send [address port interval]
   (for [stack [acc-stack rotate-stack]]
     (send stack (fn [_] [])))
   (reset! client (osc-client address port))
-  (reset! listeners (create-listeners interval sensorManager))
+  (reset! listeners (create-listeners interval @sensorManager))
   (prn "start"))

-(defn stop-send [sensorManager]
-  (map #(.unregisterListener sensorManager %) @listeners)
-  (stop-and-reset-pool! my-pool)
-  (reset! client nil)
-  (reset! listeners nil)
-  (prn "stop"))
+(defn stop-send []
+  (let [xs @listeners
+        manager @sensorManager]
+    ;; (map (fn [x] (prn "- ho -" x)
+    ;;        (.unregisterListener manager x)) xs)
+    (.unregisterListener manager (first xs))
+    (.unregisterListener manager (second xs))
+   (stop-and-reset-pool! my-pool)
+   (reset! client nil)
+   (reset! listeners nil)
+   (prn "stop")))

 (defn toggle-state [activity]
-  (let [state (swap! state #(update-in % [:start?] not))
-        sensorManager (.getSystemService activity Context/SENSOR_SERVICE)]
+  (let [state (swap! state #(update-in % [:start?] not))]
     (-> (find-views activity "button")
         (first)
         (.setText (if (:start? state)
@@ -78,13 +85,14 @@
       (let [address  (str      (.getText (find-view activity ::address)))
             port     (Integer. (str (.getText (find-view activity ::port))))
             interval (Integer. (str (.getText (find-view activity ::interval))))]
-        (start-send address port interval sensorManager))
-      (stop-send sensorManager))))
+        (start-send address port interval))
+      (stop-send))))

 (defactivity com.illiichi.MyActivity
   :key :main
   :on-create
-  (fn [this bundle]
+  (fn [this bundle]
+    (reset! sensorManager (.getSystemService (*a) Context/SENSOR_SERVICE))
     (on-ui
       (set-content-view! (*a)
         [:linear-layout {:orientation :vertical}


fix pool key

fix pool key

--- src/clojure/tcp_driver/driver.clj
+++ src/clojure/tcp_driver/driver.clj
@@ -69,19 +69,21 @@
                            ;;;try the io-f, if an exception then only if we haven't tried (count hosts) already
                            ;;;loop and retry, its expected that the routing policy blacklist or remove the host on error

-                           (let [res (try
+                           (let [host-key (select-keys host [:host :port])
+                                 res (try

-                                       (if-let [conn (tcp-pool/borrow pool host timeout-ms)]
+                                       (if-let [
+                                                conn (tcp-pool/borrow pool host-key timeout-ms)]

                                                (try
                                                  (io-f conn)
                                                  (catch Throwable e
                                                    ;;any exception will cause invalidation of the connection.
-                                                   (tcp-pool/invalidate pool host conn)
+                                                   (tcp-pool/invalidate pool host-key conn)
                                                    (throw e))
                                                  (finally
                                                    (try
-                                                     (tcp-pool/return pool host conn)
+                                                     (tcp-pool/return pool host-key conn)
                                                      (catch Exception e nil))))

                                                (throw-no-connection!))
@@ -89,10 +91,10 @@
                                        (catch Exception t

                                          ;;blacklist host
-                                         (routing/-blacklist! (:routing-policy ctx) host)
+                                         (routing/-blacklist! (:routing-policy ctx) host-key)

-                                         (routing/-on-error! (:routing-policy ctx) host t)
-                                         (ex-info (str "Error while connecting to " host) {:throwable t :host host :retries i :hosts (routing/-hosts (:routing-policy ctx))})))]
+                                         (routing/-on-error! (:routing-policy ctx) host-key t)
+                                         (ex-info (str "Error while connecting to " host-key) {:throwable t :host host-key :retries i :hosts (routing/-hosts (:routing-policy ctx))})))]

                                 (if (instance? Throwable res)
                                   (do


Delete todo

Delete todo

--- src/todomvc/events.cljs
+++ src/todomvc/events.cljs
@@ -159,9 +159,18 @@

 (reg-event-db
   :delete-todo
-  todo-interceptors
-  (fn [todos [id]]
-    (dissoc todos id)))
+  (fn [db [_ id]]
+    (let [session (:state db)
+          todo (get-todo db id)]
+      {:state (-> session
+                (retract todo)
+                (fire-rules))})))
+
+;(reg-event-db
+;  :delete-todo
+;  todo-interceptors
+;  (fn [todos [id]]
+;    (dissoc todos id)))

 (reg-event-db


Implement create-mapped-proc-fn.

Implement create-mapped-proc-fn.

--- src/dsbdp/processing_fn_utils.clj
+++ src/dsbdp/processing_fn_utils.clj
@@ -28,8 +28,9 @@

 (defn create-mapped-proc-fn
   [fn-vec start-idx end-idx]
-  (if (= 0 start-idx)
-    nil
-    nil
-    ))
+  (fn [in out]
+    (loop [fns (subvec fn-vec start-idx end-idx) o out]
+      (if (empty? fns)
+        o
+        (recur (rest fns) ((first fns) in o))))))


find margest minterms

find margest minterms

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -1127,10 +1127,10 @@
           (map #(apply str %))))))

 ;;Veitch
-(def mp [[1  1  1  1]
-         [5  6  7  8]
-         [9  10 11 12]
-         [1 14 15  1]])
+(def mp [[1 0 0 1]
+         [1 0 0 1]
+         [0 1 1 0]
+         [1 0 0 1]])

 (defn divs [len x]
   (for [i (range 1 (inc len)) j (range 1 (inc len)) :when (= x (* i j))] [i j]))
@@ -1154,20 +1154,55 @@
          (filter #(minterm? %))
          (map #(set (map second %))))))

+(defn smaller? [term terms]
+  (empty? (apply (partial clojure.set/difference term) terms)))
+
+(defn largest
+  ([minterms] (largest (sort #(< (count %1) (count %2)) minterms) '()))
+  ([[fst & rst :as minterm] res]
+   (cond
+     (not (seq minterm)) res
+     (smaller? fst (concat res rst)) (largest rst res)
+     :else (largest rst (conj res fst)))))
+
 (defn minterms [kmap]
   (let [len (count kmap)
         ones (for [i (range len) j (range len)
                    :when (= 1 (get-in kmap [i j]))] [i j])]
-    (mapcat #(minterms-iter kmap %) ones)))
-
-(defn smaller? [term terms]
-  (some empty? (map #(clojure.set/difference term %) terms)))
-
-(defn largest
-  ([minterms] (max-minterms minterms '()))
-  ([[fst & rst :as minterm] res]
-   (cond
-     (not (seq minterm)) res
-     (or (smaller? fst res) (smaller? fst rst)) (largest rst res)
-     :else (largest rst (conj res fst)))))
-
+    (mapcat #(minterms-iter kmap %) ones)))
+
+(defn gray-code [n]
+  (->> (range (Math/pow 2 n))
+       (map #(bit-xor % (bit-shift-right % 1)))
+       (map #(clojure.pprint/cl-format nil (str "~" n "'0B") %))))
+
+(defn apply-gray [str code]
+  (map #(if (= %2 \1)
+          (symbol (clojure.string/upper-case %1))
+          (symbol (clojure.string/lower-case %1))) str code))
+
+(defn gray [str]
+  (map #(apply-gray str %) (gray-code (count str))))
+
+(defn match? [gray samples]
+  (vector (apply str gray)
+          (if (some identity (map #(every? (set gray) %) samples))
+            1 0)))
+
+(defn k-match? [gray samples]
+  (if (some identity (map #(every? (set gray) %) samples))
+            1 0))
+
+(defn gray-map [sy sx samples]
+  (mapv
+   (fn [grsy] (mapv #(match? (concat grsy %) samples) (gray sx)))
+   (gray sy)))
+
+
+(defn k-map [samples]
+  (let [sample (sort (clojure.string/lower-case (apply str (first samples))))
+        mid (quot (count sample) 2)
+        y (apply str (take mid sample))
+        x (apply str (drop mid sample))]
+    (gray-map y x samples)))
+


remove logging from config.clj

remove logging from config.clj

--- config.clj
+++ config.clj
@@ -30,8 +30,7 @@
         :code [:up :up :down :down :left :right :left :right :B :A :start]
         :mode :strobe)
       (handler/buffer-keys 20)
-      handler/system-reset
-      handler/log-events)
+      handler/system-reset)

   :web-options
   {:port 8080


Cannot login if email is not active yet

Cannot login if email is not active yet

Removed logs and adde TODOs

Got rid of some logging

--- src/freecoin/handlers/sign_in.clj
+++ src/freecoin/handlers/sign_in.clj
@@ -92,15 +92,19 @@
                    (if (= :ok status)
                      (let [email (-> ctx :request :params :sign-in-email)]
                        (if-let [account (account/fetch account-store email)]
-                         ;; TODO passrd encr
-                         (if (= (-> ctx :request :params :sign-in-password) (:password account))
-                           {:email email}
-                           [false (fh/form-problem (conj problems
-                                                          {:keys [:sign-in-password] :msg (str "Wrong password for account " email)}))])
+                         (if (:activated account)
+                           ;; TODO passrd encr
+                           (if (= (-> ctx :request :params :sign-in-password) (:password account))
+                             {:email email}
+                             [false  (fh/form-problem (conj problems
+                                                            {:keys [:sign-in-password] :msg (str "Wrong password for account " email)}))])
+                           [false  (fh/form-problem (conj problems
+                                                          {:keys [:sign-in-email] :msg (str "The account for " email
+                                                                                " is not yet active.")}))])
                          [false (fh/form-problem (conj problems
                                                         {:keys [:sign-in-email] :msg "Account with for this email does not exist"}))]))
                      (do
-                       (log/info (str "Problems: " (clojure.pprint/pprint problems)))
+                       ;; TODO needed?
                        [false (fh/form-problem problems)]))))

   :handle-unauthorized (fn [ctx]
@@ -114,7 +118,7 @@
                  name (first (s/split email #"@"))]
              (if-let [wallet (wallet/fetch wallet-store email)]
                (do
-                 (log/info "The wallet for email " email " already exists")
+                 (log/trace "The wallet for email " email " already exists")
                  {::email (:email wallet)})

                ;; a new wallet has to be made
@@ -137,7 +141,6 @@
                  {::email (:email wallet)}))))

   :handle-created (fn [ctx]
-                   (log/info "CREATED")
                    (lr/ring-response
                     (cond-> (r/redirect (routes/absolute-path :account :email (::email ctx)))
                       (::cookie-data ctx) (assoc-in [:session :cookie-data] (::cookie-data ctx))
@@ -151,7 +154,6 @@
            content-types)
      [false {:message "Unsupported Content-Type"}])
     true))
-

 (def content-types ["text/html" "application/x-www-form-urlencoded"])

@@ -194,7 +196,6 @@
   :known-content-type? #(check-content-type % content-types)

   :processable? (fn [ctx]
-                  (log/info "Processable")
                   (let [{:keys [status data problems]}
                         (fh/validate-form sign-in-page/sign-up-form
                                           (ch/context->params ctx))]
@@ -207,13 +208,11 @@
                           ctx))
                       [false (fh/form-problem problems)])))

-  :handle-unprocessable-entity (fn [ctx]
-                                 (log/info "unprocessable")
+  :handle-unprocessable-entity (fn [ctx]
                                  (lr/ring-response (fh/flash-form-problem
                                                     (r/redirect (routes/absolute-path :sign-in))
                                                     ctx)))
   :post! (fn [ctx]
-           (log/info "post!")
            (let [data (-> ctx :request :params)
                  email (get data :email)]
              ;; TODO add actions if db or email failed
@@ -234,7 +233,6 @@
   :allowed-methods [:get]
   :available-media-types ["text/html"]
   :handle-ok (fn [ctx]
-               (log/info "Email confirmation ")
                (-> ctx
                    (email-confirmation/build)
                    fv/render-page)))
@@ -259,7 +257,6 @@
   :allowed-methods [:get]
   :available-media-types ["text/html"]
   :handle-ok (fn [ctx]
-               (log/info "Account activated ")
                (-> ctx
                    (aa/build)
                    fv/render-page)))


Update mux defaults to look for codecs using predicate functions.

--- src/multicodec/codecs/mux.clj
+++ src/multicodec/codecs/mux.clj
@@ -6,11 +6,48 @@
   - `select-encoder` takes the collection of codecs and the value to be encoded
     and returns a key identifying the codec to write the value with.
   - `select-decoder` takes the collection of codecs and the header path and
-    returns a key identifying the codec to read the value with."
+    returns a key identifying the codec to read the value with.
+
+  By default, the selection functions will look for codecs which can encode and
+  decode the values and headers passed to the mux codec."
   (:require
     [multicodec.core :as codec]
     [multicodec.header :as header]
     [multicodec.codecs.wrap :as wrap]))
+
+
+(defn find-encodable
+  "Finds a codec in the map which can encode the given value. Returns the key
+  for the codec, or nil if none are found."
+  [codecs value]
+  (ffirst (filter #(codec/encodable? (val %) value) codecs)))
+
+
+(defn find-decodable
+  "Finds a codec in the map which can decode the given header. Returns the key
+  for the codec, or nil if none are found."
+  [codecs header]
+  (ffirst (filter #(codec/decodable? (val %) header) codecs)))
+
+
+(defn- resolve-codec!
+  "Returns the selected codec, if it exists. Otherwise, throws an exception."
+  [codecs selected value]
+  (when-not selected
+    (throw (ex-info
+             (str "No codec selected for: " (pr-str value))
+             {:codecs (keys codecs)
+              :value value})))
+  (when-not (get codecs selected)
+    (throw (ex-info
+             (str "Selected codec " selected " which is not present in"
+                  " the codec map " (pr-str (seq (keys codecs)))
+                  " for: " (pr-str value))
+             {:codecs (keys codecs)
+              :selected selected
+              :value value})))
+  (get codecs selected))
+

 ;; ## Multiplexing Codec
@@ -25,23 +62,16 @@

   codec/Encoder

+  (encodable?
+    [this value]
+    (boolean (when-let [codec (get codecs (select-encoder codecs value))]
+               (codec/encodable? codec value))))
+
+
   (encode!
     [this output value]
     (let [codec-key (select-encoder codecs value)
-          codec (get codecs codec-key)]
-      (when-not codec-key
-        (throw (ex-info
-                 (str "No encoder selected for value: " (pr-str value))
-                 {:codec-keys (keys codecs)
-                  :value value})))
-      (when-not codec
-        (throw (ex-info
-                 (str "Selected encoder " codec-key " which is not present in"
-                      " the codec map " (pr-str (seq (keys codecs)))
-                      " for value: " (pr-str value))
-                 {:codec-keys (keys codecs)
-                  :encoder codec-key
-                  :value value})))
+          codec (resolve-codec! codecs codec-key value)]
       (when (bound? #'*dispatched-codec*)
         (set! *dispatched-codec* codec-key))
       (wrap/write-header-encoded! codec output (:header codec) value)))
@@ -49,24 +79,17 @@

   codec/Decoder

+  (decodable?
+    [this header']
+    (boolean (when-let [codec (get codecs (select-decoder codecs header))]
+               (codec/decodable? codec header))))
+
+
   (decode!
     [this input]
     (let [header (header/read-header! input)
           codec-key (select-decoder codecs header)
-          codec (get codecs codec-key)]
-      (when-not codec-key
-        (throw (ex-info
-                 (str "No decoder selected for header: " (pr-str header))
-                 {:codec-keys (keys codecs)
-                  :header header})))
-      (when-not codec
-        (throw (ex-info
-                 (str "Selected decoder " codec-key " which is not present in"
-                      " the codec map " (pr-str (seq (keys codecs)))
-                      " for header: " (pr-str header))
-                 {:codec-keys (keys codecs)
-                  :decoder codec-key
-                  :header header})))
+          codec (resolve-codec! codecs codec-key header)]
       (when (bound? #'*dispatched-codec*)
         (set! *dispatched-codec* codec-key))
       (codec/decode! codec input))))
@@ -83,14 +106,6 @@
                          (pr-str codec-key) " " (pr-str (keys (:codecs mux))))
                     {:codec-keys (keys (:codecs mux))
                      :key codec-key}))))
-
-
-(defn- match-header
-  "Helper function for selecting a decoder. Returns the key for the first entry
-  whose codec header matches the one given."
-  [codecs header]
-  (some #(when (= header (:header (val %))) (key %))
-        codecs))

 (defn mux-codec
@@ -122,8 +137,8 @@
     (MuxCodec.
       "/multicodec"
       codec-map
-      (constantly (first codecs))
-      match-header)))
+      find-encodable
+      find-decodable)))

 ;; Remove automatic constructor functions.


Fixed editing of filtered components

Fixed editing of filtered components

--- src/warehouse/core.cljs
+++ src/warehouse/core.cljs
@@ -5,94 +5,122 @@

 (enable-console-print!)

-(defonce app-state (atom {:components [
-                                       {:name "EPR212A408000Z"
-                                        :tags ["optocoupler"]
-                                        :amount 7}
-                                       {:name "2N3904"
-                                        :tags ["transistor"]
-                                        :amount 8}
-                                       {:name "LF33CV"
-                                        :tags ["linear regulator"]
-                                        :amount 10}
-                                       {:name "BD241C"
-                                        :tags ["transistor"]
-                                        :amount 4}
-                                       {:name "HC49/US QM 16.000MHZ"
-                                        :tags ["crystal" "oscillator"]
-                                        :amount 1}
-                                       {:name "MCP23016-I/SP PDIP28 MICROCHIP"
-                                        :tags ["io" "expander"]
-                                        :amount 1}
-                                       {:name "KONPC-SPK-3"
-                                        :tags ["connector"]
-                                        :amount 10}
-                                       {:name "KONPC-SPK-2"
-                                        :tags ["connector"]
-                                        :amount 14}
-                                       {:name "KONPC-SPK-1"
-                                        :tags ["connector"]
-                                        :amount 15}
-                                       {:name "KONPC-SKP-4"
-                                        :tags ["connector"]
-                                        :amount 5}
-                                       {:name "BTK10G"
-                                        :tags ["connector"]
-                                        :amount 8}
-                                       {:name "BL820GD"
-                                        :tags ["connector"]
-                                        :amount 25}
-                                       {:name "AVRProg USB v3"
-                                        :tags ["rs232", "serial", "usb"]
-                                        :amount 1}
-                                       {:name "Micro USB B"
-                                        :tags ["connector" "micro usb" "usb"]
-                                        :amount 3}
-                                       {:name "S1G20"
-                                        :tags ["connector"]
-                                        :amount 8}
-                                       {:name "S1G8"
-                                        :tags ["connector"]
-                                        :amount 1}
-                                       {:name "S1G3"
-                                        :tags ["connector"]
-                                        :amount 1}
-                                       {:name "S2G20"
-                                        :tags ["connector"]
-                                        :amount 10}
-                                       {:name "KONPC-SPK-PI"
-                                        :tags ["connector"]
-                                        :amount 35}
-                                       {:name "USB PCB 2AW"
-                                        :tags ["connector"]
-                                        :amount 6}
-                                       {:name "USB1X90A PCB"
-                                        :tags ["connector"]
-                                        :amount 3}
-                                       {:name "USB PCB AW"
-                                        :tags ["connector"]
-                                        :amount 3}
-                                       {:name "CMM 5/3SQ"
-                                        :tags ["connector"]
-                                        :amount 4}
-                                       {:name "USB AM PCB"
-                                        :tags ["connector"]
-                                        :amount 4}
-                                       {:name "ST-214-C-06"
-                                        :tags ["jack" "audio"]
-                                        :amount 3}
-                                       {:name "USB A/C SET2"
-                                        :tags ["connector" "usb"]
-                                        :amount 10}
-                                       {:name "KMOC3063"
-                                        :tags ["optocoupler"]
-                                        :amount 6}
-                                       {:name "78M05-DPAK"
-                                        :tags ["linear regulator"]
-                                        :amount 9}]
-                          :filtered-components []}))
-
-(swap! app-state assoc-in [:filtered-components] (:components @app-state))
+(defonce app-state (atom {:components {
+                                       1 {:id 1
+                                          :name "EPR212A408000Z"
+                                          :tags ["optocoupler"]
+                                          :amount 7}
+                                       2 {:id 2
+                                          :name "2N3904"
+                                          :tags ["transistor"]
+                                          :amount 8}
+                                       3 {:id 3
+                                          :name "LF33CV"
+                                          :tags ["linear regulator"]
+                                          :amount 10}
+                                       4 {:id 4
+                                          :name "BD241C"
+                                          :tags ["transistor"]
+                                          :amount 4}
+                                       5 {:id 5
+                                          :name "HC49/US QM 16.000MHZ"
+                                          :tags ["crystal" "oscillator"]
+                                          :amount 1}
+                                       6 {:id 6
+                                          :name "MCP23016-I/SP PDIP28 MICROCHIP"
+                                          :tags ["io" "expander"]
+                                          :amount 1}
+                                       7 {:id 7
+                                          :name "KONPC-SPK-3"
+                                          :tags ["connector"]
+                                          :amount 10}
+                                       8 {:id 8
+                                          :name "KONPC-SPK-2"
+                                          :tags ["connector"]
+                                          :amount 14}
+                                       9 {:id 9
+                                          :name "KONPC-SPK-1"
+                                          :tags ["connector"]
+                                          :amount 15}
+                                       10 {:id 10
+                                           :name "KONPC-SKP-4"
+                                           :tags ["connector"]
+                                           :amount 5}
+                                       11 {:id 11
+                                           :name "BTK10G"
+                                           :tags ["connector"]
+                                           :amount 8}
+                                       12 {:id 12
+                                           :name "BL820GD"
+                                           :tags ["connector"]
+                                           :amount 25}
+                                       13 {:id 13
+                                           :name "AVRProg USB v3"
+                                           :tags ["rs232", "serial", "usb"]
+                                           :amount 1}
+                                       14 {:id 14
+                                           :name "Micro USB B"
+                                           :tags ["connector" "micro usb" "usb"]
+                                           :amount 3}
+                                       15 {:id 15
+                                           :name "S1G20"
+                                           :tags ["connector"]
+                                           :amount 8}
+                                       16 {:id 16
+                                           :name "S1G8"
+                                           :tags ["connector"]
+                                           :amount 1}
+                                       17 {:id 17
+                                           :name "S1G3"
+                                           :tags ["connector"]
+                                           :amount 1}
+                                       18 {:id 18
+                                           :name "S2G20"
+                                           :tags ["connector"]
+                                           :amount 10}
+                                       19 {:id 19
+                                           :name "KONPC-SPK-PI"
+                                           :tags ["connector"]
+                                           :amount 35}
+                                       20 {:id 20
+                                           :name "USB PCB 2AW"
+                                           :tags ["connector"]
+                                           :amount 6}
+                                       21 {:id 21
+                                           :name "USB1X90A PCB"
+                                           :tags ["connector"]
+                                           :amount 3}
+                                       22 {:id 22
+                                           :name "USB PCB AW"
+                                           :tags ["connector"]
+                                           :amount 3}
+                                       23 {:id 23
+                                           :name "CMM 5/3SQ"
+                                           :tags ["connector"]
+                                           :amount 4}
+                                       24 {:id 24
+                                           :name "USB AM PCB"
+                                           :tags ["connector"]
+                                           :amount 4}
+                                       25 {:id 25
+                                           :name "ST-214-C-06"
+                                           :tags ["jack" "audio"]
+                                           :amount 3}
+                                       26 {:id 26
+                                           :name "USB A/C SET2"
+                                           :tags ["connector" "usb"]
+                                           :amount 10}
+                                       27 {:id 27
+                                           :name "KMOC3063"
+                                           :tags ["optocoupler"]
+                                           :amount 6}
+                                       28 {:id 28
+                                           :name "78M05-DPAK"
+                                           :tags ["linear regulator"]
+                                           :amount 9}}
+                          :filter {:val ""
+                                   :search []}}))
+
 (def index (.lunr js/window (fn []
                      (this-as this
                               (.field this "name")
@@ -150,33 +178,34 @@
                                   (reset! editing false))} "Save"]
             [:button {:type "button" :on-click #(reset! editing false)} "Cancel"]]))])))

+(defn get-visible-components []
+  (if (clojure.string/blank? (get-in @app-state [:filter :val]))
+    (:components @app-state)
+    (loop [indexes (map #(get % "ref") (get-in @app-state [:filter :search]))
+          res []]
+      (if (empty? indexes)
+        res
+        (recur (rest indexes) (conj res [(first indexes) (get (:components @app-state) (first indexes))]))))))
+
 (defn page []
   [:div
    [:label "Search: "
     [:input {:name "search",
              :type "search"
              :on-change (fn [e]
-                          (swap! app-state assoc :filtered-components
-                                 (if (clojure.string/blank? (.-target.value e))
-                                   (:components @app-state)
-                                   (loop [indexes (map #(get % "ref") (js->clj (.search index (.-target.value e))))
-                                         res []]
-                                     (if (empty? indexes)
-                                       res
-                                       (recur (rest indexes) (conj res (nth (:components @app-state) (first indexes)))))))))}]]
+                          (swap! app-state assoc-in [:filter :val] (.-target.value e))
+                          (swap! app-state assoc-in [:filter :search] (js->clj (.search index (.-target.value e)))))}]]
    [:button "Add new"]
-   (for [[k v] (map vector (iterate inc 0) (:filtered-components @app-state))]
+   (for [[k v] (get-visible-components)]
      ^{:key (:name v)} [item v k])])

 (reagent/render-component [page]
                           (.getElementById js/document "app"))

-(doseq [[k component] (map vector (iterate inc 0) (:components @app-state))]
-  (.add index (clj->js {:id k
+(doseq [[k component] (:components @app-state)]
+  (.add index (clj->js {:id (:id component)
                         :name (:name component)
                         :tags (:tags component)})))
-
-(aset js/window "index" index)

 (defn on-js-reload []
   ;; optionally touch your app-state to force rerendering depending on


Stringify fields prior to rendering otherwise they go raw into hiccup, oops!

--- src/kixi/hecuba/web/resources.clj
+++ src/kixi/hecuba/web/resources.clj
@@ -37,7 +37,7 @@
                             (for [p projects]
                               [:tr
                                [:td [:a {:href (:href p)} (:name p)]]
-                               (for [k fields] [:td (k p)])
+                               (for [k fields] [:td (str (k p))])
                                (when debug [:td (pr-str p)])])]]

                           ]))


Fix compliance test.

Fix compliance test.

--- src/konserve/compliance_test.cljc
+++ src/konserve/compliance_test.cljc
@@ -7,41 +7,40 @@

 (defn compliance-test [store]
   (testing "Test the core API."
-    (let [store (<!! store)]
-      (is (= (<!! (get store :foo))
-             nil))
-      (<!! (assoc store :foo :bar))
-      (is (= (<!! (get store :foo))
-             :bar))
-      (<!! (assoc-in store [:foo] :bar2))
-      (is (= :bar2 (<!! (get store :foo))))
-      (is (= :default
-             (<!! (get-in store [:fuu] :default))))
-      (is (= :bar2 (<!! (get store :foo))))
-      (is (= :default
-             (<!! (get-in store [:fuu] :default))))
-      (<!! (update-in store [:foo] name))
-      (is (= "bar2"
-             (<!! (get store :foo))))
-      (<!! (assoc-in store [:baz] {:bar 42}))
-      (is (= (<!! (get-in store [:baz :bar]))
-             42))
-      (<!! (update-in store [:baz :bar] inc))
-      (is (= (<!! (get-in store [:baz :bar]))
-             43))
-      (<!! (update-in store [:baz :bar] + 2 3))
-      (is (= (<!! (get-in store [:baz :bar]))
-             48))
-      (<!! (dissoc store :foo))
-      (is (= (<!! (get-in store [:foo]))
-             nil))
-      (<!! (bassoc store :binbar (byte-array (range 10))))
-      (<!! (bget store :binbar (fn [{:keys [input-stream]}]
-                                 (go
-                                   (is (= (map byte (slurp input-stream))
-                                          (range 10)))))))
-      (let  [{:keys [key type :konserve.core/timestamp]} (first (<!! (keys store)))]
-         (are [x y] (= x y)
-           (type (java.util.Date.)) (type timestamp)
-           true (contains? #{:foo :baz} key)
-           true (contains? #{:edn} type))))))
+    (is (= (<!! (get store :foo))
+           nil))
+    (<!! (assoc store :foo :bar))
+    (is (= (<!! (get store :foo))
+           :bar))
+    (<!! (assoc-in store [:foo] :bar2))
+    (is (= :bar2 (<!! (get store :foo))))
+    (is (= :default
+           (<!! (get-in store [:fuu] :default))))
+    (is (= :bar2 (<!! (get store :foo))))
+    (is (= :default
+           (<!! (get-in store [:fuu] :default))))
+    (<!! (update-in store [:foo] name))
+    (is (= "bar2"
+           (<!! (get store :foo))))
+    (<!! (assoc-in store [:baz] {:bar 42}))
+    (is (= (<!! (get-in store [:baz :bar]))
+           42))
+    (<!! (update-in store [:baz :bar] inc))
+    (is (= (<!! (get-in store [:baz :bar]))
+           43))
+    (<!! (update-in store [:baz :bar] + 2 3))
+    (is (= (<!! (get-in store [:baz :bar]))
+           48))
+    (<!! (dissoc store :foo))
+    (is (= (<!! (get-in store [:foo]))
+           nil))
+    (<!! (bassoc store :binbar (byte-array (range 10))))
+    (<!! (bget store :binbar (fn [{:keys [input-stream]}]
+                               (go
+                                 (is (= (map byte (slurp input-stream))
+                                        (range 10)))))))
+    (let  [{:keys [key type :konserve.core/timestamp]} (first (<!! (keys store)))]
+      (are [x y] (= x y)
+        (type (java.util.Date.)) (type timestamp)
+        true                     (contains? #{:foo :baz} key)
+        true                     (contains? #{:edn} type)))))


minor

minor

--- src/ysmiraak/tensor.clj
+++ src/ysmiraak/tensor.clj
@@ -291,6 +291,12 @@
   (dims (tenx dot [3] x [4 3 2] y [4 3] z [3 2])) => [4 2]
   ```

+  - operation along axis
+  ```clojure
+  (def sum (partial reduce +))
+  (dims (tenx sum [1] x [0 1 2])) => [4 2]
+  ```
+
   - broadcasting
   ```clojure
   (let [[x' e] (tenx list [4 3 2] x [4 3 2] 0 [])]
@@ -301,12 +307,6 @@
   - transposition
   ```clojure
   (dims (tenx identity [2 1 0] x [0 1 2])) => [2 3 4]
-  ```
-
-  - operation along axis
-  ```clojure
-  (def sum (partial reduce +))
-  (dims (tenx sum [1] x [0 1 2])) => [4 2]
   ```

   - or this


CMR-1051: Changing terms execution mode from bool to plain. See CMR-1051 for details.

--- search-app/src/cmr/search/data/query_to_elastic.clj
+++ search-app/src/cmr/search/data/query_to_elastic.clj
@@ -165,7 +165,7 @@
           field (if case-sensitive? field (str (name field) ".lowercase"))
           values (if case-sensitive? values (map str/lower-case values))]
       {:terms {field values
-               :execution "bool"}}))
+               :execution "plain"}}))

   cmr.search.models.query.BooleanCondition
   (condition->elastic


quick keyword benchmark to verify instinct

--- src/repl/shadow/benchmark.clj
+++ src/repl/shadow/benchmark.clj
@@ -7,7 +7,8 @@
             [shadow.build.npm :as npm]
             [shadow.cljs.devtools.cli]
             [shadow.cljs.devtools.server]
-            ))
+            [clojure.string :as str])
+  (:import (java.io FileOutputStream)))

 (defn test-build []
   (let [npm
@@ -47,6 +48,38 @@
 (defn -main []
   (go 5))

+;; @cmal asked in #clojurescript clojurians whether
+;; the keyword construction could be optimized by removing the fqn
+;; since its identical to the name for unqualified keywords
+;; result: small difference after gzip, extra overhead at runtime
+;; this test also generates completely random keywords
+;; real world will have some more overlap which should improve gzip
+(deftest test-keyword-size-difference
+  (let [dict
+        (into [] "abcdefghijklmnopqrstuvwxyz1234567890")
+
+        max
+        (count dict)
+
+        with-fqn
+        #(str "new X(null, \"" % "\", \"" % "\", " (rand) ", null);")
+
+        without-fqn
+        #(str "new X(null, \"" % "\", " (rand) ", null);")]
+
+    (with-open [out1 (FileOutputStream. "tmp/keywords-fqn.txt")
+                out2 (FileOutputStream. "tmp/keywords-new.txt")]
+
+      (dotimes [x 500]
+        (let [gen-name
+              (->> (range (+ 3 (rand-int 12)))
+                   (map (fn [x] (nth dict (rand-int max))))
+                   (str/join ""))]
+
+          (.write out1 (.getBytes (with-fqn gen-name)))
+          (.write out2 (.getBytes (without-fqn gen-name)))
+          )))))
+
 (comment
   (go 1)


revert hiding the sidebar to prevent it from popping in and changing the page size

--- frontend/components/aside.cljs
+++ frontend/components/aside.cljs
@@ -246,5 +246,5 @@
           shared/invite-form ;; modal trigger is in aside-nav
           (om/build aside-nav data {:opts {:login login
                                            :gravatar-id gravatar-id}})
-          (when (seq (get-in app state/projects-path))
-            (om/build activity data {:opts {:login login}}))])))))
+
+          (om/build activity data {:opts {:login login}})])))))


It's domain-part, not host-part

It's domain-part, not host-part

--- src/spam_and_eggs/persona.clj
+++ src/spam_and_eggs/persona.clj
@@ -16,12 +16,12 @@

 (def last-name-generator (frequency-generatorize (config :data :last-names)))

-(def email-host-generator (gen/elements (config :data :domains :default)))
+(def email-domain-generator (gen/elements (config :data :domains :default)))

-(defn persona [first-name last-name email-host prolificness]
+(defn persona [first-name last-name email-domain prolificness]
   {:first-name first-name
    :last-name last-name
-   :email-host email-host
+   :email-domain email-domain
    :email-address-format :first-dot-last
    :email-pretty-name :quoted-first-last
    :email-body-persona :business
@@ -32,6 +32,6 @@
   (gen/sample (gen/fmap (partial apply persona)
                         (gen/tuple first-name-generator
                                    last-name-generator
-                                   email-host-generator
+                                   email-domain-generator
                                    gen/s-pos-int))
               n))


Handle login on arrival

Handle login on arrival

--- src/trak/action_handlers.cljs
+++ src/trak/action_handlers.cljs
@@ -1,7 +1,9 @@
 (ns trak.action_handlers
   (:require [datascript.core :as d]
             [trak.utils :as utils]
-            [trak.api :as api]))
+            [trak.api :as api]
+            [trak.globals :as globals]
+            [trak.db :as db]))

 (def api-result-handler)
@@ -9,31 +11,22 @@
 (defmulti handler (fn [action params *db] action))

 (defmethod handler :find-albums [_ _ _]
-
   (api/find-albums "blues"))

 (defmethod handler :api-call-result [_ params db]
   (utils/info "Api call result " params)
   (api-result-handler (:call params) (:response params) db))

-
-;; Utitlity. Convert prefix and key to :prefix/key to use with Datascript
-(defn to-prefixed-keyword [prefix key]
-  (cond
-    (= key :db/id) key
-    :else (keyword (name prefix) (name key))))
-
-;; Convert {:name "event" :startTime "1234"} to
-;;         {:event/name "event" :event/startTime "1234}
-;; etc.
-
-(defn- convert-atrrs-to-datascript [attrs keyword-prefix]
-  (reduce #(assoc %1 (to-prefixed-keyword keyword-prefix (first %2)) (second %2)) {} attrs))
-
-(defn json-to-datascript [collection-of-entities keyword-prefix]
-  (map (fn [entity]
-         (convert-atrrs-to-datascript entity keyword-prefix))
-       collection-of-entities))
+(defmethod handler :login-on-arrival [_ params db]
+  (utils/info "Trying to log in user on arrival " params)
+  (when-let [auth (globals/get-spotify-auth-token)]
+    (utils/info db)
+    (d/transact! db [{:me/identifier :me
+                      :me/status     :loading}])
+    (d/transact! db [(merge {:me/identifier :me}
+                            (db/convert-atrrs-to-datascript auth :me))])
+    (utils/info (:access_token auth))
+    (api/me (:access_token auth))))

 (defmulti api-result-handler (fn [api result *db] api))


Macros: Notes.

Macros: Notes.

--- test/com/nomistech/clojure_the_language/macros/examples.clj
+++ test/com/nomistech/clojure_the_language/macros/examples.clj
@@ -194,8 +194,16 @@
 ;;;; built in.

 ;;;; Look at examples:
-;;;; e.g. `and`, `or`, `let`, `cond`, `while`, `letfn`, `with-redefs`, `->`,
+;;;;
+;;;; e.g. In clojure itself:
+;;;;      `and`, `or`, `let`, `cond`, `while`, `letfn`, `with-redefs`, `->`,
 ;;;;      `->>`, `as->`.
+;;;;
+;;;; e.g. In libraries:
+;;;;      - `try+` / `throw+` in Slingshot (https://github.com/scgilardi/slingshot)
+;;;;      - `defroutes` / `GET` / `POST` etc in Compojure
+;;;;      - core.match -- a library for pattern matching
+;;;;      - core.async -- a library for asynchronous programming using channels

 ;;;; ___________________________________________________________________________


fix bug of album not knowing pixel type

fix bug of album not knowing pixel type

git-svn-id: 03a8048b5ee8463be5048a3801110fb50f378627@6950 d0ab736e-dc22-4aeb-8dc9-08def0aa14fd

--- acqEngine/src/org/micromanager/acq_engine.clj
+++ acqEngine/src/org/micromanager/acq_engine.clj
@@ -537,7 +537,10 @@
    :z-drive (core getFocusDevice), :wait-time-ms 0})

 (defn create-basic-state []
-  {:init-width (core getImageWidth) :init-height (core getImageHeight)})
+  {:init-width (core getImageWidth)
+   :init-height (core getImageHeight)
+   :pixel-type (get-pixel-type)
+   :binning (core getProperty (core getCameraDevice) "Binning")})

 (defn acquire-tagged-image []
   (core snapImage)


fix space formatting

fix space formatting

--- test/calfpath/route_test.cljc
+++ test/calfpath/route_test.cljc
@@ -255,8 +255,7 @@
   [{:uri "/album/:lid/artist/:rid/" :method :get}
    {:uri "/hello/1234/"                         }
    {:uri "/info/:token/"            :method :get}
-   {:uri "/user/:id*" :nested [
-                               {:uri "/auth"    }
+   {:uri "/user/:id*" :nested [{:uri "/auth"    }
                                {:uri "/permissions/"   :nested [{:method :get   }
                                                                 {:method :post  }
                                                                 {:method :put   }]}


Example aligned with instructions

Example aligned with instructions

--- assignments/clojure/rna-transcription/example.clj
+++ assignments/clojure/rna-transcription/example.clj
@@ -1,13 +1,17 @@
 (ns dna)

-(def adenosine \A)
-(def cytadine  \C)
-(def guanosine \G)
-(def thymidine \T)
-(def uracil    \U)
+(def dna->rna {
+      \C \G
+      \G \C
+      \A \U
+      \T \A})
+
+(defn validate-strand [strand]
+  (let [valid-dna (set (keys dna->rna))]
+    (every? valid-dna strand)))

 (defn to-rna
   [strand]
-  {:pre [(every? #{adenosine cytadine guanosine thymidine}
-                 (set strand))]}
-  (clojure.string/replace strand thymidine uracil))
+  {:pre [(validate-strand strand)]}
+  (apply str
+    (map dna->rna (seq strand))))


remove test for buddy upgrade

remove test for buddy upgrade

--- auth/test/com/sixsq/slipstream/auth/core_test.clj
+++ auth/test/com/sixsq/slipstream/auth/core_test.clj
@@ -9,6 +9,7 @@
     (is (hashers/check      secret   encrypted))
     (is (not (hashers/check "wrong" encrypted)))

-    (is (= 162 (count encrypted)))
+    ;; FIXME: Why should the length be invariant?
+    #_(is (= 162 (count encrypted)))
     ))


add note about :stat :type string/keyword mismatch

--- src/brainbot/nozzle/fsworker.clj
+++ src/brainbot/nozzle/fsworker.clj
@@ -24,6 +24,9 @@
    (not (:error entry))
    (= (get-in entry [:stat :type]) type)))

+;; FIXME the following two function defs use a string instead of a
+;; symbol.  that works, because values passed in have been
+;; deserialized with the json reader.
 (def ^{:doc "entry does not have :error set and is a directory"}
   entry-is-directory-ok? (partial entry-is-type-ok? "directory"))
 (def ^{:doc "entry does not have :error set and is a file"}


Fix unit test for execution count

Fix unit test for execution count

--- test/clojupyter/core_test.clj
+++ test/clojupyter/core_test.clj
@@ -204,7 +204,7 @@
                 (get @zmq-messages 1))
                [:content])
        => {:code "(println 10)"
-           :execution_count 0}
+           :execution_count 1}
        (get-in ((comp parse-message mzmq/parts-to-message)
                (get @zmq-messages 2))
               [:header :msg_type ])


remove unneeded lexicon

remove unneeded lexicon

--- test/babel/test/fr.cljc
+++ test/babel/test/fr.cljc
@@ -399,8 +399,7 @@
                                     :person :1st,
                                     :gender :masc},
                               :essere true,
-                              :infl :present}}
-                    @lexicon)
+                              :infl :present}})
          "plains")))

 (deftest nous-acheterons


babel.generate/try-hard-to

babel.generate/try-hard-to

--- test/babel/test/fr.cljc
+++ test/babel/test/fr.cljc
@@ -2,7 +2,7 @@
     babel.test.fr
   (:refer-clojure :exclude [get-in])
   (:require [babel.engine :as engine]
-            [babel.generate :as generate]
+            [babel.generate :as generate :refer [try-hard-to]]
             [babel.francais :refer [generate lookup parse]]
             [babel.francais.grammar :refer [small medium]]
             [babel.francais.lexicon :refer [lexicon]]
@@ -381,3 +381,13 @@
                             (unifyc unify-with entry))
                           (lookup lex)))
                   replace-patterns)))
+(deftest foo
+  (let [the-foo (try-hard-to
+                 #(generate
+                   {:synsem {:sem {:subj {:pred :lui}
+                                   :pred :have-fun
+                                   :tense :present}}}))]
+    (is (not (empty? the-foo)))))
+
+
+(deftest generate-vp-present-reflexive


more work on macros

more work on macros

--- test/babel/test/it.cljc
+++ test/babel/test/it.cljc
@@ -19,8 +19,8 @@
    [clojure.set :as set]
    [dag_unify.core :refer [copy fail? get-in strip-refs unify]]))

-(defmacro deftest [test-name stuff]
-  `(apply realtest/deftest ~@[test-name stuff]))
+(defmacro deftest [test-name & stuff]
+  `(apply ~realtest/deftest ~test-name ~@stuff))

 (deftest analyze-1
   (let [singular (analyze "compito")


add pagination test

add pagination test

--- test/bzzz/core_test.clj
+++ test/bzzz/core_test.clj
@@ -21,6 +21,34 @@
       (is (= 2 (:total ret)))
       (is (= "john doe" (:name_store_index (first (:hits ret)))))
       (is (= "jack doe foo" (:name_store_index (last (:hits ret)))))))
+
+  (testing "search-or-pages"
+    (let [ret-page-0 (search :index test-index-name
+                      :default-field "name_store_index"
+                      :default-operator "or"
+                      :size 1
+                      :page 0
+                      :query "john doe")
+          ret-page-1 (search :index test-index-name
+                             :default-field "name_store_index"
+                             :default-operator "or"
+                             :size 1
+                             :page 1
+                             :query "john doe")
+          ret-page-2 (search :index test-index-name
+                             :default-field "name_store_index"
+                             :default-operator "or"
+                             :size 1
+                             :page 2
+                             :query "john doe")]
+      (is (= 2 (:total ret-page-0)))
+      (is (= 2 (:total ret-page-1)))
+      (is (= 2 (:total ret-page-2)))
+      (is (= 1 (count (:hits ret-page-0))))
+      (is (= 1 (count (:hits ret-page-1))))
+      (is (= 0 (count (:hits ret-page-2))))
+      (is (= "john doe" (:name_store_index (first (:hits ret-page-0)))))
+      (is (= "jack doe foo" (:name_store_index (last (:hits ret-page-1)))))))

   (testing "search-and"
     (let [ret (search :index test-index-name


Add new gathering

Add new gathering

--- src/clj/chili_dog_night/data.clj
+++ src/clj/chili_dog_night/data.clj
@@ -1,7 +1,29 @@
 (ns chili-dog-night.data
   (:require [hiccup.element :as el]))

-(def gatherings [{:date "2016/02/10"
+(def gatherings [{:date "2016/02/24"
+                  :address "1808 SW Elmgrove St, Seattle, WA 98106, USA"
+                  :synopsis "February 24th, 2016: Pizza plus Worms, Jem and the Holograms, and The Visit."
+                  :food ["Pizza from Frelard Pizza Company"
+                         "Trolli Sour Brite Crawlers Gummi Candy"]
+                  :attendees ["Alex Sanchez"
+                              "Greg Ryan"
+                              "Jason Aumann"
+                              "Jacob Dobner"]
+                  :media [{:title "Jem and the Holograms" :uri "http://www.imdb.com/title/tt3614530/"}
+                          {:title "The Visit" :uri "http://www.imdb.com/title/tt3567288/"}]
+                  :notes [:p
+                          (el/link-to "https://www.instagram.com/p/BCMvCdjMX6V/" "Jammers")
+                          [:br]
+                          (el/link-to "http://jezebel.com/how-we-failed-to-protect-kesha-1760142637?rev=1455919264571" "The Pending Emancipation of Kesha")
+                          [:br]
+                          (el/link-to "https://en.wikipedia.org/wiki/Found_footage_(pseudo-documentary)" "Found Footage")
+                          " and "
+                          (el/link-to "http://www.mediapost.com/publications/article/164602/hasbro-plays-product-placement-game.html#ixzz1hBGO1uEO" "Hasbro Product Placement")
+                          [:br]
+                          "The implosion of the Republican party by the coward "
+                          (el/link-to "http://www.rollingstone.com/politics/news/how-america-made-donald-trump-unstoppable-20160224?page=12" "Donald Trump")]}
+                 {:date "2016/02/10"
                   :address "3828 Meridian Ave N, Seattle, WA 98103, USA"
                   :synopsis "February 10th, 2016: Sausages and Hot Dogs, Jackie & Ryan, and Insurgent."
                   :food ["Sausages"


WIP cleanin up routing

WIP cleanin up routing

--- src/clj/clj_money/web/server.clj
+++ src/clj/clj_money/web/server.clj
@@ -48,139 +48,133 @@
             [clj-money.web.users :as users]
             [clj-money.web.grants :as grants]))

-(defmacro route
-  [method path handler]
-  `(~method ~path req# (-> ~handler
-                           wrap-models
-                           wrap-integer-id-params)))
-
 (defroutes protected-routes
   ; Entities
-  (route GET "/entities" entities/index)
-  (route GET "/entities/new" entities/new-entity)
-  (route POST "/entities" entities/create-entity)
-  (route GET "/entities/:id/edit" entities/edit-entity)
-  (route POST "/entities/:id" entities/update)
-  (route POST "/entities/:id/delete" entities/delete)
+  (GET  "/entities"            req entities/index)
+  (GET  "/entities/new"        req entities/new-entity)
+  (POST "/entities"            req entities/create-entity)
+  (GET  "/entities/:id/edit"   req entities/edit-entity)
+  (POST "/entities/:id"        req entities/update)
+  (POST "/entities/:id/delete" req entities/delete)

   ; User grants
-  (route GET "/entities/:entity-id/grants" grants/index)
-  (route GET "/entities/:entity-id/grants/new" grants/new-grant)
-  (route POST "/entities/:entity-id/grants" grants/create)
-  (route GET "/grants/:id/edit" grants/edit)
-  (route POST "/grants/:id" grants/update)
-  (route POST "/grants/:id/delete" grants/delete)
+  (GET  "/entities/:entity-id/grants"     req grants/index)
+  (GET  "/entities/:entity-id/grants/new" req grants/new-grant)
+  (POST "/entities/:entity-id/grants"     req grants/create)
+  (GET  "/grants/:id/edit"                req grants/edit)
+  (POST "/grants/:id"                     req grants/update)
+  (POST "/grants/:id/delete"              req grants/delete)

   ; Accounts
-  (route GET "/entities/:entity-id/accounts" accounts/index)
-  (route GET "/entities/:entity-id/accounts/new" accounts/new-account)
-  (route POST "/entities/:entity-id/accounts" accounts/create)
-  (route GET "/accounts/:id" accounts/show)
-  (route GET "/accounts/:id/edit" accounts/edit)
-  (route POST "/accounts/:id" accounts/update)
-  (route POST "/accounts/:id/delete" accounts/delete)
+  (GET "/entities/:entity-id/accounts" req accounts/index)
+  (GET "/entities/:entity-id/accounts/new" req accounts/new-account)
+  (POST "/entities/:entity-id/accounts" req accounts/create)
+  (GET "/accounts/:id" req accounts/show)
+  (GET "/accounts/:id/edit" req accounts/edit)
+  (POST "/accounts/:id" req accounts/update)
+  (POST "/accounts/:id/delete" req accounts/delete)

   ; Budgets
-  (route GET "/entities/:entity-id/budgets" budgets/index)
-  (route GET "/entities/:entity-id/budgets/new" budgets/new-budget)
-  (route POST "/entities/:entity-id/budgets" budgets/create)
-  (route GET "/budgets/:id/edit" budgets/edit)
-  (route POST "/budgets/:id" budgets/update)
-  (route POST "/budgets/:id/delete" budgets/delete)
-  (route GET "/budgets/:id" budgets/show)
+  (GET "/entities/:entity-id/budgets" req budgets/index)
+  (GET "/entities/:entity-id/budgets/new" req budgets/new-budget)
+  (POST "/entities/:entity-id/budgets" req budgets/create)
+  (GET "/budgets/:id/edit" req budgets/edit)
+  (POST "/budgets/:id" req budgets/update)
+  (POST "/budgets/:id/delete" req budgets/delete)
+  (GET "/budgets/:id" req budgets/show)

   ; Budget items
-  (route GET "/budgets/:budget-id/items/new/:method" budgets/new-item)
-  (route POST "/budgets/:budget-id/items" budgets/create-item)
-  (route GET "/budget-items/:id/edit/:method" budgets/edit-item)
-  (route POST "/budget-items/:id" budgets/update-item)
-  (route POST "/budget-items/:id/delete" budgets/delete-item)
+  (GET "/budgets/:budget-id/items/new/:method" req budgets/new-item)
+  (POST "/budgets/:budget-id/items" req budgets/create-item)
+  (GET "/budget-items/:id/edit/:method" req budgets/edit-item)
+  (POST "/budget-items/:id" req budgets/update-item)
+  (POST "/budget-items/:id/delete" req budgets/delete-item)

   ; Budget monitors
-  (route GET "/entities/:entity-id/monitors" entities/monitors)
-  (route POST "/entities/:entity-id/monitors" entities/create-monitor)
-  (route POST "/entities/:entity-id/monitors/:account-id/delete" entities/delete-monitor)
+  (GET "/entities/:entity-id/monitors" req entities/monitors)
+  (POST "/entities/:entity-id/monitors" req entities/create-monitor)
+  (POST "/entities/:entity-id/monitors/:account-id/delete" req entities/delete-monitor)

   ; Commodities
-  (route GET "/entities/:entity-id/commodities" commodities/index)
-  (route GET "/entities/:entity-id/commodities/new" commodities/new-commodity)
-  (route POST "/entities/:entity-id/commodities" commodities/create)
-  (route GET "/commodities/:id/edit" commodities/edit)
-  (route POST "/commodities/:id" commodities/update)
-  (route POST "/commodities/:id/delete" commodities/delete)
+  (GET "/entities/:entity-id/commodities" req commodities/index)
+  (GET "/entities/:entity-id/commodities/new" req commodities/new-commodity)
+  (POST "/entities/:entity-id/commodities" req commodities/create)
+  (GET "/commodities/:id/edit" req commodities/edit)
+  (POST "/commodities/:id" req commodities/update)
+  (POST "/commodities/:id/delete" req commodities/delete)

   ; Prices
-  (route GET "/commodities/:commodity-id/prices" prices/index)
-  (route GET "/commodities/:commodity-id/prices/new" prices/new-price)
-  (route POST "/commodities/:commodity-id/prices" prices/create)
-  (route POST "/commodities/:commodity-id/prices/fetch" prices/fetch)
-  (route POST "/entities/:entity-id/prices/fetch" prices/fetch-all)
-  (route POST "/prices/:id/delete" prices/delete)
+  (GET "/commodities/:commodity-id/prices" req prices/index)
+  (GET "/commodities/:commodity-id/prices/new" req prices/new-price)
+  (POST "/commodities/:commodity-id/prices" req prices/create)
+  (POST "/commodities/:commodity-id/prices/fetch" req prices/fetch)
+  (POST "/entities/:entity-id/prices/fetch" req prices/fetch-all)
+  (POST "/prices/:id/delete" req prices/delete)

   ; Transactions
-  (route GET "/entities/:entity-id/transactions" transactions/index)
-  (route GET "/entities/:entity-id/transactions/new" transactions/new-transaction)
-  (route POST "/entities/:entity-id/transactions" transactions/create)
-  (route GET "/transactions/:transaction-date/:id/edit" transactions/edit)
-  (route POST "/transactions/:transaction-date/:id" transactions/update)
-  (route POST "/transactions/:transaction-date/:id/delete" transactions/delete)
+  (GET "/entities/:entity-id/transactions" req transactions/index)
+  (GET "/entities/:entity-id/transactions/new" req transactions/new-transaction)
+  (POST "/entities/:entity-id/transactions" req transactions/create)
+  (GET "/transactions/:transaction-date/:id/edit" req transactions/edit)
+  (POST "/transactions/:transaction-date/:id" req transactions/update)
+  (POST "/transactions/:transaction-date/:id/delete" req transactions/delete)

   ; Attachments
-  (route GET "/transactions/:transaction-id/attachments" attachments/index)
-  (route GET "/transactions/:transaction-id/attachments" attachments/index)
-  (route GET "/transactions/:transaction-id/attachments/new" attachments/new-attachment)
-  (route POST "/transactions/:transaction-id/attachments" attachments/create)
-  (route GET "/attachments/:id/edit" attachments/edit)
-  (route POST "/attachments/:id" attachments/update)
-  (route POST "/attachments/:id/delete" attachments/delete)
+  (GET "/transactions/:transaction-id/attachments" req attachments/index)
+  (GET "/transactions/:transaction-id/attachments" req attachments/index)
+  (GET "/transactions/:transaction-id/attachments/new" req attachments/new-attachment)
+  (POST "/transactions/:transaction-id/attachments" req attachments/create)
+  (GET "/attachments/:id/edit" req attachments/edit)
+  (POST "/attachments/:id" req attachments/update)
+  (POST "/attachments/:id/delete" req attachments/delete)

   ; Images
-  (route GET "/images/:image-id" images/show)
+  (GET "/images/:image-id" req images/show)

   ; Trading
-  (route GET "/accounts/:account-id/purchases/new" trading/new-purchase)
-  (route POST "/accounts/:account-id/purchases" trading/purchase)
-  (route GET "/accounts/:account-id/sales/new" trading/new-sale)
-  (route POST "/accounts/:account-id/sales" trading/sell)
-  (route POST "/transactions/:transaction-id/unbuy" trading/unbuy)
+  (GET "/accounts/:account-id/purchases/new" req trading/new-purchase)
+  (POST "/accounts/:account-id/purchases" req trading/purchase)
+  (GET "/accounts/:account-id/sales/new" req trading/new-sale)
+  (POST "/accounts/:account-id/sales" req trading/sell)
+  (POST "/transactions/:transaction-id/unbuy" req trading/unbuy)

   ; Lots
-  (route GET "/accounts/:account-id/lots" lots/index)
+  (GET "/accounts/:account-id/lots" req lots/index)

   ; Reconciliations
-  (route GET "/accounts/:account-id/reconciliations/new" reconciliations/new-reconciliation)
-  (route POST "/accounts/:account-id/reconciliations" reconciliations/create)
-  (route GET "/reconciliations/:id" reconciliations/show)
-  (route GET "/reconciliations/:id/edit" reconciliations/edit)
-  (route POST "/reconciliations/:id" reconciliations/update)
-  (route POST "/reconciliations/:id/delete" reconciliations/delete)
+  (GET "/accounts/:account-id/reconciliations/new" req reconciliations/new-reconciliation)
+  (POST "/accounts/:account-id/reconciliations" req reconciliations/create)
+  (GET "/reconciliations/:id" req reconciliations/show)
+  (GET "/reconciliations/:id/edit" req reconciliations/edit)
+  (POST "/reconciliations/:id" req reconciliations/update)
+  (POST "/reconciliations/:id/delete" req reconciliations/delete)

   ; Imports
-  (route GET "/imports/new" imports/new-import)
+  (GET "/imports/new" req imports/new-import)

   ; Reports
-  (route GET "/entities/:entity-id/reports" reports/render)
-  (route GET "/entities/:entity-id/reports/:type" reports/render)
+  (GET "/entities/:entity-id/reports" req reports/render)
+  (GET "/entities/:entity-id/reports/:type" req reports/render)

   ; Single page apps
-  (route GET "/apps" apps/index)
-  (route GET "/apps/:id" apps/show))
+  (GET "/apps" req apps/index)
+  (GET "/apps/:id" req apps/show))

 (defroutes api-routes
-  (route GET    "/api/entities" entities-api/index)
-  (route DELETE "/api/entities/:id" entities-api/delete)
+  (GET "/api/entities" req entities-api/index)
+  (DELETE "/api/entities/:id" req entities-api/delete)

   ; Imports
-  (route POST "/api/imports" imports-api/create)
-  (route GET "/api/imports/:id" imports-api/show))
+  (POST "/api/imports" req imports-api/create)
+  (GET "/api/imports/:id" req imports-api/show))

 (defroutes open-routes
-  (route GET  "/" pages/home)
-  (route GET  "/login" pages/login)
-  (route GET  "/signup" users/new-user)
-  (route POST "/users" users/create-user)
-  (route GET  "/users/:token/password" users/new-password)
-  (route POST "/users/:token/password" users/set-password))
+  (GET "/" req pages/home)
+  (GET "/login" req pages/login)
+  (GET "/signup" req users/new-user)
+  (POST "/users" req users/create-user)
+  (GET "/users/:token/password" req users/new-password)
+  (POST "/users/:token/password" req users/set-password))

 (def ^:private accept-map
   {"application/json" :json})
@@ -200,34 +194,61 @@
   [req]
   (route/not-found (slurp (io/resource "404.html"))))

-(defroutes routes
-  open-routes
+(def wrapped-protected-routes
+  (-> protected-routes
+      (friend/authenticate
+        {:workflows [(workflows/interactive-form)]
+         :credential-fn (partial clj-money.models.users/authenticate (env :db))
+         :redirect-on-auth? false})
+      (friend/wrap-authorize #{:user})
+      wrap-anti-forgery
+      wrap-models
+      wrap-integer-id-params
+      wrap-content-type
+      wrap-exception-handling
+      wrap-params
+      wrap-multipart-params
+      wrap-keyword-params
+      wrap-session))
+
+(def wrapped-api-routes
+  (-> api-routes
+      (friend/authenticate
+        {:workflows [(workflows/interactive-form)]
+         :credential-fn (partial clj-money.models.users/authenticate (env :db))
+         :redirect-on-auth? false})
+      (friend/wrap-authorize #{:user})
+      wrap-models
+      wrap-integer-id-params
+      wrap-content-type
+      wrap-exception-handling
+      wrap-params
+      wrap-json-params
+      wrap-json-response
+      wrap-session))
+
+(def wrapped-open-routes
+  (-> open-routes
+      wrap-anti-forgery
+      wrap-models
+      wrap-integer-id-params
+      (wrap-resource "public")
+      wrap-content-type
+      wrap-exception-handling
+      wrap-params
+      wrap-keyword-params
+      wrap-session))
+
+(defroutes app
   (friend/logout (POST "/logout" [] (redirect "/")))
-  (-> protected-routes
-      (friend/wrap-authorize #{:user})
-      wrap-anti-forgery)
-  (friend/wrap-authorize api-routes #{:user})
+  wrapped-protected-routes
+  wrapped-api-routes
+  wrapped-open-routes
   (ANY "*" req
        (do
          (log/debug "unable to match route for " (:uri req))
          (render-404 req))))

-(def app
-  (-> routes
-      (friend/authenticate
-        {:workflows [(workflows/interactive-form)]
-         :credential-fn (partial clj-money.models.users/authenticate (env :db))
-         :redirect-on-auth? false})
-      (wrap-resource "public")
-      wrap-content-type
-      wrap-exception-handling
-      wrap-params
-      wrap-multipart-params
-      wrap-json-params
-      wrap-keyword-params
-      wrap-json-response
-      wrap-session))
-
 (defn -main [& [port]]
   (let [port (Integer. (or port (env :port) 5000))]
     (jetty/run-jetty (site #'app) {:port port :join? false})))


Added the ability to spend multiple credits at once to remove multiple counters from cards hosted on personal workshop

--- src/clj/game/cards-resources.clj
+++ src/clj/game/cards-resources.clj
@@ -470,7 +470,25 @@
                                   (host state side card (assoc target :counter (:cost target)))))
                    :msg (msg "host " (:title target) "")}
                   (assoc remove-counter
-                         :label "Remove 1 counter from a hosted card" :cost [:credit 1])]
+                         :label "Remove 1 counter from a hosted card" :cost [:credit 1])
+                  {:label "X[Credit]:Remove counters from a hosted card" :choices {:req #(:host %)}
+                   :req (req (not (empty? (:hosted card))))
+                   :effect (req (let [paydowntarget target]
+                                  (resolve-ability
+                                    state side
+                                    {:prompt "How many counters to remove?"
+                                     :choices {:number (req (min (:credit runner) (:counter paydowntarget)))}
+                                     :msg (msg "remove " target " counters from " (:title paydowntarget))
+                                     :effect (req (do
+                                                    (lose state side :credit target)
+                                                    (if (= (:counter paydowntarget) target)
+                                                      (runner-install state side (dissoc paydowntarget :counter) {:no-cost true})
+                                                      (add-prop state side paydowntarget :counter (- target)))))}
+                                    card nil
+                                  )
+                                  ))
+                   }
+                  ]
       :events {:runner-turn-begins remove-counter}})

    "Power Tap"


Refactors installing functions. Adds `:in-play` functionality to cards.

--- src/clj/game/core-installing.clj
+++ src/clj/game/core-installing.clj
@@ -1,49 +1,74 @@
 (in-ns 'game.core)

-(declare host in-play? make-rid rez run-flag? server-list server->zone set-prop system-msg turn-flag?
-         update-breaker-strength update-ice-strength update-run-ice)
-
-; Functions for the installation and deactivation of cards.
+(declare host in-play? make-rid rez run-flag? server-list server->zone set-prop system-msg
+         turn-flag? update-breaker-strength update-ice-strength update-run-ice)
+
+;;;; Functions for the installation and deactivation of cards.
+
+;;; Deactivate a card
+(defn- dissoc-card
+  "Dissoc relevant keys in card"
+  [card keep-counter]
+  (let [c (dissoc card :current-strength :abilities :rezzed :special :added-virus-counter)
+        c (if keep-counter c (dissoc c :counter :rec-counter :advance-counter))]
+    (if (and (= (:side c) "Runner") (not= (last (:zone c)) :facedown))
+      (dissoc c :installed :facedown :counter :rec-counter :pump :named-target) c)))
+
+(defn- trigger-leave-effect
+  "Triggers leave effects for specified card if relevant"
+  [state side card]
+  (when-let [leave-effect (:leave-play (card-def card))]
+    (when (or (and (= (:side card) "Runner") (:installed card) (not (:facedown card)))
+              (:rezzed card)
+              (= (first (:zone card)) :current)
+              (= (first (:zone card)) :scored))
+      (leave-effect state side card nil))))
+
+(defn- handle-prevent-effect
+  "Handles prevent effects on the card"
+  [state card]
+  (when-let [prevent (:prevent (card-def card))]
+     (doseq [[ptype pvec] prevent]
+       (doseq [psub pvec]
+         (swap! state update-in [:prevent ptype psub]
+                (fn [pv] (remove #(= (:cid %) (:cid card)) pv)))))))

 (defn deactivate
   "Deactivates a card, unregistering its events, removing certain attribute keys, and triggering
   some events."
   ([state side card] (deactivate state side card nil))
   ([state side card keep-counter]
-   (let [c (dissoc card :current-strength :abilities :rezzed :special :added-virus-counter)
-         c (if (and (= (:side c) "Runner") (not= (last (:zone c)) :facedown))
-             (dissoc c :installed :facedown :counter :rec-counter :pump :named-target) c)
-         c (if keep-counter c (dissoc c :counter :rec-counter :advance-counter))]
-     (when-let [leave-effect (:leave-play (card-def card))]
-       (when (or (and (= (:side card) "Runner") (:installed card) (not (:facedown card)))
-                 (:rezzed card)
-                 (= (first (:zone card)) :current)
-                 (= (first (:zone card)) :scored))
-         (leave-effect state side card nil)))
-     (when-let [prevent (:prevent (card-def card))]
-       (doseq [[ptype pvec] prevent]
-         (doseq [psub pvec]
-           (swap! state update-in [:prevent ptype psub] (fn [pv] (remove #(= (:cid %) (:cid card)) pv))))))
-     (unregister-events state side card)
-     (when (and (:memoryunits card) (:installed card) (not (:facedown card)))
-       (gain state :runner :memory (:memoryunits card)))
-     c)))
+   (trigger-leave-effect state side card)
+   (handle-prevent-effect state card)
+   (unregister-events state side card)
+   (when (and (:memoryunits card) (:installed card) (not (:facedown card)))
+     (gain state :runner :memory (:memoryunits card)))
+   (when-let [in-play (:in-play (card-def card))]
+     (apply lose state side in-play))
+   (dissoc-card card keep-counter)))
+
+
+;;; Initialising a card
+(defn- ability-init
+  "Gets abilities associated with the card"
+  [cdef]
+  (let [make-label #(or (:label %) (and (string? (:msg %)) (capitalize (:msg %))) "")
+        abilities (if (:recurring cdef)
+                    (conj (:abilities cdef) {:msg "Take 1 [Recurring Credits]"})
+                    (:abilities cdef))]
+    (for [ab abilities]
+      (assoc (select-keys ab [:cost :pump :breaks]) :label (make-label ab)))))

 (defn card-init
   "Initializes the abilities and events of the given card."
   ([state side card] (card-init state side card true))
   ([state side card resolve]
    (let [cdef (card-def card)
-         abilities (if (:recurring cdef)
-                     (conj (:abilities cdef) {:msg "Take 1 [Recurring Credits]"})
-                     (:abilities cdef))
-         abilities (for [ab abilities]
-                     (assoc (select-keys ab [:cost :pump :breaks])
-                       :label (or (:label ab) (and (string? (:msg ab)) (capitalize (:msg ab))) "")))
+         recurring (:recurring cdef)
+         abilities (ability-init cdef)
          c (merge card (:data cdef) {:abilities abilities})
-         c (if-let [r (:recurring cdef)]
-             (if (number? r) (assoc c :rec-counter r) c) c)]
-     (when-let [recurring (:recurring cdef)]
+         c (if (number? recurring) (assoc c :rec-counter recurring) c)]
+     (when recurring
        (let [r (if (number? recurring)
                  (effect (set-prop card :rec-counter recurring))
                  recurring)]
@@ -59,7 +84,36 @@
        (register-events state side events c))
      (when resolve
        (resolve-ability state side cdef c nil))
+     (when-let [in-play (:in-play cdef)]
+       (apply gain state side in-play))
      (get-card state c))))
+
+
+;;; Intalling a corp card
+(defn- corp-can-install?
+  "Checks region restrictions"
+  [card dest-zone]
+  (not (and (has-subtype? card "Region")
+            (some #(has-subtype? % "Region") dest-zone))))
+
+(defn- corp-install-asset-agenda
+  "Takes care of installing an asset or agenda in a server"
+  [state side card dest-zone]
+  (when (#{"Asset" "Agenda"} (:type card))
+    (when-let [prev-card (some #(when (#{"Asset" "Agenda"} (:type %)) %) dest-zone)]
+      (system-msg state side (str "trashes " (card-str state prev-card)))
+      (trash state side prev-card {:keep-server-alive true}))))
+
+(defn- corp-install-message
+  "Prints the correct install message."
+  [state side card server install-state cost-str]
+  (let [card-name (if (or (= :rezzed-no-cost install-state)
+                          (= :face-up install-state)
+                          (:rezzed card))
+                    (:title card)
+                    (if (ice? card) "ICE" "a card"))]
+    (system-msg state side (str (build-spend-msg cost-str "install") card-name
+                                (if (ice? card) " protecting " " in ") server))))

 (defn corp-install
   ([state side card server] (corp-install state side card server nil))
@@ -78,20 +132,10 @@
                install-cost (if (and (ice? c) (not no-install-cost))
                               (count dest-zone) 0)
                install-state (or install-state (:install-state cdef))]
-           (when (not (and (has-subtype? c "Region")
-                           (some #(has-subtype? % "Region") dest-zone)))
+           (when (corp-can-install? card dest-zone)
              (when-let [cost-str (pay state side card extra-cost :credit install-cost)]
-               (when (#{"Asset" "Agenda"} (:type c))
-                 (when-let [prev-card (some #(when (#{"Asset" "Agenda"} (:type %)) %) dest-zone)]
-                   (system-msg state side (str "trashes " (card-str state prev-card)))
-                   (trash state side prev-card {:keep-server-alive true})))
-               (let [card-name (if (or (= :rezzed-no-cost install-state)
-                                       (= :face-up install-state)
-                                       (:rezzed c))
-                                 (:title card)
-                                 (if (ice? c) "ICE" "a card"))]
-                 (system-msg state side (str (build-spend-msg cost-str "install")
-                                             card-name (if (ice? c) " protecting " " in ") server)))
+               (corp-install-asset-agenda state side c dest-zone)
+               (corp-install-message state side c server install-state cost-str)
                (let [moved-card (move state side c slot)]
                  (trigger-event state side :corp-install moved-card)
                  (when (is-type? c "Agenda")
@@ -106,45 +150,74 @@
                  (when-let [dre (:derezzed-events cdef)]
                    (register-events state side dre moved-card))))))))))

+
+;;; Installing a runner card
+(defn- runner-can-install?
+  "Checks if the specified card can be installed.
+  Uses uniqueness of card"
+  [state side {:keys [uniqueness] :as card} facedown]
+  (and (or (not uniqueness) (not (in-play? state card)) facedown) ; checks uniqueness
+       (if-let [req (:req (card-def card))]
+         (or facedown (req state side card nil)) ; checks req for install
+         true)))
+
+(defn- runner-get-cost
+  "Get the total install cost for specified card"
+  [state side {:keys [cost memoryunits] :as card}
+   {:keys [extra-cost no-cost facedown] :as params}]
+  (install-cost state side card
+                (concat extra-cost
+                        (when (and (not no-cost) (not facedown)) [:credit cost])
+                        (when (and memoryunits (not facedown)) [:memory memoryunits]))))
+
+(defn- runner-install-message
+  "Prints the correct msg for the card install"
+  [state side card-title cost-str
+   {:keys [no-cost host-card facedown custom-message] :as params}]
+  (if facedown
+    (system-msg state side "installs a card facedown")
+    (if custom-message
+      (system-msg state side custom-message)
+      (system-msg state side
+                  (str (build-spend-msg cost-str "install") card-title
+                       (when host-card (str " on " (:title host-card)))
+                       (when no-cost " at no cost"))))))
+
+(defn- handle-virus-counter-flag
+  "Deal with setting the added-virus-counter flag"
+  [state side installed-card]
+  (if (and (has-subtype? installed-card "Virus")
+           (pos? (:counter installed-card 0)))
+    (update! state side (assoc installed-card :added-virus-counter true))))
+
 (defn runner-install
+  "Installs specified runner card if able
+  Params include extra-cost, no-cost, host-card, facedown and custom-message."
   ([state side card] (runner-install state side card nil))
-  ([state side {:keys [title type cost memoryunits uniqueness ] :as card}
-    {:keys [extra-cost no-cost host-card facedown custom-message] :as params}]
-   (when (not (seq (get-in @state [side :locked (-> card :zone first)])))
+  ([state side card
+    {:keys [host-card facedown] :as params}]
+   (when (empty? (get-in @state [side :locked (-> card :zone first)]))
      (if-let [hosting (and (not host-card) (not facedown) (:hosting (card-def card)))]
        (resolve-ability state side
                         {:choices hosting
-                         :effect (effect (runner-install card (assoc params :host-card target)))} card nil)
-       (do
-         (trigger-event state side :pre-install card)
-         (let [cost (install-cost state side card
-                                  (concat extra-cost (when (and (not no-cost) (not facedown)) [:credit cost])
-                                          (when (and memoryunits (not facedown)) [:memory memoryunits])))]
-           (when (and (or (not uniqueness) (not (in-play? state card)) facedown)
-                      (if-let [req (:req (card-def card))]
-                        (or facedown (req state side card nil)) true))
-             (when-let [cost-str (pay state side card cost)]
-               (let [c (if host-card
-                         (host state side host-card card)
-                         (move state side card [:rig (if facedown :facedown (to-keyword type))]))
-                     installed-card (if facedown
-                                      (update! state side (assoc c :installed true))
-                                      (card-init state side (assoc c :installed true) true))]
-                 (if facedown
-                   (system-msg state side "installs a card facedown")
-                   (if custom-message
-                     (system-msg state side custom-message)
-                     (system-msg state side (str (build-spend-msg cost-str "install") title
-                                                 (when host-card (str " on " (:title host-card)))
-                                                 (when no-cost " at no cost")))))
-                 ;Apply added-virus-counter flag for this turn if the card enters play with a counter
-                 (if (and (contains? installed-card :counter)
-                          (contains? installed-card :subtype)
-                          (has-subtype? card "Virus")
-                          (pos? (:counter installed-card)))
-                   (update! state side (assoc installed-card :added-virus-counter true)))
-                 (trigger-event state side :runner-install installed-card)
-                 (when (has-subtype? c "Icebreaker") (update-breaker-strength state side c))))))
-         (when (is-type? card "Resource")
-           (swap! state assoc-in [:runner :register :installed-resource] true))
-         (swap! state update-in [:bonus] dissoc :install-cost))))))
+                         :effect (effect (runner-install card (assoc params :host-card target)))}
+                        card nil)
+       (do (trigger-event state side :pre-install card)
+           (let [cost (runner-get-cost state side card params)]
+             (when (runner-can-install? state side card facedown)
+               (when-let [cost-str (pay state side card cost)]
+                 (let [c (if host-card
+                           (host state side host-card card)
+                           (move state side card
+                                 [:rig (if facedown :facedown (to-keyword (:type card)))]))
+                       installed-card (if facedown
+                                        (update! state side (assoc c :installed true))
+                                        (card-init state side (assoc c :installed true) true))]
+                   (runner-install-message state side (:title card) cost-str params)
+                   (handle-virus-counter-flag state side installed-card)
+                   (trigger-event state side :runner-install installed-card)
+                   (when (has-subtype? c "Icebreaker")
+                     (update-breaker-strength state side c))))))
+           (when (is-type? card "Resource")
+             (swap! state assoc-in [:runner :register :installed-resource] true))
+           (swap! state update-in [:bonus] dissoc :install-cost))))))


Minor spec refering bug fixed in components ns

--- src/clj/hellhound/components.clj
+++ src/clj/hellhound/components.clj
@@ -6,14 +6,13 @@
   you need to look into `hellhound.components.websocket`"
   (:require
    [clojure.spec.alpha            :as spec]
-   [hellhound.components.core     :as core]))
+   [hellhound.components.specs    :as comp-specs]))

 (defn- merge-into
-  [coll keyname value]
+  [coll keyname key-spec value]
   (if (empty? value)
     coll
-    (merge coll{keyname (spec/conform
-                         (keyword "core/" (name keyname))
+    (merge coll{keyname (spec/conform key-spec
                          value)})))
 (defn create-component
   "Creates a component map with the given `instance` and `requirements`
@@ -25,6 +24,6 @@
    (create-component instance requirements []))

   ([instance requirements inputs]
-   (-> {:instance (spec/conform ::core/instance instance)}
-       (merge-into :requires (or requirements []))
-       (merge-into :inputs   (or inputs [])))))
+   (-> {:instance (spec/conform ::comp-specs/instance instance)}
+       (merge-into :requires ::comp-specs/requires (or requirements []))
+       (merge-into :inputs   ::comp-specs/inputs (or inputs [])))))


Improve hyphenation validation

Improve hyphenation validation

a hyphenation is only valid if it contains the same chars as the word
itself optionally interposed with hyphen chars

--- src/cljs/hyphen_keeper/core.cljs
+++ src/cljs/hyphen_keeper/core.cljs
@@ -75,10 +75,14 @@
    [:td word]
    [:td hyphenation]])

-(defn- hyphenation-valid? [s]
-  (and (not (string/blank? s))
-       (string/includes? s "-")
-       (re-matches #"[a-z\xDF-\xFF-]+" s)))
+(defn- hyphenation-valid?
+  "Return true if the `hyphenation` is not blank, is equal to
+  `word` (modulo the hyphenation marks) and only contains letters a-z,
+  \u00DF-\u00FF and '-'"
+  [hyphenation word]
+  (and (not (string/blank? hyphenation))
+       (= word (string/replace hyphenation "-" ""))
+       (re-matches #"[a-z\xDF-\xFF-]+" hyphenation)))

 (defn- hyphenation-pattern-readonly-ui
   [word hyphenation start remove]
@@ -96,25 +100,31 @@

 (defn- hyphenation-pattern-edit-ui
   [word new-hyphenation stop save]
-  [:tr
-   [:td word]
-   [:td
-    [:input.form-control
-     {:type "text"
-      :auto-focus true
-      :on-change #(reset! new-hyphenation (-> % .-target .-value))
-      :on-key-down #(case (.-which %)
-                      27 (stop)
-                      nil)
-      :value @new-hyphenation}]]
-   [:td
-    [:div.btn-group
-     [:button.btn.btn-default
-      {:on-click save}
-      [:span.glyphicon.glyphicon-ok {:aria-hidden true}] " Save"]
-     [:button.btn.btn-default
-      {:on-click stop}
-      [:span.glyphicon.glyphicon-remove {:aria-hidden true}] " Cancel"]]]])
+  (let [valid? (hyphenation-valid? @new-hyphenation word)
+        klass (if valid? "form-group" "form-group has-error")]
+    [:tr
+     [:td word]
+     [:td
+      [:div
+       {:class klass}
+       [:input.form-control
+        {:type "text"
+         :auto-focus true
+         :on-change #(reset! new-hyphenation (-> % .-target .-value))
+         :on-key-down #(case (.-which %)
+                         27 (stop)
+                         nil)
+         :value @new-hyphenation}]
+       (when-not valid?
+         [:span.sr-only "(error)"])]]
+     [:td
+      [:div.btn-group
+       [:button.btn.btn-default
+        {:on-click save}
+        [:span.glyphicon.glyphicon-ok {:aria-hidden true}] " Save"]
+       [:button.btn.btn-default
+        {:on-click stop}
+        [:span.glyphicon.glyphicon-remove {:aria-hidden true}] " Cancel"]]]]))

 (defn hyphenation-pattern-item-ui [{:keys [hyphenation] :as pattern}]
   (let [editing (reagent/atom false)
@@ -123,7 +133,7 @@
       (let [stop #(do (reset! new-hyphenation hyphenation)
                       (reset! editing false))
             start #(reset! editing true)
-            save #(do (when (hyphenation-valid? @new-hyphenation)
+            save #(do (when (hyphenation-valid? @new-hyphenation word)
                         (add-hyphenation-pattern! (assoc pattern :hyphenation @new-hyphenation)))
                       (reset! editing false))
             remove #(remove-hyphenation-pattern! pattern)]
@@ -147,8 +157,7 @@

 (defn hyphenation-ui []
   (let [label "Corrected Hyphenation"
-        valid? (or (string/blank? @hyphenation) (hyphenation-valid? @hyphenation))
-        klass (if valid? "form-group" "form-group has-error")]
+        klass (if (hyphenation-valid? @hyphenation @word) "form-group" "form-group has-error")]
     [:div
      {:class klass}
      [:label {:for "hyphenationInput"} label]
@@ -161,10 +170,11 @@
 (defn- hyphenation-add-ui []
   [:div.form-group
    [:button.btn.btn-default
-    {:on-click #(when (and @word (hyphenation-valid? @hyphenation))
+    {:on-click #(when (and (not (string/blank? @word))
+                           (hyphenation-valid? @hyphenation @word))
                   (add-hyphenation-pattern! {:word @word :hyphenation @hyphenation :spelling @spelling}))
      :disabled (when (or (string/blank? @word)
-                         (not (hyphenation-valid? @hyphenation))
+                         (not (hyphenation-valid? @hyphenation @word))
                          (= @hyphenation @suggested-hyphenation))
                  "disabled")}
     "Add"]])


Bug fix: We need a variable sized threadpool for our watcher threads (#1283)

--- scheduler/src/cook/kubernetes/api.clj
+++ scheduler/src/cook/kubernetes/api.clj
@@ -22,7 +22,7 @@

 (def cook-pod-label "twosigma.com/cook-scheduler-job")

-(def ^ExecutorService kubernetes-executor (Executors/newFixedThreadPool 2))
+(def ^ExecutorService kubernetes-executor (Executors/newCachedThreadPool))

 ; Cook, Fenzo, and Mesos use MB for memory. Convert bytes from k8s to MB when passing to fenzo, and MB back to bytes
 ; when submitting to k8s.


Debug client [skip ci]

Debug client [skip ci]

--- backend/src/akvo/lumen/lib/transformation.clj
+++ backend/src/akvo/lumen/lib/transformation.clj
@@ -45,6 +45,7 @@

 (defn- execute-tx [{:keys [tenant-conn] :as deps} job-execution-id dataset-id command]
   (future
+    (Thread/sleep 5000)
     (try
       (jdbc/with-db-transaction [tx-conn tenant-conn]
         (let [tx-deps (assoc deps :tenant-conn tx-conn)]


Test a sample query

Test a sample query

--- test/desdemona/query_test.clj
+++ test/desdemona/query_test.clj
@@ -69,7 +69,42 @@
       '(and (= (:type x) "egress")
             (= (:ip x) "10.0.0.2"))
       [[{:ip "10.0.0.2"
-         :type "egress"}]])))
+         :type "egress"}]]))
+  (testing "disjunction"
+    (are [query results] (= results (q/run-dsl-query 10 query events))
+      '(or (= (:ip x) "1.2.3.4")
+           (= (:type x) "bogus"))
+      []
+
+      '(or (= (:ip x) "10.0.0.1")
+           (= (:type x) "egress"))
+      [[{:ip "10.0.0.1"}]
+       [{:ip "10.0.0.2"
+         :type "egress"}]]
+
+      '(or (= (:ip x) "10.0.0.1")
+           (= (:type x) "ingress"))
+      [[{:ip "10.0.0.1"}]
+       [{:ip "10.0.0.2"
+         :type "ingress"}]]
+
+      '(or (= (:ip x) "10.0.0.2")
+           (= (:type x) "egress"))
+      [[{:ip "10.0.0.2"    ;; ip clause succeeded
+         :type "egress"}]
+       [{:ip "10.0.0.2"    ;; type clause succeeded
+         :type "egress"}]
+       [{:ip "10.0.0.2"    ;; ip clause succeeded
+         :type "ingress"}]]
+
+      '(or (= (:type x) "egress")
+           (= (:ip x) "10.0.0.2"))
+      [[{:ip "10.0.0.2"    ;; type clause succeeded
+         :type "egress"}]
+       [{:ip "10.0.0.2"    ;; ip clause succeeded
+         :type "egress"}]
+       [{:ip "10.0.0.2"    ;; ip clause succeeded
+         :type "ingress"}]])))

 (deftest logic-query-tests
   (are [query results] (= results (#'q/run-logic-query query events))


flat-* has to return a java.util.Iterator now uugghhh

--- test/flambo/example/tfidf.clj
+++ test/flambo/example/tfidf.clj
@@ -19,8 +19,8 @@
                       (clojure.string/split content #" "))
         doc-terms-count (count terms)
         term-frequencies (frequencies terms)]
-    (map (fn [term] (ft/tuple doc-id [term (term-frequencies term) doc-terms-count]))
-         (distinct terms))))
+    (.iterator (map (fn [term] (ft/tuple doc-id [term (term-frequencies term) doc-terms-count]))
+                    (distinct terms)))))

 (defn calc-idf [doc-count]
   (f/fn [term tuple-seq]
@@ -56,7 +56,7 @@
           ;; where tf is per document, that is, tf(term, document)
           tf-by-doc (-> doc-term-seq
                         (f/map-to-pair (ft/key-val-fn (f/fn [doc-id [term term-freq doc-terms-count]]
-                                                      (ft/tuple term [doc-id (double (/ term-freq doc-terms-count))]))))
+                                                        (ft/tuple term [doc-id (double (/ term-freq doc-terms-count))]))))
                         (inspect "tf-by-doc")
                         f/cache)


0.10.0

--- metrics-clojure-core/project.clj
+++ metrics-clojure-core/project.clj
@@ -1,4 +1,4 @@
-(defproject metrics-clojure "0.10.0-SNAPSHOT"
+(defproject metrics-clojure "0.10.0"
   :description "A Clojure façade for Coda Hale's metrics library."
   :dependencies [[org.clojure/clojure             "1.5.1"]
                  [com.yammer.metrics/metrics-core "2.2.0"]]


WIP commit, trying to get letfn* lifting working

--- src/oxcart/passes/lambda_lift.clj
+++ src/oxcart/passes/lambda_lift.clj
@@ -15,19 +15,9 @@
   (:require [oxcart.util :as util]
             [oxcart.pattern :as pattern]
             [clojure.tools.analyzer.ast :as ast]
-            [clojure.tools.analyzer.passes.collect
+            [clojure.tools.analyzer.passes.collect
              :refer [collect-closed-overs]]
             [clojure.set :refer [union]]))
-
-
-(defn fn->name-or-gensym
-  "λ AST → (Option Symbol)
-
-  If the argument AST is a fn, attempts to return the internal name of
-  the fn defaulting to a freshly generated symbol."
-  [ast]
-  (when (pattern/fn? ast)
-    (-> ast :internal-name)))

 (defn take-when
@@ -56,6 +46,13 @@
                   ~@body)))))

+(defn rewrite-locals-to-vars
+  [mapping ast]
+  (if (pattern/local? ast)
+    (get mapping (pattern/binding->symbol ast) ast)
+    ast))
+
+
 (defn lift-fns
   [defs-atom ast]
   (cond (and (pattern/fn? ast)
@@ -64,10 +61,10 @@
         ;; partial expression in its place

         (let [used-locals  (map :form (vals (:closed-overs ast)))
-              sym          (fn->name-or-gensym ast)
+              sym          (pattern/fn->name ast)
               def-form     `(def ~(symbol sym)
                                  ~(-> (:form ast)
-                                      (fn*->cannonical-fn*)
+                                      fn*->cannonical-fn*
                                       (rewrite-fn* used-locals)))
               partial-form `(partial ~(symbol sym) ~@used-locals)
               def-ast      (util/ast def-form     (:env ast))
@@ -80,8 +77,57 @@
           partial-ast)

-        ;; FIXME:
-        ;;    support letfn
+        (pattern/letfn? ast)
+        ;; letfns are weird and hard because they need to be rewritten
+        ;; into lets and a declare form. The fns are already correctly
+        ;; promoted to defs and replaced with partials, so if the
+        ;; naming of lifted letfn fns can be resolved it will be
+        ;; correct to simply rewrite letfn forms to lets with partials
+        ;; as the partials are ording insensitive.
+        ;;
+        ;; 1. Create a mapping from letfn bound fn names to the
+        ;;    internal (de-aliased) fn names.
+        ;;
+        ;; 2. Create a (declare <fns>) in the defs atom.
+        ;;
+        ;; 3. For each fn in the letfn rewrite the letfn bodies using
+        ;;    the mapping from 1 and emit lifted defs as would be
+        ;;    normal for lambda lifting.
+        ;;
+        ;; 4. Replace the letfn* with a simple let* that binds the
+        ;;    partials appropriately so that I don't have to rewrite
+        ;;    all the locals of the body expression.
+
+        (let [bindings     (:bindings ast)
+              locals->vars (transient {})]
+
+          ;; create the forward defs
+          (doseq [b bindings]
+            (let [sym (-> b
+                          pattern/binding->value
+                          pattern/fn->name
+                          symbol)
+                  {:keys [statements ret]} (util/ast `(do (def ~sym)
+                                                    ~sym))
+                  def-ast (first statements)]
+
+              ;; save the def ast
+              (swap! defs-atom conj def-ast)
+
+              ;; save the var ast
+              (assoc! locals->vars (pattern/binding->symbol b) ret)))
+
+          (-> ast
+              (assoc :bindings (mapv #(ast/prewalk %1
+                                        (partial rewrite-locals-to-vars
+                                                 locals->vars))
+                                     bindings))
+
+              (collect-closed-overs {:what #{:closed-overs} :where #{:fn}})
+
+              ;; force to a let form
+              (assoc :op :let)))
+

         true
         ;; This operation is a noop. Note that we do not need to


Constant propagation is a separate transform

--- src/oxcart/passes/lambda_lift.clj
+++ src/oxcart/passes/lambda_lift.clj
@@ -115,17 +115,6 @@

           ;; and yield the partial form
           partial-ast)
-
-
-        (pattern/local? ast)
-        ;; determine whether the value is a lifted lambda, (meaning
-        ;; that it's binding value is not nil)
-        (let [bindings @bindings-atom
-              sym      (pattern/local->symbol ast)
-              value    (b/get-value bindings sym)]
-          (if (nil? value)
-            ast
-            value))

         (pattern/binding? ast)


Update tests to be compatible with new Precipce Eventual

--- test/beehive/service_test.clj
+++ test/beehive/service_test.clj
@@ -18,7 +18,8 @@
             [beehive.service :as service]
             [beehive.future :as f])
   (:import (java.io IOException)
-           (java.util.concurrent CountDownLatch ExecutionException)))
+           (java.util.concurrent CountDownLatch ExecutionException)
+           (net.uncontended.precipice.timeout ActionTimeoutException)))

 (set! *warn-on-reflection* true)

@@ -80,8 +81,7 @@
   (testing "Submitted action can timeout"
     (let [latch (CountDownLatch. 1)
           f (service/submit-action service (block-fn 1 latch) 50)]
-      ;; TODO: Should change when precipice changes.
-      (is (nil? @f))
+      (f/await f)
       (is (:timeout? f))
       (is (not (:success? f)))
       (is (not (:error? f)))
@@ -89,7 +89,12 @@
       (is (= :timeout (:status f)))
       (.countDown latch)
       (is (nil? (:result f)))
-      (is (nil? (:error f)))))
+      (is (nil? (:error f)))
+      (try
+        @f
+        (is false)
+        (catch ExecutionException e
+          (is (instance? ActionTimeoutException (.getCause e)))))))
   (testing "If concurrency level exhausted, action rejected"
     (let [latch (CountDownLatch. 1)
           _ (service/submit-action service (block-fn 1 latch) Long/MAX_VALUE)


1st practice using instaparse

1st practice using instaparse

--- src/instaparse_practice/core.clj
+++ src/instaparse_practice/core.clj
@@ -1,6 +1,31 @@
-(ns instaparse-practice.core)
+(ns instaparse-practice.core
+  (:require [instaparse.core :as insta]))

-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))
+(def md-parser
+  (insta/parser
+   "doc             := {section | para}
+    section         := heading para
+    blank-line      := <WP* NL>
+    <heading>       := h1 | h2
+    <heading-title> := para
+    h1              := <'#'> <WP*> para <['#']>
+    h2              := <'#'> h1 <['#']>
+    para            := (letter | blank-line | WP)+
+
+    <letter>   := #'[a-zA-Z0-9]'
+    <WP>       := #'\\s'
+    <NL>       := ['\\r'] '\\n'
+    "))
+
+(def test-parser
+  (insta/parser
+   "doc        := para
+    para       := letter+
+
+    <letter>   := #'[a-zA-Z0-9]'
+    <WP>       := #'\\s'
+    <NL>       := ['\\r'] '\\n'
+    "))
+
+(md-parser "# abc \nabc\n \nab")
+(test-parser "test")