SQL Server Driver [WIP] :yum:

SQL Server Driver [WIP] :yum:

--- src/metabase/driver/sqlserver.clj
+++ src/metabase/driver/sqlserver.clj
@@ -2,8 +2,8 @@
   (:require (korma [core :as k]
                    [db :as kdb])
             [korma.sql.utils :as utils]
-            (metabase.driver [generic-sql :refer [sql-driver]]
-                             [interface :refer [defdriver]]))
+            [metabase.driver :refer [defdriver]]
+            [metabase.driver.generic-sql :refer [sql-driver]])
   (:import net.sourceforge.jtds.jdbc.Driver)) ; need to import this in order to load JDBC driver

 (defn- connection-details->spec [details-map]
@@ -82,33 +82,33 @@
                :date-interval             date-interval
                :unix-timestamp->timestamp unix-timestamp->timestamp}))

-(defn x []
-  (metabase.driver/process-query {:database 85
-                                  :type :native
-                                  :native {:query "SELECT COUNT(*) AS \"count\" FROM TABLES; GO"}}))
+;; (defn x []
+;;   (metabase.driver/process-query {:database 85
+;;                                   :type :native
+;;                                   :native {:query "SELECT COUNT(*) AS \"count\" FROM TABLES; GO"}}))

-(defn y []
-  (let [entity (metabase.driver.generic-sql.util/korma-entity (Database 85) {:name "sys.tables"})]
-    (k/sql-only
-     (k/select entity (k/limit 1)))))
+;; (defn y []
+;;   (let [entity (metabase.driver.generic-sql.util/korma-entity (Database 85) {:name "sys.tables"})]
+;;     (k/sql-only
+;;      (k/select entity (k/limit 1)))))

-(defn a []
-  (let [entity (metabase.driver.generic-sql.util/korma-entity (Database 85) {:name "sys.tables"})]
-    (k/sql-only
-     (k/select entity
-               (k/modifier "TOP 1")))))
+;; (defn a []
+;;   (let [entity (metabase.driver.generic-sql.util/korma-entity (Database 85) {:name "sys.tables"})]
+;;     (k/sql-only
+;;      (k/select entity
+;;                (k/modifier "TOP 1")))))

-(defn b []
-  (let [entity (metabase.driver.generic-sql.util/korma-entity (Database 85) {:name "sys.tables"})]
-    (k/select entity
-              (k/modifier (utils/func :TOP 1)))))
+;; (defn b []
+;;   (let [entity (metabase.driver.generic-sql.util/korma-entity (Database 85) {:name "sys.tables"})]
+;;     (k/select entity
+;;               (k/modifier (utils/func :TOP 1)))))

-(defn c []
-  (-> (k/select* (metabase.driver.generic-sql.util/korma-entity (Database 85) {:name "sys.tables"}))
-      (k/modifier (utils/func "TOP %s" [1]))))
+;; (defn c []
+;;   (-> (k/select* (metabase.driver.generic-sql.util/korma-entity (Database 85) {:name "sys.tables"}))
+;;       (k/modifier (utils/func "TOP %s" [1]))))

-(defn d []
-  (k/exec (c)))
+;; (defn d []
+;;   (k/exec (c)))

-(defn e []
-  (k/as-sql (c)))
+;; (defn e []
+;;   (k/as-sql (c)))


Add complete examples for about futures

Add complete examples for about futures

--- src/clojure/clojure_walkthrough/cjia/ch06_xx.clj
+++ src/clojure/clojure_walkthrough/cjia/ch06_xx.clj
@@ -173,4 +173,16 @@
         z (long-calculation 17 19)]
     (* x y z)))

-(time (long-run))
+(time (long-run)) ;; "Elapsed time: 15008.324 msecs" and return 10207769
+
+;; Now let's use future
+(defn fast-run []
+  (let [x (future (long-calculation 11 13)) ; future creates a thread that will run
+        y (future (long-calculation 13 17)) ; long-calculation without blocking current thread
+        z (future (long-calculation 17 19))]
+    (* @x @y @z))) ;; Futures x, y, and z can potentially all run in parallel
+
+(time (fast-run)) ;; "Elapsed time: 5006.027 msecs" and return 10207769
+
+;; Here are other functions that Clojure provides:
+; future?, future-done?, future-cancel?, future-cancelled?


🔥 Remove user.clj which caused ClassNotFoundException on lein javac

https://www.reddit.com/r/Clojure/comments/5f2ctk/cant_compile_java_sources_with_lein_javac/

--- env/dev/clj/user.clj
+++ env/dev/clj/user.clj
@@ -1,25 +0,0 @@
-;; Copyright © 2015-2019 Esko Luontola
-;; This software is released under the Apache License 2.0.
-;; The license text is at http://www.apache.org/licenses/LICENSE-2.0
-
-(ns user
-  (:require [clojure.test :as test]
-            [clojure.tools.namespace.repl :refer [refresh]]
-            [mount.core :as mount]
-            [territory-bro.config :refer [env]]
-            [territory-bro.db]
-            [territory-bro.main :refer [start-app]]))
-
-(defn start []
-  (mount/start-without #'territory-bro.main/repl-server))
-
-(defn stop []
-  (mount/stop-except #'territory-bro.main/repl-server))
-
-(defn restart []
-  (stop)
-  (start))
-
-(defn run-all-tests []
-  (refresh)
-  (test/run-all-tests #"territory-bro\..*"))


PLATFORM-2817: fixed image extension replace in Content-Disposition

--- src/vignette/util/image_response.clj
+++ src/vignette/util/image_response.clj
@@ -75,7 +75,7 @@
      (let [target-filename
            (if-let [requested-path
                     (when image-object (extension-for-name (content-type image-object)))]
-                      (if (re-matches #"\.\w+$" filename)
+                      (if (re-find #"\.\w+$" filename)
                         (string/replace filename #"\.\w+$" requested-path)
                         (str filename requested-path))
                       filename)]


Improve error message when unable to locate BK

--- src/onyx/state/log/bookkeeper.clj
+++ src/onyx/state/log/bookkeeper.clj
@@ -44,12 +44,18 @@
                (arg-or-default :onyx.bookkeeper/client-timeout opts)
                (arg-or-default :onyx.bookkeeper/client-throttle opts)))
   ([zk-addr zk-root-path timeout throttle]
-   (let [conf (doto (ClientConfiguration.)
-                (.setZkServers zk-addr)
-                (.setZkTimeout timeout)
-                (.setThrottleValue throttle)
-                (.setZkLedgersRootPath zk-root-path))]
-     (BookKeeper. conf))))
+   (try
+    (let [conf (doto (ClientConfiguration.)
+                 (.setZkServers zk-addr)
+                 (.setZkTimeout timeout)
+                 (.setThrottleValue throttle)
+                 (.setZkLedgersRootPath zk-root-path))]
+      (BookKeeper. conf))
+    (catch org.apache.zookeeper.KeeperException$NoNodeException nne
+      (throw (ex-info "Error locating BookKeeper cluster via ledger path. Check that BookKeeper has been started via start-env by setting `:onyx.bookkeeper/server? true` in env-config, or is setup at the correct path."
+                      {:zookeeper-addr zk-addr
+                       :zookeeper-path zk-root-path}
+                      nne))))))

 (def digest-type
   (BookKeeper$DigestType/MAC))


Draw keys in collapsed map with proper style

--- src/datafrisk/core.cljs
+++ src/datafrisk/core.cljs
@@ -31,10 +31,22 @@
                     :backgroundColor "lightgray"}}
    "Collapse all"])

+(defn NilText []
+  [:span {:style (:nil styles)} (pr-str nil)])
+
+(defn StringText [data]
+  [:span {:style (:strings styles)} (pr-str data)])
+
+(defn KeywordText [data]
+  [:span {:style (:keywords styles)} (str data)])
+
+(defn NumberText [data]
+  [:span {:style (:numbers styles)} data])
+
 (defn Node [{:keys [data path emit-fn swappable]}]
   [:div (cond
           (nil? data)
-          [:span {:style (:nil styles)} (pr-str data)]
+          [NilText]

           (string? data)
           (if swappable
@@ -43,7 +55,7 @@
                      :on-change
                      (fn string-changed [e]
                        (emit-fn :changed path (.. e -target -value)))}]
-            [:span {:style (:strings styles)} (pr-str data)])
+            [StringText data])

           (keyword? data)
           (if swappable
@@ -52,7 +64,7 @@
                      :on-change
                      (fn keyword-changed [e]
                        (emit-fn :changed path (keyword (.. e -target -value))))}]
-            [:span {:style (:keywords styles)} (str data)])
+            [KeywordText data])

           (object? data)
           (str data " " (.stringify js/JSON data))
@@ -64,7 +76,7 @@
                      :on-change
                      (fn number-changed [e]
                        (emit-fn :changed path (js/Number (.. e -target -value))))}]
-            [:span {:style (:numbers styles)} data])
+            [NumberText data])
           :else
           (str data))])

@@ -115,6 +127,17 @@
         (str (count data) " items"))
       [:span "}"]]]))

+(defn KeySet [keyset]
+  [:span
+   (->> (map-indexed
+          (fn [i data] ^{:key i} [:span
+                                  (cond (nil? data) [NilText]
+                                        (string? data) [StringText data]
+                                        (keyword? data) [KeywordText data]
+                                        (number? data) [NumberText data]
+                                        :else (str data))]) keyset)
+        (interpose " "))])
+
 (defn MapNode [{:keys [data path expanded-paths emit-fn] :as all}]
   (let [expanded? (get expanded-paths path)]
     [:div {:style {:display "flex"}}
@@ -126,7 +149,7 @@
       [:span "{"]
       (if expanded?
         (map-indexed (fn [i x] ^{:key i} [KeyValNode (assoc all :data x)]) data)
-        [:span {:style (:keywords styles)} (clojure.string/join " " (->> (keys data) (map pr-str)))])
+        [KeySet (keys data)])
       [:span "}"]]]))

 (defn DataFrisk [{:keys [data] :as all}]


Make the test pass

Make the test pass

--- src/desdemona/query.clj
+++ src/desdemona/query.clj
@@ -41,7 +41,11 @@
     `(l/featurec ~lvar {~attr ~value})

     [((= value ((attr lvar) :seq)) :seq)]
-    `(l/featurec ~lvar {~attr ~value})))
+    `(l/featurec ~lvar {~attr ~value})
+
+    [(['and & terms] :seq)]
+    (let [logic-terms (map dsl->logic terms)]
+      `(l/conde [~@logic-terms]))))

 (defn run-dsl-query
   "Run a DSL query over some events and finds n answers (default 1)."


Force smaller font in aux console

Force smaller font in aux console

--- src/devtools/debug.cljs
+++ src/devtools/debug.cljs
@@ -8,6 +8,7 @@
 (def indentation-spacer "  ")
 (def logger-name-stuffer "_")
 (def logger-name-padding 8)
+(def additional-console-styles ".logmsg, .logmsg * {font-size:10px;}")

 (def ^:dynamic *initialized* false)
 (def ^:dynamic *indent* 0)
@@ -49,6 +50,7 @@

 (defn init-logger! []
   (set! *console* (goog.debug.FancyWindow. "devtools"))
+  (aset *console* "getStyleRules" #(str (goog.debug.FancyWindow.prototype.getStyleRules) additional-console-styles))
   (.setWelcomeMessage *console* "cljs-devtools auxiliary console")
   (.init *console*)
   (.setEnabled *console* true)


Use `reduce` instead of `apply` in `std.math/mean`

This results in a 1.29x speedup on average (234ms for 100
runs on 1M longs compared to 304ms)

--- src/framed/std/math.clj
+++ src/framed/std/math.clj
@@ -35,7 +35,7 @@
   "Return the arithmetic mean of vs, or nil if empty"
   [vs]
   (when (seq vs)
-    (/ (apply + vs) (count vs))))
+    (/ (reduce + vs) (count vs))))

 (defn median
   "Return the median value of vs, or nil if empty"


small-fix

small-fix

--- src/cljs/salava/badge/ui/evidence.cljs
+++ src/cljs/salava/badge/ui/evidence.cljs
@@ -25,7 +25,7 @@
            :show-form false
            :evidence nil))))

-(defn init-settings [badge-id state init-data tab]
+(defn init-settings [badge-id state init-data]
   (ajax/GET
     (path-for (str "/obpv1/badge/settings/" badge-id) true)
     {:handler (fn [data]


PDF badges, language link check

PDF badges, language link check

--- src/cljs/salava/badge/ui/settings.cljs
+++ src/cljs/salava/badge/ui/settings.cljs
@@ -1,5 +1,6 @@
 (ns salava.badge.ui.settings
   (:require [reagent.core :refer [cursor atom]]
+            [clojure.string :as string]
             [salava.core.ui.ajax-utils :as ajax]
             [salava.core.i18n :refer [t]]
             [salava.core.time :refer [date-from-unix-time]]
@@ -256,7 +257,7 @@
                 (let [uri (str cert-uri "&lang=" lang)]
                   [:p {:key uri}
                    [:i.fa.fa-file-pdf-o.fa-2x] " "
-                   [:a {:href uri} (str badge " (" lang ")")]]))
+                   [:a {:href uri} (if-not (string/blank? lang) (str badge " (" lang ")") badge)]]))
               (:badge @state)))]
       #_[:div
          [:button {:class "btn btn-primary" :on-click #(revalidation-request user-badge-id state)} (t :badge/RevalidationRequest)]]]


Minor refactoring

Minor refactoring

--- src/faceboard/tabs.cljs
+++ src/faceboard/tabs.cljs
@@ -27,7 +27,7 @@

 (defn selected-tab-model [data selected-tab-id]
   {:ui   (:ui data)
-   :data (get (:model data) selected-tab-id)})
+   :data (get-in data [:model selected-tab-id])})

 (defcomponent tabs-component [data owner opts]
   (render [_]
@@ -43,7 +43,7 @@
                       :on-click #(controller/perform-command! "switch-tab" (:id tab))}
               (:label tab)))
           (om/build menu/menu-component ui))
-        (dom/div {:class (str "tab-content" (when (:model-editing? ui) " dual-mode"))
+        (dom/div {:class    (str "tab-content" (when (:model-editing? ui) " dual-mode"))
                   :on-click #(controller/perform-command! "change-extended-set" #{})}
           (dom/div {:class "left-side"}
             (om/build (tab->component selected-tab) (selected-tab-model data selected-tab-id)))


Remove :methods

Remove :methods

(apparently unnecessary?)

--- clojure_pi_dir/pi.clj
+++ clojure_pi_dir/pi.clj
@@ -1,7 +1,6 @@
 ; We have to define name-space etc. because we want to compile to to Java byte-code.
 (ns pi
-  (:gen-class
-   :methods [[calcpi [] Integer]]))
+  (:gen-class))

 ; The function that does the bulk of our work as usual.
 (defn calcpi [n] ((fn [x] (/ (apply + (map (fn [x] (/ 4 (+ 1 (* x x)))) (range (/ 0.5 x) 1 (/ 1 x)))) x)) n))


Fix job sort priority order, should be sorting by peer count first

--- src/onyx/scheduling/percentage_job_scheduler.clj
+++ src/onyx/scheduling/percentage_job_scheduler.clj
@@ -41,8 +41,8 @@

 (defmethod cjs/sort-job-priority :onyx.job-scheduler/percentage
   [replica jobs]
-  (sort-by (juxt #(.indexOf ^clojure.lang.PersistentVector (vec (:jobs replica)) %)
-                 (partial job-peer-count replica))
+  (sort-by (juxt #(common/job-peer-count replica %)
+                 #(.indexOf ^clojure.lang.PersistentVector (vec (:jobs replica)) %))
            (:jobs replica)))

 (defmethod cjs/claim-spare-peers :onyx.job-scheduler/percentage


Update bouncy castle version to 1.53.

Update bouncy castle version to 1.53.


Revert back to snapshot version.

Revert back to snapshot version.


Unnecessary logs

Unnecessary logs

--- src/freecoin/routes.clj
+++ src/freecoin/routes.clj
@@ -56,7 +56,7 @@

 (defn path [action & params]
   (try
-    (apply bidi/path-for routes (log/spy action) (log/spy params))
+    (apply bidi/path-for routes action params)
     (catch Exception e
       (log/warn (format "Key: '%s' probably does not match a route.\n%s" action e))
       (throw (Exception. (format "Error constructing url for action '%s', with params '%s'" action params))))))


this middleware has a bug

this middleware has a bug

--- src/main/cawala/server_components/middleware.clj
+++ src/main/cawala/server_components/middleware.clj
@@ -100,7 +100,7 @@
       (wrap-api "/api")
       server/wrap-transit-params
       server/wrap-transit-response
-      (server/wrap-protect-origins {:allow-when-origin-missing? false
+      #_(server/wrap-protect-origins {:allow-when-origin-missing? false
                                     :legal-origins              legal-origins})
       (wrap-html-routes)
       ;; If you want to set something like session store, you'd do it against


email channel type first in the list

email channel type first in the list

--- priv/ui/src/cljs/holiday_ping_ui/channels/views.cljs
+++ priv/ui/src/cljs/holiday_ping_ui/channels/views.cljs
@@ -165,8 +165,8 @@
    [step-title "Select the type of the channel you want to use."]
    [:br]
    [:div.columns.is-centered
+    [type-card wizard-state "email" "Email" "/img/email.png"]
     [type-card wizard-state "slack" "Slack" "/img/slack.png"]
-    [type-card wizard-state "email" "Email" "/img/email.png"]
     [type-card wizard-state "webhook" "Webhooks" "/img/webhooks.png"]]])

 (defn configuration-form


Test basic simulation case using both old and new simulation schema

--- test/clj_gatling/simulation_test.clj
+++ test/clj_gatling/simulation_test.clj
@@ -15,7 +15,7 @@
       (recur (conj results result))
       results)))

-(defn- run-simulation [scenarios concurrency & [options]]
+(defn- run-legacy-simulation [scenarios concurrency & [options]]
   (let [step-timeout (or (:timeout-in-ms options) 5000)]
     (-> (simulation/run-scenarios {:runner (choose-runner scenarios concurrency options)
                                    :timeout step-timeout
@@ -23,6 +23,12 @@
                                   (weighted-scenarios (range concurrency) scenarios))
         to-vector)))

+(defn- run-single-scenario [scenario concurrency]
+  (to-vector (simulation/run {:name "Simulation"
+                              :scenarios [scenario]}
+                             {:concurrency concurrency
+                              :timeout 5000})))
+
 (def request-count (atom 0))

 (defn counting-request [cb context]
@@ -86,8 +92,8 @@
 (defn get-result [requests request-name]
   (:result (first (filter #(= request-name (:name %)) requests))))

-(deftest simulation-returns-result-when-run-with-one-user
-  (let [result (run-simulation [scenario] 1)]
+(deftest simulation-returns-result-when-run-with-one-user-with-legacy-format
+  (let [result (run-legacy-simulation [scenario] 1)]
     (is (equal? result [{:name "Test scenario"
                          :id 0
                          :start number?
@@ -103,10 +109,32 @@
                                      :end number?
                                      :result false}]}]))))

+(deftest simulation-returns-result-when-run-with-one-user
+  (let [result (run-single-scenario {:name "Test scenario"
+                                     :steps [{:name "Step1"
+                                              :action (fn [ctx] [true ctx])}
+                                             {:name "Step2"
+                                              :action (fn [ctx] [false ctx])}]}
+                                    1)]
+    (is (equal? result [{:name "Test scenario"
+                         :id 0
+                         :start number?
+                         :end number?
+                         :requests [{:name "Step1"
+                                     :id 0
+                                     :start number?
+                                     :end number?
+                                     :result true}
+                                    {:name "Step2"
+                                     :id 0
+                                     :start number?
+                                     :end number?
+                                     :result false}]}]))))
+
 (deftest when-function-returns-exception-it-is-handled-as-ko
   (let [s {:name "Exception scenario"
            :requests [{:name "Throwing" :fn error-throwing-request}]}
-        result (run-simulation [s] 1)]
+        result (run-legacy-simulation [s] 1)]
     (is (equal? result [{:name "Exception scenario"
                          :id 0
                          :start number?
@@ -118,7 +146,7 @@
                                      :result false}]}]))))

 (deftest simulation-passes-context-through-requests-in-scenario
-  (let [result (first (run-simulation [context-testing-scenario] 1))]
+  (let [result (first (run-legacy-simulation [context-testing-scenario] 1))]
     (is (= true (get-result (:requests result) "Request2")))))

 (deftest simulation-passes-original-context-to-first-request
@@ -126,13 +154,13 @@
                   :requests [{:name "Request1"
                               :fn (fn [cb {:keys [test-val]}]
                                     (cb (= 5 test-val)))}]}
-        result (first (run-simulation [scenario]
+        result (first (run-legacy-simulation [scenario]
                                       1
                                       {:context {:test-val 5}}))]
     (is (= true (get-result (:requests result) "Request1")))))

 (deftest simulation-skips-second-request-if-first-fails
-  (let [result (run-simulation [first-fails-scenario] 1)]
+  (let [result (run-legacy-simulation [first-fails-scenario] 1)]
     ;Note scenario is ran twice in this case to match number of handled requests which should be 2
     (is (equal? result
                 (repeat 2 {:name "Scenario"
@@ -146,7 +174,7 @@
                                        :result false}]})))))

 (deftest second-request-is-not-skipped-in-failure-if-skip-next-after-failure-is-unset
-  (let [result (run-simulation [(assoc first-fails-scenario :skip-next-after-failure? false)] 1)]
+  (let [result (run-legacy-simulation [(assoc first-fails-scenario :skip-next-after-failure? false)] 1)]
     (is (equal? result
                 [{:name "Scenario"
                            :id 0
@@ -165,13 +193,13 @@

 (deftest simulation-returns-result-when-run-with-http-requests
   (with-redefs [httpkit/async-http-request fake-async-http]
-    (let [result (first (run-simulation [http-scenario] 1))]
+    (let [result (first (run-legacy-simulation [http-scenario] 1))]
       (is (= "Test http scenario" (:name result)))
       (is (= true (get-result (:requests result) "Request1")))
       (is (= false (get-result (:requests result) "Request2"))))))

 (deftest simulation-returns-result-when-run-with-multiple-scenarios-with-one-user
-  (let [result (run-simulation [scenario scenario2] 2)]
+  (let [result (run-legacy-simulation [scenario scenario2] 2)]
     ;Stop condition is not synced between parallel scenarios
     ;so once in a while there might be one extra scenario
     ;This is ok tolerance for max requests
@@ -187,10 +215,10 @@
                                                 :requests anything}]))))

 (deftest throws-exception-when-concurrency-is-smaller-than-number-of-parallel-scenarios
-  (is (thrown? AssertionError (run-simulation [scenario scenario2] 1))))
+  (is (thrown? AssertionError (run-legacy-simulation [scenario scenario2] 1))))

 (deftest with-given-number-of-requests
-  (let [result (run-simulation [scenario] 1 {:requests 4})]
+  (let [result (run-legacy-simulation [scenario] 1 {:requests 4})]
     (is (= "Test scenario" (-> result first :name)))
     (is (= 2 (-> result first :requests count)))
     (is (= "Test scenario" (-> result second :name)))
@@ -198,17 +226,17 @@

 (deftest with-multiple-number-of-requests
   (reset! request-count 0)
-  (let [result (run-simulation [counting-scenario] 100 {:requests 2000})
+  (let [result (run-legacy-simulation [counting-scenario] 100 {:requests 2000})
         handled-requests (->> result (map :requests) count)]
     (is (approximately== handled-requests 2000))
     (is (= handled-requests @request-count))))

 (deftest duration-given
-  (let [result (run-simulation [scenario] 1 {:duration (time/millis 50)})]
+  (let [result (run-legacy-simulation [scenario] 1 {:duration (time/millis 50)})]
     (is (not (empty? result)))))

 (deftest fails-requests-when-they-take-longer-than-timeout
-  (let [result (first (run-simulation [timeout-scenario] 1 {:timeout-in-ms 100}))]
+  (let [result (first (run-legacy-simulation [timeout-scenario] 1 {:timeout-in-ms 100}))]
     (is (= false (get-result (:requests result) "Request1")))))

 (deftest scenario-weight
@@ -216,7 +244,7 @@
         request2 {:name "Request2" :fn successful-request}
         main-scenario {:name "Main" :weight 2 :requests [request1 request2]}
         second-scenario {:name "Second" :weight 1 :requests [request1]}
-        result (group-by :name (run-simulation
+        result (group-by :name (run-legacy-simulation
                                  [main-scenario second-scenario]
                                  10
                                  {:requests 100}))


Add options for "enable-brackets-autoclose" behavior.

--- src/lt/objs/editor.cljs
+++ src/lt/objs/editor.cljs
@@ -756,8 +756,12 @@
           :desc "Editor: Enable brackets autoclose"
           :exclusive [::disable-brackets-autoclose]
           :type :user
-          :reaction (fn [this]
-                      (set-options this {:autoCloseBrackets true})))
+          :params [{:label "map"
+                    :example "{:pairs \"()[]{}''\\\"\\\"\" :explode \"[]{}\"}"}]
+          :reaction (fn [this opts]
+                      (if opts
+                        (set-options this {:autoCloseBrackets (clj->js opts)})
+                        (set-options this {:autoCloseBrackets true}))))

 (behavior ::disable-brackets-autoclose
           :triggers #{:object.instant :lt.object/tags-removed}


Expose Cljs compiler options at cljs.edn metadata

Could be useful for other tasks

--- src/adzerk/boot_cljs.clj
+++ src/adzerk/boot_cljs.clj
@@ -73,7 +73,9 @@
       (swap! core/*warnings* + (or (count warnings) 0))
       (when exception
         (throw (util/deserialize-exception exception)))
-      (-> result (update-in [:dep-order] #(->> (conj % (:output-to opts)) (map rel-path)))))))
+      (-> result
+          (update-in [:dep-order] #(->> (conj % (:output-to opts)) (map rel-path)))
+          (assoc :opts opts)))))

 (defn- macro-files-changed
   [diff]
@@ -160,7 +162,14 @@
 (defn- cljs-warnings-meta
   [cljs-edns results]
   (zipmap (map :path cljs-edns)
-          (map (fn [r] {::warnings (:warnings r)}) results)))
+          (map (fn [r] {::warnings (:warnings r)})
+               results)))
+
+(defn- cljs-opts-meta
+  [cljs-edns results]
+  (zipmap (map :path cljs-edns)
+          (map (fn [r] {::opts (:opts r)})
+               results)))

 (core/deftask cljs
   "Compile ClojureScript applications.
@@ -232,6 +241,7 @@
               ;; Add warnings to .cljs.edn files metadata so other tasks
               ;; can use this information and report it to users
               (core/add-meta (cljs-warnings-meta cljs-edns results))
+              (core/add-meta (cljs-opts-meta cljs-edns results))
               ;; Add metadata to mark the output of this task so subsequent
               ;; instances of the cljs task can remove them before compiling.
               (core/add-meta (cljs-output-meta tmp-result))


Cosmetic changes

Cosmetic changes

--- test/cljs/replumb/repl_test.cljs
+++ test/cljs/replumb/repl_test.cljs
@@ -392,11 +392,9 @@
       (reset-env!)))

   (deftest macros
-;;;;;;;;;;;;;;;;
     ;; Implementing examples from Mike Fikes work at:
     ;; http://blog.fikesfarm.com/posts/2015-09-07-messing-with-macros-at-the-repl.html
     ;; (it's not that I don't trust Mike, you know)
-;;;;;;;;;;;;;;;;
     (let [res (read-eval-call "(defmacro hello [x] `(inc ~x))")
           out (unwrap-result res)]
       (is (success? res) "(defmacro hello ..) should succeed")


Remove unneeded TLS cert expiration test

The certs are now managed automatically by AWS.

--- test/clojars/unit/certs_test.clj
+++ test/clojars/unit/certs_test.clj
@@ -8,10 +8,3 @@
     (is (< (System/currentTimeMillis)
           (- (.getTime expire-date) sixty-days))
       (format "Security GPG key expires on %s" expire-date))))
-
-(deftest fail-when-tls-cert-is-about-to-expire
-  (let [expire-date #inst "2020-06-17T00:00:00.000-00:00"]
-    (is (< (System/currentTimeMillis)
-          (- (.getTime expire-date) sixty-days))
-      (format "clojars.org TLS cert expires on %s.\nBe sure to give lein a copy of the new one: %s"
-        expire-date "https://github.com/technomancy/leiningen/blob/master/leiningen-core/resources/clojars.pem"))))


Add functionality to validate exported productions

So you can make sure we have something solid before staring the encoding
process

--- src/mdr2/production.clj
+++ src/mdr2/production.clj
@@ -13,7 +13,8 @@
             [mdr2.db :as db]
             [mdr2.dtb :as dtb]
             [mdr2.production.path :as path]
-            [mdr2.obi :as obi])
+            [mdr2.obi :as obi]
+            [mdr2.pipeline1 :as pipeline])
   (:import java.nio.file.StandardCopyOption))

 (defn library-signature?
@@ -37,6 +38,25 @@
   "Return true if the production has a DAISY export"
   [production]
   (fs/exists? (path/manifest-path production)))
+
+(defn manifest-validate
+  "Return a list of validation errors for all DAISY exports of given
+  `production`. If there are no validation errors or no DAISY exports
+  returns an empty list"
+  [production]
+  (if (not (manifest? production))
+    []
+    (->> (range (:volumes production))
+         (map inc)
+         (map #(path/manifest-path production %))
+         (map #(.getPath %))
+         (map #(pipeline/validate % :daisy202))
+         (apply concat))))
+
+(defn manifest-valid?
+  "Return true if all exports for this `production` are valid"
+  [production]
+  (empty? (manifest-validate production)))

 (defn split?
   "Return true if the production has a manual split"


Add functions to get the encoded and the iso path

of a production

--- src/mdr2/production.clj
+++ src/mdr2/production.clj
@@ -28,10 +28,21 @@
     (.getPath (file path file-name))))

 (defn manifest-path
-  "Return the path to the manifest of the DTB which was exported from
-  obi for given production"
+  "Path to the manifest of the DTB which was exported from obi for
+  given `production`"
   [production]
-  (.getPath (file (path production) "export" "package.opf"))))
+  (.getPath (file (path production) "export" "package.opf")))
+
+(defn encoded-path
+  "Path to the encoded version of the exported DTB, i.e. the DTB
+  containing mp3s for given `production`"
+  [production]
+  (.getPath (file (path production) "encoded")))
+
+(defn iso-path
+  "Path to the iso of the exported DTB for given `production`"
+  [{id :id :as production}]
+  (.getPath (file (path production) "iso" (str id ".iso"))))

 (defn has-manifest?
   "Return true if the production has a DAISY export"


Flows and fixpoints

Flows and fixpoints

--- src/aurora/language.cljs
+++ src/aurora/language.cljs
@@ -6,11 +6,35 @@

 (deftype Flow [solver output-kinds output-names output-fields]
   Object
-  (run [this kn]
+  (run [this kn rule->dirty? kind->name->rules]
        (.reset solver)
        (let [facts (.keys solver)]
          (dotimes [i (alength output-kinds)]
-           (.add-facts kn (aget output-kinds i) (aget output-names i) (aget output-fields i) facts)))))
+           (let [kind (aget output-kinds i)
+                 name (aget output-names i)
+                 fields (aget output-fields i)]
+             (when (true? (.add-facts kn kind name fields facts))
+               (let [dirtied-rules (aget kind->name->rules kind name)]
+                 (dotimes [j (alength dirtied-rules)]
+                   (aset rule->dirty? (aget dirtied-rules i) true)))))))))
+
+(deftype Flows [rules rule->flow rule->dirty? kind->name->rules]
+  Object
+  (run [this kn]
+       ;; assume everything is dirty at the start
+       (dotimes [i (alength rules)]
+         (aset rule->dirty? (aget rules i) true))
+
+       (loop [i 0]
+         (prn :loop i)
+         (when (< i (alength rules))
+           (let [rule (aget rules i)]
+             (if (true? (aget rule->dirty? rule))
+               (do
+                 (aset rule->dirty? rule false)
+                 (.run (aget rule->flow rule) kn rule->dirty? kind->name->rules)
+                 (recur 0))
+               (recur (+ i 1))))))))

 ;; KNOWLEDGE

@@ -38,7 +62,7 @@
         (set!! changed? true)))
     changed?))

-(deftype Knowledge [^:mutable kind->name->fields->index ^:mutable version]
+(deftype Knowledge [^:mutable kind->name->fields->index]
   Object
   (get-or-create-index [this kind name fields]
                        (assert (or (= kind "know") (= kind "remember") (= kind "forget")) (pr-str kind))
@@ -56,14 +80,13 @@
                (doseq [[other-fields other-index] indexes]
                  (when (-add-facts facts fields other-index (into-array other-fields))
                    (set!! changed? true)))
-               (when changed?
-                 (set! version (+ version 1)))))
+               changed?))
   (tick [this])
   ;; TODO Knowledge.tick using array of flows, needs dirty tracking per flow (requires map from index to flow)
   (tock [this]))

 (defn knowledge []
-  (Knowledge. {} 0))
+  (Knowledge. {}))

 ;; COMPILER

@@ -75,7 +98,8 @@

 ;; NOTE can't handle missing keys yet - requires a schema
 (defn compile [kn]
-  (let [rule-id->flow #js {}
+  (let [rule->flow (atom {})
+        kind->name->rules (atom {})
         clauses (.keys (.get-or-create-index kn "know" "clauses" #js ["rule-id" "when|know|remember|forget" "clause-id" "name"]))
         fields (.keys (.get-or-create-index kn "know" "clause-fields" #js ["clause-id" "constant|variable" "key" "val"]))
         rule-id->clauses (atom (into {} (for [[k vs] (group-by #(nth % 0) clauses)] [k (set (map vec vs))])))
@@ -84,7 +108,7 @@
     ;; rewrite clauses
     (doseq [[rule-id clauses] @rule-id->clauses]
       (doseq [[_ clause-type clause-id name] clauses
-              :when (not (#{"constant=" "variable=" "function="} name))]
+              :when (not (#{"=constant" "=variable" "=function"} name))]
         (let [fields (get @clause-id->fields clause-id)
               var->key (atom {})]
           (doseq [[_ field-type key val] fields]
@@ -166,6 +190,7 @@
                                            clause-vars-ixes (map var->ix clause-vars)
                                            clause-keys (map second clause-vars&keys)
                                            index (.get-or-create-index kn "know" name (into-array clause-keys))]
+                                       (swap! kind->name->rules update-in ["know" name] #(conj (or % #{}) rule-id))
                                        [(btree/contains (btree/iterator index)) (into-array clause-vars-ixes)]))))

               ;; make solver
@@ -192,12 +217,13 @@

           ;; ensure at least one index per output
           (dotimes [i (alength output-kinds)]
+            (swap! kind->name->rules update-in [(aget output-kinds i) (aget output-names i)] #(or % #{}))
             (.get-or-create-index kn (aget output-kinds i) (aget output-names i) (into-array (filter #(not (nil? %)) (aget output-fields i)))))

-          (aset rule-id->flow rule-id
-                (Flow. solver output-kinds output-names output-fields)))))
-
-    rule-id->flow))
+          (swap! rule->flow assoc rule-id (Flow. solver output-kinds output-names output-fields)))))
+
+    ;; TODO stratify
+    (Flows. (clj->js (map first @rule->flow)) (clj->js @rule->flow) #js {} (clj->js @kind->name->rules))))

 ;; TESTS

@@ -242,26 +268,14 @@
                                                                                #js ["make-str" "constant" "js" "\"edge \" + xx + \" \" + yy"]
                                                                                #js ["know-str" "variable" "name" "zz"]])

-(def rule-id->flow (compile kn))
-
-rule-id->flow
-
-(.run (aget rule-id->flow "single-edge") kn)
+(def flows (compile kn))
+
+(set! (.-rules flows) #js ["single-edge" "transitive-edge" "function-edge"])
+
+(enable-console-print!)
+
+(.run flows kn)

 (.get-or-create-index kn "know" "connected" #js ["x" "y"])

-(.run (aget rule-id->flow "transitive-edge") kn)
-
-(.get-or-create-index kn "know" "connected" #js ["x" "y"])
-
-(.run (aget rule-id->flow "transitive-edge") kn)
-
-(.get-or-create-index kn "know" "connected" #js ["x" "y"])
-
-(.run (aget rule-id->flow "transitive-edge") kn)
-
-(.get-or-create-index kn "know" "connected" #js ["x" "y"])
-
-(.run (aget rule-id->flow "function-edge") kn)
-
 (.get-or-create-index kn "know" "str-edge" #js ["name"])


Fix value type

Fix value type

--- src/kafka_test/core.clj
+++ src/kafka_test/core.clj
@@ -42,7 +42,10 @@

 (defn do-message!
   [msg]
-  (println "Consuming <=" (:value (kafka-core/to-clojure msg))))
+  (println "Consuming <=" (-> msg
+                              kafka-core/to-clojure
+                              :value
+                              (String. "UTF-8"))))

 (defn start-listening! [host port]
   (async/go


Add PATCH handler to the backend

Add PATCH handler to the backend

--- src/bartleby/handler.clj
+++ src/bartleby/handler.clj
@@ -5,6 +5,7 @@
             [ring.middleware.json :refer [wrap-json-response wrap-json-body]]
             [compojure.core :refer :all]
             [compojure.route :as route]
+            [compojure.coercions :refer [as-int]]
             [bartleby.db :as db]))

 (defn other-implementation-of-status
@@ -27,8 +28,9 @@
      (http-resp/not-implemented "not implemented"))
    (DELETE "/tasks/:id" [id]
      (http-resp/not-implemented "not implemented"))
-   (PATCH "/tasks/:id" [id]
-     (http-resp/not-implemented "not implemented"))))
+   (PATCH "/tasks/:id" [id :<< as-int]
+     (db/complete-task db-con {:id id})
+     (http-resp/ok {:status :ok}))))

 (defn entry-point
   [db-con]


Made columns in SQL query explicit.

Made columns in SQL query explicit.

--- src/kosha/db/search.clj
+++ src/kosha/db/search.clj
@@ -11,9 +11,9 @@
 (defn ragams
   "Retrieves n ragams from the db in order of similarity to the query."
   [ragam n]
-  (let [q  ["SELECT *, similarity_score(name, ?) AS score
+  (let [q  ["SELECT ragam_id, name, arohanam, avarohanam, melakartha, mela_ragam_id, ragam_link, data_source
              FROM tmp_ragams
-             ORDER BY score
+             ORDER BY similarity_score(name, ?)
              DESC LIMIT ?; "
             ragam n]]
     (vec (j/query db-pool/conn q :identifiers ->hyphens))))


Convert rain effect

Convert rain effect

--- src/zaffre/animation/wrapper.cljc
+++ src/zaffre/animation/wrapper.cljc
@@ -163,7 +163,7 @@
   ACmdStream
   (stream [this]
     (go-loop [x (first s) xs (next s)]
-      (doseq [[_ {:keys [layer-id]}] x]
+      (let [[_ {:keys [layer-id]}] x]
         (zat/clear! terminal layer-id))
       (let [[dt {:keys [layer-id characters]}] x]
         (zat/put-chars! terminal layer-id characters)
@@ -239,8 +239,15 @@
 (defn make-rain-effect
   [layer-id vw vh]
   (let [rain-state (repeat vh (vec (repeat vw nil)))]
-    (fn [terminal]
-      (RainEffect. terminal layer-id rain-state))))
+    (map (fn [rain-state]
+           [33 {:layer-id layer-id
+                :characters (for [[y line] (map-indexed vector rain-state)
+                                  [x cell] (map-indexed vector line)
+                                  :when cell]
+                              (rain-cell-char x y cell))}])
+         (iterate #(step-rain % vw vh) rain-state))))
+    #_(fn [terminal]
+      (RainEffect. terminal layer-id rain-state))

 (defrecord TransformEffect
   [terminal layer-id ch from to duration]
@@ -278,10 +285,11 @@
   ([layer-id characters]
     (make-blink-effect layer-id characters true))
   ([layer-id characters initial]
-    (make-blink-effect layer-id characters initial (constantly 1000)))
+    (make-blink-effect layer-id characters initial (repeat 1000)))
   ([layer-id characters initial intervals]
-    (fn [terminal]
-      (BlinkEffect. terminal layer-id characters initial intervals))))
+    (map vector intervals (interleave (repeat {:layer-id layer-id :characters []})
+                                      (repeat {:layer-id layer-id :characters characters})))))
+    ;(BlinkEffect. terminal layer-id characters initial intervals))))

 (defn make-blip-effect
   [layer-id characters duration]
@@ -326,7 +334,9 @@
             wrapped-term    (WrappedAnimatedTerminal. terminal (atom []) cmd-chan)
             effects-term    (WrappedAnimatedTerminal. terminal (atom []) cmd-chan)
             ;effects         (atom [((make-rain-effect :fx 16 16) effects-term)])]
-            effects         (atom [((make-blink-effect :fx [{:x 8 :y 8 :c \* :fg [128 128 0] :bg [0 0 0]}] true) effects-term)])]
+            effects         (atom [(->SeqEffect effects-term
+                                                (make-rain-effect :fx 16 16)
+                                                #_(make-blink-effect :fx [{:x 8 :y 8 :c \* :fg [128 128 0] :bg [0 0 0]}] true))])]
         #_(log/info "overriding terminal")
         #_(log/info "effects" @effects "filters" @filters)
         ;; start effects


add 'right now' as a note to english +(defn present-participle-of)

--- src/babel/english/morphology.cljc
+++ src/babel/english/morphology.cljc
@@ -49,31 +49,33 @@
      (throw (js/Error. error-string))))

 (defn present-participle-of [stem]
-  (cond
-
-    (re-find #"ie$" stem)
-    (str (replace stem #"..$" "y") "ing")
-
-    (re-find #"..e$" stem) ;; "..": avoid matching two-letter word "be"
-    (str (replace stem #"e$" "") "ing")
-
-    (re-find #"[eu]m$" stem)
-    (str (replace stem #"m$" "mm") "ing")
-
-    (re-find #"[ou]p$" stem)
-    (str (replace stem #"p$" "pp") "ing")
-
-    (re-find #"[^e][a]n$" stem)
-    (str (replace stem #"n$" "nn") "ing")
-
-    (re-find #"[ou]b$" stem)
-    (str (replace stem #"b$" "bb") "ing")
-
-    (re-find #"[^aeiou][eou]t$" stem)
-    (str (replace stem #"t$" "tt") "ing")
-
-    true
-    (str stem "ing")))
+  (let [pre-note
+        (cond
+
+          (re-find #"ie$" stem)
+          (str (replace stem #"..$" "y") "ing")
+
+          (re-find #"..e$" stem) ;; "..": avoid matching two-letter word "be"
+          (str (replace stem #"e$" "") "ing")
+
+          (re-find #"[eu]m$" stem)
+          (str (replace stem #"m$" "mm") "ing")
+
+          (re-find #"[ou]p$" stem)
+          (str (replace stem #"p$" "pp") "ing")
+
+          (re-find #"[^e][a]n$" stem)
+          (str (replace stem #"n$" "nn") "ing")
+
+          (re-find #"[ou]b$" stem)
+          (str (replace stem #"b$" "bb") "ing")
+
+          (re-find #"[^aeiou][eou]t$" stem)
+          (str (replace stem #"t$" "tt") "ing")
+
+          true
+          (str stem "ing"))]
+    (str pre-note " (right now)")))

 (defn get-string [word & {:keys [lexicon show-notes]
                           :or {lexicon nil


typed decl

typed decl

--- src/latte_compiler/static_analysis.clj
+++ src/latte_compiler/static_analysis.clj
@@ -452,8 +452,8 @@
       :decl (m/domonad util/phase-m
               [type (m-result (second code))
                decls (m-result (rest (rest code)))
-               res (reduce (process-decl glob-state type) (m-result [vars [:decl type]]) decls)]
-              res
+               [v e] (reduce (process-decl glob-state type) (m-result [vars [:decl type]]) decls)]
+              [v (with-type e type)]
               )
       :ass (m/domonad util/phase-m
              [name (m-result (second code))


type hints

type hints

--- src/c4_arena/players.clj
+++ src/c4_arena/players.clj
@@ -12,7 +12,9 @@
    [aima.core.environment.connectfour
     ConnectFourState ConnectFourGame ConnectFourAIPlayer]
    [aima.core.search.adversarial
-    AlphaBetaSearch]))
+    AdversarialSearch AlphaBetaSearch MinimaxSearch]))
+
+(set! *warn-on-reflection* true)

 (defn spawn-random-player []
   (let [ch-in (chan) ch-out (chan)]
@@ -40,39 +42,66 @@
           #{"ignored"} (tb/error "Invalid move, terminating")
           #{"state"} (let [{:keys [state turn you last-move]} msg]
                        (when last-move
-                         (.dropDisk c4-state last-move))
+                         (.dropDisk #^ConnectFourState c4-state last-move))
                        (when (= turn you)
-                         (put! ch-in {:type "move" :move (.makeDecision search c4-state)}))
+                         (put! ch-in {:type "move" :move (.makeDecision #^AdversarialSearch search c4-state)}))
                        (recur)))))
     {:id "aima" :ch-in ch-in :ch-out ch-out}))

-(defn tromp-str [^ConnectFourState state]
-  (->> (for [col (range (.getCols state))
-             row (reverse (range (.getRows state)))]
-         (case (.getPlayerNum state row col)
-           0 "b" 1 "x" 2 "o"))
-       doall (apply str)))
+(defn tromp-strs [^ConnectFourState state]
+  (let [crange (range 7)]
+    (for [cols [crange (reverse crange)]]
+      (->> (for [col cols
+                 row (reverse (range (.getRows state)))]
+             (case (.getPlayerNum state row col)
+               0 "b" 1 "x" 2 "o"))
+           doall (apply str)))))

 (defonce tromp-db
-  (with-open [in-file (io/reader (io/resource "tromp.csv"))]
-    (->> (csv/read-csv in-file)
-         (map (fn [row]
-                [(apply str (subvec row 0 (dec (count row))))
-                 (case (last row)
-                   "win" 1.0 "loss" 0.0 "draw" 0.5)]))
-         (into {}))))
+  (->>["tromp.csv" "tromp_extras.csv"]
+      (mapcat
+       (fn [file0]
+         (with-open [in-file (io/reader (io/resource file0))]
+           (->> (csv/read-csv in-file)
+                (map
+                 (fn [row]
+                   [(apply str (subvec row 0 (dec (count row))))
+                    (case (last row)
+                      "win" 1.0 "loss" 0.0 "draw" 0.5)]))
+                doall))))
+      (into {})))

-(defn tromp-terminated-connect4 []
-  (proxy [ConnectFourState] [6 7]
-    (getUtility []
-      (or
-       (-> this tromp-str tromp-db)
-       (proxy-super getUtility)))))
+(comment
+  ;; This prints out all the states not in the database
+  (.makeDecision
+   (AlphaBetaSearch. (ConnectFourGame.))
+   (let [seen (atom #{})]
+     (proxy [ConnectFourState] [6 7]
+       (getUtility []
+         (or
+          (when (= (.getMoves this) 8)
+            (let [boards (vec (tromp-strs this))]
+              (if-let [score (some tromp-db boards)]
+                score
+                (when (< (proxy-super getUtility) -1e-5)
+                  (when-not (some @seen boards)
+                    (println (first boards))
+                    (spit "unknowns" (str (first boards) "\n") :append true)
+                    (swap! seen conj (first boards)))
+                  0.5))))
+          (proxy-super getUtility)))))))

 (defn spawn-perfect-player []
   (let [ch-in (chan) ch-out (chan)
-        c4-state (tromp-terminated-connect4)
-        search (ConnectFourAIPlayer. (ConnectFourGame.) 1.)]
+        c4-state (proxy [ConnectFourState] [6 7]
+                   (getUtility []
+                     (let [^ConnectFourState this this]
+                       (or
+                        (when (= (.getMoves this) 8)
+                          (some->> this tromp-strs (some tromp-db)))
+                        (proxy-super getUtility)))))
+        ;; search (ConnectFourAIPlayer. (ConnectFourGame.) 1.)
+        search (AlphaBetaSearch. (ConnectFourGame.))]
     (go-loop []
       (when-let [msg (<! ch-out)]
         (condp contains? (:type msg)
@@ -80,8 +109,8 @@
           #{"ignored"} (tb/error "Invalid move, terminating")
           #{"state"} (let [{:keys [state turn you last-move]} msg]
                        (when last-move
-                         (.dropDisk c4-state last-move))
+                         (.dropDisk #^ConnectFourState c4-state last-move))
                        (when (= turn you)
-                         (put! ch-in {:type "move" :move (.makeDecision search c4-state)}))
+                         (put! ch-in {:type "move" :move (.makeDecision #^AdversarialSearch search c4-state)}))
                        (recur)))))
     {:id "aima" :ch-in ch-in :ch-out ch-out}))


will make this configurable eventually

will make this configurable eventually

but for now, I'll use Parse.ly's settings

--- jvm/src/streamparse/commands/submit_topology.clj
+++ jvm/src/streamparse/commands/submit_topology.clj
@@ -17,7 +17,11 @@
           topology (apply topology (var-get topology-def))
           topology-name (str (:name (meta topology-def)))]
        (StormSubmitter/submitTopology topology-name
-                                      {TOPOLOGY-DEBUG debug}
+                                      {TOPOLOGY-DEBUG false
+                                       TOPOLOGY-ACKER-EXECUTORS 8
+                                       TOPOLOGY-MAX-SPOUT-PENDING 5000
+                                       TOPOLOGY-MESSAGE-TIMEOUT-SECS 60
+                                       TOPOLOGY-WORKERS 8}
                                       topology))
     (catch Exception e
       ((println (str "Caught exception: " (.getMessage e) \newline))


bumping figwheel dep

bumping figwheel dep

--- src/leiningen/new/figwheel/project.clj
+++ src/leiningen/new/figwheel/project.clj
@@ -12,7 +12,7 @@
                  [reagent "0.5.0"]{{/reagent?}}]

   :plugins [[lein-cljsbuild "1.1.0"]
-            [lein-figwheel "0.3.8"]]
+            [lein-figwheel "0.3.9"]]

   :source-paths ["src"]


improve-logging: added database-specific logging and error message

--- src/main/clojure/com/xebia/visualreview/middleware.clj
+++ src/main/clojure/com/xebia/visualreview/middleware.clj
@@ -30,13 +30,19 @@
           (log/error (str "A service exception occured, code " code ", message " message))
           {:status  500
            :headers {}
-           :body    (str "Internal service exception occured")}))
+           :body    (str "Internal service error occured")}))
+      (catch SQLException e
+        (do
+          (log/error (str "An error occured involving the database: " (.getMessage e)) e)
+          {:status 500
+           :headers {}
+           :body "Internal database error occured"}))
       (catch Exception e
         (do
-          (log/error e (str "A request triggered an unhandled exception, as a result the request was met with a HTTP status 500 response." (.getMessage e)))
+          (log/error (str "A request triggered an unhandled exception, as a result the request was met with a HTTP status 500 response." (.getMessage e)) e)
           {:status  500
            :headers {}
-           :body    "Internal error occurred"})))))
+           :body    "Internal error occured"})))))

 (defn wrap-tx [handler]
   (fn [req]


don't broadcast message back to self

don't broadcast message back to self

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -37,9 +37,10 @@
 (defmethod event-msg-handler :chat/new-message
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]
   (db/with-conn (db/create-message! ?data))
-  (doseq [uid (->> (:any @connected-uids)
-                   (remove (partial = id)))]
-    (chsk-send! uid [:chat/new-message ?data])))
+  (when-let [user-id (get-in ring-req [:session :user-id])]
+    (doseq [uid (->> (:any @connected-uids)
+                     (remove (partial = user-id)))]
+      (chsk-send! uid [:chat/new-message ?data]))))

 (defmethod event-msg-handler :user/subscribe-to-tag
   [{:as ev-msg :keys [event id ?data ring-req ?reply-fn send-fn]}]


remove circular dependency

remove circular dependency

--- src/chat/server/sync.clj
+++ src/chat/server/sync.clj
@@ -10,9 +10,7 @@
             [chat.server.digest :as digest]
             [clojure.set :refer [difference intersection]]
             [chat.shared.util :refer [valid-nickname? valid-tag-name?]]
-            [chat.server.extensions :refer [handle-thread-change]]
-            ; just requiring to register multimethods
-            chat.server.extensions.asana))
+            [chat.server.extensions :refer [handle-thread-change]]))

 (let [{:keys [ch-recv send-fn ajax-post-fn ajax-get-or-ws-handshake-fn
               connected-uids]}


Send accepted-repositories

Send accepted-repositories

--- src/cider_ci/ex/ping.clj
+++ src/cider_ci/ex/ping.clj
@@ -5,6 +5,7 @@

 (ns cider-ci.ex.ping
   (:require
+    [cider-ci.ex.accepted-repositories :as accepted-repositories]
     [cider-ci.ex.traits :as traits]
     [cider-ci.utils.daemon :as daemon]
     [drtom.logbug.debug :as debug]
@@ -32,7 +33,9 @@
           max-load (or (:max_load config)
                        (.availableProcessors(Runtime/getRuntime)))
           data {:traits traits
-                :max_load max-load}]
+                :max_load max-load
+                :accepted-repositories (accepted-repositories/get-accepted-repositories)
+                }]
       (http/post url {:body (json/write-str data)})
       (Thread/sleep (* 1000 3)))
     (catch Exception e


* src/clj/cljs/closure.clj: add :static-fns compiler option

--- src/clj/cljs/closure.clj
+++ src/clj/cljs/closure.clj
@@ -871,6 +871,7 @@
                         :ups-externs (:externs ups-deps))
         compiled (binding [comp/*cljs-static-fns*
                            (or (and (= (opts :optimizations) :advanced))
+                               (:static-fns opts)
                                comp/*cljs-static-fns*)]
                    (-compile source all-opts))
         compiled (concat


Add fork-repo and create-pull-request functions.

--- src/clj/hatnik/utils.clj
+++ src/clj/hatnik/utils.clj
@@ -3,7 +3,10 @@
             [ring.util.response :as resp]
             [taoensso.timbre :as timbre]
             [taoensso.timbre.appenders.postal :refer [make-postal-appender]]
-            [tentacles.issues :as issues]
+            [tentacles
+             [issues :as issues]
+             [repos :as repos]
+             [pulls :as pulls]]
             [clojure.string :as cstr]))

 (defn send-email
@@ -37,6 +40,27 @@
   (issues/create-issue user repo title
                        {:body body
                         :oauth-token github-token}))
+
+(defn fork-github-repo
+  "Forks github repo. Returns clone url.
+    github-token - token of Hathink github user.
+    user - owner of the repo we want to fork.
+    repo - repo we want to fork."
+  [github-token user repo]
+  (->> {:oauth-token github-token}
+       (repos/create-fork user repo)
+       (:ssh_url)))
+
+(defn create-github-pull-request
+  "Creates github pull request, all commits must be pushed to
+  server to be ready for pull-requesting.
+    github-token - token of Hathink github user.
+    data - map with pull request settings. Should contain
+           following fields: :user, :repo, :title, :body, :branch"
+  [github-token {:keys [user repo title body branch] :as data}]
+  (pulls/create-pull user repo title "master" (str "hatnik:" branch)
+                     {:oauth-token github-token
+                      :body body}))

 (defn fill-template
   "Substitutes variables to all {{aba}} placeholders if variable exists.


test the template a little bit

test the template a little bit

--- test/start_clojure/test/core.clj
+++ test/start_clojure/test/core.clj
@@ -1,6 +1,7 @@
 (ns start-clojure.test.core
 	(:use		[start-clojure.core]
 				[clojure.test]
+				[clojure.string :only (join)]
 				[clj-time.core :only (now date-time)])
 	(:require	[clojure.contrib.string]))

@@ -18,13 +19,22 @@
 		(let [body (:body (request-get "/api/post/" main-routes))]
 			(is (clojure.contrib.string/substring?
 					(str ":\"" new-content "\"") body ))
-			(is (clojure.contrib.string/substring? "\"content\":" body ))
-			(is (clojure.contrib.string/substring? "\"title\":" body )))))
+			(is (clojure.contrib.string/substring? "\"content\":" body))
+			(is (clojure.contrib.string/substring? "\"title\":" body)))))

-(deftest test-post-representation []
+(deftest test-post-json-representation []
 	(let [post {:title "title", :text "text",
 			:created_date (java.sql.Timestamp. (.getMillis (
 					date-time 2011 8 2 3 4 5 6)))}]
 		(is (= "20110802T030405.006Z" (:created_date
 				(render-post-json post))))))

+(deftest test-get-posts []
+	(let [content (str "some new content" (now)) title (str "new title " (now))]
+		(is (= 200 (:status (request-post "/api/post/" main-routes
+			{:title title :content content}))))
+		(let [body (join (:body (request-get "/post/" main-routes)))]
+			(is (clojure.contrib.string/substring? "<html" body))
+			(is (clojure.contrib.string/substring? "div class=\"container" body))
+			(is (clojure.contrib.string/substring? title body))
+			(is (clojure.contrib.string/substring? content body)))))


fix import

fix import

--- src/clj/scrabble/api.clj
+++ src/clj/scrabble/api.clj
@@ -6,7 +6,8 @@
             [clojure.data.json :as json]
             [compojure.handler :refer [site]]
             [scrabble.core :as scrabble]
-            [environ.core :as env]
+            ;; import env
+            [environ.core :refer [env]]
             [ring.adapter.jetty :as jetty]
             [ring.middleware.json :refer [wrap-json-response]]
             [ring.middleware.defaults :refer [api-defaults wrap-defaults]]))


console.dir instead of %O

console.dir instead of %O

--- src/cljs/klang/core.cljs
+++ src/cljs/klang/core.cljs
@@ -232,11 +232,12 @@
      :on-click (fn[_]
                  (do
                    (js/console.group
-                    "%s/%s -- %O" (:ns lg-ev)
+                    "%s/%s -- %s" (:ns lg-ev)
                     (name (:type lg-ev))
                     (tf/unparse (:hour-minute-second-ms tf/formatters)
                                 (:time lg-ev)))
-                   (mapv #(js/console.log "%O" %) (:msg lg-ev))
+                   ;;(mapv #(js/console.log "%O" %) (:msg lg-ev))
+                   (mapv #(js/console.dir %) (:msg lg-ev))

                    (js/console.groupEnd)
                    ))}


CMR-183: Updated to hide implementation details of using core.cache.

--- src/cmr/common/cache.clj
+++ src/cmr/common/cache.clj
@@ -19,22 +19,52 @@
                  (cc/miss cache key (f)))))
       (get key)))

+(defmulti create-core-cache
+  "Create a cache using cmr.core-cache of the given type."
+  (fn [type value opts]
+    type))
+
+(defmethod create-core-cache :default
+  [type value opts]
+  (cc/basic-cache-factory value))
+
+(defmethod create-core-cache :lru
+  [type value opts]
+  (cc/lru-cache-factory opts))
+
 (defn create-cache
   "Create system level cache."
   ([]
-   (create-cache (cc/basic-cache-factory {})))
-  ([initial-cache]
-   {:initial initial-cache
-    :atom (atom initial-cache)}))
+   (create-cache :basic {} {}))
+  ([cache-type]
+   (create-cache cache-type {} {}))
+  ([cache-type initial-cache-value]
+   (create-cache cache-type initial-cache-value {}))
+  ([cache-type initial-cache-value opts]
+   (let [initial-cache (create-core-cache cache-type initial-cache-value opts)]
+     {:initial initial-cache
+      :atom (atom initial-cache)})))

 (defn reset-cache
   [cmr-cache]
   (reset! (:atom cmr-cache) (:initial cmr-cache)))

-(defn set-cache!
-  [cmr-cache value]
-  (swap! (:atom cmr-cache)
-         (fn [_] value)))
+(defn update-cache
+  "Update the cache contents with the output of the given funciton, f. f takes the
+  current cache as its input and returns the new cache state."
+  [cmr-cache f]
+  (let [core-cache (deref (:atom cmr-cache))
+        new-state (f cmr-cache)
+        ;; FIXME - this relies on an implementation details of cmr.core.cache, which is BAD
+        new-cache (merge core-cache new-state)]
+    (swap! (:atom cmr-cache) (fn [_] new-cache))))
+
+(defn set-cache-key-value
+  "Set a single key/value pair for the cache."
+  [cmr-cache cache-key value]
+  (let [core-cache (deref (:atom cmr-cache))]
+    (swap! (:atom cmr-cache)
+           (fn [_] (cc/miss core-cache cache-key value)))))


Make Eastwood happy. Thanks Eastwood!

Make Eastwood happy. Thanks Eastwood!

--- src/oc/email/mailer.clj
+++ src/oc/email/mailer.clj
@@ -41,8 +41,8 @@
                           :source (str company-name "<" company-slug "@" c/email-from-domain ">")
                           :reply-to (if (s/blank? reply-to) default-reply-to reply-to)
                           :subject subject}
-                    {:html body}))
-              to)))
+                    {:html body})
+              to))))

 (defn send-snapshot
   "Create an HTML snapshot and email it to the specified recipients."


Hardcoded vslues for columns AX AY and AZ

--- src/clinvar_submitter/variant.clj
+++ src/clinvar_submitter/variant.clj
@@ -78,9 +78,9 @@
      ""
      ""
      ""
-     (str (:collection-method opts))
-     (str (:allele-origin opts))
-     (str (:affected-status opts))  ;; this is col#52 AZ
+     "curation" ;; AX - hardcoded per LB
+     "germline" ;; AY - hardcoded per LB
+     "unknown"  ;; this is col#52 AZ - hardcoded per LB
      ""
      ""
      ""


tighten turn-flag of Dedication Ceremony

--- src/clj/game/cards-operations.clj
+++ src/clj/game/cards-operations.clj
@@ -192,13 +192,15 @@
    {:prompt "Choose a faceup card"
     :choices {:req rezzed?}
     :msg (msg "place 3 advancement tokens on " (card-str state target))
-    :effect (effect (add-prop :corp target :advance-counter 3 {:placed true})
-                    (register-turn-flag!
-                      target :can-score
-                      (fn [state side card]
-                        (if (>= (:advance-counter card) (or (:current-cost card) (:advancementcost card)))
-                          ((constantly false) (toast state :corp "Cannot score due to Dedication Ceremony." "warning"))
-                          true))))}
+    :effect (req (add-prop state :corp target :advance-counter 3 {:placed true})
+                 (let [tgtcid (:cid target)]
+                   (register-turn-flag! state side
+                     target :can-score
+                     (fn [state side card]
+                       (if (and (= (:cid card) tgtcid)
+                                (>= (:advance-counter card) (or (:current-cost card) (:advancementcost card))))
+                         ((constantly false) (toast state :corp "Cannot score due to Dedication Ceremony." "warning"))
+                         true)))))}

    "Defective Brainchips"
    {:events {:pre-damage {:req (req (= target :brain)) :msg "to do 1 additional brain damage"


Ordered <ol> used for table of contents

Ordered <ol> used for table of contents

--- dev/src/yada/dev/user_guide.clj
+++ dev/src/yada/dev/user_guide.clj
@@ -180,7 +180,7 @@
   (last (str/split (.getName (type r)) #"\.")))

 (defn toc [xml dropno]
-  {:tag :ul
+  {:tag :ol
    :attrs nil
    :content (vec
              (for [ch (drop dropno (extract-chapters xml))]


clean code

clean code

--- src/clj/salava/metabadge/cron.clj
+++ src/clj/salava/metabadge/cron.clj
@@ -7,66 +7,8 @@
             [salava.metabadge.db :as db]
             [clojure.string :as string]))

-(defn- fetch-json-data [url]
-  (try
-    (http/http-get url {:as :json :accept :json})
-    (catch Exception e
-      (log/error (str "Could not fetch data: " url))
-      {})))
-
-(defn- metabadge?!
-  "checks if badge is a metabadge, db is updated with information"
-  [db-conn factory-url user_badge]
-  (let [url (str factory-url "/v1/assertion/is_metabadge/?url=" (u/url-encode (:assertion_url user_badge)))
-        data (fetch-json-data url)]
-    (when-not (every? nil? (-> data (dissoc :last_modified) vals))
-      (if (nil? (:metabadge data))
-        (jdbc/execute! db-conn
-                       ["INSERT IGNORE INTO user_badge_metabadge (user_badge_id, meta_badge_req, last_modified) VALUES (?,?,?)"
-                        (:id user_badge) (:required_badge data) (:last_modified data)])
-        (doseq [m (:metabadge data)]
-          (jdbc/execute! db-conn
-                         ["INSERT IGNORE INTO user_badge_metabadge (user_badge_id, meta_badge, meta_badge_req, last_modified) VALUES (?,?,?,?)"
-                          (:id user_badge) m (:required_badge data) (:last_modified data)]))))))
-
-;;TODO why does it skip some badges
-(defn- get-metabadge! [ctx db-conn factory-url user_badge]
-  (let [url (str factory-url "/v1/assertion/metabadge/?url=" (u/url-encode (:assertion_url user_badge)))
-        metabadges (:metabadge (fetch-json-data url))]
-    (when-not (empty? metabadges)
-      (doseq [metabadge metabadges
-              :let [metabadge-badge-content (when-not (-> metabadge :badge :received) (fetch-json-data (-> metabadge :badge :url)))
-                    user_metabadge (when (-> metabadge :badge :received) (db/user-badge-by-assertion ctx (-> metabadge :badge :url)))
-                    {:keys [description criteria image]} metabadge-badge-content]]
-
-        (if-not (-> metabadge :badge :received)
-          (jdbc/execute! db-conn
-                         ["INSERT IGNORE INTO factory_metabadge (id, name, description, criteria, image_file, min_required, ctime, mtime ) VALUES (?,?,?,?,?,?,?,?)"
-                          (:id metabadge) (:name metabadge) description (u/md->html criteria) (u/file-from-url ctx image) (:min_required metabadge) (u/now) (u/now)])
-
-          (doseq [um user_metabadge]
-            (jdbc/execute! db-conn
-                           ["INSERT IGNORE INTO user_metabadge_received (metabadge_id, user_badge_id, user_id, name, min_required, last_modified) VALUES (?,?,?,?,?,?)"
-                            (:id metabadge) (:id um) (:user_id user_badge) (:name metabadge) (:min_required metabadge) (:last_modified user_badge) ])
-            ))
-        (doseq [badge (:required_badges metabadge)
-                :let [required-badge-content (when-not (:received badge) (fetch-json-data (:url badge)))
-                      user-badge (when (:received badge) (db/user-badge-by-assertion ctx (:url badge)))
-                      {:keys [name description image criteria]} required-badge-content]]
-          (if-not (:received badge)
-            (jdbc/execute! db-conn
-                           ["INSERT IGNORE INTO factory_metabadge_required (metabadge_id, required_badge_id, name, description, criteria, image_file, ctime, mtime) VALUES (?,?,?,?,?,?,?,?)"
-                            (:id metabadge) (:id badge) name description (u/md->html criteria) (u/file-from-url ctx image) (u/now) (u/now)])
-            (doseq [um user_metabadge]
-              (doseq [ub user-badge]
-                (jdbc/execute! db-conn
-                               ["INSERT IGNORE INTO user_metabadge_required_received (metabadge_id, user_metabadge_id, user_required_badge_id, user_id, last_modified) VALUES (?,?,?,?,?)"
-                                (:id metabadge) (:id um) (:id ub) (:user_id user_badge) (:last_modified user_badge)])))
-            ))))))
-
-(defn- badge->metabadge! [ctx factory-url]
+(defn- badge->metabadge! [ctx db-conn factory-url]
   (log/info "get metabadges: started working")
-  (jdbc/with-db-transaction  [db-conn (:connection (u/get-db ctx))]
     (let [time-limit (+ (System/currentTimeMillis) (* 15 60 1000))
           sql "SELECT DISTINCT ub.id, ub.user_id, ub.assertion_url, ubm.last_modified FROM user_badge_metabadge AS ubm
           JOIN user_badge AS ub ON ubm.user_badge_id = ub.id
@@ -77,7 +19,7 @@
         (when (> time-limit (System/currentTimeMillis))
           (doseq [user-badge chunk]
             (try
-              (get-metabadge! ctx db-conn factory-url user-badge)
+              (db/get-metabadge! ctx db-conn factory-url user-badge)
               (catch Throwable ex
                 (log/error "get-metabadges failed")
                 (log/error (.toString ex))
@@ -87,7 +29,7 @@
           (try (Thread/sleep 1000) (catch InterruptedException _))
           ))
       (log/info "get metabadges: done")
-      )))
+      ))

 (defn- check-metabadges [ctx factory-url]
   (log/info "check for metabadges: started working")
@@ -98,14 +40,12 @@
           AND deleted = 0 AND revoked = 0 AND status != 'declined'
           AND (expires_on IS NULL OR expires_on > UNIX_TIMESTAMP())
           ORDER BY last_checked LIMIT 1000"
-          ; all-badges (jdbc/query db-conn [sql])
-          badges (filter #(and (not (nil? (:assertion_url %))) (string/starts-with? (:assertion_url %) factory-url)) (jdbc/query db-conn [sql]))
-          ]
+          badges (filter #(and (not (nil? (:assertion_url %))) (string/starts-with? (:assertion_url %) factory-url)) (jdbc/query db-conn [sql]))]
       (doseq [chunk (partition-all 10 badges)]
         (when (> time-limit (System/currentTimeMillis))
           (doseq [user-badge chunk]
             (try
-              (metabadge?! db-conn factory-url user-badge)
+              (db/metabadge?! db-conn factory-url user-badge)
               (catch Throwable ex
                 (log/error "check-metabadges failed")
                 (log/error (.toString ex))
@@ -118,7 +58,7 @@
       ;;call other function
       )
     (log/info "check for metabadges: done")
-    (badge->metabadge! ctx factory-url)
+    (badge->metabadge! ctx db-conn factory-url)
     ))

 (defn every-hour [ctx]


Preliminary version of listlpv

Preliminary version of listlpv

--- src/clj/webapp/routes/listgen.clj
+++ src/clj/webapp/routes/listgen.clj
@@ -28,7 +28,7 @@
      [:p (link-to "/listvlcl" "POS Paradigm Value-Clusters")
       [:ul [:li "This set of queries makes a list of the set of values ('Value Clusters', 'Paradigm Names') associated with each paradigm for a given language and part-of-speech. In the case of finite verbs these are the default person-number-gender subject agreement paradigms -- person-number-gender-case typically for pronoun. The relevant dimensions for noun and non-finite verb are less clear, and a suitable set of comparable dimensions remains to be worked out. Note that at present, noun paradigms are recorded only exceptionally in this archive."
             ]]]
-     [:p (link-to "/listlpv" "Language-Property-Value Co-occurrences")
+     [:p (link-to "/listlpv" "Property-Value Indices by Language Domain")
       [:ul [:li "This set of queries will generate for a given language, language-family, or set of languages, four tables with entries:"
        [:ol
         [:li "lang prop: val, val, val, ..." [:br]


remove buggy heap dispaly code

remove buggy heap dispaly code

--- src/cljs/netrunner/gameboard.cljs
+++ src/cljs/netrunner/gameboard.cljs
@@ -175,12 +175,10 @@
 (defmethod discard-view "Runner" [{:keys [discard] :as cursor} owner]
   (om/component
    (sab/html
-    [:div.panel.blue-shade.discard {:on-click #(-> (om/get-node owner "heap") js/$ .toggle)}
+    [:div.panel.blue-shade.discard
      (om/build label discard {:opts {:name "Heap"}})
      (when-not (empty? discard)
-       (om/build card-view (last discard))
-       [:div.panel.blue-shade.heap {:ref "heap"}
-        (om/build-all cursor card-view)])])))
+       (om/build card-view (last discard)))])))

 (defmethod discard-view "Corp" [{:keys [discard] :as cursor}]
   (om/component


Add item camera manipulation

Add item camera manipulation

--- src/clojure/embla3d/new_world.clj
+++ src/clojure/embla3d/new_world.clj
@@ -58,7 +58,6 @@
                (int-array (flat-map faces))
                (int weight) (float-array rgb) texture-name))
 ;; Items Functions------------------------------------------------
-;;TODO create basic block item
 (defn create-item!
   "Create an item in the `world` with the
   specified id, position, mesh"
@@ -83,7 +82,9 @@
                 :scale scale
                 :mesh (create-mesh! world :rgb color :texture-name texture)))

-;;TODO NEED CAMERA MANAGEMENT
+;;CAMERA MANAGEMENT------------------------------------------------
+(defn camera "Retrieve the main camera of the world" [world] (.getCamera world))
+

 ;; Collision

@@ -107,4 +108,14 @@
   [world item1 item2]
   (.isInCollision world item1 item2))

-;; Generic Generic------------------------------------------------
+;; Item/camera Manipulation ------------------------------------------------
+(defn rotate! [item & {:keys [x y z]
+                       :or   {x 0
+                              y 0
+                              z 0}}]
+  (.rotate item x y z))
+(defn translate! [item & {:keys [x y z]
+                          :or   {x 0
+                                 y 0
+                                 z 0}}]
+  (.translate item x y z))


Assert that values can have metadata

Assert that values can have metadata

--- src/main/cljc/mikron/buffer_macro.cljc
+++ src/main/cljc/mikron/buffer_macro.cljc
@@ -25,11 +25,13 @@
   (defn without-tag
     "Removes the `tag` metadata from `value`."
     [value]
+    (assert (util/can-have-meta? value))
     (vary-meta value dissoc :tag))

   (defn without-primitive-tag
     "Removes the primitive `tag` metadata from `value`."
     [value]
+    (assert (util/can-have-meta? value))
     (vary-meta value (fn [{:keys [tag] :as meta}]
                        (cond-> meta
                          (#{'long 'double} tag) (dissoc :tag)))))


Change caught js exception type to :default

--- src/main/cljc/mikron/runtime/util.cljc
+++ src/main/cljc/mikron/runtime/util.cljc
@@ -15,5 +15,5 @@
   [ex-value & body]
   `(try
      (do ~@body)
-     (catch ~(if (compiler.util/cljs?) `js/Object `Throwable) e#
+     (catch ~(if (compiler.util/cljs?) :default `Throwable) e#
        ~ex-value)))


Display JVM System Properties in the exception view

Fixes #7.

--- src/main/clojure/cascade/exception.clj
+++ src/main/clojure/cascade/exception.clj
@@ -150,7 +150,8 @@
   Formats a detailed HTML report of the exception and the overall environment."
   [env]
   (let [#^HttpServletRequest request (-> env :servlet-api :request)
-  		  #^HttpSession session (.getSession request false)]
+  		  #^HttpSession session (.getSession request false)
+  		  path-sep (System/getProperty "path.separator")]
     (template
 	    :html [
 	    :head [
@@ -202,7 +203,23 @@
 						(template
 							:h2 [  "Session" ]

-							(render session)))
+							(render session)))
+
+					:h2 [ "System Properties" ]
+
+					:dl [
+						(template-for [name (sort (seq (.keySet (System/getProperties))))
+													:let [value (System/getProperty name)]]
+							:dt [ name ]
+							:dd [
+								(if (or (.endsWith name "path") (.endsWith name "dirs"))
+									(template :ul [
+										(template-for [v (.split value path-sep)]
+											:li [ v ])
+									])
+									value)
+							 ])
+					]
 				]
 	    ]
 	  ])))


fixing etenemä units

fixing etenemä units

--- src/ontrail/formats.clj
+++ src/ontrail/formats.clj
@@ -42,7 +42,7 @@
   (let [{:keys [duration distance avghr]} exercise
         {:keys [resthr]} profile]
     (if (positive-numbers? (list resthr duration distance avghr))
-        (string/replace (format "%.2f m/b" (/ distance (* (- avghr resthr) duration (double (/ 1 6000))))) #"\." ",")))
+        (string/replace (format "%.2f m/b" (/ distance (* (- avghr resthr) duration (double (/ 1 6000))))) #"\." ","))))

 (defn to-human-distance [distance]
   (if (= nil distance)


different implementation of stm

different implementation of stm

--- internal/machina/src/samsara/machina/core.clj
+++ internal/machina/src/samsara/machina/core.clj
@@ -202,25 +202,6 @@
 (comment

   ;; write to file example
-  (def sm
-    {:state :machina/start
-     :data   nil
-     :transitions
-     {:machina/start {:fn*        (constantly "/tmp/1/2/3/4/5/file.txt")
-                      :on-success (constantly :write-to-file)
-                      :on-failure (constantly :machina/stop)}
-
-
-      :sleep {:fn*        (do! (fn [_] (Thread/sleep 1000)))
-              :on-success (constantly :write-to-file)
-              :on-failure (constantly :sleep)}
-
-
-      :write-to-file {:fn*        (do! write-to-file)
-
-                      :on-success (fn [sm] (println "OK")   (clojure.pprint/pprint sm) :sleep)
-                      :on-failure (fn [sm] (println "FAIL") (clojure.pprint/pprint sm) :sleep)}}})
-

   ;;
   ;; Most generic approach
@@ -289,3 +270,79 @@
 ;; so that it is possible to add wrappers/filters style functions
 ;; which handle cross/cutting concerns.
 ;;
+
+(comment
+
+  (defn log-state-change [handler]
+    (fn [sm1]
+      (let [sm2 (handler sm1)]
+        (println "transition: " (:state sm1) "->" (:state sm2))
+        sm2)))
+
+  ;; write to file example
+  (def sm
+    {:state :machine/start
+     :data nil
+
+     :dispatch
+     {:machine/stop identity
+      :machine/start
+      (fn
+        [sm]
+        (assoc sm
+               :data "/tmp/1/2/3/4/5/file.txt"
+               :state :write-to-file))
+
+      :write-to-file
+      (fn
+        [{f :data :as sm}]
+        (try
+          (write-to-file f)
+          (assoc sm :state :sleep)
+          (catch Exception x
+            (assoc sm :state :sleep))))
+
+      :sleep
+      (fn
+        [sm]
+        (Thread/sleep 1000)
+        (assoc sm :state :write-to-file))}
+
+     :wrappers
+     [#'log-state-change]})
+
+
+  (defn bad-state [sm]
+    (throw (ex-info "Invalid state" sm)))
+
+  ;; this seems to maintain the simplicity of
+  ;; the earlier attempts with the general
+  ;; approach of the multi-method
+  ;; without scarifying the ability to
+  ;; manage cross-cutting concerns.
+  ;; note: are wrappers the best approach?
+  ;; maybe something like pedestal stacklets
+  ;; would be easier?
+
+  (defn transition
+    [{:keys [state data dispatch wrappers] :as sm}]
+    (let [f0 (get dispatch state bad-state)
+          f  (reduce (fn [wt w1] (wt w1)) identity
+                (concat wrappers [f0]))]
+      (f sm)))
+
+  (comment
+
+    (-> sm
+        transition
+        transition
+        ;;transition
+        )
+
+    (->> sm
+         (iterate transition)
+         (take-while #(not= :machine/stop (:state %)))
+         (last))
+
+
+    ))


addressing warning about method not being used for hydration.

--- src/metabase/models/dashboard_card.clj
+++ src/metabase/models/dashboard_card.clj
@@ -35,7 +35,7 @@
 ;;; ## ---------------------------------------- HYDRATION ----------------------------------------

-(defn ^:hydrate dashboard
+(defn dashboard
   "Return the `Dashboard` associated with the `DashboardCard`."
   [{:keys [dashboard_id]}]
   {:pre [(integer? dashboard_id)]}


RS | Set session cookie as http-only

RS | Set session cookie as http-only

--- src/objective8/core.clj
+++ src/objective8/core.clj
@@ -124,7 +124,7 @@
       wrap-json-params
       wrap-json-response
       wrap-flash
-      wrap-session))
+      (wrap-session {:cookie-attrs {:http-only true}})))

 (defonce server (atom nil))
 (defonce postgres-connection-pool (atom nil))


Replace fn with idiomatic function

Replace fn with idiomatic function

--- src/discuss/utils/extensions.cljs
+++ src/discuss/utils/extensions.cljs
@@ -36,4 +36,4 @@
       ([array f start]
        (ci-reduce array f start)))))

-(doall (map extend-type-fn types))
+(run! extend-type-fn types)


Transformations are now accepted as optional arguments to the note fns.

--- src/overtunes/pitch.clj
+++ src/overtunes/pitch.clj
@@ -32,12 +32,15 @@
   [m ks] (difference (set (keys m)) ks))

 (defn grounding [offset]
-  "Takes an offset from root and produces a function for rendering chords."
+  "Takes an offset and produces a function for producing concrete sounds."
   (fn
     ([octave-number]
      (+ offset (* octave-number octave)))
-    ([octave-number chord]
-     (map #(+ offset % (* octave-number octave)) (vals chord)))))
+    ([octave-number chord & transformations]
+     (let [octave-offset (* octave-number octave)
+          transform (apply comp transformations)
+          transformed-chord (transform chord)]
+       (map #(+ offset octave-offset %) (vals transformed-chord))))))

 ; Define a major scale. We could easily define other modes,
 ; but they aren't needed at present.


Fix typo

Fix typo

--- sidecar/src/figwheel_sidecar/auto_builder.clj
+++ sidecar/src/figwheel_sidecar/auto_builder.clj
@@ -36,7 +36,7 @@
 (def server-kill-switch (atom false))

 (defn autobuild [src-dirs build-options figwheel-options]
-  (let [figwheel-options' (merge figwheel-options (select-keys build-options [:ouput-dir :output-to]))
+  (let [figwheel-options' (merge figwheel-options (select-keys build-options [:output-dir :output-to]))
         figwheel-state' (fig/start-server figwheel-options')
         warning-handler (fn [warning-type env extra]
                           (when (warning-type cljs.analyzer/*cljs-warnings*)


hide feedback button from builds page

hide feedback button from builds page

--- src-cljs/frontend/components/pieces/page_header.cljs
+++ src-cljs/frontend/components/pieces/page_header.cljs
@@ -250,7 +250,8 @@
              [:.actions
               (when (ld/feature-on? "top-bar-beta-button")
                 [:div.topbar-toggle
-                 (when has-topbar?
+                 (when (and has-topbar?
+                            (not (= (:nav-point topbar-beta) :build)))
                    [:span.feedback
                      (button/link {:fixed? true
                                    :kind :primary


Add missing paren

Add missing paren

--- boot/core/src/boot/main.clj
+++ boot/core/src/boot/main.clj
@@ -219,4 +219,4 @@
                        c (.getCause cx)
                        m (.getMessage (or c cx))
                        x (or c cx)]
-                   (throw (ex-info m (merge (sorted-map :line l) (ex-data c) x))))))))))
+                   (throw (ex-info m (merge (sorted-map :line l) (ex-data c)) x))))))))))


Use a channel-based API

Use a channel-based API

--- test-cljs/frontend/test_send.cljs
+++ test-cljs/frontend/test_send.cljs
@@ -336,22 +336,19 @@

    #{:user/favorite-color :user/favorite-number}
    (fn [context ast]
-     (let [c (async/promise-chan)
-           get-user (get-in context [:apis :get-user])]
-       (get-user {:user/name (:user/name context)}
-                 #(put! c %))
-       c))
+     (let [get-user (get-in context [:apis :get-user])]
+       (get-user {:user/name (:user/name context)})))

    :user/favorite-fellow-user
    (fn [context ast]
      (let [c (chan)
            get-user (get-in context [:apis :get-user])]
-       (get-user {:user/name (:user/name context)}
-                 (fn [user]
-                   (-> (resolve* (assoc context :user/name (:user/favorite-fellow-user-name user))
-                                 User
-                                 (:children ast))
-                       (async/pipe c))))
+       (go
+         (let [user (<! (get-user {:user/name (:user/name context)}))]
+           (-> (resolve* (assoc context :user/name (:user/favorite-fellow-user-name user))
+                         User
+                         (:children ast))
+               (async/pipe c))))
        c))})

@@ -359,18 +356,6 @@
   {:root/user
    (fn [context ast]
      (resolve* (assoc context :user/name (:user/name (:params ast))) User (:children ast)))})
-
-(defn memoize-cb [f]
-  (let [mem (atom {})]
-    (fn [& args]
-      (let [mem-args (butlast args)
-            cb (last args)]
-        (if-let [e (find @mem mem-args)]
-          (cb (val e))
-          (apply f (concat mem-args
-                           [#(do
-                               (swap! mem assoc mem-args %)
-                               (cb %))])))))))

 (deftest new-thing-works
   (async done
@@ -381,10 +366,12 @@
                                               :user/favorite-fellow-user-name "jburnford"}
                    {:user/name "jburnford"} {:user/favorite-color :color/red
                                              :user/favorite-number 7}}
-            c (resolve {:apis {:get-user (memoize-cb
-                                          (fn [params cb]
+            c (resolve {:apis {:get-user (memoize
+                                          (fn [params]
                                             (swap! api-calls conj [:get-user params])
-                                            (cb (get users params))))}}
+                                            (let [c (async/promise-chan)]
+                                              (put! c (get users params))
+                                              c)))}}
                        Root '[{(:root/user {:user/name "nipponfarm"})
                                [:user/name
                                 :user/favorite-color


logviewer

logviewer

--- storm-core/src/clj/backtype/storm/daemon/logviewer.clj
+++ storm-core/src/clj/backtype/storm/daemon/logviewer.clj
@@ -320,7 +320,7 @@
           logs-groups (concat (conf LOGS-GROUPS)
                               group-wl)]
        (or (some #(= % user) logs-users)
-           (< 0 (.size (intersection (set groups) (set group-wl))))))))
+           (< 0 (.size (intersection (set groups) (set logs-groups))))))))

 (defn log-root-dir
   "Given an appender name, as configured, get the parent directory of the appender's log file.


Move code / cleanliness.

Move code / cleanliness.

--- src/rewindable/ago.cljs
+++ src/rewindable/ago.cljs
@@ -26,12 +26,6 @@

 ; --------------------------------------------------------

-(defn copy-sma-map [sma-map] ; Copy a hash-map of <buf-id => state-machine-array>.
-  (apply hash-map (mapcat (fn [[buf-id sma]] [buf-id (aclone sma)])
-                          sma-map)))
-
-; --------------------------------------------------------
-
 (defn make-ago-world []
   (let [last-id (atom 0)]
     (atom {:gen-id #(swap! last-id inc)
@@ -39,6 +33,10 @@
            :smas {}     ; Keyed by buf-id, value is state-machine array.
            :smas-new {} ; Same as :smas, but for new, not yet run goroutines.
            })))
+
+(defn copy-sma-map [sma-map] ; Copy a hash-map of <buf-id => state-machine-array>.
+  (apply hash-map (mapcat (fn [[buf-id sma]] [buf-id (aclone sma)])
+                          sma-map)))

 (defn ago-snapshot [ago-world-now]
   (-> ago-world-now


Make exploring confer a will-to-live increase

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -973,33 +973,42 @@
 ;; update visibility
 (defn update-visibility
   [state]
-  (update-in state [:world :places (-> state :world :current-place)]
-    (fn [place]
-      (let [pos (-> state :world :player :pos)
-            sight-distance 3
-            get-cell (memoize (fn [x y] (get-in place [y x])))
-            new-time (get-in state [:world :time])]
-        (vec (pmap (fn [line y]
-                     (if (< sight-distance
-                            (Math/abs (- y (pos :y))))
-                       line
-                       (vec (map (fn [cell x]
-                                   (if (and (not (nil? cell))
-                                            (not (farther-than?
-                                                   pos
-                                                   {:x x :y y}
-                                                   sight-distance))
-                                            (visible?
-                                              get-cell
-                                              cell-blocking?
-                                              (pos :x)
-                                              (pos :y)
-                                              x
-                                              y))
-                                     (assoc cell :discovered new-time)
-                                     cell))
-                                 line (range)))))
-                    place (range)))))))
+  (let [pos              (-> state :world :player :pos)
+        sight-distance   3
+        will-to-live     (get-in state [:world :player :will-to-live])
+        max-will-to-live (get-in state [:world :player :max-will-to-live])
+        place            (get-in state [:world :places (current-place-id state)])
+        get-cell         (memoize (fn [x y] (get-in place [y x])))
+        new-time         (get-in state [:world :time])
+        test-cells       (for [x (range (- (get pos :x) sight-distance) (+ (get pos :x) sight-distance))
+                               y (range (- (get pos :y) sight-distance) (+ (get pos :y) sight-distance))]
+                            [x y])
+        visible-cells    (filter (fn [[x y]] (and (not (nil? (get-cell x y)))
+                                                  (not (farther-than? {:x (- (get pos :x) 0.5) :y (- (get pos :y) 0.5)}
+                                                                      {:x x :y y}
+                                                                      sight-distance))
+                                                  (visible?
+                                                    get-cell
+                                                    cell-blocking?
+                                                    (pos :x)
+                                                    (pos :y)
+                                                    x y)))
+                                 test-cells)
+        dwtl             (/ (reduce (fn [acc [x y]] (+ acc (- (dec new-time)
+                                                           (get (get-cell x y) :discovered (- new-time 10000)))))
+                                 0 visible-cells)
+                            48000)
+        _                (info "delta will-to-live" (float dwtl))
+        will-to-live     (min (+ will-to-live dwtl)
+                              max-will-to-live)]
+  (-> state
+    (update-in [:world :places (-> state :world :current-place)]
+      (fn [place]
+              (reduce (fn [place [x y]]
+                        (update-in place [y x] (fn [cell] (assoc cell :discovered new-time))))
+                      place
+                      visible-cells)))
+    (assoc-in [:world :player :will-to-live] will-to-live))))

 (defn next-party-member
   "Switch (-> state :world :player) with the next npc where (-> npc :in-party?) is equal to true.


Make carrying more items increase hunger proportionally

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -1126,7 +1126,7 @@
   "Increase player's hunger."
   [state]
   (-> state
-    (update-in [:world :player :hunger] (partial + 0.4))
+    (update-in [:world :player :hunger] (partial + 0.1 (* 0.2 (count (player-inventory state)))))
     (update-in [:world :player :thirst] (partial + 0.3))
     ((fn [state] (update-in state
                             [:world :player :status]


Also works with additional messages

Also works with additional messages

--- src/hphelper/scengen/scenform.clj
+++ src/hphelper/scengen/scenform.clj
@@ -39,6 +39,8 @@
                                        (sl/get-char-list)))
                          [:option {:value ""} "No Char"])
                        ]
+         "Additional Messages for player:"
+         [:textarea {:rows "4" :name (str "messages_" playerId)}]
          ]
         ))

@@ -151,12 +153,13 @@

 (defn- assoc-additional-messages
   "Checks for additional messages, and if exists and long enough splits by \n"
-  [playerId {admes (keyword (str "messages_" playerId))
-             :as params}]
+  [playerId
+   {admes (keyword (str "messages_" playerId)) :as params}
+   scen]
   (if (and admes
            (> (count admes) 0))
     (do
-      (assoc-in params [:hps playerId :msgs]
+      (assoc-in scen [:hps playerId :msgs]
                  (clojure.string/split admes #"\n"))
       )
     params))
@@ -175,6 +178,7 @@
         (if player
           (assoc-additional-messages
             playerId
+            params
             (assoc-in scen [:hps playerId] player))
           scen))
       scen)))


pitch dynamic variation

pitch dynamic variation

--- src/cljs/daveconservatoire/site/ui/exercises.cljs
+++ src/cljs/daveconservatoire/site/ui/exercises.cljs
@@ -215,12 +215,12 @@

 (defmethod slug->exercise "pitch-1" [_]
   {::class PitchDetection
-   ::props {::variation 24}})
+   ::props {::variation [12 ".." 24]}})

 (defmethod slug->exercise "pitch-2" [_]
   {::class PitchDetection
-   ::props {::variation 12}})
+   ::props {::variation [8 ".." 16]}})

 (defmethod slug->exercise "pitch-3" [_]
   {::class PitchDetection
-   ::props {::variation 5}})
+   ::props {::variation [1 ".." 9]}})


Draw the shots.

Draw the shots.

--- src/cljs/wombats_web_client/components/arena.cljs
+++ src/cljs/wombats_web_client/components/arena.cljs
@@ -57,20 +57,18 @@
 (defn- draw-open
   "Draws whatever belongs on an open cell"
   [canvas-element contents meta x y width height]
-  (doseq meta
-    (fn [meta-item]
-      (js/console.log meta-item)
-      (let [{type :type} meta-item]
-        (js/console.log meta-item)
-        (case type
-          :shot
-          (draw-image canvas-element
-                      "images/fire_shot.png"
-                      x
-                      y
-                      width
-                      height)
-          nil)))))
+  (doseq [meta-item meta]
+    (let [{type :type
+           orientation :orientation} meta-item]
+      (case type
+        :shot
+        (draw-image canvas-element
+                    "images/fire_shot.png"
+                    x
+                    y
+                    width
+                    height)
+        nil))))

 (defn- draw-cell
   "Draw an arena cell on the canvas"


Remove extra braces

Remove extra braces

--- src/route_ccrs/core.clj
+++ src/route_ccrs/core.clj
@@ -4,7 +4,7 @@
             [route-ccrs.route-ccr :as ccr]))

 (defn calculate-and-record-ccrs!  [sys]
-  (let [c {:connection ( (:db sys))}]
+  (let [c {:connection (:db sys)}]
     (log/info "CCR calculation started")
     (->> (into [] ar/transduce-routes (ar/active-routes {} c))
          (map


(SERVER-1251) Update the PuppetResource test schema

The `PuppetResource` schema used in tests was out of date - this commit
updates it.

--- test/integration/puppetlabs/puppetserver/testutils.clj
+++ test/integration/puppetlabs/puppetserver/testutils.clj
@@ -16,19 +16,16 @@
   {schema/Str (schema/pred (some-fn string? #(instance? File %) #(instance? URL %)))})

 (def PuppetResource
-  "Schema for a Puppet resource. Based on
-  https://github.com/puppetlabs/puppet/blob/master/api/schemas/resource_type.json
-  which seems a little out of date and incomplete."
+  "Schema for a Puppet resource. Based on the resource within the catalog schema."
   {(schema/required-key "type") schema/Str
    (schema/required-key "title") schema/Str
-   (schema/optional-key "name") schema/Str
-   (schema/optional-key "tags") [schema/Str]
-   (schema/optional-key "exported") schema/Bool
-   (schema/optional-key "parameters") {schema/Str schema/Str}
    (schema/optional-key "line") schema/Int
    (schema/optional-key "file") schema/Str
-   (schema/optional-key "parent") schema/Str
-   (schema/optional-key "doc") schema/Str
+   (schema/required-key "exported") schema/Bool
+   (schema/optional-key "sensitive_parameters") [schema/Str]
+   (schema/required-key "tags") [schema/Str]
+   (schema/optional-key "parameters") {schema/Str schema/Str}
+   (schema/optional-key "ext_parameters") {schema/Str schema/Str}
    schema/Str schema/Str})

 (def PuppetCatalog


fix parser tests

fix parser tests

--- test/server/daveconservatoire/server/parser_tests.cljs
+++ test/server/daveconservatoire/server/parser_tests.cljs
@@ -15,11 +15,11 @@
   (async done
     (go
       (is (= (<! (p/parse {:db ts/connection} [:app/courses]))
-             {:app/courses [{:db/id 4} {:db/id 7}]}))
+             {:app/courses [{:db/id 4 :db/table :course} {:db/id 7 :db/table :course}]}))

       (is (= (<! (p/parse {:db ts/connection} [{:app/courses [:db/id :course/title]}]))
-             {:app/courses [{:db/id 4 :course/title "Reading Music"}
-                            {:db/id 7 :course/title "Music:  A Beginner's Guide"}]}))
+             {:app/courses [{:db/id 4 :course/title "Reading Music" :db/table :course}
+                            {:db/id 7 :course/title "Music:  A Beginner's Guide" :db/table :course}]}))

       (done))))

@@ -30,7 +30,7 @@
                                      :table :course
                                      :ast   (om/query->ast [:db/id :course/title])}
                                     [[:where {:url/slug "reading-music"}]]))
-             {:db/id 4, :course/title "Reading Music"}))
+             {:db/id 4 :course/title "Reading Music" :db/table :course}))

       (is (= (<! (p/query-sql-first {:db    ts/connection
                                      :table :course
@@ -38,8 +38,9 @@
                                                                   {:course/topics [:db/id :topic/title]}
                                                                   {:limit 2})])}
                                     [[:where {:db/id 4}]]))
-             {:db/id 4 :course/topics [{:db/id 18 :topic/title "Getting Started"}
-                                       {:db/id 19 :topic/title "Staff and Clefs"}]}))
+             {:db/id 4 :course/topics [{:db/id 18 :db/table :topic :topic/title "Getting Started"}
+                                       {:db/id 19 :db/table :topic :topic/title "Staff and Clefs"}]
+              :db/table :course}))
       (done))))

 (deftest parser-read-topics
@@ -47,14 +48,14 @@
     (go
       (is (= (->> (p/parse {:db ts/connection} [{:app/topics [:db/id :topic/title {:topic/course [:db/id]}]}]) <!
                   (select [:app/topics FIRST]))
-             [{:db/id 2, :topic/title "Getting Started" :topic/course {:db/id 7}}]))
+             [{:db/id 2 :db/table :topic :topic/title "Getting Started" :topic/course {:db/id 7 :db/table :course}}]))
       (done))))

 (deftest test-parse-read-lesson-by-slug
   (async done
     (go
       (is (= (->> (p/parse {:db ts/connection} [{[:lesson/by-slug "percussion"] [:db/id :lesson/title]}]) <!)
-             {[:lesson/by-slug "percussion"] {:db/id 9, :lesson/title "Percussion"}}))
+             {[:lesson/by-slug "percussion"] {:db/id 9 :db/table :lesson :lesson/title "Percussion"}}))
       (is (= (->> (p/parse {:db ts/connection} [{[:lesson/by-slug "invalid"] [:db/id :lesson/title]}]) <!)
              {[:lesson/by-slug "invalid"] [:error :row-not-found]}))
       (done))))