Add a better abstracted caching method in firebase

This caching method relies on Firebase behaviour. Data is cached and
deemed active as long as there are outstanding callbacks on a location.
As long as a .on callback is not cancelled by .off call, further
additions of .on in the same location will use cached data by
Firebase.

--- src/cljs/hacker_agent/hacker-base.cljs
+++ src/cljs/hacker_agent/hacker-base.cljs
@@ -21,6 +21,27 @@
 (def ^:dynamic closer-root nil)

 (defonce channel-closers (atom {}))
+
+(defonce cache-store (atom []))
+
+(defonce cache-limit 2000)
+
+(defn cache-ref-off [url ref]
+  (let [cached? (some (fn [[-url _]]
+                        (= -url url))
+                      @cache-store)]
+    (when-not cached?
+      (.on ref "value" identity)
+      (swap! cache-store
+             (fn [store]
+               (let [over-limit (- (count store) cache-limit)
+                     new-store (conj store [url #(.off ref "value" identity)])]
+                 (if (> over-limit 0)
+                   (do
+                     (doseq [[_ f] (take over-limit new-store)]
+                       (f))
+                     (into [] (drop over-limit new-store)))
+                   new-store)))))))

 (defonce type-chan?
   (let [type-chan (type (chan))]
@@ -181,6 +202,7 @@
   (swap! data dissoc-in path))

 (defn bind! [data path ref binder]
+  (cache-ref-off (.toString ref) ref)
   (close-channel! data path)
   (let [close-chan (chan)
         fbc (fb->chan ref close-chan)


Minor fixes to issues introduced in previous commit.

--- src/clojure/catacumba/impl/context.clj
+++ src/clojure/catacumba/impl/context.clj
@@ -69,7 +69,7 @@
   [^Context ctx]
   (let [^Optional odata (.maybeGet ctx ContextData)]
     (if (.isPresent odata)
-      @(:payload (.get odata))
+      (:payload (.get odata))
       {})))

 (defn get-context-params
@@ -95,7 +95,7 @@
          ^Optional odata (.maybeGet ctx ContextData)]
      (if (.isPresent odata)
        (let [^ContextData ctxdata (.get odata)]
-         (ContextData. (merge ctxdata data)))
+         (ContextData. (merge (:payload ctxdata) data)))
        (ContextData. data)))))

 (defn public-address


Fix regression in layout of user and tag pills

--- src/braid/core/client/ui/views/pills.cljs
+++ src/braid/core/client/ui/views/pills.cljs
@@ -62,7 +62,8 @@
 (defn tag-pill-view
   [tag-id]
   [:div.tag
-   {:on-mouse-enter
+   {:style {:display "inline-block"}
+    :on-mouse-enter
     (popover/on-mouse-enter
       (fn []
         [tag-card-view tag-id]))}
@@ -130,7 +131,8 @@
 (defn user-pill-view
   [user-id]
   [:div.user
-   {:on-mouse-enter
+   {:style {:display "inline-block"}
+    :on-mouse-enter
     (popover/on-mouse-enter
       (fn []
         [user-card-view user-id]))}


Remove signed token backend.

Remove signed token backend.

buddy-sign removes the "generic" backend.

--- src/clojure/buddy/auth/backends/token.clj
+++ src/clojure/buddy/auth/backends/token.clj
@@ -31,7 +31,6 @@
            (re-find (re-pattern (str "^" token-name " (.+)$")))
            (second)))

-
 (defn jws-backend
   [{:keys [privkey unauthorized-handler max-age token-name] :or {token-name "Token"}}]
   (reify
@@ -40,21 +39,6 @@
       (parse-authorization-header request token-name))
     (authenticate [_ request data]
       (assoc request :identity (unsign data privkey {:max-age max-age})))
-
-    proto/IAuthorization
-    (handle-unauthorized [_ request metadata]
-      (if unauthorized-handler
-        (unauthorized-handler request metadata)
-        (handle-unauthorized-default request)))))
-
-(defn signed-token-backend
-  [{:keys [privkey unauthorized-handler max-age token-name] :or {token-name "Token"}}]
-  (reify
-    proto/IAuthentication
-    (parse [_ request]
-      (parse-authorization-header request token-name))
-    (authenticate [_ request data]
-      (assoc request :identity (loads data privkey {:max-age max-age})))

     proto/IAuthorization
     (handle-unauthorized [_ request metadata]


Add stopping, calculation works now somehow

--- src/distributed_transducers_poc/rc.clj
+++ src/distributed_transducers_poc/rc.clj
@@ -1,6 +1,6 @@
 (ns distributed-transducers-poc.rc
   (:require [cheshire.core :refer [generate-string parse-string parse-stream]]
-            [clojure.core.async :refer [chan go go-loop >! <! <!!]]
+            [clojure.core.async :refer [chan thread go go-loop >! <! <!!]]
             [clojure.java.io :as io]
             [serializable.fn :as s])
   (:import [com.amazonaws ClientConfiguration]
@@ -58,39 +58,45 @@
                 (generate-string payload)))

 (defn receive-message [queue-url wait-in-seconds]
-  (let [to-json #(parse-string % true)]
-    (-> (.receiveMessage sqs-client (-> (ReceiveMessageRequest.)
+  (let [from-json #(parse-string % true)
+        raw-message (-> (.receiveMessage sqs-client (-> (ReceiveMessageRequest.)
                                         (.withQueueUrl queue-url)
                                         (.withWaitTimeSeconds (int wait-in-seconds))))
         (.getMessages)
-        (first)
-        (.getBody)
-        (to-json))))
+        (first))]
+    (when raw-message
+      (.deleteMessage sqs-client queue-url (.getReceiptHandle raw-message))
+      (-> raw-message .getBody from-json))))

-(defn receive-messages [queue-url wait-in-seconds]
+(defn receive-messages [queue-url wait-in-seconds handler-fn]
   (let [to-json #(parse-string % true)
         raw-messages (-> (.receiveMessage sqs-client (-> (ReceiveMessageRequest.)
-                                        (.withQueueUrl queue-url)
-                                        (.withWaitTimeSeconds (int wait-in-seconds))))
-        (.getMessages))]
-    (map #(-> % .getBody to-json) raw-messages)))
+                                                         (.withQueueUrl queue-url)
+                                                         (.withWaitTimeSeconds (int wait-in-seconds))))
+                         (.getMessages))]
+    (map (fn [raw-message]
+           (let [handle (.getReceiptHandle raw-message)
+                 payload (-> raw-message .getBody to-json)
+                 ret-value (handler-fn payload)]
+             (.deleteMessage sqs-client queue-url handle)
+             ret-value))
+         raw-messages)))

 (defn delete-queue [queue-url]
   (.deleteQueue sqs-client queue-url))

-(defn message-handler [f in-queue out-queue]
-  (go
-    (let [payload (receive-message in-queue 5)
-          response {:result (f (:param payload))}]
-      (send-message out-queue response))))
-
 (defn message-loop [f in-queue out-queue]
-  (go-loop []
-     (let [messages (receive-message in-queue 5)]
-       (doseq [message (filter #(= "process" (:type "message")) messages)]
-          (send-message out-queue {:result (f (:param message))}))
-       (when-not (some #(= "stop" (:type %)) messages)
-         (recur)))))
+  (let [handler (fn [message]
+                  (when (= "process" (:type message)
+                           (let [result (f (:payload message))]
+                             (println "Result " result)
+                             (send-message out-queue {:index (:index message)
+                                                      :payload result})))
+                    (:type message)))]
+    (go-loop []
+             (let [responses (receive-messages in-queue 5 handler)]
+               (when-not (some #(= "stop" %) responses)
+                 (recur))))))

 (defn uber-queue [key-fn]
   {:next-items []
@@ -98,85 +104,86 @@
    :key-fn key-fn
    :queue (java.util.PriorityQueue. 10 (comparator (fn [x y] (< (key-fn x) (key-fn y)))))})

-(defn add [{:keys [next-items next-index key-fn queue] :as uber} element]
+(defn add [{:keys [key-fn queue] :as uber} element]
   (.add queue element)
-  (if (= next-index (key-fn (.peek queue)))
-    (do
-      (.poll queue)
-      {:next-items (conj next-items element)
-       :next-index (inc next-index)
-       :key-fn key-fn
-       :queue queue})
-    uber))
+  (loop [{:keys [next-items next-index] :as result} uber]
+    (if (not (= next-index (key-fn (.peek queue))))
+      result
+      (do
+        (let [e (.poll queue)]
+          (recur {:next-items (sort-by :index (cons e next-items))
+                  :next-index (inc next-index)
+                  :key-fn key-fn
+                  :queue queue}))))))

 (defn add-all [{:keys [next-items next-index key-fn queue] :as uber} elements]
   (if (empty? elements)
     uber
     (add-all (add uber (first elements)) (drop 1 elements))))

-(defn vittu [uber]
+(defn remove-one [uber]
   (update uber :next-items (partial drop 1)))

 (defn head [{:keys [next-items]}]
   (first next-items))

+(-> (uber-queue :index)
+    (add {:index 0})
+    (remove-one)
+    (add {:index 2})
+    (add {:index 1}))
+
 (defn send-ok-messages [c buffer]
   (if-let [result (head buffer)]
     (do
+      (println "Sending ok" result)
+      (println "Sending budd" buffer)
       (go (>! c result))
-      (send-ok-messages c (vittu buffer)))
+      (send-ok-messages c (remove-one buffer)))
     buffer))

-(defn handler-loop [in-queue max-index]
-  (let [buffer (uber-queue :index)
+(defn handler-loop [in-queue]
+  (let [continue? (atom true)
+        stop-fn #(reset! continue? false)
+        buffer (uber-queue :index)
         ret (chan 10)]
-    (go-loop [next-index 0
-              buffer (uber-queue :index)]
-             (when (< next-index max-index)
-               (let [messages (receive-messages in-queue 4)]
-                 (recur (inc next-index)
-                        (send-ok-messages ret (add-all buffer messages))))))
-    ret))
+    (go-loop [buffer (uber-queue :index)]
+             (when @continue?
+               (let [messages [(receive-message in-queue 3)]]
+                 (recur (send-ok-messages ret (add-all buffer messages))))))
+    {:results ret
+     :stop-fn stop-fn}))

 (defn uuid [] (str (java.util.UUID/randomUUID)))

 ;(create-queue (uuid))

+(defn queue-reduce [f xs in-queue out-queue]
+  (message-loop (fn [x] (reduce f x)) in-queue out-queue)
+  (let [{:keys [results stop-fn]} (handler-loop out-queue)
+        batches (map (fn [a b] [a b]) (partition-all 1024 xs) (range))]
+    (thread
+      (doseq [[batch index] batches]
+        (send-message in-queue {:type "process" :index index :payload batch})))
+    (let [response (reduce (fn [acc _]
+                             (f acc (:payload (<!! results))))
+                           0
+                           batches)]
+      (send-message in-queue {:type "stop"})
+      (stop-fn)
+      response)))
+
 ;(comment
-(defn lol []
- (let [queue (create-queue (uuid))
-      a (handler-loop queue 4)]
-  (println (send-message queue {:index 0 :result "a"}))
-  (send-message queue {:index 2 :result "b"})
-  (send-message queue {:index 1 :result "b"})
-  (send-message queue {:index 3 :result "b"})
-  [(<!! a) (<!! a) (<!! a) (<!! a)]))
-;)
-
-;(lol)
+(defn do-reduce []
+  (let [in (create-queue (uuid))
+        out (create-queue (uuid))]
+    (let [response (queue-reduce + (range 10000) in out)]
+      (delete-queue in)
+      (delete-queue out)
+      response)))
+  ;(super-reduce plus (range 100000))

-(defn queue-reduce [f xs in-queue out-queue]
-  (message-loop #(reduce f %) in-queue out-queue)
-  (let [batches (partition-all 1024 xs)
-        response (reduce (fn [acc batch]
-                           (send-message in-queue {:type "process" :param batch})
-                           (let [response (receive-message out-queue 5)]
-                             (f acc (:result response))))
-                         0
-                         batches)]
-    (send-message in-queue {:type "stop"})
-    response))
-
-(comment
-(let [in (create-queue (uuid))
-      out (create-queue (uuid))]
-  (let [response (queue-reduce + (range 10000) in out)]
-    (delete-queue in)
-    (delete-queue out)
-    response))
-)
-  ;(super-reduce plus (range 100000))

 ;(invoke-lambda (pr-str (s/fn [] (map #(* 2 %) [3 4 5]))) "distributed-transducers-poc" "eu-west-1")


Fix history

Fix history

--- demo/sitetools/core.cljs
+++ demo/sitetools/core.cljs
@@ -17,12 +17,13 @@
   (let [fs (or (.-rswapfs a)
                (set! (.-rswapfs a) (array)))]
     (.push fs #(apply f % args))
-    (if (< 1 (.-length fs))
+    (if (< 1 (alength fs))
       nil
       (let [f' (fn [state]
+                 ;;;; TODO: This could throw
                  (let [s ((aget fs 0) state)]
                    (.shift fs)
-                   (if (-> fs .-length pos?)
+                   (if (-> fs alength pos?)
                      (recur s)
                      s)))]
         (swap! a f')))))
@@ -43,23 +44,16 @@
                          :js-file "js/main.js"
                          :js-dir "js/out"
                          :main-div "main-content"
-                         :default-title ""
-                         :allow-html5-history false}))
-
-;; (defonce page (r/atom "index.html"))
-;; (defonce page-state (r/atom {:has-history false}))
+                         :default-title ""}))

 (defonce history nil)
-
-(defn as-relative [f]
-  (clojure.string/replace f #"^/" ""))

 (defn demo-handler [state [id v1 v2 :as event]]
   (case id
     :content (do
                (let [title (if v2
-                             (str (:title-prefix @config) v2)
-                             (str (:default-title @config)))]
+                             (str (:title-prefix state) v2)
+                             (str (:default-title state)))]
                  (when r/is-client
                    (r/next-tick #(set! js/document.title title)))
                  (assoc state
@@ -71,161 +65,63 @@
                  (when r/is-client
                    (.setToken history v1 false)
                    (r/next-tick #(set! js/document.body.scrollTop 0)))
-                 (recur state [:set-page v1 v2]))
+                 (recur state [:set-page v1]))
     state))

 (defn dispatch [event]
-  (dbg event)
+  ;; (dbg event)
   (rswap! config demo-handler event)
   nil)

 (defn reg-page [url]
   (swap! config update-in [:pages] conj url))
+
+
+;;; History

 (defn init-history []
   (when-not history
     (let [page (:page-name @config)
-          html5 (let [proto js/location.protocol]
-                  (and page
-                       (.isSupported Html5History)
-                       (#{"http:" "https:"} proto)))]
+          html5 (and page
+                     (.isSupported Html5History)
+                     (#{"http:" "https:"} js/location.protocol))]
       (doto (set! history
                   (if html5
                     (doto (Html5History.)
                       (.setUseFragment false)
-                      (.setPathPrefix js/location.origin)
-                      (.setEnabled true))
+                      (.setPathPrefix (-> js/location.pathname
+                                          (string/replace
+                                           (re-pattern (str page "$")) "")
+                                          (string/replace #"/*$" ""))))
                     (History.)))
-        (evt/listen hevt/NAVIGATE #(dispatch [:set-page (str (.-token %))]))
+        (evt/listen hevt/NAVIGATE #(dispatch [:set-page (.-token %)]))
         (.setEnabled true))
-      (when html5
-        (.setToken history page)))))
-
-
-;; (defn register-page
-;;   ([pageurl comp]
-;;    (register-page pageurl comp nil))
-;;   ([pageurl comp title]
-;;    (assert (string? pageurl)
-;;            (str "expected string, not " pageurl))
-;;    (assert (vector? comp)
-;;            (str "expected vector, not " (pr-str comp)))
-;;    (assert (or (nil? title)
-;;                (string? title)))
-;;    (swap! config update-in [:page-map] assoc pageurl comp)
-;;    (swap! config update-in [:page-titles] assoc pageurl title)
-;;    pageurl))
+      (when (and page (not html5) (empty? (.getToken history)))
+        (dispatch [:set-page page])))))
+
+(defn as-relative [f]
+  (string/replace f #"^/" ""))

 ;;; Components

 (defn link [props child]
   [:a (assoc props
+             :href (-> props :href as-relative)
              :on-click #(do (.preventDefault %)
                             (dispatch [:goto-page (:href props)])))
    child])

-;; (defn link
-;;     [props child]
-;;     (let [p (:href props)
-;;           f ((:page-map @config) p)]
-;;       (assert (vector? f) (str "couldn't resolve page " p))
-;;       (assert (string? p))
-;;       [:a (assoc props
-;;                  :href p
-;;                  :on-click (if (:has-history @page-state)
-;;                              (fn [e]
-;;                                (.preventDefault e)
-;;                                (reset! page p)
-;;                                (r/next-tick
-;;                                 #(set! (.-scrollTop (.-body js/document))
-;;                                        0)))
-;;                              identity))
-;;        child]))
-
 (defn page-content []
   (:main-content @config))

-;;; Implementation:
-
-;; (defn get-title []
-;;   (get-in @config [:page-titles @page]
-;;           (or (get-in @config [:page-titles "index.html"])
-;;               "")))
-
-;; (defn default-content []
-;;   [:div "Empty"])
-
-;; (add-watch page ::title-watch
-;;            (fn [_ _ _ p]
-;;              (when r/is-client
-;;                (set! (.-title js/document) (get-title)))
-;;              ;; First title on a page wins
-;;              #_(reset! page-title "")))
-
-;;; History
-
-;; (defn use-html5-history []
-;;   (when r/is-client
-;;     (let [proto (.' js/window :location.protocol)]
-;;       (and (:allow-html5-history @config)
-;;            (.isSupported Html5History)
-;;            (#{"http:" "https:"} proto)))))
-
-;; (defn create-history [p]
-;;   (if (use-html5-history)
-;;     (doto (Html5History.)
-;;       (.setUseFragment false))
-;;     (let [h (History.)]
-;;       (when p
-;;         (.setToken h p))
-;;       h)))
-
-;; (defn token-base []
-;;   (if (use-html5-history)
-;;     (:base-path @config)))
-
-;; (defn setup-history [p]
-;;   (when (nil? history)
-;;     (set! history (create-history p))
-;;     (swap! page-state assoc :has-history (some? history))
-;;     (when-let [h history]
-;;       (evt/listen h hevt/NAVIGATE
-;;                   (fn [e]
-;;                     (let [t (.-token e)
-;;                           tb (token-base)]
-;;                       (reset! page (if (and tb (== 0 (.indexOf t tb)))
-;;                                      (subs t (count tb))
-;;                                      t)))
-;;                     (r/flush)))
-;;       (add-watch page ::history
-;;                  (fn [_ _ oldp newp]
-;;                    (when-not (= oldp newp)
-;;                      (.setToken h (str (token-base) newp)))))
-;;       (.setEnabled h true))))
-
-;; (defn base-path [loc p]
-;;   ;; Find base-path for html5 history
-;;   (let [split #".[^/]*"
-;;         depth (->> (case p "" "." p) (re-seq split) count)
-;;         base (->> loc (re-seq split) (drop-last depth) (apply str))]
-;;     (string/replace (str base "/") #"^/" "")))
-
-;; (defn set-start-page [p]
-;;   (when (and (not (:base-path @config))
-;;              (use-html5-history))
-;;     (swap! config assoc :base-path
-;;            (base-path (.' js/window -location.pathname) p)))
-;;   (reset! page p))
+;;; Static site generation

 (defn prefix [href page]
-  (let [depth (-> #"/" (re-seq page) count)]
+  (let [depth (-> #"/" (re-seq (as-relative page)) count)]
     (str (->> "../" (repeat depth) (apply str)) href)))
-
-
-;;; Static site generation

 (defn body []
   (let [b (:body @config)]
@@ -263,10 +159,9 @@
   (dispatch [:set-page page-name])
   (let [b (r/render-component-to-string (body))]
     (str "<!doctype html>"
-         (html-template {:title (:title @config) ;;(get-title)
+         (html-template {:title (:title @config)
                          :body b
-                         :page-conf {:allow-html5-history true
-                                     :page-name page-name}
+                         :page-conf {:page-name page-name}
                          :timestamp timestamp}))))

 (defn mkdirs [f]
@@ -275,9 +170,8 @@
         items (as-> f _
                 (.' path dirname _)
                 (.' path normalize _)
-                (string/split _ #"/"))
-        parts (reductions #(str %1 "/" %2) items)]
-    (doseq [d parts]
+                (string/split _ #"/"))]
+    (doseq [d (reductions #(str %1 "/" %2) items)]
       (when-not (.' fs existsSync d)
         (.' fs mkdirSync d)))))

@@ -295,8 +189,7 @@
     (apply (.' path :join) paths)))

 (defn read-css []
-  (clojure.string/join "\n"
-                       (map read-file (:css-infiles @config))))
+  (string/join "\n" (map read-file (:css-infiles @config))))

 (defn write-resources [dir]
   (write-file (path-join dir (:css-file @config))
@@ -309,7 +202,7 @@
   (log "Generating site")
   (swap! config merge (js->clj opts :keywordize-keys true))
   (let [dir (:site-dir @config)
-        timestamp (str "?" js/Date.now)]
+        timestamp (str "?" (js/Date.now))]
     (doseq [f (:pages @config)]
       (write-file (path-join dir (dbg (as-relative f)))
                   (gen-page f timestamp)))
@@ -320,10 +213,8 @@
   (swap! config merge site-config)
   (when r/is-client
     (let [conf (when (exists? js/pageConfig)
-                 (js->clj js/pageConfig :keywordize-keys true))
-          page-name (:page-name conf)]
+                 (js->clj js/pageConfig :keywordize-keys true))]
       (swap! config merge conf)
       (init-history)
       (r/render-component (body)
-                          (.' js/document getElementById
-                              (:main-div @config))))))
+                          (js/document.getElementById (:main-div @config))))))


#10 generate post

#10 generate post

--- src/kalar_plugins/templates/hiccup.clj
+++ src/kalar_plugins/templates/hiccup.clj
@@ -49,32 +49,33 @@
         excerpt  (-> (ehtml/select (ehtml/html-resource (StringReader. (:body compiled))) [:p]) first ehtml/text)]
     (dissoc (merge compiled {:excerpt excerpt}) :body)))

+(def num-ptn #":num")

-; id -> num
-(defmacro def-templates [url-pattern dir body]
+(defmacro def-posts [body]
   `(def hiccup#
      (reify HiccupPlugin
        (hiccup-compile [this]
-         (let [files# (.listFiles (io/file ~dir))
+         (let [files# (.listFiles (io/file ~(:posts-dir (config/read-config))))
                rng# (range (count files#))
                index-file-map# (zipmap rng# files#)]
            (dorun
              (for [tuple# index-file-map#]
-               (let [~'mp (merge (load-markdown (.getAbsolutePath (val tuple#))) {:index (key tuple#)})
-                     output# (io/file (kfile/find-dest) (string/replace ~url-pattern #":id" (str (key tuple#))))]
+               (let [~'page_ (merge (load-markdown (.getAbsolutePath (val tuple#))) {:index (key tuple#)})
+                     output# (io/file (kfile/find-dest) (string/replace (:post-url-pattern (config/read-config))
+                                                                        num-ptn (str (key tuple#))))]
                  (kfile/touch output#)
                  (spit output# ~body)))))))))

 (defn get-post-url [num]
   (let [ptn (:post-url-pattern (config/read-config))]
-    (string/replace ptn #":num" (str num))))
+    (string/replace ptn num-ptn (str num))))

 (defmacro def-excerpts [head-url tail-url-ptn num-perpage body]
   `(def hiccup#
      (reify HiccupPlugin
        (hiccup-compile [this]
          (let [
-               splited-url-ptn# (string/split ~tail-url-ptn  #":num")
+               splited-url-ptn# (string/split ~tail-url-ptn  num-ptn)
                get-url# (fn [num#] (if (= num# 1) ~head-url
                                                   (str (first splited-url-ptn#) num# (nth splited-url-ptn# 1))))
                create-neighbor-page-url# (fn [num# total#]
@@ -110,7 +111,7 @@
                                                  (:mds posts-per-page#))}
                                     (create-neighbor-page-url# (:part-num posts-per-page#) total#))
                      output# (io/file (kfile/find-dest)
-                                      (string/replace ~tail-url-ptn #":num" (str (:part-num posts-per-page#))))]
+                                      (string/replace ~tail-url-ptn num-ptn (str (:part-num posts-per-page#))))]
                  (kfile/touch output#)
                  (spit output# ~body))
                )))))))


get sum working again

get sum working again

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -88,7 +88,7 @@

 (defn rnd [seq] (nth seq (rand-int (count seq))))

-(if true
+(if false
   (def *metamodel*
        (new org.dada.core.MetaModelImpl
 	    "Cetacea"
@@ -236,8 +236,8 @@
 ;; each split adds an extra key/value downstream that we may need to unwrap upstream
 (defn ccount [& [count-key]]
   (fn [[metadata-fn data-fn]]
-      (let [[src-metadata metaprefix extra-keys] (metadata-fn)
-	    dummy (println "COUNT METADATA" metaprefix extra-keys)
+      (let [[#^Metadata src-metadata metaprefix extra-keys] (metadata-fn)
+	    ;;dummy (println "COUNT METADATA" metaprefix extra-keys)
 	    extra-attributes (map (fn [key] (.getAttribute src-metadata key)) extra-keys)
 	    tgt-metadata (count-reducer-metadata extra-keys count-key extra-attributes)]
 	[ ;; metadata
@@ -263,6 +263,37 @@
 					  (insert *metamodel* count-model)
 					  (insert tgt-metamodel [count-model extra-pairs])
 					  (connect src-model count-model))))]
+		 [tgt-metamodel new-prefix extra-pairs])))])))
+
+(defn sum [& [sum-key]]
+  (fn [[metadata-fn data-fn]]
+      (let [[#^Metadata src-metadata metaprefix extra-keys] (metadata-fn)
+	    ;;dummy (println "SUM METADATA" metaprefix extra-keys)
+	    extra-attributes (map (fn [key] (.getAttribute src-metadata key)) extra-keys)
+	    tgt-metadata (sum-reducer-metadata extra-keys sum-key extra-attributes)]
+	[ ;; metadata
+	 (fn []
+	     [tgt-metadata (str metaprefix "." (sum-value-key sum-key)) extra-keys])
+	 ;; direct
+	 (if data-fn
+	   (fn []
+	       (let [[#^Model src-metamodel prefix #^Collection extra-pairs] (data-fn)
+		     new-prefix (str prefix "." (sum-value-key sum-key))
+		     tgt-model (model new-prefix nil src-metadata)
+		     tgt-metamodel (meta-view
+				    (str "." (sum-value-key sum-key))
+				    src-metamodel
+				    (fn [tgt-metamodel #^Model src-model extra-pairs]
+					;;(println "SUM DATA:" extra-values)
+					(let [sum-model (do-reduce-sum
+							 (.getName src-model)
+							 (.getMetadata src-model)
+							 tgt-metadata
+							 sum-key
+							 extra-pairs)]
+					  (insert *metamodel* sum-model)
+					  (insert tgt-metamodel [sum-model extra-pairs])
+					  (connect src-model sum-model))))]
 		 [tgt-metamodel new-prefix extra-pairs])))])))

 (defn split-key-value [key]
@@ -379,7 +410,7 @@
 (defn pivot [pivot-key pivot-values value-key]
   (fn [[metadata-fn direct-fn]]
       (let [[src-metadata metaprefix extra-keys] (metadata-fn)
-	    dummy (println "PIVOT METADATA" pivot-key keys value-key)
+	    ;;dummy (println "PIVOT METADATA" pivot-key keys value-key)
 	    tgt-metadata (pivot-metadata src-metadata (remove #(= % pivot-key) extra-keys) pivot-values value-key)
 	    tgt-name (str ".pivot(" value-key "/" pivot-key")")]
 	[ ;; metadata
@@ -388,7 +419,7 @@
 	 ;; direct
 	 (fn []
 	     (let [[#^Model src-metamodel prefix #^Collection extra-pairs] (direct-fn)
-		   dummy (println "PIVOT" extra-pairs)
+		   ;;dummy (println "PIVOT" extra-pairs)
 		   tgt-model (PivotModel.
 			      (str prefix tgt-name)
 			      src-metadata
@@ -414,6 +445,8 @@

 ;; (?2 [(union)] all-whales)
 ;; (?2 [(ccount)] all-whales)
+;; (?2 [(sum :weight)] all-whales)
+
 ;; (?2 [(split :type)] all-whales)

 ;; (?2 [(ccount)(ccount)] all-whales)
@@ -437,11 +470,15 @@

 ;; (?2 [(split :type nil [(pivot :time years (keyword (count-value-key nil)))(ccount)(split :time (fn [time] (list (or (.lower years time) time))))])] all-whales)

-(?2 [(union "count(type/year)")(split :type nil [(pivot :time years (keyword (count-value-key nil)))(ccount)(split :time (fn [time] (list (or (.lower years time) time))))])] all-whales)
-
-(?2 [(union "count(type/ocean)")(split :type nil [(pivot :ocean oceans (keyword (count-value-key nil)))(ccount)(split :ocean )])] all-whales)
-
-(?2 [(union "count(ocean/type)")(split :ocean nil [(pivot :type types (keyword (count-value-key nil)))(ccount)(split :type )])] all-whales)
+(?2 [(union "count/type/year")(split :type nil [(pivot :time years (keyword (count-value-key nil)))(ccount)(split :time (fn [time] (list (or (.lower years time) time))))])] all-whales)
+
+(?2 [(union "count/type/ocean")(split :type nil [(pivot :ocean oceans (keyword (count-value-key nil)))(ccount)(split :ocean )])] all-whales)
+
+(?2 [(union "sum(weight)/type/ocean")(split :type nil [(pivot :ocean oceans (keyword (sum-value-key :weight)))(sum :weight)(split :ocean )])] all-whales)
+
+(?2 [(union "count/ocean/type")(split :ocean nil [(pivot :type types (keyword (count-value-key nil)))(ccount)(split :type )])] all-whales)
+
+(?2 [(union "sum(weight)/ocean/type")(split :ocean nil [(pivot :type types (keyword (sum-value-key :weight)))(sum :weight)(split :type )])] all-whales)

 ;;(?2 [(split :ocean nil [(union)(split :type nil [(pivot :time years (keyword (count-value-key nil)))(ccount)(split :time (fn [time] (list (or (.lower years time) time))))])])] all-whales)

@@ -449,28 +486,26 @@

 ;; create some whales...

-(def num-whales 1000)
-
-(def some-whales1
+(def num-whales 100000)
+
+(def some-whales
      (pmap (fn [id] (whale id)) (range num-whales)))

-(def some-whales
+(def some-whales2
      (let [#^Creator creator (.getCreator whale-metadata)]
        (map
 	#(.create creator (into-array Object %))
 	(list
-	 [0 0 (Date. 0 1 1) "blue whale" "arctic" 100 0]
-	 [1 0 (Date. 0 1 1) "blue whale" "indian" 200 0]
-	 [2 0 (Date. 0 1 1) "gray whale" "arctic" 101 0]
-	 [3 0 (Date. 0 1 1) "gray whale" "indian" 200 0]
-	 [4 0 (Date. 1 1 1) "blue whale" "arctic" 100 0]
-	 [5 0 (Date. 1 1 1) "blue whale" "indian" 200 0]
-	 [6 0 (Date. 1 1 1) "gray whale" "arctic" 100 0]
-	 [7 0 (Date. 1 1 1) "gray whale" "indian" 200 0]
+	 [0 0 (Date. 0 1 1) "blue whale" "arctic" 100 100]
+	 [1 0 (Date. 0 1 1) "blue whale" "indian" 200 100]
+	 [2 0 (Date. 0 1 1) "gray whale" "arctic" 100 100]
+	 [3 0 (Date. 0 1 1) "gray whale" "indian" 200 100]
+	 [4 0 (Date. 1 1 1) "blue whale" "arctic" 100 100]
+	 [5 0 (Date. 1 1 1) "blue whale" "indian" 200 100]
+	 [6 0 (Date. 1 1 1) "gray whale" "arctic" 100 100]
+	 [7 0 (Date. 1 1 1) "gray whale" "indian" 200 100]
 	 ))
        ))
-
-(doall (map #(println "WHALES:" (bean %)) some-whales))

 (time
  (doall
@@ -480,3 +515,6 @@
 (println "LOADED")

 nil
+
+;;--------------------------------------------------------------------------------
+;; fix so that a split/pivot can handle undeclared keys


pivot - coming along...

pivot - coming along...

--- src/main/clojure/org/dada/demo/whales.clj
+++ src/main/clojure/org/dada/demo/whales.clj
@@ -493,7 +493,7 @@
    (fn []
        (let [[downstream-metadata-accessor applicator] (chain)
 	     [src-metadata src-key] (downstream-metadata-accessor)]
-	 [ ;;n get metadata / key
+	 [ ;; get metadata / key
 	  (fn [] [src-metadata split-key])
 	  ;; apply
 	  (fn [hook]
@@ -509,6 +509,66 @@
 	  ])
        )))

+
+(import org.dada.core.AbstractModel)
+(import org.dada.core.Creator)
+(import org.dada.core.Getter)
+(import org.dada.core.GetterMetadata)
+(import org.dada.core.View)
+
+(defmulti attribute-name (fn [arg] (class arg)))
+(defmethod attribute-name Date [#^Date date] (str "attribute_" (.getTime date)))
+(defmethod attribute-name String [#^String string] (.replace string "_" "_underscore_"))
+
+(defn mpivot [chain pivot-key pivot-values]
+  (fn []
+      (let [[downstream-metadata-accessor applicator] (chain)
+	    [src-metadata src-key] (downstream-metadata-accessor)
+	    pivot-key-keys (collection "type" "version")
+	    pivot-key-types (collection String Integer)
+	    pivot-value-type (.getAttributeType src-metadata (name pivot-key))
+	    pivot-value-types (repeat (count pivot-values) pivot-value-type)
+	    pivot-names (map (fn [key](attribute-name key)) pivot-values)
+	    pivot-symbols (map (fn [name] (symbol name)) pivot-names)
+	    pivot-keywords (map (fn [name] (keyword name)) pivot-names)
+	    pivot-keys (apply collection (concat pivot-key-keys pivot-names))
+	    pivot-types (apply collection (concat pivot-key-types pivot-value-types))
+	    tgt-model-name (str "pivot(" pivot-key ")")
+	    attributes (interleave pivot-keywords pivot-types)
+	    classname (name (gensym "org.dada.demo.core.Pivot"))
+	    tgt-metadata (class-metadata classname Object :type :version attributes)
+	    ]
+	 [ ;; get metadata / key
+	  (fn [] [tgt-metadata pivot-key])
+	  ;; apply
+	  (fn [hook]
+
+	      ;; call downstream installing connection and wierd model
+	      ;; type needs to be a different sort of model - need to
+	      ;; extend AbstractModel in Clojure - a project for the
+	      ;; train tomorrow...
+	      (let [tgt-data (atom {})
+		    tgt-model (proxy
+			       [AbstractModel View] [tgt-model-name tgt-metadata]
+			       (getData [] @tgt-data)
+			       (update [insertions alterations deletions]
+				       (println "Pivot: update NYI")
+				       ;; don't forget to call notifyUpdate
+				       )
+		     )
+		    ]
+		(applicator
+		 (fn [src-model src-key]
+		     (insert *metamodel* tgt-model)
+		     (println "PIVOT: " src-key src-model "->" pivot-key tgt-model)
+		     (connect src-model tgt-model)
+		     ;; TODO: how do we do our transformation ?
+		     (hook tgt-model pivot-key)
+		     ))
+		tgt-model))
+	  ])
+       ))
+
 ;; next step e.g. (select [a <model.field> b <model.field> c <model.field>] from [model....] where [(= a 10)...]....)

 (defn execute [monad]
@@ -551,20 +611,39 @@
 ;;  ;;  false)
 ;;  )

+(def whales-by-type (msplit my-whales :type false))
+
 (execute
+(mpivot
  (munion
   (mcount
    (msplit
-    (msplit
-     my-whales
-     :type
-     false)
+    whales-by-type
     :time
     false
     (fn [time] (list (or (.lower years time) time))) ;; TODO: fencepost error...
     ))
   "union(count(split(whales, :time)))")
+ :key years)
  )
+
+;; would this make sense ?
+
+;; (def count-by-time (msplit :time (mcount)))
+;; (my-whales (msplit :type ... count-by-time (union count-by-time)))
+
+;; ;; or
+
+;; dodgy
+;; (def sum-by-value-date (msplit :valueDate (msum :amount))
+;; (my-trades (msplit :nostro sum-by-value-date (union sum-by-value-date)))
+
+;; ;; and
+
+;; unfinished
+;; (def sum-by-value-date (msplit :valueDate dates (msum :amount))
+;; (def nostro-projection (pivot dates :valueDate (union sum-by-value-date)))
+;; (my-trades (msplit :currency (msplit :nostro sum-by-value-date nostro-projection)))

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


Add cloverage

Add cloverage

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -5,6 +5,7 @@
     [lein-cljfmt "0.3.0"]
     [lein-pprint "1.1.1"]
     [lein-assoc "0.1.0"]
+    [lein-cloverage "1.0.6"]
     [jonase/eastwood "0.0.2"]
     [lein-expectations "0.0.7"]
     [lein-autoexpect "0.2.5"]


Hide the Clojure REPL in the Mac app switcher

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -7,4 +7,8 @@
                   [venantius/yagni "0.1.4"]

                   ;; Documentation generators
-                  [lein-codox "0.9.5"]]}}
+                  [lein-codox "0.9.5"]]
+
+        ;; Prevent the Clojure REPL from showing in the Mac app switcher.
+        ;; See http://stackoverflow.com/questions/24619300/hide-clojure-repl-from-command-tab-application-switcher-via-lein-command-line
+        :jvm-opts ["-Dapple.awt.UIElement=true"]}}


lein plugin upgrades, changes

lein plugin upgrades, changes

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,7 +1,8 @@

 ;; Inspired heavily by http://dev.solita.fi/2014/03/18/pimp-my-repl.html
+;; and a newer https://gist.github.com/rauhs/d5bb47c239b58cbf54e1d3d1de221031
 {:user {:dependencies [
-                         [org.clojure/tools.nrepl "0.2.7"]
+                         [org.clojure/tools.nrepl "0.2.13"]
 ;;                       [org.clojars.gjahad/debug-repl "0.3.3"]
 ;;                       [im.chit/vinyasa "0.3.4"]
 ;;                       [spyscope "0.1.5"] ;; reader macro to print forms before execution: #spy/p, d
@@ -36,12 +37,12 @@
 ;;                     (require 'spyscope.core)
                      ]
         :plugins [
-                    [lein-virgil "0.1.0"] ; auto-recompile and reload .java files from :java-source-paths into the REPL
+                    [lein-virgil "0.1.7"] ; auto-recompile and reload .java files from :java-source-paths into the REPL
                     [lein-libdir "0.1.1"] ; dependencies to ./lib/
-                    [cider/cider-nrepl "0.9.1"]
-                    [refactor-nrepl "1.1.0"]
-                    [com.jakemccrary/lein-test-refresh "0.16.0"] ;; autotest
-                    ;;[venantius/ultra "0.4.1"] ;; clj.test output coloring etc
+                    ;[cider/cider-nrepl "0.9.1"]
+                    ;[refactor-nrepl "1.1.0"]
+                    ;[com.jakemccrary/lein-test-refresh "0.16.0"] ;; autotest
+                    [venantius/ultra "0.5.2"] ;; clj.test output and data in REPL coloring etc
 ;;                  ;;[lein-catnip "0.5.1"]
 ;;                  ;;[codox "0.6.1"]                     ; document. generation from src
 ;;                  [lein-ring "0.9.3"]
@@ -49,7 +50,7 @@
 ;;                  [lein-droid "0.3.5"]       	; for Android; !! req. JDK 6 as of 5/2013 !!!
 ;;                  [lein-ritz "0.7.0"]   		; for nrepl-inspect
 ;;                  [lein-marginalia "0.8.0"]
-                    [lein-ancient "0.6.7"]
+                    [lein-ancient "0.6.15"]
                     [lein-try "0.4.3"]
 ;;                  ;;[lein-alembic "0.1.0"]     ; make alembic available -> reload prj deps w/o restarting repl: (alembic.still/load-project)
 ;;                  [lein-clojuredocs "1.0.2"] ; Create clojuredocs-style doc
@@ -70,5 +71,39 @@
  ;;                      ritz.nrepl.middleware.simple-complete/wrap-simple-complete
  ;;                      io.aviso.nrepl/pretty-middleware ;; pretty-print exceptions in repl
                        ]}
-       :mirrors {#"clojars" {:name "clojars mirror" :url "https://clojars-mirror.tcrawley.org/repo/"}}
- }}
+;       :mirrors {#"clojars" {:name "clojars mirror" :url "https://clojars-mirror.tcrawley.org/repo/"}}
+ }
+ :repl {:dependencies [;[zcaudate/lucid.aether "1.4.4"]
+                       ;[zcaudate/lucid.core.inject "1.4.4"]
+                       [zcaudate/lucid.core.debug "1.4.4"]
+                       [zcaudate/lucid.package "1.4.4"]
+                       ;; needed for ns reload (i.e. resetting; see clojure.tools.namespace.reload [Clojure only as of 0.3.0alpha4)
+                       [org.clojure/tools.namespace "0.3.0-alpha4"]]
+        :plugins [[com.gfredericks/lein-shorthand "0.4.1"]]
+        :global-vars {;*warn-on-reflection* true
+                      *print-length* 200 ;; avoid infinite sequences in dev mode.
+                      ;*print-namespace-maps* false
+                      *assert* true}
+        :jvm-opts [;"-Xms400m" ;; starting heap memory
+                   ;"-Xmx8000m" ;; max heap memory
+                   ; Enable clojure.spec/assert (off by default)
+                   "-Dclojure.spec.check-asserts=true"]
+        ;:injections [(require '[lucid.core.inject :as inject])
+        ;             ; Make the following functions available everywhere with the prefix `>`, i.e. >doc, >pull etc.
+        ;             (inject/in
+        ;               ;.
+        ;               [lucid.package pull]                ; add a project dependency to the REPL; ex: `(>pull [org.clojure/core.match "0.2.2"])`
+        ;               [clojure.pprint pprint]
+        ;               [clojure.repl doc source]
+        ;               )
+        ;             ]
+        ; Use the lein-shorthand to create the namespace `.` and copy there
+        ; functions we want easily available everywhere, e.g. `(./doc defn)`
+        :shorthand {. [clojure.pprint/pprint
+                       clojure.repl/doc
+                       clojure.repl/source
+                       ^:lazy lucid.package/pull ; add a project dependency to the REPL; ex: `(./pull [org.clojure/core.match "0.2.2"])`
+                       clojure.tools.namespace.repl/refresh
+                       clojure.tools.namespace.repl/refresh-all]}
+        }
+ }


Added injection for clj-stacktrace.

Added injection for clj-stacktrace.

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,11 +1,17 @@
-{:user {:plugins [[clj-stacktrace "0.2.4"]
-                  [lein-tarsier "0.9.2-SNAPSHOT"]
+{:user {:plugins [[lein-tarsier "0.9.2-SNAPSHOT"]
                   [lein-swank "1.4.4"]
+                  [lein-difftest "1.3.7"]
+                  [clj-stacktrace "0.2.4"]
                   [lein-pprint "1.1.1"]
                   [slamhound "1.2.0"]
                   [lein-cljsbuild "0.1.8"]
                   ;[lein-autodoc "0.9.0"]
                   [lein-marginalia "0.7.0"]
                   [lein-noir "1.2.0"]]
+        :injections [(let [orig (ns-resolve (doto 'clojure.stacktrace require)
+                                            'print-cause-trace)
+                           new (ns-resolve (doto 'clj-stacktrace.repl require)
+                                           'pst)]
+                       (alter-var-root orig (constantly @new)))]
         :vimclojure-opts {:repl true
                           :port 2113}}}


procfiles/ohm1.clj: fixed reducer output structure

--- src/org/altlaw/jobs/procfiles/ohm1.clj
+++ src/org/altlaw/jobs/procfiles/ohm1.clj
@@ -90,12 +90,12 @@

 ;;; REDUCER

-(defn my-reduce [docid docs]
+(defn my-reduce [docid-set docs]
   (let [doc (reduce merge/singleize {} (apply merge-with union docs))]
     (if (and (:html doc) (:text doc))
-      [[docid doc]]
+      [[(:docid doc) doc]]
       (do (h/counter "No html/text")
-          (log/warn "No html/text; skipping " docid)))))
+          (log/warn "No html/text; skipping " (:docid doc))))))

 (def reducer-reduce (partial h/standard-reduce my-reduce))


a whole new world

a whole new world

--- ros/angelic_planning/src/ros/robot_actions.clj
+++ ros/angelic_planning/src/ros/robot_actions.clj
@@ -1056,7 +1056,7 @@
 		:when goal]
 	    obj-name)]
     (if (empty? remaining-objects)
-        [[]]
+        [[(make-arm-tuck-action right?)]]
       (for [obj remaining-objects]
 	[(make-move-to-goal-hla (:right? a) obj)
 	 (make-enforce-goal-action obj)
@@ -1085,10 +1085,12 @@
 (defmethod robot-hla-discrete-refinements? ::SetupHLA [a] true)

 (defmethod robot-hla-refinements ::SetupHLA [nh a env]
-  [(apply concat
+  [(cons
+    (make-torso-action (make-robot-torso-state 0.035))
+    (apply concat
     (for [right? (:arms a)]
       [(make-gripper-action (make-robot-gripper-state right? true))
-       (make-arm-tuck-action right?)]))])
+       (make-arm-tuck-action right?)])))])

 (defmethod robot-action-name ::SetupHLA [a]
   ['setup (:arms a)])


some fail safe

some fail safe

--- src/clj/morpheus/models/edge/core.clj
+++ src/clj/morpheus/models/edge/core.clj
@@ -90,7 +90,7 @@
                        v2-list-cell-row-id (eb/extract-cell-list-id v2-cell v2-e-field edge-schema-id)
                        v1-remotes (map second v2-edges)
                        v2-remotes (map #(% 2) v2-edges)]
-                   (neb/update-cell* v2-list-cell-row-id 'morpheus.models.edge.base/concat-into-list-cell v2-remotes)
+                   (when v2-list-cell-row-id (neb/update-cell* v2-list-cell-row-id 'morpheus.models.edge.base/concat-into-list-cell v2-remotes))
                    v1-remotes))
                (flatten)
                (doall))


refactor and drop impl of abandoned design goals

--- src/cljc/commos/delta/compscribe.cljc
+++ src/cljc/commos/delta/compscribe.cljc
@@ -10,158 +10,8 @@
                                                pipe
                                                #?@(:clj [go go-loop])
                                                tap untap] :as a]
-            [clojure.walk :refer [prewalk postwalk]]
-            [commos.shared.core :refer [flatten-keys]])
+            [clojure.walk :refer [prewalk postwalk]])
   #?(:cljs (:require-macros [cljs.core.async.macros :refer [go-loop go]])))
-
-(defn- vsplit-at
-  "Like split-at, but for vectors."
-  [n v]
-  [(subvec v 0 n) (subvec v n)])
-
-(defn- group-by-pks
-  "Transform a flattened map ks->v into a map pks->[[rks ks v]+] where
-  pks is a partial ks and rks the complementary rest.  E. g.:
-  {[:foo :bar] 42} becomes {[:foo] ([[:bar] [:foo :bar]
-  42]), [] ([[:foo :bar] [:foo :bar] 42])}."
-  [m]
-  (reduce-kv (fn [acc ks v]
-               (reduce (fn [acc [pks rks]]
-                         (update acc pks conj [rks ks v]))
-                       acc
-                       (map #(vsplit-at % ks)
-                            (range (count ks)))))
-             {}
-             m))
-
-(defn- compile-spec
-  "Recursively transform spec [endpoint hooks] [endpoint
-  flattened-keys-hooks flattened-keys-hooks-grouped-by-pks hooks].
-  The resulting structure provides fast lookups required during live
-  dispatch.  Returns compiled spec untransformed."
-  [spec]
-  (let [spec? #(::spec (meta %))
-        mark-spec #(vary-meta % assoc ::spec true)]
-    (cond-> spec
-      (not (spec? spec))
-      (->> (mark-spec)
-           (prewalk (fn [form]
-                      (if (spec? form)
-                        (let [[endpoint specs] form]
-                          (mark-spec
-                           (if (vector? specs)
-                             [endpoint {[] (mark-spec specs)}]
-                             (let [specs (flatten-keys specs)]
-                               [endpoint (zipmap (keys specs)
-                                                 (map mark-spec
-                                                      (vals specs)))]))))
-                        form)))
-           (postwalk (fn [form]
-                       (if (spec? form)
-                         (let [[endpoint specs] form]
-                           (conj form (group-by-pks specs)))
-                         form)))))))
-
-(defn- dissoc-in
-  ;; from org.clojure/core.incubator, copy & pasted due to lack of
-  ;; clojurescript support
-  "Dissociates an entry from a nested associative structure returning a new
-  nested structure. keys is a sequence of keys. Any empty maps that result
-  will not be present in the new structure."
-  [m [k & ks :as keys]]
-  (if ks
-    (if-let [nextmap (get m k)]
-      (let [newmap (dissoc-in nextmap ks)]
-        (if (seq newmap)
-          (assoc m k newmap)
-          (dissoc m k)))
-      m)
-    (dissoc m k)))
-
-(defn- nested-subs
-  "Extract necessary subscriptions/unsubscriptions implied by updating
-  the new-val at ks.  Returns [subs new-val] where new-val has the
-  subscribed ids removed and subs has the extracted
-  subscriptions/unsubscriptions merged onto it.
-
-  Pass nil as new-val to only get unsubscriptions."
-  [subs deep-hooks ks new-val]
-  (reduce (fn [[subs new-val] [rks ks _]]
-            (if-let [val (get-in new-val rks)]
-              [(if (coll? val)
-                 (update-in subs [:subs-many ks] into val)
-                 (-> subs
-                     (assoc-in [:subs-one ks] val)
-                     (update-in [:unsubs] conj ks)))
-               (dissoc-in new-val ks)]
-              [(update-in subs [:unsubs] conj ks)
-               new-val]))
-          [subs new-val]
-          (get deep-hooks ks)))
-
-(defn- extract-hooks
-  "Return a map of required subscriptions and unsubscriptions with the
-  following keys:
-
-  :subs-one ks->val - subscribe hook at ks with val
-  :subs-many ks->vals - subscribe hooks at ks with vals
-  :unsubs [ks+] - unsubscribe subscriptions at ks
-
-  Subs and unsubs may overlap, unsubs are assumed to be applied
-  first."
-  [[_ direct-hooks deep-hooks :as conformed-spec] delta]
-  (loop [[delta & deltas] (delta/unpack delta)
-         subs {}
-         adjusted-deltas []]
-    (if delta
-      (let [[op ks new-val] delta
-            hook (get direct-hooks ks)]
-        (case op
-          :is (if hook
-                (recur deltas
-                       (-> subs
-                           (assoc-in [(if (set? new-val)
-                                        :subs-many
-                                        :subs-one) ks]
-                                     new-val)
-                           (update-in [:unsubs] conj ks))
-                       adjusted-deltas)
-                (if (map? new-val)
-                  (let [[subs new-val]
-                        (nested-subs subs deep-hooks ks new-val)]
-                    (recur deltas
-                           subs
-                           (cond-> adjusted-deltas
-                             (seq new-val)
-                             (conj
-                              [:is ks new-val]))))
-                  (recur deltas
-                         subs
-                         (conj adjusted-deltas delta))))
-          :in (if hook
-                (recur deltas
-                       (update-in subs [:subs-many ks] into new-val)
-                       adjusted-deltas)
-                (recur deltas
-                       subs
-                       (conj adjusted-deltas delta)))
-          :ex (if hook
-                (recur deltas
-                       (update-in subs [:unsubs] into
-                                  (map (partial conj ks) new-val))
-                       (conj adjusted-deltas delta))
-                (recur deltas
-                       (update-in subs [:unsubs] into
-                                  (mapcat
-                                   (fn [k]
-                                     (let [ks (conj ks k)]
-                                       (if (contains? direct-hooks ks)
-                                         [ks]
-                                         (if-let [nested (get deep-hooks ks)]
-                                           (map second nested)))))
-                                   new-val))
-                       (conj adjusted-deltas delta)))))
-      [subs (delta/pack adjusted-deltas)])))

 (defprotocol ClosingMix
   "Implementation detail, subject to change."
@@ -206,9 +56,80 @@
             (close! target)))))
     m))

+(defn- extract-hooks
+  "Return a map of required subscriptions and unsubscriptions with the
+  following keys:
+
+  :subs-one ks->val - subscribe hook at ks with val
+  :subs-many ks->vals - subscribe hooks at ks with vals
+  :unsubs [ks+] - unsubscribe subscriptions at ks
+
+  Subs and unsubs may overlap, unsubs are assumed to be applied
+  first."
+  [spec-map delta]
+  (loop [[delta & deltas] (delta/unpack delta)
+         subs {}
+         adjusted-deltas []]
+    (if delta
+      (let [[op ks new-val] delta
+            hook (get-in spec-map ks)]
+        ;; TODO: refactor else recurs
+        (case op
+          :is
+          (if hook
+            (cond (map? hook)
+                  (if (map? new-val)
+                    (recur (concat (delta/implied-deltas {} delta)
+                                   deltas)
+                           subs
+                           adjusted-deltas)
+                    (let [msg (str "Can't assert non-map at "
+                                   (pr-str ks))]
+                      (throw
+                       #?(:clj
+                          (IllegalArgumentException. msg)
+                          :cljs
+                          msg))))
+
+                  (vector? hook)
+                  (recur deltas
+                         (-> subs
+                             (assoc-in [(if (coll? new-val)
+                                          :subs-many
+                                          :subs-one) ks]
+                                       new-val)
+                             (update-in [:unsubs] conj ks))
+                         adjusted-deltas)
+
+                  :else
+                  (let [msg (str "Invalid spec"  (pr-str hook))]
+                    (throw
+                     #?(:clj
+                        (IllegalArgumentException. msg)
+                        :cljs
+                        msg))))
+            (recur deltas
+                   subs
+                   (conj adjusted-deltas delta)))
+          :in (if hook
+                (recur deltas
+                       (update-in subs [:subs-many ks] into new-val)
+                       adjusted-deltas)
+                (recur deltas
+                       subs
+                       (conj adjusted-deltas delta)))
+          :ex (if hook
+                (recur deltas
+                       (update-in subs [:unsubs] into
+                                  (map (partial conj ks) new-val))
+                       (conj adjusted-deltas delta))
+                (recur deltas
+                       subs
+                       (conj adjusted-deltas delta)))))
+      [subs (delta/pack adjusted-deltas)])))
+
 (defn- compscribe*
-  [outer-target source-service compscribe-service
-   [endpoint direct-hooks deep-hooks :as conformed-spec] id]
+  [outer-target ch-in compscribe-service spec-map]
   (let [;; Once intercepted, events need to go through target-mix so
         ;; that mix-ins and mix-outs have synchronous effects
         target (chan)
@@ -219,27 +140,20 @@
                              many? (conj id))
                        xch (chan 1 (delta/nest ks'))]
                    (service/request compscribe-service
-                                    [(get direct-hooks ks) id]
+                                    [(get-in spec-map ks) id]
                                     xch)
                    (vswap! subs assoc ks' xch)
                    ;; xch will be closed by the subscribed-composition
-                   (mix-in target-mix xch)))
-        ch-in (chan)]
-    (service/request source-service [endpoint id] ch-in)
+                   (mix-in target-mix xch)))]
     (go-loop []
       (if-some [delta (<! ch-in)]
-        (let [[{:keys [subs-one subs-many unsubs]} delta]
-              (extract-hooks conformed-spec delta)
-
-              subs-by-pks (group-by-pks @subs)]
-          (doseq [[ks xch]
-                  (->> unsubs
-                       (mapcat (fn [ks]
-                                 (concat (->> (get subs-by-pks ks)
-                                              (map rest))
-                                         (some-> (find @subs ks)
-                                                 (vector)))))
-                       distinct)]
+        (let [[{:keys [subs-one subs-many unsubs]} delta :as dbg]
+              (extract-hooks spec-map delta)]
+          (doseq [[ks xch] (filter (fn [[ks v]]
+                                     (some (fn [uks]
+                                             (= uks (take (count uks) ks)))
+                                           unsubs))
+                                   @subs)]
             (service/cancel compscribe-service xch)
             (mix-out target-mix xch)
             (vswap! subs dissoc ks))
@@ -259,8 +173,7 @@
         (do
           (close! target) ;; implicit mix-out
           (doseq [xch (vals @subs)]
-            (service/cancel compscribe-service xch)))))
-    (fn [] (service/cancel source-service ch-in))))
+            (service/cancel compscribe-service xch)))))))

 (defn- swap-out!
   "Atomically dissocs k in atom, returns k"
@@ -299,27 +212,25 @@
       service/IService
       (request [this spec target]
         (let [[spec id] spec
-              [endpoint direct-hooks deep-hooks :as spec] (compile-spec spec)
+              [endpoint spec-map] spec
               subs-target (on-close-source target
                                            #(service/cancel this target))]
-          (if (and (empty? direct-hooks)
-                   (empty? deep-hooks))
+          (if (empty? spec-map)
             ;; OPT: If there is nothing to compscribe, directly reach
             ;; through to the source-service:
             (do
               (service/request source-service [endpoint id] subs-target)
-              (swap! subscriptions assoc target
-                     #(service/cancel source-service subs-target)))
-            (do
-              (swap! subscriptions assoc target
-                     (compscribe* subs-target
-                                  source-service
-                                  (service/cached this)
-                                  spec
-                                  id))))))
+              (swap! subscriptions assoc target subs-target))
+            (let [ch-in (chan)]
+              (compscribe* subs-target
+                           ch-in
+                           (service/cached this)
+                           spec-map)
+              (service/request source-service [endpoint id] ch-in)
+              (swap! subscriptions assoc target ch-in)))))
       (cancel [this target]
-        (when-let [unsubs-fn (swap-out! subscriptions target)]
-          (unsubs-fn))))))
+        (when-let [ch (swap-out! subscriptions target)]
+          (service/cancel source-service ch))))))

 (defn compscriber
   "Return a service for requesting composite streams of multiple
@@ -387,13 +298,12 @@
              :or {cache dc/sum-cache}}]
   (let [service (-> source
                     (compscribe-service)
-                    (cache))
-        compile-spec (memoize compile-spec)]
+                    (cache))]
     (reify
       service/IService
       (request [_ spec target]
         (service/request service
-                         (update spec 0 compile-spec)
+                         spec
                          target))
       (cancel [_ target]
         (service/cancel service target)))))


Minor improvements on server startup function related to tls/ssl parameters.

--- src/clojure/catacumba/impl/server.clj
+++ src/clojure/catacumba/impl/server.clj
@@ -64,19 +64,21 @@
     (setup spec)))

 (defn- build-ssl-context
-  [{:keys [path secret]}]
-  (when (and path secret)
-    (let [keystore (io/resource path)]
-      (SSLContexts/sslContext keystore secret))))
+  [{:keys [keystore-secret keystore-path]}]
+  (when (and keystore-secret keystore-path)
+    (let [keystore (io/resource keystore-path)]
+      (SSLContexts/sslContext keystore keystore-secret))))

 (defn- build-server-config
   "Given user specified options, return a `ServerConfig` instance."
-  [{:keys [port debug threads basedir keystore public-address max-body-size] :or {debug false}}]
+  [{:keys [port debug threads basedir public-address max-body-size]
+    :or {debug false}
+    :as options}]
   (let [port (or (:catacumba-port env) port ServerConfig/DEFAULT_PORT)
         threads (or (:catacumba-threads env) threads ServerConfig/DEFAULT_THREADS)
         basedir (or (:catacumba-basedir env) basedir)
         debug (or (:catacumba-debug env) debug)
-        sslcontext (build-ssl-context keystore)
+        sslcontext (build-ssl-context options)
         config (ServerConfig/builder)]
     (if (string? basedir)
       (.baseDir config ^Path (hp/str->path basedir))


Story ID: develop Summary: Fix mock network call.

--- src/untangled/client/impl/network.cljs
+++ src/untangled/client/impl/network.cljs
@@ -83,4 +83,4 @@
   (start [this app]
     (assoc this :complete-app app)))

-(defn mock-network [] (MockNetwork.))
+(defn mock-network [] (map->MockNetwork {}))


Temp removal of vinyasa injections

Temp removal of vinyasa injections

--- link/.lein/profiles.clj
+++ link/.lein/profiles.clj
@@ -4,35 +4,36 @@
                   [lein-bikeshed "0.1.7"]
                   [lein-kibit "0.0.8"]]
         :source-paths ["/home/vagrant/.lein/src"]
-        :injections [;; humane-test-output makes clojure.test output more, well, humane
+        :injections [;; humane-test-output makes clojure.test output more better
                      (require 'pjstadig.humane-test-output)
                      (pjstadig.humane-test-output/activate!)

                      ;; Spyscope is for tracing.
                      (require 'spyscope.core)

-                     ;; Vinyasa: https://github.com/zcaudate/vinyasa
-                     (require '[vinyasa.inject :as inj])
-                     (inj/inject 'clojure.core
-                                 '[[vinyasa.inject inject]
-                                   [vinyasa.pull pull]
-                                   [vinyasa.lein lein]
-                                   [vinyasa.reimport reimport]
-                                   [user dlet plet]])
-                     (inj/inject 'clojure.core '>
-                                 '[[clojure.tools.namespace.repl refresh]
-                                   [clojure.repl apropos dir doc find-doc source
-                                    pst [root-cause >cause]]
-                                   [clojure.pprint pprint]
-                                   [clojure.java.shell sh]
-                                   [clojure.tools.trace trace-ns trace-vars
-                                    untrace-ns untrace-vars]])]
+                     ;; ;; Vinyasa: https://github.com/zcaudate/vinyasa
+                     ;; (require '[vinyasa.inject :as inj])
+                     ;; (inj/inject 'clojure.core
+                     ;;             '[[vinyasa.inject inject]
+                     ;;               [vinyasa.pull pull]
+                     ;;               [vinyasa.lein lein]
+                     ;;               [vinyasa.reimport reimport]
+                     ;;               [user dlet plet]])
+                     ;; (inj/inject 'clojure.core '>
+                     ;;             '[[clojure.tools.namespace.repl refresh]
+                     ;;               [clojure.repl apropos dir doc find-doc source
+                     ;;                pst [root-cause >cause]]
+                     ;;               [clojure.pprint pprint]
+                     ;;               [clojure.java.shell sh]
+                     ;;               [clojure.tools.trace trace-ns trace-vars
+                     ;;                untrace-ns untrace-vars]])
+                     ]
         :dependencies [[org.clojure/java.classpath "0.2.2"]
                        [org.clojure/tools.namespace "0.2.4"]
                        [org.clojure/tools.trace "0.7.6"]
                        [evalive "1.1.0"]
                        [pjstadig/humane-test-output "0.6.0"]
                        [slamhound "1.5.5"]
-                       [leiningen #= (leiningen.core.main/leiningen-version)]
-                       [im.chit/vinyasa "0.2.0"]
+                       ;; [leiningen #= (leiningen.core.main/leiningen-version)]
+                       ;; [im.chit/vinyasa "0.2.0"]
                        [spyscope "0.1.4"]]}}


Normalize naming of context and connection.

--- src/continuo/postgresql/bootstrap.clj
+++ src/continuo/postgresql/bootstrap.clj
@@ -22,26 +22,35 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 (defn- table-installed?
-  [ctx tablename]
+  [conn tablename]
   (let [sql (format "SELECT to_regclass('public.%s')" tablename)
-        rst (sc/fetch-one ctx sql)]
+        rst (sc/fetch-one conn sql)]
     (boolean (first rst))))

 (defn- installed?
   "Check if the main database layour is already installed."
-  [ctx]
-  (every (partial check ctx) ["txlog", "properties", "schemaview", "entity"]))
+  [conn]
+  (every (partial check conn) ["txlog", "properties", "schemaview", "entity"]))

 (defn create'
-  [ctx]
-  (when-not (installed? ctx)
+  [conn]
+  (when-not (installed? conn)
     (let [bsql (slurp (io/resource "persistence/postgresql/bootstrap.sql"))]
-      (sc/execute ctx bsql))))
+      (sc/execute conn bsql))))

 (defn create
-  [conn]
-  (let [ctx (:context conn)]
+  [context]
+  (let [conn (.-connection context)]
     (exec/submit #(sc/atomic-apply ctx create'))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Database Initialization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn initialize
+  [context]
+  ;; TODO
+  )

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Connection Management


Fixing build failure caused by missing require.

--- indexer-app/src/cmr/indexer/api/routes.clj
+++ indexer-app/src/cmr/indexer/api/routes.clj
@@ -17,6 +17,7 @@
             ;; These must be required here to make multimethod implementations available.
             [cmr.indexer.data.concepts.collection]
             [cmr.indexer.data.concepts.granule]
+            [cmr.indexer.data.concepts.tag]

             [cmr.indexer.services.index-service :as index-svc]
             [cmr.system-trace.http :as http-trace]


test for DELETE /api/emailreport/:id

test for DELETE /api/emailreport/:id

--- test/metabase/api/emailreport_test.clj
+++ test/metabase/api/emailreport_test.clj
@@ -11,43 +11,40 @@

 ;; ## Helper Fns

-(defn create-email-report []
+(defn create-email-report [& {:as kwargs}]
   ((user->client :rasta) :post 200 "emailreport"
-   {:name "My Cool Email Report"
-    :mode (emailreport/mode->id :active)
-    :public_perms common/perms-readwrite
-    :email_addresses ""
-    :recipients [{:id (user->id :lucky)}]
-    :dataset_query {:type "query"
-                    :query {:source_table (table->id :venues)
-                            :filter [nil nil]
-                            :aggregation ["rows"]
-                            :breakout [nil]
-                            :limit nil}
-                    :database (:id @test-db)}
-    :schedule {:days_of_week {:mon true
-                               :tue true
-                               :wed true
-                               :thu true
-                               :fri true
-                               :sat true
-                               :sun true}
-               :time_of_day "morning"
-               :timezone ""}
-    :organization (:id @test-org)}))
+   (merge {:name "My Cool Email Report"
+           :mode (emailreport/mode->id :active)
+           :public_perms common/perms-readwrite
+           :email_addresses ""
+           :recipients [{:id (user->id :lucky)}]
+           :dataset_query {:type "query"
+                           :query {:source_table (table->id :venues)
+                                   :filter [nil nil]
+                                   :aggregation ["rows"]
+                                   :breakout [nil]
+                                   :limit nil}
+                           :database (:id @test-db)}
+           :schedule {:days_of_week {:mon true
+                                     :tue true
+                                     :wed true
+                                     :thu true
+                                     :fri true
+                                     :sat true
+                                     :sun true}
+                      :time_of_day "morning"
+                      :timezone ""}
+           :organization (:id @test-org)}
+          kwargs)))

 ;; ## GET /api/emailreport/form_input
 ;; Test that we can get the form input options for the Test Org
 (expect-let [_ @test-db ; force lazy loading of Test Data / Metabase DB
              _ (cascade-delete Database :name [not= "Test Database"])] ; Delete all Databases that aren't the Test DB
-  {:users [{:id (user->id :rasta)
-            :name "Rasta Toucan"}
-           {:id (user->id :crowberto)
-            :name "Crowberto Corv"}
-           {:id (user->id :lucky)
-            :name "Lucky Pigeon"}
-           {:id (user->id :trashbird)
-            :name "Trash Bird"}],
+  {:users #{{:id (user->id :rasta),     :name "Rasta Toucan"}
+            {:id (user->id :crowberto), :name "Crowberto Corv"}
+            {:id (user->id :lucky),     :name "Lucky Pigeon"}
+            {:id (user->id :trashbird), :name "Trash Bird"}}
    :databases [{:id (:id @test-db)
                 :name "Test Database"}],
    :timezones ["GMT"
@@ -77,7 +74,8 @@
    :permissions [{:name "None",         :id 0}
                  {:name "Read Only",    :id 1}
                  {:name "Read & Write", :id 2}]}
-  ((user->client :rasta) :get 200 "emailreport/form_input" :org (:id @test-org)))
+  (-> ((user->client :rasta) :get 200 "emailreport/form_input" :org (:id @test-org)) ; convert to a set so test doesn't fail if order differs
+        (update-in [:users] set)))

 ;; ## POST /api/emailreport
@@ -161,3 +159,17 @@
        :created_at $})
   (let [{id :id} (create-email-report)]
     ((user->client :rasta) :get 200 (format "emailreport/%d" id))))
+
+;; ## DELETE /api/emailreport/:id
+(let [er-name (random-name)
+      er-exists? (fn [] (exists? EmailReport :name er-name))]
+  (expect-eval-actual-first
+      [false
+       true
+       false]
+    [(er-exists?)
+     (do (create-email-report :name er-name)
+         (er-exists?))
+     (let [{id :id} (sel :one EmailReport :name er-name)]
+       ((user->client :rasta) :delete 204 (format "emailreport/%d" id))
+       (er-exists?))]))


Removed protein to gene rule after separating included rules to their own files

--- resources/rules/post_identifier_merge/ice_to_bio/protein_to_gene.clj
+++ resources/rules/post_identifier_merge/ice_to_bio/protein_to_gene.clj
@@ -1,64 +0,0 @@
-;;;; Rules to map from protein identifiers to gene identifiers
-
-`{:name "uniprot-protein-eg-gene-mapping"
-  :head ((?/protein kso/has_indirect_template ?/dna);)
-
-         (?/r1 rdf/type owl/Restriction)
-         (?/r1 owl/onProperty kso/has_indirect_template)
-         (?/r1 owl/someValuesFrom ?/dna)
-
-         ;;still need to add a sufficient definition?
-         (?/protein rdfs/subClassOf ?/r1))
-
-  :body (;;(_/record kiao/hasTemplate iaoeg/EntrezGeneInfoFileDataSchema1)
-         ;; ~@(kabob/rtv _/record1
-         ;;              iaouniprot/UniProtIDMappingFileData_uniProtAccessionIDDataField1 _/proteinice
-         ;;              iaouniprot/UniProtIDMappingFileData_entrezGeneIDsDataField1 _/geneice)
-
-         (?/fv0 kiao/hasTemplate  iaouniprot/UniProtIDMappingFileData_uniProtAccessionIDDataField1)
-         (?/fv0 obo/IAO_0000219 _/proteinice) ; denotes
-
-         (?/record1 obo/BFO_0000051 ?/fv0) ; has_part
-         (?/record1 obo/BFO_0000051 ?/fv1) ; has_part
-         (?/fv1 kiao/hasTemplate iaouniprot/UniProtIDMappingFileData_entrezGeneIDsDataField1)
-         (?/fv1 obo/IAO_0000219 _/geneice) ; denotes
-
-         (_/proteinice obo/IAO_0000219 ?/protein) ; denotes
-         (_/geneice obo/IAO_0000219 ?/dna)) ; denotes
-
-  :reify ([?/r1 {:ln (:restriction)
-                 :ns "kbio" :prefix "R_"}])
-  :options {:magic-prefixes [["franzOption_clauseReorderer" "franz:identity"]]}
-}
-
-
-`{:name "rgd-gene-to-protein-mapping"
-  :head ((?/protein kso/has_indirect_template ?/dna);)
-
-         (?/r1 rdf/type owl/Restriction)
-         (?/r1 owl/onProperty kso/has_indirect_template)
-         (?/r1 owl/someValuesFrom ?/dna)
-
-         ;;still need to add a sufficient definition?
-         (?/protein rdfs/subClassOf ?/r1))
-
-  :body (;;(_/record kiao/hasTemplate iaoeg/EntrezGeneInfoFileDataSchema1)
-         ;; ~@(kabob/rtv _/record1
-         ;;              iaorgd/RgdGeneFileRecord_uniprotIdsDataField1 _/proteinice
-         ;;              iaorgd/RgdGeneFileRecord_geneIdDataField1 _/geneice)
-
-         (?/fv0 kiao/hasTemplate  iaorgd/RgdGeneFileRecord_uniprotIdsDataField1)
-         (?/fv0 obo/IAO_0000219 _/proteinice) ; denotes
-
-         (?/record1 obo/BFO_0000051 ?/fv0) ; has_part
-         (?/record1 obo/BFO_0000051 ?/fv1) ; has_part
-         (?/fv1 kiao/hasTemplate iaorgd/RgdGeneFileRecord_geneIdDataField1)
-         (?/fv1 obo/IAO_0000219 _/geneice) ; denotes
-
-         (_/proteinice obo/IAO_0000219 ?/protein) ; denotes
-         (_/geneice obo/IAO_0000219 ?/dna)) ; denotes
-
-  :reify ([?/r1 {:ln (:restriction)
-                 :ns "kbio" :prefix "R_"}])
-  :options {:magic-prefixes [["franzOption_clauseReorderer" "franz:identity"]]}
-}


Fix keyword matching

Fix keyword matching

--- src/aurora/compiler/match.cljs
+++ src/aurora/compiler/match.cljs
@@ -36,7 +36,8 @@
   (cond
    (= '_ pattern) ::tail
    (symbol? pattern) `(do (let! ~pattern ::input) ::tail)
-   (or (number? pattern) (string? pattern) (keyword? pattern)) `(if (= ~(data->jsth pattern) ::input) ::tail)
+   (or (number? pattern) (string? pattern)) `(if (= ~(data->jsth pattern) ::input) ::tail)
+   (keyword? pattern) `(if (cljs.core.keyword-identical? ~(data->jsth pattern) ::input) ::tail)
    (vector? pattern) `(if (cljs.core.vector? ::input)
                         (if (= ~(count pattern) (cljs.core.count ::input))
                           ~(apply chain
@@ -65,6 +66,10 @@
     (js/Function (jsth/munge input-sym) (jsth/statement->string `(do ~success ~failure)))))

 (comment
+  (match :a :a :ok)
+
+  (match "a" "a" :ok)
+
   ((pattern '[a _ b] '[a b]) [1 2 3])

   (match 1


add indices for "small" grammar

add indices for "small" grammar

--- src/babel/english/grammar.cljc
+++ src/babel/english/grammar.cljc
@@ -628,8 +628,9 @@
                               v)]
                   (if (not (empty? filtered-v))
                     [k filtered-v]))))
-        ]
+        indices (create-indices lexicon index-lexicon-on-paths)]
     {:name "small"
+     :index-fn (fn [spec] (lookup-spec spec indices index-lexicon-on-paths))
      :morph-walk-tree (fn [tree]
                         (do
                           (merge tree
@@ -677,7 +678,6 @@
                     [k filtered-v]))))
         indices (create-indices lexicon index-lexicon-on-paths)]
     {:name "medium"
-
      :index-fn (fn [spec] (lookup-spec spec indices index-lexicon-on-paths))
      ;; Will throw a clojure/core-level exception if more than 1 rule has the same :rule value:
      :grammar-map (zipmap


forget->"forgetting"

forget->"forgetting"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -659,7 +659,8 @@

    "forget" {:synsem {:cat :verb
                       :sem {:pred :forget}}
-             :english {:past "forgot"}}
+             :english {:past "forgot"
+                       :participle "forgetting"}}

    "form" {:synsem {:cat :verb
                     :sem {:pred :form}}}


added ecouter

added ecouter

--- src/babel/francais/lexicon.clj
+++ src/babel/francais/lexicon.clj
@@ -44,6 +44,11 @@

    "commencer" {:synsem {:cat :verb
                          :sem {:pred :begin}}}
+
+     "ecouter" {:synsem {:cat :verb
+                         :sem {:pred :listen}}}
+
+
    "elle"
    [{:synsem {:cat :noun
              :pronoun true


Divide a:graphic tag from fn img

Divide a:graphic tag from fn img

--- src/bakyeono/litedocx/wpml.clj
+++ src/bakyeono/litedocx/wpml.clj
@@ -657,6 +657,47 @@
                (node :w:t {}
                      text)))))

+(defn graphic
+  "Returns a:graphic tag."
+  [img-id img-desc extent-x extent-y]
+  ;; Graphic Object
+  (node :a:graphic {}
+        ;; Graphic Object Data
+        (node :a:graphicData {:uri "http://schemas.openxmlformats.org/drawingml/2006/picture"}
+              ;; Picture
+              (node :pic:pic {}
+                    ;; Non-Visual Picture Properties
+                    (node :pic:nvPicPr {}
+                          ;; Non-Visual Drawing Properties
+                          (node :pic:cNvPr {:id img-id ; Unique ID
+                                            :name name ; Name
+                                            :descr img-desc}) ; Description
+                          ;; Non-Visual Picture Drawing Properties
+                          (node :pic:cNvPicPr))
+                    ;; Picture Fill
+                    (node :pic:blipFill {}
+                          ;; Blip
+                          (node :a:blip {:r:embed id ; Embedded Picture Reference
+                                         :r:link ""}) ; Linked Picture Reference
+                          ;; Stretch
+                          (node :a:stretch {}
+                                ;; Fill Rectangle
+                                (node :a:fillRect)))
+                    ;; Shape Properties
+                    (node :pic:spPr {}
+                          ;; 2D Transform for Individual Objects
+                          (node :a:xfrm {}
+                                ;; Offset
+                                (node :a:off {:x 0
+                                              :y 0})
+                                ;; Extents
+                                (node :ext {:x extent-x
+                                            :y extent-y}))
+                          ;; Preset Geometry
+                          (node :a:prstGeom {:prst "rect"} ; Preset Shape
+                                ;; List of Shape Adjust Values
+                                (node :a:avLst)))))))
+
 (defn img
   "Returns XML tag node of image.

@@ -690,41 +731,6 @@
                                                       :noMove false
                                                       :noResize false
                                                       :noChangeAspect true}))
-                    ;; Graphic Object
-                    (node :a:graphic {}
-                          ;; Graphic Object Data
-                          (node :a:graphicData {:uri "http://schemas.openxmlformats.org/drawingml/2006/picture"}
-                                ;; Picture
-                                (node :pic:pic {}
-                                      ;; Non-Visual Picture Properties
-                                      (node :pic:nvPicPr {}
-                                            ;; Non-Visual Drawing Properties
-                                            (node :pic:cNvPr {:id id ; Unique ID
-                                                              :name name ; Name
-                                                              :descr desc}) ; Description
-                                            ;; Non-Visual Picture Drawing Properties
-                                            (node :pic:cNvPicPr))
-                                      ;; Picture Fill
-                                      (node :pic:blipFill {}
-                                            ;; Blip
-                                            (node :a:blip {:r:embed id ; Embedded Picture Reference
-                                                           :r:link ""}) ; Linked Picture Reference
-                                            ;; Stretch
-                                            (node :a:stretch {}
-                                                  ;; Fill Rectangle
-                                                  (node :a:fillRect)))
-                                      ;; Shape Properties
-                                      (node :pic:spPr {}
-                                            ;; 2D Transform for Individual Objects
-                                            (node :a:xfrm {}
-                                                  ;; Offset
-                                                  (node :a:off {:x 0
-                                                                :y 0})
-                                                  ;; Extents
-                                                  (node :ext {:x extent-x
-                                                              :y extent-y}))
-                                            ;; Preset Geometry
-                                            (node :a:prstGeom {:prst "rect"} ; Preset Shape
-                                                  ;; List of Shape Adjust Values
-                                                  (node :a:avLst))))))))))
-
+                    ;; Graphic
+                    (graphic id desc extent-x extent-y)))))
+


use right variable

use right variable

--- src/clj/just_married/pages.clj
+++ src/clj/just_married/pages.clj
@@ -22,7 +22,7 @@
   ;; fallback to a random git sha when nothing is found
   (format "%s?git_sha=%s"
           path
-          (:source-version env (str (UUID/randomUUID)))))
+          (:heroku-slug-commit env (str (UUID/randomUUID)))))

 (defn- google-font
   [font-name]


parse context image, improve assertion check

--- src/clj/salava/badge/parse.clj
+++ src/clj/salava/badge/parse.clj
@@ -282,12 +282,13 @@
                                        (get-in badge [:criteria :narrative]
                                                (http/alternate-get "text/x-markdown" criteria-url))
                                        (http/alternate-get "text/x-markdown" (:criteria badge)))
-                       creator-url (get-in badge [:extensions:OriginalCreator :url])]
+                       creator-url (get-in badge [:extensions:OriginalCreator :url])
+                       image (if (map? (:image badge)) (get-in badge [:image :id]) (:image badge))]

                    {:content  [{:id ""
                                 :language_code language
                                 :name (:name badge)
-                                :image_file (:image badge)
+                                :image_file image #_(:image badge)
                                 :description (:description badge)
                                 :alignment (get-alignment badge)
                                 :tags (get badge :tags [])}]
@@ -514,7 +515,7 @@
 (defmethod verify-assertion :v2.0 [url asr]
   (let [kind (get-in asr [:verify :type] (get-in asr [:verification :type]))]
     (when (and (not (nil? url)) (or (= kind "hosted") (= kind "HostedBadge")))
-      (if (and (not= (:id asr) url) (not (string/includes? url (:id asr))))
+      (if (and (not (string/starts-with? url (:id asr))) (not= (domain url) (domain (:id asr))))
         (throw (IllegalArgumentException. "invalid assertion, verify url mismatch")))
       (if (map? (:badge asr))
         (if (not= (domain (get-in asr [:badge :id])) (domain (:id asr)))


Added find-dimensions function

Added find-dimensions function

--- src/clj/stitch/util/opencv.clj
+++ src/clj/stitch/util/opencv.clj
@@ -38,7 +38,7 @@

 (defn matrix-multiplication [m1 m2]
   (let [res-mat (Mat.)]
-    (Core/gemm h p2 1  (Mat.) 0 res-mat 0)
+    (Core/gemm m1 m2 1  (Mat.) 0 res-mat 0)
     res-mat))

 ;; ----------------------------------------------------------------
@@ -84,7 +84,7 @@
     (.fromArray m a)
     m))

-;;Function for initial image base points setup
+;;Function for initial image base points setup
 (defn create-base-points [img]
   (let [rows (.rows img)
         cols (.cols img)
@@ -277,14 +277,24 @@
   (doto src-img
     (.copyTo dest-img)))

-(defn ludnica
-  [ivec]
-  (map (fn [[w i]] (let [r (.rows i)
-                         c (.cols i)
-                         r (rect 0 0 c r)]
-                         (copy-to i (Mat. w r))
-                         w))
-                  ivec))
+(defn find-dimensions [h img]
+  (let [base-points (create-base-points img)
+        base-atom (atom {:min_x Integer/MAX_VALUE :min_y Integer/MAX_VALUE
+           :max_x Integer/MIN_VALUE :max_y Integer/MIN_VALUE })]
+  (loop [x (dec (.rows base-points))]
+    (if (< x 0)
+      base-atom
+       (let [m (matrix-multiplication h (.t (.row base-points x)))]
+        (if (> (first (.get m 0 0)) (:max_x @base-atom))
+          (swap! base-atom  merge {:max_x (first (.get m 0 0))}))
+        (if (> (first (.get m 1 0)) (:max_y @base-atom))
+          (swap! base-atom  merge {:max_y (first (.get m 1 0))}))
+        (if (< (first (.get m 0 0)) (:min_x @base-atom))
+          (swap! base-atom  merge {:min_x (first (.get m 0 0))}))
+        (if (< (first (.get m 1 0)) (:min_y @base-atom))
+          (swap! base-atom  merge {:min_y (first (.get m 1 0))}))
+            (recur (dec x) ))))
+    @base-atom))

 (defn stitch [img-a img-b]
   (let [res (Mat.)
@@ -309,10 +319,10 @@

 (comment

-  (def i1 (read-image-resource "test_stitches/1/a1.JPG"))
-  (def i2 (read-image-resource "test_stitches/1/a2.JPG"))
-  (def i3 (read-image-resource "test_stitches/1/a3.JPG"))
-  (def i4 (read-image-resource "test_stitches/1/a4.JPG"))
+  (def i1 (read-image-resource "scans/milos/13/a1.JPG"))
+  (def i2 (read-image-resource "scans/milos/13/a2.JPG"))
+  (def i3 (read-image-resource "scans/milos/13/a3.JPG"))
+  (def i4 (read-image-resource "scans/milos/13/a4.JPG"))
   (def i5 (read-image-resource "test_stitches/1/a5.JPG"))
   (def i6 (read-image-resource "test_stitches/1/a6.JPG"))
   (def i7 (read-image-resource "test_stitches/1/a7.JPG"))
@@ -343,4 +353,23 @@
       (matrix-multiplication h (.t (.row base-points x)))))

+
+  (loop [x (dec (.rows base-points))
+         base-atom (atom {:min_x Integer/MAX_VALUE :min_y Integer/MAX_VALUE
+            :max_x Integer/MIN_VALUE :max_y Integer/MIN_VALUE })]
+    (if (< x 0)
+      base-atom
+       (let [m (matrix-multiplication h (.t (.row base-points x)))]
+        (if (> (first (.get m 0 0)) (:max_x @base-atom))
+          (swap! base-atom  merge {:max_x (first (.get m 0 0))}) (println "NO"))
+        (if (> (first (.get m 1 0)) (:max_y @base-atom))
+          (swap! base-atom  merge {:max_y (first (.get m 1 0))}) (println "NO"))
+        (if (< (first (.get m 0 0)) (:min_x @base-atom))
+          (swap! base-atom  merge {:min_x (first (.get m 0 0))}) (println "NO"))
+        (if (< (first (.get m 1 0)) (:min_y @base-atom))
+          (swap! base-atom  merge {:min_y (first (.get m 1 0))}) (println "NO"))
+            (recur (dec x) base-atom))))
+
+
+
 )


simplifications

simplifications

--- src/clojure/confgraph/core.clj
+++ src/clojure/confgraph/core.clj
@@ -7,21 +7,20 @@
            org.jgrapht.graph.DefaultEdge
            org.yaml.snakeyaml.Yaml))

-(def yaml       (Yaml. (ExtendedConstructor.)))
 (def defs       (filter #(.isFile %) (.listFiles (File. "defs/runs"))))
 (def vertices   (map #(.getName %) defs))
+(def yaml       (Yaml. (ExtendedConstructor.)))
 (def extends    (fn [x] (.get (.load yaml (slurp (.getPath x))) "ddts_extends")))
-(def precursors (map extends defs))
-(def raw-edges  (zipmap vertices precursors))
+(def prototypes (map extends defs))
+(def raw-edges  (zipmap vertices prototypes))

 (def rootpath
   (memoize #(let [dst (raw-edges %)]
               (if (nil? dst) {} (conj {% dst} (rootpath dst))))))

 (defn edges [prefix]
-  (let [re (re-pattern (str prefix ".*"))]
-    (into {} (for [[src dst] raw-edges :when (re-matches re src)]
-               (rootpath src)))))
+  (let [e (filter #(re-matches (re-pattern (str prefix ".*")) (first %)) raw-edges)]
+    (into {} (for [[src dst] e] (rootpath src)))))

 (defn -main [& args]
   (alter-var-root #'*read-eval* (constantly false))


Fixed import decl.

Fixed import decl.

--- src/clojure/freactive/core.clj
+++ src/clojure/freactive/core.clj
@@ -1,7 +1,7 @@
 (ns freactive.core
   (:refer-clojure
    :exclude [atom agent ref swap! reset! compare-and-set!])
-  (:import [clojure.lang ReactiveAtom Reactive StatefulReactive ReactiveAtomView]))
+  (:import [freactive ReactiveAtom Reactive StatefulReactive ReactiveAtomView]))

 ;; Copying clojure.core atom stuff here so that we can use my ReactiveAtom class.

@@ -20,7 +20,7 @@
 return false or throw an exception."
   {:added "1.0"
    :static true}
-  ([x] (new freactive.ReactiveAtom x))
+  ([x] (new ReactiveAtom x))
   ([x & options] (#'clojure.core/setup-reference (atom x) options)))

 (defn reactive* [f & options]


Update Clojure and ClojureScript deps

Update Clojure and ClojureScript deps

1.7.0-beta3
0.0-3269

--- Clojure/project.clj
+++ Clojure/project.clj
@@ -3,6 +3,6 @@
   :url "https://github.com/omcljs/ambly"
   :license {:name "Eclipse Public License"
             :url "http://www.eclipse.org/legal/epl-v10.html"}
-  :dependencies [[org.clojure/clojure "1.7.0-beta2"]
-                 [org.clojure/clojurescript "0.0-3255"]
+  :dependencies [[org.clojure/clojure "1.7.0-beta3"]
+                 [org.clojure/clojurescript "0.0-3269"]
                  [com.github.rickyclarkson/jmdns "3.4.2-r353-1"]])


Add test to confirm remote publish from a listener.

--- messaging/test/immutant/messaging_test.clj
+++ messaging/test/immutant/messaging_test.clj
@@ -226,3 +226,19 @@
       (is (= :success (receive q2 :timeout 1000 :timeout-val :failure)))
       (finally
         (.close l)))))
+
+(deftest publish-to-a-remote-queue-from-a-listener-should-work
+  (queue "remote" :durable false)
+  (let [conn (if (u/in-container?)
+               (connection :host "localhost" :port (u/messaging-remoting-port)
+                 :username "testuser" :password "testuser" :remote-type :hornetq-wildfly)
+               (connection :host "localhost"))
+        q (random-queue)
+        remote-q (queue "remote" :connection conn)
+        l (listen q #(publish remote-q %))]
+    (try
+      (publish q :ham)
+      (is (= :ham (receive (queue "remote") :timeout 1000 :timeout-val :failure)))
+      (finally
+        (.close conn)
+        (.close l)))))


fix ns qualified keyword :overtone.sc.buffer/buffer.

* Thank you to dave ray for pointing this out.

--- src/overtone/sc/machinery/ugen/fn_gen.clj
+++ src/overtone/sc/machinery/ugen/fn_gen.clj
@@ -132,7 +132,7 @@
     (if (and
          (= 1 (count args))
          (not (sc-ugen? (first args)))
-         (not (isa? (type (first args)) ::overtone.sc.buffer/buffer))
+         (not (isa? (type (first args)) :overtone.sc.buffer/buffer))
          (map? (first args)))
       (apply f (flatten (seq (first args))))
       (apply f args))))


cosets.clj: added functions that construct derived coset tables

--- clojure/org/gavrog/clojure/cosets.clj
+++ clojure/org/gavrog/clojure/cosets.clj
@@ -173,3 +173,27 @@
                                   :when (and (empty? equiv)
                                              (canonical t gens))]
                              t))))})))
+
+(defn- induced-table [gens img img0]
+  (loop [table {0 {}}, o2n {img0 0}, n2o {0 img0}, i 0, j 0]
+    (cond (>= i (count table)) table
+          (>= j (count gens)) (recur table o2n n2o (inc i) 0)
+          :else
+          (let [g (gens j)
+                k (img (n2o i) g)
+                n (or (o2n k) (count table))
+                o2n (assoc o2n k n)
+                n2o (assoc n2o n k)
+                table (-> table (assoc-in [i g] n) (assoc-in [n (- g)] i))]
+            (recur table o2n n2o i (inc j))))))
+
+(defn intersection-table [table-a table-b]
+  (induced-table (vec (keys (or (table-a 0) {})))
+                 (fn [[a b] g] [((table-a a) g) ((table-b b) g)])
+                 [0 0]))
+
+(defn core-table [table]
+  (let [elms (vec (keys table))]
+    (induced-table (vec (keys (or (table 0) {})))
+                   (fn [es g] (vec (map (fn [e] ((table e) g)) es)))
+                   elms)))


still a little more to do, but minor cleaning and NS fixing

--- src/funimage/filters/gabor.clj
+++ src/funimage/filters/gabor.clj
@@ -1,10 +1,7 @@
-(ns src.funimage.filters.gabor
+(ns funimage.filters.gabor
   (:use [funimage imp project utils]
         [funimage.imp calculator roi]
         [funimage.segmentation utils]))
-
-
-(defn abs [n] (max n (- n)))

 (defn make-odd [n] (if (not (odd? n))
                      (+ n 1)
@@ -44,13 +41,13 @@
         nstds 0.5
         row (max (java.lang.Math/ceil
                    (max 1
-                        (max (abs (* nstds x-sigma (java.lang.Math/cos direction)))
-                             (abs (* nstds y-sigma (java.lang.Math/sin direction))))))
+                        (max (java.lang.Math/abs (* nstds x-sigma (java.lang.Math/cos direction)))
+                             (java.lang.Math/abs (* nstds y-sigma (java.lang.Math/sin direction))))))

                  (java.lang.Math/ceil
                    (max 1
-                        (max (abs (* nstds x-sigma (java.lang.Math/sin direction)))
-                             (abs (* nstds y-sigma (java.lang.Math/cos direction)))))))
+                        (max (java.lang.Math/abs (* nstds x-sigma (java.lang.Math/sin direction)))
+                             (java.lang.Math/abs (* nstds y-sigma (java.lang.Math/cos direction)))))))
         columns row
         row-center (/ (+ row 1) 2)
         col-center (/ (+ columns 1) 2)


add a data migration which populates the RawTable and RawColumn tables.

--- src/metabase/db/migrations.clj
+++ src/metabase/db/migrations.clj
@@ -3,6 +3,7 @@
   (:require [clojure.tools.logging :as log]
             [korma.core :as k]
             [metabase.db :as db]
+            [metabase.driver :as driver]
             [metabase.events.activity-feed :refer [activity-feed-topics]]
             (metabase.models [activity :refer [Activity]]
                              [card :refer [Card]]
@@ -10,6 +11,8 @@
                              [database :refer [Database]]
                              [field :refer [Field]]
                              [foreign-key :refer [ForeignKey]]
+                             [raw-column :refer [RawColumn]]
+                             [raw-table :refer [RawTable]]
                              [table :refer [Table]]
                              [setting :as setting])
             [metabase.util :as u]))
@@ -179,3 +182,39 @@
         (k/update Field
           (k/set-fields {:fk_target_field_id destination_id})
           (k/where      {:id                 origin_id}))))))
+
+
+;; populate RawTable and RawColumn information
+;; NOTE: we only handle active Tables/Fields and we skip any FK relationships (they can safely populate later)
+(defmigration create-raw-tables
+  (when (= 0 (:cnt (first (k/select RawTable (k/aggregate (count :*) :cnt)))))
+    (doseq [{database-id :id, :keys [name engine]} (db/sel :many Database)]
+      (when-let [tables (not-empty (db/sel :many Table :db_id database-id, :active true))]
+        (log/info (format "Migrating schema information for %s database '%s'" engine name))
+        (doseq [{table-id :id, table-schema :schema, table-name :name} tables]
+          ;; create the RawTable
+          (let [{raw-table-id :id} (db/ins RawTable
+                                     :database_id  database-id
+                                     :schema       table-schema
+                                     :name         table-name
+                                     :details      {}
+                                     :active       true)]
+            ;; update the Table and link it with the RawTable
+            (k/update Table
+              (k/set-fields {:raw_table_id raw-table-id})
+              (k/where      {:id table-id}))
+            ;; migrate all Fields in the Table (skipping :dynamic-schema dbs)
+            (when-not (driver/driver-supports? (driver/engine->driver engine) :dynamic-schema)
+              (doseq [{field-id :id, column-name :name, :as field} (db/sel :many Field :table_id table-id, :visibility_type [not= "retired"])]
+                (let [{raw-column-id :id} (db/ins RawColumn
+                                            :raw_table_id  raw-table-id
+                                            :name          column-name
+                                            :base_type     (:base_type field)
+                                            :is_pk         (= :id (:special_type field))
+                                            :details       {}
+                                            :active        true)]
+                  ;; update the Field and link it with the RawColumn
+                  (k/update Field
+                    (k/set-fields {:raw_column_id raw-column-id
+                                   :last_analyzed (u/new-sql-timestamp)})
+                    (k/where      {:id field-id})))))))))))


Fix labels migration :wrench:

Fix labels migration :wrench:

--- src/metabase/db/migrations.clj
+++ src/metabase/db/migrations.clj
@@ -337,7 +337,7 @@
       (println (u/format-color 'green "Creating a new collection for label '%s'..." label-name))
       (db/insert! Collection
         :name  label-name
-        :color (or (second (re-matches collection/hex-color-regex icon))
+        :color (or (re-matches collection/hex-color-regex icon)
                    (random-color)))))

 (defn- add-label-cards-to-collection!


Replace with onyx specific namespace on nippy

--- src/onyx/compression/nippy.clj
+++ src/onyx/compression/nippy.clj
@@ -3,17 +3,16 @@
             [schema.utils :as su])
   (:import [schema.utils ValidationError NamedError]))

-(nippy/extend-freeze
- clojure.lang.ExceptionInfo :schema/validation-error
- [x data-output]
- (.writeUTF data-output (str {:ex (.getData x)
-                              :str (.getMessage x)})))
+(nippy/extend-freeze clojure.lang.ExceptionInfo :onyx/exception-info
+                     [x data-output]
+                     (.writeUTF data-output (str {:ex (.getData x)
+                                                  :str (.getMessage x)
+                                                  :cause (.getCause x)})))

-(nippy/extend-thaw
- :schema/validation-error
- [data-input]
- (let [{:keys [ex str]} (read-string (.readUTF data-input))]
-   (clojure.lang.ExceptionInfo. str ex)))
+(nippy/extend-thaw :onyx/exception-info
+                   [data-input]
+                   (let [{:keys [ex str cause]} (read-string (.readUTF data-input))]
+                     (clojure.lang.ExceptionInfo. str ex cause)))

 (def messaging-compress-opts {})

@@ -53,15 +52,3 @@

 (defn localdb-decompress [x]
   (nippy/thaw x local-db-decompress-opts))
-
-(nippy/extend-freeze clojure.lang.ExceptionInfo :onyx/exception-info
-                     [x data-output]
-                     (.writeUTF data-output (str {:ex (.getData x)
-                                                  :str (.getMessage x)
-                                                  :cause (.getCause x)})))
-
-(nippy/extend-thaw :onyx/exception-info
-                   [data-input]
-                   (let [{:keys [ex str cause]} (read-string (.readUTF data-input))]
-                     (when cause (println cause))
-                     (clojure.lang.ExceptionInfo. str ex cause)))


bugfix in the settings provider

bugfix in the settings provider

--- src/NoteHub/settings.clj
+++ src/NoteHub/settings.clj
@@ -36,7 +36,7 @@
         value (settings-map key)
         ; Through this hack we can read security-critical settings from (previously
         ; set) shell variables without commiting their content to CVS
-        value (if-not value
+        value (if value value
                 (System/getenv
                   (upper-case
                     (replace (name key) #"-" ""))))]


Drop the melody an octave so it blends in with the chords.

--- src/overtunes/songs/before.clj
+++ src/overtunes/songs/before.clj
@@ -4,7 +4,7 @@
 )

 (def melody
-  [:C4 :Bb4 :Eb4 :G4]
+  [:C3 :Bb3 :Eb3 :G3]
 )

 (def starting-section [
@@ -49,7 +49,7 @@
 ])

 (defn play-chord [notes duration] ( do
-  (defn play-note [note] (organ-cornet note (/ duration 1000)))
+  (defn play-note [note] (organ-cornet note (/ duration 1000) 0.6))
   (if (not (empty? notes))
     (let [
       root (first notes)