timers are set to count up till time set

--- src/clojure/com/example/gt/metime/main.clj
+++ src/clojure/com/example/gt/metime/main.clj
@@ -9,8 +9,9 @@
             [neko.threading :refer [on-ui]])
   (:import [android.widget CursorAdapter TextView LinearLayout]
            android.graphics.Color
+           java.text.SimpleDateFormat
            [android.os SystemClock CountDownTimer]
-           java.util.Calendar
+           [java.util Date Calendar TimeZone]
            java.util.concurrent.TimeUnit
            [android.app Activity DialogFragment]
            android.view.View
@@ -21,136 +22,169 @@
 (declare date-picker)
 (declare time-picker)

-(defn create-counter-class [text-time-view millis-in-future countdown-timer-interval]
-  (proxy [CountDownTimer] [millis-in-future countdown-timer-interval]
+(defn millis-to-format-time [millis]
+  (str (format "%02d:%02d:%02d"
+               (.toHours TimeUnit/MILLISECONDS millis)
+               (- (.toMinutes TimeUnit/MILLISECONDS millis) (.toMinutes TimeUnit/HOURS (.toHours TimeUnit/MILLISECONDS millis)))
+               (- (.toSeconds TimeUnit/MILLISECONDS millis) (.toSeconds TimeUnit/MINUTES (.toMinutes TimeUnit/MILLISECONDS millis))))))

-    (onTick [millis-until-finished]
-      (let [millis-complete (- millis-in-future millis-until-finished)]
-        (on-ui
-          (config
-            text-time-view
-            :text
-            (str "spent: " (format "%02d:%02d:%02d"
-                                   (.toHours TimeUnit/MILLISECONDS millis-complete)
-                                   (- (.toMinutes TimeUnit/MILLISECONDS millis-complete) (.toMinutes TimeUnit/HOURS (.toHours TimeUnit/MILLISECONDS millis-complete)))
-                                   (- (.toSeconds TimeUnit/MILLISECONDS millis-complete) (.toSeconds TimeUnit/MINUTES (.toMinutes TimeUnit/MILLISECONDS millis-complete)))))))))
-    (onFinish []
-      (on-ui (config text-time-view :text "Completed.")))))
+(defn priv-count-up-timer
+  [text-time-view end-time countdown-timer-interval finish-fn start-time]
+  (let [duration (- end-time start-time)]
+    (proxy [CountDownTimer] [duration countdown-timer-interval]
+      (onTick [millis-until-finished]
+        (let [millis-complete (+ start-time (- duration millis-until-finished))]
+          (on-ui
+            (config
+              text-time-view
+              :text
+              (millis-to-format-time millis-complete)))))
+      (onFinish [] (finish-fn)))))

-(defn show-picker [activity picker picker-type]
-  (. picker show (. activity getFragmentManager) picker-type))
+  (defn create-count-up-timer-class
+    ([text-time-view millis-in-future countdown-timer-interval finish-fn] (priv-count-up-timer text-time-view millis-in-future countdown-timer-interval finish-fn 0))
+    ([text-time-view millis-in-future countdown-timer-interval finish-fn start-time] (priv-count-up-timer text-time-view millis-in-future countdown-timer-interval finish-fn start-time)))

-(def listing (atom (sorted-map)))
+  (defn show-picker [activity picker picker-type]
+    (. picker show (. activity getFragmentManager) picker-type))

-(defrecord Task [date name duration date-index])
+  (def listing (atom (sorted-map)))

-(defn add-to-listing [event-name date-key time-key]
-  (swap! listing update-in [date-key] (fnil conj []) [event-name time-key]))
+  (defrecord Task [date name duration date-index])

-(defn sorted-map-array-to-array-task [lst]
-  (mapcat
-    identity
-    (map
-      (fn [sorted-map-data]
-        (into [] (map-indexed (fn [i ele] (apply ->Task (concat [(first sorted-map-data)] ele [i]))) (second sorted-map-data))))
-      lst)))
+  (defn add-to-listing [event-name date-key time-key]
+    (swap! listing update-in [date-key] (fnil conj []) [event-name time-key]))

-(defn make-date-adapter []
-  (adapters/ref-adapter
-    (fn [_]
-      [:linear-layout {:id-holder   true
-                       :orientation :vertical}
-       [:text-view {:id ::date-tv}]
-       [:linear-layout {:id          ::event-ll
-                        :id-holder   true
-                        :orientation :horizontal}
-        [:text-view {:id ::event-tv}]
-        [:text-view {:id ::goal-tv}]
-        [:text-view {:id ::time-tv}]
-        [:button {:id   ::event-btn
-                  :text "start"}]]])
-    (fn [_ view _ task]
-      (let [date-text-view (find-view view ::date-tv)
-            event-linear-layout-view (find-view view ::event-ll)
-            event-text-view (find-view event-linear-layout-view ::event-tv)
-            event-timer-view (find-view event-linear-layout-view ::time-tv)
-            event-button-view (find-view event-linear-layout-view ::event-btn)
-            timer (create-counter-class event-timer-view (* (:duration task) 60000) 1000)]
+  (defn sorted-map-array-to-array-task [lst]
+    (mapcat
+      identity
+      (map
+        (fn [sorted-map-data]
+          (into [] (map-indexed (fn [i ele] (apply ->Task (concat [(first sorted-map-data)] ele [i]))) (second sorted-map-data))))
+        lst)))

-        ;mutates the viz
-        (config date-text-view :visibility (if (= (:date-index task) 0) View/VISIBLE View/GONE))
-        (config date-text-view :text (str (:date task)))
+  (declare start-timer)
+  (declare stop-timer)

-        (config event-button-view :on-click (fn [_] (.start timer)))
-        (config event-text-view :text (str (:name task) " goal: " (:duration task) " "))))
-    listing
-    sorted-map-array-to-array-task))
+  (def simple-date-format (doto (SimpleDateFormat. "HH:mm:ss")
+                            (.setTimeZone (TimeZone/getTimeZone "GMT"))))

-(defn main-layout [activity]
-  [:linear-layout {:orientation :vertical}
-   [:edit-text {
-                :hint "Event name",
-                :id   ::name}]
-   [:linear-layout {:orientation :horizontal}
-    [:text-view {:hint "Goal (Time)",
-                 :id   ::time}]
-    [:button {:text     "...",
-              :on-click (fn [_] (show-picker activity
-                                             (time-picker activity), "timePicker"))}]]
-   [:linear-layout {:orientation :horizontal}
-    [:text-view {:hint "Event date",
-                 :id   ::date}]
-    [:button {:text     "...",
-              :on-click (fn [_] (show-picker activity
-                                             (date-picker activity) "datePicker"))}]]
-   [:button {:text     "+ Event",
-             :on-click (fn [_] (add-event activity))}]
-   [:list-view {:id                   ::days
-                :draw-selector-on-top true
-                :adapter              (make-date-adapter)}]])
+  (defn format-time-to-millis [event-timer-view] (.getTime (.parse simple-date-format (.getText ^TextView event-timer-view))))

-(defn get-elmt [activity elmt]
-  (str (.getText ^TextView (find-view activity elmt))))
+  (defn stop-timer [timer duration event-timer-view event-button-view]
+    (config event-button-view :text "Stop")
+    (config event-button-view :on-click (fn [_]
+                                          (.cancel ^CountDownTimer timer)
+                                          (start-timer duration event-timer-view event-button-view (format-time-to-millis event-timer-view)))))

-(defn set-elmt-text [activity elmt s]
-  (on-ui (config (find-view activity elmt) :text s)))
+  (defn start-timer [duration event-timer-view event-button-view start-time]
+    (let [timer (create-count-up-timer-class
+                  event-timer-view
+                  (* duration 60000)
+                  1000
+                  (fn []
+                    (on-ui (config event-timer-view :text "Completed."))
+                    (start-timer duration event-timer-view event-button-view 0))
+                  start-time)]
+      (config event-button-view :text "Start")
+      (config event-button-view :on-click (fn [_] (.start ^CountDownTimer timer)
+                                            (stop-timer timer duration event-timer-view event-button-view)))))

-(defn update-ui [activity]
-  (set-elmt-text activity ::name ""))
+  (defn make-date-adapter []
+    (adapters/ref-adapter
+      (fn [_]
+        [:linear-layout {:id-holder   true
+                         :orientation :vertical}
+         [:text-view {:id ::date-tv}]
+         [:linear-layout {:id          ::event-ll
+                          :id-holder   true
+                          :orientation :horizontal}
+          [:text-view {:id ::event-tv}]
+          [:text-view {:id ::goal-tv}]
+          [:text-view {:id ::time-tv}]
+          [:button {:id ::event-btn}]]])
+      (fn [_ view _ task]
+        (let [date-text-view (find-view view ::date-tv)
+              event-linear-layout-view (find-view view ::event-ll)
+              event-text-view (find-view event-linear-layout-view ::event-tv)
+              event-timer-view (find-view event-linear-layout-view ::time-tv)
+              event-button-view (find-view event-linear-layout-view ::event-btn)]

-(defn add-event [activity]
-  (let [date-key (try
-                   (read-string (get-elmt activity ::date))
-                   (catch RuntimeException e "Date string is empty!"))
-        time-key (try
-                   (read-string (get-elmt activity ::time))
-                   (catch RuntimeException e "Time string is empty!"))]
-    (when (number? date-key)
-      (add-to-listing (get-elmt activity ::name) date-key time-key)
-      (update-ui activity))))
+          ;mutates the viz
+          (config date-text-view :visibility (if (= (:date-index task) 0) View/VISIBLE View/GONE))
+          (config date-text-view :text (str (:date task)))

-(defn date-picker [activity]
-  (proxy [DialogFragment DatePickerDialog$OnDateSetListener] []
-    (onCreateDialog [_]
-      (let [c (Calendar/getInstance)
-            year (.get c Calendar/YEAR)
-            month (.get c Calendar/MONTH)
-            day (.get c Calendar/DAY_OF_MONTH)]
-        (DatePickerDialog. activity this year month day)))
-    (onDateSet [_ year month day]
-      (set-elmt-text activity ::date
-                     (format "%d%02d%02d" year (inc month) day)))))
+          (start-timer (:duration task) event-timer-view event-button-view 0)

-(defn time-picker [activity]
-  (proxy [DialogFragment TimePickerDialog$OnTimeSetListener] []
-    (onCreateDialog [_]
-      (TimePickerDialog. activity this 0 0 true))
-    (onTimeSet [_ hourOfDay minute]
-      (set-elmt-text activity ::time
-                     (format "%d" (+ (* hourOfDay 60) minute))))))
+          (config event-text-view :text (str (:name task) " (Goal: " ( millis-to-format-time (* 1000 60 (:duration task))) ") "))))
+      listing
+      sorted-map-array-to-array-task))

-(defactivity com.example.gt.metime.MainActivity
-             :key :main
-             (onCreate [this bundle]
-                       (.superOnCreate this bundle)
-                       (on-ui (set-content-view! (*a) (main-layout (*a))))))+  (defn main-layout [activity]
+    [:linear-layout {:orientation :vertical}
+     [:edit-text {
+                  :hint "Event name",
+                  :id   ::name}]
+     [:linear-layout {:orientation :horizontal}
+      [:text-view {:hint "Goal (Time)",
+                   :id   ::time}]
+      [:button {:text     "...",
+                :on-click (fn [_] (show-picker activity
+                                               (time-picker activity), "timePicker"))}]]
+     [:linear-layout {:orientation :horizontal}
+      [:text-view {:hint "Event date",
+                   :id   ::date}]
+      [:button {:text     "...",
+                :on-click (fn [_] (show-picker activity
+                                               (date-picker activity) "datePicker"))}]]
+     [:button {:text     "+ Event",
+               :on-click (fn [_] (add-event activity))}]
+     [:list-view {:id                   ::days
+                  :draw-selector-on-top true
+                  :adapter              (make-date-adapter)}]])
+
+  (defn get-elmt [activity elmt]
+    (str (.getText ^TextView (find-view activity elmt))))
+
+  (defn set-elmt-text [activity elmt s]
+    (on-ui (config (find-view activity elmt) :text s)))
+
+  (defn update-ui [activity]
+    (set-elmt-text activity ::name ""))
+
+  (defn add-event [activity]
+    (let [date-key (try
+                     (read-string (get-elmt activity ::date))
+                     (catch RuntimeException e "Date string is empty!"))
+          time-key (try
+                     (read-string (get-elmt activity ::time))
+                     (catch RuntimeException e "Time string is empty!"))]
+      (when (number? date-key)
+        (add-to-listing (get-elmt activity ::name) date-key time-key)
+        (update-ui activity))))
+
+  (defn date-picker [activity]
+    (proxy [DialogFragment DatePickerDialog$OnDateSetListener] []
+      (onCreateDialog [_]
+        (let [c (Calendar/getInstance)
+              year (.get c Calendar/YEAR)
+              month (.get c Calendar/MONTH)
+              day (.get c Calendar/DAY_OF_MONTH)]
+          (DatePickerDialog. activity this year month day)))
+      (onDateSet [_ year month day]
+        (set-elmt-text activity ::date
+                       (format "%d%02d%02d" year (inc month) day)))))
+
+  (defn time-picker [activity]
+    (proxy [DialogFragment TimePickerDialog$OnTimeSetListener] []
+      (onCreateDialog [_]
+        (TimePickerDialog. activity this 0 0 true))
+      (onTimeSet [_ hourOfDay minute]
+        (set-elmt-text activity ::time
+                       (format "%d" (+ (* hourOfDay 60) minute))))))
+
+  (defactivity com.example.gt.metime.MainActivity
+               :key :main
+               (onCreate [this bundle]
+                         (.superOnCreate this bundle)
+                         (on-ui (set-content-view! (*a) (main-layout (*a))))))


Read volume information from an ABACUS creation request

--- src/mdr2/abacus.clj
+++ src/mdr2/abacus.clj
@@ -42,7 +42,7 @@
    :language [:MetaData :dc :language text]
    :source_publisher [:MetaData :ncc :sourcePublisher text]
    :source_edition [:MetaData :ncc :sourceDate text]
-   ;;   :volumes [:MetaData :ncc :setInfo text] ; not sure if this is reliable
+   :volumes [:MetaData :ncc :setInfo text]
    :revision_date [:MetaData :ncc :revisionDate text]
    })


Add docstring.

Add docstring.

--- src/mount/core.cljc
+++ src/mount/core.cljc
@@ -160,7 +160,11 @@
       (up s-name with-inst (atom #{})))))

 #?(:clj
-    (defmacro defstate [state & body]
+    (defmacro defstate
+      "Defines a state. Restarts on recompilation.
+       Pass ^{:on-reload :noop} to prevent auto-restart
+       on ns recompilation, or :stop to stop on recompilation."
+      [state & body]
       (let [[state params] (macro/name-with-attributes state body)
             {:keys [start stop] :as lifecycle} (apply hash-map params)
             state-name (with-ns *ns* state)


admin function for populating first newsletter

--- src/pc/admin/db.clj
+++ src/pc/admin/db.clj
@@ -3,6 +3,7 @@
             [clj-time.core :as time]
             [clj-time.coerce :refer [to-date]]
             [pc.auth]
+            [pc.mixpanel :as mixpanel]
             [pc.datomic :as pcd]
             [pc.models.doc :as doc-model]
             [pc.models.layer :as layer-model]
@@ -54,3 +55,15 @@
                                           :document/id (:db/id new-doc)))
                                 layers))
     new-doc))
+
+(defn populate-first-newsletter [emails]
+  (let [db (pcd/default-db)]
+    (doseq [[eid] (d/q '{:find [?t]
+                         :in [$ ?emails]
+                         :where [[?t :cust/email ?e]
+                                 [(contains? ?emails ?e)]]}
+                       db
+                       (set emails))
+            :let [cust (d/entity db eid)]]
+      (println "populating" (:cust/email cust))
+      (mixpanel/engage (:cust/uuid cust) {:$set {:sent-first-newsletter true}}))))


Auto-focus login fields and proceed on enter

--- src/braid/client/mobile/views.cljs
+++ src/braid/client/mobile/views.cljs
@@ -91,35 +91,43 @@
          :login
          (case @stage
            :email
-           [:div.content.login.email
-            "Email"
-            [:input.email {:placeholder "you@awesome.com"
-                           :type "email"
-                           :key "email"
-                           :on-change (fn [e]
-                                        (reset! email (.. e -target -value)))}]
-            [:button.next {:on-click (fn [e]
-                                       (reset! stage :password))}]]
+           [:form.content.login.email
+            {:on-submit (fn [e]
+                          (.preventDefault e)
+                          (reset! stage :password))}
+            [:label.email "Email"
+             [:input.email {:placeholder "you@awesome.com"
+                            :type "email"
+                            :key "email"
+                            :auto-focus true
+                            :on-change (fn [e]
+                                         (reset! email (.. e -target -value)))}]]
+            [:button.next {:type "submit"}]]

            :password
-           [:div.content.login.password
-            "Password"
-            [:input.password {:placeholder "••••••"
-                              :type "password"
-                              :key "password"
-                              :on-change (fn [e]
-                                           (reset! password (.. e -target -value)))}]
-            [:button.next {:on-click (fn [e]
-                                       (dispatch [:auth
-                                                  {:email @email
-                                                   :password @password
-                                                   :on-complete (fn [])
-                                                   :on-error (fn [])}]))}]])
+           [:form.content.login.password
+            {:on-submit (fn [e]
+                          (.preventDefault e)
+                          (dispatch [:auth
+                                     {:email @email
+                                      :password @password
+                                      :on-complete (fn [])
+                                      :on-error (fn [])}]))}
+            [:label.password
+             "Password"
+             [:input.password {:placeholder "••••••"
+                               :type "password"
+                               :key "password"
+                               :auto-focus true
+                               :on-change (fn [e]
+                                            (reset! password (.. e -target -value)))}]]
+            [:button.next {:type "submit"}]])

          :register
          (if-not @email
            [:div.content.register.email
-            [:input.email {:placeholder "you@awesome.com"}]
+            [:input.email {:placeholder "you@awesome.com"
+                           :auto-focus true}]
             [:button.next {:on-click (fn [e]
                                        (reset! email (.. e -target -value))
                                        ; TODO


control-x to close threads

control-x to close threads

--- src/chat/client/views/threads.cljs
+++ src/chat/client/views/threads.cljs
@@ -76,6 +76,12 @@
                                         " " (when private? "private")
                                         " " (when limbo? "limbo")
                                         " " (when dragging? "dragging"))
+                        :onKeyUp (fn [e]
+                                   (when (and (= KeyCodes.X (.-keyCode e))
+                                           (.-ctrlKey e))
+                                     (.preventDefault e)
+                                     (.stopPropagation e)
+                                     (dispatch! :hide-thread {:thread-id (thread :id)})))
                         :onPaste (fn [e]
                                    (let [pasted-files (.. e -clipboardData -files)]
                                      (when (< 0 (.-length pasted-files))


Add padding and margin to rating form per feedback

--- src/clj/chili_dog_night/styles.clj
+++ src/clj/chili_dog_night/styles.clj
@@ -64,9 +64,18 @@
    {:margin-top "2em"
     :text-align "center"}])

+(defstyles forms
+  [:form
+   [:div
+    {:padding-top ".25em"
+     :padding-bottom ".25em"}]
+   [:button
+    {:margin-top "2.5em"}]])
+
 (defstyles screen
   normalize
   layout
   typography
   header
-  footer)
+  footer
+  forms)


Remove .shadow-cljs cache from :clean-targets in todomvc example

Co-Authored-By: Thomas Heller <8aa6dfc21167f676c4daceadf90decc7d87844fc@gmail.com>

--- examples/todomvc/project.clj
+++ examples/todomvc/project.clj
@@ -13,7 +13,6 @@
   :plugins [[lein-shadow "0.1.5"]]

   :clean-targets ^{:protect false} [:target-path
-                                    ".shadow-cljs"
                                     "shadow-cljs.edn"
                                     "package.json"
                                     "package-lock.json"


pass original-transaction-date through

pass original-transaction-date through

--- src/clj_money/web/transactions.clj
+++ src/clj_money/web/transactions.clj
@@ -258,6 +258,7 @@
                        (-> params
                            (select-keys [:id
                                          :transaction-date
+                                         :original-transaction-date
                                          :description
                                          :memo])
                            (assoc :items (extract-items params))))


tweaks to `lumo.closure`

tweaks to `lumo.closure`

--- src/cljs/bundled/lumo/closure.cljs
+++ src/cljs/bundled/lumo/closure.cljs
@@ -2,6 +2,7 @@
   (:refer-clojure :exclude [compile])
   (:require-macros [cljs.env.macros :as env])
   (:require [lumo.util :as util :refer [distinct-by file-seq]]
+            [goog.math :as math]
             [goog.object :as gobj]
             [cljs.core :as cljsm]
             [cljs.compiler :as comp]
@@ -19,7 +20,6 @@
             [clojure.string :as string]
             [cljs.tools.reader :as reader]
             [cljs.tools.reader.reader-types :as readers]
-            [goog.math :as math]
             child_process
             fs
             path)
@@ -719,8 +719,10 @@
       (if (seq required-files)
         (let [next-file (first required-files)
               ns-info (lana/parse-ns (:uri next-file))
-              new-req (remove #(contains? visited %) (cljs-deps (cond-> (deps/-requires ns-info)
-                                                                  (= 'cljs.js (:ns ns-info)) (conj "cljs.core$macros"))))]
+              new-req (remove #(contains? visited %)
+                        (cljs-deps (cond-> (deps/-requires ns-info)
+                                     (= 'cljs.js (:ns ns-info))
+                                     (conj "cljs.core$macros"))))]
           (recur (into (rest required-files) new-req)
                  (into visited new-req)
                  (conj cljs-namespaces ns-info)))
@@ -1962,8 +1964,6 @@
                   [lib]))))]
     (into [] (mapcat expand-lib* libs))))

-(declare index-node-modules)
-
 (defn compute-upstream-npm-deps
   ([]
    (compute-upstream-npm-deps
@@ -2193,6 +2193,7 @@
     (keyword? preprocess)
     (js-transforms js-module opts)

+    ;; TODO: support preprocess symbols
     ;; (symbol? preprocess)
     ;; (let [preprocess-var (sym->var preprocess :preprocess {:file (:file js-module)})]
     ;;   (try
@@ -2277,50 +2278,6 @@
             opts js-modules)))
       opts)))

-;; (defn- load-data-reader-file [mappings ^java.net.URL url]
-;;   (with-open [rdr (readers/input-stream-push-back-reader (.openStream url))]
-;;     (binding [*file* (.getFile url)]
-;;       (let [new-mappings (reader/read {:eof nil :read-cond :allow} rdr)]
-;;         (when (not (map? new-mappings))
-;;           (throw (ex-info (str "Not a valid data-reader map")
-;;                    {:url url})))
-;;         (reduce
-;;           (fn [m [k v]]
-;;             (when (not (symbol? k))
-;;               (throw (ex-info (str "Invalid form in data-reader file")
-;;                        {:url url
-;;                         :form k})))
-;;             (when (and (contains? mappings k)
-;;                     (not= (mappings k) v))
-;;               (throw (ex-info "Conflicting data-reader mapping"
-;;                        {:url url
-;;                         :conflict k
-;;                         :mappings m})))
-;;             (assoc m k v))
-;;           mappings
-;;           new-mappings)))))
-
-;; (defn get-data-readers*
-;;   "returns a merged map containing all data readers defined by libraries
-;;    on the classpath."
-;;   ([]
-;;    (get-data-readers* (. (Thread/currentThread) (getContextClassLoader))))
-;;   ([classloader]
-;;    (let [data-reader-urls (enumeration-seq (. classloader (getResources "data_readers.cljc")))]
-;;      (reduce load-data-reader-file {} data-reader-urls))))
-
-;; (def get-data-readers (memoize get-data-readers*))
-
-;; (defn load-data-readers! [compiler]
-;;   (let [data-readers (get-data-readers)
-;;         nses (map (comp symbol namespace) (vals data-readers))]
-;;     (swap! compiler update-in [:cljs.analyzer/data-readers] merge (get-data-readers))
-;;     (doseq [ns nses]
-;;       (try
-;;         (locking ana/load-mutex
-;;           (require ns))
-;;         (catch Throwable _)))))
-
 (defn add-externs-sources [opts]
   (cond-> opts
     (:infer-externs opts)
@@ -2333,9 +2290,8 @@
   - process the JS modules (preprocess + convert to Closure JS)
   - save js-dependency-index for compilation"
   [{:keys [npm-deps target] :as opts} js-sources compiler-env]
-  ;; Find all the top-level Node packages and their files
   (let [requires (set (mapcat deps/-requires js-sources))
-        ;; Select Node files that are required by Cljs code,
+        ;; Select Node files that are required by CLJS code,
         ;; and create list of all their dependencies
         node-required (into []
                         (filter ana/node-module-dep?)
@@ -2418,8 +2374,7 @@
           (add-externs-sources (dissoc opts :foreign-libs))))))
   ([source opts compiler-env]
    (env/with-compiler-env compiler-env
-     ;; we need to preserve the runtime loaded namespace and we restore them
-     ;; in case of error, I think.
+     ;; preserve the REPL loaded namespaces and we restore them in case of errors
      (let [runtime-loaded @cljs/*loaded*
            orig-opts opts
            opts (add-implicit-options opts)
@@ -2515,8 +2470,7 @@
                                 add-goog-base
                                 (cond-> (= :nodejs (:target opts)) (concat [(-compile (io/resource "cljs/nodejscli.cljs") opts)]))
                                 (->> (map #(source-on-disk opts %)) doall)
-                                #_(compile-loader opts)
-                                )
+                                #_(compile-loader opts))
                  _ (when (:emit-constants opts)
                      (lcomp/emit-constants-table-to-file
                       (::ana/constant-table @env/*compiler*)
@@ -2564,24 +2518,7 @@
          (finally
            (reset! cljs/*loaded* runtime-loaded)))))))

-(comment
-  ;; testing modules
-  (build "samples/hello/src"
-    {:optimizations :advanced
-     :output-dir "samples/hello/out"
-     :source-map true
-     :modules
-     {:hello
-      {:output-to "samples/hello/out/hello.js"
-       :entries '#{cljs.reader hello.core}}}})
-
-  (require '[cljs.externs :as externs])
-
-  (externs/parse-externs
-    (js-source-file "cljs/externs.js" (io/file "src/main/cljs/cljs/externs.js")))
-  )
-
-(defn ^File target-file-for-cljs-ns
+(defn target-file-for-cljs-ns
   [ns-sym output-dir]
   (util/to-target-file
     (util/output-directory {:output-dir output-dir})
@@ -2689,19 +2626,6 @@
        (doseq [path paths]
          (watch-all path))))))

-(comment
-  (watch "samples/hello/src"
-    {:optimizations :none
-     :output-to "samples/hello/out/hello.js"
-     :output-dir "samples/hello/out"
-     :cache-analysis true
-     :source-map true
-     :verbose true
-     :watch-fn
-     (fn []
-       (println "Success!"))})
-  )
-
 ;; =============================================================================
 ;; Utilities

@@ -2760,33 +2684,3 @@
          :output-dir (str "src" File/separator "main" File/separator "cljs")})
       (ana/write-analysis-cache 'cljs.core cache src)
       (ana/write-analysis-cache 'cljs.core tcache src))))
-
-(comment
-  (time
-    (do (aot-cache-core) nil))
-
-  (time
-    (do (ana/analyze-file "cljs/core.cljs") nil))
-
-  (println (build '[(ns hello.core)
-                    (defn ^{:export greet} greet [n] (str "Hola " n))
-                    (defn ^:export sum [xs] 42)]
-                  {:optimizations :simple :pretty-print true}))
-
-  ;; build a project with optimizations
-  (build "samples/hello/src" {:optimizations :advanced})
-  (build "samples/hello/src" {:optimizations :advanced :output-to "samples/hello/hello.js"})
-  ;; open 'samples/hello/hello.html' to see the result in action
-
-  ;; build a project without optimizations
-  (build "samples/hello/src" {:output-dir "samples/hello/out" :output-to "samples/hello/hello.js"})
-  ;; open 'samples/hello/hello-dev.html' to see the result in action
-  ;; notice how each script was loaded individually
-
-  ;; build unoptimized from raw ClojureScript
-  (build '[(ns hello.core)
-           (defn ^{:export greet} greet [n] (str "Hola " n))
-           (defn ^:export sum [xs] 42)]
-         {:output-dir "samples/hello/out" :output-to "samples/hello/hello.js"})
-  ;; open 'samples/hello/hello-dev.html' to see the result in action
-  )


Corrected grevious syntax errors

Corrected grevious syntax errors

--- src/clojure/jdecisiontree/core.clj
+++ src/clojure/jdecisiontree/core.clj
@@ -1,6 +1,6 @@
 (ns jdecisiontree.core
   (:require [clojure.walk :refer [stringify-keys]])
-  (:import [jdecisiontree DecisionTree SingleChoiceTask MultiChoiceTask]))
+  (:import [jdecisiontree DecisionTree ITask SingleChoiceTask MultiChoiceTask]))

 (defn tree
   [name first-question & questions]
@@ -11,15 +11,16 @@

 (defn- build-question
   [^ITask task label text opts & choices]
-  (doto (task)
+  (doto task
     (.withKey label)
     (.withQuestion text)
     (.withNext (:next opts))
-    (when-let [rlabel {:readable-label opts}]
-      (.withReadableKey opts))
-    (.withChoices choices)))
+    (.withChoices choices))
+  (when (:readable-label opts)
+    (.withReadableKey task (:readable-label opts)))
+  task)

-(defmulti question* [type & args] (fn [type & args] type))
+(defmulti question (fn [type & args] type))

 (defmethod question :single
   [type & args]
@@ -27,7 +28,7 @@

 (defmethod question :multi
   [type & args]
-  (build-quesiton (MultiChoiceTask.) args))
+  (apply build-question (MultiChoiceTask.) args))

 (defn choice
   [value label & opts]


fix address resolution error when using --latency

--- src/clojure/redis_protocol/cli.clj
+++ src/clojure/redis_protocol/cli.clj
@@ -7,7 +7,7 @@
             [clojure.tools.trace :as t]
             [redis-protocol.util :as util])
   (:import (java.util.concurrent TimeUnit)
-           (java.net InetAddress)))
+           (java.net InetAddress InetSocketAddress)))

 (timbre/refer-timbre)
@@ -53,7 +53,7 @@
   (flush))

 (defn latency [{:keys [interval host port] :as options :or {interval 1.0}}]
-  (with-open [conn (redis/connect host port)]
+  (with-open [conn (redis/connect (.getHostAddress host) port)]
     (loop [history-start (System/nanoTime)
            start         history-start
            stats         initial-latency-stats]


Refactor test grouping. I think I have finnaly understood clojure.test's deftest

--- test/buildviz/testsuites_test.clj
+++ test/buildviz/testsuites_test.clj
@@ -29,7 +29,7 @@
   (fn [build-id]
     (get tests build-id)))

-(deftest TestSuiteAccumulation
+(deftest test-accumulate-testsuite-failures
   (testing "accumulate-testsuite-failures"
     (is (= []
            (accumulate-testsuite-failures [])))
@@ -73,8 +73,8 @@
            (accumulate-testsuite-failures [[(a-testsuite "suite"
                                                          (a-testsuite "nested suite" (a-testcase "a case" :fail)))]
                                            [(a-testsuite "suite"
-                                                         (a-testsuite "nested suite" (a-testcase "another case" :fail)))]]))))
-
+                                                         (a-testsuite "nested suite" (a-testcase "another case" :fail)))]])))))
+(deftest test-accumulate-testsuite-failures-as-list
   (testing "accumulate-testsuite-failures-as-list"
     (is (= []
            (accumulate-testsuite-failures-as-list [])))
@@ -134,8 +134,9 @@
            (accumulate-testsuite-failures-as-list [[(a-testsuite "suite"
                                                                  (a-testsuite "nested suite" (a-testcase "a class" "a case" :fail)))]
                                                    [(a-testsuite "suite"
-                                                                 (a-testsuite "nested suite" (a-testcase "a class" "another case" :fail)))]]))))
-
+                                                                 (a-testsuite "nested suite" (a-testcase "a class" "another case" :fail)))]])))))
+
+(deftest test-average-testcase-runtime
   (testing "average-testcase-runtime"
     (is (= []
            (average-testcase-runtime [])))
@@ -171,8 +172,9 @@
            (average-testcase-runtime [[(a-testsuite "suite"
                                                     (a-testsuite "nested suite" (a-testcase-with-runtime "a case" 10)))]
                                       [(a-testsuite "suite"
-                                                    (a-testsuite "nested suite" (a-testcase-with-runtime "another case" 20)))]]))))
-
+                                                    (a-testsuite "nested suite" (a-testcase-with-runtime "another case" 20)))]])))))
+
+(deftest test-average-testcase-runtime-as-list
   (testing "average-testcase-runtime-as-list"
     (is (= []
            (average-testcase-runtime-as-list [])))
@@ -190,8 +192,9 @@
            (average-testcase-runtime-as-list [[(a-testsuite "suite"
                                                             (a-testsuite "nested suite" (a-testcase-with-runtime "a class" "a case" 10)))]
                                               [(a-testsuite "suite"
-                                                            (a-testsuite "nested suite" (a-testcase-with-runtime "another class" "another case" 20)))]]))))
-
+                                                            (a-testsuite "nested suite" (a-testcase-with-runtime "another class" "another case" 20)))]])))))
+
+(deftest test-average-testclass-runtime
   (testing "average-testclass-runtime"
     (is (= []
            (average-testclass-runtime [])))
@@ -225,9 +228,17 @@
                          :children [{:name "class"
                                      :averageRuntime 10}]}]}]
            (average-testclass-runtime [[(a-testsuite "suite"
-                                                    (a-testsuite "nested suite"
-                                                                 (a-testcase-with-runtime "class" "a case" 10)))]]))))
-
+                                                     (a-testsuite "nested suite"
+                                                                  (a-testcase-with-runtime "class" "a case" 10)))]]))))
+
+  (testing "should properly accumulate runtime with multiple same suite and class entries"
+    (is (= [{:name "suite"
+             :children [{:name "a class"
+                         :averageRuntime 60}]}]
+           (average-testclass-runtime [[(a-testsuite "suite" (a-testcase-with-runtime "a class" "a case" 20))
+                                        (a-testsuite "suite" (a-testcase-with-runtime "a class" "another case" 40))]])))))
+
+(deftest test-average-testclass-runtime-as-list
   (testing "average-testclass-runtime-as-list"
     (is (= []
            (average-testclass-runtime-as-list [])))
@@ -251,14 +262,9 @@
     (is (= [{:testsuite ["suite" "nested suite"] :classname "class" :averageRuntime 10}]
            (average-testclass-runtime-as-list [[(a-testsuite "suite"
                                                              (a-testsuite "nested suite"
-                                                                          (a-testcase-with-runtime "class" "a case" 10)))]]))))
-  (testing "should properly accumulate runtime with multiple same suite and class entries"
-    (is (= [{:name "suite"
-             :children [{:name "a class"
-                         :averageRuntime 60}]}]
-           (average-testclass-runtime [[(a-testsuite "suite" (a-testcase-with-runtime "a class" "a case" 20))
-                                        (a-testsuite "suite" (a-testcase-with-runtime "a class" "another case" 40))]]))))
-
+                                                                          (a-testcase-with-runtime "class" "a case" 10)))]])))))
+
+(deftest test-flaky-testcases-as-list
   (testing "flaky-testcases-as-list"
     (is (= []
            (flaky-testcases-as-list {}
@@ -334,13 +340,13 @@
              :build-id "another-failed-run-id"
              :latest-failure (:start another-failed-build-input-1)
              :flaky-count 1}]
-        (flaky-testcases-as-list {"passed-run-id" passed-build-input-1
-                                  "failed-run-id" failed-build-input-1
-                                  "another-failed-run-id" another-failed-build-input-1}
-                                 (dummy-test-lookup {"failed-run-id" [(a-testsuite "a suite"
-                                                                                (a-testcase "a class" "the testcase" :fail))]
-                                                     "another-failed-run-id" [(a-testsuite "another suite"
-                                                                                (a-testcase "another class" "another testcase" :fail))]}))))
+           (flaky-testcases-as-list {"passed-run-id" passed-build-input-1
+                                     "failed-run-id" failed-build-input-1
+                                     "another-failed-run-id" another-failed-build-input-1}
+                                    (dummy-test-lookup {"failed-run-id" [(a-testsuite "a suite"
+                                                                                (a-testcase "a class" "the testcase" :fail))]
+                                                        "another-failed-run-id" [(a-testsuite "another suite"
+                                                                                (a-testcase "another class" "another testcase" :fail))]}))))
     (is (= [{:testsuite ["a suite"]
              :classname "a class"
              :name "the testcase"


DM + RS #17 - future fact failing test

DM + RS #17 - future fact failing test

--- test/objective8/http_api_test.clj
+++ test/objective8/http_api_test.clj
@@ -163,7 +163,7 @@
                               :invitatiion-id INVITATION_ID
                               :invitee-id 10})

-(fact "posting an invitation hits the correct API endpoint"
+(future-fact "posting an invitation hits the correct API endpoint"
       (http-api/accept-invitation the-invitation-response) => :api-call-result
       (provided
         (http-api/default-create-call (contains (str host-url "/api/v1/objectives/"


removed dead code

removed dead code

--- src/selmer/tags.clj
+++ src/selmer/tags.clj
@@ -205,9 +205,6 @@
   (for [[id value] (partition 2 args)]
     [(keyword id) (compile-filter-body value false)]))

-(defn parse-with [^String arg]
-  (let [[id value] (.split arg "=")]
-    [(keyword id) (compile-filter-body value false)]))
 (defn with-handler [args tag-content render rdr]
   (let [content (get-in (tag-content rdr :with :endwith) [:with :content])
         args (->> args
@@ -220,6 +217,7 @@
                 (fn [context-map [k v]]
                   (assoc context-map k (v context-map)))
                 context-map args)))))
+

 (defn script-handler [[^String uri] _ _ _]
   (fn [{:keys [servlet-context]}]


a dog's owner must be a human

a dog's owner must be a human

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -504,7 +504,8 @@
                         :sem {:pred :scaricare}}}
    "dog" {:synsem {:cat :noun
                    :sem {:pred :cane
-                         :pet true}}}
+                         :pet true
+                         :spec {:of {:human true}}}}}

    "earn"  {:synsem {:cat :verb
                      :sem {:pred :earn


alphabetize "short"

alphabetize "short"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1654,7 +1654,22 @@

    "shoe" {:synsem {:cat :noun
                     :sem {:pred :shoe}}}
-
+   "short"
+   [(unify adjective
+           {:synsem {:cat :adjective
+                     :sem {:mod {:pred :short}
+                           :comparative false
+                           :physical-object true}
+                     :subcat {:1 {:cat :det}
+                              :2 '()}}})
+    (unify adjective
+           {:synsem {:cat :adjective
+                     :sem {:mod {:pred :short}
+                           :comparative false
+                           :event true}
+                     :subcat {:1 {:cat :det}
+                              :2 '()}}})]
+
    "show" {:synsem {:cat :verb
                     :sem {:pred :show
                           :past-participle "shown"}}}
@@ -1782,22 +1797,7 @@
                           :comparative false}
                     :subcat {:1 {:cat :det}
                              :2 '()}}})
-   "short"
-   [(unify adjective
-           {:synsem {:cat :adjective
-                     :sem {:mod {:pred :short}
-                           :comparative false
-                           :physical-object true}
-                     :subcat {:1 {:cat :det}
-                              :2 '()}}})
-    (unify adjective
-           {:synsem {:cat :adjective
-                     :sem {:mod {:pred :short}
-                           :comparative false
-                           :event true}
-                     :subcat {:1 {:cat :det}
-                              :2 '()}}})]
-
+
    "teach"  {:synsem {:cat :verb
                       :sem {:pred :teach}}
                             :english {:past "taught"}}


fix typo

fix typo

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -148,8 +148,8 @@
                                :1plur "devons"
                                :2plur "devez"
                                :3plur "doivent"}}}]
-     [(unify common {:synsem {:sem {:pred :have-to
-                                    :subj {:human true}}}})
+     (unify common {:synsem {:sem {:pred :have-to
+                                   :subj {:human true}}}}))

    "décider" {:synsem {:cat :verb
                        :sem {:pred :decide}}}
@@ -415,7 +415,6 @@
 ;  "profiter (de)" {:synsem {:cat :verb
 ;                            :sem {:pred :take-advantage-of}}}

-
   "regarder" [{:synsem {:cat :verb
                         :sem {:pred :look}}}
               {:synsem {:cat :verb


Update socket deployer with new logging system

'Alot' more robust :)

--- src/containium/deployer/socket.clj
+++ src/containium/deployer/socket.clj
@@ -6,12 +6,12 @@
   (:require [containium.systems :refer (require-system Startable Stoppable)]
             [containium.systems.config :as config :refer (Config)]
             [containium.deployer :refer :all]
-            [containium.modules :as modules :refer (Manager)]
+            [containium.systems.logging :as logging :refer (SystemLogger LogWriter refer-logging)]
             [containium.commands :as commands]
             [clojure.java.io :refer (as-file)]
-            [clojure.core.async :as async :refer (<! >!)])
+            [clojure.stacktrace :refer (print-cause-trace)])
   (:import [org.jboss.netty.channel SimpleChannelHandler ChannelHandlerContext MessageEvent Channel
-            ChannelFutureListener ChannelFactory ChannelFuture ChannelStateEvent]
+            ChannelFutureListener ChannelFactory ChannelFuture ChannelStateEvent ExceptionEvent]
            [org.jboss.netty.channel.group ChannelGroup DefaultChannelGroup]
            [org.jboss.netty.channel.socket.nio NioServerSocketChannelFactory]
            [org.jboss.netty.bootstrap ServerBootstrap]
@@ -19,50 +19,34 @@
            [java.util.concurrent Executors]
            [java.net InetSocketAddress]
            [containium.modules Response]))
-
-
-;;; Async loop for writing to Netty channel.
-
-(defn write
-  [^Channel nettyc msg]
-  (if (instance? containium.modules.Response msg)
-    (do (when-let [status (:status msg)] (.write nettyc (str "STATUS " (name status) \newline)))
-        (.write nettyc (str (if (:success? msg) "SUCCESS" "FAILED") \newline)))
-    (.write nettyc msg)))
-
-
-(defn handler-loop
-  ([^Channel nettyc]
-     (handler-loop nettyc (async/chan)))
-  ([^Channel nettyc commc]
-     (async/go-loop [fut nil]
-       (if-let [msg (<! commc)]
-         (recur (try
-                  (write nettyc msg)
-                  (catch Exception ex
-                    (async/close! commc)
-                    (println "Failed to write" msg "to netty channel:"
-                             (.getMessage ^Exception ex)))))
-         (if fut
-           (.addListener ^ChannelFuture fut ChannelFutureListener/CLOSE)
-           (.close nettyc))))
-     commc))
+(refer-logging)

 ;;; The message handler for Netty server.

 (defn handler
-  [systems ^ChannelGroup channels]
-  (proxy [SimpleChannelHandler] []
-    (channelOpen [^ChannelHandlerContext ctx ^ChannelStateEvent evt]
-      (.add channels (.getChannel evt)))
+  [systems logger ^ChannelGroup channels]
+  (let [show-ex (atom true)]
+    (proxy [SimpleChannelHandler] []
+      (channelOpen [^ChannelHandlerContext ctx ^ChannelStateEvent evt]
+        (.add channels (.getChannel evt)))

-    (messageReceived [^ChannelHandlerContext ctx ^MessageEvent evt]
-      (let [^String msg (.getMessage evt)
-            [command & args] (commands/parse-quoted msg)]
-        (when command
-          ;;---TODO Restore returning #containium.modules/Response on incorrect command?
-          (commands/handle-command command args systems (handler-loop (.getChannel evt))))))))
+      (messageReceived [^ChannelHandlerContext ctx ^MessageEvent evt]
+        (let [^String msg (.getMessage evt)
+              ^Channel chan (.getChannel evt)
+              [command & args] (commands/parse-quoted msg)]
+          (when command
+            ;; TODO Add argument to done-fn for success?
+            ;; TODO Close via future? (.addListener ^ChannelFuture fut ChannelFutureListener/CLOSE)
+            (commands/handle-command command args systems
+                                     (logging/command-logger logger chan command
+                                                             (fn []  (.close chan)))))))
+      (exceptionCaught [^ChannelHandlerContext ctx ^ExceptionEvent evt]
+        (when @show-ex
+          (reset! show-ex false)
+          (let [^Throwable cause (.getCause evt)]
+            (error logger "Error in IO of Netty Socket deployer -" (.getMessage cause))
+            (debug logger (with-out-str (print-cause-trace cause)))))))))

 ;;; Creation of Netty server and socket system.
@@ -83,39 +67,49 @@

 (defrecord SocketDeployer [^ChannelFactory server-factory ^Channel server-channel
-                           ^ChannelGroup channels config]
+                           ^ChannelGroup channels config logger]
   Deployer
   (bootstrap-modules [this])

   Stoppable
   (stop [_]
-    (println "Stopping socket-based module deployer...")
-    (println "Closing server socket...")
+    (info logger "Stopping socket-based module deployer...")
+    (info logger "Closing server socket...")
     (.close server-channel)
     (loop [i (:wait2finish-secs config)]
       (when (and (< 0 i) (not (.isEmpty channels)))
-        (when (= 0 (mod i 5)) (println "Waiting for socket deployer actions to finish."))
+        (when (= 0 (mod i 5)) (info logger "Waiting for socket deployer actions to finish."))
         (Thread/sleep 1000)
         (recur (dec i))))
     (when-not (.isEmpty channels)
-      (println "Still socket deployer actions running after" (:wait2finish-secs config)
-               "seconds. Closing the connections now."))
+      (warn logger "Still socket deployer actions running after" (:wait2finish-secs config)
+            "seconds. Closing the connections now."))
     (.. channels close (await (* 1000 (:wait2close-secs config))))
     (when-not (.isEmpty channels)
-      (println "Still open socket deployer connections after" (:wait2close-secs config)
-               "seconds. Killing them now."))
+      (warn logger "Still open socket deployer connections after" (:wait2close-secs config)
+            "seconds. Killing them now."))
     (.releaseExternalResources server-factory)
     (.shutdown server-factory)
-    (println "Socked-based module deployer stopped.")))
+    (info logger "Socked-based module deployer stopped.")))
+
+
+(defn- extend-channel
+  [logger]
+  (extend-type Channel
+    LogWriter
+    (write-line [this line]
+      (.write this (str line \newline)))))

 (def socket
   (reify Startable
     (start [_ systems]
       (let [config (config/get-config (require-system Config systems) :socket)
-            _ (println "Starting socket-based module deployer, using config:" config)
+            logger (require-system SystemLogger systems)
+            _ (info logger "Starting socket-based module deployer, using config:" config)
             channels (DefaultChannelGroup. "containium management")
-            handler (handler systems channels)
+            handler (handler systems logger channels)
             {:keys [server-factory server-channel]} (netty-server (:port config) handler)]
-        (println "Socket-based module deployer started.")
-        (SocketDeployer. server-factory server-channel channels config)))))
+        (extend-channel logger)
+        (info logger "Socket-based module deployer started.")
+        (SocketDeployer. server-factory server-channel channels config logger)))))


fix bug in unsubscribe-stale-channels

fix bug in unsubscribe-stale-channels

--- frontend/controllers/ws.cljs
+++ frontend/controllers/ws.cljs
@@ -138,8 +138,8 @@

 (defmethod post-ws-event! :unsubscribe-stale-channels
   [pusher-imp message _ previous-state current-state]
-  (doseq [channel-name (clojure.set/difference (inspect (fresh-channels current-state))
-                                               (inspect (pusher/subscribed-channels pusher-imp)))]
+  (doseq [channel-name (clojure.set/difference (pusher/subscribed-channels pusher-imp)
+                                               (fresh-channels current-state))]
     (mlog "unsubscribing from " channel-name)
     (pusher/unsubscribe pusher-imp channel-name)))


Fix typo in log message.

Fix typo in log message.

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -241,7 +241,7 @@
                                    (use-cache-or-update domain domains-info global-config local-config true state))))
               (log-message "Finished updating all domains from remote")
               (try
-                (log-message "Removing all old versions of domains (CLEANUP")
+                (log-message "Removing all old versions of domains (CLEANUP)")
                 (cleanup-domains domains-info local-config)
                 (catch Throwable t (log-error t "Error when cleaning old versions")))
               (catch Throwable t (log-error t "Error when syncing data") (throw t)))))))))


add logging of config caching

add logging of config caching

--- src/clj/elephantdb/service.clj
+++ src/clj/elephantdb/service.clj
@@ -58,11 +58,13 @@
   (let [fs (filesystem (:hdfs-conf local-config))
         domains-info (init-domain-info-map fs global-config)
         local-dir (:local-dir local-config)
-        lfs (doto (local-filesystem) (clear-dir local-dir))]
+        lfs (doto (local-filesystem) (clear-dir local-dir))
+        cache-config (assoc global-config :token token)]
     (log-message "Domains info:" domains-info)
     (future
      (sync-data-scratch domains-info global-config local-config)
-     (cache-global-config! local-config (assoc global-config :token token)))
+     (log-message "Caching global config " cache-config)
+     (cache-global-config! local-config cache-config))
     domains-info ))


Healthy females serving coffee

Healthy females serving coffee

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -58,7 +58,7 @@
    (train-coffee :tada)
    (train-coffee :bacon)
    (train-coffee :scream)
-   (train-coffee :doctor)
+   (train-coffee :female_health_worker)
    (train-coffee :smoking)
    (train-coffee :fingers_crossed)
    (train-coffee :battery)


Correction done with a heavy heart

Correction done with a heavy heart

--- src/clj/mokkameister/train.clj
+++ src/clj/mokkameister/train.clj
@@ -71,7 +71,7 @@
    (train-coffee :rotating_light)
    (train-coffee :punch)
    (train-coffee :monkey_face :wrench)
-   (train-coffee :heavy_heart_exclamation_mark_ornament)
+   (train-coffee :exclamation_heart)
    (train-coffee :badger :mushroom)
    (train :heartbeat :heartpulse)
    (train :syringe :hocho)


Implement submit shotgun actions

Implement submit shotgun actions

--- src/clojure/fault/patterns.clj
+++ src/clojure/fault/patterns.clj
@@ -1,8 +1,17 @@
 (ns fault.patterns
-  (:require [fault.core :as core])
-  (:import (fault ServiceExecutor RejectedActionException)))
+  (:require [fault.core :as core]
+            [fault.future :as future])
+  (:import (fault ServiceExecutor
+                  RejectedActionException
+                  MultipleWriterResilientPromise
+                  ResilientPromise
+                  ResilientAction ResilientFuture)))

 (set! *warn-on-reflection* true)
+
+(defn- wrap-in-action [fn]
+  (reify ResilientAction
+    (run [_] (fn))))

 (defn- next-idx [last-idx current]
   (if (<= last-idx current)
@@ -21,14 +30,14 @@
 (defn submit-load-balanced-action [load-balancer key->fn timeout-millis]
   (some (fn [[key {:keys [service]}]]
           (try (core/submit-action ^ServiceExecutor service
-                                   (get key->fn key)
+                                   (wrap-in-action (get key->fn key))
                                    timeout-millis)
                (catch RejectedActionException _ nil)))
         (load-balancer)))

 (defn perform-load-balanced-action [load-balancer key->fn]
   (some (fn [[key {:keys [service]}]]
-          (try (core/perform-action service (get key->fn key))
+          (try (core/perform-action service (wrap-in-action (get key->fn key)))
                (catch RejectedActionException _ nil)))
         (load-balancer)))

@@ -51,4 +60,10 @@
                      (repeatedly rand-fn)))))))

 (defn submit-shotgun-actions [shotgun key->fn timeout-millis]
-  )+  (let [^ResilientPromise promise (MultipleWriterResilientPromise.)]
+    (doseq [[key {:keys [service]}] (shotgun)]
+      (.submitAction ^ServiceExecutor service
+                     (wrap-in-action (get key->fn key))
+                     promise
+                     timeout-millis))
+    (future/->CLJResilientFuture promise)))


update boot-cljs

update boot-cljs

--- resources/leiningen/new/tenzing/build.boot
+++ resources/leiningen/new/tenzing/build.boot
@@ -1,7 +1,7 @@
 (set-env!
  :source-paths    {{{source-paths}}}
  :resource-paths  #{"resources"}
- :dependencies '[[adzerk/boot-cljs      "0.0-2727-0" :scope "test"]
+ :dependencies '[[adzerk/boot-cljs      "0.0-2760-0" :scope "test"]
                  [adzerk/boot-cljs-repl "0.1.8"      :scope "test"]
                  [adzerk/boot-reload    "0.2.4"      :scope "test"]
                  [pandeiro/boot-http    "0.6.1"      :scope "test"]{{{deps}}}])


extract removed. decision will be made in follow?

--- src/crawler/rich_extractor.clj
+++ src/crawler/rich_extractor.clj
@@ -8,7 +8,7 @@
 ;;;; on how expressive a URL is. A decision to follow is based upon
 ;;;; some statistics.

-(defn extract
+(defn state-action
   [page-src url]
   (let [processed-pg      (dom/html->xml-doc page-src)
         xpaths-hrefs-text (dom/xpaths-hrefs-tokens processed-pg url)
@@ -24,23 +24,13 @@
                                          (or (= host (uri/host (:href a-node)))
                                              (nil? (uri/host (:href a-node)))))
                                        nodes)])
-                             xpaths-hrefs-text)))
-
-        ranked-xpaths     (rank/rank-by-uniqueness in-host-xhrefs)]
-    (map
-     (fn [[xpath score]]
-       {:xpath xpath
-        :node (map (fn [a-node]
-                     {:href (-> a-node :href)
-                      :text (-> a-node :text)})
-                   (in-host-xhrefs xpath))
-        :score score})
-     ranked-xpaths)))
+                             xpaths-hrefs-text)))]
+    in-host-xhrefs))

 (defn follow-naive?
   "Decide if an Xpath's links are worth following based on a naive score of richness.
    The score passed in currently is a trivial product of mean # of tokens and variance
-   of the # of tokens
+   of the # of tokens. NO LOOKAHEADS ARE SUPPLIED TO THIS CRAWLER.

    Args:
     state: A set of actions. {Xpath, url}


Fix flakiness.

Fix flakiness.

--- test/clj/hatnik/selenium/core.clj
+++ test/clj/hatnik/selenium/core.clj
@@ -103,8 +103,14 @@

 (defn wait-until-projects-match [driver projects]
   (wait-until driver
-     #(= projects
-         (clean-projects (find-projects-on-page %)))
+     ; Sometimes DOM update happens while we're collecting
+     ; data about projects from page and "DOM element not found"
+     ; is thrown. As workaround we simply consider it false and
+     ; hope that on next try it will work.
+     #(try
+        (= projects
+           (clean-projects (find-projects-on-page %)))
+        (catch Exception e false))
      (str "Wait for projects to be " (pr-str projects))))

 (defn set-input-text [driver selector text]


relax the checking

relax the checking

--- src/bluebell/utils/wip/check.clj
+++ src/bluebell/utils/wip/check.clj
@@ -9,7 +9,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (spec/def ::check (spec/alt :s-expr seq?
-                            :spec (spec/cat :spec keyword?
+                            :spec (spec/cat :spec (complement seq?)
                                             :expr any?)))

 (spec/def ::checks (spec/spec (spec/* ::check)))


Tweak docstring

Tweak docstring

--- src/caesium/crypto/secretbox.clj
+++ src/caesium/crypto/secretbox.clj
@@ -37,7 +37,7 @@
   is truncated. If the integer is smaller than the nonce, it is padded
   with NUL bytes at the end.

-  Being a byte array (`bytes[]`), the return value is mutable."
+  The return value is a mutable byte array."
   [n]
   (let [unpadded (.toByteArray (biginteger n))
         output (byte-array 24)]


updated run report

updated run report

--- src/clinvar_submitter/report.clj
+++ src/clinvar_submitter/report.clj
@@ -43,32 +43,73 @@
   (some #(= errorcode %) errorvector))
 )

-
 (defn error-description [errorcode]
   (println "is equale " (identical? "*E-401" errorcode))
-  (if (identical? "*E-401" errorcode)
+  (cond
+  (identical? "*E-401" errorcode)
   {
    :desc "Interpretation id not provided."
+  }
+  (identical? "*E-202" errorcode)
+  {
+   :desc "Variant identifier not provided."
+  }
+  (identical? "*E-203" errorcode)
+  {
+   :desc "No preferred variant information provided"
+  }
+  (identical? "*E-204" errorcode)
+  {
+   :desc "Preferred variant reference sequence not provided"
+  }
+  (identical? "*E-205" errorcode)
+  {
+   :desc "Preferred variant start coordinate not provided."
+  }
+  (identical? "*E-206" errorcode)
+  {
+   :desc "Preferred variant end coordinate not provided."
+  }
+  (identical? "*E-207" errorcode)
+  {
+   :desc "Preferred variant reference allele not provided."
+  }
+  (identical? "*E-208" errorcode)
+  {
+   :desc "Preferred variant alternate allele not provided."
+  }
+  (identical? "*W-251" errorcode)
+  {
+   :desc "Preferred variant alternate designation not provided."
+  }
+  (identical? "*E-301" errorcode)
+  {
+   :desc "Condition disease code or name not provided."
+  }
+  (identical? "*E-302" errorcode)
+  {
+   :desc "Mode of Inheritance display value not provided."
+  }
+  (identical? "*E-402" errorcode)
+  {
+   :desc "Interpretation significance not provided."
+  }
+  (identical? "*E-403" errorcode)
+  {
+   :desc "Interpretation evaluation date not provided."
+  }
+  (identical? "*E-404" errorcode)
+  {
+   :desc "Interpretation evaluation date format not valid (<eval-date-value>)."
+  }
+  (identical? "*E-501" errorcode)
+  {
+   :desc "<x> met criteria rules and/or strength codes are invalid or missing."
+  }
+  (identical? "*W-551" errorcode)
+  {
+   :desc "No PMID citations found."
   }))
-
-;{
-;    :E-202 "Variant identifier not provided."
-;		:E-203 "No preferred variant information provided"
-;		:E-204 "Preferred variant reference sequence not provided"
-;		:E-205 "Preferred variant start coordinate not provided."
-;		:E-206 "Preferred variant end coordinate not provided."
-;		:E-207 "Preferred variant reference allele not provided."
-;		:E-208 "Preferred variant alternate allele not provided."
-;		:W-251 "Preferred variant alternate designation not provided."
-;		:E-301 "Condition disease code or name not provided."
-;		:E-302 "Mode of Inheritance display value not provided."
-;		:E-401 "Interpretation id not provided."
-;		:E-402 "Interpretation significance not provided."
-;		:E-403 "Interpretation evaluation date not provided."
-;		:E-404 "Interpretation evaluation date format not valid (<eval-date-value>)."
-;		:E-501 "<x> met criteria rules and/or strength codes are invalid or missing."
-;		:W-551 "No PMID citations found."
-;})

 (defn get-error [errorcode n]
   (let [desc (error-description errorcode)]
@@ -88,8 +129,8 @@
        (for [i (range (count items))]
        (if-not(nil? (get items i))
          (if(isError (get items i))
-          (str (get items i)))))]
-       (let [newList (some #(when-not (empty? %) %) errorlist)]
+          (get items i))))]
+       (let [newList (some #(when-not (empty? %) %) errorlist)]
        newList)))

 (defn append-to-report [reportfile in out records]
@@ -98,6 +139,7 @@
     (let [row (nth records n)]
       ;get errorcode from each row
       (let [errorcode (get-errorcode row)]
+        (println errorcode)
         ;if there is error in any row add error information in the report
         (if-not(nil? errorcode)
           (let [error (get-error errorcode n)]


first stab at db update ops, including insert/update/delete/upsert track
and prune tracks

also put unique contraint on path

--- src/clj/cljspazzer/db/schema.clj
+++ src/clj/cljspazzer/db/schema.clj
@@ -1,5 +1,6 @@
 (ns cljspazzer.db.schema
-  (:require [clojure.java.jdbc :as sql]))
+  (:require [clojure.java.jdbc :as sql]
+            [clojure.java.io :as io]))

 (def the-db {:classname "org.sqlite.JDBC",
              :subprotocol "sqlite",
@@ -8,7 +9,7 @@

 (def tables {:tracks {:name "tracks"
                       :columns[[:id :integer "PRIMARY KEY" "AUTOINCREMENT"]
-                               [:path :string]
+                               [:path :string "UNIQUE"]
                                [:title :string]
                                [:artist :string]
                                [:year :string]
@@ -43,8 +44,29 @@
        (sql/query db ["select count(id) as count from tracks where path=?" t])))
      0))

-(defn insert-track! [db track-info]
-  (sql/insert! db :tracks track-info))
+(defn update-track!
+  "returns count of rows affected"
+  [db track-info]
+  (first (sql/update! db :tracks track-info ["path=?" (:path track-info)])))
+
+(defn insert-track!
+  "returns last row id which should correspond to id"
+  [db track-info]
+  ((keyword "last_insert_rowid()") (first (sql/insert! db :tracks track-info))))
+
+(defn delete-track!
+  "returns rows effected which should be > 1 if successful"
+  [db path]
+  (first (sql/delete! db :tracks ["path=?" path])))
+
+(defn upsert-track!
+  "returns {id:??}for intert or {row-count:??} for update"
+  [db track-info]
+  (let [update-result (update-track! db track-info)]
+    (if (> update-result 0)
+      {:row-count update-result :action :update}
+      {:id (insert-track! db track-info) :action :insert})))
+

 (defn last-modified-index
   "{path:last_modified}"
@@ -55,3 +77,9 @@
                                            r (hash-map k v)]
                                        r)) rows))]
     result))
+
+(defn prune-tracks
+  "get rid of rows where the files no longer exist"
+  [db]
+  (let [files (filter (fn [f] (not (.exists f))) (map io/file (keys (last-modified-index db))))]
+    (map (partial delete-track! db) (map (fn [f] (.getAbsolutePath f)) files))))


Add quick fix for previously unreadable Doubles

refs #71

--- src/clj/reply/hacks/printing.clj
+++ src/clj/reply/hacks/printing.clj
@@ -33,3 +33,15 @@
                 (.write w sep)
                 (recur xs)))))
         (.write w end)))))
+
+(in-ns 'clojure.core)
+(defmethod print-method java.lang.Double [^Double d, ^Writer w]
+  (let [result-str
+          (cond
+            (= d Double/POSITIVE_INFINITY) "Double/POSITIVE_INFINITY"
+            (= d Double/NEGATIVE_INFINITY) "Double/NEGATIVE_INFINITY"
+            (.isNaN d) "Double/NaN"
+            :else (str d))]
+    (.write w result-str)))
+
+(in-ns 'reply.hacks.printing)


Name the components more consistently

Name the components more consistently

--- src/cljs/hyphen_keeper/core.cljs
+++ src/cljs/hyphen_keeper/core.cljs
@@ -70,7 +70,7 @@
                              (.warn js/console
                                     (str "Failed to lookup hyphenation patterns for word: " details)))))

-(defn hyphenation-pattern [{:keys [word hyphenation]}]
+(defn hyphenation-pattern-ui [{:keys [word hyphenation]}]
   [:tr
    [:td word]
    [:td hyphenation]])
@@ -137,7 +137,7 @@
                   (load-hyphenation-patterns! @spelling @word))
      :on-blur #(lookup-hyphenation-pattern! @spelling @word)}]])

-(defn hyphenation-field []
+(defn hyphenation-ui []
   (let [label "Corrected Hyphenation"
         valid? (or (string/blank? @hyphenation) (hyphenation-valid? @hyphenation))
         klass (if valid? "form-group" "form-group has-error")]
@@ -150,7 +150,7 @@
        :value @hyphenation
        :on-change #(reset! hyphenation (-> % .-target .-value string/lower-case))}]]))

-(defn- hyphenation-add-button []
+(defn- hyphenation-add-ui []
   [:div.form-group
    [:button.btn.btn-default
     {:on-click #(when (and @word (hyphenation-valid? @hyphenation))
@@ -161,7 +161,7 @@
                  "disabled")}
     "Add"]])

-(defn spelling-filter []
+(defn spelling-ui []
   [:div.form-group
    [:select {:value @spelling
              :on-change (fn [e]
@@ -171,7 +171,7 @@
     [:option {:value 0} "Old Spelling"]
     [:option {:value 1} "New Spelling"]]])

-(defn hyphenation-filter [search]
+(defn search-ui [search]
   [:input.form-control
    {:type "text"
     :placeholder "Search"
@@ -180,7 +180,7 @@
                  (reset! search (-> e .-target .-value))
                  (load-hyphenation-patterns! @spelling @search))}])

-(defn suggested-hyphenation-field []
+(defn suggested-hyphenation-ui []
   (let [id "suggestedHyphenation"
         label "Suggested Hyphenation"]
     [:div.form-group
@@ -203,7 +203,7 @@
       (button "TU Chemnitz" (str "http://dict.tu-chemnitz.de/?query=" word) disabled)
       (button "PONS" (str "http://de.pons.eu/dict/search/results/?l=dede&q=" word) disabled)]]))

-(defn- navbar [active]
+(defn- navbar-ui [active]
   [:nav.navbar.navbar-default
    [:div.container-fluid
     [:div.navbar-header
@@ -226,9 +226,9 @@
 ;; -------------------------
 ;; Views

-(defn home-page []
+(defn home-page-ui []
   [:div.container
-   [navbar :insert]
+   [navbar-ui :insert]
    [:h2 "Insert Hyphenations"]
    [:div.row
     [:div.col-md-6
@@ -241,23 +241,23 @@
      [:thead [:tr [:th "Word"] [:th "Hyphenation"]]]
      [:tbody
       (for [[word pattern] (:hyphenations @app-state)]
-        ^{:key word} [hyphenation-pattern pattern])]]]])
-
-(defn edit-page []
+        ^{:key word} [hyphenation-pattern-ui pattern])]]]])
+
+(defn edit-page-ui []
   [:div.container
-   [navbar :edit]
+   [navbar-ui :edit]
    [:h2 "Edit Hyphenations"]
    [:div.row
     [:div.col-md-6
-     [spelling-filter]]
+     [spelling-ui]]
     [:div.col-md-6
-     [hyphenation-filter word]]]
+     [search-ui word]]]
    [:div.row
     [:table#hyphenations.table.table-striped
      [:thead [:tr [:th "Word"] [:th "Hyphenation"] [:th ""]]]
      [:tbody
       (for [[word pattern] (:hyphenations @app-state)]
-        ^{:key word} [hyphenation-pattern-editable-item pattern])]]]])
+        ^{:key word} [hyphenation-pattern-item-ui pattern])]]]])

 (defn current-page []
   [:div [(session/get :current-page)]])
@@ -266,10 +266,10 @@
 ;; Routes

 (secretary/defroute "/" []
-  (session/put! :current-page #'home-page))
+  (session/put! :current-page #'home-page-ui))

 (secretary/defroute "/edit" []
-  (session/put! :current-page #'edit-page))
+  (session/put! :current-page #'edit-page-ui))

 ;; -------------------------
 ;; Initialize app


Implement disconnect and connected?

Implement disconnect and connected?

--- src/clojure_fabric/event_hub.clj
+++ src/clojure_fabric/event_hub.clj
@@ -392,33 +392,19 @@
                                                                           {:algorithm (:key-algorithm (:crypto-suite user))})))
                   (.build))))))

-
 (defn disconnect
   ([]
    (disconnect *event-hub*))
   ([event-hub]
-   (when-not (:connected event-hub)
-     (if-not (:peer-address event-hub)
-       (throw (Exception. "Peer address is missing!"))
-       ))))
-
-(defn get-peer-address
-  ([]
-   (get-peer-address *event-hub*))
-  ([event-hub]
-   (when-not (:connected event-hub)
-     (if-not (:peer-address event-hub)
-       (throw (Exception. "Peer address is missing!"))
-       ))))
+   (with-issuing-event-go-loop-command! [event-hub :quit])))

 (defn connected?
   ([]
    (connected? *event-hub*))
-  ([event-hub]
-   (when-not (:connected event-hub)
-     (if-not (:peer-address event-hub)
-       (throw (Exception. "Peer address is missing!"))
-       ))))
+  ([{:keys [end-time managed-channel event-go-loop] :as event-hub}]
+   (and (not (deref end-time))
+        (deref event-go-loop)
+        (deref managed-channel))))

 ;; Not required
 ;;
@@ -428,4 +414,6 @@
 ;; remove-chaincode-interest
 ;; get-interested-events
 ;; receive (i/f - block or chaincode)
-
+;; get-peer-address
+
+


Tried to add some selectors

Tried to add some selectors

--- src/clojure_web_scraper/core.clj
+++ src/clojure_web_scraper/core.clj
@@ -2,12 +2,12 @@
   (:require [org.httpkit.client :as http])
   (:require [clojure.data.json :as json])
   (:require [hickory.core :as hickory])
-  (:require [hickory.select :as selectors])
+  (:require [hickory.select :as s])
   (:require [clojure.core.async :as async :refer [go go-loop put! take! <! >! <!! timeout chan alt! go]]))

 (def surfing-urls [
-                   "sshttp://magicseaweed.com/East-Wittering-Surf-Report/14/"
+                   "http://magicseaweed.com/East-Wittering-Surf-Report/14/"
                    "http://magicseaweed.com/West-Wittering-Surf-Report/3765/"
                    "http://magicseaweed.com/Morocco-Surf-Forecast/12/"
                    "http://magicseaweed.com/Central-Morocco-Surfing/42/"
@@ -33,6 +33,8 @@

 (call-all-the-urls)

+(defn selector [hickory-tree] (s/select (s/child  (s/class "nomargin")) hickory-tree))
+
 (defn call-all-the-urls-optn
   []
   (go
@@ -41,7 +43,11 @@
                            (http-get url)))]
         (println chans)
         (doseq [c chans]
-          (println "Channel value:" (<! c)))))))
+          (println "Channel value:" (-> c
+                                        <!
+                                        :body
+                                        hickory/parse
+                                        selector)))))))

 (call-all-the-urls-optn)


improved catalog search

improved catalog search

--- src/house/puzzles/catalog.cljc
+++ src/house/puzzles/catalog.cljc
@@ -7,20 +7,41 @@
             #?(:clj [advenjure.async :refer [alet]]))
   #?(:cljs (:require-macros [advenjure.async :refer [alet]])))

+(def roca-topics #{"julio argentino roca"
+                   "alejo julio argentino roca paz"
+                   "julio roca"
+                   "julio a roca"
+                   "julio a. roca"})
+
+(def roca-text "Alejo Julio Argentino Roca Paz (July 17, 1843 – October 19, 1914) was an army general who served as President of Argentina from 12 October 1880 to 12 October 1886 and again from 12 October 1898 to 12 October 1904.")
+
+(def desert-topics #{"the conquest of the desert"
+                     "conquest of the desert"
+                     "conquest of desert"
+                     "the conquest of desert"
+                     "conquista del desierto"
+                     "la conquista del desierto"})
+
+(def desert-text "The Conquest of the Desert (Spanish: Conquista del desierto) was a military campaign directed mainly by General Julio Argentino Roca in the 1870s with the intent to establish Argentine dominance over Patagonia, which was inhabited by indigenous peoples. Under General Roca, the Conquest of the Desert extended Argentine power into Patagonia and ended the possibility of Chilean expansion there.")

 (defn wiki-url [topic]
-  (str "https://en.wikipedia.org/w/api.php?format=json&action=query&prop=extracts&redirects=1&exintro=&explaintext=&exsentences=2&origin=*&titles="
+  (str "https://en.wikipedia.org/w/api.php?action=opensearch&limit=1&namespace=0&format=json&redirects=resolve&origin=*&search="
        (string/trim topic)))

-; TODO return the needed hints even if offline
+(defn print-result [extract] (str "Browsing the books I found this:\n \n" extract))
+
 (defn search-catalog
   [gs]
   (alet [topic (prompt-value "Topic to search for: ")
          result (request (wiki-url topic) {:response-format :json})
-         extract (get (first (vals (get-in result ["query" "pages"]))) "extract")]
-    (if-not (string/blank? extract)
-      (str "Browsing the books I found this:\n \n" extract)
-      "I found nothing about that in the catalog.")))
+         extract (get-in result [2 0])
+         clean-topic (string/lower-case (string/trim topic))]
+    (cond
+      (not (string/blank? extract)) (print-result extract)
+      ; default non accurate enough foro wikipedia or no internet connection
+      (roca-topics clean-topic) (print-result roca-text)
+      (desert-topics clean-topic) (print-result desert-text)
+      :else "I found nothing about that in the catalog.")))

 (def catalog (item/make ["card cabinet" "cabinet" "catalog" "card catalog"]
                         "It was a card catalog of the library, consisting of a set of labeled small drawers. I could use it to search the books for a specific topic."


remove logging.

remove logging.

--- src/kixi/hecuba/api/parser.clj
+++ src/kixi/hecuba/api/parser.clj
@@ -21,8 +21,6 @@
           association-schema (:schema association)]
       (map
        (fn [attr]
-         (log/info "item:" item)
-         (log/info "type:" (type item))
          [(str (name association-name) "_" (name attr)) (item (name attr))])
        association-schema))))


Allow "admin" users to edit all messages on the channel

--- web-app/src/cljs/potato/core.cljs
+++ web-app/src/cljs/potato/core.cljs
@@ -725,7 +725,7 @@
     (render-state [_ {:keys [menu-opened editing-callback editing editable]}]
       (let [current-user (:current-user (deref potato.state/global))
             isDeleted    (:deleted message)
-            canEdit      (or (= (:from message) (:id current-user)))
+            canEdit      (or (aget js/window "isAdmin") (= (:from message) (:id current-user)))
             hasGearMenu  (and editable (not isDeleted))
             isEmpty      (== (count (:text message)) 0)
             isHidden     (message-hidden-p message)]


[#218] Uncomment map-indexed definition that uses letfn

--- priv/clojure/core.clj
+++ priv/clojure/core.clj
@@ -5949,18 +5949,17 @@
          ([result input]
           (rf result (f (vswap! i inc) input)))))))
   ([f coll]
-   (throw "unimplemented letfn*")
-   #_(letfn [(mapi [idx coll]
+   (letfn [(mapi [idx coll]
                  (lazy-seq
                    (when-let [s (seq coll)]
-                     (if (chunked-seq? s)
+                     #_(if (chunked-seq? s)
                        (let [c (chunk-first s)
                              size (int (count c))
                              b (chunk-buffer size)]
                          (dotimes [i size]
                            (chunk-append b (f (+ idx i) (.nth c i))))
-                         (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s))))
-                       (cons (f idx (first s)) (mapi (inc idx) (rest s)))))))]
+                         (chunk-cons (chunk b) (mapi (+ idx size) (chunk-rest s)))))
+                     (cons (f idx (first s)) (mapi (inc idx) (rest s))))))]
      (mapi 0 coll))))

 (defn keep


Port the gate (with no features) to IWorkerAudioNode

--- src/main/audio_utils/gate.cljs
+++ src/main/audio_utils/gate.cljs
@@ -2,12 +2,8 @@
   (:require [audio-utils.ring-buffer :as rb]
             [audio-utils.rms-buffer :as rms]
             [audio-utils.util :refer [aatom aderef areset! aswap!
-                                      db->amplitude time->samples]]))
-
-(defprotocol IGate
-  (connect-source [this source])
-  (connect-destination [this destination])
-  (disconnect [this]))
+                                      db->amplitude time->samples]]
+            [audio-utils.worker :as w]))

 ;;sample-rate        (.-sampleRate ctx)
 ;;threshold'         (db->amplitude threshold)
@@ -17,39 +13,42 @@
 ;;look-ahead-samples (max 1 (time->samples look-ahead sample-rate))
 ;;look-ahead-buffer  (rb/ring-buffer look-ahead-samples)

-(defrecord Gate [config node rms-buffers]
-  IGate
-  (connect-source [this source]
-    (let [sample-rate (.-sampleRate (:ctx config))
-          rms-window  (:rms-window config)
-          rms-samples (max 1 (time->samples rms-window sample-rate))]
-      (areset! rms-buffers
-               (into [] (repeat (.-channelCount source)
-                                (rms/rms-buffer rms-samples)))))
-    (.connect source node))
+;;(let [sample-rate (.-sampleRate (:ctx config))
+;;      rms-window  (:rms-window config)
+;;      rms-samples (max 1 (time->samples rms-window sample-rate))]
+;;  (areset! rms-buffers
+;;           (into [] (repeat (.-channelCount source)
+;;                            (rms/rms-buffer rms-samples)))))

-  (connect-destination [this destination]
-    (.connect node destination))
+(defprotocol IGate
+  (generate-output-sample [this channel input-sample]))
+
+(defrecord Gate [config next rms-buffers]
+  w/IWorkerAudioNode
+  (connect [this destination]
+    (reset! next destination))

   (disconnect [this]
-    (.disconnect node))
+    (reset! next nil))

-  Object
-  (generate-output-sample [this channel sample]
-    sample)
+  (process-audio [this data]
+    (let [n-samples  (count (first data))
+          n-channels (count data)
+          output     (volatile! (into [] (repeat n-channels [])))]
+      (dotimes [n n-samples]
+        (dotimes [channel n-channels]
+          (let [input-sample  ((data channel) n)
+                output-sample (generate-output-sample this channel
+                                                      input-sample)]
+            (vswap! output update channel conj output-sample))))
+      (some-> @next (w/process-audio @output))))

-  (process-audio [this event]
-    (let [input-buffer  (.-inputBuffer event)
-          output-buffer (.-outputBuffer event)
-          n-channels    (.-numberOfChannels output-buffer)]
-      (dotimes [channel n-channels]
-        (let [input-data  (.. input-buffer  (getChannelData channel))
-              output-data (.. output-buffer (getChannelData channel))]
-          (dotimes [n (.-length input-data)]
-            (let [input-sample  (aget input-data n)
-                  output-sample (.generate-output-sample this channel
-                                                         input-sample)]
-              (aset output-data n output-sample))))))))
+  IGate
+  (generate-output-sample [this channel input-sample]
+    (if (>= (Math/abs input-sample)
+            (db->amplitude (:threshold config)))
+      input-sample
+      0.0)))

 (defn default-trigger
   [gate state])
@@ -68,16 +67,12 @@
            hold        100
            rms-window  100
            trigger     default-trigger}}]
-  (let [node   (.createScriptProcessor ctx buffer-size 1 1)
-        config {:ctx        ctx
+  (let [config {:ctx        ctx
                 :threshold  threshold
                 :look-ahead look-ahead
                 :hold       hold
                 :rms-window rms-window
-                :trigger    trigger}
-        gate   (map->Gate {:config      config
-                           :node        node
-                           :rms-buffers (aatom [])})]
-    (set! (.-onaudioprocess node)
-          #(.process-audio gate %))
-    gate))
+                :trigger    trigger}]
+    (map->Gate {:config      config
+                :next        (atom nil)
+                :rms-buffers (aatom [])})))


Ontologies: prefixers for rdfs:domain and rdfs:range

--- src/grafter/rdf/ontologies/rdf.clj
+++ src/grafter/rdf/ontologies/rdf.clj
@@ -12,3 +12,5 @@
 (def rdfs:comment (rdfs "comment"))
 (def rdfs:subPropertyOf (rdfs "subPropertyOf"))
 (def rdfs:isDefinedBy (rdfs "isDefinedBy"))
+(def rdfs:range (rdfs "range"))
+(def rdfs:domain (rdfs "domain"))


Implemented "lein appengine-update".

Implemented "lein appengine-update".

--- src/leiningen/appengine_update.clj
+++ src/leiningen/appengine_update.clj
@@ -1,7 +1,59 @@
 (ns leiningen.appengine-update
-  "Deploys the application to the production Google App Engine.")
+  "Deploys the application to the production Google App Engine."
+  (:use appengine-magic.utils)
+  (:require [leiningen.core :as lein])
+  (:import java.io.File
+           com.google.appengine.tools.admin.AppCfg))

-(defn appengine-update [project & [app-name]]
-  ;; TODO: Implement me.
-  )
+(defn appengine-update [project app-name]
+  (let [appengine-sdk (:appengine-sdk project)
+        appengine-sdk (cond
+                       ;; not given
+                       (nil? appengine-sdk)
+                       (lein/abort "appengine-update requires :appengine-sdk in project.clj")
+                       ;; a string
+                       (string? appengine-sdk)
+                       appengine-sdk
+                       ;; a map: {username location}
+                       (map? appengine-sdk)
+                       (let [username (System/getProperty "user.name")
+                             raw (get appengine-sdk username)]
+                         (when (nil? raw)
+                           (lein/abort
+                            (format "no valid App Engine SDK directory defined for user %s"
+                                    username)))
+                         raw))
+        appengine-sdk (let [appengine-sdk (File. appengine-sdk)]
+                        (when-not (.isDirectory appengine-sdk)
+                          (lein/abort (format "%s is not a valid App Engine SDK directory"
+                                              appengine-sdk)))
+                        appengine-sdk)
+        versions (if (contains? project :appengine-app-versions)
+                     (:appengine-app-versions project)
+                     (lein/abort (str "appengine-update requires :appengine-app-versions"
+                                      " in project.clj")))
+        version (cond
+                 ;; not a map
+                 (not (map? versions))
+                 (lein/abort "bad format for :appengine-app-versions")
+                 ;; check the given app-name
+                 (not (contains? versions app-name))
+                 (lein/abort (format ":appengine-app-versions does not contain %s" app-name))
+                 ;; looks fine now
+                 :else (versions app-name))
+        resources-dir (File. (:resources-path project))
+        web-inf-dir (File. resources-dir "WEB-INF")
+        in-appengine-web-xml-tmpl (File. web-inf-dir "appengine-web.xml.tmpl")
+        out-appengine-web-xml (File. web-inf-dir "appengine-web.xml")]
+    (when (not (.exists in-appengine-web-xml-tmpl))
+      (lein/abort "appengine-update requires WEB-INF/appengine-web.xml.tmpl template file"))
+    (when (.exists out-appengine-web-xml)
+      (lein/abort "appengine-update cannot run when a WEB-INF/appengine-web.xml file exists"))
+    (try
+      (xpath-replace-all in-appengine-web-xml-tmpl out-appengine-web-xml
+                         {"//application" app-name
+                          "//version" version})
+      (System/setProperty "appengine.sdk.root" (.getCanonicalPath appengine-sdk))
+      (AppCfg/main (into-array ["update" (.getCanonicalPath resources-dir)]))
+      (finally (.delete out-appengine-web-xml)))))


Update form state.

Update form state.

--- src/cljs/hatnik/web/client/form/add_action.cljs
+++ src/cljs/hatnik/web/client/form/add_action.cljs
@@ -149,14 +149,28 @@
   (merge
    {:email-body (get action "body")
     :email-subject (get action "subject")}
-    github-issue-init-state))
+    github-issue-init-state github-pull-request-init-state))

 (defmethod get-init-state-by-action "github-issue" [action]
-  (merge
-   {:gh-issue-title (get action "title")
-    :gh-issue-body (get action "body")
-    :gh-repo (get action "repo")}
-   email-init-state))
+  (assoc
+      (merge
+       {:gh-issue-title (get action "title")
+        :gh-issue-body (get action "body")}
+       email-init-state github-pull-request-init-state)
+    :gh-repo (get action "repo")))
+
+(defmethod get-init-state-by-action "github-pull-request" [action]
+  (assoc
+      (merge
+       {:gh-pull-body (get action "body")
+        :gh-pull-title (get action "title")
+        :gh-comm-msg (get action "commit-message")
+        :gh-operations (mapv (fn [x] {:file (get x "file")
+                                      :regex (get x "regex")
+                                      :replacement (get x "replacement")})
+                             (get action "operations"))}
+       email-init-state github-issue-init-state)
+    :gh-repo (get action "repo")))

 (defmethod get-init-state :update [data _]
   (let [action (:action data)]


Emit route patterns in sorted order

Emit route patterns in sorted order

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -129,6 +129,41 @@
     (if sync?
       (rook-async/ring-handler->async-handler handler)
       handler)))
+
+(defn compare-pathvecs [pathvec1 pathvec2]
+  (let [variable? (some-fn keyword? symbol?)]
+    (loop [pv1 (seq pathvec1)
+           pv2 (seq pathvec2)]
+      (cond
+        (nil? pv1) (if (nil? pv2) 0 -1)
+        (nil? pv2) 1
+        :else
+        (let [seg1 (first pv1)
+              seg2 (first pv2)]
+          (cond
+            (variable? seg1) (if (variable? seg2)
+                               (let [res (compare (name seg1) (name seg2))]
+                                 (if (zero? res)
+                                   (recur (next pv1) (next pv2))
+                                   res))
+                              -1)
+            (variable? seg2) 1
+            :else (let [res (compare seg1 seg2)]
+                    (if (zero? res)
+                      (recur (next pv1) (next pv2))
+                      res))))))))
+
+(defn compare-route-specs [[method1 pathvec1] [method2 pathvec2]]
+  (let [res (compare-pathvecs pathvec1 pathvec2)]
+    (if (zero? res)
+      (compare method1 method2)
+      res)))
+
+(defn sort-dispatch-table [dispatch-table]
+  (vec (sort compare-route-specs dispatch-table)))
+
+(defn sorted-routes [routes]
+  (into (sorted-map-by compare-route-specs) routes))

 (defn analyse-dispatch-table
   "Returns a map holding a map of route-spec* -> handler-sym at
@@ -174,7 +209,7 @@
                       :sync?            sync?}
             handlers (assoc handlers handler-sym handler)]
         (recur routes handlers middleware (next entries)))
-      {:routes     routes
+      {:routes     (sorted-routes routes)
        :handlers   handlers
        :middleware (set/map-invert middleware)})))


Add support for :all in compile-dispatch-table

--- src/io/aviso/rook/dispatcher.clj
+++ src/io/aviso/rook/dispatcher.clj
@@ -146,7 +146,10 @@
             (match (preparse-request ~req)
               ~@(mapcat
                   (fn [[method pathvec verb-fn-sym middleware]]
-                    (let [ns-metadata      (-> verb-fn-sym
+                    (let [method           (if (identical? method :all)
+                                             '_
+                                             method)
+                          ns-metadata      (-> verb-fn-sym
                                              namespace symbol the-ns meta)
                           metadata         (merge (dissoc ns-metadata :doc)
                                              (meta (resolve verb-fn-sym)))


simplified best-call-action finding code

--- src/midje/internal_ideas/fakes.clj
+++ src/midje/internal_ideas/fakes.clj
@@ -175,8 +175,8 @@
     (let [value-in-var (var-get (:var fake))
           unfinished-fun (:midje/unfinished-fun (meta (:var fake)))]
       (and (extended-fn? value-in-var)
-        (or (nil? unfinished-fun)
-          (not= unfinished-fun value-in-var))))))
+           (or (nil? unfinished-fun)
+               (not= unfinished-fun value-in-var))))))

 (def #^:dynamic #^:private *call-action-count* (atom 0))

@@ -192,15 +192,11 @@
              "  (def all-even? (partial every? even?))"
              "  ;; ..."
              "  (provided (all-even? ..xs..) => true)")))
-  (if-let [found (find-first (partial call-handled-by-fake? function-var actual-args)
-                             fakes)]
+  (if-let [found (find-first (partial call-handled-by-fake? function-var actual-args) fakes)]
     found
     (let [possible-fakes (filter #(= function-var (:var %)) fakes)]
-      (pred-cond possible-fakes
-        empty?                                     nil
-        (comp not usable-default-function? first)  nil ;; Finding default, any possible fake works
-        :else                                      (:value-at-time-of-faking
-                                                     (first possible-fakes))))))
+      (when (some usable-default-function? possible-fakes)
+        (:value-at-time-of-faking (first possible-fakes))))))

 (defn- ^{:testable true } call-faker
   "This is the function that handles all mocked calls."


GR - small formatting fix

GR - small formatting fix

--- src/objective8/storage/storage.clj
+++ src/objective8/storage/storage.clj
@@ -97,11 +97,11 @@

 (defn pg-retrieve-answers-with-votes-for-question [question-id]
   (apply vector (map unmap-answer-with-votes
-                  (korma/exec-raw ["SELECT answers.*, up_votes, down_votes FROM objective8.answers AS answers
-LEFT JOIN (SELECT global_id, count(vote) as down_votes FROM objective8.up_down_votes WHERE vote < 0 GROUP BY global_id) AS agg
-     ON agg.global_id = answers.global_id
-LEFT JOIN (SELECT global_id, count(vote) as up_votes FROM objective8.up_down_votes WHERE vote > 0 GROUP BY global_id) AS agg2
-     ON agg2.global_id = answers.global_id
-WHERE answers.question_id = ?
-ORDER BY answers._created_at ASC
-LIMIT 50" [question-id]] :results))))
+                     (korma/exec-raw ["SELECT answers.*, up_votes, down_votes FROM objective8.answers AS answers
+                                      LEFT JOIN (SELECT global_id, count(vote) as down_votes FROM objective8.up_down_votes WHERE vote < 0 GROUP BY global_id) AS agg
+                                      ON agg.global_id = answers.global_id
+                                      LEFT JOIN (SELECT global_id, count(vote) as up_votes FROM objective8.up_down_votes WHERE vote > 0 GROUP BY global_id) AS agg2
+                                      ON agg2.global_id = answers.global_id
+                                      WHERE answers.question_id = ?
+                                      ORDER BY answers._created_at ASC
+                                      LIMIT 50" [question-id]] :results))))


Add some logging around clean-input function.

--- src/oc/storage/resources/entry.clj
+++ src/oc/storage/resources/entry.clj
@@ -73,6 +73,8 @@
   (map #(if (:created-at %) % (assoc % :created-at timestamp)) attachments)))

 (defn clean-input [entry]
+  (timbre/infof "Cleaning body input, initial: %s" (:body entry))
+  (timbre/infof "Cleaned: %s" (lib-html/sanitize-html (or (:body entry) "")))
   (-> entry
       (update :body #(lib-html/sanitize-html (or % "")))
       (update :headline #(lib-html/strip-xss-tags (or % "")))))


Fix typo

Fix typo

--- src/rdf_path_examples/examples.clj
+++ src/rdf_path_examples/examples.clj
@@ -44,7 +44,7 @@
   (if (.isEmpty examples)
     {}
     (-> examples
-        model->jsonld
+        model->json-ld
         JsonUtils/fromString
         (json-ld/compact example-context)
         hash-map)))


Retry mailserver request with cursor

Retry mailserver request with cursor

Signed-off-by: Jakub Sokołowski <1d3764b91b902f6b45836e2498da81fe35caf6d6@status.im>

--- src/status_im/mailserver/core.cljs
+++ src/status_im/mailserver/core.cljs
@@ -461,9 +461,11 @@
         (if (seq cursor)
           (when-let [mailserver (get-mailserver-when-ready cofx)]

-            {:mailserver/request-messages {:web3 (:web3 db)
-                                           :mailserver    mailserver
-                                           :request (assoc request :cursor cursor)}})
+            (let [request-with-cursor (assoc request :cursor cursor)]
+              {:db (assoc db :mailserver/current-request request-with-cursor)
+               :mailserver/request-messages {:web3 (:web3 db)
+                                             :mailserver    mailserver
+                                             :request request-with-cursor}}))
           (fx/merge cofx
                     {:db (-> db
                              (dissoc :mailserver/current-request)
@@ -552,9 +554,9 @@
               {:db (update db :mailserver/current-request dissoc :attemps)}
               (change-mailserver))
     (when-let [mailserver (get-mailserver-when-ready cofx)]
-      (let [{:keys [topics from to] :as request} (get db :mailserver/current-request)
+      (let [{:keys [topics from to cursor] :as request} (get db :mailserver/current-request)
             web3 (:web3 db)]
-        (log/info "mailserver: message request " request-id "expired for mailserver topic" topics "from" from "to" to)
+        (log/info "mailserver: message request " request-id "expired for mailserver topic" topics "from" from "to" to "cursor" cursor)
         {:db (update-in db [:mailserver/current-request :attemps] inc)
          :mailserver/request-messages {:web3    web3
                                        :mailserver   mailserver


Päivitetty seesaw-dependency, lisätty clojure-watch

--- mtg-pairings-wer/project.clj
+++ mtg-pairings-wer/project.clj
@@ -5,5 +5,6 @@
             :url "http://www.opensource.org/licenses/mit-license.php"}
   :dependencies [[org.clojure/clojure "1.5.1"]
                  [clojess "0.3"]
-                 [seesaw "1.4.2"]])
+                 [seesaw "1.4.4"]
+                 [clojure-watch "0.1.9"]])


Fix issues in publish triggers.

Fix issues in publish triggers.

--- src/oc/storage/api/entries.clj
+++ src/oc/storage/api/entries.clj
@@ -132,9 +132,9 @@
             publish-result (entry-res/publish-entry! conn (:uuid updated-entry) updated-entry user)]
     (do
       (timbre/info "Published entry for:" (:uuid updated-entry))
-      (change/send-trigger! (change/->trigger :add :entry {:content {:new publish-result}}))
+      (change/send-trigger! (change/->trigger :add publish-result))
       (timbre/info "Published entry:" entry-for)
-      (notification/send-trigger! (notification/->trigger :update org board {:old entry :new publish-result} user))
+      (notification/send-trigger! (notification/->trigger :add org board {:new publish-result} user))
       {:updated-entry publish-result})
     (do (timbre/error "Failed publishing entry:" entry-for) false)))


Don't let a drag event add new empty rows to the state map in sequencer.

--- src/overtone/gui/sequencer.clj
+++ src/overtone/gui/sequencer.clj
@@ -28,7 +28,9 @@
   (update-in state [:rows row :value col] not))

 (defn- set-entry [state row col v]
-  (assoc-in state [:rows row :value col] v))
+  (if (< row (count (:rows state)))
+    (assoc-in state [:rows row :value col] v)
+    state))

 (defn- get-entry [state row col]
   (get-in state [:rows row :value col]))


Use map to apply as-element in expand-seq

--- src/reagent/impl/template.cljs
+++ src/reagent/impl/template.cljs
@@ -413,20 +413,15 @@
 (set! comp/as-element as-element)

 (defn expand-seq [s]
-  (let [a (into-array s)]
-    (dotimes [i (alength a)]
-      (aset a i (as-element (aget a i))))
-    a))
+  (into-array (map as-element s)))

 (defn expand-seq-dev [s o]
-  (let [a (into-array s)]
-    (dotimes [i (alength a)]
-      (let [val (aget a i)]
-        (when (and (vector? val)
-                   (nil? (key-from-vec val)))
-          (set! (.-no-key o) true))
-        (aset a i (as-element val))))
-    a))
+  (into-array (map (fn [val]
+                     (when (and (vector? val)
+                                (nil? (key-from-vec val)))
+                       (set! (.-no-key o) true))
+                     (as-element val))
+                   s)))

 (defn expand-seq-check [x]
   (let [ctx #js{}


Prefer built-in dotimes if there is no change in base offset

--- src/sierpinski_sieve/core.cljs
+++ src/sierpinski_sieve/core.cljs
@@ -25,11 +25,11 @@
   (iterate (partial next-row modulus) (into-array initial-state)))

 (defn paint-row [ctx y row size]
-  (forloop [(x 0) (< x (alength row)) (inc x)]
-     (let [disp-x (+ (* (- size y) 0.5) x)
-           value (aget row x)]
-       (if (odd? value)
-         (.fillRect ctx disp-x y 1 1)))))
+  (dotimes [x (alength row)]
+    (let [disp-x (+ (* (- size y) 0.5) x)
+          value (aget row x)]
+      (if (odd? value)
+        (.fillRect ctx disp-x y 1 1)))))

 (defn paint [canvas-id size sieve]
   (when-let [canvas-element (.getElementById js/document canvas-id)]