Remove more clisk

Remove more clisk

--- src/cljx/robinson/worldgen.cljx
+++ src/cljx/robinson/worldgen.cljx
@@ -45,6 +45,25 @@

 ;; noise utils
 (defn invert [s] (+ 1 (* -1 s)))
+
+(defn wrap-constant
+  [c]
+  (fn [& _]
+    (constantly c)))
+
+(defn wrap-arg
+  [xy-or-fn]
+  (cond
+    (vector? xy-or-fn)
+      (wrap-constant xy-or-fn)
+    (fn? xy-or-fn)
+      xy-or-fn))
+
+
+;(defmacro defnv
+;  [s expr]
+;  (let [args] (repeat ...
+;  `(defn ~s ~args

 (defn offset
   [xy-or-fn f]
@@ -204,45 +223,39 @@
 (defn sample-island
   [noise]
   (cliskf/vectorize
-    (cliskf/vlet [c  (center (invert (cliskf/offset (cliskf/scale 0.43 (cliskf/v* [0.5 0.5 0.5] cliskp/vsnoise)) cliskf/radius)))
-                  c1 (cliskf/offset [0.5 0.5] (cliskf/v+ [-0.5 -0.5 -0.5] (cliskf/scale 0.06 cliskp/noise)))
-                  c2 (cliskf/offset [-0.5 -0.5] (cliskf/v+ [-0.5 -0.5 -0.5] (cliskf/scale 0.08 cliskp/noise)))]
-      (vcond
+    (cliskf/vlet [c  (center (invert (offset (scale 0.43 (v* [0.5 0.5 0.5] (vsnoise noise) (distance))))))
+                  c1 (offset [0.5 0.5] (v+ [-0.5 -0.5 -0.5] (scale 0.06 noise)))
+                  c2 (offset [-0.5 -0.5] (v+ [-0.5 -0.5 -0.5] (scale 0.08 noise)))]
+      (cond
         ;; interior biomes
-        (cliskf/v+ [-0.55 -0.55 -0.55]  c)
-          (vcond
-            (vand c1 c2 (v> c1 c2))
+        (> -0.55  c)
+          (cond
+            (and (pos? c1) (pos? c2) (> c1 c2))
             ;; interior jungle
             jungle
-            (vand c1 c2)
+            (and (pos? c1) (pos? c2))
             heavy-forest
-            (vand c1 (vnot c2) (v> c1 c2))
+            (and (pos? c1) (neg? c2) (> c1 c2))
             light-forest
-            (vand c1 (vnot c2))
+            (and (pos? c1) (neg? c2))
             bamboo-grove
-            (vand (vnot c1) c2 (v> c1 c2))
+            (and (neg? c1) (pos? c2) (v> c1 c2))
             meadow
-            (vand (vnot c1) c2)
+            (and (neg? c1) (pos? c2))
             rocky
-            (vand (vnot c1) (vnot c2) (v> c1 c2))
+            (and (neg? c1) (neg? c2) (> c1 c2))
             swamp
-            (vnot (vand c1 c2))
+            :else
             dirt)
         ;; shore/yellow
-        (cliskf/v+ [-0.5 -0.5 -0.5]  c)
+        (> -0.5  c)
             sand
         ;; surf/light blue
-        (cliskf/v+ [-0.42 -0.42 -0.42]  c)
+        (> -0.42 c)
           surf
         ;; else ocean
-        [1 1 1]
+        :else
           ocean))))
-
-(def tree-fns
-  (vec (map cliskn/compile-fn (:nodes tree-node))))
-
-(def island-fns
-  (vec (map cliskn/compile-fn (:nodes island-node))))

 (defn find-starting-pos [seed max-x max-y]
   (let [angle (dg/rand-nth (range (* 2 Math/PI)))


Improve code layout in loggers.

Improve code layout in loggers.

--- src/re_frame/loggers.cljs
+++ src/re_frame/loggers.cljs
@@ -2,17 +2,16 @@
   (:require
     [clojure.set :refer [difference]]))

-;;
+;; "loggers" holds the current set of logging functions.
 ;; By default, re-frame uses the functions provided by js/console.
 ;; Use set-loggers! to change these defaults.
-;;

-;; holds the current set of loggin functions.
-(def loggers (atom {:log       (js/console.log.bind   js/console)
-                    :warn      (js/console.warn.bind  js/console)
-                    :error     (js/console.error.bind js/console)
-                    :group     (if (.-group js/console) (js/console.group.bind js/console) default-log)  ;; group does not exist  < IE 11
-                    :groupEnd  (if (.-groupEnd js/console) (js/console.groupEnd.bind js/console) #())}))  ;; groupEnd does not exist  < IE 11
+(def loggers
+  (atom {:log       (js/console.log.bind   js/console)
+         :warn      (js/console.warn.bind  js/console)
+         :error     (js/console.error.bind js/console)
+         :group     (if (.-group js/console) (js/console.group.bind js/console) default-log)   ;; console.group does not exist  < IE 11
+         :groupEnd  (if (.-groupEnd js/console) (js/console.groupEnd.bind js/console) #())}))  ;; console.groupEnd does not exist  < IE 11

 (defn log      [& args] (apply (:log @loggers)      args))


updated the payment plan to use the more obfuscated show-upsell rather than raw plan info in $s

--- src-cljs/frontend/components/add_projects.cljs
+++ src-cljs/frontend/components/add_projects.cljs
@@ -406,14 +406,13 @@
                          :selected-org selected-org
                          :settings settings})
         [:hr]
-         ;; This is a chain to get the organization that the user has clicked on and whether this use is the first follower.
-         ;; The process is to combine the user with the users organizations (since the use is a org), and then filter
-         ;; down to the selected org and create a map of the org's name and whether or not this user is the first follower.
+         ;; This is a chain to get the organization that the user has clicked on and whether or not to show a payment plan upsell.
+         ;; The logic is if the user clicked on themselves as the org, or if the api returns show-upsell? as true with the org, then
+         ;; show the payment plan.
          (let [org (->> user
                          :organizations
-                         (cons user)
-                         (map #(when (= (:login %) selected-org) {:selected-org (:login %) :first-follower? (:first-follower? %)}))
+                         (map #(when (= (:login %) selected-org) {:selected-org (:login %) :show-upsell? (:show_upsell? %)}))
                          (filter some?)
                          (first))]
-           (if true;;(:first-follower? org)
+           (if (or (= selected-org (:login user)) (:show-upsell? org))
              (om/build payment-plan org)))]]]])))


Typo: "soonas" -> "soon as"

Typo: "soonas" -> "soon as"

--- src-cljs/frontend/components/build_config.cljs
+++ src-cljs/frontend/components/build_config.cljs
@@ -72,7 +72,7 @@
              (when-not (:lethal config)
                (if (:failed build)
                  " These may be causing your build to fail! We recommend that you fix them as soon as possible."
-                 " These may lead to unexpected behavior and may cause your build to fail soon. We recommend that you fix them as soonas possible."))]
+                 " These may lead to unexpected behavior and may cause your build to fail soon. We recommend that you fix them as soon as possible."))]
             [:p
              "You may want to look at "
              [:a {:href "/docs/configuration"} "our docs"]


made it clearer that iOS plan addditions affect grandfather pricing

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -1449,9 +1449,14 @@
             [:div
              [:h1 "No OS X plan selected"]
              [:p
-              [:strong [:a {:href (routes/v1-org-settings-path {:org plan-org-name
-                                                                :vcs_type plan-vcs-type
-                                                                :_fragment "osx-pricing"})} "Choose an OS X plan"]] "."]])])))))
+              (let [link [:strong [:a {:href (routes/v1-org-settings-path {:org plan-org-name
+                                                                                :vcs_type plan-vcs-type
+                                                                                :_fragment "osx-pricing"})} "Choose an OS X plan"] "."]]
+                (if (pm/grandfathered? plan)
+                  (list link
+                        " Note: changes to your billing will update your entire account"
+                        " (including Linux plans) off of our legacy plans to our current pricing model.")
+                  link))]])])))))

 (defn github-marketplace-messaging []
   [:div "Current plan managed on "


Create more seeds and smaller.

Create more seeds and smaller.

--- src/videotest/coral/motion_seeds.clj
+++ src/videotest/coral/motion_seeds.clj
@@ -7,9 +7,10 @@
    [videotest.coral.noise :as pnoise]))

-(def SEED-W 10)
+;; (def SEED-W 10)
 ;; (def SEED-CREATE-ODDS 0.1)
-(def SEED-CREATE-ODDS 0.2)
+(def SEED-W 6)
+(def SEED-CREATE-ODDS 0.4)

 (def SEED-X-VEL-BOUND 20.0)
 (def SEED-Y-VEL-BOUND-MIN 5.0)


SER-81 proper log field names

SER-81 proper log field names

--- src/vignette/util/thumb_verifier.clj
+++ src/vignette/util/thumb_verifier.clj
@@ -22,16 +22,16 @@
             estimated-size (estimate-thumb-size estimator thumb-map original)]
               (if (not-close-in-size estimated-size thumb-size)
                 (log/error "Thumbnail size is incorrect!" {
-                  :thumb-map thumb-map
+                  :thumb_map thumb-map
                   :estimated estimated-size
                   :actual thumb-size
-                  :area-ratio (area-ratio thumb-size estimated-size)
+                  :area_ratio (area-ratio thumb-size estimated-size)
                   })))
       (log/error "Couldn't verify thumbnail size. No estimator found." {
-        :thumb-map thumb-map
+        :thumb_map thumb-map
         }))
     (catch Exception e (log/error (str "Thumbnail verification failed - " e) {
-      :thumb-map thumb-map
+      :thumb_map thumb-map
       }))))

 (defn not-close-in-size


Refactor some core.cljs predicats from macro to form

--- src/core.cljs
+++ src/core.cljs
@@ -105,20 +105,20 @@
 (defn some?
     [x] (not (nil? x)))

-(defmacro symbol?
-    [x] `(.isSymbol js/symbols (~x)))
-
-(defmacro keyword?
-    [x] `(.isKeyword js/keywords (~x)))
-
-(defmacro vector?
-    [x] `(.isVector js/vectors (~x)))
-
-(defmacro map?
-    [x] `(.isMap js/maps (~x)))
-
-(defmacro array?
-    [x] `(.isArray js/Array (~x)))
+(defn symbol?
+    [x] (.isSymbol js/symbols (x)))
+
+(defn keyword?
+    [x] (.isKeyword js/keywords (x)))
+
+(defn vector?
+    [x] (.isVector js/vectors (x)))
+
+(defn map?
+    [x] (.isMap js/maps (x)))
+
+(defn array?
+    [x] (.isArray js/Array (x)))

 (defmacro get
     ([map key] `(.get ~map (~key)))


remove remark

remove remark

--- src/main/clojure/clara/rules/engine.clj
+++ src/main/clojure/clara/rules/engine.clj
@@ -499,7 +499,7 @@
            compiled-rest (compile-constraints rest assigment-set)
            containEq? (and (symbol? cmp) (let [cmp-str (name cmp)] (or (= cmp-str "=") (= cmp-str "=="))))
            a-in-assigment (and containEq? (and (symbol? a) (assigment-set (keyword a))))
-           b-in-assigment (and containEq? (and (symbol? b) (assigment-set (keyword b))))] ;;look at the trick with =>
+           b-in-assigment (and containEq? (and (symbol? b) (assigment-set (keyword b))))]
        (cond
         a-in-assigment
         (if b-in-assigment


Keep display order at bottom.

Keep display order at bottom.

--- src/onyx/datomic/information_model.cljc
+++ src/onyx/datomic/information_model.cljc
@@ -127,6 +127,37 @@
               :optional? true
               :doc "When supplied, :db/id tempids are added using this partition."}}}}

+   :lifecycle-entry
+   {:onyx.plugin.datomic/read-datoms
+    {:model
+     [{:task.lifecycle/name :read-datoms
+       :lifecycle/calls :onyx.plugin.datoms/read-datoms-calls}]}
+
+    :onyx.plugin.datomic/read-index-range
+    {:model
+     [{:task.lifecycle/name :read-index-datoms
+       :lifecycle/calls :onyx.plugin.datoms/read-index-range-calls}]}
+
+    :onyx.plugin.datomic/read-log
+    {:model
+     [{:task.lifecycle/name :read-log
+       :lifecycle/calls :onyx.plugin.datoms/read-log-calls}]}
+
+    :onyx.plugin.datomic/commit-tx
+    {:model
+     [{:task.lifecycle/name :write-datoms
+       :lifecycle/calls :onyx.plugin.datoms/write-tx-calls}]}
+
+    :onyx.plugin.datomic/commit-bulk-tx
+    {:model
+     [{:task.lifecycle/name :write-bulk-datoms
+       :lifecycle/calls :onyx.plugin.datomic/write-bulk-tx-calls}]}
+
+    :onyx.plugin.datomic/commit-bulk-tx-async
+    {:model
+     [{:task.lifecycle/name :write-bulk-datoms-async
+       :lifecycle/calls :onyx.plugin.datomic/write-bulk-tx-async-calls}]}}
+
    :display-order
    {:onyx.plugin.datomic/read-datoms
     [:datomic/uri
@@ -163,35 +194,4 @@

     :onyx.plugin.datomic/commit-bulk-tx-async
     [:datomic/uri
-     :datomic/partition]}
-
-   :lifecycle-entry
-   {:onyx.plugin.datomic/read-datoms
-    {:model
-     [{:task.lifecycle/name :read-datoms
-       :lifecycle/calls :onyx.plugin.datoms/read-datoms-calls}]}
-
-    :onyx.plugin.datomic/read-index-range
-    {:model
-     [{:task.lifecycle/name :read-index-datoms
-       :lifecycle/calls :onyx.plugin.datoms/read-index-range-calls}]}
-
-    :onyx.plugin.datomic/read-log
-    {:model
-     [{:task.lifecycle/name :read-log
-       :lifecycle/calls :onyx.plugin.datoms/read-log-calls}]}
-
-    :onyx.plugin.datomic/commit-tx
-    {:model
-     [{:task.lifecycle/name :write-datoms
-       :lifecycle/calls :onyx.plugin.datoms/write-tx-calls}]}
-
-    :onyx.plugin.datomic/commit-bulk-tx
-    {:model
-     [{:task.lifecycle/name :write-bulk-datoms
-       :lifecycle/calls :onyx.plugin.datomic/write-bulk-tx-calls}]}
-
-    :onyx.plugin.datomic/commit-bulk-tx-async
-    {:model
-     [{:task.lifecycle/name :write-bulk-datoms-async
-       :lifecycle/calls :onyx.plugin.datomic/write-bulk-tx-async-calls}]}}})
+     :datomic/partition]}})


Better robustness for stale mount points

For some stale mount points, (.exists file) will return
false, even they exists on the filesystem and cause
`Operation timed out` errors for command line tools.

It turns out that, for these, (.canRead file) returns true
(but false for other non-existent directories), and
provides a means to detect such situations.

Added a new method that incorporates `.canRead`.

Fixes #85

--- Clojure/src/ambly/core.clj
+++ Clojure/src/ambly/core.clj
@@ -346,12 +346,21 @@
   {:pre [(or (string? path) (instance? File path))]}
   (form-ambly-import-script-expr-js (str "'" path "'")))

+(defn- mount-exists?
+  "Checks to see if a WebDAV mount point already exists."
+  [webdav-mount-point]
+  {:pre [(string? webdav-mount-point)]}
+  ;; We fall back to `.canRead` to cope with mount points where `.exists` returns false and
+  ;; for command-line tools indicate `Operation timed out`.
+  (let [file (io/file webdav-mount-point)]
+    (or (.exists file) (.canRead file))))
+
 (defn- umount-webdav
   "Unmounts WebDAV, returning true upon success."
   [webdav-mount-point]
   {:pre [(string? webdav-mount-point)]}
   (or
-    (not (.exists (io/file webdav-mount-point)))
+    (not (mount-exists? webdav-mount-point))
     (or
       (zero? (sh 5000 -1 "umount" webdav-mount-point))
       (zero? (sh 5000 -1 "umount" "-f" webdav-mount-point))
@@ -376,7 +385,7 @@
     (when-not (umount-webdav webdav-mount-point)
       (throw (IOException. (str "Unable to unmount previous WebDAV mount at " webdav-mount-point))))
     (loop [tries 1]
-      (if-not (or (.exists output-dir) (.mkdirs output-dir))
+      (if-not (or (mount-exists? webdav-mount-point) (.mkdirs output-dir))
         (throw (IOException. (str "Unable to create WebDAV mount point " webdav-mount-point))))
       (if (zero? (sh 1000 -1 "mount_webdav" webdav-endpoint webdav-mount-point))
         (reset! (:webdav-mount-point repl-env) webdav-mount-point)


Refactored out revive-smas helper func.

Refactored out revive-smas helper func.

--- src/rewindable/core.cljs
+++ src/rewindable/core.cljs
@@ -25,6 +25,40 @@
          (println "yo" msg)
          msg)))

+(defn revive-smas [agw bufs-ss smas-ss smas-cur]
+  (loop [ss-buf-ids (sort (keys smas-ss))
+         cur-buf-ids (sort (keys smas-cur))
+         acc-nxt-smas {}]
+    (let [ss-buf-id (first ss-buf-ids)
+          cur-buf-id (first cur-buf-ids)]
+      (cond
+       (= nil ss-buf-id cur-buf-id) acc-nxt-smas ; Loop exit.
+
+       (and ss-buf-id ; In ss but not in cur.
+            (or (nil? cur-buf-id) (< ss-buf-id cur-buf-id)))
+       (recur (rest ss-buf-ids) cur-buf-ids
+              (let [ss-buf (get bufs-ss ss-buf-id)
+                    sma-old (get smas-ss ss-buf-id)
+                    ; TODO: Need to pass an ago-world2 to revive.
+                    sma-new (ago-revive-state-machine agw sma-old ss-buf)]
+                (assoc acc-nxt-smas ss-buf-id sma-new)))
+
+       (and cur-buf-id ; In cur but not in ss.
+            (or (nil? ss-buf-id) (< cur-buf-id ss-buf-id)))
+       (recur ss-buf-ids (rest cur-buf-ids)
+              ; TODO: need to explicitly close cur's sma?
+              acc-nxt-smas) ; So, drop cur's sma.
+
+       (= ss-buf-id cur-buf-id) ; In both cur and ss.
+       (let [sma-ss (get smas-ss ss-buf-id)
+             sma-cur (get smas-cur cur-buf-id)]
+         (acopy sma-ss sma-cur) ; Rewind cur's sma.
+         (recur (rest ss-buf-ids)
+                (rest cur-buf-ids)
+                (assoc acc-nxt-smas cur-buf-id sma-cur)))
+
+       :else (println "UNEXPECTED case in snapshot revive")))))
+
 (let [hi-ch (listen-el (gdom/getElement "hi") "click")
       stw-ch (listen-el (gdom/getElement "stw") "click") ; save-the-world button
       rtw-ch (listen-el (gdom/getElement "rtw") "click") ; restore-the-world button
@@ -40,39 +74,7 @@
     (let [ss (ago-snapshot @last-snapshot)
           smas-ss (:smas ss)
           smas-cur (:smas @agw)
-          nxt-smas
-          (loop [ss-buf-ids (sort (keys smas-ss))
-                 cur-buf-ids (sort (keys smas-cur))
-                 acc-nxt-smas {}]
-            (let [ss-buf-id (first ss-buf-ids)
-                  cur-buf-id (first cur-buf-ids)]
-              (cond
-               (= nil ss-buf-id cur-buf-id) acc-nxt-smas
-
-               (and ss-buf-id ; In ss but not in cur.
-                    (or (nil? cur-buf-id) (< ss-buf-id cur-buf-id)))
-               (recur (rest ss-buf-ids) cur-buf-ids
-                      (let [ss-buf (get-in ss [:bufs ss-buf-id])
-                            sma-old (get smas-ss ss-buf-id)
-                            ; TODO: Need to pass an ago-world2 to revive.
-                            sma-new (ago-revive-state-machine agw sma-old ss-buf)]
-                        (assoc acc-nxt-smas ss-buf-id sma-new)))
-
-               (and cur-buf-id ; In cur but not in ss.
-                    (or (nil? ss-buf-id) (< cur-buf-id ss-buf-id)))
-               (recur ss-buf-ids (rest cur-buf-ids)
-                      ; TODO: need to explicitly close cur's sma?
-                      acc-nxt-smas) ; So, drop cur's sma.
-
-               (= ss-buf-id cur-buf-id) ; In both cur and ss.
-               (let [sma-ss (get smas-ss ss-buf-id)
-                     sma-cur (get smas-cur cur-buf-id)]
-                 (acopy sma-ss sma-cur) ; Rewind cur's sma.
-                 (recur (rest ss-buf-ids)
-                        (rest cur-buf-ids)
-                        (assoc acc-nxt-smas cur-buf-id sma-cur)))
-
-               :else (println "UNEXPECTED case in snapshot revive"))))]
+          nxt-smas (revive-smas agw (:bufs ss) smas-ss smas-cur)]
       (swap! agw #(-> %
                       (assoc :bufs (:bufs ss))
                       (assoc :smas nxt-smas)


No need to qualify into-array.

No need to qualify into-array.

--- src/sablono/compiler.clj
+++ src/sablono/compiler.clj
@@ -77,7 +77,7 @@

 (defmethod compile-form "for"
   [[_ bindings body]]
-  `(cljs.core/into-array (for ~bindings ~(compile-html body))))
+  `(~'into-array (for ~bindings ~(compile-html body))))

 (defmethod compile-form "if"
   [[_ condition & body]]


Tidy up

Tidy up

--- frontend/src/crunsher/core.cljs
+++ frontend/src/crunsher/core.cljs
@@ -3,14 +3,12 @@
             [om.dom :as dom :include-macros true]
             [goog.dom :as gdom]
             [crunsher.data.pokemon]
-            [crunsher.extensions]
+            [crunsher.utils.extensions]
             [crunsher.utils.lib :as lib]
             [crunsher.views :as views]
             [om.next :as om]))

 (enable-console-print!)
-
-;(println (nth crunsher.data.pokemon/all 10))

 (om/add-root! lib/reconciler
               views/Main (gdom/getElement "crunsher-main"))


Whtiespace.

Whtiespace.

--- src/uuuurrrrllll/core.clj
+++ src/uuuurrrrllll/core.clj
@@ -49,7 +49,7 @@
                 [:ul
                  (for [k (seq (wb/keys-in bucket))]
                    (let [v (get-url k)]
-                   [:li [:a {:href v} v]]))]])})
+                     [:li [:a {:href v} v]]))]])})

 (defroutes app
   (POST "/" request


Fix standard-out appender config

Fix standard-out appender config

--- src/onyx/static/logging_configuration.clj
+++ src/onyx/static/logging_configuration.clj
@@ -20,9 +20,10 @@
         (timbre/set-config!
           [:shared-appender-config :rotor]
           {:path file :max-size (* 512 102400) :backlog 5})
-        (timbre/set-config! [:appenders :standard-out]
-                            {:min-level :error
-                             :enabled? true})
+        (timbre/merge-config!
+          {:appenders {:standard-out
+                       {:min-level :error
+                        :enabled? true}}})
         (timbre/set-config! [:appenders :spit :enabled?] false)))

     (info "Starting Logging Configuration")


Mention reason for exception-dispatch implementation

--- src/onyx/static/logging_configuration.clj
+++ src/onyx/static/logging_configuration.clj
@@ -6,6 +6,10 @@

 (def MAX-LOG-SIZE (* 512 102400))
 (def MAX-LOG-FILES 5)
+
+;; temporary workaround to prevent timbre from crashing under some circumstances
+;; e.g. java.lang.IllegalArgumentException: Multiple methods in multimethod 'exception-dispatch' match dispatch value: class schema.core.Either
+;; -> interface clojure.lang.IPersistentMap and interface clojure.lang.IRecord, and neither is preferred]

 (defmethod pretty/exception-dispatch clojure.lang.IPersistentMap [m]
   (pr-str m))


Log error when user-supplied terminal fn throws

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -1268,7 +1268,10 @@
         (future
           ;; Wait for main thread loop to start
           (.await latch)
-          (f terminal)
+          (try
+            (f terminal)
+            (catch Throwable t
+              (log/error t "Error executing terminal fn")))
           (log/info "done with use supplied fn"))
         (let [[monitor-width
                monitor-height] (with-gl-context gl-lock window capabilities


(PDB-3051) benchmark: i18n & send user msgs to *err*

Add translation for the remaining untranslated user-oriented messages,
and send all of them directly to *err* rather than indirectly to *err*
via logging.

--- src/puppetlabs/puppetdb/cli/benchmark.clj
+++ src/puppetlabs/puppetdb/cli/benchmark.clj
@@ -74,7 +74,7 @@
   (try
     (json/parse-string (slurp file))
     (catch Exception e
-      (log/error (trs "Error parsing {0}; skipping" file)))))
+      (println-err (trs "Error parsing {0}; skipping" file)))))

 (defn load-sample-data
   "Load all .json files contained in `dir`."
@@ -87,7 +87,7 @@
                     (filterv (complement nil?)))]
       (if (seq data)
         data
-        (log/error
+        (println-err
          (trs "Supplied directory {0} contains no usable data!" dir))))))

 (def producers (vec (repeatedly 4 #(random-string 10))))
@@ -365,9 +365,11 @@
           (if (> time-diff 5000)
             (let [time-diff-seconds (/ time-diff 1000)
                   messages-per-second (float (/ events-since-last-report time-diff-seconds))]
-              (println "Sending" messages-per-second "messages/s"
-                       "(load equivalent to" (int (/ messages-per-second expected-node-message-rate)) "nodes)")
-              (flush)
+              (println-err
+               (trs
+                "Sending {0} messages/s (load equivalent to {1} nodes)"
+                messages-per-second
+                (int (/ messages-per-second expected-node-message-rate))))
               (recur 0 t))
             (recur (inc events-since-last-report) last-report-time)))))))


improve build check to see if jars are up to date

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

--- buildscripts/buildcheck/src/buildcheck/core.clj
+++ buildscripts/buildcheck/src/buildcheck/core.clj
@@ -19,16 +19,27 @@
   (map first
     (re-seq #"\[javac\]\s\b([1-9]|[0-9][1-9]|[0-9][0-9][1-9])\b\serrors?" result-text)))

-(defn old-dlls [dir time-limit-hours]
+(defn old-files [files time-limit-hours]
   (let [now (System/currentTimeMillis)
         before (- now (* time-limit-hours MS-PER-HOUR))]
+    (filter #(< (.lastModified %) before) files)))
+
+(defn old-dlls [dir time-limit-hours]
+  (old-files
     (filter
       (fn [file]
         (let [file-name (.getName file)]
           (and (.endsWith file-name ".dll")
-               (.startsWith file-name "mmgr_dal")
-               (< (.lastModified file) before))))
-      (.listFiles dir))))
+               (.startsWith file-name "mmgr_dal"))))
+      (.listFiles dir))
+    time-limit-hours))
+
+(defn old-jars [dir time-limit-hours]
+  (old-files
+    (filter
+      #(.. % getName (endsWith ".jar"))
+      (file-seq (File. dir)))
+    time-limit-hours))

 (defn report-build-errors [bits mode]
   (let [f (result-file bits mode)
@@ -38,31 +49,37 @@
                                        (condp = bits
                                          32 "bin_Win32"
                                          64 "bin_x64")) 24)
-        javac-errs (javac-errors result-txt)]
-    (when-not (and (empty? vs-errors) (empty? outdated-dlls) (empty? javac-errs))
-      (println (str "MICROMANAGER " bits "-bit "
+        javac-errs (javac-errors result-txt)
+        outdated-jars (old-jars (File. micromanager "Install_AllPlatforms") 24)]
+    (when-not (and (empty? vs-errors) (empty? outdated-dlls)
+                   (empty? javac-errs) (empty? outdated-jars))
+      (println (str "\n\nMICROMANAGER " bits "-bit "
                     ({:inc "INCREMENTAL" :full "FULL"} mode)
                     " BUILD ERROR REPORT"))
       (println (str "For a full report, see " (.getAbsolutePath f)))
       (println "\nVisual Studio reported errors:")
       (if-not (empty? vs-errors) (dorun (map println vs-errors)) (println "None."))
       (println "\nOutdated device adapter DLLs:")
-      (if-not (empty? outdated-dlls) (dorun (map #(println (.getAbsolutePath %)) outdated-dlls)) (println "None."))
+      (if-not (empty? outdated-dlls) (dorun (map #(println (.getName %)) outdated-dlls)) (println "None."))
       (println "\nErrors reported by java compiler:")
       (if-not (empty? javac-errs) (dorun (map println javac-errs)) (println "None."))
-      (println "\n\n"))))
+      (println "\nOutdated jar files:")
+      (if-not (empty? outdated-jars) (dorun (map #(println (.getName %)) outdated-jars)) (println "None."))
+      )))

 (defn make-full-report [mode send?]
   (let [report
         (with-out-str
           (report-build-errors 32 mode)
           (report-build-errors 64 mode))]
-    (when send?
-      (when-not (empty? report)
-        (with-session
-          "mmbuilderrors@gmail.com" (slurp "C:\\pass.txt") "smtp.gmail.com" 465 "smtp" true
-          (send-email (text-email ["info@micro-manager.org"] "mm build errors" report)))))
-    (println report)))
+    (if-not (empty? report)
+      (do
+        (when send?
+          (with-session
+            "mmbuilderrors@gmail.com" (slurp "C:\\pass.txt") "smtp.gmail.com" 465 "smtp" true
+            (send-email (text-email ["info@micro-manager.org"] "mm build errors" report))))
+        (println report))
+      (println "Nothing to report."))))

 (defn -main [mode]
   (make-full-report (get {"inc" :inc "full" :full} mode) true))


clojure (pgraph_morphisms): avoid forces shell-positions output

--- clojure/org/gavrog/clojure/pgraph_morphisms.clj
+++ clojure/org/gavrog/clojure/pgraph_morphisms.clj
@@ -72,22 +72,23 @@
     { (vec (take 1 (second (first items2seqs)))) (take 1 (first items2seqs)) }

     :else
-    (loop [classes (sorted-set [(- (count items2seqs)) [] items2seqs])]
-      (let [[n k c] (first classes)]
+    (loop [classes (sorted-map [(- (count items2seqs)) []] items2seqs)]
+      (let [[[n k] c] (first classes)]
         (if (or (nil? n) (>= n -1))
-          (zipmap (map second classes) (map #(map first (last %)) classes))
-          (recur (into (disj classes (first classes))
+          (zipmap (map (comp second first) classes)
+                  (map #(map first (last %)) classes))
+          (recur (into (dissoc classes [n k])
                        (for [[key cl] (classify-once c)]
                          (if (nil? key)
-                           [0 k cl]
-                           [(- (count cl)) (conj k key) cl])))))))))
+                           [[0 k] cl]
+                           [[(- (count cl)) (conj k key)] cl])))))))))

 (defn node-classification [net]
   (let [pos (barycentric-positions net)
         nodes (iterator-seq (.nodes net))
         dia (diameter net)
         shells (for [v nodes]
-                 (vec (map vec (take (inc dia) (shell-positions net pos v)))))]
+                 (map vec (take (inc dia) (shell-positions net pos v))))]
     (classify-recursively (zipmap nodes shells))))

 (defn node-signatures [net]


Eliminate prepared statements cache, step 2

--- src/clojure/clojurewerkz/cassaforte/client.clj
+++ src/clojure/clojurewerkz/cassaforte/client.clj
@@ -28,8 +28,6 @@
            [java.security KeyStore SecureRandom]))

 (declare build-ssl-options)
-
-(def prepared-statement-cache (atom {}))

 (defprotocol DummySession
   (executeAsync [_ query]))
@@ -181,11 +179,7 @@

    This assumes that query is valid. Returns the prepared statement corresponding to the query."
   ([^Session session ^String query]
-     (if-let [cached (get @prepared-statement-cache [session query])]
-       cached
-       (let [prepared (.prepare ^Session session query)]
-         (swap! prepared-statement-cache #(assoc % [session query] prepared))
-         prepared))))
+     (.prepare ^Session session query)))

 (defn render-query
   "Renders compiled query"


Added support for convenient multi-bulk parsing

--- src/taoensso/carmine.clj
+++ src/taoensso/carmine.clj
@@ -56,6 +56,14 @@
   [parser-fn & body]
   `(binding [protocol/*parser* ~parser-fn] ~@body))

+(defmacro with-mparser
+  "Wraps body so that multi-bulk (vector) replies to any wrapped Redis commands
+  will be parsed with (parser-fn reply)."
+  [parser-fn & body]
+  `(with-parser
+     (fn [multi-bulk-reply#] (vec (map ~parser-fn multi-bulk-reply#)))
+     ~@body))
+
 (defmacro skip-replies
   [& body] `(with-parser (constantly :taoensso.carmine.protocol/skip-reply)
               ~@body))
@@ -68,10 +76,16 @@
                           (or (= x "false") (= x "0")) false
                           (or (= x "true")  (= x "1")) true
                           :else nil))
-(defmacro parse-long    [& body] `(with-parser as-long   ~@body))
-(defmacro parse-double  [& body] `(with-parser as-double ~@body))
-(defmacro parse-bool    [& body] `(with-parser as-bool   ~@body))
-(defmacro parse-keyword [& body] `(with-parser #(keyword %) ~@body))
+
+(defmacro parse-long     [& body] `(with-parser as-long      ~@body))
+(defmacro parse-double   [& body] `(with-parser as-double    ~@body))
+(defmacro parse-bool     [& body] `(with-parser as-bool      ~@body))
+(defmacro parse-keyword  [& body] `(with-parser #(keyword %) ~@body))
+
+(defmacro parse-longs    [& body] `(with-mparser as-long      ~@body))
+(defmacro parse-doubles  [& body] `(with-mparser as-double    ~@body))
+(defmacro parse-bools    [& body] `(with-mparser as-bool      ~@body))
+(defmacro parse-keywords [& body] `(with-mparser #(keyword %) ~@body))

 (defn make-keyfn
   "Returns a function that joins keywords and strings to form an idiomatic


Auto :unprocessed-items/keys reprocessing TODO

--- src/taoensso/faraday.clj
+++ src/taoensso/faraday.clj
@@ -515,6 +515,22 @@
                                                       :my-range ["0" "1"]}]
                                           :attrs []}}))

+;; TODO Add loops+merging for :unprocessed-keys (meta) and :unprocessed-items
+
+;; BatchGetItem will return a partial result if the response size limit is
+;; exceeded, the table's provisioned throughput is exceeded, or an internal
+;; processing failure occurs. If a partial result is returned, the operation
+;; returns a value for UnprocessedKeys . You can use this value to retry the
+;; operation starting with the next item to get.
+
+;; * The UnprocessedKeys value is in the same form as RequestItems, so the value
+;; can be provided directly to a subsequent BatchGetItem operation. For more
+;; information, see RequestItems in the Request Parameters section.
+
+;; Typically, you would call BatchWriteItem in a loop. Each iteration would
+;; check for unprocessed items and submit a new BatchWriteItem request with
+;; those unprocessed items until all items have been processed.
+
 (defn batch-get-item
   "Retrieves a batch of items in a single request.
   Limits apply, Ref. http://goo.gl/Bj9TC.


(PDB-3220) Drop resource_events_resource_type_idx

This commit drops the resource_events_resource_type_idx index
because the primary column duplicates the
resource_events_resource_timestamp index and as such we see that
the resource_type_idx is never used in practice.

--- src/puppetlabs/puppetdb/scf/migrate.clj
+++ src/puppetlabs/puppetdb/scf/migrate.clj
@@ -1160,6 +1160,11 @@
   []
   (jdbc/do-commands
     "CREATE INDEX resource_events_status_for_corrective_change_idx ON resource_events (status) WHERE corrective_change"))
+
+(defn drop-resource-events-resource-type-idx
+  []
+  (jdbc/do-commands
+    "DROP INDEX IF EXISTS resource_events_resource_type_idx"))

 (def migrations
   "The available migrations, as a map from migration version to migration function."
@@ -1191,7 +1196,8 @@
    50 remove-historical-catalogs
    51 fact-values-value-to-jsonb
    52 resource-params-cache-parameters-to-jsonb
-   53 add-corrective-change-index})
+   53 add-corrective-change-index
+   54 drop-resource-events-resource-type-idx})

 (def desired-schema-version (apply max (keys migrations)))


Add `uuid-str?` predicate.

Add `uuid-str?` predicate.


replace clojure.core with cljs.core on symbols

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -100,8 +100,9 @@
       (get-in env [:locals sym])))

 (defn desugar-symbol [form env]
-  (let [ns (namespace form)
-        n (name form)]
+  (let [ns (fix-ns (namespace form))
+        n (name form)
+        form (symbol ns n)]
     (cond

      ;; js/foo -> (js* "foo")


CMR-3203 Try lazy-seq

CMR-3203 Try lazy-seq

--- search-app/src/cmr/search/services/humanizers_service.clj
+++ search-app/src/cmr/search/services/humanizers_service.clj
@@ -30,7 +30,7 @@

 (defn- rfms->umm-collections
   [context rfms]
-  (map #(rfm->umm-collection context %) rfms))
+  (lazy-seq (map #(rfm->umm-collection context %) rfms)))

 (defn- get-all-collections
   "Retrieves all collections from the Metadata cache"
@@ -41,7 +41,7 @@
     ;(map #(rfm->umm-collection context %) (metadata-cache/all-cached-revision-format-maps context)))
   (let [[t1 rfms] (u/time-execution (metadata-cache/all-cached-revision-format-maps context))]
     (debug "Get rfms" t1)
-    (let [[t2 collections] (u/time-execution (u/map-n-all #(rfms->umm-collections context %) n rfms))]
+    (let [[t2 collections] (u/time-execution (lazy-seq (u/map-n-all #(rfms->umm-collections context %) n rfms)))]
       (debug "Convert to collections" t2)
       collections)))


Fixes test-validate-minimesos-settings (#22)

--- waiter/test/waiter/settings_test.clj
+++ waiter/test/waiter/settings_test.clj
@@ -228,7 +228,7 @@
         (let [settings (load-minimesos-settings)]
           (is (nil? (s/check settings-schema settings)))
           (is (= port (:port settings)))
-          (is (= run-as-user (get-in settings [:authenticator-config :anonymous :launch-as-user])))
+          (is (= run-as-user (get-in settings [:authenticator-config :one-user :run-as-user])))
           (is (= marathon (get-in settings [:scheduler-config :marathon :url]))))))))

 (deftest test-validate-shell-settings


Revert data-path fix for ident-based paths.

--- src/untangled/client/impl/data_fetch.cljc
+++ src/untangled/client/impl/data_fetch.cljc
@@ -306,7 +306,6 @@
   [state]
   (let [target (data-target state)]
     (cond
-      (vector? (data-ident state)) (data-ident state)
       (and (vector? target) (not-empty target)) target
       (and (vector? (data-ident state)) (keyword? (data-field state))) (conj (data-ident state) (data-field state))
       :otherwise [(data-query-key state)])))


Fix namespace.

Fix namespace.

--- test/onyx/windowing/trigger_predicate_test.clj
+++ test/onyx/windowing/trigger_predicate_test.clj
@@ -1,4 +1,4 @@
-(ns onyx.windowing.trigger-predicate-tests
+(ns onyx.windowing.trigger-predicate-test
   (:require [clojure.test.check :as tc]
             [clojure.test.check.generators :as gen]
             [clojure.test :refer [deftest is]]


future-fact tests for desirable metaconstant merge behavior

--- test/as_documentation/metaconstants.clj
+++ test/as_documentation/metaconstants.clj
@@ -151,3 +151,23 @@
   (provided
     (gen-doc) => ..doc..
     ..doc.. =contains=> {:header "gamma"}))
+
+(against-background [..doc.. =contains=> {:header "gamma"}]
+  (fact "Test merging of metaconstant with against-background"
+    (:header (gen-doc)) => "gamma"
+    (provided
+      (gen-doc) => ..doc..)))
+
+(against-background [..doc..    =contains=> {:header ..header..}
+                     ..header.. =contains=> {:title "astronautas"}]
+  (future-fact "Test metaconstants that contain other metaconstants"
+    (-> (gen-doc) :header :title) => "astronautas"
+    (provided
+      (gen-doc) => ..doc..)))
+
+(future-fact "Test metaconstants that contain other metaconstants"
+  (-> (gen-doc) :header :title) => "astronautas"
+  (provided
+    (gen-doc) => ..doc..
+    ..doc..    =contains=> {:header ..header..}
+    ..header.. =contains=> {:title "astronautas"}))


"a OS X plan" => "an OS X plan"

"a OS X plan" => "an OS X plan"

Havin' a grammar opinion about indefinite articles, even though I know this is about to be displaced by macOS.

--- src-cljs/frontend/components/org_settings.cljs
+++ src-cljs/frontend/components/org_settings.cljs
@@ -1319,7 +1319,7 @@
                  (om/build osx-usage-table-plan {:plan plan})]])
              [:div.plan-header
               [:h1 "No OS X plan selected"]
-              [:p "Choose a OS X plan below."]])])))))
+              [:p "Choose an OS X plan below."]])])))))

 (defn osx-usage-table [{:keys [plan]} owner]
   (reify
@@ -1437,7 +1437,7 @@
              [:p
               [:strong [:a {:href (routes/v1-org-settings-path {:org plan-org-name
                                                                 :vcs_type plan-vcs-type
-                                                                :_fragment "osx-pricing"})} "Choose a OS X plan"]] "."]])])))))
+                                                                :_fragment "osx-pricing"})} "Choose an OS X plan"]] "."]])])))))

 (defn displayed-linux-plan-info [current-linux-cost containers in-student-trial?]
   (gstring/format "Current Linux plan: %s - $%s/month"


Update dependency.

Update dependency.


updated url

updated url


Version 0.4.1-SNAPSHOT

Version 0.4.1-SNAPSHOT


Version 1.0.16-SNAPSHOT

Version 1.0.16-SNAPSHOT


Allow dev to see test files.

Allow dev to see test files.


(maint) Bump version to 6.6.0

(maint) Bump version to 6.6.0


Update board.cljs

Update board.cljs

--- src/cljs/back_channeling/components/board.cljs
+++ src/cljs/back_channeling/components/board.cljs
@@ -394,7 +394,7 @@
           :style {:margin-top "66px"
                   :width "874px"
                   :background-color "#ffffff"
-                  :z-index "1"}})
+                  :z-index 1}})
         (for [tab tabs]
           [:a.item (merge {:on-click (fn [_]
                                (set! (.-href js/location)


Test for image in bucket not found

Test for image in bucket not found

--- test/silly_image_store/handler_test.clj
+++ test/silly_image_store/handler_test.clj
@@ -22,6 +22,11 @@

     (testing "image not-found"
       (let [response (app (mock/request :get "/images/not-such-image.png"))]
+        (is (= (:status response) 404))
+        (is (= (:body response) "No thing 'not-such-image.png' found"))))
+
+    (testing "bucket image not-found"
+      (let [response (app (mock/request :get "/buckets/some-bucket/images/not-such-image.png"))]
         (is (= (:status response) 404))
         (is (= (:body response) "No thing 'not-such-image.png' found")))))


Formatting

Formatting

--- src/cylon/core.clj
+++ src/cylon/core.clj
@@ -531,12 +531,10 @@
   (ring-handler [this]
     (-> (:ring-handler this)
         ring-handler
-        ;; TODO Just use the one authenticator if possible
-        (wrap-authentication (new-session-based-request-authenticator
-                              :http-session-store
-                              (-> this :protection-system :http-session-store)
-                              :user-roles
-                              (-> this :protection-system :user-roles))))))
+        (wrap-authentication
+         (new-session-based-request-authenticator
+          :http-session-store (-> this :protection-system :http-session-store)
+          :user-roles (-> this :protection-system :user-roles))))))

 (defn new-auth-binder
   "Constructor for a ring handler provider that amalgamates all bidi


Function find-job-with-name

Function find-job-with-name

--- src/emender_jenkins/results.clj
+++ src/emender_jenkins/results.clj
@@ -18,7 +18,7 @@
 (require '[emender-jenkins.jenkins-api :as jenkins-api])
 (require '[emender-jenkins.config      :as config])

-(def results (atom {}))
+(def results (atom nil))

 (defn render-edn-data
     "Render EDN data to be used for debugging purposes etc."
@@ -115,3 +115,7 @@
           ;job-results))
 ))

+(defn find-job-with-name
+    [job-name]
+    (some #(if (= job-name (:job-name %)) %) @results))
+


CMR-4223: Addressed the PR comments.

CMR-4223: Addressed the PR comments.

--- ingest-app/src/cmr/ingest/data/bulk_update.clj
+++ ingest-app/src/cmr/ingest/data/bulk_update.clj
@@ -31,6 +31,9 @@
   (update-bulk-update-collection-status [db task-id concept-id status status-message])
   (reset-bulk-update [db]))

+(def bulk_update_task_status
+ "bulk_update_task_status")
+
 ;; Extends the BulkUpdateStore to the oracle store so it will work with oracle.
 (extend-protocol BulkUpdateStore
   cmr.oracle.connection.OracleStore
@@ -41,8 +44,8 @@
      [conn db]
      ;; Returns a list of bulk update statuses for the provider
      (let [stmt (su/build (su/select [:created-at :task-id :status :status-message :request-json-body]
-                            (su/from "bulk_update_task_status")
-                            (su/where `(= :provider-id ~provider-id))))
+                          (su/from bulk_update_task_status)
+                          (su/where `(= :provider-id ~provider-id))))
            ;; Note: the column selected out of the database is created_at, instead of created-at.
            statuses (doall (map #(update % :created_at (partial oracle/oracle-timestamp->str-time conn))
                                 (su/query conn stmt)))
@@ -57,8 +60,8 @@
      ;; Returns a status for the particular task
      (some-> conn
              (su/find-one (su/select [:created-at :status :status-message :request-json-body]
-                                     (su/from "bulk_update_task_status")
-                                     (su/where `(= :task-id ~task-id))))
+                          (su/from bulk_update_task_status)
+                          (su/where `(= :task-id ~task-id))))
              util/map-keys->kebab-case
              (update :request-json-body util/gzip-blob->string)
              (update :created-at (partial oracle/oracle-timestamp->str-time conn)))))


macros not needed, if I am a good salesman

--- src/fogus/me/trammel/macros.clj
+++ src/fogus/me/trammel/macros.clj
@@ -1,183 +0,0 @@
-;;; macros.clj -- Contracts programming library for Clojure
-
-;; by Michael Fogus - http://fogus.me/fun/
-;; July 9, 2010
-
-;; Copyright (c) Michael Fogus, 2010. All rights reserved.  The use
-;; and distribution terms for this software are covered by the Eclipse
-;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-;; which can be found in the file COPYING the root of this
-;; distribution.  By using this software in any fashion, you are
-;; agreeing to be bound by the terms of this license.  You must not
-;; remove this notice, or any other, from this software.
-
-(ns fogus.me.trammel.macros)
-
-;; ALL macros in this ns are taken directly from clojure.contrib.macro-utils
-;;  by the eminent Konrad Hinsen
-;; This inclusion is only temporary until contrib is properly modularized.
-
-(def macro-fns {})
-(def macro-symbols {})
-(def protected-symbols #{})
-(def special-forms (into #{} (keys clojure.lang.Compiler/specials)))
-
-(declare expand-all)
-
-(defn- reserved?
-  [symbol]
-  "Return true if symbol is a reserved symbol (starting or ending with a dot)."
-  (let [s (str symbol)]
-    (or (= "." (subs s 0 1))
-	(= "." (subs s (dec (count s)))))))
-
-(defn- expand-symbol
-  "Expand symbol macros"
-  [symbol]
-  (cond (contains? protected-symbols symbol) symbol
-	(reserved? symbol)                   symbol
-	(contains? macro-symbols symbol)     (get macro-symbols symbol)
-	:else (let [v (resolve symbol)
-		    m (meta v)]
-		(if (:symbol-macro m)
-		  (var-get v)
-		  symbol))))
-
-(defn- expand-1
-  "Perform a single non-recursive macro expansion of form."
-  [form]
-  (cond
-    (seq? form)
-      (let [f (first form)]
-        (cond (contains? special-forms f) form
-	      (contains? macro-fns f)     (apply (get macro-fns f) (rest form))
-	      (symbol? f)                 (let [exp (expand-symbol f)]
-					    (if (= exp f)
-					      (clojure.core/macroexpand-1 form)
-					      (cons exp (rest form))))
-	      ; handle defmacro macros and Java method special forms
-	      :else (clojure.core/macroexpand-1 form)))
-    (symbol? form)
-      (expand-symbol form)
-     :else
-       form))
-
-(defn- expand
-  "Perform repeated non-recursive macro expansion of form, until it no
-   longer changes."
-  [form]
-  (let [ex (expand-1 form)]
-    (if (identical? ex form)
-      form
-      (recur ex))))
-
-(defn- expand-args
-  "Recursively expand the arguments of form, leaving its first
-   n elements unchanged."
-  ([form]
-   (expand-args form 1))
-  ([form n]
-   (doall (concat (take n form) (map expand-all (drop n form))))))
-
-(defn- expand-bindings
-  [bindings exprs]
-  (if (empty? bindings)
-    (list (doall (map expand-all exprs)))
-    (let [[[s b] & bindings] bindings]
-      (let [b (expand-all b)]
-	(binding [protected-symbols (conj protected-symbols s)]
-	  (doall (cons [s b] (expand-bindings bindings exprs))))))))
-
-(defn- expand-with-bindings
-  "Handle let* and loop* forms. The symbols defined in them are protected
-   from symbol macro expansion, the definitions and the body expressions
-   are expanded recursively."
-  [form]
-  (let [f        (first form)
-	bindings (partition 2 (second form))
-	exprs    (rest (rest form))
-	expanded (expand-bindings bindings exprs)
-	bindings (vec (apply concat (butlast expanded)))
-	exprs    (last expanded)]
-    (cons f (cons bindings exprs))))
-
-(defn- expand-fn-body
-  [[args & exprs]]
-  (binding [protected-symbols (reduce conj protected-symbols
-				     (filter #(not (= % '&)) args))]
-    (cons args (doall (map expand-all exprs)))))
-
-(defn- expand-fn
-  "Handle fn* forms. The arguments are protected from symbol macro
-   expansion, the bodies are expanded recursively."
-  [form]
-  (let [[f & bodies] form
-	name         (when (symbol? (first bodies)) (first bodies))
-	bodies       (if (symbol? (first bodies)) (rest bodies) bodies)
-	bodies       (if (vector? (first bodies)) (list bodies) bodies)
-	bodies       (doall (map expand-fn-body bodies))]
-    (if (nil? name)
-      (cons f bodies)
-      (cons f (cons name bodies)))))
-
-(defn- expand-method
-  "Handle a method in a deftype* or reify* form."
-  [m]
-  (rest (expand-fn (cons 'fn* m))))
-
-(defn- expand-deftype
-  "Handle deftype* forms."
-  [[symbol typename classname fields implements interfaces & methods]]
-  (assert (= implements :implements))
-  (let [expanded-methods (map expand-method methods)]
-    (concat
-     (list symbol typename classname fields implements interfaces)
-     expanded-methods)))
-
-(defn- expand-reify
-  "Handle reify* forms."
-  [[symbol interfaces & methods]]
-  (let [expanded-methods (map expand-method methods)]
-    (cons symbol (cons interfaces expanded-methods))))
-
-(def special-form-handlers
-  {'quote 	  identity
-   'var   	  identity
-   'def   	  #(expand-args % 2)
-   'new           #(expand-args % 2)
-   'let*          expand-with-bindings
-   'loop*         expand-with-bindings
-   'fn*           expand-fn
-   'deftype*      expand-deftype
-   'reify*        expand-reify})
-
-(defn- expand-list
-  "Recursively expand a form that is a list or a cons."
-  [form]
-  (let [f (first form)]
-    (if (symbol? f)
-      (if (contains? special-forms f)
-	((get special-form-handlers f expand-args) form)
-	(expand-args form))
-      (doall (map expand-all form)))))
-
-(defn- expand-all
-  "Expand a form recursively."
-  [form]
-  (let [exp (expand form)]
-    (cond (symbol? exp) exp
-	  (seq? exp) (expand-list exp)
-	  (vector? exp) (into [] (map expand-all exp))
-	  (map? exp) (into {} (map expand-all (seq exp)))
-	  :else exp)))
-
-(defmacro macrolet
-  "Define local macros that are used in the expansion of exprs. The
-   syntax is the same as for letfn forms."
-  [fn-bindings & exprs]
-  (let [names      (map first fn-bindings)
-	name-map   (into {} (map (fn [n] [(list 'quote n) n]) names))
-	macro-map  (eval `(letfn ~fn-bindings ~name-map))]
-    (binding [macro-fns     (merge macro-fns macro-map)
-	      macro-symbols (apply dissoc macro-symbols names)]
-      `(do ~@(doall (map expand-all exprs))))))


desired capabilities added

desired capabilities added

--- src/etaoin/api.clj
+++ src/etaoin/api.clj
@@ -137,11 +137,11 @@
   side-effect. All the further requests are made within specific
   session. Some drivers may work with only one active session. Returns
   a long string identifier."
-  [driver]
+  [driver & [capabilities]]
   (with-resp driver
     :post
     [:session]
-    {:desiredCapabilities {}}
+    {:desiredCapabilities (or capabilities {})}
     result
     (:sessionId result)))

@@ -1926,11 +1926,25 @@
   "Connects to a running Webdriver server.

   Creates a new session on Webdriver HTTP server. Sets the session to
-  the driver. Returns the modified driver."
+  the driver. Returns the modified driver.
+
+  Arguments:
+
+  - `opt`: an map of the following optional parameters:
+
+  -- `:desired-capabilities` a map of desired capabilities your
+  browser should support. There are some common capabilities that most
+  of the browsers support. Besides that, each driver accepts its own
+  capabilities to regilate internal behaviour.
+
+  See https://www.w3.org/TR/webdriver/#capabilities"
   [driver & [opt]]
   (wait-running driver)
-  (let [session (create-session driver)]
-    (swap! driver assoc :session session)
+  (let [capabilities (:desired-capabilities opt)
+        session (create-session driver capabilities)]
+    (swap! driver assoc
+           :session session
+           :desired-capabilities capabilities)
     driver))

 (defn disconnect-driver
@@ -1940,7 +1954,8 @@
   session from the driver instance. Returns modified driver."
   [driver]
   (delete-session driver)
-  (swap! driver dissoc :session)
+  (swap! driver dissoc
+         :session :desired-capabilities)
   driver)

 (defn stop-driver


Simplify, cutting out half the code of new version.

--- src/exp/sahucs.clj
+++ src/exp/sahucs.clj
@@ -16,7 +16,7 @@
 ;; Difficulty: nodes with multiple ancestors.

 (defprotocol HasCutoff (cutoff [x]))
-(defprotocol HasQueue (queue [x]))
+(defprotocol HasQueue  (queue [x]))

 (deftype PartialResult [result-map cutoff]
   HasCutoff (cutoff [] cutoff))
@@ -30,15 +30,13 @@
   HasCutoff (cutoff [] (- (second (queues/pq-peek-min queue))))
   HasQueue  (queue [] queue))

-(deftype SeqNodeEntry [state sanode reward-to-state remaining-actions]
+;; Represents an action sequence from a state, with sanode representing the first action in remaining-actions.
+ ; (or nil, if remaining-actions is empty.)
+(deftype SANodeEntry [state sanode reward-to-state remaining-actions]
   Object
    (equals [y] (and (= state (:state y)) (= remaining-actions (:remaining-actions y))))
    (hashCode [] (unchecked-add (int (hash state))
                                (unchecked-multiply (int 13) (int (hash remaining-actions))))))
-
-(deftype SeqNode [queue]
-  HasCutoff (cutoff [] (- (second (queues/pq-peek-min queue))))
-  HasQueue  (queue [] queue))

 (defn make-queue [initial-elements]
@@ -47,11 +45,10 @@
     (queues/pq-add-all! q initial-elements)
     q))

-(defn merge-safe
-  "Merge maps m1 and m2.  If a key is in m1 and m2, the value for m1 will be retained.
-   Moreover, we will assert that (pred m1-val m2-val)."
-  [pred m1 m2]
-  (merge-with (fn [x y] (assert (pred x y)) x) m1 m2))
+(defn assoc-safe [m pred k v]
+  (if (contains? m k)
+    (do (assert (pred (get m k) v)) m)
+    (assoc m k v)))

 ; empty refinement !

@@ -65,22 +62,9 @@
             [ss r] (when-let [x (and prim? (env/applicable? a s) (env/successor a s))] x)] ;pun
         (SANode context a
           (atom (if ss {(vary-meta (env/extract-effects ss context) assoc :opt [a]) r} {}))
-          (make-queue
-           (for [ref (when-not prim? (hierarchy/immediate-refinements a s))]
-             [(SeqNode (make-queue [[(SeqNodeEntry s (when (seq ref) (get-sa-node cache s (first ref))) 0.0 ref) 0.0]])) 0.0])))))))
+          (make-queue (for [ref (when-not prim? (hierarchy/immediate-refinements a s))]
+                        [(SANodeEntry s (when (seq ref) (get-sa-node cache s (first ref))) 0.0 ref) 0.0])))))))

-
-;; Result-fn returns
-(defn expand-helper [node cache next-best init-results result-fn]
-  (if (< (cutoff node) next-best)
-    (do ;#_ (println "done " (type node)  (cutoff node) init-results)
-        (PartialResult init-results (cutoff node)))
-    (let [[best-child neg-reward] (queues/pq-remove-min-with-cost! (queue node))
-          next-best (max next-best (cutoff node))
-          [new-states adj-reward new-pairs] (result-fn best-child (- neg-reward) next-best)]
-      (when (> adj-reward Double/NEGATIVE_INFINITY) (queues/pq-replace! (queue node) best-child (- adj-reward)))
-      (doseq [[n r] new-pairs] (queues/pq-add! (queue node) n (- r)))
-      (recur node cache next-best (merge init-results new-states) result-fn))))

 (defn stitch-results [effect-map state reward-to-state]
@@ -90,43 +74,28 @@
       (+ reward-to-state local-reward)])
    effect-map))

-;; May return states better than next-best, but these will be held at the seq node.
-(declare  expand-seq-node)
+;; May return states better than next-best, but these will be held at the parent.
 (defn expand-sa-node [#^::SANode node #^HashMap cache next-best state reward-to-state last-cutoff]
-;  (util/timeout)
-;  (println "SA" (env/action-name (:action node)) last-cutoff (cutoff node) next-best reward-to-state)
-  (util/assert-is (= (type node) ::SANode))
-  (expand-helper node cache next-best
-    (if (= last-cutoff (cutoff node)) {}
-        (stitch-results
-         (util/filter-map #(<= (val %) last-cutoff)  @(:result-map-atom node))
-         state reward-to-state))
-    (fn [best-child reward next-best]
-      (let [result (expand-seq-node best-child cache next-best)
-            effect-map (util/map-keys #(vary-meta (env/extract-effects % (:context node)) assoc :opt (:opt (meta %)))
-                                      (:result-map result))]
-;        (println "Got seq results " result reward-to-state)
-        (swap! (:result-map-atom node) (partial merge-safe >=) effect-map)
-        [(stitch-results effect-map state reward-to-state) (:cutoff result) nil]))))
+  (loop [new-results (if (= last-cutoff (cutoff node)) {}
+                         (util/filter-map #(<= (val %) last-cutoff)  @(:result-map-atom node)))]
+     (if (< (cutoff node) next-best)
+         (PartialResult (stitch-results new-results state reward-to-state) (cutoff node))
+       (let [[entry neg-reward] (queues/pq-remove-min-with-cost! (queue node))
+             b-s (:state entry), b-rts (:reward-to-state entry), b-ra (:remaining-actions entry), b-sa (:sanode entry)
+             rec-next-best (max next-best (cutoff node))]
+           (if (empty? b-ra)
+               (let [eff (vary-meta (env/extract-effects b-s (:context node)) assoc :opt (:opt (meta b-s)))]
+                 (swap! (:result-map-atom node) assoc-safe >= eff b-rts)
+                 (recur (assoc-safe new-results >= eff b-rts)))
+             (let [rec (expand-sa-node b-sa cache (- rec-next-best b-rts) b-s b-rts (- 0 neg-reward b-rts))]
+               (when (> (:cutoff rec) Double/NEGATIVE_INFINITY)
+                 (queues/pq-replace! (queue node) entry (- 0 b-rts (:cutoff rec))))
+               (doseq [[ss sr] (:result-map rec)]
+                 (queues/pq-add! (queue node)
+                   (SeqNodeEntry ss (when (next b-ra) (get-sa-node cache ss (second b-ra))) sr (next b-ra))
+                   (- sr)))
+               (recur new-results)))))))

-;; Will never return anything worse than next-best.
-(defn expand-seq-node [#^::SeqNode node #^HashMap cache next-best]
-;  (println "Seq")
-  (util/assert-is (= (type node) ::SeqNode))
-  (expand-helper node cache next-best {}
-    (fn [entry reward next-best]
-      (let [{:keys [state reward-to-state remaining-actions sanode]} entry]
-;        (println "ACTIONS " (map env/action-name remaining-actions))
-        (if (empty? remaining-actions)
-            [{state reward-to-state} Double/NEGATIVE_INFINITY nil]
-          (let [result (expand-sa-node sanode cache (- next-best reward-to-state) state
-                                       reward-to-state (- reward reward-to-state))]
-;            (println "SEQ" (:result-map result))
-            [{} (+ reward-to-state (:cutoff result))
-              (for [[s r] (:result-map result)]
-                [(SeqNodeEntry s (when (next remaining-actions) (get-sa-node cache s (second remaining-actions)))
-                               r (next remaining-actions))
-                 r])]))))))

 (defn sahucs [henv]


Trace facts

Trace facts

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -181,7 +181,6 @@
   (get x 1)
   (get x :b)

-
   (= eg (fact-shape ::eg "[a] has a [b] with a [c]"))

   (fact (fact-shape ::eg "[a] has a [b] with a [c]") #js ["a" "b" "c"])
@@ -202,9 +201,11 @@

 ;; FLOW STATE

-(defrecord FlowState [node->state node->out-nodes node->facts node->update!])
-
-(defn fixpoint! [{:keys [node->state node->out-nodes node->facts node->update!] :as flow-state}]
+(defrecord FlowState [node->state node->out-nodes node->facts node->update! trace])
+
+(def trace? true)
+
+(defn fixpoint! [{:keys [node->state node->out-nodes node->facts node->update! trace] :as flow-state}]
   (loop [node 0]
     (when (< node (alength node->facts))
       (let [in-facts (aget node->facts node)]
@@ -213,6 +214,7 @@
           (let [out-facts #js []]
             (.call (aget node->update! node) nil node node->state in-facts out-facts)
             (aset node->facts node #js [])
+            (when trace? (.push trace #js [node in-facts out-facts]))
             (if (> (alength out-facts) 0)
               (let [out-nodes (aget node->out-nodes node)
                     min-out-node (areduce out-nodes i min-out-node (+ node 1)
@@ -312,7 +314,8 @@
   (let [node->state (into-array (for [_ node->flow] nil))
         node->out-nodes (into-array (for [_ node->flow] #js []))
         node->facts (into-array (for [_ node->flow] #js []))
-        node->update! (into-array (for [_ node->flow] nil))]
+        node->update! (into-array (for [_ node->flow] nil))
+        trace #js []]
     (dotimes [node (count node->flow)]
       (let [flow (nth node->flow node)]
         (aset node->state node
@@ -329,7 +332,7 @@
                 FilterMap (filter-map-update! (apply (resolve (first (:fun&args flow))) (rest (:fun&args flow))))
                 Index (index-update! (:key-ixes flow))
                 Lookup (lookup-update! (:index-node flow) (:key-ixes flow) (:val-ixes flow))))))
-    (FlowState. node->state node->out-nodes node->facts node->update!)))
+    (FlowState. node->state node->out-nodes node->facts node->update! trace)))

 (defn memory->node [memory]
   (case memory


docker-build

docker-build

--- src/modus/core.clj
+++ src/modus/core.clj
@@ -1,7 +0,0 @@
-(ns modus.core
-  (:gen-class))
-
-(defn -main
-  "I don't do a whole lot ... yet."
-  [& args]
-  (println "Hello, World!"))


CLJS-628: *cljs-file* not bound when compiling to stdout

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -384,10 +384,11 @@
   returns a JavaScriptFile. In either case the return value satisfies
   IJavaScript."
   [^File file {:keys [output-file] :as opts}]
-  (if output-file
-    (let [out-file (io/file (output-directory opts) output-file)]
-      (compiled-file (comp/compile-file file out-file opts)))
-    (compile-form-seq (ana/forms-seq file))))
+    (if output-file
+      (let [out-file (io/file (output-directory opts) output-file)]
+        (compiled-file (comp/compile-file file out-file opts)))
+      (binding [ana/*cljs-file* (.getPath ^java.io.File file)]
+        (compile-form-seq (ana/forms-seq file)))))

 (defn compile-dir
   "Recursively compile all cljs files under the given source


tweaks to update logic

tweaks to update logic

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -1152,9 +1152,11 @@
                     start (util/now)]
                 (when (seq (.pollEvents key))
                   (print "Change detected, recompiling...")
+                  (flush)
                   (build source opts compiler-env)
                   (println " done. Elapsed"
-                    (util/to-secs (- (util/now) start)) "seconds"))
+                    (util/to-secs (unchecked-subtract (util/now) start)) "seconds")
+                  (flush))
                 (recur key)))))
         (catch Exception e
           (.printStackTrace e)
@@ -1165,6 +1167,7 @@
     {:optimizations :none
      :output-to "samples/hello/out/hello.js"
      :output-dir "samples/hello/out"
+     :cache-analysis true
      :source-map true})
   )


Submitting score on enter-key

Submitting score on enter-key

--- src/cljs/darts/core.cljs
+++ src/cljs/darts/core.cljs
@@ -78,6 +78,13 @@
 (defn clear-message []
   (reset! message ""))

+(defn submit-score []
+  (let [new-score (js/parseInt @score)
+        points (points @current-player)]
+    (if (valid-score? new-score points)
+      (record-score @current-player @score)
+      (reset! message "Score not valid"))))
+
 (defn numpad []
   [:div
    (map (fn [n]
@@ -92,12 +99,7 @@
    [:button {:on-click (fn []
                          (reset! score "")
                          (clear-message))} "Clear"]
-   [:button {:on-click (fn []
-                         (let [new-score (js/parseInt @score)
-                               points (points @current-player)]
-                           (if (valid-score? new-score points)
-                             (record-score @current-player @score)
-                             (reset! message "Score not valid"))))} "Enter"]])
+   [:button {:on-click submit-score} "Enter"]])

@@ -115,6 +117,9 @@
     [:br]
     [:input {:type :text
              :value @score
+             :on-key-press (fn [e]
+                             (when (= (.-key e) "Enter")
+                               (submit-score)))
              :on-change (fn [e] (let [value (str (-> e .-target .-value))
                                       value (apply str (filter #(contains? #{\1 \2 \3 \4 \5 \6 \7 \8 \9 \0} %)
                                                                value))]


Don't try to unbox js or goog types we have no knowledge of.

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -162,12 +162,13 @@
 (defn go-type [tag]
   (if-let [ns (and (symbol? tag) (namespace tag))]
     (let [ns (symbol ns)
+          goog? (= 'goog ns)
           type? (get-in (ana/get-namespace ns) [:defs (symbol (name tag)) :type])]
       (str
-       (when type? "*")
+       (when (or type? goog?) "*")
        (munge (cond
                ((hash-set 'cljs.core ana/*cljs-ns*) ns) (go-type-fqn tag)
-               (= 'goog ns) (go-normalize-goog-type tag)
+               goog? (go-normalize-goog-type tag)
                :else (str ns "." (go-type-fqn tag))))))
     (go-tag->type tag "interface{}")))

@@ -817,7 +818,10 @@
     (emitln (comma-sep params)
             " = "
             (comma-sep (for [[e p] (map vector exprs params)]
-                         (str (emit-str e) (go-unbox-no-emit (go-try-to-ressurect-impl p) e))))))
+                         (str (emit-str e)
+                              (when-not ('#{goog js} (and (symbol? (:tag p))
+                                                          (some-> p :tag namespace symbol)))
+                                (go-unbox-no-emit (go-try-to-ressurect-impl p) e)))))))
   (emitln "continue"))

 (defmethod emit* :letfn


Ensure game works on German Keyboard

Ensure game works on German Keyboard

--- src/cljs/kenny/core.cljs
+++ src/cljs/kenny/core.cljs
@@ -520,14 +520,17 @@
 (defn start-moving [e app]
   (condp = (aget e "keyCode")
     88 (om/update! app [:hero :dx] 5)
+    89 (om/update! app [:hero :dx] -5)
     90 (om/update! app [:hero :dx] -5)
     nil
     )
   )

 (defn stop-moving [e app]
+    (println (aget e "keyCode"))
   (condp = (aget e "keyCode")
     88 (om/update! app [:hero :dx] 0)
+    89 (om/update! app [:hero :dx] 0)
     90 (om/update! app [:hero :dx] 0)
     nil
     )


using reagent atom in form to allow editing

--- src/cljs/ohds/pages.cljs
+++ src/cljs/ohds/pages.cljs
@@ -1,5 +1,7 @@
 (ns ohds.pages
-  (:require [ohds.components :as c]))
+  (:require
+   [reagent.core :refer [atom]]
+   [ohds.components :as c]))

 (defn login-page [do-login app-state]
   (let [username (atom "Username")
@@ -16,4 +18,7 @@
        [:div
         [:button {:class "btn btn-lg btn-primary btn-block" :type "submit"
                   :on-click (fn [] (do-login username password))}
-         "Login"]]])))
+         "Login"]]
+       [:div @username]
+       [:div @password]]
+      )))


Fix logging utility.

Fix logging utility.

--- src/clojure/neko/log.clj
+++ src/clojure/neko/log.clj
@@ -66,8 +66,8 @@
                    (-> (partial ~log-fn ~tag)
                        (with-meta  {:private true}))))]
     `(do
-       ~(intern-logger "log-d" `log-debug)
-       ~(intern-logger "log-e" `log-error)
-       ~(intern-logger "log-i" `log-info)
-       ~(intern-logger "log-v" `log-verbose)
-       ~(intern-logger "log-w" `log-warn))))
+       ~(intern-logger "log-d" `d)
+       ~(intern-logger "log-e" `e)
+       ~(intern-logger "log-i" `i)
+       ~(intern-logger "log-v" `v)
+       ~(intern-logger "log-w" `w))))


Starts fix for hanging threads.

Starts fix for hanging threads.

--- src/onyx/peer/task_pipeline.clj
+++ src/onyx/peer/task_pipeline.clj
@@ -87,96 +87,110 @@
     (extensions/touch-place sync completion-node))
   event)

-(defn open-session-loop [read-ch kill-ch pipeline-data]
+(defn open-session-loop [read-ch kill-ch pipeline-data dead-ch]
   (loop []
     (when (first (alts!! [kill-ch] :default true))
       (when-let [session (create-tx-session pipeline-data)]
         (>!! read-ch (munge-open-session pipeline-data session))
-        (recur)))))
-
-(defn read-batch-loop [read-ch decompress-ch]
+        (recur))))
+  (>!! dead-ch true))
+
+(defn read-batch-loop [read-ch decompress-ch dead-ch]
   (loop []
     (when-let [event (<!! read-ch)]
       (>!! decompress-ch (munge-read-batch event))
-      (recur))))
-
-(defn decompress-batch-loop [decompress-ch strip-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn decompress-batch-loop [decompress-ch strip-ch dead-ch]
   (loop []
     (when-let [event (<!! decompress-ch)]
       (>!! strip-ch (munge-decompress-batch event))
-      (recur))))
-
-(defn strip-sentinel-loop [strip-ch requeue-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn strip-sentinel-loop [strip-ch requeue-ch dead-ch]
   (loop []
     (when-let [event (<!! strip-ch)]
       (>!! requeue-ch (munge-strip-sentinel event))
-      (recur))))
-
-(defn requeue-sentinel-loop [requeue-ch apply-fn-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn requeue-sentinel-loop [requeue-ch apply-fn-ch dead-ch]
   (loop []
     (when-let [event (<!! requeue-ch)]
       (>!! apply-fn-ch (munge-requeue-sentinel event))
-      (recur))))
-
-(defn apply-fn-loop [apply-fn-ch compress-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn apply-fn-loop [apply-fn-ch compress-ch dead-ch]
   (loop []
     (when-let [event (<!! apply-fn-ch)]
       (>!! compress-ch (munge-apply-fn event))
-      (recur))))
-
-(defn compress-batch-loop [compress-ch write-batch-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn compress-batch-loop [compress-ch write-batch-ch dead-ch]
   (loop []
     (when-let [event (<!! compress-ch)]
       (>!! write-batch-ch (munge-compress-batch event))
-      (recur))))
-
-(defn write-batch-loop [write-ch status-check-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn write-batch-loop [write-ch status-check-ch dead-ch]
   (loop []
     (when-let [event (<!! write-ch)]
       (>!! status-check-ch (munge-write-batch event))
-      (recur))))
-
-(defn status-check-loop [status-ch ack-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn status-check-loop [status-ch ack-ch dead-ch]
   (loop []
     (when-let [event (<!! status-ch)]
       (>!! ack-ch (munge-status-check event))
-      (recur))))
-
-(defn ack-loop [ack-ch commit-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn ack-loop [ack-ch commit-ch dead-ch]
   (loop []
     (when-let [event (<!! ack-ch)]
       (>!! commit-ch (munge-ack event))
-      (recur))))
-
-(defn commit-tx-loop [commit-ch close-resources-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn commit-tx-loop [commit-ch close-resources-ch dead-ch]
   (loop []
     (when-let [event (<!! commit-ch)]
       (>!! close-resources-ch (munge-commit-tx event))
-      (recur))))
-
-(defn close-resources-loop [close-ch reset-payload-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn close-resources-loop [close-ch reset-payload-ch dead-ch]
   (loop []
     (when-let [event (<!! close-ch)]
       (>!! reset-payload-ch (munge-close-resources event))
-      (recur))))
-
-(defn reset-payload-node [reset-ch internal-complete-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn reset-payload-node [reset-ch internal-complete-ch dead-ch]
   (loop []
     (when-let [event (<!! reset-ch)]
       (if (and (:tail-batch? event) (:commit? event))
         (let [event (munge-new-payload event)]
           (>!! internal-complete-ch event))
         (>!! internal-complete-ch event))
-      (recur))))
-
-(defn complete-task-loop [complete-ch]
+      (recur)))
+  (>!! dead-ch true))
+
+(defn complete-task-loop [complete-ch dead-ch]
   (loop []
     (when-let [event (<!! complete-ch)]
       (when (and (:tail-batch? event) (:commit? event))
         (munge-complete-task event)
         (when (:completion? event)
           (>!! (:complete-ch event) :task-completed)))
-      (recur))))
+      (recur)))
+  (>!! dead-ch true))

 (defrecord TaskPipeline [payload sync queue payload-ch complete-ch]
   component/Lifecycle
@@ -198,6 +212,21 @@
           close-resources-ch (chan 0)
           reset-payload-node-ch (chan 0)
           complete-task-ch (chan 0)
+
+          open-session-dead-ch (chan)
+          read-batch-dead-ch (chan)
+          decompress-batch-dead-ch (chan)
+          strip-sentinel-dead-ch (chan)
+          requeue-sentinel-dead-ch (chan)
+          apply-fn-dead-ch (chan)
+          compress-batch-dead-ch (chan)
+          status-check-dead-ch (chan)
+          write-batch-dead-ch (chan)
+          ack-dead-ch (chan)
+          commit-tx-dead-ch (chan)
+          close-resources-dead-ch (chan)
+          reset-payload-node-dead-ch (chan)
+          complete-task-dead-ch (chan)

           pipeline-data {:ingress-queues (:task/ingress-queues (:task payload))
                          :egress-queues (:task/egress-queues (:task payload))
@@ -284,39 +313,96 @@
         :close-resources-ch close-resources-ch
         :reset-payload-node-ch reset-payload-node-ch
         :complete-task-ch complete-task-ch
+
+        :open-session-dead-ch open-session-dead-ch
+        :read-batch-dead-ch read-batch-dead-ch
+        :decompress-batch-dead-ch decompress-batch-dead-ch
+        :strip-sentinel-dead-ch strip-sentinel-dead-ch
+        :requeue-sentinel-dead-ch requeue-sentinel-dead-ch
+        :apply-fn-dead-ch apply-fn-dead-ch
+        :compress-batch-dead-ch compress-batch-dead-ch
+        :status-check-dead-ch status-check-dead-ch
+        :write-batch-dead-ch write-batch-dead-ch
+        :ack-dead-ch ack-dead-ch
+        :commit-tx-dead-ch commit-tx-dead-ch
+        :close-resources-dead-ch close-resources-dead-ch
+        :reset-payload-node-dead-ch reset-payload-node-dead-ch
+        :complete-task-dead-ch complete-task-dead-ch

-        :open-session-loop (thread (open-session-loop read-batch-ch open-session-kill-ch pipeline-data))
-        :read-batch-loop (thread (read-batch-loop read-batch-ch decompress-batch-ch))
-        :decompress-batch-loop (thread (decompress-batch-loop decompress-batch-ch strip-sentinel-ch))
-        :strip-sentinel-loop (thread (strip-sentinel-loop strip-sentinel-ch requeue-sentinel-ch))
-        :requeue-sentinel-ch (thread (requeue-sentinel-loop requeue-sentinel-ch apply-fn-ch))
-        :apply-fn-loop (thread (apply-fn-loop apply-fn-ch compress-batch-ch))
-        :compress-batch-loop (thread (compress-batch-loop compress-batch-ch write-batch-ch))
-        :write-batch-loop (thread (write-batch-loop write-batch-ch status-check-ch))
-        :status-check-loop (thread (status-check-loop status-check-ch ack-ch))
-        :ack-loop (thread (ack-loop ack-ch commit-tx-ch))
-        :commit-tx-loop (thread (commit-tx-loop commit-tx-ch close-resources-ch))
-        :close-resources-loop (thread (close-resources-loop close-resources-ch reset-payload-node-ch))
-        :reset-payload-node (thread (reset-payload-node reset-payload-node-ch complete-task-ch))
-        :complete-task-loop (thread (complete-task-loop complete-task-ch)))))
+        :open-session-loop (thread (open-session-loop read-batch-ch open-session-kill-ch pipeline-data open-session-dead-ch))
+        :read-batch-loop (thread (read-batch-loop read-batch-ch decompress-batch-ch read-batch-dead-ch))
+        :decompress-batch-loop (thread (decompress-batch-loop decompress-batch-ch strip-sentinel-ch decompress-batch-dead-ch))
+        :strip-sentinel-loop (thread (strip-sentinel-loop strip-sentinel-ch requeue-sentinel-ch strip-sentinel-dead-ch))
+        :requeue-sentinel-ch (thread (requeue-sentinel-loop requeue-sentinel-ch apply-fn-ch requeue-sentinel-dead-ch))
+        :apply-fn-loop (thread (apply-fn-loop apply-fn-ch compress-batch-ch apply-fn-dead-ch))
+        :compress-batch-loop (thread (compress-batch-loop compress-batch-ch write-batch-ch compress-batch-dead-ch))
+        :write-batch-loop (thread (write-batch-loop write-batch-ch status-check-ch write-batch-dead-ch))
+        :status-check-loop (thread (status-check-loop status-check-ch ack-ch status-check-dead-ch))
+        :ack-loop (thread (ack-loop ack-ch commit-tx-ch ack-dead-ch))
+        :commit-tx-loop (thread (commit-tx-loop commit-tx-ch close-resources-ch commit-tx-dead-ch))
+        :close-resources-loop (thread (close-resources-loop close-resources-ch reset-payload-node-ch close-resources-dead-ch))
+        :reset-payload-node (thread (reset-payload-node reset-payload-node-ch complete-task-ch reset-payload-node-dead-ch))
+        :complete-task-loop (thread (complete-task-loop complete-task-ch complete-task-dead-ch)))))

   (stop [component]
     (taoensso.timbre/info "Stopping Task Pipeline")

     (close! (:open-session-kill-ch component))
-    ;; (close! (:read-batch-ch component))
-    ;; (close! (:decompress-batch-ch component))
-    ;; (close! (:strip-sentinel-ch component))
-    ;; (close! (:requeue-sentinel-ch component))
-    ;; (close! (:apply-fn-ch component))
-    ;; (close! (:compress-batch-ch component))
-    ;; (close! (:write-batch-ch component))
-    ;; (close! (:status-check-ch component))
-    ;; (close! (:ack-ch component))
-    ;; (close! (:commit-tx-ch component))
-    ;; (close! (:close-resources-ch component))
-    ;; (close! (:reset-payload-node-ch component))
-    ;; (close! (:complete-task-ch component))
+    (<!! (:open-session-dead-ch component))
+
+    (close! (:read-batch-ch component))
+    (<!! (:read-batch-dead-ch component))
+
+    (close! (:decompress-batch-ch component))
+    (<!! (:decompress-batch-dead-ch component))
+
+    (close! (:strip-sentinel-ch component))
+    (<!! (:strip-sentinel-dead-ch component))
+
+    (close! (:requeue-sentinel-ch component))
+    (<!! (:requeue-sentinel-dead-ch component))
+
+    (close! (:apply-fn-ch component))
+    (<!! (:apply-fn-dead-ch component))
+
+    (close! (:compress-batch-ch component))
+    (<!! (:compress-batch-dead-ch component))
+
+    (close! (:write-batch-ch component))
+    (<!! (:write-batch-dead-ch component))
+
+    (close! (:status-check-ch component))
+    (<!! (:status-check-dead-ch component))
+
+    (close! (:ack-ch component))
+    (<!! (:ack-dead-ch component))
+
+    (close! (:commit-tx-ch component))
+    (<!! (:commit-tx-dead-ch component))
+
+    (close! (:close-resources-ch component))
+    (<!! (:close-resources-dead-ch component))
+
+    (close! (:reset-payload-node-ch component))
+    (<!! (:reset-payload-node-dead-ch component))
+
+    (close! (:complete-task-ch component))
+    (<!! (:complete-task-dead-ch component))
+
+    (close! (:open-session-dead-ch component))
+    (close! (:read-batch-dead-ch component))
+    (close! (:decompress-batch-dead-ch component))
+    (close! (:strip-sentinel-dead-ch component))
+    (close! (:requeue-sentinel-dead-ch component))
+    (close! (:apply-fn-dead-ch component))
+    (close! (:compress-batch-dead-ch component))
+    (close! (:status-check-dead-ch component))
+    (close! (:write-batch-dead-ch component))
+    (close! (:ack-dead-ch component))
+    (close! (:commit-tx-dead-ch component))
+    (close! (:close-resources-dead-ch component))
+    (close! (:reset-payload-node-dead-ch component))
+    (close! (:complete-task-dead-ch component))

     component))


fix test case due to disease name change

--- test/wb_es/core_test.clj
+++ test/wb_es/core_test.clj
@@ -36,11 +36,12 @@
   (do
     (let [index-url (format "%s/%s" es-base-url index-name)]
       (do
-        (try
-          (http/delete index-url)
-          (catch clojure.lang.ExceptionInfo e
-            (prn "failed to delete index.")
-            (prn e)))
+        (if (http/get index-url)
+          (try
+            (http/delete index-url)
+            (catch clojure.lang.ExceptionInfo e
+              (prn "failed to delete index.")
+              (prn e))))
         (http/put index-url {:headers {:content-type "application/json"}
                              :body (->> (assoc-in mappings/index-settings [:settings :number_of_shards] 1)
                                         (json/generate-string))})
@@ -160,9 +161,9 @@
                           (= "Parkinson's disease"
                              (get-in hit [:_source :label])))
                         hits)))
-            (testing "matching early-onset Parkinson disease"
-              (is (some (fn [hit]
-                          (= "early-onset Parkinson disease"
+            (testing "matching early-onset Parkinson's disease"
+              (is (some (fn [hit]
+                          (= "early-onset Parkinson's disease"
                              (get-in hit [:_source :label])))
                         hits)))
             (testing "X-linked dystonia-parkinsonism"


util/context.clj: added doc strings

util/context.clj: added doc strings

--- src/org/altlaw/util/context.clj
+++ src/org/altlaw/util/context.clj
@@ -32,22 +32,38 @@

 ;;; PUBLIC

-(defn setup-context [obj]
+(defn setup-context
+  "Set up AltLaw's context object from the given context/configuration
+  object."
+  [obj]
   (alter-var-root #'*altlaw-context*
                   (fn [old] (merge *default-context* (extract-context obj)))))

-(defn altlaw-home []
+(defn altlaw-home
+  "AltLaw's home directory, as String."
+  []
   (:home *altlaw-context*))

-(defn altlaw-env []
+(defn altlaw-env
+  "AltLaw's running environment, a String.
+  One of production/development/testing."
+  []
   (:env *altlaw-context*))

-(defn altlaw-internal-uri []
+(defn altlaw-internal-uri
+  "The base URI of the internal.altlaw.org server.  String, includes
+  the scheme and host name, but not the initial slash."
+  []
   (:internal-uri *altlaw-context*))

-(defmacro with-altlaw-env [name & body]
+(defmacro with-altlaw-env
+  "Run body with a modified altlaw-env string."
+  [name & body]
   `(binding [*altlaw-context* (assoc *altlaw-context* :env name)]
      ~@body))

-(defn testing-env-fixture [f]
+(defn testing-env-fixture
+  "Fixture function for use in tests.  Sets the altlaw-env to
+  'testing'."
+  [f]
   (with-altlaw-env "testing" (f)))


properly delimit stringified clojure vector representing the serialized graph of a lexeme or an expression

--- src/babel/writer.clj
+++ src/babel/writer.clj
@@ -152,9 +152,10 @@

   (try
     (exec-raw [(str "INSERT INTO " table " (surface, structure, serialized, language, model) VALUES (?,"
-                    "$$" (json/write-str (strip-refs expression)) "$$"
+                    ;; TODO: dissoc the spec per immediately below TODO
+                    "$$" (json/write-str (strip-refs expression)) "$$" ;; TODO: store the :spec in a new column 'spec' within the given table.
                     ","
-                    "$$" (str (serialize expression)) "$$"
+                    "$$[" (string/join "" (serialize expression)) "]$$" ;; TODO: check for presence of "$$" within (serialize expression).
                     ","
                     "?,?)")
                [surface
@@ -175,7 +176,7 @@
                           VALUES (?,"
                     "$$" (json/write-str (strip-refs lexeme)) "$$"
                     ",?,?)")
-               [canonical (str "[" (string/join " " (serialize lexeme))
+               [canonical (str "[" (string/join " " (serialize lexeme)) ;; TODO: remove unneeded whitespace: string/join "" should work fine.
                                "]")
                 language]])))


Use clojure function notation instead of dot notation.

--- test/benchmark_test/method_call_tests.clj
+++ test/benchmark_test/method_call_tests.clj
@@ -647,7 +647,7 @@
   (let [r (MyRec. 1)]
     (cc/with-progress-reporting
       (cc/quick-bench
-        (.bar r 2)
+        (bar r 2)
         :verbose))))

 (deftest defrecord-benchmark-1
@@ -671,7 +671,7 @@
   (let [t (MyType. 1)]
     (cc/with-progress-reporting
       (cc/quick-bench
-        (.bar t 2)
+        (bar t 2)
         :verbose))))

 (deftest deftype-benchmark-1


[Add] cond in update-exp

[Add] cond in update-exp

--- src/clj_elm/core.clj
+++ src/clj_elm/core.clj
@@ -108,13 +108,14 @@
        (sign))))

 (defn update-exp [fn key exp]
+  {:pre [(fn? fn) (keyword? key) (map? @exp)]}
   (reset! exp (assoc @exp key (fn (key @exp))))
   exp)

 (defn count-rate [pred fact exp]
   {:pre [(= (Math/abs pred) (Math/abs fact) 1) (map? @exp)]}
   (cond
-    (and (= pred 1) (= fact 1)) (update-exp :TP inc exp)
+    (and (= pred 1) (= fact 1)) (update-exp inc :TP exp)
     (and (= pred 1) (= fact -1)) (update-exp inc :FP exp)
     (and (= pred -1) (= fact -1)) (update-exp inc :TN exp)
     (and (= pred -1) (= fact 1)) (update-exp inc :FN exp)))


(PDB-3169) Increase timeout in command test

This sometimes times out when running on shared test infrastructure; attempt to
work around this by increasing the timeout.

--- test/puppetlabs/puppetdb/command_test.clj
+++ test/puppetlabs/puppetdb/command_test.clj
@@ -53,7 +53,8 @@
             [puppetlabs.puppetdb.queue :as queue]
             [puppetlabs.trapperkeeper.services
              :refer [service-context]]
-            [overtone.at-at :refer [mk-pool scheduled-jobs]])
+            [overtone.at-at :refer [mk-pool scheduled-jobs]]
+            [puppetlabs.puppetdb.testutils :as tutils])
   (:import [java.util.concurrent TimeUnit]
            [org.joda.time DateTime DateTimeZone]))

@@ -1304,7 +1305,7 @@

             (handle-message (store-command' q new-catalog-cmd))

-            (is (= ::handled-first-message (deref fut (* 1000 60) nil)))
+            (is (= ::handled-first-message (deref fut tutils/default-timeout-ms nil)))
             (is (empty? (fs/list-dir (:path dlo))))
             (let [failed-cmdref (take-with-timeout!! command-chan default-timeout-ms)]
               (is (= 1 (count (:attempts failed-cmdref))))
@@ -1671,9 +1672,9 @@

            (.release semaphore)

-           (is (not= ::timed-out (deref cmd-1 5000 ::timed-out)))
-           (is (not= ::timed-out (deref cmd-2 5000 ::timed-out)))
-           (is (not= ::timed-out (deref cmd-3 5000 ::timed-out)))
+           (is (not= ::timed-out (deref cmd-1 tutils/default-timeout-ms ::timed-out)))
+           (is (not= ::timed-out (deref cmd-2 tutils/default-timeout-ms ::timed-out)))
+           (is (not= ::timed-out (deref cmd-3 tutils/default-timeout-ms ::timed-out)))

            ;; There's currently a lot of layering in the messaging
            ;; stack. The callback mechanism that delivers the promise


(PDB-3114) command-test: await countdown latches

--- test/puppetlabs/puppetdb/command_test.clj
+++ test/puppetlabs/puppetdb/command_test.clj
@@ -1004,6 +1004,7 @@
                       scf-store/update-facts!
                       (fn [fact-data]
                         (.countDown latch)
+                        (.await latch)
                         (storage-replace-facts! fact-data))]
           (let [first-message? (atom false)
                 second-message? (atom false)
@@ -1217,6 +1218,7 @@
                       scf-store/replace-catalog!
                       (fn [& args]
                         (.countDown latch)
+                        (.await latch)
                         (apply orig-replace-catalog! args))]
           (let [first-message? (atom false)
                 second-message? (atom false)
@@ -1268,6 +1270,7 @@
                       scf-store/replace-catalog!
                       (fn [& args]
                         (.countDown latch)
+                        (.await latch)
                         (apply orig-replace-catalog! args))]
           (let [first-message? (atom false)
                 fut (future


increase threshold for log/warn if no matching lexical head can be found

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -139,7 +139,7 @@
                    (log/debug (str "trying overh with spec: " (strip-refs spec)))
                    (if (and (not (empty? subset)) (empty? result)
                             (> (count subset)
-                               10))
+                               50))
                      ;; log/warn because it's very expensive to run
                      ;; over/overh: for every candidate, both parent
                      ;; and candidate head must be copied.


more simplification

more simplification

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -84,17 +84,16 @@
   "given a bolt, return the lazy sequence of all bolts derived from this bolt after adding,
    at each supplied path in comp-paths, the bolts for that path."
   [bolt model comp-paths bolts-at-paths depth max-depth top-bolt truncate? take-n]
-  (when (not (= :fail bolt))
-    (if (empty? comp-paths)
-      [bolt] ;; done: we've added all the comps to the bolt, so just return the bolt as a singleton vector.
-      (mapfn #(add-comps % model
-                         (rest comp-paths)
-                         (rest bolts-at-paths)
-                         depth max-depth top-bolt truncate? take-n)
-             (flatten
-              (add-bolts-to-path
-               (first comp-paths) (first bolts-at-paths)
-               bolt top-bolt model depth max-depth truncate? take-n))))))
+  (if (empty? comp-paths)
+    [bolt] ;; done: we've added all the comps to the bolt, so just return the bolt as a singleton vector.
+    (mapfn #(add-comps % model
+                       (rest comp-paths)
+                       (rest bolts-at-paths)
+                       depth max-depth top-bolt truncate? take-n)
+           (flatten
+            (add-bolts-to-path
+             (first comp-paths) (first bolts-at-paths)
+             bolt top-bolt model depth max-depth truncate? take-n)))))

 (defn add-bolt-at [top-bolt bolt path bolt-at model depth max-depth truncate? & [take-n]]
   (mapfn #(do-defaults % model)


+(defn morph) (all languages should support a top-level (defn morph)

--- src/babel/italiano.cljc
+++ src/babel/italiano.cljc
@@ -13,6 +13,15 @@
    [clojure.repl :refer [doc]]
    [clojure.string :as string]
    [dag_unify.core :refer [fail-path-between get-in strip-refs unifyc]]))
+
+
+;; can't decide between 'morph' or 'fo' or something other better name.
+(defn morph [expr & {:keys [from-language show-notes]
+                     :or {from-language nil
+                          show-notes true}}]
+  ;; modeled after babel.english/morph:
+  ;; most arguments are simply discarded for italian.
+  (fo expr))

 (defn fo-ps [expr]
   (parse/fo-ps expr fo))


improve logging

improve logging

--- src/babel/lexiconfn.clj
+++ src/babel/lexiconfn.clj
@@ -740,14 +740,21 @@

         true
         (do
-          (log/trace (str "transform: input :" lexical-entry))
-          (log/trace (str "transforming lexical entry: " lexical-entry))
-          (let [result (reduce #(if (or (fail? %1) (fail? %2))
-                                  (do
-                                    (if (fail? %1) (log/warn (str "fail at %1:" %1 " in lexical-entry: " (strip-refs lexical-entry))))
-                                    (if (fail? %2) (log/warn (str "fail at %2:" %2 " in lexical-entry: " (strip-refs lexical-entry))))
-                                    :fail)
-                                  (unifyc %1 %2))
+          (log/debug (str "transforming lexical entry: " lexical-entry))
+          (let [result (reduce #(if (fail? %1)
+                                  (let [message (str "lexical entry fail; entry:" (strip-refs %1) ";")]
+                                    (log/error message)
+                                    (throw (Exception. message)))
+
+                                  (let [result (unifyc %1 %2)]
+                                    (if (fail? result)
+                                      (let [fail-path (get-fail-path %1 %2)
+                                            message (str "lexical entry reduce fail:(fail-path=" fail-path "): "
+                                                         {:f1 (strip-refs (get-in %1 fail-path))
+                                                          :f2 (strip-refs (get-in %2 fail-path))})]
+                                        (log/error message)
+                                        (throw (Exception. message)))
+                                      result)))
                                (map
                                 (fn [rule]
                                   ;; check for return value of (apply rule (list lexical-entry)):


java api using gen-class

java api using gen-class

--- src/bitcoinrpc/core.clj
+++ src/bitcoinrpc/core.clj
@@ -1,5 +1,7 @@
 (ns bitcoinrpc.core
-  (:use [clojure.pprint])
+  (:use [clojure.pprint]
+        [clojure.repl])
+
   (:require [clojure.data.json :as json]
             [instaparse.core :as insta]
             [clj-http.client :as client]
@@ -9,6 +11,7 @@
             [clojure.set :refer [subset?]]
             [clojure.core.server :as sock-repl]
             [clojure.main :as m]
+            [com.gfredericks.debug-repl :refer [break! unbreak!]]
             ))

 (defmacro dbg [body]
@@ -188,18 +191,39 @@
 ;; java interface
 ;;TODO

-(defn method-args-of [m]
-  `~(:arglists m))
-
-(defn method-of [m]
-  `(~(:name m) ~@(method-args-of m))
-  )
+
+
+(defn method-decl-of [fn-map]
+  (let [n (:name fn-map)]
+    `[~n ~@(map #(mapv (fn [_] 'Object) %) (:arglists fn-map)) ~'Object]
+    ))
+(defn method-name-of [n]
+  (symbol (str "-" n)))
+
+(defn method-overload-of [name args]
+  ;(break!)
+  `(~(-> args rest vec) (~name ~@args)))
+
+(defn method-impl-of [fn-map]
+  (let [n (:name fn-map)]
+    `(defn ~(method-name-of n) ~@(map (partial method-overload-of n) (:arglists fn-map)))))

 (defmacro def-java-api []
-  `(definterface IBtcRpc
-     ~(map method-of (btc-meta))
-     )
-  )
+  `(do
+     (gen-class
+       :name bitcoinrpc.BtcJava
+       :state ~'config
+       :methods ~(mapv method-decl-of (btc-meta))
+       :init ~'init
+       :constructors {[java.util.Map] []})
+
+     ~@(map method-impl-of (btc-meta))
+     (defn ~'-init [config#]
+       [[] config#])))
+;(def-java-api)
+
+
+

 ;;---------------socket repl-------------------------------

@@ -227,3 +251,19 @@

 ;;-------------------------java gen---------------------------

+
+(gen-class
+ :name bitcoinrpc.BtcJava
+ :prefix "-"
+ :methods [[foo [] String]
+           [foo [String] String]]
+ )
+
+(defn -foo
+  ([this]
+  (str (class this)))
+  ([this a]
+  (str (class this))))
+
+
+(compile 'bitcoinrpc.core)


using perserve

using perserve

--- src/celestial/redis.clj
+++ src/celestial/redis.clj
@@ -84,9 +84,9 @@
 (defn apply-diff [map-key _new old]
   {:pre [(map? _new) (map? old)]}
   (fn []
-    (letfn [(sub [a b] (clojure.set/difference (into #{} a)(into #{} b)))]
+    (letfn [(sub [a b] (clojure.set/difference (into #{} a) (into #{} b)))]
       (doseq [[k v] (sub old _new)] (wcar (car/hdel map-key k)))
-      (doseq [[k v] (sub _new old)] (wcar (car/hset map-key k v)))
+      (doseq [[k v] (sub _new old)] (wcar (car/hset map-key k (car/preserve v))))
       )))

 (defn sync-watch [map-key r]
@@ -95,15 +95,10 @@
         (with-lock  _key (apply-diff map-key _new old)
                  {:expiry half-hour :wait-time minute}))) r)

-(defn load-map [k]
-  "see https://github.com/ptaoussanis/carmine/issues/18"
-  (when-let [m (wcar (car/hgetall* (atom-key k)))]
-    (reduce (fn [r [k v]] (assoc r k (cond-> v (string? v) Integer/valueOf))) {} m)))
-
 (defn synched-map [k]
   "Lock backed atom map watcher that persists changes into redis takes the backing redis hash key."
   (sync-watch (atom-key k)
-    (if-let [data (load-map k)]
+    (if-let [data (wcar (car/hgetall* (atom-key k)))]
        (atom data)
        (atom {}))))


JC | commenting out line that does finnish translations

--- src/stonecutter/translation.clj
+++ src/stonecutter/translation.clj
@@ -23,7 +23,8 @@

 (defn config-translation []
   {:dictionary                 {:en (translation-map "en")
-                                :fi (translation-map "fi")}
+                                ;:fi (translation-map "fi") ;; FIXME JC 21/10/2015 removed until translations are correct
+                                }
    :dev-mode?                  false
    :fallback-locale            :en
    :log-missing-translation-fn (fn [{:keys [locales ks ns] :as args}]


fix issue with copying files that don't exist: revisit this later

--- src/tailrecursion/boot/file.clj
+++ src/tailrecursion/boot/file.clj
@@ -63,8 +63,10 @@
 (defn copy-with-lastmod
   [src-file dst-file]
   (make-parents dst-file)
-  (copy src-file dst-file)
-  (.setLastModified dst-file (.lastModified src-file)))
+  (try
+    (copy src-file dst-file)
+    (.setLastModified dst-file (.lastModified src-file))
+    (catch Throwable _)))

 (defn copy-files
   [src dest]


open beats port for logstash

open beats port for logstash

--- src/terraboot/elasticsearch.clj
+++ src/terraboot/elasticsearch.clj
@@ -36,7 +36,7 @@
                                                                                (vpc-output-of "aws_eip" "public-b-nat" "public_ip")
                                                                                (vpc-output-of "aws_eip" "logstash" "public_ip")
                                                                                "87.115.98.26/32" ; Tom
-                                                                                "146.200.166.70" ; Elise
+                                                                                "146.200.166.70/32"  ; Elise
                                                                                ]
                                                                             }}}]})
                     :cluster_config {:instance_count 2,
@@ -57,11 +57,15 @@
                                   :cidr_blocks ["52.29.162.148/32"
                                                 "52.29.163.57/32"
                                                 "52.29.97.114/32"
-                                                "87.115.98.26/32"]})
+                                                "87.115.98.26/32"]}
+                                  :protocol "tcp"
+                                  :cidr_blocks [all-external]})

              (vpc-resource "aws_eip" "logstash"
                            {:vpc true
                             :instance (vpc-id-of "aws_instance" "logstash")})
+
+

              (vpc-security-group "sends_gelf" {})
              (aws-instance (vpc-unique "logstash") {:ami "ami-9b9c86f7"