trimming date ms to 3 digits

trimming date ms to 3 digits

--- src/cljs/swarmpit/time.cljs
+++ src/cljs/swarmpit/time.cljs
@@ -1,17 +1,24 @@
 (ns swarmpit.time
   (:require [clojure.contrib.humanize :as humanize]
+            [clojure.string :as str]
             [cljs-time.core :refer [after? to-default-time-zone now]]
             [cljs-time.format :as format]))

 (def docker-format
-  (format/formatter "yyyy-MM-dd'T'HH:mm:ss.SSSSSSSSSZZ"))
+  (format/formatters :date-time))

 (def simple-format
   (format/formatters :mysql))

+(defn- trim-ms
+  [datetime]
+  (str/replace datetime #"\.(.+)Z$"
+               #(str "." (->> (% 1) (take 3) (apply str)) "Z")))
+
 (defn parse
   [datetime]
-  (format/parse docker-format datetime))
+  (->> (trim-ms datetime)
+       (format/parse docker-format)))

 (defn- shift-future-date
   [date]
@@ -21,14 +28,12 @@

 (defn humanize
   [datetime]
-  (->> datetime
-       (parse)
+  (->> (parse datetime)
        (shift-future-date)
        (humanize/datetime)))

 (defn simplify
   [datetime]
-  (->> datetime
-       (parse)
+  (->> (parse datetime)
        (to-default-time-zone)
        (format/unparse simple-format)))


Init board

Init board

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -54,15 +54,30 @@
     {:board (new-board)
      }))

+;; -----------------------------------------
+
+(defn rect-cell
+  [x y color & options]
+  [:rect
+   (merge
+     {:width 0.9
+      :height 0.9
+      :x (+ 0.05 x)
+      :y (+ 0.05 y)
+      :fill color}
+     #_(into {} options)
+     )
+   ])
+
 (defn empty-cell
-  "Draws an empty cell"
-  [x y color]
-  [:rect {:width 0.9
-          :height 0.9
-          :x (+ 0.05 x)
-          :y (+ 0.05 y)
-          :fill "lightgrey"
-          }])
+  [x y]
+  (rect-cell x y "lightgray"
+    :on-click #(js/alert (str "Got click on " [x y]))
+    ))
+
+(defn blocked-cell
+  [x y]
+  (rect-cell x y "gray"))

 (defn greeting []
   [:h1 "Triboard"
@@ -76,7 +91,7 @@
          :blue [empty-cell x y]
          :red [empty-cell x y]
          :green [empty-cell x y]
-         :gray [empty-cell x y])
+         :gray [blocked-cell x y])
        ))
    ])


Set :at for poms as a Date

Set :at for poms as a Date

It was a long, but the underlying search code now expects a Date.

--- src/clojars/routes/repo.clj
+++ src/clojars/routes/repo.clj
@@ -1,5 +1,6 @@
 (ns clojars.routes.repo
-  (:require [clojars
+  (:require [cemerick.pomegranate.aether :as aether]
+            [clojars
              [auth :refer [with-account]]
              [db :as db]
              [errors :refer [report-error]]
@@ -9,16 +10,15 @@
              [storage :as storage]]
             [clojure.java.io :as io]
             [clojure.string :as str]
-            [cemerick.pomegranate.aether :as aether]
             [compojure
              [core :as compojure :refer [PUT defroutes]]
              [route :refer [not-found]]]
             [ring.util
              [codec :as codec]
              [response :as response]])
-  (:import java.util.UUID
-           org.apache.commons.io.FileUtils
-           (java.io FileFilter IOException FileNotFoundException File)))
+  (:import (java.io FileFilter IOException FileNotFoundException File)
+           (java.util Date UUID)
+           org.apache.commons.io.FileUtils))

 (defn save-to-file [dest input]
   (-> dest
@@ -277,7 +277,7 @@

       (db/add-jar db account pom)
       (search/index! search (assoc pom
-                              :at (.lastModified pom-file)))
+                                   :at (Date. (.lastModified pom-file))))
       (spit (io/file dir ".finalized") ""))
     (throw-invalid "no pom file was uploaded")))


[#1316] Fix misplaced parens

[#1316] Fix misplaced parens

--- backend/src/akvo/lumen/lib/public_impl.clj
+++ backend/src/akvo/lumen/lib/public_impl.clj
@@ -60,9 +60,9 @@
              "visualisations" {(:id visualisation) (merge visualisation map-data)}
              "metadata" {(:id visualisation) map-data}}))
       (let [[map-data-tag map-data] (maps/create tenant-conn windshaft-url layers)]
-          (when (= map-data-tag ::lib/ok))
+          (when (= map-data-tag ::lib/ok)
             {"visualisations" {(:id visualisation) (merge visualisation map-data)}
-             "metadata" {(:id visualisation) map-data}}))))
+             "metadata" {(:id visualisation) map-data}})))))

 (defmethod visualisation :default
   [tenant-conn visualisation config]


http: ensure that HTTP messages release their content. fix for #145

--- src/io/cyanite/http.clj
+++ src/io/cyanite/http.clj
@@ -93,22 +93,25 @@
    The closure may be called at once or submitted to a pool."
   [f ^ChannelHandlerContext ctx ^FullHttpRequest msg]
   (fn []
-    (let [headers (headers (.headers msg))
-          body    (bb->string (.content msg))
-          dx      (QueryStringDecoder. (.getUri msg))
-          p1      (->params dx)
-          p2      (some-> msg (body-params headers body) ->params)
-          req     {:uri            (.path dx)
-                   :get-params     p1
-                   :body-params    p2
-                   :params         (merge p1 p2)
-                   :request-method (method->data (.getMethod msg))
-                   :version        (-> msg .getProtocolVersion .text)
-                   :headers        headers
-                   :body           body}
-          resp (data->response (f req) (.getProtocolVersion msg))]
-      (-> (.writeAndFlush ctx resp)
-          (.addListener ChannelFutureListener/CLOSE)))))
+    (try
+      (let [headers (headers (.headers msg))
+            body    (bb->string (.content msg))
+            dx      (QueryStringDecoder. (.getUri msg))
+            p1      (->params dx)
+            p2      (some-> msg (body-params headers body) ->params)
+            req     {:uri            (.path dx)
+                     :get-params     p1
+                     :body-params    p2
+                     :params         (merge p1 p2)
+                     :request-method (method->data (.getMethod msg))
+                     :version        (-> msg .getProtocolVersion .text)
+                     :headers        headers
+                     :body           body}
+            resp (data->response (f req) (.getProtocolVersion msg))]
+        (-> (.writeAndFlush ctx resp)
+            (.addListener ChannelFutureListener/CLOSE)))
+      (finally
+        (.release msg)))))

 (defn netty-handler
   "Simple netty-handler, everything may happen in


Use session cookie.

Use session cookie.

--- src/cadence/server.clj
+++ src/cadence/server.clj
@@ -1,6 +1,7 @@
 (ns cadence.server
   (:require [noir.response :as response]
             [ring.util.response :as ringresp :only [redirect]]
+            [ring.middleware.session.cookie :refer [cookie-store]]
             [cemerick.friend :as friend]
             (cadence [model :as model]
                      [state :as state]
@@ -52,7 +53,8 @@
     (wrap-request-map)
     (wrap-noir-cookies)
     (wrap-noir-flash)
-    (wrap-noir-session)))
+    (wrap-noir-session
+      {:store (cookie-store {:key (read-config "SECRET_KEY")})})))

 (defn -main
   "Run the application."


fix directory in file mappings

fix directory in file mappings

--- src/cake/tasks/jar.clj
+++ src/cake/tasks/jar.clj
@@ -21,6 +21,7 @@

 (defn add-file-mappings [task mappings]
   (doseq [mapping mappings]
+    (println "mapping:" mapping)
     (cond (vector? mapping)
           (add-zipfileset task {:file (first mapping) :fullpath (second mapping)})

@@ -29,8 +30,9 @@
                 name   (.getName file)
                 parent (.getParent file)
                 dir    (or parent ".")
-                parent (or parent "")]
-            (add-zipfileset task {:dir dir :prefix parent :includes name}))
+                parent (or parent "")
+                file   (if (.isDirectory file) (str mapping "/**/*") file)]
+            (add-zipfileset task {:dir dir :prefix parent :includes file}))

           (map? mapping)
           (add-zipfileset task mapping))))


Make «concept-lattice-layout?» to be memoized by the layout

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/layouts/base.clj
+++ src/conexp/layouts/base.clj
@@ -336,7 +336,7 @@
   [layout]
   (standard-context (lattice layout)))

-(defn concept-lattice-layout?
+(def-layout-fn concept-lattice-layout?
   "Tests whether layout comes from a concept lattice.

   Note: This implementation is not correct, as it only tests whether


Restructured so prog restarts the world.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -1,7 +1,7 @@
 (ns cbfg.world.t1
   (:require-macros [cljs.core.async.macros :refer [go-loop]]
                    [cbfg.act :refer [act actx-top]])
-  (:require [cljs.core.async :refer [<! >! chan timeout dropping-buffer]]
+  (:require [cljs.core.async :refer [<! >! close! chan timeout dropping-buffer]]
             [goog.dom :as gdom]
             [om.core :as om :include-macros true]
             [om.dom :as dom :include-macros true]
@@ -130,6 +130,12 @@

 (def vis-event-handlers {})

+(defn process-render [render-ch]
+  (go-loop []
+    (when-let [[vis-next deltas after event-str] (<! render-ch)]
+      (println :render-ch event-str)
+      (recur))))
+
 (defn process-events [vis event-delay event-ch step-ch render-ch]
   (go-loop [num-events 0]
     (when-let [[actx [verb step & args]] (<! event-ch)]
@@ -145,44 +151,41 @@
       (recur (inc num-events)))))

 (defn world-vis-init [el-prefix init-event-delay]
-  (let [last-id (atom 0)
-        gen-id #(swap! last-id inc)
-        agw (make-ago-world nil)
-        get-agw (fn [] agw)
-        event-ch (ago-chan agw)
-        event-delay (atom init-event-delay)
-        make-timeout-ch (fn [actx delay]
-                          (ago-timeout ((:get-agw (actx-top actx))) delay))
+  (init-roots)
+  (let [prog-ch (listen-el (gdom/getElement "prog-go") "click")
         step-ch (chan (dropping-buffer 1))
-        render-ch (chan)
-        w [{:gen-id gen-id
-            :get-agw get-agw
-            :event-ch event-ch
-            :make-timeout-ch make-timeout-ch}]
-        world (conj w "world-0")  ; No act for world actx init to avoid recursion.
-        vis (atom {:actxs {world {:children {} ; child-actx -> true,
-                                  :wait-chs {} ; ch -> [:ghost|:take|:put optional-ch-name],
-                                  :collapsed true
-                                  ; :loop-state last-loop-bindings,
-                                  }}
-                   :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
-                           ;         :first-taker-actx actx-or-nil}}.
-                   :gen-id gen-id})
-        go-ch (listen-el (gdom/getElement "prog-go") "click")]
-    (init-roots)
-    (process-events vis event-delay event-ch step-ch render-ch)
-    (go-loop []
-      (when-let [[vis-next deltas after event-str] (<! render-ch)]
-        (println :render-ch event-str)
-        (recur)))
-    (go-loop []
-      (let [prog (get-el-value "prog")
-            prog-js (str "with (cbfg.world.t1) {" prog "}")]
-        (let [res (try (js/eval prog-js)
-                       (catch js/Object ex ex))]
-          (println :prog-res res)))
-      (<! go-ch)
-      (recur))))
+        render-ch (chan)]
+    (process-render render-ch)
+    (go-loop [num-worlds 0]
+      (let [last-id (atom 0)
+            gen-id #(swap! last-id inc)
+            agw (make-ago-world num-worlds)
+            get-agw (fn [] agw)
+            event-ch (ago-chan agw)
+            event-delay (atom init-event-delay)
+            make-timeout-ch (fn [actx delay]
+                              (ago-timeout ((:get-agw (actx-top actx))) delay))
+            w [{:gen-id gen-id
+                :get-agw get-agw
+                :event-ch event-ch
+                :make-timeout-ch make-timeout-ch}]
+            world (conj w "world-0")  ; No act for world actx init to avoid recursion.
+            vis (atom {:actxs {world {:children {} ; child-actx -> true,
+                                      :wait-chs {} ; ch -> [:ghost|:take|:put optional-ch-name],
+                                      :collapsed true
+                                      ; :loop-state last-loop-bindings,
+                                      }}
+                       :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
+                               ;         :first-taker-actx actx-or-nil}}.
+                       :gen-id gen-id})]
+        (process-events vis event-delay event-ch step-ch render-ch)
+        (let [prog (get-el-value "prog")
+              prog-js (str "with (cbfg.world.t1) {" prog "}")
+              prog-res (try (js/eval prog-js) (catch js/Object ex ex))]
+          (println :prog-res prog-res))
+        (<! prog-ch)
+        (close! event-ch)
+        (recur (inc num-worlds))))))

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


Removed unused func.

Removed unused func.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -130,12 +130,6 @@
            {:target (. js/document (getElementById "events"))}))

 ; ------------------------------------------------
-
-(defn process-render [render-ch]
-  (go-loop []
-    (when-let [[vis-next deltas after event-str] (<! render-ch)]
-      (println :render-ch event-str)
-      (recur))))

 (defn world-vis-init [el-prefix init-event-delay]
   (init-roots)


refactor `camel->other-case`

refactor `camel->other-case`

--- src/cellophane/dom.clj
+++ src/cellophane/dom.clj
@@ -319,10 +319,9 @@

 (defn camel->other-case [^String sep]
   (fn ^String [^String s]
-    (->> (str/split s #"(?=[A-Z])")
-      (clojure.core/map #(reduce str %))
-      (clojure.core/map str/lower-case)
-      (str/join sep))))
+    (-> s
+      (str/replace #"([A-Z])" (str sep "$1"))
+      str/lower-case)))

 (def camel->kebab-case
   (camel->other-case "-"))


Notoriety improvement

Notoriety improvement

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -1196,7 +1196,7 @@
    {:req (req (and (some #{:hq} (:successful-run runner-reg))
                    (some #{:rd} (:successful-run runner-reg))
                    (some #{:archives} (:successful-run runner-reg))))
-    :effect (effect (gain :agenda-point 1) (move (first (:play-area runner)) :scored))}
+    :effect (effect (gain-agenda-point 1) (move (first (:play-area runner)) :scored))}

    "Off-Campus Apartment"
    {:abilities [{:effect (effect (draw))


Rez cost discount for Asteroid Belt, Nebula, Orion, Wormhole.

--- src/clj/game/cards.clj
+++ src/clj/game/cards.clj
@@ -3138,7 +3138,8 @@
    {:abilities [{:msg "end the run" :effect (effect (end-run))}]}

    "Asteroid Belt"
-   {:advanceable :always :abilities [{:msg "end the run" :effect (effect (end-run))}]}
+   {:advanceable :always :abilities [{:msg "end the run" :effect (effect (end-run))}]
+    :rez-cost-bonus (req (* -3 (or (:advance-counter card) 0)))}

    "Bandwidth"
    {:abilities [{:msg "give the Runner 1 tag" :effect (effect (gain :runner :tag 1))}]}
@@ -3487,7 +3488,8 @@

    "Nebula"
    {:advanceable :always
-    :abilities [trash-program]}
+    :abilities [trash-program]
+    :rez-cost-bonus (req (* -3 (or (:advance-counter card) 0)))}

    "Negotiator"
    {:abilities [{:msg "gain 2 [Credits]" :effect (effect (gain :credit 2))}
@@ -3527,7 +3529,8 @@
    "Orion"
    {:advanceable :always
     :abilities [trash-program
-                {:msg "end the run" :effect (effect (end-run))}]}
+                {:msg "end the run" :effect (effect (end-run))}]
+    :rez-cost-bonus (req (* -3 (or (:advance-counter card) 0)))}

    "Pachinko"
    {:abilities [{:label "End the run if the Runner is tagged"
@@ -3718,7 +3721,8 @@
     :abilities [{:msg "do 1 net damage" :effect (effect (damage :net 1 {:card card}))}]}

    "Wormhole"
-   {:advanceable :always}
+   {:advanceable :always
+    :rez-cost-bonus (req (* -3 (or (:advance-counter card) 0)))}

    "Wotan"
    {:abilities [{:msg "end the run" :effect (effect (end-run))}]}


Add GA

Add GA

--- src/clj/inky/entry.clj
+++ src/clj/inky/entry.clj
@@ -24,6 +24,14 @@
             [inky.util :as util]
             [clojure.java.shell :as sh]
             [clojure.edn :as edn]))
+
+(def ga-tag
+  [:script (str "(function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+  (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+  m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+  })(window,document,'script','//www.google-analytics.com/analytics.js','ga');
+  ga('create', '" (env/str :ga-tracking-id "") "', '" (env/str :ga-tracking-host "") "');
+  ga('send', 'pageview');")])

 (defn md5
   "Compute the hex MD5 sum of a string."
@@ -151,7 +159,8 @@
        [:div.row
         [:div.col-sm-121
          "inky.cc is brought to you by "
-         [:a {:href "https://twitter.com/heyzk"} "@heyzk"]]]]]]))
+         [:a {:href "https://twitter.com/heyzk"} "@heyzk"]]]]]
+     ga-tag]))

 (defn render-compiling []
   ($layout


One more multimethod.

One more multimethod.

--- src/clj/sptcg/core.clj
+++ src/clj/sptcg/core.clj
@@ -53,6 +53,7 @@

 (defmethod socket-event :chsk/uidport-open [event] (println "> Socket open!"))
 (defmethod socket-event :chsk/state [event] (println "> Socket state!"))
+(defmethod socket-event :chsk/ping [event] (println "> Socket ping!"))

 (let [{:keys [ch-recv send-fn ajax-post-fn ajax-get-or-ws-handshake-fn]}
       (sente/make-channel-socket! {})]


Dynamic control signals

Dynamic control signals

I should've done this long ago...

--- src/computer_build.clj
+++ src/computer_build.clj
@@ -208,10 +208,12 @@

 (defn build* [cpuname options instructions]
   (.mkdir (java.io.File. cpuname))
-  (let [[control-unit control-in control-out] (control-unit instructions)]
+  (let [[control-unit control-in control-out] (control-unit instructions)
+        control-signals (concat (dissoc control-in :clock :reset) control-out)
+        dynamic-signals (map (fn [[k v]] (list 'signal k v)) control-signals)]
     (with-open [main-vhdl (java.io.FileWriter. (str cpuname "/main.vhdl"))
                 control-vhdl (java.io.FileWriter. (str cpuname "/control.vhdl"))]
-      ;(pprint control-unit)
+      (pprint dynamic-signals)
       (binding [*out* control-vhdl]
         (generate-vhdl control-unit))
       (binding [*out* main-vhdl]
@@ -221,26 +223,9 @@
            (:reset :in ~std-logic)
            (:bus_inspection :out ~(std-logic-vector 7 0))]
           ; defs
-          [(signal :system_bus ~(std-logic-vector 7 0))
-          (signal :condition ~std-logic)
-          (signal :alu_operation ~(std-logic-vector 2 0))
-          (signal :opcode ~(std-logic-vector 7 5))
-          (signal :wr_pc ~std-logic)
-          (signal :rd_pc ~std-logic)
-          (signal :inc_pc ~std-logic)
-          (signal :wr_IR ~std-logic)
-          (signal :rd_IR ~std-logic)
-          (signal :wr_MA ~std-logic)
-          (signal :wr_MD ~std-logic)
-          (signal :rd_MD ~std-logic)
-          (signal :wr_A ~std-logic)
-          (signal :rd_A ~std-logic)
-          (signal :wr_B ~std-logic)
-          (signal :rd_B ~std-logic)
-          (signal :wr_alu_a ~std-logic)
-          (signal :wr_alu_b ~std-logic)
-          (signal :rd_alu ~std-logic)
-
+          [~@dynamic-signals
+           (signal :system_bus ~(std-logic-vector 7 0))
+
           (component :reg
             (:clock :in ~std-logic)
             (:data_in :in ~(std-logic-vector 7 0))


Update to reflect API changes

Update to reflect API changes

--- breakout/desktop/src-common/breakout/core.clj
+++ breakout/desktop/src-common/breakout/core.clj
@@ -111,7 +111,7 @@
     nil)
   :on-begin-contact
   (fn [screen entities]
-    (when-let [entity (first-contact screen entities)]
+    (when-let [entity (find-body (first-body screen) entities)]
       (cond
         (:floor? entity)
         (set-screen! breakout main-screen text-screen)


Remove get-references

Remove get-references

--- src/discuss/debug.cljs
+++ src/discuss/debug.cljs
@@ -41,11 +41,7 @@
            " "
            (dom/button #js {:className "btn btn-default"
                             :onClick   discuss.auth/one-click-login}
-                       "One-Click Login")
-           " "
-           (dom/button #js {:className "btn btn-default"
-                            :onClick   #(discuss.communication/request-references)}
-                       "Get references")))
+                       "One-Click Login")))

 (defn debug-view [data _owner]
   (reify om/IRender


Fixes formatting

Fixes formatting

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -274,9 +274,8 @@

 (defmethod expected-str :problem/missing-spec [_type spec-name val path problems opts]
   (->> problems
-        (map #(no-method spec-name val path %))
-        (string/join "\n"))
-  )
+       (map #(no-method spec-name val path %))
+       (string/join "\n")))

 (defmethod problem-group-str :problem/missing-spec [_type spec-name val path problems opts]
   (printer/format
@@ -300,14 +299,12 @@
 %s"
    (header-label "Syntax error")
    (show-spec-name spec-name (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path))))
-   (expected-str _type spec-name val path problems opts)
-   ))
+   (expected-str _type spec-name val path problems opts)))

 (defmethod expected-str :problem/extra-input [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
   (let [problem (first problems)]
-    (extra-input spec-name val path)
-    ))
+    (extra-input spec-name val path)))

 (defmethod problem-group-str :problem/extra-input [_type spec-name val path problems opts]
   (printer/format
@@ -318,8 +315,7 @@
 %s"
    (header-label "Syntax error")
    (show-spec-name spec-name (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path))))
-   (expected-str _type spec-name val path problems opts)
-   ))
+   (expected-str _type spec-name val path problems opts)))

 (defmethod expected-str :problem/fspec-exception-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
@@ -358,9 +354,7 @@

 %s"
      (printer/indent (pr-str (:val problem)))
-     (printer/indent (pr-pred (:pred problem) (:spec problem)))
-     ))
-  )
+     (printer/indent (pr-pred (:pred problem) (:spec problem))))))

 (defmethod problem-group-str :problem/fspec-ret-failure [_type spec-name val path problems opts]
   (printer/format
@@ -385,10 +379,7 @@

 %s"
      (printer/indent (pr-str (:val problem)))
-     (printer/indent (pr-pred (:pred problem) (:spec problem)))
-     )
-    )
-  )
+     (printer/indent (pr-pred (:pred problem) (:spec problem))))))

 (defmethod problem-group-str :problem/fspec-fn-failure [_type spec-name val path problems opts]
   (s/assert ::singleton problems)
@@ -400,17 +391,14 @@
 %s"
    (header-label "Function spec failed")
    (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path)))
-   (expected-str _type spec-name val path problems opts)
-   ))
+   (expected-str _type spec-name val path problems opts)))

 (defmethod expected-str :problem/unknown [_type spec-name val path problems opts]
   (printer/format
    "should satisfy

 %s"
-   (preds problems)
-   )
-  )
+   (preds problems)))

 (defmethod problem-group-str :problem/unknown [_type spec-name val path problems opts]
   (assert (apply = (map :val problems)) (str "All values should be the same, but they are " problems))
@@ -422,8 +410,7 @@
 %s"
    (header-label "Spec failed")
    (show-spec-name spec-name (printer/indent (*value-str-fn* spec-name val path (problems/value-in val path))))
-   (expected-str _type spec-name val path problems opts)
-   ))
+   (expected-str _type spec-name val path problems opts)))

 (defn problem-group-str1 [type spec-name val path problems opts]
   (str


removed unnecessary comments

removed unnecessary comments

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -70,8 +70,6 @@
 (defn pause []
   (.pause js/soundManager current-sound-id)
   (.emit socket "pause" (.-position (:current-sound @app-state))))
-  ;(.emit socket "pause" (* (.-duration (:current-sound @app-state))
-  ;                         (.-position (:current-sound @app-state)))))

 (defn resume []
   (.emit socket "resume"))


fixed uploading multiple files

fixed uploading multiple files

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -50,7 +50,8 @@
         (if-not (empty? (:upload-queue @app-state))
           (let [next-file (first (:upload-queue @app-state))]
             (swap! app-state assoc :upload-queue (pop (:upload-queue @app-state)))
-            (upload-file next-file)))))))
+            (if-not (= next-file file)
+              (upload-file next-file))))))))

 (.change (js/$ "#file-upload")
   (fn [e]


Implemented missing method for BooleanLiteralImpl

Fixes #136 - implemented missing method sesame-rdf-type->type on protocol ISesameRDFConverter for type BooleanLiteralImpl

--- src/grafter/rdf/io.clj
+++ src/grafter/rdf/io.clj
@@ -231,6 +231,9 @@
   BooleanLiteralImpl
   (->sesame-rdf-type [this]
     this)
+
+  (sesame-rdf-type->type [this]
+    (.booleanValue this))

   Statement
   (->sesame-rdf-type [this]


add :before? and :after? navigation keys

--- src/java_time/data.clj
+++ src/java_time/data.clj
@@ -68,6 +68,8 @@

         {`p/nav (fn [_ k v]
                   (case k
+                    :before? (.isBefore ym v)
+                    :after?  (.isAfter  ym v)
                     :instant (-> (.atDay ym 1)
                                  (.atStartOfDay)
                                  (.toInstant (or (zone-offset v) @system-offset)))
@@ -78,7 +80,7 @@
   (datafy [lt]
     (let [nanos (.getNano lt)]
       (with-meta
-        {:day    {:hour   (.getHour lt)}
+        {:day    {:hour   (.getHour   lt)}
          :hour   {:minute (.getMinute lt)}
          :minute {:second (.getSecond lt)}
          :second {:nano  nanos
@@ -87,6 +89,8 @@

         {`p/nav  (fn [_ k v]
                    (case k
+                     :before? (.isBefore lt v)
+                     :after?  (.isAfter  lt v)
                      :iso-format (.format DateTimeFormatter/ISO_TIME lt)
                      :format     (.format (dt-formatter v) lt)
                      nil))})))
@@ -103,6 +107,8 @@

         {`p/nav (fn [_ k v]
                   (case k
+                    :before?    (.isBefore ld v)
+                    :after?     (.isAfter  ld v)
                     :iso-format (.format DateTimeFormatter/ISO_DATE ld)
                     :format     (.format (dt-formatter v) ld)
                     :julian     (julian-field ld v)
@@ -124,6 +130,8 @@

         {`p/nav (fn [_ k v]
                   (case k
+                    :before?    (.isBefore ldt v)
+                    :after?     (.isAfter  ldt v)
                     :iso-format (.format DateTimeFormatter/ISO_LOCAL_DATE_TIME ldt)
                     :format     (.format (dt-formatter v) ldt)
                     :instant    (.toInstant ldt (or (zone-offset v) @system-offset))
@@ -145,6 +153,8 @@

         {`p/nav (fn [_ k v]
                   (case k
+                    :before?    (.isBefore odt v)
+                    :after?     (.isAfter  odt v)
                     :iso-format (.format DateTimeFormatter/ISO_OFFSET_DATE_TIME odt)
                     :format     (.format (dt-formatter v) ldt)
                     :instant    (.toInstant odt)
@@ -162,6 +172,8 @@

         {`p/nav (fn [_ k v]
                   (case k
+                    :before?    (.isBefore zdt v)
+                    :after?     (.isAfter  zdt v)
                     :iso-format (.format DateTimeFormatter/ISO_ZONED_DATE_TIME zdt)
                     :format     (.format (dt-formatter v) zdt)
                     :instant    (.toInstant zdt)
@@ -186,6 +198,8 @@
                  :nano   epoch-nano}}
         {`p/nav (fn [_ k v]
                   (case k
+                    :before?    (.isBefore inst v)
+                    :after?     (.isAfter  inst v)
                     :iso-format (.format DateTimeFormatter/ISO_INSTANT inst)
                     :format     (.format ^DateTimeFormatter v inst)
                     :local-time      (LocalTime/ofInstant      inst  (or (zone-id v) @system-zone))


Alias classpath to cp.

Alias classpath to cp.

--- src/leiningen/core.clj
+++ src/leiningen/core.clj
@@ -107,7 +107,7 @@
   ([] (read-project "project.clj")))

 (def aliases (atom {"--help" "help" "-h" "help" "-?" "help" "-v" "version"
-                    "--version" "version" "überjar" "uberjar"
+                    "--version" "version" "überjar" "uberjar" "cp" "classpath"
                     "int" "interactive"}))

 (defn task-not-found [& _]


enhance the option handling for the interactive mode

--- src/leiningen/sync.clj
+++ src/leiningen/sync.clj
@@ -10,6 +10,7 @@
             [leiningen.leinsync.utils :as u]))

 (def PARENT-FOLDER "../")
+(def ALL-PROJECTS ".*")

 (defn find-command [options commands]
   (->> options
@@ -89,7 +90,7 @@
              (may-update-source-project-desc options)
              (command target-projects))))
     (catch Exception e
-      (m/info "An error occurs with the input string: " search-project-string e))))
+      (m/info "An error occurs with the input string: " search-project-string (.getMessage e)))))

 (defn cli-options [profiles]
   [["-a" "--interactive" "activate interactive mode"]
@@ -145,9 +146,11 @@
        (cli/parse-opts args)))

 (defn sync [project-desc & args]
-  (let [{:keys [options arguments summary errors]} (parse-args project-desc args)]
+  (let [{:keys [options arguments summary errors]} (parse-args project-desc args)
+        {interactive-mode :interactive} options]
     (cond
       (seq errors) (m/abort (str/join " " errors))
+      (and (zero? (count arguments)) interactive-mode) (execute-program ALL-PROJECTS project-desc options c/SYNC-COMMANDS PARENT-FOLDER)
       (not= 1 (count arguments)) (m/abort (usage summary))
       :else (execute-program (first arguments) project-desc options c/SYNC-COMMANDS PARENT-FOLDER))
     (m/exit)))


Add 'version-in-range?

Add 'version-in-range?

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -321,6 +321,12 @@

 ;; === freshen ===
+
+(let [gvs (GenericVersionScheme.)]
+  (defn version-in-range?
+    [range-str version-str]
+    (.containsVersion (.parseVersionConstraint gvs range-str)
+                      (.parseVersion gvs version-str))))

 (defn fetch-checkout-all
   "This is slower than necessary for most real use cases."


Cleaned up some of the code

Cleaned up some of the code

Removed 'resource' functions since they were really only useful during
early development. Added a :pre assertion to transform-file, might add a
few more in a bit.

--- src/extracter/core.clj
+++ src/extracter/core.clj
@@ -24,11 +24,6 @@
        (take-while (complement code?))
        (s/join "\n")))

-(defn parse-resource
-  [^String path]
-  (let [rdr (io/reader (io/resource path))]
-    (parse (slurp rdr))))
-
 (def transformations
   {:BodyContinued str
    :BodyMain str
@@ -40,14 +35,10 @@
    :Doc (fn [title & maps] {:title title :sections (vec maps)})
    :Docs (fn [& facts] {:facts (vec facts)})})

-(defn transform-resource
-  [^String path]
-  (let [parse-tree (parse-resource path)]
-    (insta/transform transformations parse-tree)))
-
 (defn transform-file
   [^java.io.File f]
-  (let [parse-tree (parse (slurp f))]
+  {:pre [(files/fact? f)]}
+  (let [parse-tree (parse (slurp-comments f))]
     (insta/transform transformations parse-tree)))

 (defn transform-facts-in-dir


Adapt to upstream renaming (editor-view => editor)

--- src/flense_nw/app.cljs
+++ src/flense_nw/app.cljs
@@ -2,7 +2,7 @@
   (:require [cljs.core.async :as async :refer [<!]]
             [cljs.reader :as rdr]
             [flense.actions.text :as text]
-            [flense.editor :refer [editor-view]]
+            [flense.editor :as flense]
             [flense.model :as model]
             [flense-nw.cli :refer [cli-view]]
             [flense-nw.error :refer [error-bar-view]]
@@ -92,7 +92,7 @@

 (defn init []
   (let [command-chan (async/chan)]
-    (om/root editor-view app-state
+    (om/root flense/editor app-state
              {:target (.getElementById js/document "editor-parent")
               :opts {:edit-chan edit-chan}})
     (om/root cli-view nil


fixed previous and next buttons

fixed previous and next buttons

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -133,8 +133,8 @@
   (.emit socket "resume"))

 (defn get-current-track-num []
-  (first (indices #(= (.-id %1) (:current-track-id @app-state))
-                  (:music-info @app-state))))
+  (first (indices #(= %1 (:current-track-id @app-state))
+                  (:track-order @app-state))))

 (defn change-track [track-num]


Remove unused top-level get-skins call

Remove unused top-level get-skins call

Seems like a repl artificat of 0d980a12b4c5be069b0a75fd5771c3804420ef37

--- src/lt/objs/style.cljs
+++ src/lt/objs/style.cljs
@@ -99,8 +99,6 @@
            (for [[skin path] (object/raise-reduce app/app :skins+ {})]
               #js {:text (pr-str skin) :completion (pr-str skin)})))

-(get-skins)
-
 (behavior ::set-skin
                   :triggers #{:object.instant}
                   :desc "Style: Set Light Table skin"


Update task.clj

Update task.clj

--- src/iyye/bios/task.clj
+++ src/iyye/bios/task.clj
@@ -14,13 +14,66 @@
 ; You should have received a copy of the GNU Affero General Public License
 ; along with this program.  If not, see <http://www.gnu.org/licenses/>.

-(ns iyye.bios.task)
+(ns iyye.bios.task
+  (:require [clojure.zip :as zip]))
+
+;(defrecord Task [name function task-future parent paused])
+
+(def tasks-tree (ref []))
+
+(defn find-task [name]
+  (loop [cur (zip/vector-zip @tasks-tree)]
+    (if (zip/end? cur)
+      nil
+      (if (= (:name (zip/node cur)))
+        cur
+        (recur (zip/next cur))))))
+
+(defn run-on-all-tasks [func]
+  (loop [cur (zip/vector-zip @tasks-tree)]
+    (if (zip/end? cur)
+      nil
+      (do
+        (if (not (zip/branch? cur))
+          (func (zip/node cur)))
+        (recur (zip/next cur))))))
+
+(defn add-task [task]
+  (if-let [name (:parent task)]
+    (if-let [cur (find-task name)]
+      (if cur
+        (dosync (ref-set tasks-tree
+                         (-> cur (zip/append-child task) zip/root))))
+      (dosync (alter tasks-tree conj task)))
+    (dosync (alter tasks-tree conj task))))
+
+(defn remove-task [task]
+  (let [cur (find-task (:name task))]
+    (if cur
+      (dosync (ref-set tasks-tree (-> cur zip/remove zip/root))))))

 ; FIXME Yumzya: to add task trees
 (defn start-task [task]
   (dosync (ref-set (:task-future task) (future (while (not (Thread/interrupted))
-                                                       (dorun [((:function task))]))))))
+                                                 (dorun [((:function task))])))))
+  (add-task task))
+
+(defn run-off-task [task & params]
+  (dosync (ref-set (:task-future task) (future (dorun ((:function task) params)))))
+  (add-task task))

 (defn stop-task [task]
-  (future-cancel @(:task-future task)))
+  (future-cancel @(:task-future task))
+  (remove-task task))

+(defn pause []
+  (run-on-all-tasks #(future-cancel @(:task-future %))))
+
+(defn resume []
+  (run-on-all-tasks #(ref-set (:task-future %) (future (while (not (Thread/interrupted))
+                                                            (dorun [((:function %))]))))))
+
+(defn shutdown []
+  "Trivial now. FIXME Yumzya later add saving in-progress tasks"
+  (System/exit 0))
+


Add summary table to sparkline pulse

Add summary table to sparkline pulse

--- src/metabase/pulse.clj
+++ src/metabase/pulse.clj
@@ -43,18 +43,24 @@
       (t/within? (t/interval (t/minus today (t/days 1)) today) date) "Yesterday"
       :else (f/unparse (f/formatter "MMM d, YYYY") date))))

-(defn render-bar-chart-row
-  [index row max-value]
+(defn- format-cell
+  [value]
+  (cond
+    (instance? java.util.Date value) (format-timestamp (.getTime value))
+    (number? value) (format-number value)
+    :else (str value)))
+
+(defn render-table-row
+  [index row bar-column max-value]
   [:tr {:style (if (odd? index) "color: rgb(189,193,191);" "color: rgb(124,131,129);")}
-    [:td {:style bar-td-style} (first row)]
-    [:td {:style (str bar-td-style "font-weight: 700;")} (format-number (second row))]
-    [:td {:style (str bar-td-style "width: 99%;")}
-      [:div {:style (str "background-color: rgb(135, 93, 175); height: 20px; width: " (float (* 100 (/ (second row) max-value))) "%")} " "]]])
+    [:td {:style bar-td-style} (format-cell (first row))]
+    [:td {:style (str bar-td-style "font-weight: 700;")} (format-cell (second row))]
+    (if bar-column [:td {:style (str bar-td-style "width: 99%;")}
+      [:div {:style (str "background-color: rgb(135, 93, 175); height: 20px; width: " (float (* 100 (/ (bar-column row) max-value))) "%")} " "]])])

-(defn render-bar-chart
-  [data]
-  (let [{cols :cols rows :rows } data
-        max-value (apply max (map second rows))]
+(defn render-table
+  [{:keys [cols rows]} bar-column]
+  (let [max-value (if bar-column (apply max (map bar-column rows)))]
     [:table {:style "border-collapse: collapse;"}
       [:thead
         [:tr
@@ -62,13 +68,19 @@
             (-> cols first :display_name upper-case)]
           [:th {:style (str bar-td-style bar-th-style "min-width: 60px;")}
             (-> cols second :display_name upper-case)]
-          [:th {:style (str bar-td-style bar-th-style "width: 99%;")}]]]
+          (if bar-column [:th {:style (str bar-td-style bar-th-style "width: 99%;")}])]]
       [:tbody
-        (map-indexed #(render-bar-chart-row %1 %2 max-value) rows)]]))
+        (map-indexed #(render-table-row %1 %2 bar-column max-value) rows)]]))
+
+(defn render-bar-chart
+  [data]
+  [:div {:style ""}
+    (render-table data second)])

 (defn render-scalar
   [data]
-  [:div {:style scalar-style} (-> data :rows first first format-number)])
+  [:div {:style scalar-style}
+    (-> data :rows first first format-cell)])

 (def ^:private sparkline-dot-radius 6)
 (def ^:private sparkline-thickness 4)
@@ -98,18 +110,19 @@
   [bytes file-type]
   (str "data:" file-type ";base64," (new String (org.fit.cssbox.misc.Base64Coder/encode bytes))))

-  (defn render-sparkline
-    [{:keys [rows cols]}]
-    (let [xs (map #(-> % first .getTime) rows)
-          xmin (apply min xs)
-          xmax (apply max xs)
-          xrange (- xmax xmin)
-          xs' (map #(/ (- % xmin) xrange) xs)
-          ys (map second rows)
-          ymin (apply min ys)
-          ymax (apply max ys)
-          yrange (- ymax ymin)
-          ys' (map #(/ (- % ymin) yrange) ys)]
+(defn render-sparkline
+  [{:keys [rows cols] :as data}]
+  (let [xs (map #(-> % first .getTime) rows)
+        xmin (apply min xs)
+        xmax (apply max xs)
+        xrange (- xmax xmin)
+        xs' (map #(/ (- % xmin) xrange) xs)
+        ys (map second rows)
+        ymin (apply min ys)
+        ymax (apply max ys)
+        yrange (- ymax ymin)
+        ys' (map #(/ (- % ymin) yrange) ys)]
+    [:div
       [:div {:style "color: rgb(214,214,214);" }
         [:div {:style "display: inline-block; position: relative; margin-left: 30px;" }
           [:div {:style "position: relative;"}
@@ -123,7 +136,9 @@
             [:div {:style "height: 15px; margin-left: 10px; margin-right: 10px;"}
               [:div {:style "float: left;"} (format-timestamp xmin)]
               [:div {:style "float: right;"} (format-timestamp xmax)]]
-          ]]]))
+          ]]]
+      [:div {:style "margin-top: 20px; margin-left: 30px;"}
+        (render-table {:cols cols :rows [(last rows) (first rows)]} nil)]]))

 (defn render-pulse-card
   [card data include-title]


Start db componenet with a session and use it when connecting to c*.

--- src/kixi/hecuba/db.clj
+++ src/kixi/hecuba/db.clj
@@ -22,17 +22,15 @@

 (defn execute-query
   "Executes raw CQL query."
-  [config query]
-  (let [session (create-db-session config)]
-    (client/execute session query)
-   ; (client/disconnect!)
-    ))
+  [session query]
+  (client/execute session query))

 (deftype Database [config]
   Lifecycle
   (init [_ system]
     system)
   (start [_ system]
-    (update-in system [(:jig/id config) ::cluster] (constantly (select-keys config [:hosts :keyspace :port :credentials]))))
+    (let [session (create-db-session config)]
+      (update-in system [(:jig/id config) ::db-session] (constantly session))))
   (stop [_ system]
     system))


Trololol defn

Trololol defn

--- src/lazubot/docker.clj
+++ src/lazubot/docker.clj
@@ -19,6 +19,7 @@
 (defn build-container!
   "Build the worker image. Should only need to do this once unless you
   want to do a fresh pull of the repository."
+  []
   (shell/sh "docker" "build" "-no-cache=true" "-t=lazubot-worker" "resources/public"))

 (defn run-new-container!


Ordering

Ordering

--- src/lazubot/docker.clj
+++ src/lazubot/docker.clj
@@ -38,6 +38,18 @@
   (dosync
    (commute workers assoc (:id worker-doc) worker-doc)))

+(defn add-worker! []
+  "Start a new lazubot-worker container and add its worker-doc to the
+  workers ref."
+  (let [container-id (run-new-container!)
+        container-address (container-address container-id)
+        socket-address (str "tcp://" container-address ":" (:expose-port config))
+        [request-in request-out] (repeatedly 2 #(chan (sliding-buffer 64)))
+        worker-doc {:id container-id :in request-in :out request-out}]
+    (register-socket! {:in request-in :out request-out :socket-type :req
+                       :configurator (fn [socket] (.connect socket socket-address))})
+    (register-worker! worker-doc)))
+
 (defn replace-worker!
   "Called upon worker death. Remove the given worker and spin up a new
   one."
@@ -59,15 +71,3 @@
             (>! result-channel response)
             (replace-worker! worker-doc))))
     result-channel))
-
-(defn add-worker! []
-  "Start a new lazubot-worker container and add its worker-doc to the
-  workers ref."
-  (let [container-id (run-new-container!)
-        container-address (container-address container-id)
-        socket-address (str "tcp://" container-address ":" (:expose-port config))
-        [request-in request-out] (repeatedly 2 #(chan (sliding-buffer 64)))
-        worker-doc {:id container-id :in request-in :out request-out}]
-    (register-socket! {:in request-in :out request-out :socket-type :req
-                       :configurator (fn [socket] (.connect socket socket-address))})
-    (register-worker! worker-doc)))


Fixed indentation.

Fixed indentation.

--- src/overtunes/core.clj
+++ src/overtunes/core.clj
@@ -1,3 +1,2 @@
 (ns overtunes.core
-  (:use [overtone.live])
-)
+  (:use [overtone.live]))


made parser more compliant with clojure.xml

--- src/paredit/parser.clj
+++ src/paredit/parser.clj
@@ -4,7 +4,7 @@
 ; 1.a  (and move the special handling of zipping terminals up on :eof from default-handler to default-maker ?)
 ; 2. correctly handle clojure specificities : #{} #^ #"" ' ` @ #^ ^ #' #_ #() ~ ~@ foo# #!
 ; 3. correctly handle the premature :eof on non closed structures (a cause of error)
-; 4. correctly handle parsetree errors (wrong closing of bracket, ... TODO finish the exhaustive list)
+; 4. correctly handle parsetree errors (wrong closing of bracket (this one done), ... TODO finish the exhaustive list)
 ; 5. make the parser restartable
 ; 6. make the parser incremental
 ; 7. refactor the code so that the handling of advancing offset, line, column ... is mutualized (be aware of not introducing regressions in the handling of atoms and spaces terminals)
@@ -13,6 +13,9 @@

 ; bugs:
 ; \newlinb should be an error, not \n + symbol ewlinb
+
+; miscellaneous TODO
+; * add an explicit error message to :parser-state :ko (unbalanced parens)

 (ns paredit.parser
 	(:use clojure.test))
@@ -67,9 +70,14 @@
 (def *closing-brackets* (set (vals *brackets*)))
 (def *spaces* #{\space \tab \newline \return})
 (def *atoms* #{ \a \space})
-
+
 (defn zip-one [#^String text offset line col parents parser-state accumulated-state]
-  (let [level (-> accumulated-state peek (assoc :end-offset offset))
+  (let [level (-> accumulated-state peek)
+        level-content (get level :content [])
+        level-content (if-let [closing-delimiter (-> level :tag *brackets*)]
+                        (conj level-content (str closing-delimiter))
+                        (conj level-content (.substring text (get level :offset 0) offset)))
+        level (-> accumulated-state peek (assoc :end-offset offset :content level-content))
         parent-level (-> accumulated-state pop peek)
         brothers (get parent-level :content [])
         parent-level (assoc parent-level :content (conj brothers level))]
@@ -86,7 +94,11 @@
           (zip-one
             text offset line col parents parser-state
             (-> accumulated-state (conj (peek parents))))
-          (-> accumulated-state (conj (peek parents))))
+          (let [new-node (peek parents)
+                new-node (assoc new-node :content (if-let [opening-delimiter (*opening-brackets* (:tag new-node))]
+                                           [(str opening-delimiter)]
+                                           []))]
+            (-> accumulated-state (conj new-node))))
       (or
         (< (count parents) (count accumulated-state))
         (and (= :eof parser-state) (*atoms* (-> accumulated-state peek :tag))))


Minor code reorganization.

Minor code reorganization.

--- src/postal/client.cljs
+++ src/postal/client.cljs
@@ -6,6 +6,10 @@
             [httpurr.client :as http]
             [httpurr.status :as http-status]
             [httpurr.client.xhr :as xhr]))
+
+(def ^:private
+  +default-headers+
+  {"content-type" "application/transit+json"})

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Data encoding/decoding
@@ -22,27 +26,8 @@
     (t/write w data)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Encoding & Decoding
+;; Implementation Details
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defrecord Client [headers method url])
-
-(defn client
-  "Creates a new client instance from socket."
-  ([url]
-   (client url {}))
-  ([url {:keys [headers method] :or {headers {} method :put}}]
-   (Client. headers method url)))
-
-(defn client?
-  "Return true if a privided client is instance
-  of Client type."
-  [client]
-  (instance? Client client))
-
-(def ^:private
-  +default-headers+
-  {"content-type" "application/transit+json"})

 (defn- process-response
   [response]
@@ -61,6 +46,39 @@
     (if (= :method :get)
       (merge req {:query-string (str "d=" (b64/encodeString data true))})
       (merge req {:body data}))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The basic client interface.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defrecord Client [headers method url])
+
+(defn client
+  "Creates a new client instance from socket."
+  ([url]
+   (client url {}))
+  ([url {:keys [headers method] :or {headers {} method :put}}]
+   (Client. (atom headers) method url)))
+
+(defn client?
+  "Return true if a privided client is instance
+  of Client type."
+  [client]
+  (instance? Client client))
+
+(defn update-headers!
+  "Update the headers on the client instance."
+  [c headers]
+  {:pre [(client? c)]}
+  (let [ha (:headers c)]
+    (swap! ha merge headers)))
+
+(defn reset-headers!
+  "Reset the headers on the client instance."
+  [c headers]
+  {:pre [(client? c)]}
+  (let [ha (:headers c)]
+    (reset! ha headers)))

 (defn send!
   [client {:keys [type dest data headers] :as opts}]


redirecting URLs like /faq/n to /faq/n/0. (SEO again - in case someone erases part of the URL to navigate)

--- src/prais2/routes.cljs
+++ src/prais2/routes.cljs
@@ -25,6 +25,17 @@
 ;;;
 (defroute faqs "/faqs" []
   (put! core/event-bus [:faqs nil])
+  )
+
+(defroute sec "/faq/:section" [section]
+  (let [s (js/parseInt section)
+        ap @core/app]
+    (if (not (and
+               (= (:page ap) :faqs)
+               (= (:section ap) [s 0])))
+      (do
+        (put! core/event-bus [:faq [s 0]])
+        (prn "faq match" s 0))))
   )

 (defroute faq "/faq/:section/:id" [section id]


add docstring note about 1-element vector forms in bind helpers

--- src/preflex/either.clj
+++ src/preflex/either.clj
@@ -140,7 +140,7 @@

 (defmacro bind->
-  "Thread-first expansion using bind.
+  "Thread-first expansion using bind. A vector form of one element [x] is treated as [x x].
   Example usage                           Expanded as
   -------------                         | -----------
   (bind-> (place-order)                 | (-> (place-order)
@@ -160,7 +160,7 @@

 (defmacro bind->>
-  "Thread-last expansion using bind.
+  "Thread-last expansion using bind. A vector form of one element [x] is treated as [x x].
   Example usage                           Expanded as
   -------------                         | -----------
   (bind->> (place-order)                | (-> (place-order)
@@ -180,7 +180,7 @@

 (defmacro bind-as->
-  "Thread-anywhere expansion using bind.
+  "Thread-anywhere expansion using bind. A vector form of one element [x] is treated as [x x].
   Example usage                             Expanded as
   -------------                           | -----------
   (bind-as-> (place-order) $              | (-> (place-order)


sawtooth front

sawtooth front

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -515,7 +515,7 @@
     ))))

   (let [light-param (params/build-oscillated-param
-        (oscillators/sawtooth-beat :beat-ratio :osc-beat-ratio :down? true) :min :lightness-min-general :max :lightness-max-general)]
+        (oscillators/sawtooth-beat :beat-ratio :osc-beat-ratio :down? true) :min :lightness-min-general :max :lightness-max-back)]
     (ct/set-cue! (:cue-grid *show*) 0 2
       (cues/cue :color  (fn [_] (afterglow.effects/scene
         "Sawtooth Back"
@@ -525,18 +525,29 @@
   ))

+  (let [light-param (params/build-oscillated-param
+        (oscillators/sawtooth-beat :beat-ratio :osc-beat-ratio :down? true) :min :lightness-min-general :max :lightness-max-front)]
+    (ct/set-cue! (:cue-grid *show*) 1 2
+      (cues/cue :color  (fn [_] (afterglow.effects/scene
+        "Sawtooth Front"
+          (afterglow.effects.color/color-effect
+            "Bass" (params/build-color-param :h :main-hue :s 100 :l light-param) (show/fixtures-named "front"))
+      )))
+  ))
+
+

   (let [light-param-back (params/build-oscillated-param
         (oscillators/sawtooth-beat :beat-ratio :osc-beat-ratio :down? true) :min :lightness-min-general :max :lightness-max-general)
         light-param-front (params/build-oscillated-param
         (oscillators/sawtooth-beat :beat-ratio :osc-beat-ratio :down? true) :min :lightness-min-general :max :lightness-max-front)]
-    (ct/set-cue! (:cue-grid *show*) 1 2
+    (ct/set-cue! (:cue-grid *show*) 2 2
       (cues/cue :color  (fn [_] (afterglow.effects/scene
         "Sawtooth Back & Front"
           (afterglow.effects.color/color-effect
-            "Bass" (params/build-color-param :h :main-hue :s 100 :l light-param-back) (show/fixtures-named "back"))
+            "Back" (params/build-color-param :h :main-hue :s 100 :l light-param-back) (show/fixtures-named "back"))
           (afterglow.effects.color/color-effect
-            "Bass" (params/build-color-param :h :main-hue :s 100 :l light-param-front (show/fixtures-named "front"))
+            "Front" (params/build-color-param :h :main-hue :s 100 :l light-param-front (show/fixtures-named "front"))
       )))
   )))


Add openjdk-17 variants and remove openjdk-16-alpine

--- src/docker_clojure/core.clj
+++ src/docker_clojure/core.clj
@@ -33,7 +33,7 @@

 (def base-image "openjdk")

-(def jdk-versions #{8 11 15 16})
+(def jdk-versions #{8 11 15 16 17})

 ;; The default JDK version to use for tags that don't specify one; usually the latest LTS release
 (def default-jdk-version 11)
@@ -56,6 +56,8 @@
     {:jdk-version 11
      :distro      "alpine"}
     {:jdk-version 15
+     :distro      "alpine"}
+    {:jdk-version 16
      :distro      "alpine"}})

 (def maintainers


Further lint cleanup

Further lint cleanup

--- src/rainboots/core.clj
+++ src/rainboots/core.clj
@@ -126,7 +126,6 @@
   (let [on-connect (:on-connect opts)
         on-auth (:on-auth opts)
         on-cmd (:on-cmd opts)
-        on-404 (:on-404 opts)
         telnet-opts (:telnet-opts opts)
         on-telnet (:on-telnet opts)
         on-disconnect (:on-disconnect opts)
@@ -186,9 +185,16 @@
              on-prompt prompt-delay
              on-telnet]
       :as opts}]
-  {:pre [(not (nil? on-connect))
+  {:pre [(number? port)
+         (not (nil? on-connect))
          (not (nil? on-cmd))
-         (not (nil? on-auth))]}
+         (not (nil? on-auth))
+         (when on-404
+           (fn? on-404))
+         (when on-disconnect
+           (fn? on-disconnect))
+         (when on-telnet
+           (fn? on-telnet))]}

   (let [obj (atom {:connected (atom #{})
                    :on-prompt on-prompt


Use empty context instead of *flushing* in flush!

--- src/reagent/ratom.cljs
+++ src/reagent/ratom.cljs
@@ -98,8 +98,7 @@
 ;;; Queueing

 (defonce rea-queue nil)
-
-(def ^boolean ^:dynamic *flushing*)
+(def empty-context #js{})

 (defn- rea-enqueue [r]
   (when (nil? rea-queue)
@@ -116,8 +115,9 @@
 (defn flush! []
   (when-some [q rea-queue]
     (set! rea-queue nil)
-    (binding [*flushing* true]
-      (run-queue q))))
+    (binding [*ratom-context* empty-context]
+      (run-queue q))
+    (assert (nil? (-captured empty-context)))))

 ;;; Atom
@@ -372,7 +372,7 @@

   (_handle-change [this sender oldval newval]
     (when-not (identical? oldval newval)
-      (if *flushing*
+      (if-not (nil? *ratom-context*)
         (if-not (nil? auto-run)
           (auto-run this)
           (when-not dirty?
@@ -428,7 +428,7 @@

   IDeref
   (-deref [this]
-    (when-not (or *flushing* (not (nil? *ratom-context*)))
+    (when (nil? *ratom-context*)
       (flush!))
     (if-not (and (nil? auto-run) (nil? *ratom-context*))
       (do


Config: require folds.

Config: require folds.

--- src/reimann/config.clj
+++ src/reimann/config.clj
@@ -3,6 +3,7 @@
   (:require [reimann.server])
   (:require reimann.index)
   (:require [reimann.logging :as logging])
+  (:require [reimann.folds :as folds])
   (:use clojure.tools.logging)
   (:use reimann.client)
   (:use reimann.streams)


Fix #403: directory includes binding *config-file* incorrectly.

--- src/riemann/config.clj
+++ src/riemann/config.clj
@@ -399,7 +399,10 @@
     (binding [*config-file* path
               *ns* (find-ns 'riemann.config)]
       (if (.isDirectory file)
-        (doseq [f (file-seq file)]
-          (when (config-file? f)
-            (load-file (.toString f))))
+        (->> file
+             file-seq
+             (filter config-file?)
+             (map str)
+             (map include)
+             dorun)
         (load-file path)))))


Make split-on-re public

Make split-on-re public

--- src/rp/util/string.clj
+++ src/rp/util/string.clj
@@ -42,12 +42,6 @@
   (when s
     (str/lower-case s)))

-(defn- split-on-re
-  [re s]
-  (if (non-blank-string s)
-    (mapv str/trim (str/split s re))
-    []))
-
 (def parse-double* (make-parser (:double regexes)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -68,6 +62,13 @@
   (some-> s
           parse-double*
           bigdec))
+
+(defn split-on-re
+  "Useful for its check on blankness and interstitial whitespace trimming."
+  [re s]
+  (if (non-blank-string s)
+    (mapv str/trim (str/split s re))
+    []))

 (def split-on-comma (partial split-on-re (:comma regexes)))
 (def split-on-caret (partial split-on-re (:caret regexes)))


[SM][000000] Catch exceptions thrown from parsing octal strings

--- src/rp/util/string.clj
+++ src/rp/util/string.clj
@@ -2,9 +2,11 @@
   (:require [clojure.tools.reader.edn :as edn]
             [clojure.string :as str]))

-(def long-regex (re-pattern "([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)(N)?"))
-(def double-regex (re-pattern "([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?"))
-(def bool-regex (re-pattern "(?i)true|false"))
+(def ^:const long-regex (re-pattern "([-+]?)(?:(0)|([1-9][0-9]*)|0[xX]([0-9A-Fa-f]+)|0([0-7]+)|([1-9][0-9]?)[rR]([0-9A-Za-z]+)|0[0-9]+)(N)?"))
+(def ^:const double-regex (re-pattern "([-+]?[0-9]+(\\.[0-9]*)?([eE][-+]?[0-9]+)?)(M)?"))
+(def ^:const bool-regex (re-pattern "(?i)true|false"))
+
+(def ^:const comma-regex #",")

 (defn parseable?
   [re s]
@@ -14,13 +16,16 @@
   [regex]
   (fn [s]
     (when (and (string? s) (parseable? regex s))
-      (edn/read-string (str/lower-case s)))))
+      (try
+        (edn/read-string s)
+        (catch Exception e)))))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Public API

 (def parse-long (make-parser long-regex))
-(def parse-boolean (make-parser bool-regex))
+(def parse-boolean (comp (make-parser bool-regex)
+                         #(when % (str/lower-case %))))
 (def parse-double* (make-parser double-regex))

 (defn parse-double
@@ -29,6 +34,12 @@
           parse-double*
           double))

+(defn parse-big-decimal
+  [s]
+  (some-> s
+          parse-double*
+          bigdec))
+
 (defn non-blank-string
   "Returns x if it is a non-blank string, nil otherwise."
   [x]


think about refactoring a lot of things in this project and add a comment

--- src/ibcm_assembler/core.clj
+++ src/ibcm_assembler/core.clj
@@ -1,5 +1,7 @@
 (ns ibcm-assembler.core
   (:gen-class))
+
+;; Go easy on me - this was the first clojure code I ever wrote

 (def hex-digits [\0 \1 \2 \3 \4 \5 \6 \7 \8 \9 \A \B \C \D \E \F])
 (def op-names [:halt :io :shift :load :store :add :sub :and :or :xor :not :nop :jmp :jmpe :jmpl :brl])
@@ -13,6 +15,7 @@
   (opmap (keyword op)))

 (defn remove-first [input] (apply str (rest input)))
+
 (defn parse-instr [instr]
   "takes an instruction as a string and returns a map representing the instruction"
   (let [instr-seq (clojure.string/split instr #"\s+")
@@ -74,7 +77,6 @@
     (= :a instr-type)
     (let [address (instr :address)
           opcode (instr :opcode)] (str (opmap opcode) (get-address address labels)))))
-
 (defn encode
   ([instr]
    (encode instr {}))
@@ -86,16 +88,15 @@
 (defn format-instruction [op locn comm labelmap]
   (str (encode op labelmap) \tab locn \tab (pad op) comm))

-(defn make-pair [line locn] [line locn])
 ;; TODO refactor label-map because i know there's about 1,000 better ways to do this
 (defn label-map [lines]
-  (let [with-dots  (->> (map make-pair lines addresses)
-                        (filter #(= (ffirst %) \.))
-                        flatten
-                        (apply hash-map))]
-    (zipmap (map remove-first (keys with-dots)) (vals with-dots))))
-
-;; TODO note, I think I could totally use the state monad here to handle labels
+  (->> (map list lines addresses)
+       (filter (fn [[k v]] (not (empty? k))))
+       print
+       (filter (fn [[k v]] (= (subs k 0 1) \.)))
+       (map (fn [[k v]] [(subs k 1) v]))
+       (into {})))
+;; TODO note, I think I could use the state monad here to handle labels
 ;; I'm realizing that once I introduce a label map to these functions, I have two
 ;; options: either add an argument, the label map, or pass in the state as a monad
 (defn assemble [x]


formatting

formatting

--- src/leiningen/fore_prob.clj
+++ src/leiningen/fore_prob.clj
@@ -36,8 +36,8 @@
     (if-not (re-find (re-pattern (str "(?m)^\\(defn " prob)) (slurp src))
       (spit src
             (str "\n(defn " prob "-solution [] ; Update args as needed!\n"
-                 (-> project :description desc->comments)
-                 "nil)\n")
+                 (-> project :description desc->comments) "\n"
+                 "  nil)\n")
             :append true))))

 (defn- no-test-yet


fix formatting on api/routes.clj which got lost in a previous commit.

--- src/metabase/api/routes.clj
+++ src/metabase/api/routes.clj
@@ -27,22 +27,22 @@
   auth/enforce-authentication)

 (defroutes routes
-  (context "/activity" [] (+auth activity/routes))
-  (context "/card" [] (+auth card/routes))
-  (context "/dash" [] (+auth dash/routes))
-  (GET "/health" [] {:status 200 :body {:status "ok"}})
+  (context "/activity"     [] (+auth activity/routes))
+  (context "/card"         [] (+auth card/routes))
+  (context "/dash"         [] (+auth dash/routes))
+  (GET "/health"           [] {:status 200 :body {:status "ok"}})
   (context "/meta/dataset" [] (+auth dataset/routes))
-  (context "/meta/db" [] (+auth db/routes))
-  (context "/meta/field" [] (+auth field/routes))
-  (context "/meta/fk" [] (+auth fk/routes))
-  (context "/meta/table" [] (+auth table/routes))
-  (context "/notify" [] (+apikey notify/routes))
-  (context "/revision" [] (+auth revision/routes))
-  (context "/session" [] session/routes)
-  (context "/setting" [] (+auth setting/routes))
-  (context "/setup" [] setup/routes)
-  (context "/tiles" [] (+auth tiles/routes))
-  (context "/user" [] (+auth user/routes))
+  (context "/meta/db"      [] (+auth db/routes))
+  (context "/meta/field"   [] (+auth field/routes))
+  (context "/meta/fk"      [] (+auth fk/routes))
+  (context "/meta/table"   [] (+auth table/routes))
+  (context "/notify"       [] (+apikey notify/routes))
+  (context "/revision"     [] (+auth revision/routes))
+  (context "/session"      [] session/routes)
+  (context "/setting"      [] (+auth setting/routes))
+  (context "/setup"        [] setup/routes)
+  (context "/tiles"        [] (+auth tiles/routes))
+  (context "/user"         [] (+auth user/routes))
   (route/not-found (fn [{:keys [request-method uri]}]
                      {:status 404
                       :body   (str (.toUpperCase (name request-method)) " " uri " is not yet implemented.")})))


Make kibit happy. Thanks kibit.

Make kibit happy. Thanks kibit.

--- src/oc/storage/api/orgs.clj
+++ src/oc/storage/api/orgs.clj
@@ -170,7 +170,7 @@
                 (create-board conn updated-org {:name create-board-name} author))
                 create-board-names))
               ;; create a min of 3 / max of 4 sample entries, including at least 1 from the forced board
-              selected-entries (take 3 (flatten (map #(default-entries-for %) selected-board-names)))
+              selected-entries (take 3 (flatten (map default-entries-for selected-board-names)))
               forced-entries (default-entries-for config/forced-board-name)
               total-entries (take 4 (concat selected-entries forced-entries))
               create-entries (map #(assoc % :author (lib-schema/author-for-user author))


Correctly index pseudo control ugens

Correctly index pseudo control ugens

--- src/overtone/repl/debug.clj
+++ src/overtone/repl/debug.clj
@@ -115,7 +115,7 @@
             (conj res (assoc ug
                         :inputs {}
                         :orig-id c-idx
-                        :control-param (nth (:unified-params sdef) (+ (find-control-offset (:name ug) sdef)))
+                        :control-param (nth (:unified-params sdef) (+ (find-control-offset (:name ug) sdef) idx))
                         :default 1
                         :id (mk-control-id (:id ug) idx)
                         :outputs (nth (:outputs ug) idx))))


fixed bug, where beats were skipped at high tempos

--- src/metronome/core.cljs
+++ src/metronome/core.cljs
@@ -45,9 +45,15 @@
     (did-mount [_]
                (let [sound-channel (om/get-state owner :sound-channel)]
                  (go (loop []
-                       (and (<! sound-channel) (.play (if (zero? (mod (om/get-state owner :beat) 4)) (om/get-node owner "ding") (om/get-node owner "dong"))))
-                       (om/update-state! owner :beat inc)
-                       (recur)))))
+                       (let [_     (<! sound-channel)
+                             audio (if (zero? (mod (om/get-state owner :beat) 4))
+                                     (om/get-node owner "ding")
+                                     (om/get-node owner "dong"))]
+                         (if (.-paused audio)
+                           (.play audio)
+                           (set! (.-currentTime audio) 0))
+                         (om/update-state! owner :beat inc)
+                         (recur))))))
     om/IRender
     (render [_]
             (dom/div nil


Add entity query

Add entity query

--- src/todomvc/rules.cljs
+++ src/todomvc/rules.cljs
@@ -140,9 +140,10 @@
 ;  [:?id])
 ;  [?todo <- Todo (= id ?id)])
 ;
-(defquery find-todo [:?eid]
-  [?todo <- :all [[e a v]] (= e ?eid)])
-
+(defquery entity- [:?eid]
+  [?entity <- :all [[e a v]] (= e ?eid)])
+
+(defn entity [session id] (mapv :?entity (query session entity- :?eid id)))
 ;; MVCtodo uses sequential ids. Since this is a horrible idea, I'm skipping it this pass.
 ;(defquery find-max-id
 ;  []
@@ -153,9 +154,9 @@
 ;  [?todos <- (acc/all) :from [Todo (= done true)]])
 ;
 (defquery find-all-done []
-  ;[:all [[e a v]] (= e ?e) (= a ?a) (= v ?v)]
   [:all [[e a v]] (= e ?e) (= a ?a) (= v ?v)]
   [:test (= (attr-ns ?a) "todo")])
+

 ;(defquery find-done-count
 ;  []
@@ -178,7 +179,7 @@

 @(def session (fire-rules (insert-all todos facts)))

-@(def all-done (query session find-all-done))
+(def all-done (query session find-all-done))

 (defn clara-tups->maps
   [tups]
@@ -194,6 +195,8 @@

 (cljs.pprint/pprint (clara-tups->maps all-done))

+(cljs.pprint/pprint (entity session (:db/id (first (clara-tups->maps all-done)))))
+

 (println "Done count: " (query session find-done-count))


Allow Clojure files to be loaded

Allow Clojure files to be loaded

--- src/nightmod/public.clj
+++ src/nightmod/public.clj
@@ -1,5 +1,7 @@
 (ns nightmod.public
-  (:require [nightmod.core :refer :all]
+  (:require [clojail.core :as jail]
+            [clojure.java.io :as io]
+            [nightmod.core :refer :all]
             [play-clj.core :refer :all]))

 (defn set-game-screen!
@@ -7,3 +9,11 @@
   (->> (apply set-screen! nightmod (conj (vec screens) overlay-screen))
        (fn [])
        (app! :post-runnable)))
+
+(defmacro load-game-file
+  [n]
+  (some->> (or (io/resource n)
+               (throw (Throwable. (str "File not found:" n))))
+           slurp
+           (format "(do %s\n)")
+           jail/safe-read))


fixed event handling issue

fixed event handling issue

--- src/node/game/core.cljs
+++ src/node/game/core.cljs
@@ -107,9 +107,10 @@
                        (get-in @state [:corp :servers :remote]))))
           (doseq [s (drop n (get-in @state [:corp :servers :remote]))
                   c (concat (:content s) (:ices s))]
-            (when-let [events (:events (card-def c))]
-              (unregister-events state side c)
-              (register-events state side events c)))))
+            (when (:rezzed c)
+              (when-let [events (:events (card-def c))]
+                (unregister-events state side c)
+                (register-events state side events c))))))
       moved-card)))

 (defn draw


RS | Remove content-type nosniff header

RS | Remove content-type nosniff header

--- src/objective8/core.clj
+++ src/objective8/core.clj
@@ -128,7 +128,9 @@
       (wrap-session {:cookie-attrs {:http-only true}})
       (wrap-xss-protection true {:mode :block})
       (wrap-frame-options :sameorigin)
-      (wrap-content-type-options :nosniff)))
+     ; (wrap-content-type-options :nosniff)
+
+      ))

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


Rollback changes to keep temp files of sent emails.

--- src/oc/email/mailer.clj
+++ src/oc/email/mailer.clj
@@ -75,9 +75,8 @@
       ;; (email-entry entry (content/share-link-text entry))
       (finally
         ;; remove the tmp files
-        ; (io/delete-file html-file true)
-        ; (io/delete-file inline-file true)
-        ))))
+        (io/delete-file html-file true)
+        (io/delete-file inline-file true)))))

 (defn send-reminder-notification
   "Create an HTML notification of a created reminder and email it to the specified recipient."
@@ -99,9 +98,8 @@
       (email reminder {:html (slurp inline-file)})
       (finally
         ;; remove the tmp files
-        ; (io/delete-file html-file true)
-        ; (io/delete-file inline-file true)
-        ))))
+        (io/delete-file html-file true)
+        (io/delete-file inline-file true)))))

 (defn send-reminder-alert
   "Create an HTML email to alert of an upcoming reminder and send it to the specified recipient"
@@ -122,9 +120,8 @@
       (email reminder {:html (slurp inline-file)})
       (finally
         ;; remove the tmp files
-        ; (io/delete-file html-file true)
-        ; (io/delete-file inline-file true)
-        ))))
+        (io/delete-file html-file true)
+        (io/delete-file inline-file true)))))

 (defn send-invite
   "Create an HTML and text invite and email it to the specified recipient."
@@ -144,9 +141,8 @@
                          :html (slurp inline-file)})
       (finally
         ;; remove the tmp files
-        ; (io/delete-file html-file true)
-        ; (io/delete-file inline-file true)
-        ))))
+        (io/delete-file html-file true)
+        (io/delete-file inline-file true)))))

 (defn send-follow-up
   "Create an HTML and text follow-up notification and email it to the specified recipient."
@@ -166,9 +162,8 @@
                              :html (slurp inline-file)})
       (finally
         ;; remove the tmp files
-        ; (io/delete-file html-file true)
-        ; (io/delete-file inline-file true)
-        ))))
+        (io/delete-file html-file true)
+        (io/delete-file inline-file true)))))

 (defn send-token
   "Create an HTML and text one-time-token email and email it to the specified recipient."
@@ -192,9 +187,8 @@
                   :html (slurp inline-file)})
       (finally
         ; remove the tmp files
-        ; (io/delete-file html-file true)
-        ; (io/delete-file inline-file true)
-        ))))
+        (io/delete-file html-file true)
+        (io/delete-file inline-file true)))))

 (defn send-digest
   "Create an HTML digest and email it to the specified recipient."
@@ -217,9 +211,8 @@
              {:html (slurp inline-file)})
       (finally
         ; remove the tmp files
-        ; (io/delete-file html-file true)
-        ; (io/delete-file inline-file true)
-        ))))
+        (io/delete-file html-file true)
+        (io/delete-file inline-file true)))))

 (defn send-private-board-notification
   "Creates an HTML private board invite email and sends it to the recipient."
@@ -241,9 +234,8 @@
              {:html (slurp inline-file)})
       (finally
        ;; remove the tmp files
-       ; (io/delete-file html-file true)
-       ; (io/delete-file inline-file true)
-       ))))
+       (io/delete-file html-file true)
+       (io/delete-file inline-file true)))))

 (defn- post-data-from-msg [msg]
   (let [notification (:notification msg)
@@ -294,9 +286,8 @@
              {:html (slurp inline-file)})
       (finally
        ;; remove the tmp files
-       ; (io/delete-file html-file true)
-       ; (io/delete-file inline-file true)
-       ))))
+       (io/delete-file html-file true)
+       (io/delete-file inline-file true)))))

 (defn send-bot-removed
   "Creates an HTML email notifying user of being mentioned or replied to and sends it to the recipient."
@@ -320,9 +311,8 @@
              {:html (slurp inline-file)})
       (finally
        ;; remove the tmp files
-       ; (io/delete-file html-file true)
-       ; (io/delete-file inline-file true)
-       ))))
+       (io/delete-file html-file true)
+       (io/delete-file inline-file true)))))

 (defn handle-data-change
   "


[fix][buttons] Disable buttons.

[fix][buttons] Disable buttons.

--- src/ombs/view/event.clj
+++ src/ombs/view/event.clj
@@ -29,26 +29,40 @@
 (h/defsnippet parts-snip "../resources/public/parts.html" parts-row-sel [parts]
   [:.parts] (h/set-attr :value (str parts)))

+(defn set-attr-class
+  ([attr]
+    (set-attr-class attr ""))
+  ([attr value]
+    {:pre (= (type attr) java.lang.String)}
+    (comp (h/set-attr attr value) (h/add-class attr))) )
+
+(defn rm-attr-class [attr]
+  {:pre (= (type attr) java.lang.String)}
+  (comp (h/remove-attr attr ) (h/remove-class attr)) )
+
 (defn pay-action [name date match]
   (if (and
         (core/participated? (sess/get :username) name date)
         (core/is-active? name date) ) ; have debt
-    ((h/remove-class "disabled") match)
-    ((h/add-class "disabled")    match)))
+    ((rm-attr-class "disabled")   match)
+    ((set-attr-class "disabled")  match)
+    ))

 (defn start-action [name date author match]
   (if (and (= author (sess/get :username))
            (core/is-initial? name date)
            (> (core/participants-count name date) 0))
-    ((h/remove-class "disabled") match)
-    ((h/add-class "disabled")    match)))
+    ((rm-attr-class "disabled")   match)
+    ((set-attr-class "disabled")  match)
+    ))

 (defn participate-action [name date status match]
   (if (and
         (not (core/participated? (sess/get :username) name date))
         (not= status "finished"))
-    ((h/remove-attr "disabled") match)
-    ((h/add-class "disabled")   match)))
+    ((rm-attr-class "disabled")   match)
+    ((set-attr-class "disabled")  match)
+    ))

 (defn fill-parts [parts match]
   (if (= 0 parts)


handler.clj: Massive update

handler.clj: Massive update

--- src/wlmmap/handler.clj
+++ src/wlmmap/handler.clj
@@ -125,7 +125,7 @@

 (defn- backend
   "interface to select which lang/country to store"
-  [req]
+  []
   (h/html5
    [:head (h/include-css "/css/admin.css")]
    [:body
@@ -173,31 +173,25 @@
     (doseq [m (:monuments res)]
       (when (and (not (nil? (:lat m)))
                  (not (nil? (:lon m)))
-                 (not (= "" (:name m))))
-        (let [;; reg (:registrant_url m)
-              ;; id (:id m)
+                 (not (= "" (:name m)))
+                 (not (= "" (:image m))))
+        (let [reg (:registrant_url m)
+              id (:id m)
               nam (cleanup-name (:name m))
-              ;; imc (:image m)
-              ;; img (codec/url-encode m)
-              ;; lng (:lang m)
-              ;; emb (str "")
-              ;; ilk (if (not (= imc ""))
-              ;;       (str "" emb "") "")
+              imc (:image m)
+              img (codec/url-encode imc)
+              lng (:lang m)
+              emb (str "")
+              ilk (when (not (= imc "")) (str "" emb ""))
               art (:monument_article m)
-              lnk "%s"
-              ;; arl (format "%s" lng art art)
-              ;; src (format "Source: %s" reg id)
-              ]
-          (wcar* (car/hset rset    ; key
-                           (:id m) ; field
-                           (list (list (:lat m) (:lon m))
-                                 (str "
" nam "
"
-                                      (if (not (= "" art)) "ok" "notok")
-                                      lnk
-                                      ;; ilk "
" (if art (str arl "
") "")
-                                      ;; src
-                                      )))))))
+              lnk "%s"
+              arl (format lnk lng (codec/url-encode art) art)
+              src (format "Source: %s" reg id)
+              all (str "
" nam "
"
+                                      (when (not (= "" imc)) (str ilk "
"))
+                                      (when (not (= "" art)) (str arl "
"))
+                                      (when (not (= "" reg)) src))]
+          (wcar* (car/hset rset (:id m) (list (list (:lat m) (:lon m)) all))))))
     (let [card (count (wcar* (car/hvals rset)))]
       (wcar* (car/hmset (str "s" rset)
                         "size" card
@@ -249,23 +243,22 @@
   (wcar* (car/hvals @db)))

 (defn- index [params]
-  ;; (swap! db ((if (:lang params) (:lang params) "fr") language-db))
   (h/html5
    [:head
-    (h/include-css "http://api.tiles.mapbox.com/mapbox.js/v1.3.1/mapbox.css")
+    (h/include-css "/css/mapbox.css")
     ""
     (h/include-css "/css/generic.css")]
    [:body
-    (h/include-css "http://www.mapbox.com/mapbox.js/assets/MarkerCluster.css")
-    (h/include-css "http://www.mapbox.com/mapbox.js/assets/MarkerCluster.Default.css")
+    (h/include-css "/css/MarkerCluster.css")
+    (h/include-css "/css/MarkerCluster.Default.css")
     (h/include-js "/js/ArrayLikeIsArray.js")
-    (h/include-js "http://api.tiles.mapbox.com/mapbox.js/v1.3.1/mapbox.js")
+    (h/include-js "/js/mapbox.js")
     ""
-    (h/include-js "http://www.mapbox.com/mapbox.js/assets/leaflet.markercluster.js")
+    (h/include-js "/js/leaflet.markercluster.js")
     "

"
     (h/include-js "/js/main.js")]))

@@ -273,7 +266,7 @@
 (defroutes app-routes
   (GET "/" {params :params} (index params))
   (POST "/" {params :params} (index params))
-  (GET "/backend" req (if-let [identity (friend/identity req)] (backend req) "Doh!"))
+  (GET "/backend" req (if-let [identity (friend/identity req)] (backend) "Doh!"))
   (POST "/process" {params :params} (process params))
   (GET "/login" [] (login-form))
   (GET "/logout" req (friend/logout* (resp/redirect (str (:context req) "/"))))


CMR-1980: Implemented collapsing of hierarchical maps.

--- search-app/src/cmr/search/api/keyword.clj
+++ search-app/src/cmr/search/api/keyword.clj
@@ -127,59 +127,6 @@

 (comment

-  (declare node-type)
-
-  (def branch-node-type
-    {:value s/Str
-     :subfields [s/Keyword]
-     (s/optional :uuid) s/Str
-     s/Keyword [node-type]})
-
-  (def leaf-node-type
-    {:value s/Str
-     :uuid s/Str})
-
-  (def root-node
-    s/Keyword [node-type])
-
-  (def node-type
-    (s/OR branch-node-type leaf-node-type))
-
-  (def expected-result
-    {:a [{:value "A1"
-          :subfields ["c"]
-          :c [{:value "C1"
-               :uuid "a1c1"
-               :subfields ["d"]
-               :d [{:value "D1"
-                    :uuid "a1c1d1"}]}]}
-         {:value "A2"
-          :uuid "a2"
-          :subfields ["d"]
-          :d [{:value "D1"
-               :uuid "a2d1"}]}
-         {:value "A3"
-          :subfields ["b" "c" "d"]
-          :b [{:value "B1"
-               :subfields ["c"]
-               :c [{:value "C1"
-                    :subfields ["d"]
-                    :d [{:value "D1"
-                         :uuid "a3b1c1d1"}]}]}]
-          :c [{:value "C2"
-               :uuid "a3c2"}]
-          :d [{:value "D2"
-               :uuid "a3d2"}]}]})
-
-  {:a "A1" :c "C1" :uuid "a1c1"}
-
-  {:a [{:value "A1"
-        :subfields ["b"]
-        :b [{:value nil
-             :subfields ["c"]
-             :c [{:value "C1"
-                  :uuid "a1c1"}]}]}]}
-
   (def example-keywords
     [{:a "A1" :c "C1" :uuid "a1c1"}
      {:a "A1" :c "C1" :d "D1" :uuid "a1c1d1"}
@@ -190,67 +137,41 @@
      {:a "A3" :c "C2" :uuid "a3c2"}
      {:a "A3" :d "D2" :uuid "a3d2"}])

-  (def keyword-hierarchy-example [:a :b :c :d])
-
-  (def expected-merged
-    {:a [{:value "A3"
-          :b [{:value nil
-               :c [{:value nil
-                    :d [{:value "D2"
-                         :uuid "a3d2"
-                         }]}
-                   {:value "C2"
-                    :uuid "a3c2"
-                    :d [{:value nil}]
-                    }]}
-              {:value "B1"
-               :c [{:value "C1"
-                    :d [{:value "D1"
-                         :uuid "a3b1c1d1"
-                         }]}
-                   ]}]}
-         {:value "A2"
-          ; :uuid "a2"
-          :b [{:value nil
-               :c [{:value nil
-                    :d [{:value "D1"
-                         :uuid "a2d1"
-                         }
-                        {:value nil}]}]}]}
-         {:value "A1"
-          :b [{:value nil
-               :c [{:value "C1"
-                    :uuid "a1c1"
-                    :d [{:value "D1"
-                         :uuid "a1c1d1"
-                         }
-                        {:value nil}]}]}]}]})
-
-
-  (->> example-keywords
-       (map #(keyword->hierarchy % [:a :b :c :d]))
-       (reduce merge-hierarchical-maps)
-       (= expected-merged)
-       )
-
-  (map #(keyword->hierarchy % [:a :b :c :d]) example-keywords)
-
-  )

 ;; Three steps
 ;; Flat to hierarchical map
 ;; Merge together all of the keyword maps
 ;; Remove fields that should not be there

+  (->> example-keywords
+       (map #(keyword->hierarchy % [:a :b :c :d]))
+       (reduce merge-hierarchical-maps)
+       collapse-hierarchical-map
+       convert-to-json
+       println
+       )
+
+
+  )
+
+
 (defn keyword->hierarchy
+  "TODO comment this"
   [keyword-map keyword-hierarchy]
-  (let [[current-subfield & remaining-subfields] keyword-hierarchy]
-    {current-subfield [(merge
-                        (when (seq remaining-subfields)
-                          (keyword->hierarchy keyword-map remaining-subfields))
-                        {:value (current-subfield keyword-map)})]}))
+  (let [[current-subfield & remaining-subfields] keyword-hierarchy
+        current-value (get keyword-map current-subfield)
+        subfield-hierarchy (when (seq remaining-subfields)
+                             (keyword->hierarchy keyword-map remaining-subfields))]
+    (when (or current-value subfield-hierarchy)
+      (if subfield-hierarchy
+        {current-subfield #{(merge
+                              subfield-hierarchy
+                              {:value current-value})}}
+        {current-subfield #{{:value current-value
+                             :uuid (:uuid keyword-map)}}}))))

 (defn merge-hierarchical-maps
+  "TODO comment this"
   [hm1 hm2]
   ;; Merge the two maps without their values
   (let [merged-map (merge-with
@@ -261,123 +182,66 @@
                                         (map-by :value existing-values)
                                         (map-by :value new-values))
                             vals
-                            vec))
+                            ;; TODO consider removing calls to vec
+                            set))
                      (dissoc hm1 :value :uuid)
                      (dissoc hm2 :value :uuid))]
-    ;; Add value back in if it was there originally
-    (if (contains? hm1 :value)
-      (assoc merged-map :value (:value hm1))
-      merged-map)))
-
-(comment
-
-  (def example-keywords
-    [{:a "A1" :c "C1" :uuid "a1c1"}
-     {:a "A1" :c "C1" :d "D1" :uuid "a1c1d1"}
-     {:a "A2" :uuid "a2"}
-     {:a "A2" :d "D1" :uuid "a2d1"}
-     {:a "A3" :b "B1" :c "C1" :d "D1" :uuid "a3b1c1d1"}
-     {:a "A3" :c "C2" :uuid "a3c2"}
-     {:a "A3" :d "D2" :uuid "a3d2"}])
-
-  (def hm1
-    (keyword->hierarchy (first example-keywords) [:a :b :c :d]))
-
-  (def hm2
-    (keyword->hierarchy (second example-keywords) [:a :b :c :d]))
-
-  (def hm3
-    (keyword->hierarchy (nth example-keywords 2) [:a :b :c :d]))
-
-
-  (def hm1
-    {:a [{:value "A1",
-          :b [{:value nil,
-               :c [{:value "C1",
-                    :d [{:value nil}]}]}]}]})
-
-  (def hm2
-    {:a [{:value "A1",
-          :b [{:value nil,
-               :c [{:value "C1",
-                    :d [{:value "D1"}]}]}]}]})
-
-  (def hm1-2-combined
-    {:a [{:value "A1",
-          :b [{:value nil,
-               :c [{:value "C1",
-                    :d [{:value "D1"}
-                        {:value nil}]}]}]}]})
-
-  (def hm3
-    {:a [{:value "A2",
-          :b [{:value nil,
-               :c [{:value nil,
-                    :d [{:value nil}]}]}]}]})
-
-  ; map -> :keyword vector
-  ;vector -> maps
-
-  (defn map-by
-    "Like group-by but assumes that all the keys returned by f will be unique per item"
-    [f things]
-    (into {} (for [thing things] [(f thing) thing])))
-
-
-
-  (defn merge-hierarchical-maps
-    [hm1 hm2]
-    ;; Merge the two maps without their values
-    (let [merged-map (merge-with
-                       (fn [existing-values new-values]
-                         ;; Find the values in common by using map-b and then merge those maps.
-                         ;; The merge-with here recursively calls into the same function
-                         (->> (merge-with merge-hierarchical-maps
-                                          (map-by :value existing-values)
-                                          (map-by :value new-values))
-                              vals
-                              vec))
-                       (dissoc hm1 :value)
-                       (dissoc hm2 :value))]
-      ;; Add value back in if it was there originally
-      (if (contains? hm1 :value)
-        (assoc merged-map :value (:value hm1))
-        merged-map)))
-
-  (= hm1-2-combined (value-map-merger-cleaner hm1 hm2))
-
-  )
-
-(defn create-branch-nodes
-  [subfield remaining-subfields keywords]
-  (let [keywords-by-subfield-value (group-by subfield keywords)]
-    (if-let [[next-subfield & remaining-subfields] (seq remaining-subfields)]
-      {subfield (for [[subfield-value subfield-keywords] keywords-by-subfield-value
-                      ;; TODO handle child-branch-nodes is empty
-                      :let [child-branch-nodes (create-branch-nodes
-                                                 next-subfield remaining-subfields subfield-keywords)]]
-                  ;; TODO value may be nil
-                  (if (seq child-branch-nodes)
-                    (merge child-branch-nodes
-                           {:value subfield-value
-                            :subfields (keys child-branch-nodes) ;; TODO
-                            ; :uuid nil ;; TODO
-                            ;; TODO subfields
-                            })
-                    {:value subfield-value
-                     ; :uuid TODO
-                     }))}
-
-      ;; TODO handle leaf node
-      {subfield [{:value "TODO leaf"
-                  :uuid "TODO UUID"}]})))
-
-(defn create-branch-nodes2
-  [subfield remaining-subfields keywords]
-  (reduce (fn [return-map keyword-map]
-            )
-          {}
-          keywords))
+    ;; Add value and uuid back in if it was there originally
+    (as-> merged-map hm
+          (if (contains? hm1 :value)
+            (assoc hm :value (:value hm1))
+            hm)
+          (if-let [uuid (or (:uuid hm1) (:uuid hm2))]
+            (assoc hm :uuid uuid)
+            hm))))
+
+(defn seq-set
+  "Totally permantent Change to call seq later
+  TODO comment me and correc tspelling mistakes"
+  [s]
+  (when (seq s)
+    (set s)))
+
+(defn collapse-hierarchical-map*
+  "Removes intermediate nil values in the hierarchical map"
+  [hm]
+  (let [collapsed-map (reduce (fn [new-hm [k values]]
+                                (let [values-by-value (map-by :value values)]
+                                  ;; Determine if one of the values was nil
+                                  (if-let [nil-value-map (get values-by-value nil)]
+                                    (merge new-hm
+                                           ;; If it's nil then we should collapse it and then merge in its
+                                           ;; contents into the new map. This is what actually does the
+                                           ;; collapsing
+                                           (collapse-hierarchical-map*
+                                             (dissoc nil-value-map :value))
+                                           ;; Add on the other values within the original key
+                                           {k (seq-set (map collapse-hierarchical-map*
+                                                         (vals (dissoc values-by-value nil))))})
+                                    ;; There's no nil values so collapse the inner values and associate
+                                    ;; it with the original key
+                                    (assoc new-hm k (seq-set (map collapse-hierarchical-map* values))))))
+                              {}
+                              (dissoc hm :value :uuid))
+        ;; Remove the empty subfields so we can get the correct list of subfields
+        subfields (-> collapsed-map util/remove-nil-keys (dissoc :value :uuid :subfields) keys seq-set)]
+    (util/remove-nil-keys
+      (assoc collapsed-map
+             :value (:value hm)
+             :uuid (:uuid hm)
+             :subfields subfields))))
+
+(defn collapse-hierarchical-map
+  "TODO comment this"
+  [hm]
+  (dissoc (collapse-hierarchical-map* hm) :subfields))
+
+(defn convert-to-json
+  "TODO comment this"
+  [hm]
+  (cheshire.core/generate-string (util/map-keys->snake_case hm) {:pretty true}))
+
+

 (defn- parse-hierarchical-keywords
   "Returns keywords in a hierarchical map based on the provided keyword hierarchy and a list of


Add audio bus amplitude monitoring mechanism. Returns an atom with the current amplitude for the specified bus. Only works with mono busses - multi-channel busses can be referenced via an optional offset parameter.

--- src/overtone/sc/bus.clj
+++ src/overtone/sc/bus.clj
@@ -2,9 +2,11 @@
   (:import [java.util.concurrent TimeoutException])
   (:use [overtone.sc.machinery allocator]
         [overtone.sc.machinery.server comms]
-        [overtone.sc defaults server node]
+        [overtone.sc synth ugens defaults server node]
         [overtone.helpers lib]
-	[overtone.sc server]))
+        [overtone.sc.foundation-groups :only [foundation-monitor-group]]
+        [overtone.libs.deps            :only [on-deps]])
+  (:require [overtone.at-at :as at-at]))

 ;; ## Buses
 ;;
@@ -13,6 +15,10 @@
 ;; plugging a cable from the output of one unit to the input of another,
 ;; but in SC they are implemented using a simple integer referenced
 ;; array of float values.
+
+(defonce ^{:private true} bus-monitors* (atom {}))
+(defonce ^{:private true} bus-monitor-pool (at-at/mk-pool))
+(defonce ^{:private true} audio-bus-monitor-group* (atom nil))

 (defonce ^{:private true} __PROTOCOLS__
   (do
@@ -145,3 +151,52 @@
         p  (server-recv "/c_setn")]
     (snd "/c_getn" id len)
     (drop 2 (:args (deref! p (str "attempting to get a range of consecutive control bus values of length " len " from bus " (with-out-str (pr bus))))))))
+
+(defn- create-monitor-group
+  "Creates a group for the audio bus monitor synths. Designed to be
+   called in a dependency callback after :foundation-groups-created."
+  []
+  (ensure-connected!)
+  (assert (foundation-monitor-group) "Couldn't find monitor group")
+  (let [g (with-server-sync
+            #(group "Audio Bus Monitors" :tail (foundation-monitor-group))
+            "whilst creating the audio bus monitor group")]
+    (reset! audio-bus-monitor-group* g)))
+
+(on-deps :foundation-groups-created ::create-monitor-group create-monitor-group)
+
+(defonce __BUS-MONITOR-SYNTH__
+  (defsynth mono-audio-bus-level [in-a-bus 0 out-c-bus 0]
+    (let [sig   (in:ar in-a-bus 1)
+          level (amplitude sig)
+          level (lag-ud level 0.1 0.3)]
+      (out:kr out-c-bus [(a2k level)]))))
+
+(defn audio-bus-monitor
+  "Mono bus amplitude monitor. Returns an atom containing the current
+   amplitude of the monitor. For multi-channel buses, an offset may be
+   specified.
+
+   Note - only creates one monitor per audio bus - subsequent calls for
+   the same audio bus idx will return a cached monitor."
+  ([audio-bus] (audio-bus-monitor audio-bus 0))
+  ([audio-bus chan-offset]
+     (ensure-connected!)
+     (assert @audio-bus-monitor-group* "Couldn't find audio bus monitor group")
+     (let [bus-idx (to-sc-id audio-bus)
+           bus-idx (+ chan-offset bus-idx)]
+       (if-let [[monitor _] (get @bus-monitors* bus-idx)]
+         monitor
+         (let [monitor (atom 0)
+               cb      (control-bus (str "audio-bus-level [" bus-idx "]"))
+               m-synth (mono-audio-bus-level [:tail @audio-bus-monitor-group*]
+                                             bus-idx
+                                             cb)]
+
+           (at-at/every 100
+                        #(reset! monitor (control-bus-get bus-idx))
+                        bus-monitor-pool
+                        :initial-delay 0
+                        :desc (str "bus-monitor [" bus-idx "]"))
+           (swap! bus-monitors* assoc bus-idx [monitor m-synth])
+           monitor)))))


Refactor action specific code to a method.

--- src/plan_schema/cli.clj
+++ src/plan_schema/cli.clj
@@ -122,6 +122,21 @@
         (System/exit status)))
   status)

+(defn do-action [action options]
+  (let [out (action options)
+        error (error? out)]
+    ;; if we've found an error then it's likely it's already been
+    ;; reported... output the first line just in case we have
+    ;; a new error from error? itself.
+    (if error
+      (do
+        (log-error (first (re-find #"^.*(\n)?" error)))
+        (exit 1))
+      (do
+        (when (stdout-option? (:output options))
+          (pprint out))
+        (exit 0)))))
+
 (defn plan-schema
   "plan-schema command line processor. (see usage for help)."
   {:added "0.1.0"
@@ -164,17 +179,9 @@
         (exit 1 (str "Unknown action: \"" cmd "\". Must be one of " (keys actions)))
         (usage summary))
       (if (> verbose 1) ;; throw full exception with stack trace when -v -v
-        (let [out (action options)
-              error (error? out)]
-          (when (stdout-option? output)
-            (pprint out))
-          (exit (if error 1 0)))
+        (do-action action options)
         (try
-          (let [out (action options)
-                error (error? out)]
-            (when (stdout-option? output)
-              (pprint out))
-            (exit (if error 1 0)))
+          (do-action action options)
           (catch Throwable e ;; note AssertionError not derived from Exception
             (exit 1 "caught exception: " (.getMessage e))))))))


Add support for home key

Add support for home key

--- src/reabledit/util.cljs
+++ src/reabledit/util.cljs
@@ -40,6 +40,15 @@
         current-row (-> @state :selected first)
         current-col (-> @state :selected second)]
     (cond
+
+      ;; Home moves to the beginning of row if not in edit mode
+      (and (not (:edit @state)) (= keycode 36))
+      (do
+        (.preventDefault e)
+        (move-to-cell! row-change-fn
+                       current-row
+                       0
+                       state))

       ;; Shift + tab moves one cell backwards
       (and shift? (= keycode 9))


fix spacing & alignment

fix spacing & alignment

--- src/riffmuse/parser.clj
+++ src/riffmuse/parser.clj
@@ -46,25 +46,21 @@
                                     "1" :octatonic-1
                                     "2" :octatonic-2)))
           :letter str/lower-case
-          :pitch (fn
-                   ([letter]
-                     {:pitch (keyword letter)})
-                   ([letter accidental]
-                     {:pitch (keyword (str letter accidental))}))
+          :pitch (fn ([letter]
+                       {:pitch (keyword letter)})
+                     ([letter accidental]
+                       {:pitch (keyword (str letter accidental))}))
           :scale (fn [[type & attrs]]
                    (conj {:type type}
                          (if-let [pitch (:pitch (first attrs))]
                            (let [attrs (rest attrs)]
-                             {:pitch pitch
-                              :scale
-                              (case (count attrs)
-                                0 :major
-                                1 (if (= (first attrs) :pentatonic)
-                                    :major-pentatonic
-                                    (first attrs))
-                                2 (case (set attrs)
-                                    #{:minor :pentatonic}
-                                    :minor-pentatonic
-                                    #{:major :pentatonic}
-                                    :major-pentatonic))})
+                             {:pitch pitch
+                              :scale (case (count attrs)
+                                       0 :major
+                                       1 (if (= (first attrs) :pentatonic)
+                                           :major-pentatonic
+                                           (first attrs))
+                                       2 (case (set attrs)
+                                           #{:minor :pentatonic} :minor-pentatonic
+                                           #{:major :pentatonic} :major-pentatonic))})
                            {:scale (first attrs)})))})))


Prevent Double Init of System

Prevent Double Init of System


Extract render-tile again

Extract render-tile again

--- src/tile_game/grid.cljs
+++ src/tile_game/grid.cljs
@@ -12,18 +12,21 @@
   (r/atom {:board (range 0 16)
            :dim 4}))

+(defn render-tile [[x y] tile]
+  (let [fill-color (colors tile)]
+    [:g {:key (str "tile-" tile)}
+     [:rect {:x (+ x 0.05) :y (+ y 0.05) :width 0.9 :height 0.9 :fill fill-color}]
+     [:text {:x (+ 0.5 x) :y (+ 0.65 y)
+             :font-family "Verdana" :font-size 0.4 :text-anchor "middle"}
+      (str tile)]]))
+
 (defn tile-grid []
   (let [{:keys [board dim]} @app-state]
     [:center
      [:h1 "Tile Grid"]
      [:svg {:view-box "0 0 4 4" :width 800 :height 800}
       (for [x (range dim) y (range dim)]
-        (let [tile (nth board (+ (* y dim) x))
-              fill-color (colors tile)]
-          [:g {:key (str "tile-" tile)}
-           [:rect {:x x :y y :width 0.9 :height 0.9 :fill fill-color}]
-           [:text {:x (+ 0.45 x) :y (+ 0.6 y)
-                   :font-family "Verdana" :font-size 0.4 :text-anchor "middle"}
-            (str tile)]]))]]))
+        (let [tile (nth board (+ (* y dim) x))]
+          (render-tile [x y] tile)))]]))

 (r/render-component [tile-grid] (. js/document (getElementById "grid")))


Mark done

Mark done

--- src/todomvc/events.cljs
+++ src/todomvc/events.cljs
@@ -131,16 +131,27 @@
 ;    (let [id (allocate-next-id todos)]
 ;      (assoc todos id {:id id :title text :done false}))))

-
-(reg-event-db
-  :toggle-done
-  todo-interceptors
-  (fn [todos [id]]
-    (update-in todos [id :done] not)))
-
-
 (defn get-todo [db id]
   (:?todo (first (query (:state db) find-todo :?id id))))
+
+(reg-event-db
+  :toggle-done
+  (fn [db [_ id]]
+    (let [session (:state db)
+          todo (get-todo db id)
+          updated-todo (update todo :done not)]
+      {:state (-> session
+                (retract todo)
+                (insert updated-todo)
+                (fire-rules))})))
+
+;(reg-event-db
+;  :toggle-done
+;  todo-interceptors
+;  (fn [todos [id]]
+;    (update-in todos [id :done] not)))
+
+
 (reg-event-db
   :save
   (fn [db [_ id title]]