Refactored asset url strings to a kw-str map.

--- src/cljs/smarthome/core.cljs
+++ src/cljs/smarthome/core.cljs
@@ -52,21 +52,49 @@

 (def state (atom initial-state))

-(def dish-on false)
+(def dish-on true)
 (def oven-on true)
 (def stove-on true)
 (def tv-on true)
-(def radio-on false)
+(def radio-on true)
 (def wash-on true)
 (def car-in true)
-(def bath-door-open false)
-(def bed-door-open false)
+(def bath-door-open true)
+(def bed-door-open true)
 (def front-door-open false)
 (def livingroom-lights-off false)
-(def bathroom-lights-off true)
-(def bedroom-lights-off true)
+(def bathroom-lights-off false)
+(def bedroom-lights-off false)
 (def garage-lights-off false)
-(def garage-door-closed false)
+(def garage-door-closed true)
+
+(def imgs {:living-nw "../assets/livingroom-nw.jpg"
+           :living-ne "../assets/livingroom-ne.jpg"
+           :living-sw "../assets/livingroom-sw.jpg"
+           :living-se "../assets/livingroom-se.jpg"
+           :kitchen "../assets/kitchen.jpg"
+           :bathroom "../assets/bathroom.jpg"
+           :garage "../assets/garage.jpg"
+           :hall "../assets/hall.jpg"
+           :bedroom "../assets/bedroom.jpg"
+           :fridge "../assets/fridge.jpg"
+           :dish-on "../assets/dish-on.jpg"
+           :dish-off "../assets/dish-off.jpg"
+           :oven-on "../assets/oven-on.jpg"
+           :oven-off "../assets/oven-off.jpg"
+           :stove-on "../assets/stove-on.jpg"
+           :stove-off "../assets/stove-off.jpg"
+           :tv-on "../assets/tv-on.jpg"
+           :tv-off "../assets/tv-off.jpg"
+           :radio-on "../assets/radio-on.jpg"
+           :radio-off "../assets/radio-off.jpg"
+           :door "../assets/door.jpg"
+           :laundry "../assets/laundry.jpg"
+           :wash-on "../assets/wash-on.jpg"
+           :car "../assets/car.jpg"
+           :garage-port "../assets/garageport.jpg"
+           :frontdoor-closed "../assets/front-door-closed.jpg"
+           :frontdoor-open "../assets/front-door-open.jpg"})

 ;; -------------------------
 (defn home-page []
@@ -74,53 +102,54 @@
    [:div.line
     ; LIVINGROOM-NW
     [:div {:className (str "room" (when livingroom-lights-off " dark"))}
-     [:img.room-image {:src "../assets/livingroom-nw.jpg"}]]
+     [:img.room-image {:src (:living-nw imgs)}]]
     ; LIVINGROOM-NE
     [:div {:className (str "room" (when livingroom-lights-off " dark"))}
-     [:img.room-image {:src "../assets/livingroom-ne.jpg"}]]
+     [:img.room-image {:src (:living-ne imgs)}]]
     ; KITCHEN
     [:div {:className (str "room" (when livingroom-lights-off " dark"))}
-     [:img.room-image {:src "../assets/kitchen.jpg"}]
-     [:img.fridge {:src "../assets/fridge.jpg"}]
-     (if dish-on [:img.dish {:src "../assets/dish-on.jpg"}]
-                 [:img.dish {:src "../assets/dish-off.jpg"}])
-     [:img.oven {:src "../assets/oven-off.jpg"}]
-     [:img.stove {:src "../assets/stove-off.jpg"}]]]
+     [:img.room-image {:src (:kitchen imgs)}]
+     [:img.fridge {:src (:fridge imgs)}]
+     (if dish-on [:img.dish {:src (:dish-on imgs)}]
+                 [:img.dish {:src (:dish-off imgs)}])
+     [:img.oven {:src (:oven-off imgs)}]
+     [:img.stove {:src (:stove-off imgs)}]]]
    [:div.line
     ; LIVINGROOM-SW
     [:div {:className (str "room" (when livingroom-lights-off " dark"))}
-     [:img.room-image {:src "../assets/livingroom-sw.jpg"}]
-     [:img.tv {:src "../assets/tv-on.jpg"}]]
+     [:img.room-image {:src (:living-sw imgs)}]
+     [:img.tv {:src (:tv-on imgs)}]]
     ; LIVINGROOM-SE
     [:div {:className (str "room" (when livingroom-lights-off " dark"))}
-     [:img.room-image {:src "../assets/livingroom-se.jpg"}]
-     (if radio-on [:img.radio-off {:src "../assets/radio-off.jpg"}]
-                  [:img.radio-on {:src "../assets/radio-on.jpg"}])]
+     [:img.room-image {:src (:living-se imgs)}]
+     (if radio-on [:img.radio-on {:src (:radio-on imgs)}]
+                  [:img.radio-off {:src (:radio-off imgs)}])]
     ; BATHROOM
     [:div {:className (str "room" (cond (and bath-door-open bathroom-lights-off) " dim"
                                         bathroom-lights-off " dark"))}
-     [:img.room-image {:src "../assets/bathroom.jpg"}]
+     [:img.room-image {:src (:bathroom imgs)}]
      [:img {:className (str "bathroom-door" (if bath-door-open "-open" "-closed"))
-            :src "../assets/door.jpg"}]
-     [:img.laundry {:src "../assets/laundry.jpg"}]
-     [:img.wash {:src "../assets/wash-on.jpg"}]]]
+            :src (:door imgs)}]
+     [:img.laundry {:src (:laundry imgs)}]
+     [:img.wash {:src (:wash-on imgs)}]]]
    [:div.line
     ; GARAGE
     [:div {:className (str "room" (when garage-lights-off " dark"))}
-     [:img.room-image {:src "../assets/garage.jpg"}]
-     (when car-in [:img.car {:src "../assets/car.jpg"}])
-     (when garage-door-closed [:img {:className "garage-port" :src "../assets/garageport.jpg"}])]
-    ; HALL
-    [:div {:className (str "room" (when livingroom-lights-off " dark"))}
-     [:img.room-image {:src "../assets/hall.jpg"}]
-     (if front-door-open [:img.front-door {:src "../assets/front-door-closed.jpg"}]
-                         [:img.front-door {:src "../assets/front-door-open.jpg"}])]
+     [:img.room-image {:src (:garage imgs)}]
+     (when car-in [:img.car {:src (:car imgs)}])
+     (when garage-door-closed [:img {:className "garage-port" :src (:garage-port imgs)}])]
+     ; HALL
+    [:div {:className (str "room" (when livingroom-lights-off " dark"))}
+     [:img.room-image {:src (:hall imgs)}]
+     (if front-door-open [:img.front-door {:src (:frontdoor-open imgs)}]
+                         [:img.front-door {:src (:frontdoor-closed imgs)}])]
     ; BEDROOM
     [:div {:className (str "room" (cond (and bed-door-open bedroom-lights-off) " dim"
                                         bedroom-lights-off " dark"))}
-     [:img.room-image {:src "../assets/bedroom.jpg"}]
+     [:img.room-image {:src (:bedroom imgs)}]
      [:img {:className (str "bedroom-door" (if bed-door-open "-open" "-closed"))
-            :src "../assets/door.jpg"}]]]])
+            :src (:door imgs)}]]]])
+
 (defn kitchen-page []
   [:div.container
    [:div.line


Move inline method definitions to top-level

--- src/clojure_ruby/corelib.clj
+++ src/clojure_ruby/corelib.clj
@@ -1,5 +1,7 @@
 (ns clojure-ruby.corelib
   (:require [clojure-ruby.messaging :refer :all]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;

 (def global-true
   {:methods {"&&" (fn true-and [this other] other)}
@@ -48,44 +50,73 @@
              "!=" number-not-equal}
    :host-methods {:number number-host-number}})

+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare create-string)
+
+(defn string-size [this]
+  (create-number (count (:data this))))
+
+(defn string-bracket [this idx]
+  (let [idx (host-send idx :number)]
+    (create-string (subs (:data this) idx (inc idx)))))
+
+(defn string-equal [this other]
+  (let [other (host-send other :string)]
+    (create-boolean (= (:data this) other))))
+
+(defn string-host-string [this]
+  (:data this))
+
 (defn create-string [s]
   {:data s
-   :methods {"size" (fn string-size [this]
-                      (create-number (count (:data this))))
-             "[]" (fn string-bracket [this idx]
-                    (let [idx (host-send idx :number)]
-                      (create-string (subs (:data this) idx (inc idx)))))
-             "==" (fn string-triple-equal [this other]
-                    (let [other (host-send other :string)]
-                      (create-boolean (= (:data this) other))))
-             "===" (fn string-triple-equal [this other]
-                     (let [other (host-send other :string)]
-                       (create-boolean (= (:data this) other))))}
-   :host-methods {:string (fn string-host-string [this] (:data this))}})
+   :methods {"size" string-size
+             "[]" string-bracket
+             "==" string-equal
+             "===" string-equal}
+   :host-methods {:string string-host-string}})
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn array-bracket [this idx]
+  (let [idx (host-send idx :number)]
+    (nth @(:data this) idx)))
+
+(defn array-bracket-assign [this idx val]
+  (let [idx (host-send idx :number)]
+    (swap! (:data this) assoc idx val)))

 (defn create-array [cnt val]
   {:data (atom (vec (repeat cnt val)))
-   :methods {"[]" (fn array-bracket [this idx]
-                    (let [idx (host-send idx :number)]
-                      (nth @(:data this) idx)))
-             "[]=" (fn array-bracket-assign [this idx val]
-                     (let [idx (host-send idx :number)]
-                       (swap! (:data this) assoc idx val)))}})
+   :methods {"[]" array-bracket
+             "[]=" array-bracket-assign}})
+
+(defn Array-new [this cnt val]
+  (let [cnt (host-send cnt :number)]
+    (create-array cnt val)))

 (def Array
-  {:methods {"new" (fn Array-new [this cnt val]
-                     (let [cnt (host-send cnt :number)]
-                       (create-array cnt val)))}})
+  {:methods {"new" Array-new}})
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn File-read [this name]
+  (let [name (host-send name :string)]
+    (create-string (slurp name))))

 (def File
-  {:methods {"read" (fn File-read [this name]
-                      (let [name (host-send name :string)]
-                        (create-string (slurp name))))}})
+  {:methods {"read" File-read}})
+
+;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn STDOUT-putc [this char-int]
+  (let [char-int (host-send char-int :number)]
+    (print (char char-int))))

 (def STDOUT
-  {:methods {"putc" (fn STDOUT-putc [this char-int]
-                      (let [char-int (host-send char-int :number)]
-                        (print (char char-int))))}})
+  {:methods {"putc" STDOUT-putc}})
+
+;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn register-global-variables [variables]
   (swap! variables assoc "Array" Array)


* benchmark/cljs/benchmark_runner.cljs: add order of magnitude to keyword invoke bench

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -31,9 +31,9 @@
 (println ";;; map / record ops")
 (simple-benchmark [coll {:foo 1 :bar 2}] (get coll :foo) 1000000)
 (simple-benchmark [coll {:foo 1 :bar 2}] (-lookup coll :foo nil) 1000000)
-(simple-benchmark [coll {:foo 1 :bar 2}] (:foo coll) 100000)
+(simple-benchmark [coll {:foo 1 :bar 2}] (:foo coll) 1000000)
 (defrecord Foo [bar baz])
-(simple-benchmark [coll (Foo. 1 2)] (:bar coll) 100000)
+(simple-benchmark [coll (Foo. 1 2)] (:bar coll) 1000000)
 (simple-benchmark [coll {:foo 1 :bar 2}] (assoc coll :baz 3) 100000)
 (println)


Add note about inlined bits from lein-npm

--- tasks/leiningen/packagejson.clj
+++ tasks/leiningen/packagejson.clj
@@ -3,6 +3,9 @@
             [cheshire.core :as json]
             [clojure.java.io :as io]
             [leiningen.npm.deps :refer [resolve-node-deps]]))
+
+;; inlined these bits from lein-npm as it keeps deleting the package.json after each action
+;; this makes it difficult to deploy to heroku as a nodejs project.

 (defn- root [project]
   (if-let [root (project :npm-root)]


check existence of init script

check existence of init script

--- src/leiningen/repl.clj
+++ src/leiningen/repl.clj
@@ -3,13 +3,14 @@
   (:use [leiningen.compile :only [eval-in-project]]
         [clojure.java.io :only [copy]])
   (:import [java.net Socket]
-           [java.io OutputStreamWriter InputStreamReader]))
+           [java.io OutputStreamWriter InputStreamReader File]))

 (defn repl-server [project port]
   (let [init-form (and (or (:init-script project) (:main project))
                        [:init `#(let [is# ~(:init-script project)
                                       mn# '~(:main project)]
-                                  (when is# (load-file is#))
+                                  (when (and is# (.exists (File. is#)))
+                                    (load-file is#))
                                   (when mn# (doto mn# require in-ns)))])]
     `(do (ns ~'user
            (:use [~'clojure.main :only [~'repl]])


Removed extra ?pix-idx value from timeseries generation.

--- src/clj/forma/hadoop/jobs/load_tseries.clj
+++ src/clj/forma/hadoop/jobs/load_tseries.clj
@@ -30,7 +30,7 @@
   "Given a source of chunks, this subquery generates timeseries with
   all relevant accompanying information."
   [chunk-source]
-  (<- [?dataset ?spatial-res ?temporal-res ?tile-h ?tile-v ?sample ?line ?pix-idx ?t-start ?t-end ?tseries]
+  (<- [?dataset ?spatial-res ?temporal-res ?tile-h ?tile-v ?sample ?line ?t-start ?t-end ?tseries]
       (chunk-source ?dataset ?spatial-res ?temporal-res ?tilestring ?date ?chunkid ?int-chunk)
       (count ?int-chunk :> ?chunk-size)
       (extract-tseries ?temporal-res ?date ?int-chunk :> ?pix-idx ?t-start ?t-end ?tseries)


Fix Add project button text.

Fix Add project button text.

--- src/cljs/hatnik/web/client/components.cljs
+++ src/cljs/hatnik/web/client/components.cljs
@@ -161,7 +161,7 @@
        #js {:className "row"}
        (dom/div #js {:className "col-md-2"}
                 (dom/a #js {:className "btn btn-success"
-                            :onClick add-new-project} "Add new project"))
+                            :onClick add-new-project} "Add project"))
        (dom/div #js {:className "col-md-10"}))

       (dom/div nil


Tweak whitespace

Tweak whitespace

--- spec/rook/dispatcher_spec.clj
+++ spec/rook/dispatcher_spec.clj
@@ -34,6 +34,8 @@
     (fn [kw request]
       (if (identical? kw :request-method)
         (:request-method request)))))
+
+
 (create-ns 'example.foo)

 (binding [*ns* (the-ns 'example.foo)]


Добавлен data api для компонента табов

Добавлен data api для компонента табов

--- src-cljs/ixinfestor/omut.cljs
+++ src-cljs/ixinfestor/omut.cljs
@@ -1076,6 +1076,27 @@
    :tabs [;; {:text "item 1"}
           ]})

+(defn nav-tabs-active-tab [app]
+  (get-in @app [:active-tab] 0))
+
+(defn nav-tabs-enable-inly-one [app i]
+  (om/transact!
+   app (fn [app]
+         (-> app
+             (update-in [:tabs] #(->> %
+                                      (map
+                                       (fn [i t]
+                                         (if (= 0 i) t (assoc t :disabled? true)))
+                                       (range))
+                                      vec))
+             (assoc :active-tab i)))))
+
+(defn nav-tabs-enable-all [app]
+  (om/transact!
+   app :tabs
+   (fn [tabs] (map #(dissoc % :disabled?) tabs))))
+
+

 (defn nav-tabs [app _ {:keys [justified?
                               type


No need for token in parsed event

No need for token in parsed event

--- src/mokkameister/slack_coffee_resource.clj
+++ src/mokkameister/slack_coffee_resource.clj
@@ -32,9 +32,8 @@
     (slack/delayed-notify time-ms later-msg :channel channel)))

-(defn parse-slack-coffee-event [{:keys [channel_id text token user_name]}]
+(defn parse-slack-coffee-event [{:keys [channel_id text user_name]}]
   (let [event {:channel channel_id
-               :token token
                :user user_name}]
     (if (= text "instant")
       (assoc event :coffee-type :instant)


Fixed status accessors

Fixed status accessors

--- src/emm_ess_pee/computer.clj
+++ src/emm_ess_pee/computer.clj
@@ -60,22 +60,22 @@
   (bit-get (SR computer) 2))

 (defn GIE [computer]
-  (bit-get (SR computer 3)))
+  (bit-get (SR computer) 3))

 (defn CPUOFF [computer]
-  (bit-get (SR computer 4)))
+  (bit-get (SR computer) 4))

 (defn OSCOFF [computer]
-  (bit-get (SR computer 5)))
+  (bit-get (SR computer) 5))

 (defn SCG0 [computer]
-  (bit-get (SR computer 6)))
+  (bit-get (SR computer) 6))

 (defn SCG1 [computer]
-  (bit-get (SR computer 7)))
+  (bit-get (SR computer) 7))

 (defn V [computer]
-  (bit-get (SR computer 8)))
+  (bit-get (SR computer) 8))

 (defn set-C [computer value]
   (set-SR computer (set-bit (SR computer) 0 value)))


Improve the docstring for the then macro

Make use of case rather than cond when expanding the then macro

--- src/io/aviso/rook/client.clj
+++ src/io/aviso/rook/client.clj
@@ -148,40 +148,39 @@
   (let [->cond-block' (partial ->cond-block form response-sym)]
     (loop [cond-clauses []
            [selector clause-block & remaining-clauses] clauses]
-      (cond
-        (nil? selector) cond-clauses
-
-        (= selector :else)
+      (case selector
+        nil cond-clauses
+
+        :else
         (recur (conj cond-clauses true (->cond-block' clause-block))
                remaining-clauses)

-        (= selector :success)
+        :success
         (recur (conj cond-clauses
                      `(is-success? ~status-sym)
                      (->cond-block' clause-block))
                remaining-clauses)

-        (= selector :failure)
+        :failure
         (recur (conj cond-clauses
                      `(not (is-success? ~status-sym))
                      (->cond-block' clause-block))
                remaining-clauses)

-        (= selector :pass-success)
+        :pass-success
         (recur (conj cond-clauses
                      `(is-success? ~status-sym)
                      response-sym)
                ;; There is no clause block after :pass-success or :pass-failure
                (cons clause-block remaining-clauses))

-        (= selector :pass-failure)
+        :pass-failure
         (recur (conj cond-clauses
                      `(not (is-success? ~status-sym))
                      response-sym)
                ;; There is no clause block after :pass-success or :pass-failure
                (cons clause-block remaining-clauses))

-        :else
         (recur (conj cond-clauses
                      `(= ~status-sym ~selector)
                      (->cond-block' clause-block))
@@ -206,18 +205,25 @@
   makes it easier to work with that channel, branching based on status code, and returning a new
   result from the channel.

-  then makes use of <! (to park until the response form the channle is available),
+  then makes use of <! (to park until the response form the channel is available),
   and can therefore only be used inside a go block. Use [[then*]] outside of a go block.

   channel - the expression which produces the channel, e.g., the result of invoking [[send]].

-  A clause can either be :pass-success, :pass-failure, or a status code followed by vector.
+  A clause can either be :pass-success, :pass-failure, or a single status code followed by vector.
   The first elmeent in the vector is a symbol to which the response will be bound before evaluating
   the other forms in the vector. The result of the then block is the value of the last form
   in the selected block.

-  Instead of a status code, you may use :success (any 2xx status code), :failure (any other
+  then is specifically designed to work within a go block; this means that within a clause,
+  it is allowed to use the non-blocking forms <!, >!, and so forth. This would not be possible
+  if the then macro worked by relating a status code to a callback function.
+
+  Instead of a specific status code, you may use :success (any 2xx status code), :failure (any other
   status code), or :else (which matches regardless of status code).
+
+  Often it is desirable to simply pass through the response unchanged; this is the purpose of
+  the :pass-success and :pass-failure clauses.

   :pass-success is equvalent to :success [x x] and :pass-failure is equivalent to :failure [x x].

@@ -226,11 +232,12 @@
       (-> (c/new-request handler)
           (c/to :get :endpoint)
           c/send
-          (c/then :success [response
-                    (write-success-to-log (:body response))
-                    response]
-
-                  :pass-failure))
+          (c/then
+            :success [response
+                       (write-success-to-log (:body response))
+                      response]
+
+            :pass-failure))

   It is necessary to provide a handler for all success and failure cases; an unmatched status code


whitespace

whitespace

--- src/babel/italiano/writer.clj
+++ src/babel/italiano/writer.clj
@@ -69,8 +69,7 @@
 (defn generate-one-verb [spec & [count]]
   (log/debug (str "generate-one-verb with spec:" spec "; count=" count))
   (writer/generate-from-spec
-   (let [model
-         (create-model-for-spec spec)]
+   (let [model (create-model-for-spec spec)]
      (log/debug (str "created custom model from spec: " spec "; new model: " (keys model)))
      model)
    (strip-refs spec)


Fix typo

Fix typo

--- test/cljc/reitit/ring_test.cljc
+++ test/cljc/reitit/ring_test.cljc
@@ -581,7 +581,7 @@

 #?(:clj
    (deftest invalid-path-parameters-parsing-concurrent-requests-277-test
-     (testing "in enought concurrent system, path-parameters can bleed"
+     (testing "in enough concurrent system, path-parameters can bleed"
        (doseq [compiler [trie/java-trie-compiler trie/clojure-trie-compiler]]
          (let [app (ring/ring-handler
                      (ring/router


Handle illegal XML gracefully when aggregating test results

--- src/buildviz/go/aggregate.clj
+++ src/buildviz/go/aggregate.clj
@@ -27,7 +27,10 @@
       (when-not (= (count junit-xml-list) (count all-junit-xml))
         (log/infof "Unable to accumulate all JUnit XML for jobs of %s %s (%s %s)"
                    pipeline-name stage-name pipeline-run stage-run))
-      (aggregate-junit-xml-testsuites junit-xml-list))))
+      (try
+        (aggregate-junit-xml-testsuites junit-xml-list)
+        (catch Exception e
+          (log/errorf e "Unable to aggregate testresults for %s %s (%s %s)" pipeline-name stage-name pipeline-run stage-run))))))

 (defn- aggregate-build-times [job-instances]


Selects only a few keys out of the given map to add a new user.

--- src/cadence/views/landing.clj
+++ src/cadence/views/landing.clj
@@ -60,7 +60,8 @@
 (defpage signup-check [:post "/signup"] {:as user}
   (if (is-valid/user? user)
     (do
-      (model/add-user user)
+      (model/add-user
+        (select-keys user [:username :name :email :password])
       (flash/put! :success "Successfully Signed Up!")
       (resp/redirect (url-for root)))
     (do


This test isn't cleaning up after itself properly; fix it

--- test/doctopus/doctopus_test.clj
+++ test/doctopus/doctopus_test.clj
@@ -8,6 +8,8 @@
   (:import [doctopus.doctopus Doctopus]
            [doctopus.doctopus.head Head]))

+(storage/set-backend! :temp-fs)
+
 (def doctopus-test-configs
   {:heads-dir (io/resource "test/heads")})

@@ -16,8 +18,6 @@
 ;; inclined to mess with it until we get a Database and we can stop returning
 ;; new Doctopi/Heads every time there's a state change :/ - RMD
 (def stunt-doctopus (bootstrap-heads (Doctopus. doctopus-test-configs {})))
-
-(storage/set-backend! :temp-fs)

 (deftest doctopus-test
   (testing "Can we list heads?"


:bug: Pass whitelist domain to config

:bug: Pass whitelist domain to config

Signed-off-by: mathieu.brunot <cbb78c9d6ecc8139b4697c3352cc1f1edbdf61d7@monogramm.io>

--- backend/src/uxbox/config.clj
+++ backend/src/uxbox/config.clj
@@ -105,6 +105,7 @@
                    ::debug-humanize-transit
                    ::allow-demo-users
                    ::registration-enabled
+                   ::registration-domain-whitelist
                    ::image-process-max-threads]))

 (defn env->config


cleaning

cleaning

--- src/celestial/persistency.clj
+++ src/celestial/persistency.clj
@@ -26,7 +26,7 @@
     [bouncer [core :as b] [validators :as v :only (defvalidatorset defvalidator)]]
     [celestial.validations :only (validate!)]
     [clojure.string :only (split join)]
-    [celestial.redis :only (wcar hsetall*)]
+    [celestial.redis :only (wcar)]
     [slingshot.slingshot :only  [throw+ try+]]
     [celestial.model :only (clone hypervizors figure-virt)]
     [clojure.core.strint :only (<<)]))


change dependencies for supporting new leiningen (om => om/om)

--- src/clj/foosball/software.clj
+++ src/clj/foosball/software.clj
@@ -24,13 +24,13 @@
    ['com.cemerick/friend
     "Friend"
     "https://github.com/cemerick/friend"]
-   ['om
+   ['om/om
     "Om"
     "https://github.com/swannodette/om"]
    ['org.clojure/core.async
     "core.async"
     "https://github.com/clojure/core.async"]
-   ['sablono
+   ['sablono/sablono
     "Ŝablono"
     "https://github.com/r0man/sablono"]
    ['compojure/compojure
@@ -45,7 +45,7 @@
    ['liberator/liberator
     "Liberator"
     "http://clojure-liberator.github.io/liberator/"]
-   ['secretary
+   ['secretary/secretary
     "Secretary"
     "https://github.com/gf3/secretary"]
    ['clj-time/clj-time


fix DBS + Fisk Investment seminar interaction

allow Corp to return any of the cards drawn by FIS + DBS

--- src/clj/game/cards-assets.clj
+++ src/clj/game/cards-assets.clj
@@ -183,7 +183,7 @@
                         (let [dbs (count (filter #(and (rezzed? %) (= (:title %) "Daily Business Show"))
                                                   (all-installed state :corp)))
                               newcards (take dbs (:deck corp))
-                              drawn (conj newcards (last (:hand corp)))]
+                              (concat newcards (take-last target (:hand corp)))]
                           (doseq [c newcards] (move state side c :hand))
                           (resolve-ability
                             state side


implement Jeeves Model Bioroids

implement Jeeves Model Bioroids

--- src/clj/game/cards-assets.clj
+++ src/clj/game/cards-assets.clj
@@ -427,6 +427,12 @@
                             :effect (req (doseq [c targets] (move state side c :deck))
                                          (shuffle! state side :deck))}
                            card nil))}]}
+
+   "Jeeves Model Bioroids"
+   {:abilities [{:label "Gain [Click]"
+                 :req (req (< 2 (- (:click-per-turn corp) (:click corp))))
+                 :msg "gain [Click]" :once :per-turn
+                 :effect (effect (gain :click 1))}]}

    "Kala Ghoda Real TV"
    {:flags {:corp-phase-12 (req true)}


Don't run auto-solver if there's no solver (e.g. during tests)

--- src/clj/herder/solver/run.clj
+++ src/clj/herder/solver/run.clj
@@ -122,11 +122,13 @@
           (swap! (-> system :solver :tosolve) disj item)))))

 (defn needs-solve [id]
-  (if (-> system :solver :watch deref nil?)
+  (if (-> system :solver nil? not) ; if we have solver available. Not true in tests
     (do
-      (add-watch (-> system :solver :tosolve) :solve-watch solve-watch)
-      (reset! (-> system :solver :watch) :solve-watch)))
-  (swap! (-> system :solver :tosolve) conj id))
+      (if (-> system :solver :watch deref nil?)
+        (do
+          (add-watch (-> system :solver :tosolve) :solve-watch solve-watch)
+          (reset! (-> system :solver :watch) :solve-watch)))
+      (swap! (-> system :solver :tosolve) conj id))))

 (if-let [sys-db (-> system :db :connection)]
   (kd/with-db sys-db


Notify matrix.org room on coffee!!!

Notify matrix.org room on coffee!!!

--- src/clj/mokkameister/brew.clj
+++ src/clj/mokkameister/brew.clj
@@ -3,6 +3,7 @@
             [clj-time.core :as t]
             [clj-time.coerce :as tc]
             [mokkameister
+             [matrix :as matrix]
              [pusher :as pusher]
              [slack :as slack]
              [system :refer [system]]
@@ -48,10 +49,12 @@
         total-count  (get-in stats [:regular :total])
         starting-msg (coffee-message-starting brew today-count)
         msg          (str starting-msg " - " mokkameister-link)]
+    (matrix/notify msg)
     (slack/notify msg :channel channel)))

 (defn- notify-done! [brew]
   (let [msg (coffee-message-finished)]
+    (matrix/notify msg)
     (slack/notify msg :channel channel)))

 (defn- finish-brewing! [brew]


Added hacky printing of error vectors to log.csv files.

--- src/clojush/pushgp/report.clj
+++ src/clojush/pushgp/report.clj
@@ -36,6 +36,7 @@
 ;; report printing functions

 (def fname "log.csv")
+(def printAllTestCases true)

 (defn csv-init
   []
@@ -43,14 +44,34 @@

 (defn csv-print
   [population generation]
-  (doseq [[ind p] (map-indexed vector population)]
-    (spit fname
-          (format "%s,%s,%s,%s\n"
-                  generation
-                  ind
-                  (:total-error p)
-                  (count-points (:program p)))
-          :append true)))
+  (if (not printAllTestCases)
+    (doseq [[ind p] (map-indexed vector population)]
+      (spit fname
+            (format "%s,%s,%s,%s\n"
+                    generation
+                    ind
+                    (:total-error p)
+                    (count-points (:program p)))
+            :append true))
+    (do
+      (when (zero? generation)
+        (spit fname "generation,individual,total-error,size," :append false)
+        (spit fname
+              (format "%s\n"
+                      (apply str
+                             "TC"
+                             (interpose ",TC"
+                                        (range (count (:errors (first population)))))))
+              :append true))
+      (doseq [[ind p] (map-indexed vector population)]
+        (spit fname
+              (format "%s,%s,%s,%s,%s\n"
+                      generation
+                      ind
+                      (:total-error p)
+                      (count-points (:program p))
+                      (apply str (interpose "," (:errors p))))
+              :append true)))))

 (defn report
   "Reports on the specified generation of a pushgp run. Returns the best


Fixing use of kml results handler.

Fixing use of kml results handler.

--- src/cmr/search/api/routes.clj
+++ src/cmr/search/api/routes.clj
@@ -23,6 +23,7 @@
             [cmr.search.results-handlers.atom-results-handler]
             [cmr.search.results-handlers.atom-json-results-handler]
             [cmr.search.results-handlers.reference-results-handler]
+            [cmr.search.results-handlers.kml-results-handler]
             [cmr.search.results-handlers.metadata-results-handler]
             [cmr.search.results-handlers.query-specified-results-handler]
             [cmr.search.results-handlers.timeline-results-handler]


added list with all videos to video main page

--- src/distillery/view/index.clj
+++ src/distillery/view/index.clj
@@ -1,5 +1,6 @@
 (ns distillery.view.index
   (:require [net.cgrand.enlive-html :as eh])
+  (:require [distillery.data :refer [key-comp]])
   (:require [distillery.files :refer :all])
   (:require [distillery.view.html :refer :all]))

@@ -42,10 +43,16 @@
       (render-categories-list args)]])

+(defn- render-video-list-item
+  "Renders a video link as list item."
+  [{:keys [id name] :as video}]
+  (list-item (link (str "videos/" id "/index.html") name)))
+
 (defn- render-videos-list
   [{:keys [videos] :as args}]
-  (innerpage "list" "Liste" true
-             [(TODO "Videoliste")]))
+  (let [video-list (into (sorted-set-by (key-comp :name)) videos)]
+    (innerpage "list" "Liste" true
+               (ulist (map render-video-list-item video-list)))))

 (defn render-videos-page
   "Renders the videos main page."


enhanced ns detection: if there's a top level in-ns, it's used

--- ccw.core/src/ccw/static_analysis.clj
+++ ccw.core/src/ccw/static_analysis.clj
@@ -1,5 +1,13 @@
 (ns ccw.static-analysis
   (:require [paredit.parser :as p]))

-(defn find-namespace
-  [tree] (p/sym-name (p/form (first (p/call-args (some #(p/call-of % "ns") (p/code-children tree)))))))+(defn find-namespace [tree]
+  (p/sym-name
+    (p/form
+      (first
+        (p/call-args
+          (some
+            #(or
+               (p/call-of % "ns")
+               (p/call-of % "in-ns"))
+            (p/code-children tree)))))))


Comment some printlns on users tests.

Comment some printlns on users tests.

--- test/uxbox/tests/test_users.clj
+++ test/uxbox/tests/test_users.clj
@@ -19,7 +19,7 @@
       (with-server {:handler (urt/app)}
         (let [uri (str th/+base-url+ "/api/profile/me")
               [status data] (th/http-get user uri)]
-          (println "RESPONSE:" status data)
+          ;; (println "RESPONSE:" status data)
           (t/is (= 200 status))
           (t/is (= (:fullname data) "User 1"))
           (t/is (= (:username data) "user1"))
@@ -38,7 +38,7 @@
                           :metadata "222"
                           :email "user222@uxbox.io")
               [status data] (th/http-put user uri {:body data})]
-          (println "RESPONSE:" status data)
+          ;; (println "RESPONSE:" status data)
           (t/is (= 200 status))
           (t/is (= (:fullname data) "Full Name"))
           (t/is (= (:username data) "user222"))
@@ -56,6 +56,6 @@
                        :content (io/input-stream
                                  (io/resource "uxbox/tests/_files/sample.jpg"))}]
               [status data] (th/http-multipart user uri params)]
-          (println "RESPONSE:" status data)
+          ;; (println "RESPONSE:" status data)
           (t/is (= 204 status)))))))


[Add] test update-exp

[Add] test update-exp

--- test/clj_elm/core_test.clj
+++ test/clj_elm/core_test.clj
@@ -102,6 +102,12 @@
       (predict model (first (normalize (:features libsvmlian))))
       => -1)))

+(facts "test-update-exp"
+  (fact "(update-exp fn key exp) return reference of exp"
+    (let [exp (atom {:TP 0 :FP 0})]
+      @(update-exp inc :TP exp)
+      => {:TP 1 :FP 0})))
+
 (facts "test-count-rate"
   (fact "(count-rate pred fact exp)"
     (let [exp (atom {:TP 0 :FP 0 :TN 10 :FN 10})]


Fix expected output to include my.test0

Fix expected output to include my.test0

--- tests/formatter/main/output.clj
+++ tests/formatter/main/output.clj
@@ -110,7 +110,8 @@
   3.14)

 (ns my.test
-  (:require my.test1
+  (:require my.test0
+            my.test1
             [my.test2]
             [my.test3 :as test3 :refer [f1]])
   (:import (java.time LocalDateTime ZonedDateTime ZoneId)


Add synonyms for 0-9.

Add synonyms for 0-9.

--- src/haystack/create_index.clj
+++ src/haystack/create_index.clj
@@ -30,6 +30,17 @@
    "pipe conduit"
    "romex nm"
    "so seoow seow soow sow"
+   "gray grey"
+   "0 zero"
+   "1 one"
+   "2 two"
+   "3 three"
+   "4 four"
+   "5 five"
+   "6 six"
+   "7 seven"
+   "8 eight"
+   "9 nine"
    ])

 (defn synonyms


able to extract table data

able to extract table data

--- src/hypertext_ray/finders.clj
+++ src/hypertext_ray/finders.clj
@@ -130,6 +130,12 @@

 ;
+;
+;
+;
+
+(def itables (atom nil)) ;vector of indexed tables for current page
+
 (comment defn get-cell
   "gets cell at r,c from table t, but returns nil if the cell doesn't exist"
   [t r c]
@@ -158,6 +164,7 @@
       (for [c (find-header-or-data-cells r)]
         (failsafe-text c)))))

+(def ffilter (comp first filter))

 (defn some-what
   "works like some, but returns the value which satisfied the predicate"
@@ -174,9 +181,7 @@

 (defn index-tables []
   (for [t (find-elements [{:tag :table}])]
-    (map vector (range) (index-table-text t))
-    )
-  )
+    (index-table-text t)))

 (defn match? [re x]
   (try
@@ -184,32 +189,39 @@
     (catch NullPointerException e false) ))

 (defn search-table [t re]
-  (let [itable (index-table-text t)]
-    (some-what #(match? re (last %)) itable)
-    ) )
-
-(defn find-cell-by-coordinate [[x,y]]
-  (println "cell at:" x y)
-  )
-
-(defn find-cell-by-offset [[x,y] re]
-  (println "looking for" re " and then " x y)
-  (let [match (search-table )])
-  )
+    (ffilter #(match? re (last %)) t))
+
+(defn find-cell-by-coordinate [coords]
+  (println "finding cell by coordinate:" coords)
+  (let [candidates (ffilter #(get % coords ) @itables)]
+    (second (first (remove #(nil? (second %)) candidates)))
+    ))
+
+(defn find-cell-by-offset [coords re]
+  (println "finding cell by offset:" coords re)
+  (let [match  (map #(vector (second %) (search-table (first %) re)) (map vector @itables (range)))
+        match (first (remove #(nil? (second %)) match)) ]
+    (println "matched:" match)
+    (when-let [matchedcoords (get-in match [1 0])]
+      (let [newcoords (mapv + coords matchedcoords)]
+        (println newcoords)
+        (get (nth @itables (first match)) newcoords)))))

 ;location should be like:
 ;[:offset [x,y]]
 ;[x,y]
-(defn find-table-cell-by-location [location re]
+(defn find-table-cell-by-location [location]
+  (println "finding table cell by location" location )
   (case (first location)
-    :offset (find-cell-by-offset (first (rest location)) re)
-    (find-cell-by-coordinate location)
+    :offset (find-cell-by-offset (first (rest location)) (last location))
+    (find-cell-by-coordinate (first location))
     )
   )

-(defn dispatch-location [location re]
+(defn dispatch-location [location]
+  (println "dispatching" location)
   (case (first location)
-    :table (find-table-cell-by-location (rest location) re)
+    :table (find-table-cell-by-location (rest location))
     :miss)
     )

@@ -222,9 +234,9 @@
 ; and then it should add a :results section to the siteinfo map
 ; which contains a map of keynames and scraped data
 (defn find-data [siteinfo page]
-  (let [items (page (:datamatcher siteinfo))]
+  (reset! itables (index-tables))
+  (assoc siteinfo :data (into {} (let [items (page (:datamatcher siteinfo))]
     (for [[keyname item] items]
-      (let [[location re] item]
-        (dispatch-location location re)
-        ))))
-
+        [keyname (dispatch-location item)]
+        )))))
+


[Fix #25] project-prefix can be defined on project file...

...default is unique. CLI supersedes project file. Also related to #22

--- src/leiningen/source_deps.clj
+++ src/leiningen/source_deps.clj
@@ -2,17 +2,24 @@
   (:require [clojure.edn :as edn]
             [me.raynes.fs :as fs]
             [mranderson.core :as c]
-            [mranderson.util :as u]))
+            [mranderson.util :as u])
+  (:import [java.util UUID]))

 (defn lookup-opt [opt-key opts]
   (second (drop-while #(not= % opt-key) opts)))

+(defn- generate-default-project-prefix []
+  (str "mranderson" (->  (UUID/randomUUID)
+                         str
+                         (.substring 0 8))))
+
 (defn- lein-project->ctx
   [{:keys [root target-path name version mranderson]} args]
   (let [opts                        (map #(edn/read-string %) args)
-        project-prefix              (lookup-opt :project-prefix opts)
-        pprefix                     (or (and project-prefix (clojure.core/name project-prefix))
-                                        (u/clean-name-version "mranderson" (u/mranderson-version)))
+        project-prefix-opt          (lookup-opt :project-prefix opts)
+        project-prefix              (or (and project-prefix-opt (clojure.core/name project-prefix-opt))
+                                        (and (nil? project-prefix-opt) (:project-prefix mranderson))
+                                        (generate-default-project-prefix))
         skip-repackage-java-classes (lookup-opt :skip-javaclass-repackage opts)
         prefix-exclusions           (lookup-opt :prefix-exclusions opts)
         srcdeps-relative            (str (apply str (drop (inc (count root)) target-path)) "/srcdeps")
@@ -21,10 +28,10 @@
         shadowing-only              (or shadowing-only-opt (and (nil? shadowing-only-opt) (:shadowing-only mranderson)))]
     (u/debug "skip repackage" skip-repackage-java-classes)
     (u/debug "project mranderson" (prn-str mranderson))
-    (u/info "project prefix: " pprefix)
+    (u/info "project prefix: " project-prefix)
     {:pname                       name
      :pversion                    version
-     :pprefix                     pprefix
+     :pprefix                     project-prefix
      :skip-repackage-java-classes skip-repackage-java-classes
      :srcdeps                     srcdeps-relative
      :prefix-exclusions           prefix-exclusions


less logging

less logging

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -141,20 +141,16 @@
   (log/debug (str "generate-all: generating from spec with cat "
                   (get-in spec [:synsem :cat])))
   (if (= false (get-in spec [:phrasal] true))
-    (exception (str "do not call generate-all with spec:[phrasal=true]"))
+    (exception (str "do not call generate-all with spec:[phrasal=false]"))
     ;; else, phrasal:
     (let [total-depth (if total-depth total-depth 0)
           add-complements-to-bolts
           (fn [bolts path]
-            (log/debug (str "generate-all: "
-                            "add-complements-to-bolts: "
-                            (show-bolt (first bolts) path morph)
-                            "@" path))
             (mapcat
              #(if (not (= :none (get-in % path :none)))
                 (lazy-seq (add-complement % path :top grammar lexicon index morph 0 (+ total-depth (count path))))
                 [%])
-             bolts))
+             (filter #(not (nil? %)) bolts)))

           expressions
           (lazy-seq
@@ -166,24 +162,6 @@
                (add-complements-to-bolts [:head :head :comp])
                (add-complements-to-bolts [:head :comp])
                (add-complements-to-bolts [:comp])))]
-
-      (if (not (empty? expressions))
-        (log/debug
-         (str "generate-all: first expression generated for spec:"
-              (strip-refs (if (seq? spec)
-                            (first spec)
-                            spec))
-              ":"
-              "'" (morph (first expressions)) "'"))
-
-        ;; no expression could be generated.
-        (let [error-message
-              (str "generate-all: no expressions could be generated for spec:"
-                   (strip-refs (if (seq? spec)
-                                 (first spec)
-                                 spec)))]
-          (log/error error-message)
-          (if false (exception error-message))))
       (map (fn [expr]
              (truncate expr [[:head][:comp]]))
            expressions))))
@@ -205,6 +183,8 @@
                      :fail))
                  (lazy-seq (shuffle rules)))))

+(declare morph-with-recovery)
+
 (defn lightning-bolt [grammar lexicon spec depth index morph total-depth]
   "Returns a lazy-sequence of all possible trees given a spec, where
 there is only one child for each parent, and that single child is the
@@ -220,21 +200,9 @@
         (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
               (mapcat (fn [parent]
                         (if (= false (get-in parent [:head :phrasal] false))
-                          (let [candidate-lexemes (lazy-seq (get-lex parent :head index spec))
-                                results (filter #(not (nil? %))
-                                                (over/overh parent (mapfn copy candidate-lexemes)))]
-                            (log/debug (str "lightning-bolt: " (get-in parent [:rule])
-                                            ": first candidate head lexeme:"
-                                            (let [fo (morph (first candidate-lexemes))]
-                                              (if (or (nil? fo)
-                                                      (= '' (trim fo)))
-                                                (str
-                                                 "'"
-                                                 (get-in (first candidate-lexemes)
-                                                         [:english :english])
-                                                 "'")
-                                                (str fo)))))
-                            results)))
+                          (let [candidate-lexemes (filter #(not (nil? %)) (get-lex parent :head index spec))]
+                            (filter #(not (nil? %))
+                                    (over/overh parent (mapfn copy candidate-lexemes))))))
                       parents)
               phrasal ;; 2. generate list of all phrases where the head child of each parent is itself a phrase.
               (if (< depth max-total-depth)
@@ -254,15 +222,15 @@
         result (if (or (nil? result)
                        (= "" result))
                  (get-in input [:english :english] "")
-                 (str "r1: " result))
+                 result)
         result (if (or (nil? result)
                        (= "" result))
                  (get-in input [:english] "")
-                 (str "r2: " result))
+                 result)
         result (if (or (nil? result)
                        (= "" result))
                  (get-in input [:rule] "")
-                 (str "r3: " result))
+                 result)
         result (if (or (nil? result)
                        (= "" result))
                  (exception
@@ -271,12 +239,11 @@
     result))

 (defn add-complement [bolt path spec grammar lexicon cache morph depth total-depth]
-  (log/debug (str "add-complement: " (show-bolt bolt path morph)))
+  (log/debug (str "add-complement: start: " (show-bolt bolt path morph)))
   (let [input-spec spec
         from-bolt bolt ;; so we can show what (add-complement) did to the input bolt, for logging.
         spec (unifyc spec (get-in bolt path))
         immediate-parent (get-in bolt (butlast path))
-        start-time (current-time)
         complement-candidate-lexemes (if (not (= true
                                                  (get-in bolt (concat path [:phrasal]))))
                                        (let [cached (if cache
@@ -293,24 +260,8 @@
                                  result))
         filtered-lexical-complements (filter (fn [lexeme]
                                                (complement-pre-check lexeme bolt path))
-                                             complement-candidate-lexemes)
-        debug (log/debug
-               (if (not (empty? filtered-lexical-complements))
-                 (str "add-complement: candidate first complement-lexemes:'"
-                      (morph (first filtered-lexical-complements)) "'")))]
-    (filter (fn [complement]
-              (if (fail? complement)
-                (do
-                  (log/debug (str "add-complement(depth=" depth ",total-depth=" total-depth
-                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ") FAILED:"
-                                  "'" (morph-with-recovery morph complement) "'"))
-
-                  false)
-                (do
-                  (log/debug (str "add-complement(depth=" depth ",total-depth=" total-depth
-                                  ",path=" path ",bolt=(" (show-bolt bolt path morph) ")=>"
-                                  "'" (morph-with-recovery morph complement) "'"))
-                  true)))
+                                             complement-candidate-lexemes)]
+    (filter #(not (fail? %))
             (mapfn (fn [complement]
                     (unify (copy bolt)
                            (path-to-map path
@@ -319,8 +270,9 @@
                                               ",path=" path ",bolt=(" (show-bolt bolt path morph)
                                               "): calling generate-all(" (strip-refs spec) ");"
                                               "input-spec: " input-spec))
-                        phrasal-complements (if (> max-total-depth total-depth)
-                                              (lazy-seq (generate-all spec grammar lexicon cache morph (+ depth total-depth))))]
+                        phrasal-complements (if (and (> max-total-depth total-depth)
+                                                     (= true (get-in spec [:phrasal] true)))
+                                              (generate-all spec grammar lexicon cache morph (+ depth total-depth)))]
                     (if (lexemes-before-phrases total-depth)
                       (lazy-cat filtered-lexical-complements phrasal-complements)
                       (lazy-cat phrasal-complements filtered-lexical-complements)))))))
@@ -391,7 +343,10 @@
     (exception (str "don't call show-bolt with bolt=null."))
     (if (not (empty? path))
       (str "[" (get-in bolt [:rule])
-           " '" (morph-with-recovery morph bolt) "' "
-           (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
-             (if (not (nil? rest-str))
-               (str " -> " rest-str  "]")))))) )
+           " '" (morph-with-recovery morph bolt) "'"
+           (let [head-bolt (get-in bolt [:head])]
+             (if (not (nil? head-bolt))
+               (let [rest-str (show-bolt (get-in bolt [:head]) (rest path) morph)]
+                 (if (not (nil? rest-str))
+                   (str " -> " rest-str)))))
+           "]"))))


use shuffle rather than lazy-shuffle and +(defn candidate-parents)

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -7,7 +7,7 @@
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
    [clojure.string :as string]
-   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path lazy-shuffle
+   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path
                                         ref? remove-false remove-top-values-log
                                         strip-refs show-spec unify unifyc)]))
 ;; during generation, will not search deeper than this:
@@ -131,8 +131,9 @@

 (defn candidate-parents [rules spec]
   "find subset of _rules_ for which each member unifies successfully with _spec_"
-  (filter #(not (fail? (unifyc % spec)))
-          rules))
+  (filter #(not (fail? %))
+          (mapfn (fn [rule] (unifyc spec rule))
+                 (shuffle rules))))

 (defn lightning-bolt [grammar lexicon spec depth index morph total-depth]
   "Returns a lazy-sequence of all possible trees given a spec, where
@@ -147,7 +148,7 @@
       (log/debug (str "lightning-bolt(depth=" depth "; total-depth=" total-depth "; cat=" (get-in spec [:synsem :cat]) "; spec=" (strip-refs spec) ")"))
       (let [morph (if morph morph (fn [input] (get-in input [:rule] :default-morph-no-rule)))
             depth (if depth depth 0)
-            parents (lazy-shuffle (filter #(not (fail? %)) (mapfn (fn [rule] (unifyc spec rule)) grammar)))]
+            parents (candidate-parents grammar spec)]
         (let [lexical ;; 1. generate list of all phrases where the head child of each parent is a lexeme.
               (mapcat (fn [parent]
                         (if (= false (get-in parent [:head :phrasal] false))


added java api

added java api

--- src/bitcoinrpc/core.clj
+++ src/bitcoinrpc/core.clj
@@ -192,9 +192,9 @@
 ;== Util ==
 (def-rpc createmultisig nrequired the-keys)
 (def-rpc estimatefee nblocks)
-(def-rpc estimatepriority nblocks)
-(def-rpc estimatesmartfee nblocks)
-(def-rpc estimatesmartpriority nblocks)
+;(def-rpc estimatepriority nblocks)
+;(def-rpc estimatesmartfee nblocks)
+;(def-rpc estimatesmartpriority nblocks)

 (s/fdef signmessagewithprivkey :args (s/cat :privkey string?, :message string?) :ret ::signature)
 (def-rpc signmessagewithprivkey privkey message)
@@ -335,13 +335,13 @@
 (defn arg-vals-of [args]
   (reduce (fn [acc v] (if (empty? acc) (format "%s" v) (format "%s, %s" acc v))) "" args))

-(defn java-fn-name-of [m] (format "btc%s" (normalize-name (:name m))))
+(defn java-fn-name-of [i m] (format "btc%s%s" (normalize-name (:name m)) (if (> i 0) i "")))

 (defn java-method-of
   ([m]
-   (reduce (fn [acc v] (format "%s\n%s" acc v)) (flatten (map (comp (partial java-method-of m) rest) (:arglists m)))))
-  ([m args]
-    (let [n (java-fn-name-of m)
+   (reduce (fn [acc v] (format "%s\n%s" acc v)) (flatten (map-indexed (fn [i v] (java-method-of i m (rest v))) (:arglists m)))))
+  ([i m args]
+    (let [n (java-fn-name-of i m)
           args (map normalize-name args)
           arg-vals (arg-vals-of args)]
       ["/**"
@@ -366,9 +366,12 @@
   ]
   ))

-(defn java-signature-of [m]
-  (format "buildSignatureFromThreadSafeMethod(\"%s\")" (java-fn-name-of m))
+(defn java-signature-of [i m]
+  (format "buildSignatureFromThreadSafeMethod(\"%s\")" (java-fn-name-of i m))
   )
+
+(defn meta-with-index []
+  (mapcat (fn [x] (map (fn [i] [i x]) (range (-> x :arglists count)))) (btc-meta)))

 (defn java-plugin-source-of [package classname]
   (reduce (fn [acc v] (format "%s\n%s" acc v)) [
@@ -383,7 +386,7 @@
   "@Override"
   "public DRAPLFunctionSignature[] getFunctions() {"
   "return new DRAPLFunctionSignature[] {"
-  (reduce (fn [acc v] (format "%s,\n%s" acc v)) (map java-signature-of (btc-meta)))
+  (reduce (fn [acc v] (format "%s,\n%s" acc v)) (map (fn [[i x]] (java-signature-of i x)) (meta-with-index)))

   "};"
   "}"


segment out these pieces

segment out these pieces

--- src/block_chain/pem.clj
+++ src/block_chain/pem.clj
@@ -3,16 +3,9 @@
             [clojure.string :refer [join split]]
             [block-chain.encoding :refer :all]))

-(defn keydata [reader]
- (->> reader
-      (org.bouncycastle.openssl.PEMParser.)
-      (.readObject)))
-
-(defn pem-string->key-pair [string]
-  "Convert a PEM-formatted private key string to a public/private keypair.
-   Returns java.security.KeyPair."
-  (let [kd (keydata (io/reader (.getBytes string)))]
-    (.getKeyPair (org.bouncycastle.openssl.jcajce.JcaPEMKeyConverter.) kd)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;; DER ;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn der-string->pub-key [string]
   (let [non-wrapped (clojure.string/replace string #"\n" "")
@@ -52,6 +45,21 @@

 (defn private-key->der-string [private-key]
   (encode64 (.getEncoded private-key)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;; PEM ;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn keydata [reader]
+ (->> reader
+      (org.bouncycastle.openssl.PEMParser.)
+      (.readObject)))
+
+(defn pem-string->key-pair [string]
+  "Convert a PEM-formatted private key string to a public/private keypair.
+   Returns java.security.KeyPair."
+  (let [kd (keydata (io/reader (.getBytes string)))]
+    (.getKeyPair (org.bouncycastle.openssl.jcajce.JcaPEMKeyConverter.) kd)))

 (defn pem-string->pub-key [string]
   "Convert a PEM-formatted public key string to an RSA public key.


Comment blake2b 256 due to bug in bouncy castle.

--- src/buddy/core/hash.clj
+++ src/buddy/core/hash.clj
@@ -168,11 +168,11 @@
   [input]
   (blake2b input 16))

-(defn blake2b-256
-  "BLAKE2 cryptographic hash function with fixed output
-  digest size to 256 bits."
-  [input]
-  (blake2b input 32))
+;; (defn blake2b-256
+;;   "BLAKE2 cryptographic hash function with fixed output
+;;   digest size to 256 bits."
+;;   [input]
+;;   (blake2b input 32))

 (defn blake2b-512
   "BLAKE2 cryptographic hash function with fixed output


Say recognized words.

Say recognized words.

--- src/mash_commander/core.cljs
+++ src/mash_commander/core.cljs
@@ -149,7 +149,10 @@
                                     (str/split "1234567890" ""))))

 (defn last-word [letters]
-  (str/join (reverse (take-while #(not= " " %) letters))))
+  (as-> letters l
+    (if (and (not (empty? letters)) (= " " (first letters)))
+      (rest l) l)
+    (str/join (reverse (take-while #(not= " " %) l)))))

 (defn recognize? [owner word]
   (let [trie (om/observe owner (words))
@@ -221,7 +224,10 @@
           (as-> % c
             (assoc-in c [:active :letters] (cons key (get-in c [:active :letters])))
             (if (= :typing state)
-              (assoc-in c [:active :state] (cons :typing-space (get-in c [:active :state])))
+              (do
+                (let [what (last-word (get-in c [:active :letters]))]
+                  (go (>! polly-say what)))
+                (assoc-in c [:active :state] (cons :typing-space (get-in c [:active :state]))))
               (assoc-in c [:active :state] (cons :mashing-space (get-in c [:active :state])))))
           ;; Ignore backspace on empty
           (and (= "Backspace" key) (= :empty state)) %
@@ -231,7 +237,12 @@
             (assoc-in c [:active :state] (rest (get-in c [:active :state])))
             (assoc-in c [:active :letters] (rest (get-in c [:active :letters]))))
           ;; Enter
-          (= "Enter" key) (dispatch-enter %)
+          (= "Enter" key)
+          (do
+            (when (= :typing state)
+              (let [what (last-word (get-in % [:active :letters]))]
+                (go (>! polly-say what))))
+            (dispatch-enter %))
           ;; Ignore everything else
           :default %)))))


Table model should set getter fn as :db, not :database

--- src/metabase/models/table.clj
+++ src/metabase/models/table.clj
@@ -9,5 +9,5 @@

 (defmethod post-select Table [_ {:keys [id db_id] :as table}]
   (-> table
-      (assoc :database (sel-fn :one Database :id db_id))
+      (assoc :db (sel-fn :one Database :id db_id))
       (assoc :fields (sel-fn :many "metabase.models.field/Field" :table_id id))))


Just need multidim back.

Just need multidim back.

--- src/numerics/runge_kutta.clj
+++ src/numerics/runge_kutta.clj
@@ -46,14 +46,9 @@
 ;      [(* dt (Math/pow (/ tol error-estimate) 0.25)) y])))

 ;;;; 1 D
-(defn ki [f [tn yn] dt a c k]
-  (let [ys (+ yn (* dt (reduce + 0 (for [j (range (count k))] (* (a j) (k j))))))]
-    (f (into [(+ tn (* dt c))] [ys]))))
+

 (defn f [[x y]] (- (* 4.0 (Math/exp (* 0.8 x))) (* 0.5 y)))
-(prn (ks [f] [0 2] 0.5 tableaus/classic-fourth-order))
-(prn (rk-step [f] [0 2] 0.5 tableaus/classic-fourth-order))
-
 ;;This is wrong and needs fixing.
 (prn (ks [f] [0 2] 2.0 tableaus/cash-karp))

@@ -67,10 +62,11 @@
 ;(def y (vec (map + yn (map (fn [k] (* dt (reduce + (map #(* % k) (first ai))))) ks))))

 ;; http://en.wikipedia.org/wiki/List_of_Runge–Kutta_methods
-;;This approach is probably right (well, there's no recursion).
-;; Currently ki is not being accumulated, though.
-;; kj is going to count up to s. At each loop they must be summed. IDK if this happens above.
 (prn "YYYYYYYYY")
+(defn ki [f [tn yn] dt a c k]
+  (let [ys (+ yn (* dt (reduce + 0 (map * a k))))]
+    (f (into [(+ tn (* dt c))] [ys]))))
+
 (def kk (loop [ks [] ai a ci c]
   (if-not (first ci)
     ks


Use goog.dom in nodejs polyfill

Use goog.dom in nodejs polyfill

--- src/node/polyfill/compat.cljs
+++ src/node/polyfill/compat.cljs
@@ -1,7 +1,8 @@
 (ns polyfill.compat
   (:require
    [cljs.nodejs :as nodejs]
-   [polyfill.simple]))
+   [polyfill.simple]
+   [goog.dom :as dom]))

 "
 Load before any module that depends on basic browser context.
@@ -261,27 +262,10 @@

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

-(deftype Node [] Object)
-(override-prototype Node node-prototype (aget js/global "Node"))
-(set! js/Node Node)
-;(set! js/Node
-;      (clone-merge (or (aget js/global "Node") Node)
-;                    node-prototype))
-
-; for testing - from hickory
-(defn extend-type-with-seqable
-  [t]
-  (extend-type t
-    ISeqable
-    (-seq [array] (array-seq array))))
-
-;; (def doc2 (.parseFromString (new dom-parser) xhtml "application/xml"))
-;; (extend-type-with-seqable Node)
-;; (map identity (Node.))
-;; Now even an existing document should be seqable:
-;; (map identity doc2)
-;; Yes! Works...
-
+(when-not (exists? js/Node)
+  (set! js/Node dom/NodeType))
+
+;; for testing - from hickory
 ;; js/NodeList (used in hickory.core)

 (def nodelist-prototype (prototype-of (.-childNodes doc)))
@@ -294,6 +278,12 @@
 ;;                     NodeList
 ;;                    (aget js/global "NodeList"))
 ;;                    nodelist-prototype))
+
+(defn extend-type-with-seqable
+  [t]
+  (extend-type t
+    ISeqable
+    (-seq [array] (array-seq array))))

 (extend-type-with-seqable js/NodeList) ; test


Fix bug in garbage collection that caused collection issues when a task is two task types e.g. output and window.

--- src/onyx/peer/coordinator.clj
+++ src/onyx/peer/coordinator.clj
@@ -119,12 +119,14 @@
      (fn [all task-id]
        (let [slots (vals (get-in replica [:task-slot-ids job-id task-id]))]
          (if (seq slots)
-           (let [kind (cond (some #{task-id} inputs) :input
-                            (some #{task-id} outputs) :output
-                            (some #{task-id} windows) :windows)]
-             (if kind
-               (assoc-in all [kind task-id] (apply max slots))
-               all))
+           (let [n-slots (apply max slots)]
+             (cond-> all
+               (some #{task-id} inputs)
+               (assoc-in [:input task-id] n-slots)
+               (some #{task-id} outputs)
+               (assoc-in [:output task-id] n-slots)
+               (some #{task-id} windows)
+               (assoc-in [:windows task-id] n-slots)))
            all)))
      {}
      tasks)))


Initialize circles with a radius

Initialize circles with a radius

--- src/play_clj/g2d_physics.clj
+++ src/play_clj/g2d_physics.clj
@@ -110,12 +110,16 @@
   `(u/call! ^ChainShape ~object ~k ~@options))

 (defn circle*
-  []
-  (CircleShape.))
+  ([]
+    (CircleShape.))
+  ([radius]
+    (doto (circle*)
+      (.setRadius radius)
+      (.setPosition (m/vector-2 radius radius)))))

 (defmacro circle
-  [& options]
-  `(u/calls! ^CircleShape (circle*) ~@options))
+  [radius & options]
+  `(u/calls! ^CircleShape (circle* ~radius) ~@options))

 (defmacro circle!
   [object k & options]


better docstring

better docstring

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

--- plugins/SlideExplorer2/src/slide_explorer/reactive.clj
+++ plugins/SlideExplorer2/src/slide_explorer/reactive.clj
@@ -70,8 +70,8 @@
   (update-in map [key] #(or % val)))

 (defn send-off-update
-  "Like send-off, but the function will only be run if the agent
-   is not piled up with tasks."
+  "Like send-off, but if the agent is piled up with tasks, then only
+   the most recent task will run (intermediate tasks will be skipped)."
   [a f & args]
   (alter-meta! a assoc-if-lacking ::task-ref (AtomicReference. nil))
   (let [task-ref (::task-ref (meta a))]


db/content.clj: put/get content as string/bytes

--- src/org/altlaw/db/content.clj
+++ src/org/altlaw/db/content.clj
@@ -1,5 +1,6 @@
 (ns org.altlaw.db.content
-  (:require [org.altlaw.util.s3 :as s3]))
+  (:require [org.altlaw.util.s3 :as s3])
+  (:import (org.apache.commons.codec.digest DigestUtils)))

 (def #^{:private true} *bucket* "content.altlaw.org")

@@ -11,3 +12,33 @@

 (defn get-page [path]
   (s3/get-object-string *bucket* (str "www/" path)))
+
+(defn put-content-string [content metadata]
+  (let [hash (DigestUtils/shaHex content)
+        key (str "sha1/" hash)]
+    (when-not (try (s3/get-object-meta *bucket* key)
+                   (catch Exception e nil))
+      (s3/put-object-gzip-string
+       *bucket* key content metadata))
+    hash))
+
+(defn put-content-bytes [content metadata]
+  (let [hash (DigestUtils/shaHex content)
+        key (str "sha1/" hash)]
+    (when-not (try (s3/get-object-meta *bucket* key)
+                   (catch Exception e nil))
+      (s3/put-object-gzip-bytes
+       *bucket* key content metadata))
+    hash))
+
+(defn get-content-string [hash]
+  (let [key (str "sha1/" hash)]
+    (s3/get-object-string *bucket* key)))
+
+(defn get-content-bytes [hash]
+  (let [key (str "sha1/" hash)]
+    (s3/get-object-bytes *bucket* key)))
+
+(defn delete-content [hash]
+  (let [key (str "sha1/" hash)]
+    (s3/delete-object *bucket* key)))


Added missing utils to simulation

Added missing utils to simulation

--- src/polismath/simulation.clj
+++ src/polismath/simulation.clj
@@ -1,5 +1,6 @@
 (ns polismath.simulation
-  (:use clj-time.coerce
+  (:use polismath.utils
+        clj-time.coerce
         clj-time.local))


added ClojureFormat to src/ccw/compile.clj

--- ccw.core/src/ccw/compile.clj
+++ ccw.core/src/ccw/compile.clj
@@ -7,5 +7,6 @@
       ['ccw.ClojureProjectNature
        'ccw.debug.clientrepl
        'ccw.debug.serverrepl
-       'ccw.editors.antlrbased.PareditAutoEditStrategy])))
+       'ccw.editors.antlrbased.PareditAutoEditStrategy
+       'ccw.editors.antlrbased.ClojureFormat])))


brought newer :vectorized instructions into root :vector type

--- src/push/type/item/vector.clj
+++ src/push/type/item/vector.clj
@@ -53,13 +53,14 @@
       (t/attach-instruction , vector-refilter)
       (t/attach-instruction , vector-refilterall)
       (t/attach-instruction , (v/x-butlast-instruction typename))
+      (t/attach-instruction , (v/x-byexample-instruction typename componentname))
       (t/attach-instruction , (v/x-concat-instruction typename))
       (t/attach-instruction , (v/x-conj-instruction typename componentname))
       (t/attach-instruction , (v/x-contains?-instruction typename componentname))
+      (t/attach-instruction , (v/x-distinct-instruction typename))
       (t/attach-instruction , (v/x-do*each-instruction typename))
       (t/attach-instruction , (v/x-emptyitem?-instruction typename))
       (t/attach-instruction , (v/x-first-instruction typename componentname))
-      (t/attach-instruction , (v/x-byexample-instruction typename componentname))
       (t/attach-instruction , (v/x-indexof-instruction typename componentname))
       (t/attach-instruction , (v/x-last-instruction typename componentname))
       (t/attach-instruction , (v/x-length-instruction typename))
@@ -67,6 +68,7 @@
       (t/attach-instruction , (v/x-nth-instruction typename componentname))
       (t/attach-instruction , (v/x-occurrencesof-instruction typename componentname))
       (t/attach-instruction , (v/x-portion-instruction typename))
+      (t/attach-instruction , (v/x-pt-crossover-instruction typename))
       (t/attach-instruction , (v/x-shatter-instruction typename componentname))
       (t/attach-instruction , (v/x-remove-instruction typename componentname))
       (t/attach-instruction , (v/x-replace-instruction typename componentname))
@@ -75,5 +77,9 @@
       (t/attach-instruction , (v/x-set-instruction typename componentname))
       (t/attach-instruction , (v/x-take-instruction typename))
       (t/attach-instruction , (v/x-reverse-instruction typename))
+      (t/attach-instruction , (v/x-vfilter-instruction typename))
+      (t/attach-instruction , (v/x-vremove-instruction typename))
+      (t/attach-instruction , (v/x-vsplit-instruction typename))
       )))

+


Remove unused functions in client

Remove unused functions in client

Missed these when deleting ops earlier

--- src/refactor_nrepl/client.clj
+++ src/refactor_nrepl/client.clj
@@ -150,36 +150,6 @@
   {:pre [ns name new-name]}
   (act-on-occurrences (partial rename-symbol-occurrence! name new-name)
                       :transport transport :ns ns :name name :clj-dir clj-dir))
-
-(defn find-referred
-  "Finds referred symbol in namespace.
-
-  Temporary as only needed for temporary performance tweak for remove requires in clj-refactor.el. Will be removed when refactor-nrepl based clean-ns is implemented"
-  [& {:keys [transport file referred]}]
-  {:pre [file referred]}
-  (let [tr (or transport @transp (reset! transp (connect)))
-        ns-string (slurp file)
-        result (->> {:op :refactor
-                     :ns-string ns-string
-                     :referred referred
-                     :refactor-fn "find-referred"}
-                    (nrepl-message tr)
-                    first
-                    :value
-                    (#(if (coll? %) (not-empty %) %)))]
-    (println (format "Referred %s is %s in %s" referred (if result "found" "not found") file))
-    result))
-
-(defn var-info [& {:keys [transport file name]}]
-  {:pre [file name]}
-  (let [tr (or transport @transp (reset! transp (connect)))
-        ns-string (slurp file)]
-    (-> (nrepl-message tr {:op :refactor
-                           :ns-string ns-string
-                           :refactor-fn "var-info"
-                           :name name})
-        first
-        :var-info)))

 (defn remove-debug-invocations
   "Removes debug function invocations. In reality it could remove any function


fix check-opts never lets setting :debug

reason being it throws illegal argument exception on value being false
on given key in opts map not only if key is missing from opts map

--- src/refactor_nrepl/config.clj
+++ src/refactor_nrepl/config.clj
@@ -16,6 +16,11 @@
   [key]
   (get @opts key))

+(defn contains-opt?
+  "Checks if key is present in the opts map."
+  [key]
+  (contains? @opts key))
+
 (defn- set-opts!
   "Sets the options for the current session."
   [m]
@@ -27,7 +32,7 @@
     (throw (IllegalArgumentException.
             (str "Options must be a map, got '" opts "'"))))
   (doseq [k (keys opts)]
-    (when-not (get-opt k)
+    (when-not (contains-opt? k)
       (throw (IllegalArgumentException.
               (str "Unknown key in config map: " k)))))
   opts)


Dispatched goroutine checks for pre-born condition.

--- src/rewindable/ago-macros.clj
+++ src/rewindable/ago-macros.clj
@@ -28,6 +28,7 @@
        (rewindable.ago/ago-reg-state-machine ~ago-world sma2# b#)
        (cljs.core.async.impl.dispatch/run
         (fn []
-          (rewindable.ago/ago-run-state-machine ~ago-world sma2# b#)
-          (cljs.core.async.impl.ioc-helpers/run-state-machine-wrapped sma2#)))
+          (when (rewindable.ago/segv-alive? ~ago-world (rewindable.ago/chan-segv c#))
+            (rewindable.ago/ago-run-state-machine ~ago-world sma2# b#)
+            (cljs.core.async.impl.ioc-helpers/run-state-machine-wrapped sma2#))))
        c#)))


log a warning when connection is closed

log a warning when connection is closed

--- src/riemann/transport/tcp.clj
+++ src/riemann/transport/tcp.clj
@@ -69,6 +69,8 @@
     (channelWritabilityChanged [^ChannelHandlerContext ctx]
       (let [channel (.channel ctx)]
         (when (not (.isWritable channel))
+          (warn "forcefully closing connection from " (.remoteAddress channel)
+                ". Client might be not reading acks fast enough or network is broken")
           (.close channel))))

     (channelRead [^ChannelHandlerContext ctx ^Object message]


Improve documentation

Improve documentation

--- src/rill/event_store/psql.clj
+++ src/rill/event_store/psql.clj
@@ -33,6 +33,11 @@
       (seq p) ;; make sure we return nil when no messages are found
       (concat p (lazy-seq (messages (:cursor (meta (last p))) page-size selector))))))

+(defn unique-violation?
+  "true when the exception was caused by a unique constraint violation"
+  [sql-exception]
+  (= (.getSQLState sql-exception) "23505"))
+
 (defrecord PsqlEventStore [spec page-size]
   EventStore
   (retrieve-events-since [this stream-id cursor wait-for-seconds]
@@ -66,9 +71,9 @@
                                events))
            true
            (catch java.sql.BatchUpdateException e
-             (when-not (= (.getSQLState e) "23505")
+             (when-not (unique-violation? e)
                (throw e))
-             false)))))
+             false))))) ;; conflict - there is already an event with the given stream_order

 (defn psql-event-store [spec & [{:keys [page-size] :or {page-size 20}}]]
   {:pre [(integer? page-size)]}


Add * pattern match tests

Add * pattern match tests

--- src/chapter3/match.cljs
+++ src/chapter3/match.cljs
@@ -35,6 +35,13 @@
 (defn function-pattern-match-test [match]
   (is (= {'x 1 'y 2} (match '((chapter3.match/=1? x) (? y) 3) '(1 2 3))))
   (is (not (match '((chapter3.match/=1? x) 2 3) '(2 2 3)))))
+(defn star-pattern-match-test [match]
+  (is (= {'x '(the whole thing)} (match '((* x)) '(the whole thing))))
+  (is (= {'x '(whole thing) 'y 'the} (match '((? y) (* x)) '(the whole thing))))
+  (is (not (match '(this (* x)) '(the whole thing))))
+  (is (= {'x '(thing) 'y 'whole} (match '(the (? y) (* x)) '(the whole thing))))
+  (is (= {'x '()} (match '(the whole thing (* x)) '(the whole thing))))
+  (is (not (match '(the (chapter3.match/=1? y) thing (* x)) '(the whole thing)))))

 (with-test
   (defn match2 [p s]
@@ -166,8 +173,9 @@
     (if (match-helper p s) @variables false))
   (basic-match-test match)
   (basic-pattern-match-test match)
-  (is (not (match '(1 (2) 3) '(1 (2) 3))))
-  (function-pattern-match-test match))
+  (is (not (match '(1 (2) 3) '(1 (2) 3))) "malformed pattern")
+  (function-pattern-match-test match)
+  (star-pattern-match-test match))
 (defn match-state
   "Note: ClojureScript doesn't have resolve so arbitrary predicates won't work there."
   [p s]


Fix tests

Fix tests

--- src/spec_tools/data_spec.cljc
+++ src/spec_tools/data_spec.cljc
@@ -97,7 +97,7 @@
 (defn maybe? [x]
   (instance? Maybe x))

-(declare to-spec)
+(declare spec)

 (defn- -map-spec [n data]
   ;; predicate keys


working towards signals supplying recipes to build the part of the world they need

--- src/cljx/jamesmacaulay/async_tools/signals.cljx
+++ src/cljx/jamesmacaulay/async_tools/signals.cljx
@@ -49,7 +49,7 @@
   [x]
   (satisfies? SignalProtocol x))

-(defn- subscribed-topics-message-emitter
+(defn- relayed-events-message-emitter
   [topics]
   (let [topics (if (set? topics) topics (set topics))]
     (fn [prev event]
@@ -58,18 +58,20 @@
         (->Cached (:value prev))))))

 (defrecord Signal
-  [init message-emitter subscribed-topics event-emitter external-event-source]
+  [init message-emitter relayed-events deps event-sources]
   SignalProtocol
   (sources [_]
-    (into #{}
-          (comp (filter identity)
-                (mapcat (comp flatten vector first))
-                (filter signal?))
-          [message-emitter event-emitter]))
+    (or deps
+        (->> message-emitter
+             first
+             vector
+             flatten
+             (filter signal?)
+             (into #{}))))
   (message-emitter [_]
     (cond
       message-emitter message-emitter
-      subscribed-topics [:events (subscribed-topics-message-emitter subscribed-topics)])))
+      relayed-events [:events (relayed-events-message-emitter relayed-events)])))

 (defn- messages-from-events
   [topic]
@@ -82,7 +84,7 @@
   ([init] (input init (gen-topic)))
   ([init topic]
    (map->Signal {:init init
-                 :subscribed-topics #{topic}})))
+                 :relayed-events #{topic}})))

 (defn constant
   [x]
@@ -140,12 +142,17 @@

 (defn async
   [source]
-  (let [topic source]
+  (let [topic source
+        msgs->events (comp (filter fresh?)
+                           (map (fn [msg]
+                                  (->Event topic (:value msg)))))
+        events-channel-fn (fn [live-graph _]
+                            (async/tap (get (:mult-map live-graph) source)
+                                       (chan 1 msgs->events)))]
     (map->Signal {:init (:init source)
-                  :event-emitter [source (fn [message]
-                                           (when (fresh? message)
-                                             (:value message)))]
-                  :subscribed-topics #{topic}})))
+                  :deps #{source}
+                  :event-sources {topic events-channel-fn}
+                  :relayed-events #{topic}})))

 (defn mergeseq
   [sigs]


* src/cljs/cljs/core.cljs: use sugared property access in apply

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1335,8 +1335,8 @@
   "Applies fn f to the argument list formed by prepending intervening arguments to args.
   First cut.  Not lazy.  Needs to use emitted toApply."
   ([f args]
-     (let [fixed-arity (. f -cljs$lang$maxFixedArity)]
-       (if (. f -cljs$lang$applyTo)
+     (let [fixed-arity (.-cljs$lang$maxFixedArity f)]
+       (if (.-cljs$lang$applyTo f)
          (if (<= (bounded-count args (inc fixed-arity))
                  fixed-arity)
            (.apply f f (to-array args))
@@ -1344,8 +1344,8 @@
          (.apply f f (to-array args)))))
   ([f x args]
      (let [arglist (list* x args)
-           fixed-arity (. f -cljs$lang$maxFixedArity)]
-       (if (. f -cljs$lang$applyTo)
+           fixed-arity (.-cljs$lang$maxFixedArity f)]
+       (if (.-cljs$lang$applyTo f)
          (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
            (.apply f f (to-array arglist))
@@ -1353,8 +1353,8 @@
          (.apply f f (to-array arglist)))))
   ([f x y args]
      (let [arglist (list* x y args)
-           fixed-arity (. f -cljs$lang$maxFixedArity)]
-       (if (. f -cljs$lang$applyTo)
+           fixed-arity (.-cljs$lang$maxFixedArity f)]
+       (if (.-cljs$lang$applyTo f)
          (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
            (.apply f f (to-array arglist))
@@ -1362,8 +1362,8 @@
          (.apply f f (to-array arglist)))))
   ([f x y z args]
      (let [arglist (list* x y z args)
-           fixed-arity (. f -cljs$lang$maxFixedArity)]
-       (if (. f -cljs$lang$applyTo)
+           fixed-arity (.-cljs$lang$maxFixedArity f)]
+       (if (.-cljs$lang$applyTo f)
          (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
            (.apply f f (to-array arglist))
@@ -1371,8 +1371,8 @@
          (.apply f f (to-array arglist)))))
   ([f a b c d & args]
      (let [arglist (cons a (cons b (cons c (cons d (spread args)))))
-           fixed-arity (. f -cljs$lang$maxFixedArity)]
-       (if (. f -cljs$lang$applyTo)
+           fixed-arity (.-cljs$lang$maxFixedArity f)]
+       (if (.-cljs$lang$applyTo f)
          (if (<= (bounded-count arglist fixed-arity)
                  fixed-arity)
            (.apply f f (to-array arglist))


Add nthrest

Add nthrest

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1185,6 +1185,14 @@
       :else
       (throw (js/Error. (str "nth not supported on this type "
                           (type->str (type coll))))))))
+
+(defn nthrest
+  "Returns the nth rest of coll, coll when n is 0."
+  [coll n]
+    (loop [n n xs coll]
+      (if (and (pos? n) (seq xs))
+        (recur (dec n) (rest xs))
+        xs)))

 (defn get
   "Returns the value mapped to key, not-found or nil if key not present."


Remove ugly mock

Remove ugly mock

--- src/cljs/shop/core.cljs
+++ src/cljs/shop/core.cljs
@@ -96,18 +96,6 @@
     {:form-params {"Query" (str "query:" q), "Page" 1
                     "PageSize" 20, "RefinementSize" 5
                     "Sort" 2, "Heavy" false}}))
-
-;; ;; One ugly mock
-;; (defn ^:export search [q]
-;;   (go (js->clj
-;;         (.parse js/JSON
-;;           (:body
-;;            (<!
-;;              (http/post "http://localhost:8000/search"
-;;                {:form-params {"Query" (str "query:" "eggs"), "Page" 1
-;;                               "PageSize" 20, "RefinementSize" 5
-;;                               "Sort" 2, "Heavy" false}}))))
-;;         :keywordize-keys true)))

 ;; ──────────────────────────────────────────────────────────────────────
 ;; state


Fix hang at startup with release build

Fix hang at startup with release build

--- src/status_im/node/core.cljs
+++ src/status_im/node/core.cljs
@@ -23,6 +23,7 @@
 (defn- add-log-level [config log-level]
   (if (empty? log-level)
     (assoc config
+           :LogLevel "ERROR"
            :LogEnabled false)
     (assoc config
            :LogLevel log-level


Use 1 less go block in dynamic translation

--- src/tranjlator/chat_room.clj
+++ src/tranjlator/chat_room.clj
@@ -72,18 +72,19 @@

 (defn send-translation-history
   [chan history translator]
-  (go (let [token (<! (p/token translator))]
-        (doseq [h history]
-          (go (let [[translation orig-sha trans-sha] (<! (p/translate translator
-                                                                      (:content h)
-                                                                      (:language h)
-                                                                      token))]
-                (>! chan (msg/->translation (:language translator)
-                                            translation
-                                            (xlate/sha-hex orig-sha)
-                                            (xlate/sha-hex trans-sha)
-                                            (:user-name h)))
-                (log/infof "XLATE HISTORY: %s" translation)))))))
+  (let [token (promise)]
+    (a/take! (p/token translator) #(deliver token %))
+    (doseq [h history]
+      (go (let [[translation orig-sha trans-sha] (<! (p/translate translator
+                                                                  (:content h)
+                                                                  (:language h)
+                                                                  @token))]
+            (>! chan (msg/->translation (:language translator)
+                                        translation
+                                        (xlate/sha-hex orig-sha)
+                                        (xlate/sha-hex trans-sha)
+                                        (:user-name h)))
+            (log/infof "XLATE HISTORY: %s" translation))))))

 (defrecord ChatRoom
     [initial-users initial-history pub-chan process-chan mock-translator? db]


Performance tweak

Performance tweak

--- src/wireframes/transform.clj
+++ src/wireframes/transform.clj
@@ -70,9 +70,14 @@
   (reduce + (mapv * as bs)))

 (defn transform-point [matrix]
-  (fn [[^double ax ^double ay ^double az ^double aw]]
+  (fn [[ax ay az aw]]
     (mapv
-      (fn [[^double bx ^double by ^double bz ^double bw]] (+ (* ax bx) (* ay by) (* az bz) (* aw bw)))
+      (fn [[bx by bz bw]]
+        (+
+          (* (double ax) (double bx))
+          (* (double ay) (double by))
+          (* (double az) (double bz))
+          (* (double aw) (double bw))))
       matrix)))

 (defn transpose [matrix]


fix with reverse

fix with reverse

--- ohack/src/ohack/core.clj
+++ ohack/src/ohack/core.clj
@@ -281,7 +281,8 @@
                           ;; map over each line in the line-set, with string index
                           (apply
                            merge-with concat
-                           (for [[string-index tab-line] (map-indexed vector line-set)]
+                           ;; note the reverse
+                           (for [[string-index tab-line] (map-indexed vector (reverse line-set))]
                              ;; now we need to parse the tab-line...
                              ;; collect each string's results into into {}
                              (into {}


Reduce player size when browsing homepage

--- src/reddio_frontend/screens/player/player.cljs
+++ src/reddio_frontend/screens/player/player.cljs
@@ -3,6 +3,11 @@
             [re-frame.core :as rf]
             [reddio-frontend.bridge :as bridge]
             [reddio-frontend.components.icons :as icons]))
+
+(def WIDTH 640)
+(def HEIGHT 360)
+(def COMPACT_WIDTH 320)
+(def COMPACT_HEIGHT 180)

 (def react-player-adapter (r/adapt-react-class bridge/react-player))

@@ -35,14 +40,18 @@
 (defn main []
   (let [current-post @(rf/subscribe [:post])
         player-state @(rf/subscribe [:player-state])
+        route @(rf/subscribe [:route])
         initialized (not (nil? current-post))
-        playing (not= player-state :paused)]
+        playing (not= player-state :paused)
+        compact? (= route "/")]
     [:div
      [:div.player
       [main-controls current-post player-state]]
      (when initialized
        [:div.iframe
         (let [data {:url (:url current-post)
+                    :width (if compact? COMPACT_WIDTH WIDTH)
+                    :height (if compact? COMPACT_HEIGHT HEIGHT)
                     :controls true
                     :playing playing
                     :on-ready #(rf/dispatch [:player-ready])


Another docstring fix

Another docstring fix

--- src/grafter/tabular.clj
+++ src/grafter/tabular.clj
@@ -22,7 +22,7 @@

-(defn test-dataset [r c]
+(defn test-dataset
   "Constructs a test dataset of r rows by c cols e.g.

 (test-dataset 2 2) ;; =>
@@ -31,7 +31,7 @@
 |---+---|
 | 0 | 0 |
 | 1 | 1 |"
-
+  [r c]
   (->> (iterate inc 0)
        (map #(repeat c %))
        (take r)


Don't care if it's a leaf for thing->name anymore

--- src/grimoire/things.clj
+++ src/grimoire/things.clj
@@ -164,8 +164,7 @@
   "Function from an object to Maybe[String]. If the input is a thing, returns
   the name of the Thing. Otherwise returns nil."
   [t]
-  {:pre [(thing? t)
-         (not (leaf? t))]}
+  {:pre [(thing? t)]}
   (:name t))

 ;; Helpers for stringifying and reading paths


remove obsolete comment

remove obsolete comment

--- src/me/panzoo/story.clj
+++ src/me/panzoo/story.clj
@@ -106,10 +106,6 @@
 ; the language argument to an include directive is preferrable to explicitly
 ; listing brushes on the commandline or in a program that calls this one.
 ; Comment syntax is listed here too for the same reason.
-;
-; Some languages are commented out because they either do not have comments or
-; because they only have block comments. Their dull lifeless forms remind the
-; maintainer of this program to do something about that.
 ;
 ; Don't use `languages` and `language-aliases` directly. Use [[lang-info]],
 ; [[lang-brush]], and [[lang-comment]] instead. Those three functions route


draw coordinate axes

draw coordinate axes

--- src/minkowski/core.cljs
+++ src/minkowski/core.cljs
@@ -46,19 +46,38 @@
 (.addEventListener js/window "resize" window-resized)
 (window-resized)

+(defn draw-coordinates []
+  (do
+    (.save drawing)
+    (aset drawing "strokeStyle" "#dddddd")
+    (aset drawing "lineWidth" 1)
+    (.beginPath drawing)
+    (let [[x y] (canvas-point [-10 0])] (.moveTo drawing x y))
+    (let [[x y] (canvas-point [10 0])] (.lineTo drawing x y))
+    (.closePath drawing)
+    (.stroke drawing)
+    (.beginPath drawing)
+    (let [[x y] (canvas-point [0 -10])] (.moveTo drawing x y))
+    (let [[x y] (canvas-point [0 10])] (.lineTo drawing x y))
+    (.closePath drawing)
+    (.stroke drawing)
+    (.restore drawing)))
+
 (defn draw-circle [circle]
   (do
+    (.save drawing)
     (.beginPath drawing)
     (doall (for [point circle] (let [[x y] (canvas-point point)] (.lineTo drawing x y))))
     (.closePath drawing)
     (.setLineDash drawing (array 3 5))
     (aset drawing "strokeStyle" "gray")
     (.stroke drawing)
-  ))
+    (.restore drawing)))

 (defn draw-scene []
   (do
     (.clearRect drawing 0 0 (aget canvas "width") (aget canvas "height"))
+    (draw-coordinates)
     (doall (for [circle circles] (draw-circle circle)))))

 (defn request-frame []


Revert "RS | #0 | wrap-ssl-redirect"

Revert "RS | #0 | wrap-ssl-redirect"

This reverts commit 58d4c0b98e36dc6673d36040a0b2fffd394f9e7f.

--- src/objective8/core.clj
+++ src/objective8/core.clj
@@ -102,9 +102,9 @@
       (wrap-xss-protection true {:mode :block})
       (wrap-frame-options :sameorigin)

-      ((if (config/get-var "ENABLE_HTTPS_ONLY")
+      (#(if (config/get-var "ENABLE_HTTPS_ONLY")
          wrap-ssl-redirect
-         identity))))
+         %))))

 (defonce server (atom nil))
 (defonce scheduler (atom nil))


Mess with type annotations some more

Mess with type annotations some more

--- src/robinson/common.clj
+++ src/robinson/common.clj
@@ -26,7 +26,7 @@
        result#)))

 (t/ann log-io (t/All [a x y ...]
-                [String [(t/U (t/EmptySeqable a) (t/HSeq (y ... y))) -> x] -> [(t/U (t/EmptySeqable a) (t/HSeq (y ... y))) -> x]]))
+                [String [(t/U t/EmptySeqable (t/HSeq (y ... y))) -> x] -> [(t/U t/EmptySeqable (t/HSeq (y ... y))) -> x]]))
 (defn log-io
   "Log function inputs and outputs by wrapping an function f."
   [msg f]
@@ -108,12 +108,12 @@
                                   [Float -> Float]
                                   [Integer -> Integer]
                                   [Long -> Long]))
-(t/ann chebyshev-distance [Pos Pos -> Integer])
+(t/ann chebyshev-distance [Pos Pos -> Long])
 (defn chebyshev-distance
   "Chebyshev/chessboard distance between 2 points"
   [p1 p2]
-  (max (Math/abs (- (get p1 :x) (get p2 :x)))
-       (Math/abs (- (get p1 :y) (get p2 :y)))))
+  (max (Math/abs (long (- (get p1 :x) (get p2 :x))))
+       (Math/abs (long (- (get p1 :y) (get p2 :y))))))

 (t/ann distance-sq [Pos Pos -> t/AnyInteger])
 (defn distance-sq
@@ -175,8 +175,11 @@
                             (cons (f x y) (if (empty? xs) [] (fill-missing pred f ys xs)))
                             (cons x (if (empty? xs) [] (fill-missing pred f vcoll xs)))))))

-(t/ann fn-in (t/All[x y]
-               [[t/Any x -> t/Any] y (t/Vec t/Any) x -> y]))
+(t/ann ^:no-check clojure.core/update-in (t/All [x [y :< (clojure.lang.Associative t/Any t/Any)]]
+                                           [y (t/Seqable t/Any) [t/Any -> t/Any] -> y]))
+(t/ann fn-in (t/All [x
+                     [y :< (clojure.lang.Associative t/Any t/Any)]]
+               [[t/Any x -> t/Any] y (t/Seqable t/Any) x -> y]))
 (defn fn-in
   "Applies a function to a value in a nested associative structure and an input value.
    ks sequence of keys and v is the second arguement to f. The nested value will be
@@ -184,20 +187,20 @@
   [f m ks v]
   (update-in m ks (fn [coll] (f coll v))))

-(t/ann concat-in (t/All [x]
-                   [x (t/Vec t/Any) t/Any -> x]))
+(t/ann concat-in (t/All [[x :< (clojure.lang.Associative t/Any t/Any)]]
+                   [x (t/Seqable t/Any) (t/Seqable t/Any) -> x]))
 (defn concat-in
   [m ks v]
   (fn-in concat m ks v))

 (t/ann conj-in (t/All [x]
-                 (t/IFn [x (t/Vec t/Any) t/Any -> x])))
+                 (t/IFn [x (clojure.lang.Associative t/Any t/Any) t/Any -> x])))
 (defn conj-in
   [m ks v]
   (fn-in conj m ks v))

 (t/ann map-in (t/All [x]
-                [x (t/Vec t/Any) [t/Any -> t/Any] -> x]))
+                [x (clojure.lang.Associative t/Any t/Any) [t/Any -> t/Any] -> x]))
 (defn map-in
   [m ks f]
   (fn-in (fn [coll _] (if (vector? coll)
@@ -206,8 +209,8 @@
          m ks nil))

 (t/ann reduce-in (t/All [x]
-                   (t/IFn [x (t/Vec t/Any) (t/IFn [t/Any -> t/Any]) -> x]
-                         [x (t/Vec t/Any) (t/IFn [t/Any -> t/Any]) t/Any -> x])))
+                   (t/IFn [x (clojure.lang.Associative t/Any t/Any) (t/IFn [t/Any -> t/Any]) -> x]
+                          [x (clojure.lang.Associative t/Any t/Any) (t/IFn [t/Any -> t/Any]) t/Any -> x])))
 (defn reduce-in
   "Reduce a value inside an associative datastructure. `more` can be either
   a reducing function, a reducting function and an initial value."
@@ -217,7 +220,7 @@
    (update-in m ks (fn [coll] (reduce f v coll)))))

 (t/ann filter-in (t/All [x]
-                   (t/IFn [x (t/Vec t/Any) (t/IFn [t/Any -> t/Any]) -> x])))
+                   (t/IFn [x (clojure.lang.Associative t/Any t/Any) (t/IFn [t/Any -> t/Any]) -> x])))
 (defn filter-in
   [m ks f]
   (fn-in (fn [coll _] (if (vector? coll)
@@ -225,7 +228,7 @@
                         (filter f coll))) m ks nil))

 (t/ann remove-in (t/All [x]
-                   [x (t/Vec t/Any) [t/Any -> t/Any] -> x]))
+                   [x (clojure.lang.Associative t/Any t/Any) [t/Any -> t/Any] -> x]))
 (defn remove-in
   [m ks f]
   (fn-in (fn [coll _] (if (vector? coll)
@@ -233,7 +236,7 @@
                         (remove f coll))) m ks nil))

 (t/ann some-in (t/All [x]
-                 (t/IFn [x (t/Vec t/Any) (t/IFn [t/Any -> t/Any]) -> x])))
+                 (t/IFn [x (clojure.lang.Associative t/Any t/Any) (t/IFn [t/Any -> t/Any]) -> x])))
 (defn some-in
   [m ks f]
   (fn-in (fn [coll _] (if (vector? coll)
@@ -241,7 +244,7 @@
                         (some f coll))) m ks nil))

 (t/ann update-in-matching (t/All [a b]
-                            (t/IFn [a (t/Vec t/Any) (t/IFn [b -> Boolean]) (t/IFn [b -> t/Any]) -> a])))
+                            (t/IFn [a (clojure.lang.Associative t/Any t/Any) (t/IFn [b -> Boolean]) (t/IFn [b -> t/Any]) -> a])))
 (defn update-in-matching
   [m ks p f]
   (if (fn? p)


Revert update of Austin.

Revert update of Austin.

--- profiles.clj
+++ profiles.clj
@@ -26,7 +26,7 @@
         :dependencies [[ring "1.2.1"]
                        [compojure "1.1.6"]
                        [enlive "1.1.5"]]
-        :plugins [[com.cemerick/austin "0.1.5-SNAPSHOT"]]
+        :plugins [[com.cemerick/austin "0.1.4"]]

         :cljsbuild
         {:builds {:beatha


Add missing update-image service.

Add missing update-image service.

--- src/uxbox/services/images.clj
+++ src/uxbox/services/images.clj
@@ -101,8 +101,8 @@
                                 :path path
                                 :collection collection
                                 :user user})]
-    (->> (sc/fetch conn sqlv)
-         (map usc/normalize-attrs))))
+    (some-> (sc/fetch-one conn sqlv)
+            (usc/normalize-attrs))))

 (def ^:private create-image-schema
   {:id [us/uuid]
@@ -114,12 +114,25 @@
   (->> (validate! params create-image-schema)
        (create-image conn)))

-;; --- Update Image.
+;; --- Update Image

 (defn update-image
   [conn {:keys [id name version]}]
+  (let [sqlv (sql/update-image {:id id :name name :version version})]
+    (some-> (sc/fetch-one conn sqlv)
+            (usc/normalize-attrs))))

-;; --- Delete Image.
+(def ^:private update-image-schema
+  {:id [us/uuid]
+   :user [us/required us/uuid]
+   :file [us/required us/uploaded-file]})
+
+(defmethod usc/-novelty :update/image
+  [conn params]
+  (->> (validate! params update-image-schema)
+       (update-image conn)))
+
+;; --- Delete Image

 (defn delete-image
   [conn {:keys [user id]}]


Fix wrong name

Fix wrong name

--- src/sql_walker/core.clj
+++ src/sql_walker/core.clj
@@ -66,13 +66,12 @@
 "           ) PT"
 "    ON PT.TABLE_NAME = PK.TABLE_NAME"))

+
 (defn query-get-constraints
   [t]
   (qm (str
-      query-get-foreign-key-sql
+      query-get-foreign-keys-sql
       " WHERE FK.TABLE_NAME = '" t "'")))
-
-

 (defn query-get-primary-key
   [t]


small dry

small dry

--- server/src/gratefulplace/db/transactions.clj
+++ server/src/gratefulplace/db/transactions.clj
@@ -7,7 +7,7 @@
   [params]
   (let [{:keys [topic-id author-id]} params
         post-tempid (d/tempid :db.part/user -1)
-        now (java.util.Date.)
+        now (now)
         post (remove-nils-from-map {:post/content (:content params)
                                     :post/topic topic-id
                                     :post/created-at now
@@ -37,7 +37,7 @@
               :db/id post-tempid}]

     {:result (db/t [topic post])
-     :topic-tempid topic-tempid}))
+     :tempid topic-tempid}))

 (defn reset-watch-count
   [topic user]


Vertical motion

Vertical motion

--- src/try_lwjgl/logic.clj
+++ src/try_lwjgl/logic.clj
@@ -7,6 +7,7 @@
 (def player-position (atom [(float 0.0) (float 1.0) (float 10.0)]))
 (def player-direction (atom [(float 0.0) (float 0.0) (float 0.0)]))
 (def show-player? (atom false))
+(def keys-down-at {})

 (defn inc-angle []
   (swap! angle #(+ % @angle-speed)))
@@ -78,6 +79,9 @@
 (defn move-forward [amount]
   (move @player-direction amount))

+(defn move-vertical [amount]
+  (swap! player-position (fn [pp] (assoc pp 1 (+ (pp 1) amount)))))
+
 (def mouse-sensitivity 0.002)

 (defn handle-mouse []
@@ -99,12 +103,6 @@
     (move-fn key)
     (if-not @key-down-at (swap! key-down-at (fn [_] (System/currentTimeMillis))))))

-(def keys-down-at
-  {:a (atom nil)
-   :d (atom nil)
-   :w (atom nil)
-   :s (atom nil)})
-
 (defn event-move [key event move-fn]
   (let [key-down-at (keys-down-at key)]
     (handle-movement-key-up key event key-down-at)
@@ -116,17 +114,28 @@
 (defn event-move-forward [key event]
   (event-move key event (fn [key] (move-forward (key {:w 0.1 :s -0.1})))))

+(defn event-move-vertical [key event]
+  (event-move key event (fn [key] (move-vertical (key {:space 0.1 :lshift -0.1})))))
+
+(defn events-by-key [events]
+  (reduce (fn [m event] (assoc m (event :key) event))
+          {} events))
+
 (def key-listeners
   {:w event-move-forward
    :s event-move-forward
    :a strife
    :d strife
    :1 (fn [key event] (when (and event (event :down?) (not (event :repeat?)))
-                        (swap! show-player? #(not %))))})
+                        (swap! show-player? #(not %))))
+   :space event-move-vertical
+   :lshift event-move-vertical})

-(defn events-by-key [events]
-  (reduce (fn [m event] (assoc m (event :key) event))
-          {} events))
+(def keys-down-at
+  "Maps keyboard key to timestamp atom: {:keyboard-key (atom nil)}"
+  (reduce (fn [m key] (assoc m key (atom nil)))
+          {}
+          (keys key-listeners)))

 (defn handle-keyboard []
   (let [events (input/collect-key-events)


log errors from bulk submitted items

log errors from bulk submitted items

--- src/wb_es/bulk/core.clj
+++ src/wb_es/bulk/core.clj
@@ -67,7 +67,9 @@
                      (let [status (:status body)]
                        (cond
                         (< status 300) (update result :success inc)
-                        :else (update result :error inc))))
+                        :else (do
+                                (error body)
+                                (update result :error inc)))))
                    {:success 0 :error 0})
            ))))


JSONマップをキーワード化

JSONマップをキーワード化

--- src/webexample/core.clj
+++ src/webexample/core.clj
@@ -13,12 +13,11 @@

 ;;; utilities

-(defn as-json [obj]
+(defn as-json [obj & options]
   (condp instance? obj
-    String (json/read-str obj)
-    java.io.InputStream (json/read (io/reader obj))
-    java.io.Reader (json/read (io/reader obj))
-    obj))
+    String (apply json/read-str obj options)
+    java.io.InputStream (apply json/read (io/reader obj) options)
+    java.io.Reader (apply json/read (io/reader obj) options)))

 ;;; services

@@ -26,7 +25,7 @@

 (defroutes task-service
   (ANY "/task" {:keys [request-method db body]}
-       (let [data (when (= request-method :post) (as-json body))
+       (let [data (when (= request-method :post) (as-json body :key-fn keyword))
              new-id (when (= request-method :post)
                       (let [r (next-task-id db)]
                         (or (:newid (first r)) 0)))]
@@ -36,17 +35,17 @@
            :available-media-types ["application/json"]
            :handle-ok (list-tasks db)
            :handle-malformed (pr-str data)
-           :post! (fn [ctx] (new-task! db new-id (get data "title")))
+           :post! (fn [ctx] (new-task! db new-id (:title data)))
            :handle-created {:id new-id})))

   (ANY "/task/:id" [id :as {:keys [request-method db body]}]
-       (let [data (when (= request-method :put) (as-json body))]
+       (let [data (when (= request-method :put) (as-json body :key-fn keyword))]
          (resource
            :allowed-methods [:get :put :delete]
            :available-media-types ["application/json"]
            :malformed? (and (= request-method :put) (nil? data))
            :handle-ok (fn [_] (first (get-task db)))
-           :put!  (fn [_] (update-task! db (get data "title") id))
+           :put!  (fn [_] (update-task! db (:title data) id))
            :new? false
            :delete! (fn [_] (delete-task! db id))))))