run now returns container id

run now returns container id

--- src/clj_docker/core.clj
+++ src/clj_docker/core.clj
@@ -51,21 +51,21 @@
   (let [host-config (-> config
                         (assoc :image (str image (when tag (str ":" tag))))
                         (dissoc :name :tag :repo :registry))
-        container (try+
-                   (container/create-from-config cli host-config :name name)
-                   (catch #(= (:type %) ::clj-docker.client/not-found) _
-                     (image/create-image cli image
-                                         :tag tag
-                                         :repo repo
-                                         :registry registry)
-                     (container/create-from-config cli host-config :name name)))]
-    (container/start cli container
+        container-id (:id (try+
+                           (container/create-from-config cli host-config :name name)
+                           (catch #(= (:type %) ::clj-docker.client/not-found) _
+                             (image/create cli image
+                                           :tag tag
+                                           :repo repo
+                                           :registry registry)
+                             (container/create-from-config cli host-config :name name))))]
+    (container/start cli container-id
                      :binds             binds
                      :lxc-conf          lxc-conf
                      :port-bindigs      port-bindings
                      :publish-all-ports publish-all-ports
                      :privileged        privileged)
-    container))
+    container-id))

 (defn commit [cli container & {:keys [repo tag message author]}]
   (utils/map-keys ->kebab-case


Fix generate-query-string to handle sequential values properly.

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -126,9 +126,17 @@

 (defn generate-query-string [params]
   (str/join "&"
-            (map (fn [[k v]] (str (util/url-encode (name k)) "="
-                                  (util/url-encode (str v))))
-                 params)))
+            (mapcat (fn [[k v]]
+                      (if (sequential? v)
+                        (map #(str (util/url-encode (name %1))
+                                   "="
+                                   (util/url-encode (str %2)))
+                             (repeat k) v)
+                        [(str (util/url-encode (name k))
+                              "="
+                              (util/url-encode (str v)))]))
+                    params)))
+

 (defn wrap-query-params [client]
   (fn [{:keys [query-params] :as req}]


correct blatant errors in clj-http.client

--- src/clj_http/client.clj
+++ src/clj_http/client.clj
@@ -57,7 +57,7 @@
     (if accept-encoding
       (client (-> req (dissoc :accept)
                       (assoc-in [:headers "Accept-Encoding"]
-                        (content-type-value accept-encoding))))
+                        (accept-encoding-value accept-encoding))))
       (client req))))

@@ -140,7 +140,6 @@
     (wrap-basic-auth)
     (wrap-accept)
     (wrap-accept-encoding)
-    (wrap-content-type)
     (wrap-method)
     (wrap-url)))


* src/cljs/cljs/core.cljs: (coercive-= foo nil) -> (nil? foo)

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -1542,7 +1542,7 @@
 (defn cons
   "Returns a new seq where x is the first element and seq is the rest."
   [x coll]
-  (if (or (coercive-= coll nil)
+  (if (or (nil? coll)
           (satisfies? ISeq coll))
     (Cons. nil x coll nil)
     (Cons. nil x (seq coll) nil)))
@@ -3045,7 +3045,7 @@
     (cond
       (> level 5) (let [new-child (tv-pop-tail
                                    tv (- level 5) (pv-aget node subidx))]
-                    (if (and (coercive-= new-child nil) (zero? subidx))
+                    (if (and (nil? new-child) (zero? subidx))
                       nil
                       (do (pv-aset node subidx new-child)
                           node)))
@@ -3155,7 +3155,7 @@
                          (if-not (nil? nr)
                            nr
                            (VectorNode. (.-edit root) (make-array 32))))]
-          (if (and (< 5 shift) (coercive-= (pv-aget new-root 1) nil))
+          (if (and (< 5 shift) (nil? (pv-aget new-root 1)))
             (let [new-root (tv-ensure-editable (.-edit root) (pv-aget new-root 0))]
               (set! root  new-root)
               (set! shift (- shift 5))
@@ -3873,7 +3873,7 @@
               (BitmapIndexedNode. nil (bit-or bitmap bit) new-arr))))
         (let [key-or-nil  (aget arr (* 2 idx))
               val-or-node (aget arr (inc (* 2 idx)))]
-          (cond (coercive-= nil key-or-nil)
+          (cond (nil? key-or-nil)
                 (let [n (.inode-assoc val-or-node (+ shift 5) hash key val added-leaf?)]
                   (if (identical? n val-or-node)
                     inode
@@ -3897,7 +3897,7 @@
         (let [idx         (bitmap-indexed-node-index bitmap bit)
               key-or-nil  (aget arr (* 2 idx))
               val-or-node (aget arr (inc (* 2 idx)))]
-          (cond (coercive-= nil key-or-nil)
+          (cond (nil? key-or-nil)
                 (let [n (.inode-without val-or-node (+ shift 5) hash key)]
                   (cond (identical? n val-or-node) inode
                         (not (nil? n)) (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) n))
@@ -3914,7 +3914,7 @@
         (let [idx         (bitmap-indexed-node-index bitmap bit)
               key-or-nil  (aget arr (* 2 idx))
               val-or-node (aget arr (inc (* 2 idx)))]
-          (cond (coercive-= nil key-or-nil) (.inode-find val-or-node (+ shift 5) hash key)
+          (cond (nil? key-or-nil) (.inode-find val-or-node (+ shift 5) hash key)
                 (= key key-or-nil)          [key-or-nil val-or-node]
                 :else nil)))))

@@ -3925,7 +3925,7 @@
         (let [idx         (bitmap-indexed-node-index bitmap bit)
               key-or-nil  (aget arr (* 2 idx))
               val-or-node (aget arr (inc (* 2 idx)))]
-          (cond (coercive-= nil key-or-nil) (.inode-find val-or-node (+ shift 5) hash key not-found)
+          (cond (nil? key-or-nil) (.inode-find val-or-node (+ shift 5) hash key not-found)
                 (= key key-or-nil)          [key-or-nil val-or-node]
                 :else not-found)))))

@@ -4001,7 +4001,7 @@
                 editable))))
         (let [key-or-nil  (aget arr (* 2 idx))
               val-or-node (aget arr (inc (* 2 idx)))]
-          (cond (coercive-= nil key-or-nil)
+          (cond (nil? key-or-nil)
                 (let [n (.inode-assoc! val-or-node edit (+ shift 5) hash key val added-leaf?)]
                   (if (identical? n val-or-node)
                     inode
@@ -4024,7 +4024,7 @@
         (let [idx         (bitmap-indexed-node-index bitmap bit)
               key-or-nil  (aget arr (* 2 idx))
               val-or-node (aget arr (inc (* 2 idx)))]
-          (cond (coercive-= nil key-or-nil)
+          (cond (nil? key-or-nil)
                 (let [n (.inode-without! val-or-node edit (+ shift 5) hash key removed-leaf?)]
                   (cond (identical? n val-or-node) inode
                         (not (nil? n)) (edit-and-set inode edit (inc (* 2 idx)) n)
@@ -4058,7 +4058,7 @@
   (inode-assoc [inode shift hash key val added-leaf?]
     (let [idx  (mask hash shift)
           node (aget arr idx)]
-      (if (coercive-= nil node)
+      (if (nil? node)
         (ArrayNode. nil (inc cnt) (clone-and-set arr idx (.inode-assoc cljs.core.BitmapIndexedNode/EMPTY (+ shift 5) hash key val added-leaf?)))
         (let [n (.inode-assoc node (+ shift 5) hash key val added-leaf?)]
           (if (identical? n node)
@@ -4108,7 +4108,7 @@
   (inode-assoc! [inode edit shift hash key val added-leaf?]
     (let [idx  (mask hash shift)
           node (aget arr idx)]
-      (if (coercive-= nil node)
+      (if (nil? node)
         (let [editable (edit-and-set inode edit idx (.inode-assoc! cljs.core.BitmapIndexedNode/EMPTY edit (+ shift 5) hash key val added-leaf?))]
           (set! (.-cnt editable) (inc (.-cnt editable)))
           editable)
@@ -4120,14 +4120,14 @@
   (inode-without! [inode edit shift hash key removed-leaf?]
     (let [idx  (mask hash shift)
           node (aget arr idx)]
-      (if (coercive-= nil node)
+      (if (nil? node)
         inode
         (let [n (.inode-without! node edit (+ shift 5) hash key removed-leaf?)]
           (cond
             (identical? n node)
             inode

-            (coercive-= nil n)
+            (nil? n)
             (if (<= cnt 8)
               (pack-array-node inode edit idx)
               (let [editable (edit-and-set inode edit idx n)]
@@ -5014,7 +5014,7 @@
     (-lookup node k not-found)))

 (defn- tree-map-add [comp tree k v found]
-  (if (coercive-= tree nil)
+  (if (nil? tree)
     (RedNode. k v nil nil nil)
     (let [c (comp k (.-key tree))]
       (cond
@@ -5034,10 +5034,10 @@

 (defn- tree-map-append [left right]
   (cond
-    (coercive-= left nil)
+    (nil? left)
     right

-    (coercive-= right nil)
+    (nil? right)
     left

     (instance? RedNode left)
@@ -5196,7 +5196,7 @@
   (-assoc [coll k v]
     (let [found (array nil)
           t     (tree-map-add comp tree k v found)]
-      (if (coercive-= t nil)
+      (if (nil? t)
         (let [found-node (nth found 0)]
           (if (= v (.-val found-node))
             coll
@@ -5210,8 +5210,8 @@
   (-dissoc [coll k]
     (let [found (array nil)
           t     (tree-map-remove comp tree k found)]
-      (if (coercive-= t nil)
-        (if (coercive-= (nth found 0) nil)
+      (if (nil? t)
+        (if (nil? (nth found 0))
           coll
           (PersistentTreeMap. comp nil 0 meta nil))
         (PersistentTreeMap. comp (.blacken t) (dec cnt) meta nil))))
@@ -5234,7 +5234,7 @@
               :else      (if (pos? c)
                            (recur (conj stack t) (.-right t))
                            (recur stack          (.-left t)))))
-          (if (coercive-= stack nil)
+          (if (nil? stack)
             (PersistentTreeMapSeq. nil stack ascending? -1 nil))))))

   (-entry-key [coll entry] (key entry))


small fix

small fix

--- src/cljs/salava/extra/hpass/ui/block.cljs
+++ src/cljs/salava/extra/hpass/ui/block.cljs
@@ -204,7 +204,7 @@
 (defn ^:export welcomeblockbody [lang]
   (case lang
     "en" "Welcome to HPass! We enable humanitarians to demonstrate their skills and experience using digital badges. You can earn badges on a range of humanitarian themes, from a wide range of organisations. Set up a profile or browse available badges to get started"
-    "Welcome to HPass! We enable humanitarians to demonstrate their skills and experience using digital badges. You can earn badges on a range of humanitarian themes, from a wide range of organisations. Set up a profile or browse available badges to get started"
+    "Welcome to HPass! We enable humanitarians to demonstrate their skills and experience using digital badges. You can earn badges on a range of humanitarian themes, from a wide range of organisations. Set up a profile or browse available badges to get started."
     )
   )


Update map options on city page.

Update map options on city page.

--- src/cljs/travel_site/components/city.cljs
+++ src/cljs/travel_site/components/city.cljs
@@ -229,9 +229,12 @@
                            #js {:center google-city-center
                                 :overviewMapControl false
                                 :mapTypeControl false
+                                :minZoom 10
+                                :maxZoom 17
+                                :scrollwheel false
                                 :streetViewControl false
                                 :styles constants/map-style-arr
-                                :zoom 9})]
+                                :zoom 12})]
           (om/set-state! owner :google-map google-map)
           (om/set-state! owner :google-directions-service google-directions-service)
           (gen-new-renderers owner transit-journey)


Add re-com v-box

Add re-com v-box

--- src/day8/re_frame/trace/utils/re_com.cljs
+++ src/day8/re_frame/trace/utils/re_com.cljs
@@ -168,6 +168,55 @@
              {:class (str "rc-h-box display-flex " class) :style s}
              attr)]
           children)))
+
+(defn v-box
+  "Returns hiccup which produces a vertical box.
+   It's primary role is to act as a container for components and lays it's children from top to bottom.
+   By default, it also acts as a child under it's parent"
+  [& {:keys [size width height min-width min-height max-width max-height justify align align-self margin padding gap children class style attr]
+      :or   {size "none" justify :start align :stretch}
+      :as   args}]
+  (let [s        (merge
+                   (flex-flow-style "column nowrap")
+                   (flex-child-style size)
+                   (when width {:width width})
+                   (when height {:height height})
+                   (when min-width {:min-width min-width})
+                   (when min-height {:min-height min-height})
+                   (when max-width {:max-width max-width})
+                   (when max-height {:max-height max-height})
+                   (justify-style justify)
+                   (align-style :align-items align)
+                   (when align-self (align-style :align-self align-self))
+                   (when margin {:margin margin})       ;; margin and padding: "all" OR "top&bottom right&left" OR "top right bottom left"
+                   (when padding {:padding padding})
+                   style)
+        gap-form (when gap [gap-f
+                            :size gap
+                            :height gap]) ;; TODO: required to get around a Chrome bug: https://code.google.com/p/chromium/issues/detail?id=423112. Remove once fixed.
+        children (if gap
+                   (interpose gap-form (filter identity children)) ;; filter is to remove possible nils so we don't add unwanted gaps
+                   children)]
+    (into [:div
+           (merge
+             {:class (str "rc-v-box display-flex " class) :style s}
+             attr)]
+          children)))
+
+(defn line
+  "Returns a component which produces a line between children in a v-box/h-box along the main axis.
+   Specify size in pixels and a stancard CSS color. Defaults to a 1px lightgray line"
+  [& {:keys [size color class style attr]
+      :or   {size "1px" color "lightgray"}
+      :as   args}]
+  (let [s (merge
+            (flex-child-style (str "0 0 " size))
+            {:background-color color}
+            style)]
+    [:div
+     (merge
+       {:class (str "rc-line " class) :style s}
+       attr)]))

 (defn- input-text-base
   "Returns markup for a basic text input label"
@@ -247,3 +296,7 @@
 (defn input-text
   [& args]
   (apply input-text-base :input-type :input args))
+
+(def re-com-css
+  [[:.display-flex {:display "flex"}]
+   [:.display-inline-flex {:display "flex"}]])


Tidy up

Tidy up

--- src/discuss/debug.cljs
+++ src/discuss/debug.cljs
@@ -2,8 +2,7 @@
   "Show information for debugging."
   (:require [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
-            [discuss.lib :as lib]
-            [discuss.test :as test]))
+            [discuss.lib :as lib]))

 (defn print-bubbles [bubbles]
   (map #(let [bubble (nth bubbles %)]


Added quote to log

Added quote to log

--- src/elefant_server/domain/sse_service.clj
+++ src/elefant_server/domain/sse_service.clj
@@ -10,7 +10,7 @@

 (defn broadcast-message! [trumpetee-id message]
   {:pre [trumpetee-id]}
-  (log/info "Sending message" (:message message) "with id" (:id message) "to trumpetee" trumpetee-id)
+  (log/info "Sending message \"" (:message message) "\" with id" (:id message) "to trumpetee" trumpetee-id)
   (if-let [subscriber (@subscribers trumpetee-id)]
     (do (reset! (:last-accessed subscriber) (time/now))
         (go (>! (:sse-stream subscriber) (with-meta message {:event-type "trumpet"}))))


Fix docstring.

Fix docstring.

--- src/fhofherr/clj_db_util/transactions.clj
+++ src/fhofherr/clj_db_util/transactions.clj
@@ -97,10 +97,7 @@
                     {::db db ::value nil}))))

 (defn tx-exec
-  "Execute the transaction `tx` in the database represented by `db-spec`.
-  The `dialect` is added for convenience since some database functions need it
-  to perform their tasks (this might not be a good idea, in which case I'll
-  remove the dialect)."
+  "Execute the transaction `tx` in the database represented by `db-spec`. "
   [db tx]
   (io!
     (jdbc/with-db-transaction [db* (db-con/db-spec db)]


Modified mapping algorithm.

Modified mapping algorithm.

Seed for RNG is the sum of unicode values of the characters in the given
string.

--- wysitutwyg/src-cljs/wysitutwyg/textgen.cljs
+++ wysitutwyg/src-cljs/wysitutwyg/textgen.cljs
@@ -9,9 +9,11 @@
 (defn not-word-delim? [char]
   (not (word-delimiters char)))

-(defn seed-from-sentence ;; TODO: Something better than literally count.
+(defn seed-from-sentence
+  "Takes a string and maps it to an integer by summing the unicode character
+  codes of the characters in the string."
   [sentence]
-  (count sentence))
+  (reduce + (map #(.charCodeAt % 0) sentence)))

 (defn break-text
   "Breaks a text by pred, much like C#'s split."


attempts to download next track on upload completion

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -66,6 +66,30 @@
                                                               :ball-being-dragged?
                                                               true)
                                                :stop on-drag-stop})
+(defn get-music-info-from-id [track-id]
+  (nth (filter #(= (.-id %1)
+                   track-id)
+         (:music-info @app-state))
+    0))
+
+(defn get-next-track-to-download []
+  (letfn [(is-track-downloaded? [track-id]
+            (contains? (:music-files @app-state) track-id))]
+    (let [current-track-info (get-music-info-from-id (:current-track-id @app-state))]
+      (loop [track-num (+ (.-tracknum current-track-info) 1)
+             i 0]
+        (if (>= i (count (:music-info @app-state)))
+          nil
+          (let [music-info (nth (:music-info @app-state) track-num)
+                track-id (.-id music-info)]
+            (if-not (is-track-downloaded? track-id)
+              track-id
+              (if (< track-num (count (:music-info @app-state)))
+                (recur (+ 1 track-num)
+                       (+ 1 i))
+                (recur 0
+                       (+ 1 i))))))))))
+
 (defn pause []
   (.pause js/soundManager current-sound-id)
   (.emit socket "pause" (.-position (:current-sound @app-state))))
@@ -149,7 +173,11 @@
 (.on socket "upload-complete"
   (fn [music-info]
     (swap! app-state assoc :music-info
-      (merge (:music-info @app-state) music-info))))
+      (merge (:music-info @app-state) music-info))
+    (if-not (:is-file-downloading? @app-state)
+      (let [id (get-next-track-to-download)]
+        (if-not (nil? id)
+          (.emit socket "file-download-request" id))))))

 (.on (new js/ss socket) "file-download"
   (fn [stream track-id file-size]


finished change functions

finished change functions

--- src/hydrofoil/core.clj
+++ src/hydrofoil/core.clj
@@ -16,17 +16,17 @@

 (defn generate-random-design
-  []
+  [individual]
   (NACA-design (round-double (rand 9.5)) (round-double (rand 90)) (+ (round-double (rand 39)) 1)))

 (defn random-change
-  []
+  [individual]
   (def changeVector (vector (rand-int 2) (rand-int 2) (rand-int 2) )))

 (defn score
-  [lift]
+  [individual]
   (assoc lift :score (score lift)))

@@ -38,7 +38,15 @@

 (defn change-max-camber
-  []
-  (if (> (+ max-camber (round-double (rand 1))) 9.5) ))
+  [individual]
+  (if (> (+ max-camber (round-double (rand 1))) 9.5) (% max-camber 9.5) (max-camber)))

+(defn change-position-camber
+  [individual]
+  (if (> (+ position-camber (round-double (rand 9))) 90) (% position-camber 90) (position-camber)))
+
+
+(defn change-thickness
+  [individual]
+  (if (> (+ thickness (round-double (rand 4))) 40) (+ (% thickness 40) 1) (thickness)))


add boot support. fix #14

add boot support. fix #14

--- src/jarkeeper/core.clj
+++ src/jarkeeper/core.clj
@@ -40,9 +40,26 @@
     (read-string s)))

 (defn read-project-clj [repo-owner repo-name]
-  (let [url (str "https://raw.github.com/" repo-owner "/" repo-name "/master/project.clj")]
-    (edn/read (PushbackReader. (io/reader url)))))
-
+  (try
+    (let [url (str "https://raw.github.com/" repo-owner "/" repo-name "/master/project.clj")]
+      (edn/read (PushbackReader. (io/reader url))))
+    (catch Exception e
+      nil)))
+
+(defn read-build-boot [repo-owner repo-name]
+  (try
+    (let [url (str "https://raw.github.com/" repo-owner "/" repo-name "/master/build.boot")]
+      (safe-read (slurp url)))
+    (catch Exception e
+      nil)))
+
+(defn read-boot-deps [repo-owner repo-name]
+  (if-let [parsed-build-file (read-build-boot repo-owner repo-name)]
+    (some->> parsed-build-file
+            rest
+            (apply hash-map)
+            :dependencies
+            last)))

 (defn check-deps [deps]
   (map #(conj % (anc/artifact-outdated? % {:snapshots? false :qualified? false})) deps))
@@ -65,8 +82,25 @@
                      [profile-name deps (calculate-stats deps)])))))
        profiles))

-
-(defn project-map [repo-owner repo-name]
+(defn boot-project-map [repo-owner repo-name]
+  (let [github-url (str "https://github.com/" repo-owner "/" repo-name)]
+       (if-let [dependencies (read-boot-deps repo-owner repo-name)]
+           (do
+             (println "boot-build deps" read-boot-deps)
+             (let [deps (check-deps dependencies)
+                   stats (calculate-stats deps)
+                   result { :boot? true
+                            :name repo-name
+                            :repo-name repo-name
+                            :repo-owner repo-owner
+                            :github-url github-url
+                            :deps deps
+                            :stats stats
+                            }]
+               (log/info "boot project map" result)
+               result)))))
+
+(defn lein-project-map [repo-owner repo-name]
   (let [github-url (str "https://github.com/" repo-owner "/" repo-name)]
         (if-let [project-clj-content (read-project-clj repo-owner repo-name)]
             (do
@@ -79,6 +113,7 @@
                     stats (calculate-stats deps)
                     plugins-stats (calculate-stats plugins)
                     result (assoc info-map
+                             :lein? true
                              :name project-name
                              :repo-name repo-name
                              :repo-owner repo-owner
@@ -90,10 +125,14 @@
                              :stats stats
                              :plugins-stats plugins-stats)]
                 (log/info "project map" result profiles)
-                result))
-
-            )))
-
+                result)))))
+
+(defn project-map [repo-owner repo-name]
+  (let [lein-result (future (lein-project-map repo-owner repo-name))
+        boot-result (future (boot-project-map repo-owner repo-name))]
+    (if (nil? @lein-result)
+      @boot-result
+      @lein-result)))

 (defn- repo-redirect [{:keys [params]}]
   (log/info params)


Updates from @mbossenbroek's feedback.

Updates from @mbossenbroek's feedback.

--- src/main/clojure/rx/lang/clojure/core.clj
+++ src/main/clojure/rx/lang/clojure/core.clj
@@ -96,7 +96,7 @@
 (declare unsubscribed?)

 (defn ^Subscriber subscriber
-  ""
+  "Experimental, subject to change or deletion."
   ([o on-next-action] (subscriber o on-next-action nil nil))
   ([o on-next-action on-error-action] (subscriber o on-next-action on-error-action nil))
   ([^Subscriber o on-next-action on-error-action on-completed-action]
@@ -125,7 +125,9 @@
   (Subscriptions/create ^Action0 (iop/action* handler)))

 (defn ^Observable$Operator operator*
-  "Returns a new implementation of rx.Observable$Operator that calls the given
+  "Experimental, subject to change or deletion.
+
+  Returns a new implementation of rx.Observable$Operator that calls the given
   function with a rx.Subscriber. The function should return a rx.Subscriber.

   See:
@@ -188,6 +190,13 @@
 ;################################################################################

 (defn ^Subscription subscribe
+  "Subscribe to the given observable.
+
+  on-X-action is a normal clojure function.
+
+  See:
+    rx.Observable/subscribe
+  "

   ([^Observable o on-next-action]
     (.subscribe o
@@ -283,6 +292,11 @@
 ; Operators

 (defn synchronize
+  "Synchronize execution.
+
+  See:
+    rx.Observable/synchronize
+  "
   ([^Observable xs]
   (.synchronize xs))
   ([lock ^Observable xs]


return source-map file instance in graal helper

--- src/main/shadow/build/targets/graaljs.clj
+++ src/main/shadow/build/targets/graaljs.clj
@@ -103,7 +103,9 @@
               sources)
             (dissoc :offset))]

-    (spit sm-file (json/write-str sm-index))))
+    (spit sm-file (json/write-str sm-index))
+    sm-file
+    ))

 (defn flush-dev


Ignore all 1.5.0 versions for noir tests.

--- integration-tests/src/test/clojure/immutant/integs/web/noir.clj
+++ integration-tests/src/test/clojure/immutant/integs/web/noir.clj
@@ -21,8 +21,9 @@
   (:require [clj-http.client :as client]))

 (defn run-tests? []
-  (not= "1.5.0-RC1"
-        (:full immutant.integs/*current-clojure-version*)))
+  (not (.startsWith
+        (:full immutant.integs/*current-clojure-version*)
+        "1.5.0")))

 (let [file *file*]
   (use-fixtures :once #(if (run-tests?)


ergonomics

ergonomics

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -7,7 +7,7 @@
    #?(:clj [clojure.tools.logging :as log])
    #?(:cljs [babel.logjs :as log])
    [clojure.string :as string]
-   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path-between lazy-shuffle
+   [dag_unify.core :refer (copy dissoc-paths get-in fail? fail-path lazy-shuffle
                                         ref? remove-false remove-top-values-log
                                         strip-refs show-spec unify unifyc)]))
 ;; during generation, will not search deeper than this:


in (defn add-to-bolt-at-path), check for (gen) result being empty; log/warn if so

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -188,20 +188,26 @@
 (defn add-to-bolt-at-path
   "bolt + path => partial trees"
   [bolt path model]
-  (->>
-   ;; set of all complements at _path_ for _bolt_:
-   (gen (get-in bolt path) model 0 nil path)
-
-   ;; add each member _each_comp_ of this set to _bolt_:
-   (map (fn [each-comp]
-          (->
-           bolt
-           (dag_unify.core/assoc-in path
-                                    each-comp)
-           ((fn [tree]
-              (if (:default-fn model)
-                ((:default-fn model) tree)
-                tree))))))))
+  (let [complements (gen (get-in bolt path) model 0 nil path)]
+    (if (empty? complements)
+      (log/warn (str "(improve grammar): no complements found for: "
+                     ((:morph-ps model) bolt)
+                     "; spec=" (dag_unify.core/strip-refs
+                                (get-in bolt path))))
+      (->>
+       ;; set of all complements at _path_ for _bolt_:
+       complements
+
+       ;; add each member _each_comp_ of this set to _bolt_:
+       (map (fn [each-comp]
+              (let [result
+                    (dag_unify.core/assoc-in bolt path each-comp)]
+                (->
+                 result
+                 ((fn [tree]
+                    (if (:default-fn model)
+                      ((:default-fn model) tree)
+                      tree)))))))))))

 (defn candidate-parents
   "find subset of _rules_ for which each member unifies successfully with _spec_; _depth_ is only used for diagnostic logging."


cleanup whitespace

cleanup whitespace

--- src/babel/generate.cljc
+++ src/babel/generate.cljc
@@ -5,7 +5,7 @@
    [clojure.math.combinatorics :as combo]
    [clojure.string :as string]
    [dag_unify.core :as u :refer [unify]]))
-
+
 ;; the higher the constant below,
 ;; the more likely we'll first generate leaves
 ;; (terminal nodes) rather than trees.


activate jansi support; fix whitespaces.

--- src/leiningen/ancient.clj
+++ src/leiningen/ancient.clj
@@ -5,7 +5,8 @@
             [leiningen.ancient.get :refer [run-get-task! run-latest-vector-task!]]
             [leiningen.ancient.upgrade :refer [run-upgrade-task! run-upgrade-profiles-task!]]
             [leiningen.core.main :as main]
-            [ancient-clj.verbose :refer :all]))
+            [ancient-clj.verbose :refer :all]
+            [jansi-clj.auto]))

 (def ^:private dispatch-table
   {"get"              run-get-task!
@@ -15,8 +16,8 @@
    "latest"           run-latest-vector-task!})

 (defn ^:higher-order ^:no-project-needed ancient
-  "Check your Projects for outdated Dependencies.
-
+  "Check your Projects for outdated Dependencies.
+
    Usage:

      lein ancient [<options>] [<path>]
@@ -35,7 +36,7 @@
      upgrade-profiles     Replace plugins in '~/.lein/profiles.clj' with newer versions.

    Commandline Options:
-
+
      :aggressive          Check all available repositories (= Do not stop after first artifact match).
      :all                 Check Dependencies and Plugins.
      :allow-all           Allow SNAPSHOT and qualified versions to be reported as new.


Support setting clojure.debug system property.

--- src/leiningen/compile.clj
+++ src/leiningen/compile.clj
@@ -150,6 +150,11 @@
     (if (= (get-os) :windows)
       (pr-str (pr-str form))
       (prn-str form))))
+
+(defn- add-system-property [java name value]
+  (.addSysproperty java (doto (Environment$Variable.)
+                          (.setKey (name name))
+                          (.setValue (name value)))))

 ;; TODO: split this function up
 (defn eval-in-project
@@ -170,6 +175,8 @@
     (do ;; bootclasspath workaround: http://dev.clojure.org/jira/browse/CLJ-673
       (require '[clojure walk repl])
       (require '[clojure.java io shell browse])
+      (when (:debug project)
+        (System/setProperty "clojure.debug" "true"))
       ;; need to at least pretend to return an exit code
       (try (eval form)
            0
@@ -180,17 +187,16 @@
           native-path (or (:native-path project)
                           (find-native-lib-path project))]
       (.setProject java lancet/ant-project)
-      (.addSysproperty java (doto (Environment$Variable.)
-                              (.setKey "clojure.compile.path")
-                              (.setValue (:compile-path project))))
+      (add-system-property java :clojure.compile.path (:compile-path project))
+      (when (:debug project)
+        (add-system-property java :clojure.debug true))
       (when native-path
-        (.addSysproperty java (doto (Environment$Variable.)
-                                (.setKey "java.library.path")
-                                (.setValue (cond
-                                            (= file (class native-path))
-                                            (.getAbsolutePath native-path)
-                                            (fn? native-path) (native-path)
-                                            :default native-path)))))
+        (add-system-property
+         java "java.library.path" (cond
+                                   (= file (class native-path))
+                                   (.getAbsolutePath native-path)
+                                   (fn? native-path) (native-path)
+                                   :default native-path)))
       (.setClasspath java (apply make-path (get-classpath project)))
       (.setFailonerror java true)
       (.setFork java true)


Evaluate queries in desdemona.query

Evaluate queries in desdemona.query

This makes sure the clojure.core.logic ns is available.

--- src/desdemona/query.clj
+++ src/desdemona/query.clj
@@ -13,4 +13,10 @@
   ([query events]
    (run-query 1 query events))
   ([n-answers query events]
-   (eval (gen-query n-answers query events))))
+   (let [compiled-query (gen-query n-answers query events)
+         old-ns *ns*]
+     (try
+       (in-ns 'desdemona.query)
+       (eval compiled-query)
+       (finally
+         (in-ns (ns-name old-ns)))))))


try debug-repl

try debug-repl

--- src/bitcoinrpc/core.clj
+++ src/bitcoinrpc/core.clj
@@ -195,32 +195,35 @@

 (defn method-decl-of [fn-map]
   (let [n (:name fn-map)]
-    `[~n ~@(map #(mapv (fn [_] 'Object) %) (:arglists fn-map)) ~'Object]
+    (mapv (fn [x] [n (mapv (fn [_] 'Object) (rest x)) 'Object]) (:arglists fn-map))
     ))
 (defn method-name-of [n]
   (symbol (str "-" n)))

 (defn method-overload-of [name args]
-  ;(break!)
-  `(~(-> args rest vec) (~name ~@args)))
+  `(~(-> args rest (conj 'this) vec) (~name (.config ~'this) ~@(rest args))))

 (defn method-impl-of [fn-map]
   (let [n (:name fn-map)]
     `(defn ~(method-name-of n) ~@(map (partial method-overload-of n) (:arglists fn-map)))))
+
+(defn get-meta []
+  (btc-meta)
+  #_(-> (btc-meta) (nth 2) list))

 (defmacro def-java-api []
   `(do
      (gen-class
        :name bitcoinrpc.BtcJava
        :state ~'config
-       :methods ~(mapv method-decl-of (btc-meta))
+       :methods ~(vec (mapcat method-decl-of (get-meta)))
        :init ~'init
        :constructors {[java.util.Map] []})

-     ~@(map method-impl-of (btc-meta))
+     ~@(map method-impl-of (get-meta))
      (defn ~'-init [config#]
        [[] config#])))
-;(def-java-api)
+(def-java-api)

@@ -252,18 +255,18 @@
 ;;-------------------------java gen---------------------------

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

 (compile 'bitcoinrpc.core)


Simplify toggle-item-checked mutation

Simplify toggle-item-checked mutation

--- fulcro-todo/src/main/app/operations.cljs
+++ fulcro-todo/src/main/app/operations.cljs
@@ -4,10 +4,7 @@
 (defmutation toggle-item-checked?!
   [{:keys [id]}]
   (action [{:keys [state]}]
-          (let [ident [:item/by-id id]
-                current-item (get-in @state ident)
-                updated-item (update current-item :item/checked? not)]
-            (swap! state assoc-in ident updated-item))))
+          (swap! state update-in [:item/by-id id :item/checked?] not)))

 (defmutation add-item!
   [_]


Improves next-link function.

Improves next-link function.

Developed using Light Table, where I wasn't getting the Util.java:221
errors.

--- src/az_wish/core.clj
+++ src/az_wish/core.clj
@@ -23,10 +23,11 @@
   {:link (item-link link) :title (item-title link)})

 (defn- next-link [dom]
-  ; Written this way to avoid Util.java:221 RuntimeException for Unmatched delimiter: )
-  ; Will throw NPE for single-page wish lists.
-  ; Will throw CCE for last page of multi-page lists.
-  (az-link (((first ((first (html/select dom [:#wishlistPagination :li.a-last])) :content)) :attrs) :href)))
+  ; Single page wishlists will not have the element at all.
+  (if-let [a-last (first (html/select dom [:#wishlistPagination :li.a-last]))]
+    ; The last page will not have a link, just text.
+    (if-let [nxt (-> a-last :content first :attrs)]
+      (az-link (:href nxt)))))

 (defn wishlist [id]
   (letfn [(get-links [links] (map item-pair links))]
@@ -36,5 +37,5 @@
         coll
         (let [resource (fetch-url url)
               links (items resource)]
-          (recur (try (next-link resource) (catch ClassCastException _ nil) (catch NullPointerException _ nil))
+          (recur (next-link resource)
                  (concat coll (get-links links))))))))


CLJS: disable tests for non supported features

--- src/test/cljs/cljs/tools/reader_test.cljs
+++ src/test/cljs/cljs/tools/reader_test.cljs
@@ -130,8 +130,6 @@
   (is (= :abc/def.ghi (read-string ":abc/def.ghi")))
   (is (= :abc:def/ghi:jkl.mno (read-string ":abc:def/ghi:jkl.mno")))
   (is (instance? cljs.core.Keyword (read-string ":alphabet")))
-  (is (= :foo/bar (read-string "::foo/bar")))
-  (is (= :foo/bar (read-string "::foo/bar")))
   (is (= :bar/bar (binding [*alias-map* '{foo bar}] (read-string "::foo/bar")))))

 (deftest read-regex
@@ -143,17 +141,17 @@
 (deftest read-quote
   (is (= ''foo (read-string "'foo"))))

-(deftest read-syntax-quote
-  (let [q (read-string "quote")]
-    (is (= 'bar/bar (binding [*alias-map* '{foo bar}]
-                      (second (read-string "`foo/bar")))))
-    (is (= q (first (read-string "`foo"))))
-    (is (= 'foo (second (read-string "`foo"))))
-    (is (= q (first (read-string "`+"))))
-    (is (= '+ (second (read-string "`+"))))
-    (is (= q (first (read-string "`foo/bar"))))
-    (is (= 'foo/bar (second (read-string "`foo/bar"))))
-    (is (= 1 (read-string "`1")))))
+#_(deftest read-syntax-quote
+    (let [q (read-string "quote")]
+      (is (= 'bar/bar (binding [*alias-map* '{foo bar}]
+                        (second (read-string "`foo/bar")))))
+      (is (= q (first (read-string "`foo"))))
+      (is (= 'foo (second (read-string "`foo"))))
+      (is (= q (first (read-string "`+"))))
+      (is (= '+ (second (read-string "`+"))))
+      (is (= q (first (read-string "`foo/bar"))))
+      (is (= 'foo/bar (second (read-string "`foo/bar"))))
+      (is (= 1 (read-string "`1")))))

 (deftest read-deref
   (is (= '@foo (read-string "@foo"))))
@@ -186,22 +184,22 @@
 (defrecord ^:export foo [])
 (defrecord ^:export bar [baz buz])

-(deftest read-record
-  (is (= (foo.)
-         (read-string "#cljs.tools.reader_test.foo[]")))
-  (is (= (foo.)
-         (read-string "#cljs.tools.reader_test.foo []"))) ;; not valid in clojure
-  (is (= (foo.)
-         (read-string "#cljs.tools.reader_test.foo{}")))
-  (is (= (assoc (foo.) :foo 'bar)
-         (read-string "#cljs.tools.reader_test.foo{:foo bar}")))
-
-  (is (= (map->bar {:baz 1})
-         (read-string "#cljs.tools.reader_test.bar{:baz 1}")))
-  (is (= (bar. 1 nil)
-         (read-string "#cljs.tools.reader_test.bar[1 nil]")))
-  (is (= (bar. 1 2)
-         (read-string "#cljs.tools.reader_test.bar[1 2]"))))
+#_(deftest read-record
+    (is (= (foo.)
+           (read-string "#cljs.tools.reader_test.foo[]")))
+    (is (= (foo.)
+           (read-string "#cljs.tools.reader_test.foo []"))) ;; not valid in clojure
+    (is (= (foo.)
+           (read-string "#cljs.tools.reader_test.foo{}")))
+    (is (= (assoc (foo.) :foo 'bar)
+           (read-string "#cljs.tools.reader_test.foo{:foo bar}")))
+
+    (is (= (map->bar {:baz 1})
+           (read-string "#cljs.tools.reader_test.bar{:baz 1}")))
+    (is (= (bar. 1 nil)
+           (read-string "#cljs.tools.reader_test.bar[1 nil]")))
+    (is (= (bar. 1 2)
+           (read-string "#cljs.tools.reader_test.bar[1 2]"))))

 (deftest source-logging-meta-test
   (-> (loop [r (cljs.tools.reader.reader-types/source-logging-push-back-reader "(def test 8)\n(def test2 9)\n")


Maybe not that much magic

Maybe not that much magic

--- src/caesium/binding.clj
+++ src/caesium/binding.clj
@@ -1,7 +1,5 @@
 (ns caesium.binding
-  "Bindings to libsodium, using jnr-ffi.
-
-  Warning: crazy macro magic, here be dragons!"
+  "Bindings to libsodium, using jnr-ffi."
   (:require [clojure.string :as s])
   (:import [jnr.ffi LibraryLoader]
            [jnr.ffi.annotations In Out Pinned LongLong]


Use when-let in server-accept-loop.

Use when-let in server-accept-loop.

--- src/cbfg/world-net.cljs
+++ src/cbfg/world-net.cljs
@@ -45,11 +45,11 @@
                   (ago server-init world
                        (let [listen-result-ch (achan server-init)]
                          (aput server-init listen-ch [:server 8000 listen-result-ch])
-                         (let [[close-accept-ch accept-ch] (atake server-init listen-result-ch)]
+                         (when-let [[close-accept-ch accept-ch] (atake server-init listen-result-ch)]
                            (ago-loop server-accept-loop world
                                      [num-accepts 0]
-                                     (let [[server-send-ch server-recv-ch close-server-recv-ch]
-                                           (atake server-accept-loop accept-ch)]
+                                     (when-let [[server-send-ch server-recv-ch close-server-recv-ch]
+                                                (atake server-accept-loop accept-ch)]
                                        (ago-loop server-conn-loop server-accept-loop
                                                  [num-requests 0]
                                                  (aput server-conn-loop server-send-ch


[CS] Insert each row during CSV load on its own

SQLite has an easily reached limit of parameters in a statement (999). A
nice TODO would be to chunk inserts into groups up to that limit of
required parameters.

--- src/vip/data_processor/validation/csv.clj
+++ src/vip/data_processor/validation/csv.clj
@@ -91,7 +91,8 @@
             contents (read-csv-with-headers file-to-load)
             transforms (apply comp select-columns row-transform-fns)
             transformed-contents (map transforms contents)]
-        (korma/insert sql-table (korma/values transformed-contents))))
+        (doseq [row transformed-contents]
+          (korma/insert sql-table (korma/values row)))))
     ctx))

 (defn add-report-on-missing-file-fn


Put realtime log processing into a function

Put realtime log processing into a function

--- src/webapp/framework/server/systemfns.clj
+++ src/webapp/framework/server/systemfns.clj
@@ -627,13 +627,17 @@

-
+(defn process-log-entry [ realtime-log-entry ]
+(do
+            (println (str "**** Processing: " realtime-log-entry ) )
+          (println @cached-queries)
+        )  )

 (go
   (loop []
     (do
         (let [realtime-log-entry   (<! server-side-record-changes)]
-                             (println (str "**** " realtime-log-entry ) )
+            (process-log-entry realtime-log-entry )
         )
         (recur)
       )


Demunge functions in stacktraces

Demunge functions in stacktraces

--- planck-cljs/src/planck/repl.cljs
+++ planck-cljs/src/planck/repl.cljs
@@ -89,14 +89,22 @@
   {:pre [(symbol? ns)]}
   (get-in @st [::ana/namespaces ns]))

+(defn- ns-syms
+  "Returns a sequence of the symbols in a namespace."
+  ([ns]
+    (ns-syms ns (constantly true)))
+  ([ns pred]
+   {:pre [(symbol? ns)]}
+   (->> (get-namespace ns)
+     :defs
+     (filter pred)
+     (map key))))
+
 (defn- public-syms
   "Returns a sequence of the public symbols in a namespace."
   [ns]
   {:pre [(symbol? ns)]}
-  (->> (get-namespace ns)
-    :defs
-    (filter (comp not :private second))
-    (map key)))
+  (ns-syms ns (comp not :private second)))

 (defn- get-aenv
   []
@@ -858,6 +866,63 @@
   [e]
   (and (instance? ExceptionInfo e)
        (some #{[:type :reader-exception] [:tag :cljs/analysis-error]} (ex-data e))))
+
+(defn- form-demunge-map
+  "Forms a map from munged function symbols (as they appear in stacktraces)
+  to their unmunged forms."
+  [ns]
+  {:pre [(symbol? ns)]}
+  (let [ns-str        (str ns)
+        munged-ns-str (s/replace ns-str #"\." "$")]
+    (into {} (for [sym (ns-syms ns)]
+               [(str munged-ns-str "$" (munge sym)) (symbol ns-str (str sym))]))))
+
+(def ^:private core-demunge-map
+  (delay (form-demunge-map 'cljs.core)))
+
+(defn- non-core-demunge-maps
+  []
+  (let [non-core-nss (remove #{'cljs.core 'cljs.core$macros} (all-ns))]
+    (map form-demunge-map non-core-nss)))
+
+(defn- lookup-sym
+  [demunge-maps munged-sym]
+  (some #(% munged-sym) demunge-maps))
+
+(defn- demunge-local
+  [demunge-maps munged-sym]
+  (let [[_ fn local] (re-find #"(.*)_\$_(.*)" munged-sym)]
+    (when fn
+      (when-let [fn-sym (lookup-sym demunge-maps fn)]
+        (str fn-sym " " (demunge local))))))
+
+(defn- demunge-protocol-fn
+  [demunge-maps munged-sym]
+  (let [[_ ns prot fn] (re-find #"(.*)\$(.*)\$(.*)\$arity\$.*" munged-sym)]
+    (when ns
+      (when-let [prot-sym (lookup-sym demunge-maps (str ns "$" prot))]
+        (when-let [fn-sym (lookup-sym demunge-maps (str ns "$" fn))]
+          (str fn-sym " [" prot-sym "]"))))))
+
+(defn- demunge-sym
+  [munged-sym]
+  (let [demunge-maps (cons @core-demunge-map (non-core-demunge-maps))]
+    (str (or (lookup-sym demunge-maps munged-sym)
+             (demunge-protocol-fn demunge-maps munged-sym)
+             (demunge-local demunge-maps munged-sym)
+           munged-sym))))
+
+(defn-  mapped-stacktrace-str
+  ([stacktrace sms]
+   (mapped-stacktrace-str stacktrace sms nil))
+  ([stacktrace sms opts]
+   (with-out-str
+     (doseq [{:keys [function file line column]}
+             (st/mapped-stacktrace stacktrace sms opts)]
+       (println "\t"
+         (str (when function (str (demunge-sym function) " "))
+           "(" file (when line (str ":" line))
+           (when column (str ":" column)) ")"))))))

 (defn- print-error
   ([error]
@@ -888,7 +953,7 @@
                                     {:output-dir "file://(/goog/..)?"})]
          (println
            ((:ex-stack-fn theme)
-             (st/mapped-stacktrace-str
+             (mapped-stacktrace-str
                canonical-stacktrace
                (or (:source-maps @planck.repl/st) {})
                nil)))))


More broken docstrings fixed.

More broken docstrings fixed.

--- src/grafter/tabular.clj
+++ src/grafter/tabular.clj
@@ -73,7 +73,7 @@
                              (map first))]
     not-found-items))

-(defn all-columns [dataset cols]
+(defn all-columns
   "Takes a dataset and any number of integers corresponding to column
   numbers and returns a dataset containing only those columns.

@@ -84,7 +84,7 @@

   One advantage of this over using columns is that you can duplicate
   an arbitrary number of columns."
-
+ [dataset cols]
   (let [not-found-items (invalid-column-keys cols dataset)]
     (if (and (empty? not-found-items)
             (some identity cols))
@@ -196,12 +196,14 @@
       (make-dataset new-columns
                     new-data))))

-(defn drop-rows [dataset n]
+(defn drop-rows
   "Drops the first n rows from the CSV."
+  [dataset n]
   (map-rows dataset (partial drop n)))

-(defn take-rows [dataset n]
+(defn take-rows
   "Drops the first n rows from the CSV."
+  [dataset n]
   (map-rows dataset (partial take n)))

 (defn derive-column
@@ -270,8 +272,10 @@

 (def _ "An alias for the identity function, for providing positional arguments to mapc." identity)

-(defn mapc [dataset fs]
-"Takes an array or a hashmap of functions and maps each to the key column for every row."
+(defn mapc
+  "Takes an array or a hashmap of functions and maps each to the key
+  column for every row."
+  [dataset fs]
   (let [fs-hash (if (vector? fs)
                     (zipmap (column-names dataset) fs)
                     fs)


Adapt `key-pressed?` and `mouse-pressed?` for use with p5js. Issue #255.

--- src/cljc/quil/core.cljc
+++ src/cljc/quil/core.cljc
@@ -2084,7 +2084,7 @@
   "true if any key is currently pressed, false otherwise."
   []
   #?(:clj (.-keyPressed (ap/current-applet))
-     :cljs (.-__keyPressed (ap/current-applet))))
+     :cljs (.-keyIsPressed (ap/current-applet))))

 #?(:cljs
    (defn
@@ -2443,7 +2443,7 @@
   and false if a button is not pressed."
   []
   #?(:clj (.-mousePressed (ap/current-applet))
-     :cljs (.-__mousePressed (ap/current-applet))))
+     :cljs (.-mouseIsPressed (ap/current-applet))))

 (defn
   ^{:requires-bindings true


optimize Range IReduce implementation

optimize Range IReduce implementation

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -7589,7 +7589,14 @@

   IReduce
   (-reduce [rng f] (ci-reduce rng f))
-  (-reduce [rng f s] (ci-reduce rng f s)))
+  (-reduce [rng f init]
+    (loop [i start ret init]
+      (if (if (pos? step) (< i end) (> i end))
+        (let [ret (f ret i)]
+          (if (reduced? ret)
+            @ret
+            (recur (+ i step) ret)))
+        ret))))

 (defn range
   "Returns a lazy seq of nums from start (inclusive) to end


Renamed eval-message to eval-string

Renamed eval-message to eval-string

--- src/clojurebot/core.clj
+++ src/clojurebot/core.clj
@@ -13,12 +13,13 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (def sandbox (jail/sandbox testers/secure-tester :timeout 5000))

-(defn eval-message
-  "Evaluate a message received from IRC."
-  [msg]
+(defn eval-string
+  "Attempt to evaluate a string. If an exception is thrown,
+  the message text is returned."
+  [s]
   (try
     (binding [*read-eval* false]
-      (sandbox (read-string msg)))
+      (sandbox (read-string s)))
     (catch Exception e
       (.getMessage e))))

@@ -65,7 +66,7 @@
 (reg-command
  "eval"
  (fn [msg]
-   (str "=> " (pr-str (eval-message msg)))))
+   (str "=> " (pr-str (eval-string msg)))))

 (reg-command
  "doc"


Added a default case for @work

Added a default case for @work

--- src/clojurebot/core.clj
+++ src/clojurebot/core.clj
@@ -67,7 +67,8 @@
   "work"
   #(cond cmd
       "init" "Bleep bloop, initializing work..."
-      "end"  "Bleep bloop, work terminated"))
+      "end"  "Bleep bloop, work terminated"
+      :else  "Get back to work!"))

 (reg-command
  "coin"


New REST API call: /api/status

New REST API call: /api/status

--- src/hurvinek/server.clj
+++ src/hurvinek/server.clj
@@ -21,6 +21,7 @@
 (require '[hurvinek.exporter      :as exporter])
 (require '[hurvinek.db-interface  :as db-interface])
 (require '[hurvinek.utils         :as utils])
+(require '[hurvinek.process-info  :as process-info])

 (defn println-and-flush
     "Original (println) has problem with syncing when it's called from more threads.
@@ -330,10 +331,18 @@
             (http-response/content-type mime-type))))

 (defn process-api-info
+    "REST API handler for the /api/info"
     [request]
     (let [response {:toasterNotifications [(str "info|Api response|Hurvinek api v1")]
                     :configuration (:configuration request)}]
         (send-rest-api-response response)))
+
+(defn process-status
+    "REST API handler for the /api/status"
+    [request]
+    (let [response {:properties     (process-info/read-properties)
+                    :pid            (process-info/get-current-pid)}]
+         (send-rest-api-response response)))

 (defn return-file
     "Creates HTTP response containing content of specified file.
@@ -380,5 +389,6 @@
             "/api/components"             (process-list-of-components   request)
             "/api/components-to-chapter"  (process-list-of-components-to-chapter request)
             "/api/info"                   (process-api-info             request)
+            "/api/status"                 (process-status               request)
             )))


New functions: display-list-of-groups and display-rename-chapter-dialog

--- src/hurvinek/server.clj
+++ src/hurvinek/server.clj
@@ -55,10 +55,10 @@
               (http-response/content-type "text/html"))))

 (defn finish-processing-chapter-list
-    [request title product-id chapter-list]
+    [request title product-id product-name chapter-list]
     (let [params        (:params request)
           url-prefix    (get-url-prefix request)]
-          (-> (http-response/response (html-renderer/render-chapter-list url-prefix title product-id chapter-list))
+          (-> (http-response/response (html-renderer/render-chapter-list url-prefix title product-id product-name chapter-list))
               (http-response/content-type "text/html"))))

 (defn display-list-of-products
@@ -70,21 +70,47 @@

 (defn display-list-of-chapters
     [request title product-id]
-    (let [chapter-list (db-interface/read-chapters product-id)]
+    (let [product-name   (db-interface/read-product-name product-id)
+          chapter-list   (db-interface/read-chapters product-id)]
+        (println product-name)
         (println chapter-list)
-        (finish-processing-chapter-list request title product-id chapter-list)))
+        (finish-processing-chapter-list request title product-id product-name chapter-list)))
+
+(defn display-list-of-groups
+    [request title product-id chapter-id]
+    (let [product-name   (db-interface/read-product-name product-id)
+          chapter-name   (db-interface/read-chapter-name chapter-id)
+          group-list     (db-interface/read-groups chapter-id)]
+        (println product-name)
+        (println chapter-name)
+        (println group-list)
+        (finish-processing-chapter-list request title product-id product-name nil)))
+
+(defn display-rename-chapter-dialog
+    [request title product-id chapter-id]
+    (let [product-name   (db-interface/read-product-name product-id)
+          chapter-name   (db-interface/read-chapter-name chapter-id)]
+        (println product-name)
+        (println chapter-name)
+        (finish-processing-chapter-list request title product-id product-name nil)))

 (defn process-front-page
     "Function that prepares data for the front page."
     [request title]
     (let [params         (:params request)
           product-id     (get params "product-id")
-          chapter-id     (get params "chapter-id")]
+          chapter-id     (get params "chapter-id")
+          group-id       (get params "group-id")
+          action         (get params "action")]
           (println "Product ID" product-id)
           (println "Chapter ID" chapter-id)
+          (println "Group   ID" group-id)
+          (println "Action    " action)
           (cond
               (not product-id) (display-list-of-products request title)
               (not chapter-id) (display-list-of-chapters request title product-id)
+              (= action "grouplist") (display-list-of-groups request title product-id chapter-id)
+              (= action "rename-chapter") (display-rename-chapter-dialog request title product-id chapter-id)
               :else (finish-processing-front-page request title))))

 (defn return-file


remove brackets and fix syntax

remove brackets and fix syntax

--- kafka-clj/src/kafka_clj/metadata.clj
+++ kafka-clj/src/kafka_clj/metadata.clj
@@ -75,7 +75,7 @@

 (defn- black-list-producer [blacklisted-metadata-producers-ref {:keys [host port]} e]
   (error (str "Blacklisting metadata-producer: " host ":" port) e)
-  (dosync (alter blacklisted-metadata-producers-ref assoc (str host ":" port) true))
+  (dosync (commute blacklisted-metadata-producers-ref assoc (str host ":" port) true))
   nil)

 (defn blacklist-if-exception [blacklisted-metadata-producers-ref metadata-producer f & args]
@@ -96,7 +96,7 @@
     (filter (complement nil?))
     (filter (complement #(is-blacklisted? % @blacklisted-metadata-producers-ref)))
     (map #(_get-metadata % conf blacklisted-metadata-producers-ref))
-    (filter (fn [[_ meta] (nil? meta)]))
+    (filter (fn [[_ meta]] (nil? meta)))
     first))

 (defn get-metadata [metadata-producers conf & {:keys [blacklisted-metadata-producers-ref] :or {blacklisted-metadata-producers-ref (ref {})}}]
@@ -104,7 +104,7 @@
     (info "Got meta from " (:host metadata-producer) " -> empty? " (empty? meta))
     (if
       (not (empty? meta)) meta
-                        (throw (RuntimeException. (str "Could not get metadata for any metadata server blacklisted-servers: " (smart-deref blacklisted-metadata-producers-ref)))))))
+                          (throw (RuntimeException. (str "Could not get metadata for any metadata server blacklisted-servers: " (keys (smart-deref blacklisted-metadata-producers-ref))))))))


Fix errors from logging regexes in JSON

Fix errors from logging regexes in JSON

--- src/cfpb/qu/data.clj
+++ src/cfpb/qu/data.clj
@@ -14,6 +14,7 @@
             [cfpb.qu.data.compression :as compression]
             [cfpb.qu.metrics :as metrics]
             [cheshire.core :as json]
+            [cheshire.generate :refer [add-encoder encode-str]]
             [monger
              [core :as mongo :refer [with-db get-db]]
              [query :as q]
@@ -21,6 +22,9 @@
              [conversion :as conv]
              joda-time
              json]))
+
+;; Prevent encoding regexes in JSON in the logs from throwing an error.
+(add-encoder java.util.regex.Pattern encode-str)

 (defn- authenticate-mongo
   [auth]


Moved the 'update index' TODO comment for create-commit to a question.

--- src/clj_git/core.clj
+++ src/clj_git/core.clj
@@ -24,7 +24,8 @@

 ; Creates a new commit object (and all required tree objects)
 ; from the current index
-; TODO: Update the index, HEAD and branch after creating objects!
+; TODO: Update the HEAD and branch after creating objects!
+;	(Do we need to update the index at all?)
 (defn create-commit
   ( [message]
     (create-commit message (head)))


delete own comment

delete own comment

--- src/ontrail/mutate.clj
+++ src/ontrail/mutate.clj
@@ -56,8 +56,7 @@
   (.trace logger (str user " deleting comment " comment-id " from own ex " ex-id))
   (mc/update-by-id EXERCISE
     (ObjectId. ex-id)
-    { :user user
-      "$set" {:lastModifiedDate (time/now)}
+    { "$set" {:lastModifiedDate (time/now)}
       "$pull" {:comments {:_id (ObjectId. comment-id)}}})
   (get-ex ex-id))


Removed a let

Removed a let

--- src/ctia/properties.clj
+++ src/ctia/properties.clj
@@ -75,10 +75,9 @@
    validate it, transform it into a nested map with keyword keys, and
    then store it in memory."
   []
-  (->> (let [properties-from-file (read-property-file)]
-         (merge properties-from-file
-                (select-keys (System/getProperties)
-                             configurable-properties)))
+  (->> (merge (read-property-file)
+              (select-keys (System/getProperties)
+                           configurable-properties))
        coerce-properties
        transform
        (reset! properties)))


Update core.cljc

Update core.cljc

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -702,7 +702,9 @@
   (std-interceptors/enrich f))

 (def ^{:api-docs/heading "Interceptors"} unwrap
-  "An interceptor which decreases the amount of destructuring necessary in an
+  "> New in v1.2.0
+
+   An interceptor which decreases the amount of destructuring necessary in an
    event handler where the event is structured as a 2-vector of
    [event-id payload-map].


tweak docstrings agin

tweak docstrings agin

--- src/re_frame/core.cljc
+++ src/re_frame/core.cljc
@@ -716,17 +716,17 @@

   Notes:

-    - `:before` functions modify and return their `context` argument. Unless they
-      side effect, in which case, they'll perform the side effect and return
+    - `:before` functions modify and return their `context` argument. Sometimes they
+      only side effect, in which case, they'll perform the side effect and return
       `context` unchanged.
-    - `:before` fucntions often modify the `:coeffects` map with `context` and,
-      if they do, then they  should use the utility functions `get-coeffect` and
+    - `:before` functions often modify the `:coeffects` map within `context` and,
+      if they do, then they should use the utility functions `get-coeffect` and
       `assoc-coeffect`.
-    - `:after` functions modify and return their `context` argument. Unless they
-      side effect, in which case, they'll perform the side effect and return
+    - `:after` functions modify and return their `context` argument. Sometimes they
+      only side effect, in which case, they'll perform the side effect and return
       `context` unchanged.
-    - `:after` functions often modify the `:effects` map with `context` and,
-      if they do, then they  should use the utility functions `get-effect`
+    - `:after` functions often modify the `:effects` map within `context` and,
+      if they do, then they should use the utility functions `get-effect`
       and `assoc-effect`"
   [& {:as m :keys [id before after]}]
   (utils/apply-kw interceptor/->interceptor m))


new core

new core

--- src/re_frame/core.cljs
+++ src/re_frame/core.cljs
@@ -1,8 +1,8 @@
 (ns re-frame.core
   (:require
-            [re-frame.handlers   :as handlers]
-            [re-frame.subs       :as subs]
-            [re-frame.middleware :as  middleware]))
+    [re-frame.handlers   :as handlers]
+    [re-frame.subs       :as subs]
+    [re-frame.middleware :as  middleware]))

 ;; --  API  -------
@@ -32,4 +32,4 @@
   ([id handler]
     (register-handler id pure handler))
   ([id middleware handler]
-    (register-handler id (comp pure middleware) handler)))+    (register-handler id (comp pure middleware) handler)))


Light improvements to comments in core.

Light improvements to comments in core.

--- src/re_frame/core.cljs
+++ src/re_frame/core.cljs
@@ -8,6 +8,7 @@

 ;; --  API  -------
+;; See also macros in clj file

 (def dispatch         router/dispatch)
 (def dispatch-sync    router/dispatch-sync)
@@ -32,10 +33,10 @@

 ;; --  Logging -----
 ;; re-frame uses the logging functions: warn, log, error, group and groupEnd
-;; By default, these functions map directly to the js/console implementations
-;; But you can override with your own (set or subset).
+;; By default, these functions map directly to the js/console implementations,
+;; but you can override with your own (set or subset).
 ;; Example Usage:
-;;   (defn my-warn-fn [& args]  (post-somewhere (apply str args)))
+;;   (defn my-warn-fn [& args]  (post-it-somewhere (apply str args)))
 ;;   (re-frame.core/set-loggers!  {:warn  my-warn-fn})
 (def set-loggers! utils/set-loggers!)

@@ -57,7 +58,7 @@
 (defn add-post-event-callback
   "Registers a callback function 'f'.
   f will be called after each dispatched event is procecessed
-  f will be called with two parameters:
+  f will be called with two arguments:
     - the event's vector. That which was dispatched orignally.
     - the further event queue - what is still to be processed. A PersistentQueue.

@@ -65,7 +66,7 @@
     - you are implementing a complex bootstrap pipeline
     - you want to create your own handling infrastructure, with perhaps multiple
       handlers for the one event, etc.  Hook in here.
-    - a libraries providing 'isomorphic javascript' rendering on  Nodejs or Nashorn.
+    - libraries providing 'isomorphic javascript' rendering on  Nodejs or Nashorn.
   "
   [f]
   (router/add-post-event-callback re-frame.router/event-queue f))


Add FriskInline component; fixes #1

Add FriskInline component; fixes #1

--- src/datafrisk/core.cljs
+++ src/datafrisk/core.cljs
@@ -14,7 +14,9 @@
     [:polygon {:points "0,0 0,100 100,50" :stroke "black"}]]])

 (def styles
-  {:shell {:backgroundColor "#FAFAFA"}
+  {:shell {:backgroundColor "#FAFAFA"
+           :fontFamily "Consolas,Monaco,Courier New,monospace"
+           :fontSize "12px"}
    :strings {:color "#4Ebb4E"}
    :keywords {:color "purple"}
    :numbers {:color "blue"}
@@ -64,8 +66,8 @@
     [:div {:style {:display "flex"}}
      (when-not (empty? data)
        [:div {:style {:flex "0 1 auto"}} [ExpandButton {:expanded? expanded?
-                                               :path path
-                                               :emit-fn emit-fn}]])
+                                                        :path path
+                                                        :emit-fn emit-fn}]])
      [:div {:style {:flex 1}}
       [:span (if (vector? data) "[" "(")]
       (if expanded?
@@ -135,17 +137,19 @@

 (defn DataFriskShellVisibleButton [visible? toggle-visible-fn]
   [:button {:onClick toggle-visible-fn
-         :style (merge {:border 0
-                        :cursor "pointer"
-                        :font "inherit"
-                        :padding "12px"
-                        :position "fixed"
-                        :right 0
-                        :width "80px"
-                        :text-align "center"}
-                  (:shell-visible-button styles)
-                  (when-not visible? {:bottom 0}))}
+            :style (merge {:border 0
+                           :cursor "pointer"
+                           :font "inherit"
+                           :padding "12px"
+                           :position "fixed"
+                           :right 0
+                           :width "80px"
+                           :text-align "center"}
+                     (:shell-visible-button styles)
+                     (when-not visible? {:bottom 0}))}
    (if visible? "Hide" "Data frisk")])
+
+

 (defn DataFriskShell [& data]
   (let [expand-by-default (reduce #(assoc-in %1 [:data-frisk %2 :expanded-paths] #{[]}) {} (range (count data)))
@@ -154,8 +158,6 @@
       (let [data-frisk (:data-frisk @state-atom)
             visible? (:visible? data-frisk)]
         [:div {:style (merge {:position "fixed"
-                              :fontFamily "Consolas,Monaco,Courier New,monospace"
-                              :fontSize "12px"
                               :right 0
                               :bottom 0
                               :width "100%"
@@ -170,4 +172,40 @@
                         :box-sizing "border-box"
                         :overflow-y "scroll"}}
           (map-indexed (fn [id x]
-                         ^{:key id} [Root x id state-atom]) data)]]))))+                         ^{:key id} [Root x id state-atom]) data)]]))))
+
+
+(defn FriskInlineVisibilityButton
+  [visible? update-fn]
+  [:button {:style {:border "0"
+                    :backgroundColor "transparent" :width "20px" :height "20px"}
+            :onClick update-fn}
+   [:svg {:viewBox "0 0 100 100"
+          :width "100%" :height "100%"
+          :style {:transition "all 0.2s ease"
+                  :transform (when visible? "rotate(90deg)")}}
+    [:polygon {:points "0,0 0,100 100,50" :stroke "black"}]]])
+
+
+(defn FriskInline [& data]
+  (let [expand-by-default (reduce #(assoc-in %1 [:data-frisk %2 :expanded-paths] #{[]}) {} (range (count data)))
+        state-atom (r/atom expand-by-default)]
+    (fn [& data]
+      (let [data-frisk (:data-frisk @state-atom)
+            visible? (:visible? data-frisk)]
+        [:div {:style (merge {:padding-top "10px"
+                              :max-height (if visible? "200px" 0)
+                              :flex-flow "row nowrap"
+                              :transition "all 0.3s ease-out"
+                              :z-index "5"}
+                             (:shell styles))}
+         [FriskInlineVisibilityButton visible? (fn [_] (swap! state-atom assoc-in [:data-frisk :visible?] (not visible?)))]
+         [:span "Data frisk"]
+         [:div {:style {:padding "10px"
+                        :height "100%"
+                        :box-sizing "border-box"
+                        :overflow-y "auto"}}
+          (map-indexed (fn [id x]
+                         ^{:key id} [Root x id state-atom]) data)]]))))
+
+


Implemented rendering depending on stamp position

--- src/ecregister/core.clj
+++ src/ecregister/core.clj
@@ -34,14 +34,21 @@
        (if (= resp :error)
          (log lb-log (str "failed to retrieve avatar image for '" username "'\n"))
          (let [image (<! (av/read-image (first resp) c))
-               ext (second resp)
-               stamped-image (av/stamped image (:stamp-type @state) ext)]
+               ext (second resp)]
            (log lb-log (str "successfully read image, detected extension is '" ext "'\n"))
-           (log lb-log (str "type is '" (.getType stamped-image) "'\n"))
            (config! (select form [:#orig-ava]) :icon image)
-           (config! (select form [:#stamped-ava]) :icon stamped-image)
+           (update-state :image-orig image :image-ext ext)
+           (update-stamped-image form)
            ))
        ))))
+
+(defn update-stamped-image [form]
+  "Gets an image from state, [re]stamps it according to state config,
+saves newly stamped to state updates widgets"
+  (when-let [image-orig (:image-orig @state)]
+    (update-state :image-stamped
+                  (av/stamped image-orig (:stamp-type @state) (:image-ext @state)))
+    (config! (select form [:#stamped-ava]) :icon (:image-stamped @state))))

 (defn build-avatars-tab []
   (let [bg-stamp-pos (button-group)
@@ -53,8 +60,15 @@
                               :halign :center)
                        "span 1 3,w 105px::, h 105px::,wrap,top"]
                       [(label "Положение штампа:")]
-                      [(flow-panel :items [(radio :id :top :text "Сверху" :group bg-stamp-pos)
-                                           (radio :id :bottom :text "Снизу" :group bg-stamp-pos)]) "wrap"]
+                      [(flow-panel :items [(radio :id :top
+                                                  :text "Сверху"
+                                                  :group bg-stamp-pos
+                                                  :selected? (not= :bottom (:stamp-type @state)))
+                                           (radio :id :bottom
+                                                  :text "Снизу"
+                                                  :group bg-stamp-pos
+                                                  :selected? (= :bottom (:stamp-type @state))
+                                                  )]) "wrap"]
                       [(button :text "Проштамповать") "wrap,skip 1"]
                       [(label "") "grow,push,span 2"] ;; empty filler
                       [(label :id :stamped-ava
@@ -66,61 +80,61 @@
                                                :columns 80
                                                ))
                        "span,growx"]]
-              :constraints ["fill", "[][grow][]", ""])]
-
-    ;; set up username edit to wait for user input become idle
-    (let [te-name (select form [:#username])
-          lb-log (select form [:#log])
-          active-chan (chan 1)
-          keys-chan (chan 1)
-          stop-listening (fn []
-                           ;; (log lb-log "Stopping listening\n")
-                           (go
-                            (if (<! active-chan)
-                              (do
-                                ;; important to put it back to channel immediately so others could read
-                                (>! active-chan false)
-                                (prepare-avatars (text te-name) lb-log form)
+              :constraints ["fill", "[][grow][]", ""])
+        te-name (select form [:#username])
+        lb-log (select form [:#log])
+        active-chan (chan 1)
+        keys-chan (chan 1)
+        stop-listening (fn []
+                         ;; (log lb-log "Stopping listening\n")
+                         (go
+                          (if (<! active-chan)
+                            (do
+                              ;; important to put it back to channel immediately so others could read
+                              (>! active-chan false)
+                              (prepare-avatars (text te-name) lb-log form)
                               ))))

-          start-listening (fn []
-                            ;;(log lb-log "Starting listening\n")
-                            (go
+        start-listening (fn []
+                          ;;(log lb-log "Starting listening\n")
+                          (go
+                           (>! active-chan true)
+                           (loop []
+                             (let [[v ch] (alts! [keys-chan (timeout 800)])]
+                               (if (not (blank? v))
+                                 (recur)
+                                 (do
+                                   ;;       (log lb-log "timeout reached\n")
+                                   (stop-listening))
+                                 ))
+                             )))]
+    ;; It is important in this scheme to return value to the channel as soon as it had been read:
+    ;; so that others interested can read back
+    (listen te-name
+            :focus-gained (fn [e]
+                            (put! active-chan false))
+
+            :document (fn [e]
+                        (go
+                         (if (<! active-chan)
+                           (do
+                             ;; important to put it back to channel immediately so others could read
                              (>! active-chan true)
-                             (loop []
-                               (let [[v ch] (alts! [keys-chan (timeout 800)])]
-                                 (if (not (blank? v))
-                                   (recur)
-                                   (do
-                              ;;       (log lb-log "timeout reached\n")
-                                     (stop-listening))
-                                   ))
-                               )))]
-      ;; It is important in this scheme to return value to the channel as soon as it had been read:
-      ;; so that others interested can read back
-      (listen te-name
-              :focus-gained (fn [e]
-                              (put! active-chan false))
-
-              :document (fn [e]
-                          (go
-                           (if (<! active-chan)
-                             (do
-                               ;; important to put it back to channel immediately so others could read
-                               (>! active-chan true)
-                               (>! keys-chan "1")
-                               )
-                             (do
-                               ;(log lb-log "in not-active mode, initiating listening\n")
-                               (start-listening))
-                             ))
-                          )
-              :focus-lost (fn [e]
-                            ;(log lb-log "focus lost, stopping\n")
-                            (stop-listening)
-                            )
-              )
-      form)))
+                             (>! keys-chan "1"))
+                           (do
+                                        ;(log lb-log "in not-active mode, initiating listening\n")
+                             (start-listening)))))
+            :focus-lost (fn [e]
+                                        ;(log lb-log "focus lost, stopping\n")
+                          (stop-listening)))
+    (listen bg-stamp-pos :selection
+            (fn [e]
+              (when-let [image (:image-orig @state)]
+                (when-let [s (selection bg-stamp-pos)]
+                  (update-state :stamp-type (config s :id))
+                  (update-stamped-image form)
+                  ))))
+    form))

 (defn build-posts-tab []
   (label "Posts"))


cleaner use of atom

cleaner use of atom

--- src/eatme/config.clj
+++ src/eatme/config.clj
@@ -4,13 +4,12 @@
 (def config-atom (atom {}))

 (defn init-config
-  ""
+  "Loads config from resources/config/<env>.edn"
   ([]
      (init-config :dev))
   ([config-name]
-     (swap! config-atom (fn [old new] new)
-            (safe-read (slurp
-                        (str "resources/config/" (name config-name) ".edn"))))))
+     (reset! config-atom (safe-read (slurp
+                                     (str "resources/config/" (name config-name) ".edn"))))))

 (def config (fn
               ([] @config-atom)


Make the auditing logic even more aggressive

Scans all Ruby files all the way through and uses a pretty loose regex
to match the "Fact: x" convention.

--- src/extracter/audit.clj
+++ src/extracter/audit.clj
@@ -5,19 +5,22 @@
             [clojure.java.io :as io]))

 (defn fact-names
-  "Given a java.io.File object containing one or more documented facts, return the names of those facts."
+  "Given a java.io.File object containing one or more (possibly malformed) documented facts, return the
+  names of those facts."
   [^java.io.File f]
   (->> f
        slurp
-       (re-seq #"[Ff]act: ([\w_<># ]*)")
-       (mapcat rest)))
+       (re-seq #"[Ff]act:[ ]+(.*)\n")
+       (map second)))

 (defn likely-facts-in-dir
-  "Recursively scans a directory for documented facts and returns the names
-   of any facts found. Relies on the '# Fact: x' convention."
+  "Recursively scans a directory for documented facts and returns a set of the names of any facts found.
+  Relies on the 'Fact: x' convention, but applied much more loosely than the main parsing function."
   [^String path]
   (->> path
-       files/facts-in-dir
+       io/file
+       file-seq
+       (filter files/ruby-file?)
        (mapcat fact-names)
        set))


modifies instruments

modifies instruments

--- src/example/core.clj
+++ src/example/core.clj
@@ -18,11 +18,11 @@
         env      (env-gen (perc attack decay peak) 1 1 0 1 FREE)]
     (out 0 (pan2 (* high-hat env) 0))))

-(definst kick-drum [amp 1 decay 0.8 freq 45 peak 1 attack 0.01]
+(definst kick-drum [amp 2 decay 0.8 freq 45 peak 1 attack 0.01]
   (let [env (env-gen (perc attack decay peak) 1 1 0 1 FREE)
-        enn (env-gen (asr 0.01 1 0.5))
+        ;enn (env-gen (asr 0.01 1 0.5))
         snd (sin-osc freq)]
-    (out 0 (pan2 (* snd env enn) 0))))
+    (out 0 (pan2 (* snd env) 0))))

 (kick-drum)

@@ -46,11 +46,11 @@
         snd (sin-osc (midicps note) (* Math/PI 0.5))]
     (out 0 (pan2 (* snd env) 0))))

-(definst spooky-house [freq 440 width 0.2
+(definst spooky-house [note 60 freq 440 width 0.2
                          attack 0.3 sustain 4 release 0.3
                          vol 0.4]
-  (* (env-gen (lin attack sustain release) 1 1 0 1 FREE)
-     (sin-osc (+ freq (* 20 (lf-pulse:kr 0.5 0 width))))
+  (*
+     (sin-osc (+ (midicps note) (* 20 (lf-pulse:kr 0.5 0 width))))
      vol))

 (definst growl [note 30 amp 1 decay 0.8 freq 220 peak 1 attack 0.01]
@@ -58,33 +58,35 @@
         snd (triangle 500 2 2)]
     (out 0 (pan2 (* snd env) 0))))

-(growl)
+(stop)
+
+;(growl)

-(env-triangle 400)
+;(env-triangle 400)

 ; ------------------------------------------------
 ; MAIN->MONOME -----------------------------------
 ; ------------------------------------------------
-;(def m (poly/init "/dev/tty.usbserial-m64-1113"))
+(def m (poly/init "/dev/tty.usbserial-m64-1113"))

-;(poly/remove-all-callbacks m)
+(poly/remove-all-callbacks m)

-;(poly/toggle-led m 0 0)
+(poly/toggle-led m 0 0)

-;(poly/on-press m ::foo (fn [x y s]
-                         ;(match [x y]
-                           ;[0 0] (kick-drum)
-                           ;[0 1] (snare-drum)
-                           ;[0 2] (high-hat)
-                           ;[7 7] (beep 80)
-                           ;[7 6] (beep 82)
-                           ;[7 5] (beep 84)
-                           ;[7 4] (beep 85)
-                           ;[7 3] (beep 87)
-                           ;[7 2] (beep 89)
-                           ;[7 1] (beep 91)
-                           ;[7 0] (beep 92)
-                           ;)))
+(poly/on-press m ::foo (fn [x y s]
+                         (match [x y]
+                           [0 0] (kick-drum)
+                           [0 1] (snare-drum)
+                           [0 2] (high-hat)
+                           [7 7] (spooky-house 80)
+                           [7 6] (spooky-house 82)
+                           [7 5] (spooky-house 84)
+                           [7 4] (spooky-house 85)
+                           [7 3] (spooky-house 87)
+                           [7 2] (spooky-house 89)
+                           [7 1] (spooky-house 91)
+                           [7 0] (spooky-house 92)
+                           )))


caller will pass in queue name

caller will pass in queue name

--- src/gangway/enqueue.clj
+++ src/gangway/enqueue.clj
@@ -1,8 +1,6 @@
 (ns gangway.enqueue
-  (:require [immutant.messaging :as msg]
-            [gangway.util :as gw-util]))
+  (:require [immutant.messaging :as msg]))

-(defn enqueue! [qid message]
-  (let [qn (get-in gw-util/queues [qid :name])]
-    (msg/publish qn message)))
+(defn enqueue! [qn message]
+  (msg/publish qn message))


Formatting for ->cli

Formatting for ->cli

--- src/labs/redis/core.clj
+++ src/labs/redis/core.clj
@@ -93,11 +93,11 @@
              StatusReply (->str @r)
              ErrorReply (str "(error) " (value r))
              MultiBulkReply (if-let [values (seq (value r))]
-                              (interpose "\n" (map #(str "(" %1 ") " (->str %2))
+                              (interpose "\n" (map #(str "(" %1 ") " (->cli %2))
                                                    (iterate inc 0)
                                                    values))
                               "(empty list or set)")
-             IntegerReply (str "(integer)" (value r))
+             IntegerReply (str "(integer) " (value r))
              (->str r)))))

 ;; low level redis protocol fns


Change defmanners to defmannerisms.

Change defmanners to defmannerisms.

--- src/manners/victorian.clj
+++ src/manners/victorian.clj
@@ -50,7 +50,7 @@
   ([prefix etiquette value] (falter prefix (bad-manners etiquette value)))
   ([etiquette value] (avow! nil etiquette value)))

-(defmacro defmanners
+(defmacro defmannerisms
   [obj-sym & etiquette]
   (let [bad-manners-sym (symbol (str "bad-" obj-sym "-manners"))
         proper?-sym (symbol (str "proper-" obj-sym \?))


fix typo in cookie

fix typo in cookie

--- src/mars_ogler/scrape.clj
+++ src/mars_ogler/scrape.clj
@@ -110,7 +110,7 @@
   [i]
   (let [page (:body (http/post
                       "http://curiositymsl.com/localphp/loadmore.php"
-                      {:headers {"Cookie" "PHPSESSID=3v55ibi7c0l25836c2chenpmo1;"
+                      {:headers {"Cookie" "PHPSESSID=3v55ibi7c0l25836c2chenpmo1"
                                  "User-Agent" "Mozilla/5.0 (Macintosh; Intel Mac OS X 10_6_8) AppleWebKit/537.13 (KHTML, like Gecko) Chrome/24.0.1290.1 Safari/537.13"
                                  "X-Requested-With" "XMLHttpRequest"}
                        :form-params {:q "", :z "UTC", :s "etreleased",


Refactoring search imp'l

Refactoring search imp'l

Because HOF are great
Helpers now hidden and reordered
This may or may not be a feature

--- src/grimoire/api.clj
+++ src/grimoire/api.clj
@@ -434,6 +434,40 @@
           (e/fail (.getMessage e))))
       ?notes)))

+(defn search
+  "Succeeds with a result Seq[Thing], being a list of all the Things in the
+  given datastore which match the given search structure.
+
+  Search patterns are vectors of the form [<type> &parts] where a type is one of
+  the Thing keywords, and &parts is a sequence terms being either sets of
+  strings, strings, regexes, functions, nil or the keyword :any.
+
+  - nil as a term matches any Thing
+  - :any as a term matches any Thing
+  - Sets as a term match Thing with its Name in the set
+  - Strings as a term match any Thing with an equal Name
+  - Regexps as a Term match any Thing with a matching Name
+  - Fns as a term match any Thing such that (f T) is truthy
+
+  Examples:
+  > [:def :any :any :any :any \"clojure.core\" \"concat\"]
+
+  Will match all instances of Defs named \"clojure.core/concat\" on all
+  platforms in all versions in all artifacts in all groups.
+
+  > [:ns :any \"clojure\" :any :any \"clojure.set\"]
+
+  Will match all instances of Nss named \"clojure.set\" in all artifacts named
+  \"clojure\" in all versions, platforms and groups.
+
+  > [:ns #\"org.*\" :any :any :any :any]
+
+  Will match all instances of Ns in any platform of any version of any artifact
+  in a Maven group matching the regex #\"org.*\""
+
+  [config pattern]
+  (-search config pattern))
+
 (defn- matches?
   "Helper function to clj::grimoire.api/search which serves to determine whether
   a pattern matches a Thing.
@@ -479,110 +513,52 @@
     (cons (tm (first pattern))
           (rest (butlast pattern)))))

-(defn search
-  "Succeeds with a result Seq[Thing], being a list of all the Things in the
-  given datastore which match the given search structure.
-
-  Search patterns are vectors of the form [<type> &parts] where a type is one of
-  the Thing keywords, and &parts is a sequence terms being either sets of
-  strings, strings, regexes, functions, nil or the keyword :any.
-
-  - nil as a term matches any Thing
-  - :any as a term matches any Thing
-  - Sets as a term match Thing with its Name in the set
-  - Strings as a term match any Thing with an equal Name
-  - Regexps as a Term match any Thing with a matching Name
-  - Fns as a term match any Thing such that (f T) is truthy
-
-  Examples:
-  > [:def :any :any :any :any \"clojure.core\" \"concat\"]
-
-  Will match all instances of Defs named \"clojure.core/concat\" on all
-  platforms in all versions in all artifacts in all groups.
-
-  > [:ns :any \"clojure\" :any :any \"clojure.set\"]
-
-  Will match all instances of Nss named \"clojure.set\" in all artifacts named
-  \"clojure\" in all versions, platforms and groups.
-
-  > [:ns #\"org.*\" :any :any :any :any]
-
-  Will match all instances of Ns in any platform of any version of any artifact
-  in a Maven group matching the regex #\"org.*\""
-
-  [config pattern]
-  (-search config pattern))
+(defn- recur-and-filter [cfg pattern el list-fn]
+  (let [?subterms (-search cfg (downgrade pattern))]
+    (if (e/succeed? ?subterms)
+      (e/succeed
+       (for [r     (e/result ?subterms)
+             ir    (e/result (list-fn cfg r))
+             :when (matches? el ir)]
+         ir))
+      ?subterms)))

 ;; Default naive implementation of searching as above
 (defmethod -search :default [config pattern]
-  (match [pattern]
-    ;; Case of a def
-    ;;----------------------------------------
-    [([:def gid art v plat ns name] :seq)]
-    ,,(let [?subterms (search config (downgrade pattern))]
-        (if (e/succeed? ?subterms)
-          (e/succeed
-           (for [ns    (e/result ?subterms) ;; Seq of Ns
-                 cname (e/result (list-defs config ns))
-                 :when (matches? name cname)]
-             cname))
-          ?subterms))
-
-    ;; Case of a ns
-    ;;----------------------------------------
-    [([:ns gid art v plat ns] :seq)]
-    ,,(let [?subterms (search config (downgrade pattern))]
-        (if (e/succeed? ?subterms)
-          (e/succeed
-           (for [platform (e/result ?subterms) ;; Seq of Platform
-                 cns      (e/result (list-namespaces config platform))
-                 :when    (matches? ns cns)]
-             cns))
-          ?subterms))
-
-    ;; Case of a platform
-    ;;----------------------------------------
-    [([:platform gid art v plat] :seq)]
-    ,,(let [?subterms (search config (downgrade pattern))]
-        (if (e/succeed? ?subterms)
-          (e/succeed
-           (for [version (e/result ?subterms) ;; Seq Version
-                 cplat   (e/result (list-platforms config version))
-                 :when   (matches? plat cplat)]
-             cplat))
-          ?subterms))
-
-    ;; Case of a version
-    ;;----------------------------------------
-    [([:version gid art v] :seq)]
-    ,,(let [?subterms (search config (downgrade pattern))]
-        (if (e/succeed? ?subterms)
-          (e/succeed
-           (for [artifact (e/result ?subterms) ;; Seq Artifact
-                 cvers    (e/result (list-versions config artifact))
-                 :when    (matches? v cvers)]
-             cvers))
-          ?subterms))
-
-    ;; Case of an artifact
-    ;;----------------------------------------
-    [([:artifact gid art] :seq)]
-    ,,(let [?subterms (search config (downgrade pattern))]
-        (if (e/succeed? ?subterms)
-          (e/succeed
-           (for [group (e/result ?subterms) ;; Seq Group
-                 ca    (e/result (list-artifacts config group))
-                 :when (matches? art ca)]
-             ca))
-          ?subterms))
-
-    ;; Case of a group
-    ;;----------------------------------------
-    [([:group gid] :seq)]
-    ,,(e/succeed
-       (for [cg (e/result (list-groups config))
-             :when (matches? gid cg)]
-         cg))))
+  (let [f (partial recur-and-filter config pattern)]
+    (match [pattern]
+      ;; Case of a def
+      ;;----------------------------------------
+      [([:def gid art v plat ns name] :seq)]
+      ,,(f name list-defs)
+
+      ;; Case of a ns
+      ;;----------------------------------------
+      [([:ns gid art v plat ns] :seq)]
+      ,,(f ns list-namespaces)
+
+      ;; Case of a platform
+      ;;----------------------------------------
+      [([:platform gid art v plat] :seq)]
+      ,,(f plat list-platforms)
+
+      ;; Case of a version
+      ;;----------------------------------------
+      [([:version gid art v] :seq)]
+      ,,(f v list-versions)
+
+      ;; Case of an artifact
+      ;;----------------------------------------
+      [([:artifact gid art] :seq)]
+      ,,(f art list-artifacts)
+
+      ;; Case of a group
+      ;;----------------------------------------
+      [([:group gid] :seq)]
+      ,,(e/succeed
+         (for [cg    (e/result (list-groups config))
+               :when (matches? gid cg)]
+           cg)))))

 (defn resolve-short-string
   "Succeeds with a result Thing, mapping a short string as generated by


Guarding against clojure.core/any?

Guarding against clojure.core/any?

Guarding against any?, which is part of clojure.core in 1.9.

--- src/such/shorthand.clj
+++ src/such/shorthand.clj
@@ -1,7 +1,8 @@
 (ns such.shorthand
   "Explicit functions for what could be done easily - but less clearly -
    by composing clojure.core functions. Anti-shibboleths such as using
-   `not-empty?` instead of `seq`.")
+   `not-empty?` instead of `seq`."
+  (:refer-clojure :exclude [any?]))

 (def ^:no-doc this-var-has-no-value-and-is-used-in-testing)


fixed FileReader call

fixed FileReader call

--- cljs/src/views/editor.cljs
+++ cljs/src/views/editor.cljs
@@ -466,7 +466,7 @@
 (def *file* (atom {}))

 (defn display-image-preview [file title]
-  (let [reader (FileReader.)]
+  (let [reader (new js/FileReader)]
     (set! (.-onload reader)
           (fn [e]
             (ui/render-template (dom/getElement "image-preview")
@@ -478,7 +478,7 @@
 (defn save-image-document-click-callback [create? language feed-name]
   (let [file (:obj @*file*)]
     (if file
-      (let [reader (FileReader.)]
+      (let [reader (new js/FileReader)]
         (set! (.-onload reader)
               (fn [e]
                 (let [image-data (util/map-to-obj


Update for new protocol names

Update for new protocol names

--- src/onyx/plugin/kafka.clj
+++ src/onyx/plugin/kafka.clj
@@ -150,21 +150,21 @@

   p-ext/PipelineInput

-  (ack-message [_ _ message-id]
-    (when-let [offset (:offset (get @pending-messages message-id))]
+  (ack-segment [_ _ segment-id]
+    (when-let [offset (:offset (get @pending-messages segment-id))]
       (swap! pending-commits conj offset))
-    (swap! pending-messages dissoc message-id))
-
-  (retry-message
-    [_ _ message-id]
-    (when-let [msg (get @pending-messages message-id)]
-      (swap! pending-messages dissoc message-id)
+    (swap! pending-messages dissoc segment-id))
+
+  (retry-segment
+    [_ _ segment-id]
+    (when-let [msg (get @pending-messages segment-id)]
+      (swap! pending-messages dissoc segment-id)
       (>!! read-ch (t/input (java.util.UUID/randomUUID)
                             (:message msg)))))

   (pending?
-    [_ _ message-id]
-    (get @pending-messages message-id))
+    [_ _ segment-id]
+    (get @pending-messages segment-id))

   (drained?
     [_ _]


provide sass/scss asset loader for optimus

--- src/optimus_sass/core.clj
+++ src/optimus_sass/core.clj
@@ -1,6 +1,31 @@
-(ns optimus-sass.core)
+(ns optimus-sass.core
+  (:require [clojure.string :as str]
+            [optimus.assets.creation :refer [last-modified existing-resource]]
+            [optimus.assets.load-css :refer [create-css-asset]]
+            [zweikopf.multi :refer [call-ruby ruby-eval]])
+  (:import [org.jruby.embed ScriptingContainer LocalContextScope]))

-(defn foo
-  "I don't do a whole lot."
-  [x]
-  (println x "Hello, World!"))
+(def ^:private ruby
+  (ScriptingContainer. LocalContextScope/SINGLETON))
+
+(ruby-eval ruby "ENV['GEM_PATH']='gems'
+                 ENV['GEM_HOME']='gems'
+                 require 'sass'")
+
+(def ^:private sass (ruby-eval ruby "Sass"))
+
+(defn ^:private compile-sass [path]
+  (call-ruby ruby sass :compile_file path))
+
+(defn ^:private load-sass-asset [public-dir path]
+  (let [resource (existing-resource public-dir path)
+        css (-> resource .getFile compile-sass)
+        css-asset (create-css-asset (str/replace path #"\.sass\z|\.scss\z" ".css")
+                                    css
+                                    (last-modified resource))]
+    (assoc css-asset :original-path path)))
+
+(doseq [ext ["sass" "scss"]]
+  (defmethod optimus.assets.creation/load-asset ext
+    [public-dir path]
+    (load-sass-asset public-dir path)))


Remove A/B from camera display name

Remove A/B from camera display name

--- src/mars_ogler/cams.clj
+++ src/mars_ogler/cams.clj
@@ -23,18 +23,18 @@

 (def cam-names-by-abbrev {"ML" "MastCam Left"
                           "MR" "MastCam Right"
-                          "NLA" "NavCam Left A"
-                          "NLB" "NavCam Left B"
-                          "NRA" "NavCam Right A"
-                          "NRB" "NavCam Right B"
+                          "NLA" "NavCam Left"
+                          "NLB" "NavCam Left"
+                          "NRA" "NavCam Right"
+                          "NRB" "NavCam Right"
                           "CR" "ChemCam"
                           "MH" "MAHLI"
                           "MD" "MARDI"
-                          "FLA" "HazCam Front-Left A"
-                          "FLB" "HazCam Front-Left B"
-                          "FRA" "HazCam Front-Right A"
-                          "FRB" "HazCam Front-Right B"
-                          "RLA" "HazCam Rear-Left A"
-                          "RLB" "HazCam Rear-Left B"
-                          "RRA" "HazCam Rear-Right A"
-                          "RRB" "HazCam Rear-Right B"})
+                          "FLA" "HazCam Front-Left"
+                          "FLB" "HazCam Front-Left"
+                          "FRA" "HazCam Front-Right"
+                          "FRB" "HazCam Front-Right"
+                          "RLA" "HazCam Rear-Left"
+                          "RLB" "HazCam Rear-Left"
+                          "RRA" "HazCam Rear-Right"
+                          "RRB" "HazCam Rear-Right"})


DM + RS | 129 | Update config to use base-url env var, keeping it separate from host and port

--- src/mooncake/config.clj
+++ src/mooncake/config.clj
@@ -2,7 +2,7 @@
   (:require [environ.core :as env]
             [clojure.tools.logging :as log]))

-(def env-vars #{:port :host :domain :scheme
+(def env-vars #{:port :host :base-url
                 :client-id :client-secret :auth-url
                 :secure})

@@ -22,14 +22,8 @@
 (defn host [config-m]
   (get-env config-m :host "localhost"))

-(defn domain [config-m]
-  (get-env config-m :domain "localhost"))
-
-(defn scheme [config-m]
-  (get-env config-m :scheme "https"))
-
 (defn base-url [config-m]
-  (str (scheme config-m) "://" (domain config-m) ":" (port config-m)))
+  (get-env config-m :base-url "http://localhost:3000"))

 (defn client-id [config-m]
   (get-env config-m :client-id))


Update docstring :robot_face:

Update docstring :robot_face:

--- src/metabase/driver.clj
+++ src/metabase/driver.clj
@@ -328,10 +328,13 @@
 ;; ## Driver Lookup

 (defn engine->driver
-  "Return the driver instance that should be used for given ENGINE.
-   This loads the corresponding driver if needed; it is expected that it resides in a var named
-
-     metabase.driver.<engine>/<engine>"
+  "Return the driver instance that should be used for given ENGINE keyword.
+   This loads the corresponding driver if needed; this is done with a call like
+
+     (require 'metabase.driver.<engine>)
+
+   The namespace itself should register itself by passing an instance of a class that
+   implements `IDriver` to `metabase.driver/register-driver!`."
   [engine]
   {:pre [engine]}
   (or ((keyword engine) @registered-drivers)


by-month summary

by-month summary

--- src/ontrail/summary.clj
+++ src/ontrail/summary.clj
@@ -95,5 +95,6 @@
 (defn get-season-months [user year]
   (let [pyear (- year 1)
         pairs [(list pyear 10) (list pyear 11) (list pyear 12) (list year 1)
-               (list year 2) (list year 3) (list year 4) (list year 5) (list year 6)]]
+               (list year 2) (list year 3) (list year 4) (list year 5) (list year 6)
+               (list year 7) (list year 8) (list year 9)]]
     (map #(get-month-summary-sport user (first %) (second %)) pairs)))


API ns

API ns

--- src/onyx/plugin/sql.clj
+++ src/onyx/plugin/sql.clj
@@ -24,18 +24,18 @@

 (defmethod l-ext/inject-lifecycle-resources
   :sql/load-rows
-  [_ {:keys [task-map] :as pipeline}]
-  {:params [(task->pool task-map)]})
+  [_ {:keys [onyx.core/task-map] :as pipeline}]
+  {:onyx.core/params [(task->pool task-map)]})

 (defmethod l-ext/apply-fn [:input :sql]
-  [{:keys [task-map] :as pipeline}]
+  [{:keys [onyx.core/task-map] :as pipeline}]
   (let [pool (task->pool task-map)
         sql-map {:select [:%count.*] :from [(:sql/table task-map)]}
         n ((keyword "count(*)") (first (jdbc/query pool (sql/format sql-map))))
         ranges (partition-all 2 1 (range (or (:sql/lower-bound task-map) 1)
                                          (or (:sql/upper-bound task-map) n)
                                          (:sql/rows-per-segment task-map)))]
-    {:results
+    {:onyx.core/results
      (map (fn [[l h]]
             {:low l
              :high (dec (or h (inc (or (:sql/upper-bound task-map) n))))


RS | #0 | Use wrap-forwarded-scheme to attempt to prevent redirect loop on wrap-ssl-redirect

--- src/objective8/core.clj
+++ src/objective8/core.clj
@@ -102,7 +102,7 @@
       (wrap-xss-protection true {:mode :block})
       (wrap-frame-options :sameorigin)
       ((if (config/get-var "HTTPS_ONLY")
-         (comp  wrap-ssl-redirect wrap-forwarded-scheme)
+         (comp wrap-forwarded-scheme wrap-ssl-redirect)
          identity))
       ))


remove duck-streams spit, it causes name clash errors. There must be a better way to fix Thomas Karolski's problem...

--- src/overtone/config.clj
+++ src/overtone/config.clj
@@ -1,6 +1,5 @@
 (ns overtone.config
-  (:use [clojure.contrib.io :only (slurp*)]
-        [clojure.contrib.duck-streams :only (spit)])
+  (:use [clojure.contrib.io :only (slurp*)])
   (:import (java.io FileOutputStream FileInputStream)))

 ;; Provides a simple key/value configuration system with support for automatically


finished expert panel

finished expert panel


make agree? and disagree? handle nils

make agree? and disagree? handle nils

--- src/polismath/utils.clj
+++ src/polismath/utils.clj
@@ -4,11 +4,15 @@

 (defn agree? [n]
-  (< n 0))
+  (and
+    (not (nil? n))
+    (< n 0)))

 (defn disagree? [n]
-  (> n 0))
+  (and
+    (not (nil? n))
+    (> n 0)))

 (defmacro time2