feat: generate smile test files

feat: generate smile test files

--- src/main/clojure/pdok/featured/generator.clj
+++ src/main/clojure/pdok/featured/generator.clj
@@ -1,7 +1,17 @@
 (ns pdok.featured.generator
-  (:require [cheshire.core :as json]
-            [clj-time [core :as t] [format :as tf] [local :refer [local-now]]])
-  (:import  [java.io PipedInputStream PipedOutputStream]))
+  (:require [cheshire
+             [core :as json]
+             [generate :refer [add-encoder]]]
+            [clj-time
+             [core :as t]
+             [format :as tf]
+             [local :refer [local-now]]
+             [coerce :refer [to-long to-date-time to-local-date to-local-date-time]]]
+            [clojure.walk :as walk])
+  (:import [java.io PipedInputStream PipedOutputStream OutputStream InputStream ByteArrayOutputStream]
+           (com.fasterxml.jackson.dataformat.smile SmileFactory SmileGenerator)
+           (org.joda.time LocalDateTime LocalDate)
+           (clojure.lang MapEntry)))

 (def ^:dynamic *difficult-geometry?* false)

@@ -99,37 +109,52 @@
         "</gml:Polygon> ")})

 (defn random-date []
-  (let [date (local-now)
-        date-string (tf/unparse date-formatter date)]
+  (let [date (to-local-date (local-now))]
+    date))
+
+(defn date->text [date]
+  (tf/unparse date-formatter (to-date-time date)))
+
+(defn texify-date [date]
+  (let [date-string (date->text date)]
     ["~#date", [date-string]]))

 (defn random-moment []
-  (let [moment (local-now)
-        date-time-string (tf/unparse date-time-formatter moment)]
+  (let [date (to-local-date-time (local-now))]
+    date))
+
+(defn moment->text [moment]
+  (tf/unparse date-time-formatter (to-date-time moment)))
+
+(defn texify-moment [moment]
+  (let [date-time-string (moment->text moment)]
     ["~#moment", [date-time-string]]))

 (def attribute-generators [#(random-word 5) random-date random-moment])

+(def ^:dynamic *attribute-generators* attribute-generators)
+
+(defn texify-validity [validity]
+  (tf/unparse date-time-formatter validity))
+
 (defn new-feature [collection id]
-   {:_action "new"
-    :_collection collection
-    :_id id
-    :_validity (tf/unparse date-time-formatter (local-now))
-    :_geometry (if *difficult-geometry?* difficult-geometry (random-geometry))})
+  {:_action     "new"
+   :_collection collection
+   :_id         id
+   :_validity   (to-local-date-time (local-now))
+   :_geometry   (if *difficult-geometry?* difficult-geometry (random-geometry))})

 (defn transform-to-change [feature]
   (-> feature
       (assoc :_action "change")
       (assoc :_current_validity (:_validity feature))
-      (assoc :_validity (tf/unparse date-time-formatter
-                          (t/plus (tf/parse date-time-formatter (:_validity feature)) (t/minutes 1))))))
+      (assoc :_validity (t/plus (:_validity feature) (t/minutes 1)))))

 (defn transform-to-close [feature]
   (-> feature
       (assoc :_action "close")
       (assoc :_current_validity (:_validity feature))
-      (assoc :_validity (tf/unparse date-time-formatter
-                          (t/plus (tf/parse date-time-formatter (:_validity feature)) (t/minutes 1))))))
+      (assoc :_validity (t/plus (:_validity feature) (t/minutes 1)))))

 (defn transform-to-delete [{:keys [_dataset _collection _id _validity]}]
   {:_action "delete"
@@ -193,12 +218,62 @@

 (defn create-attributes [simple-attributes & {:keys [names]}]
   (let [attribute-names (or names (repeatedly simple-attributes #(random-word 5)))
-        generators (cycle attribute-generators)
+        generators (cycle *attribute-generators*)
         attributes (map #(vector %1 %2) attribute-names generators)]
     attributes))

+(defn generate-smile-stream
+  "Returns a SMILE-encoded writer for the given Clojure object.
+  Takes an optional date format string that Date objects will be encoded with.
+
+  The default date format (in UTC) is: yyyy-MM-dd'T'HH:mm:ss'Z'"
+  ([obj ^OutputStream os]
+   (generate-smile-stream obj nil os))
+  ([obj opt-map ^OutputStream os]
+   (let [generator (.createGenerator ^SmileFactory
+                                     cheshire.factory/smile-factory
+                                     ^OutputStream os)]
+     (cheshire.generate/generate generator obj (or (:date-format opt-map)
+                                     cheshire.factory/default-date-format)
+                   (:ex opt-map)
+                   (:key-fn opt-map))
+     (.flush generator)
+     os)))
+
+(defn generate-smile [obj]
+  (let [baos (ByteArrayOutputStream.)]
+    (.toByteArray (generate-smile-stream obj baos))))
+
+
+(defn texify-feature [feature]
+  (walk/postwalk
+    (fn [e]
+      (cond (instance? LocalDateTime e)
+            (texify-moment e)
+            (instance? LocalDate e)
+            (texify-date e)
+            (and (instance? MapEntry e) (= :_validity (first e)))
+            (MapEntry. :_validity (texify-validity (second e)))
+            :else e))
+    feature))
+
+(add-encoder LocalDate
+             (fn [c ^SmileGenerator smile-generator]
+               (doto smile-generator
+                 (.writeStartArray 2)
+                 (.writeString "D")
+                 (.writeNumber (to-long c))
+                 (.writeEndArray))))
+(add-encoder LocalDateTime
+             (fn [c ^SmileGenerator smile-generator]
+               (doto smile-generator
+                 (.writeStartArray 2)
+                 (.writeString "M")
+                 (.writeNumber (to-long c))
+                 (.writeEndArray))))
+
 (defn random-json-features [out-stream dataset collection total & args]
-  (let [{:keys [change? close? delete? start-with-delete? nested geometry? ids]
+  (let [{:keys [change? close? delete? start-with-delete? nested geometry? ids smile?]
          :or {change? false close? false delete? false
               start-with-delete? false nested 0 geometry? true
               ids (repeatedly #(random-word 10))}} args
@@ -207,58 +282,61 @@
         new-features (map #(random-new-feature collection attributes %) ids)
         with-nested (map #(combine-to-nested-feature % "nested" geometry?) (partition (+ 1 nested) new-features))
         with-extra (mapcat #(followed-by % change? close? delete? start-with-delete?) with-nested)
+        features (cond->> with-extra (not smile?) (map texify-feature))
         package {:_meta {}
                  :dataset dataset
-                 :features (take total with-extra)}]
-    (json/generate-stream package out-stream)))
+                 :features (take total features)}]
+    (if smile?
+      (generate-smile-stream package out-stream)
+      (json/generate-stream package (clojure.java.io/writer out-stream)))))

 (defn- random-json-feature-stream* [out-stream dataset collection total & args]
   (with-open [writer (clojure.java.io/writer out-stream)]
     (apply random-json-features writer dataset collection total args)))

 (defn random-json-feature-stream
-  (^java.io.InputStream [dataset collection total & args]
+  (^InputStream [dataset collection total & args]
    (let [pipe-in (PipedInputStream.)
          pipe-out (PipedOutputStream. pipe-in)]
      (future (apply random-json-feature-stream* pipe-out dataset collection total args))
      pipe-in)))

-(defn generate-test-files []
+(defn generate-test-files [smile?]
+  (doseq [c [1 10 100 1000 10000 100000]]
+    (with-open [w (clojure.java.io/output-stream (str ".test-files/new-features-single-collection-" c (if smile? ".smile" ".json")))]
+      (random-json-features w "newset" "collection1" c :smile? smile?))))
+
+(defn generate-test-files-with-changes [smile?]
   (doseq [c [10 100 1000 10000 100000]]
-    (with-open [w (clojure.java.io/writer (str ".test-files/new-features-single-collection-" c ".json"))]
-      (random-json-features w "newset" "collection1" c))))
-
-(defn generate-test-files-with-changes []
+    (with-open [w (clojure.java.io/output-stream (str ".test-files/change-features-single-collection-" c (if smile? ".smile" ".json")))]
+      (random-json-features w "changeset" "collection1" c :smile? smile? :change? true))))
+
+(defn generate-test-files-with-closes [smile?]
   (doseq [c [10 100 1000 10000 100000]]
-    (with-open [w (clojure.java.io/writer (str ".test-files/change-features-single-collection-" c ".json"))]
-      (random-json-features w "changeset" "collection1" c :change? true))))
-
-(defn generate-test-files-with-closes []
+    (with-open [w (clojure.java.io/output-stream (str ".test-files/close-features-single-collection-" c (if smile? ".smile" ".json")))]
+      (random-json-features w "closeset" "collection1" c :smile? smile? :close? true))))
+
+(defn generate-test-files-with-deletes [smile?]
+  (doseq [c [2 10 100 1000 10000 100000]]
+    (with-open [w (clojure.java.io/output-stream (str ".test-files/delete-features-single-collection-" c (if smile? ".smile" ".json")))]
+      (random-json-features w "deleteset" "collection1" c :smile? smile? :delete? true))))
+
+(defn generate-test-files-with-nested-feature [smile?]
+  (doseq [c [5 50 500 5000 50000]]
+    (with-open [w (clojure.java.io/output-stream (str ".test-files/new-features-nested-feature-" c (if smile? ".smile" ".json")))]
+      (random-json-features w "nestedset" "collection1" c :smile? smile? :nested 1))))
+
+(defn generate-test-files-with-nested-features [smile?]
+  (doseq [c [3 33 333 3333 33333]]
+    (with-open [w (clojure.java.io/output-stream (str ".test-files/new-features-nested-features-" c (if smile? ".smile" ".json")))]
+      (random-json-features w "nestedset" "collection1" c :smile? smile? :nested 2))))
+
+(defn generate-test-files-with-nested-feature-no-top-geometry [smile?]
   (doseq [c [10 100 1000 10000 100000]]
-    (with-open [w (clojure.java.io/writer (str ".test-files/close-features-single-collection-" c ".json"))]
-      (random-json-features w "closeset" "collection1" c :close? true))))
-
-(defn generate-test-files-with-deletes []
-  (doseq [c [2 10 100 1000 10000 100000]]
-    (with-open [w (clojure.java.io/writer (str ".test-files/delete-features-single-collection-" c ".json"))]
-      (random-json-features w "deleteset" "collection1" c :delete? true))))
-
-(defn generate-test-files-with-nested-feature []
+    (with-open [w (clojure.java.io/output-stream (str ".test-files/new-features-nested-feature-no-top-geometry-" c (if smile? ".smile" ".json")))]
+      (random-json-features w "nestedset" "collection1" c :smile? smile? :nested 1 :geometry? false))))
+
+(defn generate-test-files-with-nested-features-no-top-geometry [smile?]
   (doseq [c [5 50 500 5000 50000]]
-    (with-open [w (clojure.java.io/writer (str ".test-files/new-features-nested-feature-" c ".json"))]
-      (random-json-features w "nestedset" "collection1" c :nested 1))))
-
-(defn generate-test-files-with-nested-features []
-  (doseq [c [3 33 333 3333 33333]]
-    (with-open [w (clojure.java.io/writer (str ".test-files/new-features-nested-features-" c ".json"))]
-      (random-json-features w "nestedset" "collection1" c :nested 2))))
-
-(defn generate-test-files-with-nested-feature-no-top-geometry []
-  (doseq [c [10 100 1000 10000 100000]]
-    (with-open [w (clojure.java.io/writer (str ".test-files/new-features-nested-feature-no-top-geometry-" c ".json"))]
-      (random-json-features w "nestedset" "collection1" c :nested 1 :geometry? false))))
-
-(defn generate-test-files-with-nested-features-no-top-geometry []
-  (doseq [c [5 50 500 5000 50000]]
-    (with-open [w (clojure.java.io/writer (str ".test-files/new-features-nested-features-no-top-geometry-" c ".json"))]
-      (random-json-features w "nestedset" "collection1" c :nested 2 :geometry? false))))
+    (with-open [w (clojure.java.io/output-stream (str ".test-files/new-features-nested-features-no-top-geometry-" c (if smile? ".smile" ".json")))]
+      (random-json-features w "nestedset" "collection1" c :smile? smile? :nested 2 :geometry? false))))


No need to save the tab id on either groups or snapshots, it's irrelevant

--- src/booklet/core.cljs
+++ src/booklet/core.cljs
@@ -61,6 +61,8 @@
   [col id]
   (remove #(= (:id %) id) col))

+;; Tab items we actually care about
+(def relevant-tab-items [:index :url :title :favIconUrl])

 ;;;;----------------------------
@@ -104,7 +106,7 @@
   :group-add
   (fn [app-state [_]]
     (let [tabs    (get-in app-state [:app-state :tabs])
-          to-save (map (fn [m] (select-keys m [:index :url :id :title :favIconUrl])) tabs)
+          to-save (map (fn [m] (select-keys m relevant-tab-items)) tabs)
           groups  (conj (or (get-in app-state [:data :groups]) '())
                         (group-from-tabs to-save))]
       (dispatch [:data-set :groups groups])
@@ -190,7 +192,7 @@
           snapshots (or (get-in app-state path) '())
           tabs      (->> (get-in app-state [:app-state :tabs])
                          filter-tabs
-                         (map #(select-keys % [:index :url :id :title :favIconUrl])))
+                         (map #(select-keys % relevant-tab-items)))
           new-group (group-from-tabs tabs)
           last-snap (or (get-in app-state [:app-state :last-snapshot])
                         (first (sort-by #(* -1 (:date %)) snapshots)))


Listing snapshots

Listing snapshots

Trivial implementation, the list function is not a component so it's
probably redrawing more than necessary.

--- src/booklet/core.cljs
+++ src/booklet/core.cljs
@@ -347,6 +347,38 @@
        ; [:button {:on-click #(storage/clear)} "Clear"]
        ])))

+(defn list-groups
+  [group-list editable? group-edit edit-label]
+  (for [group group-list]
+    ^{:key (:date group)}
+    [:div
+     [:div
+      (if (= group group-edit)
+        [initial-focus-wrapper
+         [:input {:type      "text"
+                  :class     "form-control"
+                  :value     edit-label
+                  :on-change #(dispatch-sync [:group-label-set (-> % .-target .-value)])
+                  :on-blur   #(do
+                               (dispatch [:group-update group (assoc group :name edit-label)])
+                               (dispatch [:group-edit-set nil]))
+                  }]]
+        [:h3 {:on-click #(dispatch [:group-edit-set group])} (group-label group)]
+        )
+      (if editable? [:small [:a {:on-click #(dispatch [:group-delete-set group])} "Delete"]])
+      ]
+
+     [:table {:class "table table-striped table-hover"}
+      [:thead
+       [:tr
+        [:th "#"]
+        [:th "Title"]
+        [:th "URL"]]]
+      [:tbody
+       (list-tabs (filter-tabs (:tabs group)) true)]
+      ]])
+  )
+
 (defn tab-groups []
   (let [tab-groups (subscribe [:data :groups])
         group-edit (subscribe [:ui-state :group-edit])
@@ -356,37 +388,18 @@
       [:div
        [modal-confirm]
        [:div {:class "page-header"} [:h2 "Previous groups"]]
-       (doall
-         (for [group @to-list]
-           ^{:key (:date group)}
-           [:div
-            [:div
-             (if (= group @group-edit)
-               [initial-focus-wrapper
-                [:input {:type      "text"
-                         :class     "form-control"
-                         :value     @label
-                         :on-change #(dispatch-sync [:group-label-set (-> % .-target .-value)])
-                         :on-blur   #(do
-                                      (dispatch [:group-update group (assoc group :name @label)])
-                                      (dispatch [:group-edit-set nil]))
-                         }]]
-               [:h3 {:on-click #(dispatch [:group-edit-set group])} (group-label group)]
-               )
-             [:small [:a {:on-click #(dispatch [:group-delete-set group])} "Delete"]]
-             ]
-
-            [:table {:class "table table-striped table-hover"}
-             [:thead
-              [:tr
-               [:th "#"]
-               [:th "Title"]
-               [:th "URL"]]]
-             [:tbody
-              (list-tabs (filter-tabs (:tabs group)) true)]
-             ]]))
-       ]
-      )
+       (list-groups @to-list true @group-edit @label)
+       ])
+    ))
+
+(defn snapshots []
+  (let [snapshots (subscribe [:data :snapshots])
+        to-list   (reaction (sort-by #(* -1 (:date %)) @snapshots))]
+    (fn []
+      [:div
+       [:div {:class "page-header"} [:h2 "Snapshots"]]
+       (list-groups @to-list false nil nil)
+       ])
     ))

@@ -423,10 +436,11 @@
        ])))

-(def component-dir {:monitor current-tabs
-                    :groups  tab-groups
-                    :export  data-export
-                    :import  data-import})
+(def component-dir {:monitor   current-tabs
+                    :groups    tab-groups
+                    :export    data-export
+                    :import    data-import
+                    :snapshots snapshots})

 (defn main-section []


add shopping functions

add shopping functions

--- src/ca_recipe/store.clj
+++ src/ca_recipe/store.clj
@@ -38,3 +38,15 @@
   "stock an item on the shelves"
   [item]
   (swap! inventory update-in [item] inc))
+
+(defn shop-for-item
+  "Shop for an item, return undated cart"
+  [cart item]
+  (if (store/grab item)
+    (conj cart item)
+    cart))
+
+(defn go-shopping
+  "Returns a list of items purchased"
+  [shopping-list]
+  (reduce shop-for-item [] shopping-list))


Syntax tweak

Syntax tweak

--- src/caesium/binding.clj
+++ src/caesium/binding.clj
@@ -29,7 +29,7 @@
     ^long ^{size_t {}} crypto_secretbox_keybytes []
     ^long ^{size_t {}} crypto_secretbox_noncebytes []
     ^long ^{size_t {}} crypto_secretbox_macbytes []
-    ^String ^{size_t {}} crypto_secretbox_primitive[]
+    ^String ^{size_t {}} crypto_secretbox_primitive []

     ^int crypto_secretbox_easy
     [^bytes ^{Pinned {}} c


Adapt builtin monads to protocol changes.

--- src/cats/builtin.cljc
+++ src/cats/builtin.cljc
@@ -50,8 +50,6 @@
 (def sequence-context
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (into sv' (reverse sv)))
@@ -159,8 +157,6 @@
 (def lazy-sequence-context
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (concat sv sv'))
@@ -237,8 +233,6 @@
 (def range-context
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Foldable
     (-foldr [ctx f z xs]
       (let [x (first xs)]
@@ -268,8 +262,6 @@
 (def vector-context
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (into sv sv'))
@@ -343,8 +335,6 @@
 (def map-context
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (merge sv sv'))
@@ -393,8 +383,6 @@
 (def set-context
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (s/union sv (set sv')))
@@ -449,8 +437,6 @@
 (def function-context
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [ctx f g] (comp f g))

@@ -498,8 +484,6 @@
 (def any-monoid
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (or sv sv'))
@@ -517,8 +501,6 @@
 (def all-monoid
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (and sv sv'))
@@ -536,8 +518,6 @@
 (def sum-monoid
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (+ sv sv'))
@@ -555,8 +535,6 @@
 (def prod-monoid
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (* sv sv'))
@@ -574,8 +552,6 @@
 (def string-monoid
   (reify
     p/Context
-    (-get-level [_] ctx/+level-default+)
-
     p/Semigroup
     (-mappend [_ sv sv']
       (str sv sv'))


fixing msg

fixing msg

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -85,7 +85,7 @@
      {:nickname "reloadSystem" :summary "System reload job"
       :errorResponses (errors {:bad-req "Missing system"})
       :notes "Reloads a system by destroying the VM and then re-creating it"}
-         (schedule-job id "create" "submitted system creation"))
+         (schedule-job id "reload" "submitted system reloading"))

   (POST- "/jobs/destroy/:id" [^:int id]
     {:nickname "destroySystem" :summary "System destruction job"


hash-set duplicate key regression

hash-set duplicate key regression

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -1316,8 +1316,7 @@
 (defmacro hash-set
   ([] `cljs.core.PersistentHashSet.EMPTY)
   ([& xs]
-    `(cljs.core.PersistentHashSet.fromArray
-       (array ~@(interleave xs (repeat nil))) true)))
+    `(set (array ~@xs))))

 (defmacro js-obj [& rest]
   (let [kvs-str (->> (repeat "~{}:~{}")


provide data oriented stacktrace mapping api

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -208,9 +208,9 @@
             [:line :col])))
       default)))

-(defn print-mapped-stacktrace
+(defn mapped-stacktrace
   "Given a vector representing the canonicalized JavaScript stacktrace
-   print the ClojureScript stacktrace. The canonical stacktrace must be
+   return the ClojureScript stacktrace. The canonical stacktrace must be
    in the form:

     [{:file <string>
@@ -219,28 +219,41 @@
       :column <integer>}*]

    :file must be a URL path (without protocol) relative to :output-dir."
-  ([stacktrace] (print-mapped-stacktrace stacktrace nil))
+  ([stacktrace] (mapped-stacktrace stacktrace nil))
   ([stacktrace opts]
     (let [read-source-map' (memoize read-source-map)
           ns-info' (memoize ns-info)]
-      (doseq [{:keys [function file line column] :as frame} stacktrace]
-        ;; need to convert file, a relative URL style path, to host-specific file
-        (let [file (io/file (URL. (.toURL (io/file (util/output-directory opts))) file))
-              [sm {:keys [ns source-file] :as ns-info}]
-              ((juxt read-source-map' ns-info') file)
-              [line' column'] (if ns-info
-                                (mapped-line-and-column sm line column)
-                                [line column])
-              name' (if (and ns-info function)
-                      (symbol (name ns) (cljrepl/demunge function))
-                      function)
-              file' (string/replace
-                      (.getCanonicalFile
-                        (if ns-info
-                          source-file
-                          (io/file file)))
-                      (str (System/getProperty "user.dir") File/separator) "")]
-          (println "\t" (str name' " (" file' ":" line' ":" column' ")")))))))
+      (vec
+        (for [{:keys [function file line column] :as frame} stacktrace]
+          ;; need to convert file, a relative URL style path, to host-specific file
+          (let [rfile (io/file (URL. (.toURL (io/file (util/output-directory opts))) file))
+                [sm {:keys [ns source-file] :as ns-info}]
+                ((juxt read-source-map' ns-info') rfile)
+                [line' column'] (if ns-info
+                                  (mapped-line-and-column sm line column)
+                                  [line column])
+                name' (if (and ns-info function)
+                        (symbol (name ns) (cljrepl/demunge function))
+                        function)
+                file' (string/replace
+                        (.getCanonicalFile
+                          (if ns-info
+                            source-file
+                            (io/file rfile)))
+                        (str (System/getProperty "user.dir") File/separator) "")]
+            {:function name'
+             :file     file'
+             :line     line'
+             :column   column'}))))))
+
+(defn print-mapped-stacktrace
+  "Given a vector representing the canonicalized JavaScript stacktrace
+   print the ClojureScript stacktrace. See mapped-stacktrace."
+  ([stacktrace] (print-mapped-stacktrace stacktrace nil))
+  ([stacktrace opts]
+    (doseq [{:keys [function file line column]}
+            (mapped-stacktrace stacktrace opts)]
+      (println "\t" (str function " (" file ":" line ":" column ")")))))

 (comment
   (cljsc/build "samples/hello/src"
@@ -255,6 +268,13 @@

   ;; hello.core
   (:ns (ns-info "samples/hello/out/hello/core.js"))
+
+  (mapped-stacktrace
+    [{:file "hello/core.js"
+      :function "first"
+      :line 2
+      :column 1}]
+    {:output-dir "samples/hello/out"})

   (print-mapped-stacktrace
     [{:file "hello/core.js"


CLJS-951: goog.require emitted multiple times under Node.js REPL

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -59,13 +59,15 @@
                     (remove (comp #{["goog"]} :provides))
                     (remove (comp #{:seed} :type))
                     (map #(select-keys % [:provides :url])))]
-     ;; for now only do this for REPLs that rely on disk - David
-     (when (:output-dir opts)
+     (if (:output-dir opts)
+       ;; REPLs that read from :output-dir just need to add deps,
+       ;; environment will handle actual loading - David
        (doseq [source (map #(cljsc/source-on-disk opts %) sources)]
          (-evaluate repl-env "<cljs repl>" 1
-           (cljsc/add-dep-string opts source))))
-     (doseq [{:keys [url provides]} deps]
-       (-load repl-env provides url)))))
+           (cljsc/add-dep-string opts source)))
+       ;; REPLs that stream must manually load each dep - David
+       (doseq [{:keys [url provides]} deps]
+         (-load repl-env provides url))))))

 (defn- load-dependencies
   ([repl-env requires] (load-dependencies repl-env requires nil))


make parse-headers private

make parse-headers private

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -7,7 +7,7 @@
   (:import (org.apache.http.client.params CookiePolicy ClientPNames))
   (:import (org.apache.http.impl.client DefaultHttpClient)))

-(defn parse-headers [#^HttpResponse http-resp]
+(defn- parse-headers [#^HttpResponse http-resp]
   (into {} (map (fn [#^Header h] [(.toLowerCase (.getName h)) (.getValue h)])
                 (iterator-seq (.headerIterator http-resp)))))


:bug: Removed last reflection warnings from clj-http.core

--- src/clj_http/core.clj
+++ src/clj_http/core.clj
@@ -40,6 +40,7 @@
            (org.apache.http.impl.nio.client HttpAsyncClientBuilder
                                             HttpAsyncClients
                                             CloseableHttpAsyncClient)
+           (org.apache.http.nio.conn NHttpClientConnectionManager)
            (org.apache.http.message BasicHttpResponse)
            (java.util.concurrent ExecutionException)))

@@ -319,6 +320,10 @@
     (or conn/*connection-manager*
         (conn/make-regular-conn-manager req))))

+(defmulti ^:private  shutdown class)
+(defmethod shutdown org.apache.http.conn.HttpClientConnectionManager      [^HttpClientConnectionManager  conn-mgr] (.shutdown conn-mgr))
+(defmethod shutdown org.apache.http.nio.conn.NHttpClientConnectionManager [^NHttpClientConnectionManager conn-mgr] (.shutdown conn-mgr))
+
 (defn request
   ([req] (request req nil nil))
   ([{:keys [body conn-timeout conn-request-timeout connection-manager
@@ -334,8 +339,6 @@
                        (when server-port (str ":" server-port))
                        uri
                        (when query-string (str "?" query-string)))
-; #### THIS DEADLOCKS THE TESTS FOR SOME REASON!!!!
-;         ^HttpClientConnectionManager conn-mgr (or connection-manager
          conn-mgr (or connection-manager
                       (get-conn-mgr async? req))
          proxy-ignore-hosts (or proxy-ignore-hosts
@@ -390,7 +393,7 @@
            (build-response-map (.execute client http-req context) req conn-mgr context)
            (catch Throwable t
              (when-not (conn/reusable? conn-mgr)
-               (.shutdown conn-mgr))
+               (shutdown conn-mgr))
              (throw t))))
        (let [^CloseableHttpAsyncClient client
              (http-async-client req conn-mgr http-url proxy-ignore-hosts)]
@@ -399,7 +402,7 @@
                    (reify org.apache.http.concurrent.FutureCallback
                      (failed [this ex]
                        (when-not (conn/reusable? conn-mgr)
-                         (.shutdown conn-mgr))
+                         (shutdown conn-mgr))
                        (if (:ignore-unknown-host? req)
                          ((:unknown-host-respond req) nil)
                          (raise ex)))
@@ -408,10 +411,10 @@
                          (respond (build-response-map resp req conn-mgr context))
                          (catch Throwable t
                            (when-not (conn/reusable? conn-mgr)
-                             (.shutdown conn-mgr))
+                             (shutdown conn-mgr))
                            (raise t))))
                      (cancelled [this]
                        (if-let [oncancel (:oncancel req)]
                          (oncancel))
                        (when-not (conn/reusable? conn-mgr)
-                         (.shutdown conn-mgr))))))))))
+                         (shutdown conn-mgr))))))))))


Switch to nanoTime in timer input.

Switch to nanoTime in timer input.

--- src/clojure/playasophy/wonderdome/input/timer.clj
+++ src/clojure/playasophy/wonderdome/input/timer.clj
@@ -16,11 +16,11 @@
   [period channel]
   (fn []
     (try
-      (loop [t (System/currentTimeMillis)]
+      (loop [t (System/nanoTime)]
         (when-not (Thread/interrupted)
           (Thread/sleep period)
-          (let [now (System/currentTimeMillis)]
-            (>!! channel {:type :time/tick, :elapsed (- now t)})
+          (let [now (System/nanoTime)]
+            (>!! channel {:type :time/tick, :elapsed (/ (- now t) 1000000.0)})
             (recur now))))
       (catch InterruptedException e
         nil))))


CMR-736: Added aliasing for NEAR_REAL_TIME to keyword param

--- src/cmr/search/services/parameters/conversion.clj
+++ src/cmr/search/services/parameters/conversion.clj
@@ -298,13 +298,19 @@
      :result-features (seq result-features)
      :pretty? pretty?}))

+(defn- alias-nrt
+  "Alias variations of NEAR_REAL_TIME to nrt"
+  [value]
+  (if (some #{value} nrt-aliases) "nrt" value))
+
 (defn parameters->query
   "Converts parameters into a query model."
   [concept-type params]
   (let [options (u/map-keys->kebab-case (get params :options {}))
         query-attribs (standard-params->query-attribs concept-type params)
         keywords (when (:keyword params)
-                   (str/split (str/lower-case (:keyword params)) #" "))
+                   (map alias-nrt (str/split (str/lower-case (:keyword params)) #" ")))
+        params (if keywords (assoc params :keyword (str/join " " keywords)) params)
         params (dissoc params :options :page-size :page-num :sort-key :result-format :pretty
                        :include-granule-counts :include-has-granules :include-facets)]
     (if (empty? params)


Added missing before-destroy call.

Added missing before-destroy call.

--- src/clj_record/core.clj
+++ src/clj_record/core.clj
@@ -141,6 +141,7 @@
   "Deletes by (record :id)."
   [model-name record]
   (connected (db-spec-for model-name)
+    (before-destroy model-name record)
     (sql/delete-rows (table-name model-name) ["id = ?" (:id record)])
     (after-destroy model-name record)))


Implemented min and max.  Completes #42.

Implemented min and max.  Completes #42.

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -656,6 +656,20 @@
 (defn dec
   "Returns a number one less than num."
   [x] (- x 1))
+
+(defn max
+  "Returns the greatest of the nums."
+  ([x] x)
+  ([x y] (js* "((~{x} > ~{y}) ? x : y)"))
+  ([x y & more]
+   (reduce max (max x y) more)))
+
+(defn min
+  "Returns the least of the nums."
+  ([x] x)
+  ([x y] (js* "((~{x} < ~{y}) ? x : y)"))
+  ([x y & more]
+   (reduce min (min x y) more)))

 (defn bit-xor
   "Bitwise exclusive or"
@@ -2338,6 +2352,10 @@
     (assert (= 121 (a21 100)))
     (assert (= 122 (a22 100)))
     (assert (= 123 (a23 100))))
+  (assert (= 5 (max 1 2 3 4 5)))
+  (assert (= 5.5 (max 1 2 3 4 5 5.5)))
+  (assert (= 1 (min 5 4 3 2 1)))
+  (assert (= 0.5 (min 5 4 3 0.5 2 1)))
   :ok
   )


Add js->clj, with some tests

Add js->clj, with some tests

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -2600,6 +2600,25 @@
   returns nil if d is not a Delay"
   [d]
     (-realized? d))
+
+(defn js->clj
+  "Recursively transforms JavaScript arrays into ClojureScript
+  vectors, and JavaScript objects into ClojureScript maps.  With
+  option ':keywordize-keys true' will convert object fields from
+  strings to keywords."
+  [x & options]
+  (let [{:keys [keywordize-keys]} options
+        keyfn (if keywordize-keys keyword str)
+        f (fn thisfn [x]
+            (cond
+             (seq? x) (doall (map thisfn x))
+             (coll? x) (into (empty x) (map thisfn x))
+             (goog.isArray x) (vec (map thisfn x))
+             (goog.isObject x) (into {} (for [k (js-keys x)]
+                                          [(keyfn k)
+                                           (thisfn (aget x k))]))
+             :else x))]
+    (f x)))

 (comment

@@ -2974,6 +2993,14 @@
   (assert (= ["a" [ 1 2] "foo"] (sort-by count ["foo" "a" [1 2]])))
   (assert (= ["foo" [1 2] "a"] (sort-by count > ["foo" "a" [1 2]])))

+  ;; js->clj
+  (assert (= {"a" 1, "b" 2} (js->clj (js* "{\"a\":1,\"b\":2}"))))
+  (assert (= {:a 1, :b 2} (js->clj (js* "{\"a\":1,\"b\":2}") :keywordize-keys true)))
+  (assert (= [[{:a 1, :b 2} {:a 1, :b 2}]]
+               (js->clj (js* "[[{\"a\":1,\"b\":2}, {\"a\":1,\"b\":2}]]") :keywordize-keys true)))
+  (assert (= [[{:a 1, :b 2} {:a 1, :b 2}]]
+               (js->clj [[{:a 1, :b 2} {:a 1, :b 2}]])))
+
   :ok
   )


`cljs.core/*print-fn*` needs to be defonce'ed

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -17,7 +17,7 @@

 (def *unchecked-if* false)

-(def
+(defonce
   ^{:doc "Each runtime environment provides a different way to print output.
   Whatever function *print-fn* is bound to will be passed any
   Strings which should be printed." :dynamic true}


Tweak game-loop to make more cohesive

Tweak game-loop to make more cohesive

--- src/cljs_game/core.cljs
+++ src/cljs_game/core.cljs
@@ -11,8 +11,10 @@
                   :entities []}))

 (defn update-world
-  [delta-time entities]
-  )
+  [entities delta-time]
+  (map (fn [entity]
+         (update-in entity [:components :position-component :y] + 1))
+       entities))

 (defn game-loop
   [now]
@@ -20,19 +22,20 @@
         leftover-time (@world :accum-time)
         time-step 16.666666666666668]
     (swap! world assoc :prev-time now)
-    (let [entities (-> (:entities @world)
-                       (input/process-input)
-                       (input/process-commands))]
-      (swap! world assoc :entities entities))
-    (when (@world :running)
-      (swap! world assoc :leftover-time
-             (loop [accumulated (+ leftover-time (- now prev))
-                    attempts 10]
-               (if (and (>= accumulated time-step)
-                        (>= attempts 0))
-                 (do (update-world time-step (:entities @world))
-                   (recur (- accumulated time-step) (dec attempts)))
-                 accumulated))))))
+    (loop [accumulated (+ leftover-time (- now prev))
+           attempts 10
+           entities (:entities @world)]
+      (if (and (>= accumulated time-step)
+               (>= attempts 0)
+               (:running @world))
+        (recur (- accumulated time-step)
+               (dec attempts)
+               (-> entities
+                   (input/process-input)
+                   (input/process-commands)
+                   (update-world time-step)))
+        (do (swap! world assoc :leftover-time accumulated)
+          (swap! world assoc :entities entities))))))

 (defn ^:export init-game []
   (let [backend (render/create-threejs-backend)


Eval non-vector arguments to defui

Eval non-vector arguments to defui

--- src/clojure/neko/ui.clj
+++ src/clojure/neko/ui.clj
@@ -140,15 +140,18 @@
   internal element. Presumes the `*context*` var to be bound. The
   second argument is a keyword that represents the type of the
   container UI element will be put in."
-  [[el-type attributes & inside-elements] container-type]
-  (let [klass (kw/classname el-type)
-        obj (gensym (.getSimpleName klass))]
-    `(let [~obj (new ~klass *context*)]
-       ~@(process-attributes el-type obj attributes container-type)
-       ~@(map (fn [el]
-                `(.addView ~obj ~(make-ui-element el el-type)))
-              inside-elements)
-       ~obj)))
+  [element container-type]
+  (if (vector? element)
+    (let [[el-type attributes & inside-elements] element
+          klass (kw/classname el-type)
+          obj (gensym (.getSimpleName klass))]
+      `(let [~obj (new ~klass *context*)]
+         ~@(process-attributes el-type obj attributes container-type)
+         ~@(map (fn [el]
+                  `(.addView ~obj ~(make-ui-element el el-type)))
+                inside-elements)
+         ~obj))
+    (make-ui-element (eval element) container-type)))

 (defmacro defui [tree]
   (make-ui-element tree nil))


fix port display for http page

fix port display for http page

closes #165

--- src/main/shadow/cljs/devtools/server/web.clj
+++ src/main/shadow/cljs/devtools/server/web.clj
@@ -24,8 +24,9 @@
           (html
             [:h2 "HTTP Servers"]
             [:ul
-             (for [{:keys [build-id port ssl] :as srv} (:servers dev-http)]
-               (let [url (str "http" (when ssl "s") "://localhost:" port)]
+             (for [{:keys [build-id instance] :as srv} (:servers dev-http)
+                   :let [{:keys [http-port https-port]} instance]]
+               (let [url (str "http" (when https-port "s") "://localhost:" (or https-port http-port))]
                  [:li [:a {:href url} (str url " - " (pr-str build-id))]]))])))

       [:div#root]


structure driven crawler just needs 100 documents

--- src/crawler/structure_driven.clj
+++ src/crawler/structure_driven.clj
@@ -8,7 +8,7 @@

 (defn stop?
   [{visited :visited}]
-  (<= 200 visited))
+  (<= 100 visited))

 (defn leaf?
   "A leaf for a structure driven crawler"


fix bad fn input

fix bad fn input

--- src/crucible/template.clj
+++ src/crucible/template.clj
@@ -18,7 +18,7 @@
                          :elements (s/nilable (s/map-of keyword? ::element))))

 (defn template "Make a template structure with the given description and elements"
-  [description & elements]
+  [description & {:as elements}]
   (let [input [description elements]
         spec ::template
         parsed (s/conform spec input)]


Indent code

Indent code

--- src/discuss/references/main.cljs
+++ src/discuss/references/main.cljs
@@ -82,9 +82,9 @@
     om/IRender
     (render [_]
       (dom/div #js {:className "text-center"}
-        (bs/button-primary #(println "btn show issues") "Show Issues")
-        " "
-        (bs/button-primary #(lib/change-view! :reference-create-with-ref) "Jump into the discussion")))))
+               (bs/button-primary #(println "btn show issues") "Show Issues")
+               " "
+               (bs/button-primary #(lib/change-view! :reference-create-with-ref) "Jump into the discussion")))))

 (defn dialog-view
   "Show a dialog to give the user the option to choose, whether she wants to get some information about the statement
@@ -93,13 +93,13 @@
   (reify om/IRender
     (render [_]
       (dom/div #js {:className "text-center"}
-        (om/build rlib/current-reference-component {})
-        (bs/button-primary #(query-reference-details (:id (rlib/get-selected-reference)))
-                           "Wo wird diese Referenz verwendet?")
-        " "
-        (dom/button #js {:className "btn btn-primary"
-                         :onClick   #(lib/change-view! :reference-create-with-ref)}
-                    "Springe in die Diskussion")))))
+               (om/build rlib/current-reference-component {})
+               (bs/button-primary #(query-reference-details (:id (rlib/get-selected-reference)))
+                                  "Wo wird diese Referenz verwendet?")
+               " "
+               (dom/button #js {:className "btn btn-primary"
+                                :onClick   #(lib/change-view! :reference-create-with-ref)}
+                           "Springe in die Diskussion")))))

 (defn usage-view
   "A single item showing the usage of the currently selected reference."


add type

add type

--- src/dataanalysis/core.clj
+++ src/dataanalysis/core.clj
@@ -23,7 +23,7 @@
   (GET "/lfpr" [] (rr/content-type
                    (rr/response  (db/get-lfpr))
                    "application/json; charset=utf-8"))
-  (GET "/lfpr/:type" [title]
+  (GET "/lfpr/:type" [type]
        (rr/content-type
         (rr/response  (db/get-lfpr-by-type {:type type}))
         "application/json; charset=utf-8"))


Dev-page watermark support. Working, but still dirty.  [BugId: 179]

--- src/degel/muxx/server.clj
+++ src/degel/muxx/server.clj
@@ -32,14 +32,15 @@
    base-page      ;; base html page, for the production site.
    production-js  ;; JavaScript to load on the production page.
    dev-js         ;; JavaScript to load on the development page.
+   dev-background-image ;; Watermark to  show on dev page
    ])

 (defn add-app
   "Add an app to this deployment. Apps are keyed by name."
-  [{:keys [name base-page production-js dev-js] :as app-map}]
+  [{:keys [name base-page production-js dev-js dev-background-image] :as app-map}]
   (swap! app-dispatch
-         assoc name (->app-data name base-page production-js dev-js)))
+         assoc name (->app-data name base-page production-js dev-js dev-background-image)))

 (defn default-app-properties
@@ -49,17 +50,19 @@
   {:name app-name
    :base-page (str "/" app-name ".html")
    :production-js (str "js/" app-name ".js")
-   :dev-js (str "js/" app-name "-dev.js")})
+   :dev-js (str "js/" app-name "-dev.js")
+   :dev-background-image "dev-page.png"})

 (defn- dev-page
   "Create a development page from the production page. Currently, this
    changes which JavaScript is run (typically to support debugging), and
    injects Austin support for brower-repl access to the page."
-  ([{:keys [base-page production-js dev-js]}]
-     (dev-page (str "public" base-page) production-js dev-js))
-  ([page production-js dev-js]
+  ([{:keys [base-page production-js dev-js dev-background-image]}]
+     (dev-page (str "public" base-page) production-js dev-js dev-background-image))
+  ([page production-js dev-js dev-background-image]
      ((html/template page []
+        [:body] (html/set-attr :background dev-background-image)
         [:body] (html/append (html/html [:script (austin-repls/browser-connected-repl-js)]))
         [[:script (html/attr= :src production-js)]] (html/set-attr :src dev-js)))))


Refactoring error handling logic for waive endpoint

--- src/emender_jenkins/rest_api.clj
+++ src/emender_jenkins/rest_api.clj
@@ -555,21 +555,26 @@
              (-> (create-bad-request-response "running_jobs" "Can not read Jenkins queue and/or selected view")
                  (send-error-response request :internal-server-error)))))

-(defn read-test-to-waive
+(defn read-waive-input-data
     [request]
     (try
         (-> request
             read-request-body
             (json/read-str :key-fn clojure.core/keyword))
         (catch Exception e
-            (log/error "Can not read POST data" (.getMessage e)))))
+            (throw (new Exception (str "Can not read POST data: " (.getMessage e)))))))

 (defn waive
     "Waive one test result."
     [request]
-    (if-let [test-to-waive (read-test-to-waive request)]
-        (send-response test-to-waive request)
-        (send-error-response "Bad request" request :bad-request)
+    (try
+        (let [waive-input-data  (read-waive-input-data request)]
+             ; parsed-waive-data (parse-waive-data waive-input-data)]
+              (send-response waive-input-data request))
+        (catch Exception e
+            (let [error-message (str "Error waiving test results: " (.getMessage e))]
+                (log/error error-message)
+                (send-error-response error-message request :bad-request)))
     )
 )


I have reassembled FPINS variant of tree and tree mapping function from there as well.

--- src/fpinscala/datastructures.clj
+++ src/fpinscala/datastructures.clj
@@ -503,10 +503,28 @@

 ;3.29
 ;first I try with my original "xconj" structure
-(defn fold
+;I am not really sure how to sneak out without having acc as my structure
+;does not goes via ADTs to acommodate termination?
+(defn t-fold
   "Folds tree. t is tree, f is function of transformation and g is accumulator function"
-  [t f g]
+  [t f g init]
   (letfn [(go [t acc]
               (if (nil? t)
                 acc
-                ))]))
+                (if (and (nil? (:L t)) (nil? (:R t)))
+                  (f (:val t))
+                  (g (go (:R t) acc) (go (:L t) acc)))))]
+    (g (go (:R t) init) (go (:L t) init))))
+
+(defn t-size-via-t-fold [t]
+  (t-fold t (fn [_] 1) #(+ 1 % %2) 1))
+
+(defn t-max-via-t-fold [t]
+  (t-fold t #(identity %) #(max % %2) (:val t)))
+
+(defn t-depth-via-t-fold [t]
+  (t-fold t (fn [_] 0) #(+ 1 (max % %2)) 1))
+
+;My xconj original structure does not allow proper implementation of map via fold
+;as it does not allow explicit association of "branch"
+;This one will be marked as partially solved :/


Improve :value hints of board mutations

Improve :value hints of board mutations

--- src/kanban/parsing/boards.cljs
+++ src/kanban/parsing/boards.cljs
@@ -27,7 +27,8 @@

 (defmethod mutate 'boards/activate
   [{:keys [state]} _ {:keys [ref]}]
-  {:action #(swap! state assoc :boards/active ref)})
+  {:value [:boards/active]
+   :action #(swap! state assoc :boards/active ref)})

 (defmethod read :boards/editing
   [{:keys [state]} key _]
@@ -43,7 +44,8 @@

 (defmethod mutate 'boards/update
   [{:keys [state]} _ {:keys [board data]}]
-  {:action (fn [] (swap! state update-in board #(merge % data)))})
+  {:value [:boards :boards/active]
+   :action (fn [] (swap! state update-in board #(merge % data)))})

 (defn create-board [st]
   (let [id    (->> (get-boards st :boards) (map :id) (cons 0) (reduce max) inc)
@@ -56,5 +58,5 @@

 (defmethod mutate 'boards/create-board
   [{:keys [state]} _ _]
-  {:value [:boards]
+  {:value [:boards :boards/editing]
    :action #(swap! state create-board)})


Added a handy little inspection middleware.

--- src/lambda_blog/middleware.clj
+++ src/lambda_blog/middleware.clj
@@ -1,8 +1,10 @@
 (ns lambda-blog.middleware
   (:refer-clojure :exclude [replace])
-  (:require [clojure.set :refer [union]]
+  (:require [clojure.pprint :refer [pprint]]
+            [clojure.set :refer [union]]
             [clojure.string :refer [replace]]
-            [lambda-blog.utils :refer [pathcat sanitize]]))
+            [lambda-blog.utils :refer [pathcat sanitize]]
+            [taoensso.timbre :as log]))

 (defn- fmt [f args]
   (->> f
@@ -55,3 +57,7 @@
               (assoc e k v))
             entity
             (entity what))))
+
+(defn inspect [entity]
+  (log/debug (with-out-str (pprint entity)))
+  entity)


Fixed lint errors.

Fixed lint errors.

--- src/dragon/dev/system.clj
+++ src/dragon/dev/system.clj
@@ -131,9 +131,9 @@
   (if (contains? invalid-startup-transitions state)
     (log/warn "System is already running.")
     (do
-      (when (not (contains? invalid-init-transitions state))
+      (when-not (contains? invalid-init-transitions state)
         (init))
-      (when (not (contains? invalid-start-transitions state))
+      (when-not (contains? invalid-start-transitions state)
         (start))
       (set-state :running)
       state)))
@@ -146,9 +146,9 @@
   (if (contains? invalid-shutdown-transitions state)
     (log/warn "System is already shutdown.")
     (do
-      (when (not (contains? invalid-stop-transitions state))
+      (when-not (contains? invalid-stop-transitions state)
         (stop))
-      (when (not (contains? invalid-deinit-transitions state))
+      (when-not (contains? invalid-deinit-transitions state)
         (deinit))
       (set-state :shutdown)
       state)))


removed unnecessary prints

removed unnecessary prints

--- src/frontend/uploads.cljs
+++ src/frontend/uploads.cljs
@@ -69,14 +69,10 @@
                                      (:uploads new-state))]
     (if-not (nil? (first uploads-keys-diff))
       (let [deleted-upload-ids (first (keys (first uploads-keys-diff)))]
-        (println "old-state" (:uploads old-state))
-        (println "new-state" (:uploads new-state))
-        (println "DELETED-UPLOAD-ID" deleted-upload-ids)
         (if-not (nil? deleted-upload-ids)
           (let [active-uploads   (vec (remove (set deleted-upload-ids) (:active-uploads new-state)))
                 inactive-uploads (vec (remove (set deleted-upload-ids) (:inactive-uploads new-state)))
                 uploads (:uploads new-state)]
-            (println "INACTIVE-UPLOADS:" inactive-uploads)
             (if-not (empty? inactive-uploads)
               (swap! app-state/app-state
                      merge
@@ -84,8 +80,7 @@
                                                      (first inactive-uploads))
                       :inactive-uploads (drop-first-upload inactive-uploads)
                       :uploads (merge uploads {(first inactive-uploads)
-                                               (start-upload (uploads (first inactive-uploads)))})})))))))
-  (println "APP-STATE" @app-state/app-state))
+                                               (start-upload (uploads (first inactive-uploads)))})}))))))))

 (add-watch app-state/app-state :upload-removed upload-removed-watch-fn!)


Add writer helper for testing purposes

Add writer helper for testing purposes

--- src/io/cyanite/engine/writer.clj
+++ src/io/cyanite/engine/writer.clj
@@ -22,3 +22,21 @@
   engine/Acceptor
   (accept! [this metric]
     (q/add! writeq metric)))
+
+(defn memory-writer
+  "Extremely inefficient in-memory acceptor that writes everything to the internal vector, to be used
+   for testing/mocking purposes"
+  ([]
+   (memory-writer conj))
+  ([f]
+   (let [state (atom [])]
+     (reify
+       component/Lifecycle
+       (start [this] this)
+       (stop [this] this)
+       clojure.lang.IDeref
+       (deref [this]
+         @state)
+       engine/Acceptor
+       (accept! [this metric]
+         (swap! state f metric))))))


Create main function for core

Create main function for core

--- src/discuss/core.cljs
+++ src/discuss/core.cljs
@@ -9,9 +9,10 @@
 (enable-console-print!)

 ;; Initialization
-(com/init!)
-(discuss.auth/one-click-login)
-(com/post-origin-get-references)
+(defn main []
+  (com/init!)
+  (discuss.auth/one-click-login)
+  (com/post-origin-get-references))

 ;; Register
 (om/root views/main-view lib/app-state
@@ -30,5 +31,4 @@
   ;; optionally touch your app-state to force rerendering depending on
   ;; your application
   ;; (swap! app-state update-in [:__figwheel_counter] inc)
-  ; (test/run)
   )


WIP: testing, add-qualifiers doesnt work for node qualifiers

--- src/domshot/core.cljs
+++ src/domshot/core.cljs
@@ -89,3 +89,18 @@
                             (clj->js (for [i (range (count (:children structure)))
                                            :let [child (nth (:children structure) i)]]
                                        (build child))))))))
+
+
+;; ---- Testing ---- TODO: delete this! ---- ;;
+
+(defn is-not-style [name _]
+  (not= "style" name))
+
+(defn is-not-empty-text [node]
+  (println "node" node)
+  true)
+
+(add-qualifier is-not-style :attribute)
+(add-qualifier is-not-empty-text)
+
+(println (snapshot (goog.dom/getElement "outer")))


adjust tesla link placement

adjust tesla link placement

--- src/pc/views/blog/blue_ocean_made_of_ink.clj
+++ src/pc/views/blog/blue_ocean_made_of_ink.clj
@@ -18,9 +18,8 @@
      [:blockquote "Our true competition is not the small trickle of non-Tesla electric cars being produced, but rather the enormous flood of gasoline cars pouring out of the world's factories every day."]]

     [:article
-     [:p "Elon Musk "
-         [:a {:href "http://www.teslamotors.com/blog/all-our-patent-are-belong-you"} "said that about Telsa"]
-         " last year.
+     [:p [:a {:href "http://www.teslamotors.com/blog/all-our-patent-are-belong-you"} "Elon Musk"]
+         " said that about Telsa last year.
          Prototyping stands on similar shores.
          For every single designer or developer using an app to prototype their product, there's a thousand using pen and paper."]]


Isolate tests with a fresh client & use dynamic var for server

With Clojure 1.6, there are sporadic test failures when the same client
is used for each test.  Not yet sure why, but the failures frequently
appear in test-head.

--- test/http/async/client/test.clj
+++ test/http/async/client/test.clj
@@ -45,6 +45,7 @@
 (set! *warn-on-reflection* true)

 (def ^:dynamic *client* nil)
+(def ^:dynamic *server* nil)
 (def ^:private ^:dynamic *default-encoding* "UTF-8")

@@ -165,15 +166,20 @@

 (defn- once-fixture [f]
   "Configures Logger before test here are executed, and closes AHC after tests are done."
-  (def srv (start-jetty default-handler))
+  (binding [*server* (start-jetty default-handler)]
+    (try (f)
+         (finally
+           (.stop ^Server *server*)))))
+
+(defn- each-fixture
+  [f]
   (binding [*client* (create-client)]
     (try (f)
          (finally
-          (do
-            (.close ^AsyncHttpClient *client*)
-            (.stop ^Server srv))))))
+           (.close ^AsyncHttpClient *client*)))))

 (use-fixtures :once once-fixture)
+(use-fixtures :each each-fixture)

 ;; testing
 (deftest test-status


Delay rq-handler defer until on the 'server side'.


Fix connect and test in auto mode when there are no jar files

--- src/sqls/jdbc.clj
+++ src/sqls/jdbc.clj
@@ -35,8 +35,16 @@

 (defn connect-with-urls!
-  "Try to connect using URLClassLoader initialized with given url."
+  "Try to connect using URLClassLoader initialized with given url.
+
+  Parameters:
+
+  - conn-data - defines connection metadata,
+  - urls - nonempty coll of urls.
+  "
   [^clojure.lang.IPersistentMap conn-data urls]
+  (assert (not= urls nil))
+  (assert (> (count urls) 0))
   (let [conn-class (conn-data "class")
         conn-str (conn-data "jdbc-conn-str")
         url-class-loader (java.net.URLClassLoader. (into-array urls))
@@ -81,7 +89,9 @@
   [conn-data]
   (let [jar-paths (util/find-driver-jars)
         jar-urls (map (fn [p] (java.net.URL. "file" "" p)) jar-paths)]
-    (connect-with-urls! conn-data jar-urls)))
+    (if (> (count jar-urls) 0)
+      (connect-with-urls! conn-data jar-urls)
+      nil)))

 (defn connect-with-auto!
@@ -135,8 +145,12 @@
       (let [^java.sql.Connection conn (if (not (blank? conn-jar))
                                         (connect-with-path! conn-data)
                                         (connect-with-auto! conn-data))]
-        (.setAutoCommit conn false)
-        {:conn conn})
+        (if (not= conn nil)
+          (do
+            (.setAutoCommit conn false)
+            {:conn conn})
+          {:conn nil
+           :msg "Connection failed"}))
       (catch java.security.PrivilegedActionException e {:conn nil
                                                         :msg (str e)
                                                         :desc (exception-to-stacktrace e)})


Fix missing import

Fix missing import

--- src/googlica/common.clj
+++ src/googlica/common.clj
@@ -1,6 +1,7 @@
 (ns googlica.common
   (:gen-class)
   (:require [googlica.auth :as auth]
+            [cheshire.core :refer [parse-string generate-string]]
             [clj-http.client :as http]))

 (defn ?assoc


Compensate extra space occupied by 1-group

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -50,16 +50,21 @@
   (fn [[result tokens] group]
     (first group)))

-(defmethod fill-group 0 [[result tokens] group]
-  [(conj result (string/join (repeat (count group) " "))) tokens])
-
-(defmethod fill-group 1 [[result tokens] group]
-      (let [[column rest-ts] (fill-column tokens (count group))]
-        [(conj result column) rest-ts]))
+;; shorten defined for 0 group only: how much chars "eaten" by preceding 1-groups
+(defmethod fill-group 0 [[result tokens shorten] group]
+  (let [l (max 1 (- (count group) shorten))]
+   [(conj result (string/join (repeat l " "))) tokens 0]))
+
+(defmethod fill-group 1 [[result tokens _] group]
+      (let [l                (count group)
+            [column rest-ts] (fill-column tokens l)
+            extra-len (- (count column) l)]
+        (println extra-len)
+        [(conj result column) rest-ts extra-len]))

 (defn arrange-tokens-line [ts line]
   (let [groups (partition-by identity line)
-        [this-line-tokens ts-rest] (reduce fill-group [[] ts] groups)]
+        [this-line-tokens ts-rest _] (reduce fill-group [[] ts 0] groups)]
     [(string/join this-line-tokens) ts-rest]))

 (defn arrange-tokens [ts img]


trying to move image upload to clojure - partial

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -119,13 +119,11 @@

 (def window (dom/getWindow))
 (events/listen window "domready"
-               ;#(let [fileUpload (dom/getElement "fileInput")]
-               ;  (when fileUpload
-               ;    (events/listen fileUpload "change" handle-files))
-               ;  )
                (fn [] (
-                       (.log js/console "domready")
-                       ))
-               )
+                        (let [fileUpload (dom/getElement "fileInput")]
+                          (when fileUpload
+                            (events/listen fileUpload "change" handle-files))
+                          )
+                        (.log js/console "domready")
+                        )))

-


replace multimethod with protocol

replace multimethod with protocol

--- src/hiccup/compiler.clj
+++ src/hiccup/compiler.clj
@@ -54,10 +54,9 @@
       [tag (merge tag-attrs map-attrs) (next content)]
       [tag tag-attrs content])))

-(defmulti render-html
-  "Turn a Clojure data type into a string of HTML."
-  {:private true}
-  type)
+(defprotocol HtmlRenderer
+  (render-html [this]
+    "Turn a Clojure data type into a string of HTML."))

 (defn- render-element
   "Render an element vector as a HTML element."
@@ -69,15 +68,19 @@
            "</" tag ">")
       (str "<" tag (render-attr-map attrs) (end-tag)))))

-(defmethod render-html IPersistentVector
-  [element]
-  (render-element element))
-
-(defmethod render-html ISeq [coll]
-  (apply str (map render-html coll)))
-
-(defmethod render-html :default [x]
-  (as-str x))
+(extend-protocol HtmlRenderer
+  IPersistentVector
+  (render-html [this]
+    (render-element this))
+  ISeq
+  (render-html [this]
+    (apply str (map render-html this)))
+  Object
+  (render-html [this]
+    (str this))
+  nil
+  (render-html [this]
+    ""))

 (defn- unevaluated?
   "True if the expression has not been evaluated."


sensors-div wip

sensors-div wip

--- src-cljs/kixi/hecuba/tabs/programmes.cljs
+++ src-cljs/kixi/hecuba/tabs/programmes.cljs
@@ -542,29 +542,30 @@
       (let [{:keys [programmes projects properties devices sensors active-components]} data
             history (om/get-shared owner :history)]
         (html
-         [:div {:id "sensors-div" :class (if (:device-id sensors) "" "hidden")}
-          [:h2 {:id "sensors"} "Sensors"]
-          [:ul {:class "breadcrumb"}
-           [:li [:a
-                 {:onClick (back-to-programmes history)}
-                 (title-for programmes)]]
-           [:li [:a
-                 {:onClick (back-to-projects history)}
-                 (title-for projects)]]
-           [:li [:a
-                 {:onClick (back-to-properties history)}
-                 (title-for properties :title-key :address-street-two)]]
-           [:li [:a
-                 {:onClick (back-to-devices history)}
-                 (title-for devices :title-key [:location :name])]]]
-          (om/build sensors-table data {:opts {:histkey :sensors
-                                               :path    :readings}})
-          [:div {:id "chart-div"}
-           [:div {:id "date-picker"}
-            (om/build dtpicker/date-picker data {:opts {:histkey :range}})]
-           (om/build chart-feedback-box (get-in data [:chart :message]))
-           [:div {:className "well" :id "chart" :style {:width "100%" :height 600}}
-            (om/build chart/chart-figure (:chart data))]]])))))
+         [:div {:id "sensors-div"}
+          [:div {:class (if (:device-id sensors) "" "hidden")}
+           [:h2 {:id "sensors"} "Sensors"]
+           [:ul {:class "breadcrumb"}
+            [:li [:a
+                  {:onClick (back-to-programmes history)}
+                  (title-for programmes)]]
+            [:li [:a
+                  {:onClick (back-to-projects history)}
+                  (title-for projects)]]
+            [:li [:a
+                  {:onClick (back-to-properties history)}
+                  (title-for properties :title-key :address-street-two)]]
+            [:li [:a
+                  {:onClick (back-to-devices history)}
+                  (title-for devices :title-key [:location :name])]]]
+           (om/build sensors-table data {:opts {:histkey :sensors
+                                                :path    :readings}})
+           [:div {:id "chart-div"}
+            [:div {:id "date-picker"}
+             (om/build dtpicker/date-picker data {:opts {:histkey :range}})]
+            (om/build chart-feedback-box (get-in data [:chart :message]))
+            [:div {:className "well" :id "chart" :style {:width "100%" :height 600}}
+             (om/build chart/chart-figure (:chart data))]]]])))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Main View


Skip paging for find-one

Skip paging for find-one


fix it

fix it

--- resources/leiningen/new/closp/project.clj
+++ resources/leiningen/new/closp/project.clj
@@ -139,9 +139,9 @@

   :aliases {"rel-jar" ["do" "clean," "cljsbuild" "once" "adv," "uberjar"]
             "unit" ["do" "test" ":unit"]
-            "integ" ["do" "test" ":integration"]}
+            "integ" ["do" "test" ":integration"]

             ; migration utilities
             "migrate" ["run" "-m" "joplin.alias/migrate" "joplin.edn" "sqlite-dev-env" "sqlite-dev"]
             "rollback" ["run" "-m" "joplin.alias/rollback" "joplin.edn" "sqlite-dev-env" "sqlite-dev"]
-            "reset" ["run" "-m" "joplin.alias/reset" "joplin.edn" "sqlite-dev-env" "sqlite-dev"])
+            "reset" ["run" "-m" "joplin.alias/reset" "joplin.edn" "sqlite-dev-env" "sqlite-dev"]})


fix name stomping

fix name stomping

--- src/metabase/models/database.clj
+++ src/metabase/models/database.clj
@@ -43,10 +43,10 @@
   "Perform a native (i.e. SQL) query against DATABASE.
    ex. `(let [db (sel :one Database :name \"spotguides\")]
           ((:native-query db) \"SELECT COUNT(*) FROM main_guide;\"))`"
-  ([database native-query]
-   (native-query database native-query true))
-  ([database native-query return-results?]
-   (exec-raw @(:connection database) native-query (when return-results? :results))))
+  ([database sql]
+   (native-query database sql true))
+  ([database sql return-results?]
+   (exec-raw @(:connection database) sql (when return-results? :results))))

 (defmethod post-select Database [_ {:keys [organization_id] :as db}]
   (-> db


Shouldn't sleep this long when generating segments

--- src/onyx/plugin/bench_plugin.clj
+++ src/onyx/plugin/bench_plugin.clj
@@ -48,7 +48,7 @@
     (let [_ (while (< (- max-pending
                          (count @pending-messages))
                       batch-size)
-              (Thread/sleep 100))
+              (Thread/sleep 1))
           max-segments batch-size
           segments (->> (flush-swap! retry
                                      #(take max-segments %)


Don't hard code posthere.io as the host in the PUT/PATCH/POST response body when capturing results.

--- src/posthere/capture_request.clj
+++ src/posthere/capture_request.clj
@@ -30,13 +30,13 @@

 ;; ----- HTTP Response -----

-(defn post-response-body [url-uuid]
-  (str "We got your request! View your results at: http://posthere.io/" url-uuid "\n"))
+(defn post-response-body [url-uuid host]
+  (str "We got your request! View your results at: http://" host "/" url-uuid "\n"))

 (defn- post-response
   "Create the response to the stored POST request."
   [url-uuid request]
-  (-> (post-response-body url-uuid) ; string with directions
+  (-> (post-response-body url-uuid (get-in request [:headers "host"])) ; string with directions
     (response) ; make the string the body of our response
     (header "Content-Type" "text/plain") ; add a content type header
     (status (:status request)))) ; add the HTTP status of the response


Improved conversion from SPARQL results to Clojure data structures

--- src/rdf_path_examples/sparql.clj
+++ src/rdf_path_examples/sparql.clj
@@ -3,7 +3,26 @@
   (:import [org.apache.jena.rdf.model Literal Model Resource]
            [org.apache.jena.query QueryExecutionFactory QueryFactory]
            [org.apache.jena.query Dataset]
-           [org.apache.jena.update UpdateAction UpdateFactory]))
+           [org.apache.jena.update UpdateAction UpdateFactory]
+           [org.apache.jena.datatypes.xsd XSDDatatype]))
+
+; ----- Multimethods -----
+
+(defmulti literal->clj
+  "Convert RDF literal to a Clojure scalar data type."
+  (fn [literal] (.getDatatype literal)))
+
+(defmethod literal->clj XSDDatatype/XSDboolean
+  [literal]
+  (.getBoolean literal))
+
+(defmethod literal->clj XSDDatatype/XSDduration
+  [literal]
+  (.getLexicalForm literal))
+
+(defmethod literal->clj :default
+  [literal]
+  (.getValue literal))

 ; ----- Protocols -----

@@ -13,7 +32,8 @@

 (extend-protocol IStringifiableNode
   Literal
-  (node->clj [node] (.getValue node))
+  (node->clj [node] (literal->clj node))
+    ;(.getLexicalForm node))

   Resource
   (node->clj [node] (str node)))
@@ -28,7 +48,7 @@
   "Process SPARQL SELECT `solution` for `result-vars`."
   [result-vars solution]
   (into {} (mapv (partial process-select-binding solution) result-vars)))
-
+
 ; ----- Public functions -----

 (defn ^Boolean ask-query


make thx sound more beefy

make thx sound more beefy

--- examples/thx.clj
+++ examples/thx.clj
@@ -1,7 +1,7 @@
 (ns examples.thx
   (use [overtone.live]))

-;;THX sound simulation by Geirmund Simonsen
+;;Original THX sound simulation by Geirmund Simonsen:
 ;;{
 ;;        var randomFreq, ampEnv, riseCurve, doAdder, doArray;
 ;;        doAdder = 0;
@@ -13,12 +13,21 @@
 ;;        Out.ar(0, doAdder*ampEnv);
 ;;}.play

+(definst thx [gate 1]
+  (let [target-pitches (map midi->hz [77 74 72 70 65 62 60 58 53 50 46 34 26 22 14 10 ])
+        r-freq         (env-gen:kr (envelope [1 1 0.007 10] [8 4 2] [0 -4 1] 2) gate )
+        amp-env        (env-gen:kr (envelope [0 0.07 0.21 0] [8 4 2] [0 1 1] 2) gate :action FREE)
+        mk-noise       (fn [ug-osc]
+                         (mix (map #(pan2 (ug-osc (+ (* r-freq (+ 230 (* 100 (lf-noise2:kr 1.3))))
+                                                     (env-gen:kr (envelope [0 0 %] [8 6] [0 -3]))))
+                                          (lf-noise2:kr 5))
+                                   target-pitches)))
+        saws           (mk-noise saw)
+        sins           (mk-noise sin-osc)
+        snd (+ (* saws amp-env) (* sins amp-env))]
+    (g-verb snd 9 0.7 0)))

-(demo 25
-      (let [target-pitches (map midi->hz [77 74 72 70 65 62 60 58 53 50 46 34])
-            r-freq         (env-gen:kr (envelope [1 1 0.007] [8 6] [0 -4]) 1)
-            amp-env        (env-gen:kr (envelope [0.07 0.07 0.21] [8 6] [0 1]) 1)
-            saws           (apply + (map #(pan2 (saw (+ (* r-freq (+ 230 (* 100 (lf-noise2:kr 1.3))))
-                                                           (env-gen:kr (envelope [0 0 %] [8 6] [0 -3]) 1)))
-                                                   (lf-noise2:kr 1.3)) target-pitches))]
-        (* saws amp-env)))
+;;play the instrument:
+;;(thx)
+;;kill it off when you're ready
+;;(ctl thx :gate 0)


fix added code not in when-let block

fix added code not in when-let block

--- storm-core/src/clj/backtype/storm/daemon/drpc.clj
+++ storm-core/src/clj/backtype/storm/daemon/drpc.clj
@@ -62,9 +62,9 @@
                           (when (> (time-delta start) (conf DRPC-REQUEST-TIMEOUT-SECS))
                             (when-let [sem (@id->sem id)]
                               (swap! id->result assoc id (DRPCExecutionException. "Request timed out"))
-                              (.release sem))
                               (.remove (acquire-queue request-queues (@id->function id)) (@id->request id))
                               (log-warn "Timeout DRPC request id: " id " start at " start)
+                              (.release sem))
                             (cleanup id)
                             ))
                         TIMEOUT-CHECK-SECS