Доработка компонента поискового селектора

--- radiolamp-6P3S/src/r6p3s/cpt/input_from_search.cljs
+++ radiolamp-6P3S/src/r6p3s/cpt/input_from_search.cljs
@@ -106,8 +106,8 @@

            :add-button
            (button/render {:type     ui-type--add-button--type
-                         :on-click #(modal/show (:modal app))
-                         :text     ui-type--add-button--text })
+                           :on-click #(modal/show (:modal app))
+                           :text     ui-type--add-button--text })

            :input-select
            (dom/div #js {:className (str "form-group " class+ " "(common-input/input-css-string-has? @app))}
@@ -120,6 +120,14 @@
                       (dom/div
                        #js {:className input-class+}
                        (dom/div #js {:className "input-group"}
+                                (dom/span #js {:className "input-group-btn"}
+                                          (button/render {:type     :default
+                                                          :on-click (fn []
+                                                                      (om/update! app :sel [])
+                                                                      (when on-selected-fn (on-selected-fn)))
+                                                          :text     (dom/span #js {:className   "glyphicon glyphicon-remove"
+                                                                                :aria-hidden "true"})
+                                                          }))
                                 (dom/input #js {:value       (let [r (get-in @app [:sel 0])]
                                                                (if one--row-to-text-fn
                                                                  (one--row-to-text-fn r)
@@ -128,9 +136,9 @@
                                                 :className   "form-control"})
                                 (dom/span #js {:className "input-group-btn"}
                                           (button/render {:type     :default
-                                                        :on-click #(modal/show (:modal app))
-                                                        :text     (dom/span #js {:className   "glyphicon glyphicon-list-alt"
-                                                                                :aria-hidden "true"})})))
+                                                          :on-click #(modal/show (:modal app))
+                                                          :text     (dom/span #js {:className   "glyphicon glyphicon-list-alt"
+                                                                                :aria-hidden "true"})})))
                        (om/build helper-p/component app))

                       :multi
@@ -187,8 +195,8 @@

                         (dom/div #js {:className "panel-footer"}
                                  (button/render {:type     ui-type--add-button--type
-                                               :on-click #(modal/show (:modal app))
-                                               :text     ui-type--add-button--text }))))
+                                                 :on-click #(modal/show (:modal app))
+                                                 :text     ui-type--add-button--text }))))

@@ -247,7 +255,7 @@
                                                   :text "Выбрать"})

                                                 (button/render {:on-click (fn [_] (modal/hide (:modal app)) 1)
-                                                              :text     "Закрыть"})
+                                                                :text     "Закрыть"})
                                                 )
                            }})
          )))))


change variable name to indicate function

--- ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/app/main.clj
+++ ssclj/jar/src/main/clojure/com/sixsq/slipstream/ssclj/app/main.clj
@@ -12,14 +12,14 @@
   (or (< 0 port 65536) port))

 (defn- create-shutdown-hook
-  [state]
-  (proxy [Thread] [] (run [] (stop state))))
+  [stop-fn]
+  (proxy [Thread] [] (run [] (stop stop-fn))))

 (defn register-shutdown-hook
   "Registers a shutdown hook in the JVM to shutdown the application
    container cleanly."
-  [state]
-  (let [hook (create-shutdown-hook state)]
+  [stop-fn]
+  (let [hook (create-shutdown-hook stop-fn)]
     (.. (Runtime/getRuntime)
         (addShutdownHook hook))))


bugfix

bugfix

--- resources/leiningen/new/closp/clj/components/db.clj
+++ resources/leiningen/new/closp/clj/components/db.clj
@@ -1,10 +1,9 @@
 (ns {{ns}}.components.db
   (:require [mount.core :refer [defstate]]
-            [korma.db :refer [defdb]]
+            [korma.db :as korma]
             [{{ns}}.components.config :refer [config]]))

 (defn new-db [config]
-  (println "fooso" (korma/create-db (get-in config [:jdbc-url])))
   (let [db (korma/create-db (get-in config [:jdbc-url]))]
     (korma/default-connection db)))


CMR-2397: Fix mappings for lowercase fields and sort fields

--- search-app/src/cmr/search/data/query_to_elastic.clj
+++ search-app/src/cmr/search/data/query_to_elastic.clj
@@ -134,14 +134,19 @@
   (let [default-mappings
         {:granule-ur "granule-ur.lowercase2"
          :producer-gran-id "producer-gran-id.lowercase2"
-         :producer-granule-id "producer-gran-id.lowercase2"}]
+         :producer-granule-id "producer-gran-id.lowercase2"
+         :version "version-id.lowercase"}]
     (if (use-doc-values-fields)
       (merge default-mappings {:provider "provider-id.lowercase-doc-values"
                                :provider-id "provider-id.lowercase-doc-values"
                                :platform "platform-sn.lowercase-doc-values"
                                :instrument "instrument-sn.lowercase-doc-values"
                                :sensor "sensor-sn.lowercase-doc-values"
-                               :project "project-refs.lowercase-doc-values"})
+                               :project "project-refs.lowercase-doc-values"
+                               :entry-title "entry-title.lowercase-doc-values"
+                               :short-name "short-name.lowercase-doc-values"
+                               :version "version-id.lowercase-doc-values"
+                               :version-id "version-id.lowercase-doc-values"})
       default-mappings)))

 (defn- keywords-in-condition
@@ -221,7 +226,14 @@
                                :sensor :sensor-sn.lowercase-doc-values
                                :project :project-refs.lowercase-doc-values
                                :start-date :start-date-doc-values
-                               :end-date :end-date-doc-values})
+                               :end-date :end-date-doc-values
+                               :revision-date :revision-date-doc-values
+                               :entry-title :entry-title.lowercase-doc-values
+                               :short-name :short-name.lowercase-doc-values
+                               :version :version-id.lowercase-doc-values
+                               :version-id :version-id.lowercase-doc-values
+                               :day-night :day-night-doc-values
+                               :cloud-cover :cloud-cover-doc-values})
       default-mappings)))

 (defmethod q2e/concept-type->sub-sort-fields :collection


Rename arg

Rename arg

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -252,7 +252,7 @@
                      (= pred (second %))))
        first))

-(defn ^:private no-method [_spec-name val path problem]
+(defn ^:private no-method [_spec-name form path problem]
   (let [sp (s/spec (last (:expound/via problem)))
         {:keys [mm retag]} (multi-spec-parts
                             (multi-spec (:pred problem) sp))]
@@ -262,11 +262,11 @@
  Dispatch value:        `%s`"
      (pr-str mm)
      (pr-str retag)
-     (pr-str (if retag (retag (paths/value-in val path)) nil)))))
-
-(defmulti ^:no-doc problem-group-str (fn [type _spec-name _val _path _problems _opts] type))
-(defmulti ^:no-doc expected-str (fn [type  _spec-name _val _path _problems _opts] type))
-(defmulti ^:no-doc value-str (fn [type _spec-name _val _path _problems _opts] type))
+     (pr-str (if retag (retag (paths/value-in form path)) nil)))))
+
+(defmulti ^:no-doc problem-group-str (fn [type _spec-name _form _path _problems _opts] type))
+(defmulti ^:no-doc expected-str (fn [type  _spec-name _form _path _problems _opts] type))
+(defmulti ^:no-doc value-str (fn [type _spec-name _form _path _problems _opts] type))

 (defn ^:private expected-str* [spec-name problems opts]
   (let [problem (first problems)
@@ -280,10 +280,9 @@
         type (:expound.spec.problem/type problem)]
     (value-str type spec-name form in problems opts)))

-;; TODO - rename 'problem-val'
-(defn conformed-value [problems problem-val]
+(defn conformed-value [problems invalid-value]
   (let [conformed-val (-> problems first :val)]
-    (if (= conformed-val problem-val)
+    (if (= conformed-val invalid-value)
       ""
       (printer/format
        "\n\nwhen conformed as\n\n%s"
@@ -291,33 +290,26 @@

 ;; FIXME - when I decide to break compatibility for value-str-fn, maybe
 ;; make it show conform/unformed value
-;; TODO - rename
-
-
-(defn ^:private value-and-conformed-value [problems spec-name val path opts]
+(defn ^:private value-and-conformed-value [problems spec-name form path opts]
   (let [{:keys [show-conformed?]} opts
-        ;; TODO - rename
-        problem-val (if (nil? path)
+        invalid-value (if (nil? path)
                       ;; This isn't used by default
                       ;; because value-in-context will look at
                       ;; path and only print form, but anyone
                       ;; who provides their own *value-str-fn*
                       ;; could use this
-                      ::no-value-found
-                      ;; TODO - maybe this problem val should be annotated to problem so we don't
-                      ;; need to check path at this level
-                      (paths/value-in val path))]
-
+                        ::no-value-found
+                        (paths/value-in form path))]
     (printer/format
      "%s%s"
-     (*value-str-fn* spec-name val path
-                     problem-val)
+     (*value-str-fn* spec-name form path invalid-value)
      (if show-conformed?
-       (conformed-value problems problem-val)
+       (conformed-value problems invalid-value)
        ""))))

-(defmethod value-str :default [_type spec-name val path problems opts]
-  (show-spec-name spec-name (value-and-conformed-value problems spec-name val path {:show-conformed? true})))
+;; TODO - rename val -> form
+(defmethod value-str :default [_type spec-name form path problems opts]
+  (show-spec-name spec-name (value-and-conformed-value problems spec-name form path {:show-conformed? true})))

 (defn ^:private explain-missing-keys [problems]
   (let [missing-keys (map #(printer/missing-key (:pred %)) problems)]
@@ -341,7 +333,7 @@
    (value-str type spec-name form in problems opts)
    expected))

-(defmethod expected-str :expound.problem-group/one-value [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem-group/one-value [_type spec-name form path problems opts]
   (let [problem (first problems)
         subproblems (:problems problem)
         grouped-subproblems (vals (group-by :expound.spec.problem/type subproblems))]
@@ -349,7 +341,7 @@
      "\n\nor\n\n"
      (map #(expected-str* spec-name % opts) grouped-subproblems))))

-(defmethod value-str :expound.problem-group/one-value [type spec-name val path problems opts]
+(defmethod value-str :expound.problem-group/one-value [type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)
         subproblems (:problems problem)]
@@ -362,7 +354,7 @@

     "Spec failed"))

-(defmethod problem-group-str :expound.problem-group/one-value [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem-group/one-value [type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)
         subproblems (:problems problem)
@@ -374,9 +366,9 @@
                 in
                 problems
                 opts
-                (expected-str type spec-name val path problems opts))))
-
-(defmethod expected-str :expound.problem-group/many-values [type spec-name val path problems opts]
+                (expected-str type spec-name form path problems opts))))
+
+(defmethod expected-str :expound.problem-group/many-values [type spec-name form path problems opts]
   (let [subproblems (:problems (first problems))]
     (string/join
      "\n\nor value\n\n"
@@ -386,28 +378,28 @@
         (value-str* spec-name [problem] opts)
         (expected-str* spec-name [problem] opts))))))

-(defmethod problem-group-str :expound.problem-group/many-values [_type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem-group/many-values [_type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (printer/format
    "%s\n\n%s"
    (header-label "Spec failed")
-   (expected-str _type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/missing-key [_type spec-name val path problems opts]
+   (expected-str _type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/missing-key [_type spec-name _form path problems opts]
   (explain-missing-keys problems))

-(defmethod problem-group-str :expound.problem/missing-key [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/missing-key [type spec-name form path problems opts]
   (assert (apply = (map :val problems)) (str util/assert-message ": All values should be the same, but they are " problems))
   (format-err "Spec failed"
               type
               spec-name
-              val
+              form
               path
               problems
               opts
-              (expected-str type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/not-in-set [_type _spec-name _val _path problems _opts]
+              (expected-str type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/not-in-set [_type _spec-name _form _path problems _opts]
   (let [combined-set (apply set/union (map :pred problems))]
     (printer/format
      "should be%s: %s"
@@ -419,36 +411,36 @@
                       (string/join ", "))
                  :good))))

-(defmethod problem-group-str :expound.problem/not-in-set [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/not-in-set [type spec-name form path problems opts]
   (assert (apply = (map :val problems)) (str util/assert-message ": All values should be the same, but they are " problems))
   (format-err "Spec failed"
               type
               spec-name
-              val
+              form
               path
               problems
               opts
-              (expected-str type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/missing-spec [_type spec-name val path problems opts]
+              (expected-str type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/missing-spec [_type spec-name form path problems opts]
   (str "with\n\n"
        (->> problems
-            (map #(no-method spec-name val path %))
+            (map #(no-method spec-name form path %))
             (string/join "\n\nor with\n\n"))))

-(defmethod value-str :expound.problem/missing-spec [_type spec-name val path problems opts]
+(defmethod value-str :expound.problem/missing-spec [_type spec-name form path problems opts]
   (printer/format
    "Cannot find spec for

 %s"
-   (show-spec-name spec-name (*value-str-fn* spec-name val path (paths/value-in val path)))))
-
-(defmethod problem-group-str :expound.problem/missing-spec [type spec-name val path problems opts]
+   (show-spec-name spec-name (*value-str-fn* spec-name form path (paths/value-in form path)))))
+
+(defmethod problem-group-str :expound.problem/missing-spec [type spec-name form path problems opts]
   (printer/format
    "%s\n\n%s\n\n%s"
    (header-label "Missing spec")
-   (value-str type spec-name val path problems opts)
-   (expected-str type spec-name val path problems opts)))
+   (value-str type spec-name form path problems opts)
+   (expected-str type spec-name form path problems opts)))

 (defn ^:private lcs* [[x & xs] [y & ys]]
   (cond
@@ -530,7 +522,7 @@
           [])
          lift-singleton-groups)))

-(defmethod expected-str :expound.problem/insufficient-input [_type spec-name val path problems opts]
+(defmethod expected-str :expound.problem/insufficient-input [_type spec-name form path problems opts]
   (let [problem (first problems)]
     (printer/format
      "should have additional elements. The next element%s %s"
@@ -547,31 +539,31 @@
                     (let [in (-> prob :expound/in)]
                       (expected-str (-> prob :expound.spec.problem/type) :expound/no-spec-name non-matching-value in [prob] opts))))))))

-(defmethod problem-group-str :expound.problem/insufficient-input [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/insufficient-input [type spec-name form path problems opts]
   (format-err "Syntax error"
               type
               spec-name
-              val
+              form
               path
               problems
               opts
-              (expected-str type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/extra-input [_type spec-name val path problems opts]
+              (expected-str type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/extra-input [_type spec-name form path problems opts]
   (s/assert ::singleton problems)
   "has extra input")

-(defmethod problem-group-str :expound.problem/extra-input [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/extra-input [type spec-name form path problems opts]
   (format-err "Syntax error"
               type
               spec-name
-              val
+              form
               path
               problems
               opts
-              (expected-str type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/fspec-exception-failure [_type spec-name val path problems opts]
+              (expected-str type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/fspec-exception-failure [_type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -587,18 +579,18 @@
                        (pr-str (:reason problem))))
      (printer/indent (string/join ", " (:val problem))))))

-(defmethod problem-group-str :expound.problem/fspec-exception-failure [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/fspec-exception-failure [type spec-name form path problems opts]
   (format-err
    "Exception"
    type
    spec-name
-   val
+   form
    path
    problems
    opts
-   (expected-str type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/fspec-ret-failure [_type spec-name val path problems opts]
+   (expected-str type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/fspec-ret-failure [_type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -606,33 +598,33 @@
      (ansi/color (printer/indent (pr-str (:val problem))) :bad-value)
      (predicate-errors problems))))

-(defmethod problem-group-str :expound.problem/fspec-ret-failure [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/fspec-ret-failure [type spec-name form path problems opts]
   (format-err
    "Function spec failed"
    type
    spec-name
-   val
+   form
    path
    problems
    opts
-   (expected-str type spec-name val path problems opts)))
-
-(defmethod value-str :expound.problem/insufficient-input [_type spec-name val path problems opts]
-  (show-spec-name spec-name (value-and-conformed-value problems spec-name val path {:show-conformed? false})))
-
-(defmethod value-str :expound.problem/extra-input [_type spec-name val path problems opts]
-  (show-spec-name spec-name (value-and-conformed-value problems spec-name val path {:show-conformed? false})))
-
-(defmethod value-str :expound.problem/fspec-fn-failure [_type spec-name val path problems opts]
-  (show-spec-name spec-name (value-and-conformed-value problems spec-name val path {:show-conformed? false})))
-
-(defmethod value-str :expound.problem/fspec-exception-failure [_type spec-name val path problems opts]
-  (show-spec-name spec-name (value-and-conformed-value problems spec-name val path {:show-conformed? false})))
-
-(defmethod value-str :expound.problem/fspec-ret-failure [_type spec-name val path problems opts]
-  (show-spec-name spec-name (value-and-conformed-value problems spec-name val path {:show-conformed? false})))
-
-(defmethod expected-str :expound.problem/fspec-fn-failure [_type spec-name val path problems opts]
+   (expected-str type spec-name form path problems opts)))
+
+(defmethod value-str :expound.problem/insufficient-input [_type spec-name form path problems opts]
+  (show-spec-name spec-name (value-and-conformed-value problems spec-name form path {:show-conformed? false})))
+
+(defmethod value-str :expound.problem/extra-input [_type spec-name form path problems opts]
+  (show-spec-name spec-name (value-and-conformed-value problems spec-name form path {:show-conformed? false})))
+
+(defmethod value-str :expound.problem/fspec-fn-failure [_type spec-name form path problems opts]
+  (show-spec-name spec-name (value-and-conformed-value problems spec-name form path {:show-conformed? false})))
+
+(defmethod value-str :expound.problem/fspec-exception-failure [_type spec-name form path problems opts]
+  (show-spec-name spec-name (value-and-conformed-value problems spec-name form path {:show-conformed? false})))
+
+(defmethod value-str :expound.problem/fspec-ret-failure [_type spec-name form path problems opts]
+  (show-spec-name spec-name (value-and-conformed-value problems spec-name form path {:show-conformed? false})))
+
+(defmethod expected-str :expound.problem/fspec-fn-failure [_type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -646,19 +638,19 @@
      (printer/indent (ansi/color (pr-str (:val problem)) :bad-value))
      (printer/indent (ansi/color (pr-pred (:pred problem) (:spec problem)) :good-pred)))))

-(defmethod problem-group-str :expound.problem/fspec-fn-failure [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/fspec-fn-failure [type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (format-err
    "Function spec failed"
    type
    spec-name
-   val
+   form
    path
    problems
    opts
-   (expected-str type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/check-fn-failure [_type spec-name val path problems opts]
+   (expected-str type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/check-fn-failure [_type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
     (printer/format
@@ -672,18 +664,18 @@
      (printer/indent (ansi/color (pr-str (:val problem)) :bad-value))
      (printer/indent (ansi/color (pr-pred (:pred problem) (:spec problem)) :good-pred)))))

-(defmethod problem-group-str :expound.problem/check-fn-failure [_type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/check-fn-failure [_type spec-name form path problems opts]
   (s/assert ::singleton problems)
   (printer/format
    format-str
    (header-label "Function spec failed")
    (ansi/color (printer/indent (pr-str (:expound/check-fn-call (first problems)))) :bad-value)
-   (expected-str _type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/check-ret-failure [_type spec-name val path problems opts]
+   (expected-str _type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/check-ret-failure [_type spec-name form path problems opts]
   (predicate-errors problems))

-(defmethod problem-group-str :expound.problem/check-ret-failure [_type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/check-ret-failure [_type spec-name form path problems opts]
   (printer/format
    "%s

@@ -698,23 +690,23 @@

    (ansi/color (printer/indent (pr-str (:expound/check-fn-call (first problems)))) :bad-value)

-   (*value-str-fn* spec-name val path (paths/value-in val path))
-   (expected-str _type spec-name val path problems opts)))
-
-(defmethod expected-str :expound.problem/unknown [_type spec-name val path problems opts]
+   (*value-str-fn* spec-name form path (paths/value-in form path))
+   (expected-str _type spec-name form path problems opts)))
+
+(defmethod expected-str :expound.problem/unknown [_type spec-name form path problems opts]
   (predicate-errors problems))

-(defmethod problem-group-str :expound.problem/unknown [type spec-name val path problems opts]
+(defmethod problem-group-str :expound.problem/unknown [type spec-name form path problems opts]
   (assert (apply = (map :val problems)) (str util/assert-message ": All values should be the same, but they are " problems))
   (format-err
    "Spec failed"
    type
    spec-name
-   val
+   form
    path
    problems
    opts
-   (expected-str type spec-name val path problems opts)))
+   (expected-str type spec-name form path problems opts)))

 (defn ^:private instrumentation-info [failure caller]
   ;; As of version 1.9.562, Clojurescript does


Removes deleted code

Removes deleted code

--- src/expound/paths.cljc
+++ src/expound/paths.cljc
@@ -131,16 +131,12 @@

         ;; detect a `:in` path that points at a key in a map-of spec
         (and (map? form)
-             (= 0 idx)
-             #_(not (and (associative? (get form k ::not-found))
-                         (contains? (get form k ::not-found) idx))))
+             (= 0 idx))
         (in-with-kps* k val rst2 (conj in' (->KeyPathSegment k)))

         ;; detect a `:in` path that points at a value in a map-of spec
         (and (map? form)
-             (= 1 idx)
-             #_(not (and (associative? (get form k ::not-found))
-                         (contains? (get form k ::not-found) idx))))
+             (= 1 idx))
         (in-with-kps* (get form k ::not-found) val rst2 (conj in' k))

         :else


Modal quickfix

Modal quickfix

Revert recent changes while we try to figure out what's wrong with
modals closing instantly.

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -637,8 +637,7 @@
         click-fn #(let [{{:keys [title data]} :selected-node} @current-state
                         display-data (or data (filler/data-for-title title))]
                     (detail/show-modal modal-selector display-data))]
-    (.on detail-button "mouseup" click-fn)
-    (.on detail-button "touchend" click-fn)))
+    (.on detail-button "click" click-fn)))

 ;; Exported function to do magic


have to pass through actual ns now

have to pass through actual ns now

--- sidecar/src/figwheel_sidecar/core.clj
+++ sidecar/src/figwheel_sidecar/core.clj
@@ -274,7 +274,7 @@
   ;; are made explicitely
   ([state old-mtimes new-mtimes additional-ns]
      (notify-cljs-ns-changes state
-      (set (concat (map name additional-ns)
+      (set (concat additional-ns
               (keep get-ns-from-source-file-path
                     (:cljs (get-changed-source-file-paths old-mtimes new-mtimes))))))))


stack traces now print path to actual source file

--- sidecar/src/figwheel_sidecar/repl.clj
+++ sidecar/src/figwheel_sidecar/repl.clj
@@ -113,7 +113,12 @@
   (-tear-down [_] true)
   cljs.repl/IParseStacktrace
   (-parse-stacktrace [repl-env stacktrace error build-options]
-    (handle-stack-trace (:base-path error) (:stacktrace error))))
+    (handle-stack-trace (:base-path error) (:stacktrace error)))
+  cljs.repl/IPrintStacktrace
+  (-print-stacktrace [repl-env stacktrace error build-options]
+    (doseq [{:keys [function file url line column]}
+              (cljs.repl/mapped-stacktrace stacktrace build-options)]
+      (println "\t" (str function " (" (str (or url file)) ":" line ":" column ")")))))

 (defn repl-env
   ([figwheel-server {:keys [id build-options] :as build}]


Add current version to main view

Add current version to main view

--- src/discuss/views.cljs
+++ src/discuss/views.cljs
@@ -117,7 +117,8 @@
                                :data-target   (str "#" (lib/prefix-name "dialog-collapse"))
                                :aria-expanded "true"
                                :aria-controls (lib/prefix-name "dialog-collapse")}
-                title]]
+                title
+                [:small " " (lib/project-version)]]]
               [:br]
               (view-dispatcher-next (om/props this))
               (when add?


log incoming messages from bots

log incoming messages from bots

--- src/braid/server/routes/bots.clj
+++ src/braid/server/routes/bots.clj
@@ -73,6 +73,7 @@
       (if (schema/new-message-valid? msg)
         (if (bot-can-message? bot-id msg)
           (do
+            (timbre/debugf "Creating message from bot: %s %s" bot-id msg)
             (db/create-message! msg)
             (sync/broadcast-thread (msg :thread-id) [])
             {:status 201


Implement gtm instructions

Implement gtm instructions

--- src/clojush/instructions/gtm.clj
+++ src/clojush/instructions/gtm.clj
@@ -1,7 +1,257 @@
 (ns clojush.instructions.gtm
-  (:use [clojush pushstate globals args random]
-        clojush.instructions.common
-        clojush.pushgp.genetic-operators))
-
-
-
+  (:use [clojush pushstate globals args random util])
+  (:require [clojure.math.numeric-tower :as math]))
+
+;; All GTM instructions are no-ops on Push states that lack a GTM.
+
+;; Instructions that read from a tape are no-ops if the head is over a blank.
+
+;; Instructions that write to a tape create an instruction-map (gene) under
+;; the head if none existed previously, with default instruction exec_noop,
+;; silent false, and close 0.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gtm (genetic turing machine) utilities
+
+(defn init-gtm
+  "Returns the provided Push state, but with a fresh GTM that has been initialized with
+  the given number of empty tapes."
+  [push-state num-tapes]
+  (assoc push-state
+    :gtm
+    {:primary 0
+     :secondary 0
+     :tapes (vec (repeat num-tapes {:position 0 :contents (sorted-map)}))
+     :trace []}))
+
+(defn load-tape
+  "Returns the provided Push state but with the indicated tape in its GTM initialized
+  to contain the provided genome."
+  [push-state tape-index genome]
+  (assoc-in push-state
+            [:gtm :tapes tape-index :contents]
+            (into (sorted-map)
+                  (zipmap (iterate inc 0)
+                          genome))))
+
+(defn dump-tape
+  "Returns the genome recorded on the specified tape in the GTM of the provided Push state."
+  [push-state tape-index]
+  (vec (vals (:contents (get (:tapes (:gtm push-state)) tape-index)))))
+
+(defn ensure-instruction-map
+  "If instr-map is a hash map, returns it unchanged; otherwise returns a default
+  instruction map."
+  [instr-map]
+  (if (map? instr-map)
+    instr-map
+    {:instruction 'exec_noop
+     :close 0
+     :silent false
+     :random-insertion false
+     :uuid (java.util.UUID/randomUUID)}))
+
+(defn trace
+  "Returns push-state with trace-info added to the trace recorded in its GTM."
+  [trace-info push-state]
+  (update-in push-state [:gtm :trace] conj trace-info))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; gtm (genetic turing machine) instructions
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Instructions for moving GTM control from tape to tape. There is always a "primary"
+;; tape, to which most other instructions refer implicitly. When the primary tape is
+;; changed, the prior primary is remembered as the "secondary" tape; the gtm_copy
+;; refers to both, copying an item from the secondary to the primary.
+
+(define-registered ;; set primary to tape0, secondary to prior primary
+  gtm_tape0
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_tape0
+             (-> state
+                 (assoc-in [:gtm :secondary] (:primary (:gtm state)))
+                 (assoc-in [:gtm :primary 0])))
+      state)))
+
+(define-registered ;; set primary to tape1, secondary to prior primary
+  gtm_tape1
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_tape1
+             (-> state
+                 (assoc-in [:gtm :secondary] (:primary (:gtm state)))
+                 (assoc-in [:gtm :primary 1])))
+      state)))
+
+(define-registered ;; set primary to tape2, secondary to prior primary
+  gtm_tape2
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_tape2
+             (-> state
+                 (assoc-in [:gtm :secondary] (:primary (:gtm state)))
+                 (assoc-in [:gtm :primary 2])))
+      state)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Instructions for moving the read/write head on the primary tape.
+
+(define-registered ;; move head on primary tape to the left
+  gtm_left
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_left
+             (update-in state [:gtm :tapes (:primary (:gtm state)) :position] dec))
+      state)))
+
+(define-registered ;; move head on primary tape to the right
+  gtm_right
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (trace 'gtm_right
+             (update-in state [:gtm :tapes (:primary (:gtm state)) :position] inc))
+      state)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Instructions for reading/writing to tapes.
+
+(define-registered ;; copy from secondary to primary
+  gtm_copy
+  ^{:stack-types [:gtm]}
+  (fn [state]
+    (if (:gtm state)
+      (let [primary (:primary (:gtm state))
+            primary-tape (get (:tapes (:gtm state)) primary)
+            primary-position (:position primary-tape)
+            secondary (:secondary (:gtm state))
+            secondary-tape (get (:tapes (:gtm state)) secondary)
+            secondary-position (:position secondary-tape)
+            secondary-instr-map (get (:contents secondary-tape) secondary-position)]
+        (if secondary-instr-map
+          (trace 'gtm_copy
+                 (assoc-in state [:gtm :tapes primary :contents primary-position]
+                           secondary-instr-map))
+          state))
+      state)))
+
+(define-registered ;; push primary tape's instruction to code stack
+  gtm_instruction
+  ^{:stack-types [:gtm :code]}
+  (fn [state]
+    (if (:gtm state)
+      (let [primary-tape (get (:tapes (:gtm state)) (:primary (:gtm state)))
+            instr-map (get (:contents primary-tape) (:position primary-tape))]
+        (if instr-map
+          (trace 'gtm_instruction
+                 (push-item (:instruction instr-map) :code state))
+          state))
+      state)))
+
+(define-registered ;; set instruction to first of flattened top of code stack
+  gtm_set_instruction
+  ^{:stack-types [:gtm :code]}
+  (fn [state]
+    (if (and (:gtm state)
+             (not (empty? (:code state)))
+             (not (empty? (ensure-list (stack-ref :code 0 state)))))
+      (let [primary (:primary (:gtm state))
+            primary-tape (get (:tapes (:gtm state)) primary)
+            primary-position (:position primary-tape)
+            primary-contents (:contents primary-tape)
+            primary-instr-map (ensure-instruction-map
+                                (get primary-contents primary-position))
+            new-instr (first (flatten (ensure-list (stack-ref :code 0 state))))]
+        (trace 'gtm_set_instruction
+               (assoc-in (pop-item :code state)
+                         [:gtm :tapes primary :contents primary-position]
+                         (assoc primary-instr-map :instruction new-instr))))
+      state)))
+
+(define-registered ;; push primary tape's silent marker to boolean stack
+  gtm_silent
+  ^{:stack-types [:gtm :boolean]}
+  (fn [state]
+    (if (:gtm state)
+      (let [primary (:primary (:gtm state))
+            primary-tape (get (:tapes (:gtm state)) primary)
+            instr-map (get (:contents primary-tape) (:position primary-tape))]
+        (if instr-map
+          (trace 'gtm_silent
+                 (push-item (:silent instr-map) :boolean state))
+          state))
+      state)))
+
+(define-registered ;; set silent to top of boolean stack
+  gtm_set_silent
+  ^{:stack-types [:gtm :boolean]}
+  (fn [state]
+    (if (and (:gtm state)
+             (not (empty? (:boolean state))))
+      (let [primary (:primary (:gtm state))
+            primary-tape (get (:tapes (:gtm state)) primary)
+            primary-position (:position primary-tape)
+            primary-contents (:contents primary-tape)
+            primary-instr-map (ensure-instruction-map
+                                (get primary-contents primary-position))
+            new-silent (stack-ref :boolean 0 state)]
+        (trace 'gtm_set_silent
+               (assoc-in (pop-item :boolean state)
+                         [:gtm :tapes primary :contents primary-position]
+                         (assoc primary-instr-map :silent new-silent))))
+      state)))
+
+(define-registered ;; push primary tape's close marker to integer stack
+  gtm_close
+  ^{:stack-types [:gtm :integer]}
+  (fn [state]
+    (if (:gtm state)
+      (let [primary (:primary (:gtm state))
+            primary-tape (get (:tapes (:gtm state)) primary)
+            instr-map (get (:contents primary-tape) (:position primary-tape))]
+        (if instr-map
+          (trace 'gtm_close
+                 (push-item (:close instr-map) :integer state))
+          state))
+      state)))
+
+(define-registered ;; set close to abs value of top of integer stack
+  gtm_set_close
+  ^{:stack-types [:gtm :integer]}
+  (fn [state]
+    (if (and (:gtm state)
+             (not (empty? (:integer state))))
+      (let [primary (:primary (:gtm state))
+            primary-tape (get (:tapes (:gtm state)) primary)
+            primary-position (:position primary-tape)
+            primary-contents (:contents primary-tape)
+            primary-instr-map (ensure-instruction-map
+                                (get primary-contents primary-position))
+            new-close (math/abs (stack-ref :integer 0 state))]
+        (trace 'gtm_set_close
+               (assoc-in (pop-item :integer state)
+                         [:gtm :tapes primary :contents primary-position]
+                         (assoc primary-instr-map :close new-close))))
+      state)))
+
+;; some tests
+
+(let [genome (random-plush-genome 10 [1 'exec_noop 'integer_add]
+                                  {:epigenetic-markers [:close :silent]})]
+  (println "Before:" genome)
+  (println "After loading and dumping:"
+           (dump-tape (load-tape (init-gtm (make-push-state) 3)
+                                 1
+                                 genome)
+                      1)))
+


Fix case where non-qualified projects are dropped from the list.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -612,12 +612,15 @@

 (defn fold-args-as-meta
   [adeps]
+  ;; TODO better handle malformed commandlines for error reporting
   (loop [deps [] [fdep & rdeps] adeps]
-    (if (seq rdeps)
-      (if (map? fdep)
-        (let [[ndep & rdeps] rdeps]
-          (recur (conj deps (with-meta ndep fdep)) rdeps))
-        (recur (conj deps fdep) rdeps))
+    (if fdep
+      (if (seq rdeps)
+        (if (map? fdep)
+          (let [[ndep & rdeps] rdeps]
+            (recur (conj deps (with-meta ndep fdep)) rdeps))
+          (recur (conj deps fdep) rdeps))
+        (conj deps fdep))
       deps)))

 (defn box-add


Adding sha-bitmap (shabam) support.

Adding sha-bitmap (shabam) support.

This structure allows for fast ancestry checking via bitmaps, indexed
by enumerated shas.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -17,7 +17,7 @@
             [org.satta.glob :refer [glob]]
             [robert.hooke :as hooke])
   (:import [clojure.lang #_IPersistentVector Seqable]
-           [java.util Date]
+           [java.util Date Arrays]
            [java.lang.reflect Array]
            [java.io File FileInputStream FileOutputStream OutputStreamWriter
             Closeable]
@@ -1154,6 +1154,84 @@
        (~@run-mode ~rfresh
                    ~@body))))

+;; ===== ancestry sha-bitmap (shabam) =====
+
+(def ^Long bits-per-byte 8)
+(def ^Long bytes-per-long 8)
+(def ^Long bits-per-long (* bits-per-byte bytes-per-long))
+
+(defn ^Long bm-longs [bits]
+  (long (Math/ceil (/ bits bits-per-long))))
+
+(defn ^"[J" bm-new []
+  (long-array 1))
+
+(defn ^"[J" bm-set
+  [^"[J" bm idx]
+  (let [size (max (count bm) (bm-longs idx))
+        nbm (Arrays/copyOf bm ^Long size)
+        w (quot idx bits-per-long)
+        o (mod idx bits-per-long)
+        m (bit-set 0 o)
+        v (aget nbm w)
+        nv (bit-or v ^Long m)]
+    (aset nbm w nv)
+    nbm))
+
+(defn ^Long bm-get
+  [^"[J" bm idx]
+  (when (<= (bm-longs idx) (count bm))
+    (let [w (quot idx bits-per-long)
+          o (mod idx bits-per-long)
+          m (bit-set 0 o)
+          v (aget bm w)
+          mv (bit-and v m)]
+      (pos? mv))))
+
+(defn ^"[J" bm-or
+  [& bms]
+  (if (empty? bms)
+    (bm-new)
+    (let [size (apply max (map count bms))
+          nbm (Arrays/copyOf ^"[J" (first bms) ^Long size)]
+      (doseq [bm (rest bms)
+              [i v] (map-indexed list bm)
+              :let [mv (bit-or v (aget nbm i))]]
+        (aset nbm i mv))
+      nbm)))
+
+(defn shabam-new []
+  {:sha->idx {} :bitmaps []})
+
+(defn shabam-add [shabam sha & parents]
+  (if (-> shabam :sha->idx (contains? sha))
+    shabam
+    (let [{:keys [sha->idx bitmaps]} shabam
+          nid (count sha->idx)
+          sha->idx (assoc sha->idx sha nid)
+          pidxs (map sha->idx parents)
+          nbm (if (empty? pidxs)
+                (bm-new)
+                (apply bm-or (map bitmaps pidxs)))
+          nbm (reduce bm-set nbm pidxs)
+          bitmaps (conj bitmaps nbm)]
+      {:sha->idx sha->idx
+       :bitmaps bitmaps})))
+
+(defn sha-ancestors [shabam child ancs]
+  (let [{:keys [sha->idx bitmaps]} shabam
+        cidx (sha->idx child)]
+    (filter #(bm-get (get bitmaps cidx)
+                     (sha->idx %))
+            ancs)))
+
+(defn sha-successors [shabam parent succ]
+  (let [{:keys [sha->idx bitmaps]} shabam
+        pidx (sha->idx parent)]
+    (filter #(bm-get (get bitmaps (sha->idx %))
+                     pidx)
+            succ)))
+
 ;; ===== relational queries =====

 #_


Revert part of c51fe50 that broke freshen

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -491,7 +491,7 @@
                   dep)
             1 (do
                 (assert (contains? #{nil :ok} (:verify (first infos))))
-                (assoc dep 1 (first infos)))
+                (assoc dep 1 (key (first groups))))
             (do (print "\nMultiple bump resolutions for:"
                        prj (pr-str voom-meta))
                 (print-repo-infos (map #(first (val %)) groups))


Wait for Callback to Complete

Wait for Callback to Complete

It is important to wait for the callback to complete in order to avoid
unbounded parallelism.

--- src/lens/event_bus.clj
+++ src/lens/event_bus.clj
@@ -98,7 +98,7 @@
       (let [[{:keys [msg]} port] (async/alts! ports)]
         (when msg
           (condp = port
-            ch (do (callback res msg) (recur res [ch reset-ch]))
+            ch (do (<! (callback res msg)) (recur res [ch reset-ch]))
             reset-ch (recur nil [res-ch])
             res-ch (recur msg [ch reset-ch])))))
     #(do


fix regexp

fix regexp

--- src/example/verbs.cljc
+++ src/example/verbs.cljc
@@ -18,6 +18,6 @@

 (def verb-map (-> default-map ;; support all the default verbs
                   (add-verb ["^yell$" "^scream$"] yell) ;; supoprt synonyms
-                  (add-verb ["^move (.*)" "^move$"] move) ;; need the (?<item>.*) bit for autocompletion
-                  (add-verb ["^pull (.*)" "^pull$"] pull)  ;; need the no item version for the "pull what?" response
-                  (add-verb ["^push (.*)" "^push$"] push)))
+                  (add-verb ["^move (?<item>.*)" "^move$"] move) ;; need the (?<item>.*) bit for autocompletion
+                  (add-verb ["^pull (?<item>.*)" "^pull$"] pull)  ;; need the no item version for the "pull what?" response
+                  (add-verb ["^push (?<item>.*)" "^push$"] push)))


Double this timeout to see if it robustifies the test.

--- web/test-integration/immutant/web/integ_test.clj
+++ web/test-integration/immutant/web/integ_test.clj
@@ -198,7 +198,7 @@
                                      (when (= client-count (count @results))
                                        (deliver done? true))))]
           (swap! clients conj client))))
-    (is (deref done? 5000 nil))
+    (is (deref done? 10000 nil))
     (println "RESULTS" @results)
     (is (= (->> client-count (range 0) (map str) set)
           (set @results)))


Remove unused NS

Remove unused NS

Former-commit-id: 931d37a6c101e2738ac2f9660eace4159584fc9a

--- planck-cljs/src/planck/stacktrace.cljs
+++ planck-cljs/src/planck/stacktrace.cljs
@@ -1,55 +0,0 @@
-(ns planck.stacktrace
-  (:require [clojure.string :as string]))
-
-(defn source-uri->relative-path
-  "Takes a source URI and returns a relative path value suitable for inclusion
-  in a canonical stack frame."
-  [source-uri]
-  {:pre [(string? source-uri)]}
-  (let [c (count "file:///")]
-    (if (and (> (count source-uri) c)
-          (= "file:///" (subs source-uri 0 c)))
-      (subs source-uri c)
-      (str "<" source-uri ">"))))
-
-(defn stack-line->canonical-frame
-  "Parses a stack line into a frame representation, returning nil
-  if parse failed."
-  [stack-line]
-  {:pre  [(string? stack-line)]}
-  (let [[function source-uri line column]
-        (rest (re-matches #"(.*)@(.*):([0-9]+):([0-9]+)"
-                stack-line))]
-    (if (and source-uri function line column)
-      {:file     (source-uri->relative-path source-uri)
-       :function function
-       :line     (js/parseInt line)
-       :column   (js/parseInt column)}
-      (let [[source-uri line column]
-            (rest (re-matches #"(.*):([0-9]+):([0-9]+)"
-                    stack-line))]
-        (if (and source-uri line column)
-          {:file     (source-uri->relative-path source-uri)
-           :function nil
-           :line     (js/parseInt line)
-           :column   (js/parseInt column)}
-          (when-not (string/blank? stack-line)
-            {:file     nil
-             :function (string/trim stack-line)
-             :line     nil
-             :column   nil}))))))
-
-(defn raw-stacktrace->canonical-stacktrace
-  "Parse a raw JSC stack representation, parsing it into stack frames.
-  The canonical stacktrace must be a vector of maps of the form
-  {:file <string> :function <string> :line <integer> :column <integer>}."
-  [raw-stacktrace opts]
-  {:pre  [(string? raw-stacktrace) (map? opts)]
-   :post [(vector? %)]}
-  (let [stack-line->canonical-frame (memoize stack-line->canonical-frame)]
-    (->> raw-stacktrace
-      string/split-lines
-      (map stack-line->canonical-frame)
-      (remove nil?)
-      vec)))
-


Fix num-bins. Take 2.

Fix num-bins. Take 2.

--- src/forecast/parse.clj
+++ src/forecast/parse.clj
@@ -123,8 +123,8 @@
       (use-live))

     ;; load logfile
-    (when-not (and process? (first params) (= \- (-> params first first)))
-      (println "load file")
+    (when (and process? (not (= \- (-> params first first))))
+      (println "load file " (first params))
       (parse-logfile (first params) log-parser))

     ;; post processing


fixed playlist order on hotjoin

fixed playlist order on hotjoin

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -121,6 +121,9 @@
       (println (str "Num of file downloads: " (:num-of-downloads @app-state))))
     (println "WARNING: Attempted to request download that has already been requested")))

+(defn indices [pred coll]
+  (keep-indexed #(when (pred %2) %1) coll))
+
 ; TODO: reimplement this
 (defn get-next-track-to-download []
   nil)
@@ -136,9 +139,6 @@

 (defn resume []
   (.emit socket "resume"))
-
-(defn indices [pred coll]
-  (keep-indexed #(when (pred %2) %1) coll))

 (defn get-current-track-num []
   (first (indices #(= (.-id %1) (:current-track-id @app-state))
@@ -259,12 +259,15 @@

 (.on socket "hotjoin-music-info"
   (fn [room-music-info track-order current-track-id current-sound-id]
-    (let [sorted-music-info (.sort room-music-info #(- (.-tracknum %1)
-                                                       (.-tracknum %2)))]
+    (let [track-order (js->clj track-order)
+          sorted-music-info (.sort room-music-info (fn [a b]
+                                                     (- (indices #(= %1 (.-id a)) track-order)
+                                                        (indices #(= %1 (.-id b)) track-order))))]
+
+      (swap! app-state assoc :track-order track-order)
       (swap! app-state assoc :music-info (vec (map #(clj->js %1)
                                                 (js->clj sorted-music-info)))))

-    (swap! app-state assoc :track-order track-order)
     (swap! app-state assoc :current-track-id current-track-id)
     (swap! app-state assoc :current-sound-id current-sound-id)


clear track now destroys current track

clear track now destroys current track

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -275,5 +275,8 @@

 (.on socket "clear-songs"
   (fn []
+    (player/destroy-track (:current-sound-id @app-state))
     (swap! app-state assoc :music-info [])
-    (swap! app-state assoc :music-files {})))
+    (swap! app-state assoc :music-files {})
+    (swap! app-state assoc :current-track-id nil)
+    (swap! app-state assoc :current-sound-id nil)))


Move test's shutdown-agents to inside eval-in-project.

--- src/leiningen/test.clj
+++ src/leiningen/test.clj
@@ -20,7 +20,8 @@
                               {} '~namespaces)]
          (clojure.test/with-test-out
            (println "\n\n--------------------\nTotal:")
-           (clojure.test/report summary#)))))
+           (clojure.test/report summary#))
+         (shutdown-agents))))

 (defn test
   "Run the project's tests. Accept a list of namespaces for which to run all
@@ -29,5 +30,4 @@
   (let [namespaces (if (empty? namespaces)
                      (find-namespaces-in-dir (file (:test-path project)))
                      (map symbol namespaces))]
-    (eval-in-project project (form-for-testing-namespaces namespaces))
-    (shutdown-agents)))
+    (eval-in-project project (form-for-testing-namespaces namespaces))))


Make git error case print helpful diagnostic context.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -100,7 +100,7 @@
                        (re-seq #"(?m)^.*$" (:out rtn))))]
     (if (ok-statuses exit)
       rtn
-      (throw (ex-info "git error" rtn)))))
+      (throw (ex-info (str "git error: " (pr-str rtn)) rtn)))))

 ;; === git sha-based versions ===


add-r-commits now adds nil relation to unreadable project.clj's

Without this the missing relation was interpreted as unread project.clj,
triggering re-reading and flagging the db as dirty. It would also likely cause
problems for our core.logic queries.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -938,12 +938,6 @@
                                      %) (reverse vnums))]
     [vmajor vminor vinc vqual]))

-(defn reduce-db
-  [db coll f]
-  (if (empty? coll)
-    db
-    (reduce f (vary-meta db assoc ::dirty true) coll)))
-
 (defn add-r-commits
   [db gitdir]
   (let [old-branches (into {} (vdb/get-facts db r-branch))
@@ -1011,18 +1005,22 @@
                      (l/run* [blob-sha]
                        (l/fresh [proj-dir-sha]
                          (r-tree proj-dir-sha "project.clj" :blob blob-sha))))
-        read-blobs (vdb/get-column db r-proj 0)]
-    (reduce-db
-     db (apply disj (set proj-blobs) read-blobs)
-     (fn [db blob-sha]
-       (if-let [proj (robust-read-proj-blob gitdir blob-sha)]
-         (let [proj-name (symbol (:group proj) (:name proj))
-               has-snaps? (some #(.contains ^String % "-SNAPSHOT")
-                                (map second (:dependencies proj)))
-               [vmajor vminor vinc vqual] (sem-ver-parse (:version proj))]
-           (pldb/db-fact db r-proj blob-sha proj-name
-                         vmajor vminor vinc vqual has-snaps?))
-         db)))))
+        read-blobs (vdb/get-column db r-proj 0)
+        blobs-to-read (apply disj (set proj-blobs) read-blobs)]
+    (if (empty? blobs-to-read)
+      db
+      (reduce
+       (fn [db blob-sha]
+         (if-let [proj (robust-read-proj-blob gitdir blob-sha)]
+           (let [proj-name (symbol (:group proj) (:name proj))
+                 has-snaps? (some #(.contains ^String % "-SNAPSHOT")
+                                  (map second (:dependencies proj)))
+                 [vmajor vminor vinc vqual] (sem-ver-parse (:version proj))]
+             (pldb/db-fact db r-proj blob-sha proj-name
+                           vmajor vminor vinc vqual has-snaps?))
+           (pldb/db-fact db r-proj blob-sha nil nil nil nil nil nil)))
+       (vary-meta db assoc ::dirty true)
+       blobs-to-read))))

 (defn update-git-db
   [db gitdir]


Use char arrays and type hints

Use char arrays and type hints

--- clojure/anagrams-mutable.clj
+++ clojure/anagrams-mutable.clj
@@ -2,17 +2,17 @@
 ; Highly non-idiomatic. Should not be used. EXPERIMENTAL.
 ; Also it is ridiculously slow. Does anyone know why?

-(defn generatePermutations [a n]
+(defn generatePermutations [^chars a n]
   (if (zero? n)
-    (println (apply str a))
+    ();(println (apply str a))
     (doseq [i (range 0 (inc n))]
       (generatePermutations a (dec n))
       (let [j (if (even? n) i 0) oldn (aget a n) oldj (aget a j)]
-        (aset a n oldj) (aset a j oldn)))))
+        (aset-char a n oldj) (aset-char a j oldn)))))

 (if (not= (count *command-line-args*) 1)
   (do
     (println "Exactly one argument is required")
     (System/exit 1))
-  (let [word (-> *command-line-args* first vec to-array)]
+  (let [word (-> *command-line-args* first vec char-array)]
     (time (generatePermutations word (dec (count word))))))


Added commands for building and running go files. Also fixed issue with Notifos complaining when given a formatted string as an argument -s witched to using str and it worked again. Might just be a problem for windows machines?

--- src/lt/plugins/go.cljs
+++ src/lt/plugins/go.cljs
@@ -26,6 +26,7 @@
 ;; simple things is ridiculous.
 (def exec (.-exec (js/require "child_process")))

+
 (def client-path
   "Provides a fallback path at dev stage for plugins/*plugin-dir*, which
   returns an empty string when using LightTable UI."
@@ -151,7 +152,7 @@
                          (fn [err stdout stderr]
                            (if err
                              (println "err: " err)
-                             (println "no err"))))
+                             (println stdout))))
         ;input (.-stdin child)
         ;output (.-stdout child)
         ]
@@ -161,7 +162,7 @@
 (defn gofmt [file]
   "Performs `gofmt -w file`."
   (let [cmd (str "gofmt -w " file)]
-    (notifos/working (format "gofmt %s..." file))
+    (notifos/working (str "gofmt " file))
     (run-cmd cmd)
     (notifos/done-working "")))

@@ -169,14 +170,37 @@
 (behavior ::fmt-on-save
           :triggers #{:save}
           :reaction (fn [editor]
-                      (println "::fmt-on-save")
                       (let [path (-> @editor :info :path)]
-                        (println "file" path)
-                        (gofmt path))
-                      ;(cmd/exec! :go-fmt nil)
-                      ))
+                        (gofmt path)
+                        (pool/reload editor))))

 (cmd/command {:command ::go-fmt
               :desc "Go: fmt current file"
               :exec (fn []
                       (gofmt (cwf->path)))})
+
+;; go build
+(defn gobuild [file]
+  "Performs `go build file`."
+  (let [cmd (str "go build -o " (str (files/parent file) files/separator "main.exe" ) " " file )]
+    (notifos/working (str "go build " file))
+    (run-cmd cmd)
+    (notifos/done-working "")))
+
+(cmd/command {:command ::go-build
+              :desc "Go: Build current file"
+              :exec (fn []
+                      (gobuild (cwf->path)))})
+
+;; go run
+(defn gorun [file]
+  "Performs `go run file`."
+  (let [cmd (str "go run " file )]
+    (notifos/working (str "go run " file ))
+    (run-cmd cmd)
+    (notifos/done-working)))
+
+(cmd/command {:command ::go-run
+              :desc "Go: Run current file"
+              :exec (fn []
+                      (gorun (cwf->path)))})


Add missing imports on monad ns.

Add missing imports on monad ns.

--- src/promesa/monad.cljc
+++ src/promesa/monad.cljc
@@ -5,7 +5,11 @@
             [cats.protocols :as mp]
             [cats.util :as mutil]
             [promesa.core :as pc]
-            [promesa.protocols :as p]))
+            [promesa.protocols :as p])
+  #?(:clj
+     (:import java.util.concurrent.CompletionStage
+              java.util.concurrent.ExecutionException
+              java.util.concurrent.CompletionException)))

 (declare promise-context)


Simplified some logic

Simplified some logic

--- src/clj/puppetlabs/master/certificate_authority.clj
+++ src/clj/puppetlabs/master/certificate_authority.clj
@@ -180,8 +180,8 @@
   {:pre  [(or (nil? hostnames) (string? hostnames))]
    :post [(every? string? %)]}
   (let [hostnames (str/trim (or hostnames ""))]
-    (when (and hostnames (> (count hostnames) 0))
-      (mapv #(str/trim %) (str/split hostnames #",")))))
+    (when-not (empty? hostnames)
+      (map str/trim (str/split hostnames #",")))))

 (schema/defn
   create-master-extensions-list
@@ -189,13 +189,13 @@
   [settings  :- MasterSettings
    cert-name :- schema/Str]
   (let [dns-alt-names (split-hostnames (:dns-alt-names settings))
-        alt-names-ext (when (> (count dns-alt-names) 0)
+        alt-names-ext (when-not (empty? dns-alt-names)
                         ;; TODO: Create a list of OID def'ns in CA lib
                         ;;       This is happening in PE-4373
                         {:oid      "2.5.29.17"
                          :critical false
                          :value    {:dns-name (conj dns-alt-names cert-name)}})]
-    (filter #((complement nil?) %) [alt-names-ext])))
+    (if alt-names-ext [alt-names-ext] [])))

 (schema/defn initialize-master!
   "Given the SSL directory file paths, master certname, and CA information,


show total estimate only for selected

show total estimate only for selected

--- src/cljs/iwaswhere_web/ui/entry/briefing/tasks.cljs
+++ src/cljs/iwaswhere_web/ui/entry/briefing/tasks.cljs
@@ -115,7 +115,7 @@
         filter-btn (fn [fk text]
                      [:span.filter {:class    (when (= fk (:filter @local)) "current")
                                     :on-click #(swap! local assoc-in [:filter] fk)}
-                      (name fk) text])]
+                      (name fk) (when (= fk (:filter @local)) text)])]
     (fn open-linked-tasks-render [ts local local-cfg put-fn]
       (let [{:keys [tab-group query-id]} local-cfg
             linked-entries-set (into (sorted-set) (:linked-entries-list @entry))
@@ -152,7 +152,7 @@
             time-reducer (fn [acc t] (+ acc (get-in t [:task :estimate-m] 0)))
             total-time (reduce time-reducer 0 linked-tasks)]
         [:div.linked-tasks
-         [filter-btn :active]
+         [filter-btn :active (str " - " (m-to-hhmm total-time))]
          [filter-btn :open (str " - " (m-to-hhmm total-time))]
          [filter-btn :done]
          [filter-btn :closed]


Fucking around with throttle tests.

Fucking around with throttle tests.

--- reimann/test/reimann/test/streams.clj
+++ reimann/test/reimann/test/streams.clj
@@ -257,9 +257,14 @@
              (stream state))

            (let [dt (- (unix-time) t1)
-                 slices (inc (quot dt quantum))
-                 maxcount (* slices 5)]
-             (is (approx-equal maxcount (count (deref out)))))))
+                 slices (quot dt quantum)
+                 maxcount (* slices 5)
+                 count (count (deref out))]
+
+             ; Depending on whether we fell exactly on the interval boundary...
+             ; ugh I hate testing this shit
+             (is (approx-equal count maxcount 0.1))
+             (is (zero? (mod count 5))))))

 (deftest rollup-test
          (let [out (ref [])


don't reference figwheel.tools

don't reference figwheel.tools

figwheel.tools middleware isn’t going to be a thing

--- sidecar/src/figwheel_sidecar/repl.clj
+++ sidecar/src/figwheel_sidecar/repl.clj
@@ -165,12 +165,6 @@
   [_ figwheel-env]
   (try
     (cond
-      (and (require? 'figwheel.tools.nrepl)
-           (when-let [present-var (resolve 'figwheel.tools.nrepl/*cljs-evaluator*)]
-             (thread-bound? present-var)))
-      (let [cljs-repl (resolve 'figwheel.tools.nrepl/cljs-repl)
-            opts' (:repl-opts figwheel-env)]
-        (apply cljs-repl figwheel-env (apply concat opts')))
       (and (require? 'cemerick.piggieback)
            (when-let [present-var (resolve 'cemerick.piggieback/*cljs-repl-env*)]
              (thread-bound? present-var)))


no need for nested params anymore

no need for nested params anymore

--- src/main/clojure/com/xebia/visualreview/starter.clj
+++ src/main/clojure/com/xebia/visualreview/starter.clj
@@ -19,7 +19,6 @@
   (:require [ring.middleware
              [params :as params]
              [keyword-params :refer [wrap-keyword-params]]
-             [nested-params :refer [wrap-nested-params]]
              [multipart-params :refer [wrap-multipart-params]]]
             [taoensso.timbre :as timbre]
             [com.xebia.visualreview.routes :as routes]
@@ -28,7 +27,6 @@

 (def app (-> routes/main-router
              wrap-keyword-params
-             wrap-nested-params
              wrap-multipart-params
              params/wrap-params
              middleware/wrap-exception))


specification stuff

specification stuff

--- src/s7p/slave/core.clj
+++ src/s7p/slave/core.clj
@@ -20,7 +20,7 @@
   (let [{:keys [status body]} @res]
     {:dsp dsp :status status :body body}))

-(defn validate [{dsp :dsp status :status body :body}]
+(defn validate [request-id {dsp :dsp status :status body :body}]
   ;; TODO: validate id identity
   (try
    (let [body (and body (json/parse-string body true))
@@ -32,6 +32,7 @@
                (not body) {:status :invalid :reason "no body"}
                (not id) {:status :invalid :invalid "no bid id"}
                (not (instance? String id)) {:status :invalid :reason "id not string" :id id}
+               (not (= id request-id)) {:status :invalid :reason "bid id differs from request-id" :id id :request-id request-id}
                (not bidPrice) {:status :invalid :reason "no bid price"}
                (not (instance? Double bidPrice)) {:status :invalid :reason "bidPrice not double" :bidPrice bidPrice}
                (not advertiserId) {:status :invalid :reason "no advertiser id"}
@@ -54,7 +55,7 @@

 (defn over-floor? [floor-price {res :response}]
   (if floor-price
-    (<= floor-price (:bidPrice res))
+    (<= (* 1000 floor-price) (:bidPrice res))
     true))

 (defn auction [floor-price resps]
@@ -98,7 +99,7 @@
        (sequence (comp
                   (map (fn [dsp] {:dsp dsp :response (http/post (:url dsp) (json-request-option req))}))
                   (map destruct)
-                  (map validate)
+                  (map #(validate (:id req) %))
                   (map #(log-validated test %))
                   (filter succeed?)
                   (map (fn [{dsp :dsp res :response}] {:dsp dsp :response res}))


looks better

looks better


Add release and environment to sentry captures in the main app exveption handler.

--- src/oc/storage/app.clj
+++ src/oc/storage/app.clj
@@ -36,7 +36,9 @@
    (uncaughtException [_ thread ex]
      (timbre/error ex "Uncaught exception on" (.getName thread) (.getMessage ex))
      (when c/dsn
-       (sentry/capture c/dsn (-> {:message (.getMessage ex)}
+       (sentry/capture c/dsn (-> {:message (.getMessage ex)
+                                  :release c/sentry-release
+                                  :environment c/sentry-env}
                                  (assoc-in [:extra :exception-data] (ex-data ex))
                                  (sentry-interfaces/stacktrace ex)))))))

@@ -71,6 +73,9 @@
     "Trace: " c/liberator-trace "\n"
     "Log level: " c/log-level "\n"
     "Sentry: " c/dsn "\n"
+    "  env: " c/sentry-env "\n"
+    (when-not (clojure.string/blank? c/sentry-release)
+      (str "  release: " c/sentry-release "\n"))
     "Payments?: " c/payments-enabled? "\n"
     "Unread limit: " c/unread-days-limit " days\n\n"
     (when c/intro? "Ready to serve...\n"))))


Remove dependency on core.async.

Remove dependency on core.async.

--- src/om_forms/core.cljs
+++ src/om_forms/core.cljs
@@ -84,7 +84,7 @@
   [:label {:class "warning"} warning])

 (defn input
-  [label placeholder cursor korks type & {:keys [notify-ch valid? validation-error-fn in-progress warn-fn help]}]
+  [label placeholder cursor korks type & {:keys [valid? validation-error-fn in-progress warn-fn help]}]
   (let [dom-id (gen-dom-id cursor korks)
         valid (or (nil? valid?) (valid? korks))
         warning (and warn-fn (warn-fn (get-in cursor korks)))]
@@ -93,10 +93,7 @@
      [:label {:for   dom-id
               :class (str "control-label " (label-column-class))} label]
      (input-column [:input {:onChange    #(do
-                                           (om/update! cursor korks (.. % -target -value))
-                                           (when notify-ch
-                                             (async/go
-                                               (async/>! notify-ch {:event :change}))))
+                                           (om/update! cursor korks (.. % -target -value)))
                             :value       (get-in cursor korks)
                             :type        type
                             :class       "form-control"
@@ -126,13 +123,10 @@
   [:h2 {:class (str "group-title" (when class (str " " class)))} title])

 (defn button
-  [label on-click & {:keys [notify-ch in-progress disabled] :as opts}]
+  [label on-click & {:keys [in-progress disabled] :as opts}]
   [:button (merge opts {:type     "button"
                         :disabled disabled
                         :onClick  #(when-not disabled
-                                    (when notify-ch
-                                      (async/go
-                                        (async/>! notify-ch {:event :click})))
                                     (on-click))}) label (when in-progress
                                                           (list " "
                                                                 (spinner)))])
@@ -142,17 +136,14 @@
   [:div {:class "button-group text-right"} (seq buttons)])

 (defn checkbox
-  [label cursor korks & {:keys [notify-ch valid? validation-error-fn inline]}]
+  [label cursor korks & {:keys [valid? validation-error-fn inline]}]
   (let [dom-id (gen-dom-id cursor korks)
         valid (or (nil? valid?) (valid? korks))]
     (list
       [:div {:class (str "checkbox" (when-not valid " has-error") (when inline " checkbox-inline"))}
        [:label
         [:input {:onChange #(do
-                             (om/update! cursor korks (.. % -target -checked))
-                             (when notify-ch
-                               (async/go
-                                 (async/>! notify-ch {:event :change}))))
+                             (om/update! cursor korks (.. % -target -checked)))
                  :checked  (get-in cursor korks)
                  :type     "checkbox"
                  :id       dom-id}]
@@ -161,17 +152,14 @@
         (error-label validation-error)))))

 (defn radio
-  [label cursor korks value & {:keys [notify-ch valid? validation-error-fn inline]}]
+  [label cursor korks value & {:keys [valid? validation-error-fn inline]}]
   (let [dom-id (gen-dom-id cursor korks)
         valid (or (nil? valid?) (valid? korks))]
     (list
       [:div {:class (str "radio" (when-not valid " has-error") (when inline " radio-inline"))}
        [:label
         [:input {:onChange #(when (.. % -target -checked)
-                             (om/update! cursor korks value)
-                             (when notify-ch
-                               (async/go
-                                 (async/>! notify-ch {:event :change}))))
+                             (om/update! cursor korks value))
                  :checked  (= value (get-in cursor korks))
                  :type     "radio"
                  :id       dom-id


made the parse externalize when to stop and what to return via additional hof+initial hof state args

--- src/paredit/parser.clj
+++ src/paredit/parser.clj
@@ -12,23 +12,23 @@
   start-like
   "returns true if s1 is a prefix of s2 or s2 is a prefix of s1.
    Examples:
-   (= true (starts-like \"bar and foo\" \"bar\"))
-   (= true (starts-like \"bar\" \"bar and foo\"))
-   (= false (starts-like \"bar\" \"baz\"))
-   (= true (starts-like \"bar\" \"bar\"))
-   (= true (starts-like \"ba\" \"bar\"))
-   (= true (starts-like \"bar\" \"ba\"))
-   (= true (starts-like \"b\" \"bar\"))
-   (= true (starts-like \"bar\" \"b\"))
-   (= true (starts-like \"\" \"bar\"))
-   (= true (starts-like \"bar\" \"\"))"
+   (= true (start-like \"bar and foo\" \"bar\"))
+   (= true (start-like \"bar\" \"bar and foo\"))
+   (= false (start-like \"bar\" \"baz\"))
+   (= true (start-like \"bar\" \"bar\"))
+   (= true (start-like \"ba\" \"bar\"))
+   (= true (start-like \"bar\" \"ba\"))
+   (= true (start-like \"b\" \"bar\"))
+   (= true (start-like \"bar\" \"b\"))
+   (= true (start-like \"\" \"bar\"))
+   (= true (start-like \"bar\" \"\"))"
   [#^String s1 #^String s2]
     (or (.startsWith s1 s2) (.startsWith s2 s1))
     #_(.startsWith s1 (.substring s2 0 (min (.length s2) (.length s1)))))

-(deftest test-starts-like
-  (testing "starts-like"
-    (are [expected s1 s2]  (= expected (starts-like s1 s2))
+(deftest test-start-like
+  (testing "start-like"
+    (are [expected s1 s2]  (= expected (start-like s1 s2))
       true "bar and foo" "bar"
       true "bar" "bar and foo"

@@ -53,112 +53,131 @@
  { :parents [ {:type <[ or ( or { or \" or \\> :line :offset :col} ... ]
    :offset current-offset :line current-line :col current-col}"

+#_(defn default-parser-hook
+  ; todo : later on, move offset+line+col+parents inside a proper deftyped type
+  [#^String text offset line col parents hook-state]
+  [(< offset (.length text))
+   { :parents parents :offset offset :line line :col col }])
+
+(defn make-stop-offset-based-parser-hook
+  [stop-offset]
+  (fn stop-offset-based-parser-hook
+  ; todo : later on, move offset+line+col+parents inside a proper deftyped type
+    [#^String text offset line col parents hook-state]
+    [(< offset stop-offset)
+    { :parents parents :offset offset :line line :col col }]))
+
 (defn parse
-	"TODO: currently the parser assumes a well formed document ...
+	"TODO: currently the parser assumes a well formed document ... Define a policy if the parser encounters and invalid text
 	 TODO: make the parser restartable at a given offset given a state ...
 	 TODO: make the parser fully incremental (via chunks of any possible size ...)"
-	([#^String text] (parse text (.length text)))
-	([#^String text stop-offset]
+  ([#^String text] (parse text (make-stop-offset-based-parser-hook (.length text)) nil))
+  ([#^String text stop-offset] (parse text (make-stop-offset-based-parser-hook stop-offset) nil))
+	([#^String text parser-hook hook-state]
 	  (loop [offset  (int 0)
 	         line    (int 0)
 	         col     (int 0)
-	         parents [{:type nil :offset 0 :line 0 :col 0}]]
-	      (if (>= offset stop-offset)
-	        { :parents parents :offset offset :line line :col col }
-	        (let [c (.charAt text offset)] ; c: current char
-	          (condp = (-> parents peek :type)
-	            \"
+	         parents [{:type nil :offset 0 :line 0 :col 0}]
+	         hook-state hook-state]
+	      (let [[continue? hook-state] (parser-hook text offset line col parents hook-state)]
+  	      (if (or (not continue?) (>= offset (.length text)))
+  	        hook-state
+  	        (let [c (.charAt text offset)] ; c: current char
+  	          (condp = (-> parents peek :type)
+  	            \"
+                  (cond
+                    (= \newline c)
+                      (recur (inc offset) (inc line) (int 0) parents hook-state)
+                    (= \" c)
+                      (if (= offset 0)
+                        (recur (inc offset) line (inc col) (conj parents {:type c :line line :col col :offset offset}) hook-state)
+                        (if (= \\ (.charAt text (dec offset)))
+                          (recur (inc offset) line (inc col) parents hook-state)
+                          (recur (inc offset) line (inc col) (pop parents) hook-state)))
+                    :else
+                      (recur (inc offset) line (inc col) parents hook-state))
+                \;
+                  (cond
+                    (= \newline c)
+                      (recur (inc offset) (inc line) (int 0) (pop parents) hook-state)
+                    :else
+                      (recur (inc offset) line (inc col) parents hook-state))
+                \\
+                  (cond   ; leaved as a template if new cases have to be handled
+                    #_(*opening-brackets* c)
+                    #_(*closing-brackets* c)
+                    #_(= (first "\r") c)
+                    #_(= \newline c)
+                    #_(= \" c)
+                    #_(= \; c)
+                    ; TODO refactor the following stuff. or keep for performance ? (bleh)
+                    (start-like (.substring text (-> parents peek :offset)) "\\newline")
+                      (if (< (inc (- offset (-> parents peek :offset))) (.length "\\newline"))
+                        (recur (inc offset) line (inc col) parents hook-state)
+                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                    (start-like (.substring text (-> parents peek :offset)) "\\tab")
+                      (if (< (inc (- offset (-> parents peek :offset))) (.length "\\tab"))
+                        (recur (inc offset) line (inc col) parents hook-state)
+                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                    (start-like (.substring text (-> parents peek :offset)) "\\space")
+                      (if (< (inc (- offset (-> parents peek :offset))) (.length "\\space"))
+                        (recur (inc offset) line (inc col) parents hook-state)
+                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                    (start-like (.substring text (-> parents peek :offset)) "\\backspace")
+                      (if (< (inc (- offset (-> parents peek :offset))) (.length "\\backspace"))
+                        (recur (inc offset) line (inc col) parents hook-state)
+                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                    (start-like (.substring text (-> parents peek :offset)) "\\formfeed")
+                      (if (< (inc (- offset (-> parents peek :offset))) (.length "\\formfeed"))
+                        (recur (inc offset) line (inc col) parents hook-state)
+                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                    (start-like (.substring text (-> parents peek :offset)) "\\return")
+                      (if (< (inc (- offset (-> parents peek :offset))) (.length "\\return"))
+                        (recur (inc offset) line (inc col) parents hook-state)
+                        (recur (inc offset) line (inc col) (pop parents) hook-state))
+                    ; TODO I don't like the fact the next two conditions on \r and \newline are repeated from the default case
+                    ;      clearly a level of indirection is missing regarding the update of line, offset and col
+                    (= (first "\r") c)
+                      (recur (inc offset) line col parents hook-state) ; we do not increment the column
+                    (= \newline c)
+                      (recur (inc offset) (inc line) (int 0) parents hook-state)
+                    :else
+                      (recur (inc offset) line (inc col) (pop parents) hook-state))
+                ; last falling case: we are in plain code, neither in a string, regexp or a comment
                 (cond
+                  (*opening-brackets* c)
+                    (recur
+                      (inc offset) line (inc col)
+                      (conj parents {:type c :offset offset :line line :col col})
+                       hook-state)
+                  (*closing-brackets* c)
+                    (recur
+                      (inc offset) line (inc col)
+                      (pop parents)
+                       hook-state)
+                  (= (first "\r") c)
+                    (recur (inc offset) line col parents hook-state) ; we do not increment the column
                   (= \newline c)
-                    (recur (inc offset) (inc line) (int 0) parents)
+                    (recur (inc offset) (inc line) (int 0) parents hook-state)
                   (= \" c)
-                    (if (= offset 0)
-                      (recur (inc offset) line (inc col) (conj parents {:type c :line line :col col :offset offset}))
-                      (if (= \\ (.charAt text (dec offset)))
-                        (recur (inc offset) line (inc col) parents)
-                        (recur (inc offset) line (inc col) (pop parents))))
+                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col }) hook-state)
+                  (= \; c)
+                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}) hook-state)
+                  (= \\ c)
+                    (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}) hook-state)
                   :else
-                    (recur (inc offset) line (inc col) parents))
-              \;
-                (cond
-                  (= \newline c)
-                    (recur (inc offset) (inc line) (int 0) (pop parents))
-                  :else
-                    (recur (inc offset) line (inc col) parents))
-              \\
-                (cond   ; leaved as a template if new cases have to be handled
-                  #_(*opening-brackets* c)
-                  #_(*closing-brackets* c)
-                  #_(= (first "\r") c)
-                  #_(= \newline c)
-                  #_(= \" c)
-                  #_(= \; c)
-                  ; TODO refactor the following stuff. or keep for performance ? (bleh)
-                  (starts-like (.substring text (-> parents peek :offset)) "\\newline")
-                    (if (< (inc (- offset (-> parents peek :offset))) (.length "\\newline"))
-                      (recur (inc offset) line (inc col) parents)
-                      (recur (inc offset) line (inc col) (pop parents)))
-                  (starts-like (.substring text (-> parents peek :offset)) "\\tab")
-                    (if (< (inc (- offset (-> parents peek :offset))) (.length "\\tab"))
-                      (recur (inc offset) line (inc col) parents)
-                      (recur (inc offset) line (inc col) (pop parents)))
-                  (starts-like (.substring text (-> parents peek :offset)) "\\space")
-                    (if (< (inc (- offset (-> parents peek :offset))) (.length "\\space"))
-                      (recur (inc offset) line (inc col) parents)
-                      (recur (inc offset) line (inc col) (pop parents)))
-                  (starts-like (.substring text (-> parents peek :offset)) "\\backspace")
-                    (if (< (inc (- offset (-> parents peek :offset))) (.length "\\backspace"))
-                      (recur (inc offset) line (inc col) parents)
-                      (recur (inc offset) line (inc col) (pop parents)))
-                  (starts-like (.substring text (-> parents peek :offset)) "\\formfeed")
-                    (if (< (inc (- offset (-> parents peek :offset))) (.length "\\formfeed"))
-                      (recur (inc offset) line (inc col) parents)
-                      (recur (inc offset) line (inc col) (pop parents)))
-                  (starts-like (.substring text (-> parents peek :offset)) "\\return")
-                    (if (< (inc (- offset (-> parents peek :offset))) (.length "\\return"))
-                      (recur (inc offset) line (inc col) parents)
-                      (recur (inc offset) line (inc col) (pop parents)))
-                  ; TODO I don't like the fact the next two conditions on \r and \newline are repeated from the default case
-                  ;      clearly a level of indirection is missing regarding the update of line, offset and col
-                  (= (first "\r") c)
-                    (recur (inc offset) line col parents) ; we do not increment the column
-                  (= \newline c)
-                    (recur (inc offset) (inc line) (int 0) parents)
-                  :else
-                    (recur (inc offset) line (inc col) (pop parents)))
-              ; last falling case: we are in plain code, neither in a string, regexp or a comment
-              (cond
-                (*opening-brackets* c)
-                  (recur
-                    (inc offset) line (inc col)
-                    (conj parents {:type c :offset offset :line line :col col}))
-                (*closing-brackets* c)
-                  (recur
-                    (inc offset) line (inc col)
-                    (pop parents))
-                (= (first "\r") c)
-                  (recur (inc offset) line col parents) ; we do not increment the column
-                (= \newline c)
-                  (recur (inc offset) (inc line) (int 0) parents)
-                (= \" c)
-                  (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col }))
-                (= \; c)
-                  (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}))
-                (= \\ c)
-                  (recur (inc offset) line (inc col) (conj parents {:type c :offset offset :line line :col col}))
-                :else
-                  (recur (inc offset) line (inc col) parents))
-
-                #_(cond   ; leaved as a template if new cases have to be handled
-                  (*opening-brackets* c)
-                  (*closing-brackets* c)
-                  (= (first "\r") c)
-                  (= \newline c)
-                  (= \" c)
-                  (= \; c)
-                  (= \\ c)
-                  :else
-                    (recur (inc offset) line (inc col) parents))))))))
+                    (recur (inc offset) line (inc col) parents hook-state))
+
+                  #_(cond   ; leaved as a template if new cases have to be handled
+                    (*opening-brackets* c)
+                    (*closing-brackets* c)
+                    (= (first "\r") c)
+                    (= \newline c)
+                    (= \" c)
+                    (= \; c)
+                    (= \\ c)
+                    :else
+                      (recur (inc offset) line (inc col) parents hook-state)))))))))

 (comment
 (defn parse-lib


Fix pingpong example.

Fix pingpong example.

--- examples/pingpong.clj
+++ examples/pingpong.clj
@@ -19,7 +19,7 @@
   (let [new-in (chan)
         new-out (chan)]
     ;; we just mirror the messages back
-    (go-loop-try [i (<? S in)]
+    (go-loop-try S [i (<? S in)]
       (when i
         (>? S out i)
         (recur (<? S in))))


Update transit-clj to 0.8.300

Update transit-clj to 0.8.300

--- planck-cljs/project.clj
+++ planck-cljs/project.clj
@@ -12,7 +12,7 @@
                  [org.clojure/clojurescript "1.9.562"]
                  [org.clojure/test.check "0.9.0"]
                  [org.clojure/tools.reader "1.0.0-RC1"]
-                 [com.cognitect/transit-clj "0.8.297"]
+                 [com.cognitect/transit-clj "0.8.300"]
                  [com.cognitect/transit-cljs "0.8.239"]
                  [fipp "0.6.7"]
                  [malabarba/lazy-map "1.3"]


Render game over states better

Render game over states better

--- src/tttclj/render.cljs
+++ src/tttclj/render.cljs
@@ -2,17 +2,21 @@
   (:require [quiescent :as q :include-macros true]
             [quiescent.dom :as d]))

-
 (def state {:tiles [:x :o :-
                     :x :- :o
                     :- :x :o]
-            :player :x})
+            :player-turn :x})

 (q/defcomponent Turn
   "Renders a component saying whose turn it is"
   [game]
-  (d/p {} (str "It is " (name (:player game)) "'s turn:")))
+  (d/p {}
+       (if-let [player (:player-turn game)]
+         (str "It is " (name player) "'s turn")
+         (if-let [winner (:winner game)]
+           (str (name winner) " won the match!")
+           "You managed a draw!"))))

 (q/defcomponent Cell
   "Renders a cell in the TicTacToe grid"


add namesapce name

add namesapce name

--- src/ca_recipe/components/kengine.clj
+++ src/ca_recipe/components/kengine.clj
@@ -1,3 +1,6 @@
+(ns ca-recipe.components.kengine
+  :require [com.stuartsierra.component :as component])
+
 (defrecord KnowledgeEngine
     [ke-config feed-chan alert-chan rules]
   component/Ligecicle


(maint) Test leaking threads by identity vs name

Prior to this we tested for leaking threads from a JRuby instance's
Timeout module by comparing threads by name (which are more human
readable when they fail). However JRuby gives these threads generic
names so any Timeout threadpool will create similar named threads. This
wasn't an issue prior to this because nothing created a Timeout
threadpool by default when a JRuby instance was initialized.

However, with a recent change to Facter a Timeout threadpool is always
initialized as soon as Facter runs (which happens when we load Puppet
during JRuby initialization). Now after flushing the pool the new JRuby
instance will have a threadpool whose threads have the same name to the
previous JRuby instance's.

To resolve this issue we stop checking threads by name and instead
compare the actual objects themselves.

--- test/integration/puppetlabs/services/jruby/jruby_puppet_pool_int_test.clj
+++ test/integration/puppetlabs/services/jruby/jruby_puppet_pool_int_test.clj
@@ -629,10 +629,8 @@
        jruby-testutils/jruby-service-and-dependencies
        (jruby-testutils/jruby-puppet-tk-config
         (jruby-testutils/jruby-puppet-config {:max-active-instances 1}))
-        ;; getName vs getId here is helpful in debugging
-        (let [threads-before-jruby (->> (Thread/getAllStackTraces)
-                                        (map #(.getName (key %)))
-                                        (set))
+        ;; getAllStackTraces returns a HashMap of Thread to StackTraceElement[]
+        (let [threads-before-jruby (set (keys (Thread/getAllStackTraces)))
               jruby-service (tk-app/get-service app :JRubyPuppetService)
               pool-context (jruby-protocol/get-pool-context jruby-service)
               pool-agent (jruby-agents/get-modify-instance-agent pool-context)
@@ -644,17 +642,13 @@
           (try
             (.runScriptlet scripting-container script)
             (catch EvalFailedException e))
-          (let [threads-during-jruby (->> (Thread/getAllStackTraces)
-                                          (map #(.getName (key %)))
-                                          (set))]
+          (let [threads-during-jruby (set (keys (Thread/getAllStackTraces)))]
             (jruby-testutils/return-instance jruby-service instance :test)
             (jruby-protocol/flush-jruby-pool! jruby-service)
             ; wait until the flush is complete
             (await pool-agent)
             (Thread/sleep 5000)
-            (let [threads-after-jruby (->> (Thread/getAllStackTraces)
-                                           (map #(.getName (key %)))
-                                           (set))
+            (let [threads-after-jruby (set (keys (Thread/getAllStackTraces)))
                   threads-created-by-jruby (set/difference threads-during-jruby threads-before-jruby)
                   threads-orphaned-by-jruby (set/intersection threads-created-by-jruby threads-after-jruby)]
               (is (empty? threads-orphaned-by-jruby)))))))))


fix cook memory label handling (#1805)

fix cook memory label handling (#1805)

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

     ; Don't add memory limit if user sets job label to allow memory usage above request to "true"
     (let [allow-memory-usage-above-request (some->> (:memory-limit-job-label-name (config/kubernetes))
-                                             (get labels)
+                                             (get (tools/job-ent->label job))
                                              clojure.string/lower-case
                                              (= "true"))]
       (set-mem-cpu-resources resources computed-mem (when-not allow-memory-usage-above-request computed-mem) cpus cpus))


Make Validation types printable

Make Validation types printable

--- src/cats/applicative/validation.cljc
+++ src/cats/applicative/validation.cljc
@@ -65,6 +65,21 @@
            (= v (.-v other))
            false))]))

+(defn ok->str
+  [mv]
+  (str "#<Ok " (pr-str (.-v mv)) ">"))
+
+#?(:clj
+   (defmethod print-method Ok
+     [mv writer]
+     (.write writer (ok->str mv))))
+
+#?(:cljs
+   (extend-type Ok
+     IPrintWithWriter
+     (-pr-writer [mv writer _]
+       (-write writer (ok->str mv)))))
+
 (deftype Fail [v]
   p/Contextual
   (-get-context [_] context)
@@ -92,6 +107,21 @@
          (if (instance? Fail other)
            (= v (.-v other))
            false))]))
+
+(defn fail->str
+  [mv]
+  (str "#<Fail " (pr-str (.-v mv)) ">"))
+
+#?(:clj
+   (defmethod print-method Fail
+     [mv writer]
+     (.write writer (fail->str mv))))
+
+#?(:cljs
+   (extend-type Fail
+     IPrintWithWriter
+     (-pr-writer [mv writer _]
+       (-write writer (fail->str mv)))))

 (alter-meta! #'->Ok assoc :private true)
 (alter-meta! #'->Fail assoc :private true)


improve file chunking output

improve file chunking output

--- src/clj/clj_money/import/gnucash.clj
+++ src/clj/clj_money/import/gnucash.clj
@@ -345,8 +345,7 @@

 (defn- process-output
   "Writes the records to the next output file and resets the record buffer"
-  [{:keys [verbose
-           records
+  [{:keys [records
            output-folder
            file-name
            output-paths
@@ -357,19 +356,19 @@
                               output-folder
                               file-name
                               (count output-paths))]
+      (>!! progress-chan [:message "compressing and writing records..."])
       (binding [*print-meta* true]
         (with-open [writer (io/writer (GZIPOutputStream. (FileOutputStream. output-path)))]
           (with-precision 4
             (.write writer (prn-str records)))))
-      (>!! progress-chan [:output-path output-path])
+      (>!! progress-chan [:message output-path])
       (-> context
           (assoc :records [])
           (update-in [:output-paths] #(conj % output-path))))
     context))

 (def ^:private chunk-file-options
-  [["-v" "--verbose" "Print a lot of details about what's going on"]
-   ["-m" "--maximum MAXIMUM" "The maximum number of records to include in each output file"
+  [["-m" "--maximum MAXIMUM" "The maximum number of records to include in each output file"
     :parse-fn #(Integer/parseInt %)
     :default 1000]])

@@ -409,7 +408,7 @@
       true)))

 (defn- filter-record
-  ([xf]
+  ([progress-chan xf]
    (let [filter-state (atom {})]
      (fn
        ([] (xf))
@@ -417,7 +416,9 @@
        ([result record]
         (if (keep-record? record filter-state)
           (xf result record)
-          result))))))
+          (do
+            (>!! progress-chan [:dot])
+            result)))))))

 (defn- evaluate-output
   "Evaluates the output for the chunking process
@@ -462,12 +463,11 @@
                    (try
                      (->> (read-source :gnucash input-stream)
                           (transduce
-                            (comp filter-record
+                            (comp (partial filter-record progress-chan)
                                   append-record
                                   (partial notify-record progress-chan))
                             evaluate-output
                             {:output-paths []
-                             :verbose (-> opts :options :verbose)
                              :records []
                              :max-record-count (-> opts :options :maximum)
                              :file-name (second (re-matches #"^(.+)(\..+)$" file-name))
@@ -480,11 +480,12 @@
     (go-loop [value (<! progress-chan)]
              (case (first value)
                :record
-               (when (not (:verbose opts))
-                 (print (-> value second meta :record-type name first))
-                 (flush))
-               :output-path
+               (print (-> value second meta :record-type name first))
+               :dot
+               (print ".")
+               :message
                (println "\n" (second value)))
+             (flush)
              (recur (<! progress-chan)))
     (println "reading the source file...")
     (<!! result)


To go forward, you must be able to go forward. Jamie, 2015

--- src/cljs/gc_api_browser/history.cljs
+++ src/cljs/gc_api_browser/history.cljs
@@ -25,6 +25,7 @@
   (and history-id (not= history-id (:id (last history)))))

 (defn go-forward [app]
+  {:pre [(can-go-forward? app)]}
   (let [entry (second (drop-while #(not= (:history-id app) (:id %)) (:history app)))]
     (assoc app :request (:request entry)
                :response (:response entry)