Move to Hanasu. Get rid of sente and everything associated with it! Like taking a shower

--- src/aerobio/server.clj
+++ src/aerobio/server.clj
@@ -34,40 +34,39 @@
   {:author "Jon Anthony"}

   (:require
-   [clojure.java.io          :as io]
-   [clojure.string           :as str]
-   [clojure.set              :as set]
-   [clojure.data.json        :as json]
+   [clojure.string :as str]
+   [clojure.set :as set]
+   [clojure.data.json :as json]
+   [clojure.java.io :as io]
    [clojure.tools.reader.edn :as edn]
-
-   [ring.middleware.defaults]
-   [ring.util.codec :as ruc]
-
-   [compojure.core     :as comp
-    :refer (defroutes GET POST)]
-
-   [compojure.route    :as route]
-   [hiccup.core        :as hiccup]
-
    [clojure.core.async :as async
     :refer (<! <!! >! >!! put! chan go go-loop alt! timeout alt! alts!!)]

-   [taoensso.timbre    :as timbre
+   [ring.middleware.defaults]
+   [ring.middleware.gzip :refer [wrap-gzip]]
+   [ring.middleware.cljsjs :refer [wrap-cljsjs]]
+   [ring.util.response :refer (resource-response content-type)]
+   #_[ring.util.codec :as ruc]
+
+   [compojure.core :as comp :refer (routes GET POST)]
+   [compojure.route :as route]
+
+   [hiccup.core :as hiccup]
+
+   [taoensso.timbre :as timbre
     :refer (tracef debugf infof warnf errorf)]
-   [taoensso.sente     :as sente]
-
-   [org.httpkit.server :as http-kit]
-   [taoensso.sente.server-adapters.http-kit :refer (sente-web-server-adapter)]

    ;; Watch tool config directory to automatically configure new tools
    [clojure-watch.core :refer [start-watch]]

-   ;; BinaryJS msg protocol
-   [aerial.msgpacket.binaryjs :as bjs :refer [newBinaryJsMsg]]
+   [com.rpl.specter :as sp]
+
+   [aerial.hanasu.server :as srv]
+   [aerial.hanasu.common :as com]

    [aerial.fs :as fs]
    [aerial.utils.misc :as aum]
-   [aerial.utils.io   :as aio]
+   [aerial.utils.io :as aio]
    [aerial.utils.string :as austr]
    [aerial.utils.coll :as coll :refer [in takev-until dropv-until ensure-vec]]

@@ -92,31 +91,203 @@
 ;;; Logging config
 ;;; (sente/set-logging-level! :trace) ; Uncomment for more logging

-;;; http-kit
-(defn start-web-server!* [ring-handler port]
-  (infof "Starting http-kit on port %s..." port)
-  (let [http-kit-stop-fn (http-kit/run-server ring-handler {:port port})]
-    {:server  nil ; http-kit doesn't expose this
-     :port    (:local-port (meta http-kit-stop-fn))
-     :stop-fn (fn [] (http-kit-stop-fn :timeout 100))}))
-
-
-(defn login!
-  "Here's where you'll add your server-side login/auth procedure (Friend, etc.).
-  In our simplified example we'll just always successfully authenticate the user
-  with whatever user-id they provided in the auth request."
-  [ring-request]
-  (let [{:keys [session params]} ring-request
-        {:keys [user-id]} params]
-    (debugf "Login request: %s" params)
-    {:status 200 :session (assoc session :uid user-id)}))
-
-(defn landing-pg-handler [req]
-  (hiccup/html
-    [:h1 "BinaryJS Test example"]
-    [:hr]
-    [:p [:strong "Not Intended to be used Manually..."]]
-    ))
+
+
+;;; ------------------------------------------------------------------------;;;
+;;;                    Tool Config and  Watcher                             ;;;
+;;; ------------------------------------------------------------------------;;;
+
+(def tool-configs (atom nil))
+
+(defn bind-env [f env]
+  (let [val (env :value)
+        done? (env :done)]
+    (if done?
+      env
+      (let [val (f val)]
+        (assoc env :value val :done? (or (nil? val) (= val :done)))))))
+
+(defn read-tool-config [f]
+  (infof "Tool update: %s" f)
+  (binding [*ns* (find-ns 'aerobio.server)]
+    (if (= "clj" (fs/ftype f))
+      (let [cfg (-> f slurp clojure.core/read-string)
+            func (cfg :func)]
+        (if (and func (or (symbol? func) (list? func)))
+          (assoc cfg :func (eval func) :src func)
+          cfg))
+      (-> f slurp (json/read-str :key-fn keyword)))))
+
+(defn read-tool-configs
+  []
+  (let [wd (fs/pwd)
+        srvdir (fs/join wd "services")
+        _ (assert (fs/directory? srvdir)
+                  (format "Services dir %s missing!!" srvdir))
+        configs (fs/re-directory-files srvdir #"\.(clj|js)")
+        toolinfo (reduce
+                  (fn[M f]
+                    (assoc M (-> f fs/basename (str/split #"\.") first)
+                           (read-tool-config f)))
+                  {} configs)]
+    toolinfo))
+
+
+(def _watcher (atom nil))
+
+(defmulti
+  ^{:doc "Dispatch dynamic tool config based on service file event"
+    :arglists '([event filename])}
+  config-tool
+  (fn [event filename] event))
+
+
+(defmethod config-tool :create
+  [_ f]
+  (swap! tool-configs
+         assoc (-> f fs/basename (str/split #"\.") first)
+         (read-tool-config f)))
+
+(defmethod config-tool :modify
+  [_ f]
+  (swap! tool-configs
+         assoc (-> f fs/basename (str/split #"\.") first)
+         (read-tool-config f)))
+
+(defmethod config-tool :delete
+  [_ f]
+  (swap! tool-configs
+         dissoc  (-> f fs/basename (str/split #"\.") first)))
+
+(defn stop-tool-watcher []
+  (when-let [stopw @_watcher] (stopw)))
+
+(defn start-tool-watcher []
+  (stop-tool-watcher)
+  (reset! _watcher
+          (start-watch
+           [{:path (fs/join (fs/pwd) "services")
+             :event-types [:create :modify :delete]
+             :bootstrap (fn[_](swap! tool-configs (fn[_] (read-tool-configs))))
+             :callback config-tool
+             :options {:recursive true}}])))
+
+(defn get-toolinfo [toolname]
+  (assert (@tool-configs toolname)
+          (format "No such tool %s" toolname))
+  (merge {:inputOption "" :options "" :args ""}
+         (@tool-configs toolname)))
+
+
+;;; ------------------------------------------------------------------------;;;
+;;;                     Job Config and  Watcher                             ;;;
+;;; ------------------------------------------------------------------------;;;
+
+(def job-configs (atom nil))
+
+(defn read-job-config [f]
+  (infof "Job update: %s" f)
+  (if (= "clj" (fs/ftype f))
+    (let [cfg (-> f slurp edn/read-string)
+          func (cfg :func)]
+      (if (and func (or (symbol? func) (list? func)))
+        (assoc cfg :func (eval func) :src func)
+        cfg))
+    (-> f slurp (json/read-str :key-fn keyword))))
+
+(defn read-job-configs
+  []
+  (let [wd (fs/pwd)
+        jobdir (fs/join wd "Jobs")
+        _ (assert (fs/directory? jobdir)
+                  (format "Jobs dir %s missing!!" jobdir))
+        configs (fs/re-directory-files jobdir #"\.(clj|js)")
+        jobinfo (reduce
+                  (fn[M f]
+                    (assoc M (-> f fs/basename (str/split #"\.") first)
+                           (read-job-config f)))
+                  {} configs)]
+    jobinfo))
+
+
+(def _job-watcher (atom nil))
+
+(defmulti
+  ^{:doc "Dispatch dynamic job config based on job file event"
+    :arglists '([event filename])}
+  config-job
+  (fn [event filename] event))
+
+
+(defmethod config-job :create
+  [_ f]
+  (swap! job-configs
+         assoc (-> f fs/basename (str/split #"\.") first)
+         (read-job-config f)))
+
+(defmethod config-job :modify
+  [_ f]
+  (swap! job-configs
+         assoc (-> f fs/basename (str/split #"\.") first)
+         (read-job-config f)))
+
+(defmethod config-job :delete
+  [_ f]
+  (swap! job-configs
+         dissoc  (-> f fs/basename (str/split #"\.") first)))
+
+(defn stop-job-watcher []
+  (when-let [stopw @_job-watcher] (stopw)))
+
+(defn start-job-watcher []
+  (stop-job-watcher)
+  (reset! _job-watcher
+          (start-watch
+           [{:path (fs/join (fs/pwd) "Jobs")
+             :event-types [:create :modify :delete]
+             :bootstrap (fn[_](swap! job-configs (fn[_] (read-job-configs))))
+             :callback config-job
+             :options {:recursive true}}])))
+
+(defn get-jobinfo [jobname]
+  (assert (@job-configs jobname)
+          (format "No such job %s" jobname))
+  (@job-configs jobname))
+
+
+;;; ------------------------------------------------------------------------;;;
+;;;                     Server communication database                       ;;;
+;;; ------------------------------------------------------------------------;;;
+
+(defn uuid [] (str (java.util.UUID/randomUUID)))
+
+(defonce app-bpsize 100)
+(defonce app-db (atom {:rcvcnt 0 :sntcnt 0}))
+
+(defn update-adb
+  ([] (com/update-db app-db {:rcvcnt 0 :sntcnt 0}))
+  ([keypath vorf]
+   (com/update-db app-db keypath vorf))
+  ([kp1 vof1 kp2 vof2 & kps-vs]
+   (apply com/update-db app-db kp1 vof1 kp2 vof2 kps-vs)))
+
+(defn get-adb
+  ([] (com/get-db app-db []))
+  ([key-path] (com/get-db app-db key-path)))
+
+
+;;; ------------------------------------------------------------------------;;;
+;;;                      Server routes and handlers                         ;;;
+;;; ------------------------------------------------------------------------;;;
+
+
+(defn landing-handler [request]
+  #_(infof "landing handler request: %s" request)
+  (content-type
+   {:status 200
+    :body (io/input-stream (io/resource "public/index.html"))}
+   "text/html"))
+

 (defn upload-file [args reqmap]
   (println :ARGS args)
@@ -136,15 +307,10 @@
      [:hr]
      [:ul
       (map #(vector :li [:a {:href (fs/join resource-dir (args :dir) %)} %])
-           files)]))
-  )
+           files)])))

 (def dbg (atom {}))
-
-(declare
- get-jobinfo
- get-toolinfo)

 (defn htseq-file-get [args reqmap]
   (infof "Args %s\nParams %s" args (reqmap :params))
@@ -199,623 +365,126 @@
          [:hr]
          [:p (str "Params" params)]
          [:hr]
-         [:p (str "User Agent: " user-agent)]
-         )))))
-
-(defn htseq-file-cmd [args reqmap]
-  {:body (json/json-str
-          {:stat "success"
-           :info [:NA :NA
-                  (str :args " "
-                       (->> args :file :tempfile slurp
-                            str/split-lines vec))]})})
-
-
-;;; ------------------------------------------------------------------------;;;
-;;;         Configure msgprotocol, Sente and Webserver Control              ;;;
-;;; ------------------------------------------------------------------------;;;
-
-(declare
- msgpacket
- ring-ajax-post
- ring-websocket
- recvchan
- chsk-send!
- connected-uids
- my-routes
- my-ring-handler
- )
-
-(defn config-sente []
-  (let [mp (newBinaryJsMsg) ; BinaryJS msg protocol
-        {:keys [ch-recv send-fn ajax-post-fn ajax-get-or-ws-handshake-fn
-                connected-uids]} (sente/make-channel-socket!
-                                  sente-web-server-adapter
-                                  {:msgpacket mp :recv-buf-or-n 1000})]
-
-    (alter-var-root #'msgpacket (constantly mp))
-    (alter-var-root #'ring-ajax-post (constantly ajax-post-fn))
-    (alter-var-root #'ring-websocket (constantly ajax-get-or-ws-handshake-fn))
-    ;; ChannelSocket's receive channel
-    (alter-var-root #'recvchan (constantly ch-recv))
-    ;; ChannelSocket's DEFAULT send API fn
-    (alter-var-root #'chsk-send! (constantly send-fn))
-    ;; Watchable, read-only atom
-    (alter-var-root #'connected-uids (constantly connected-uids))
-
-    ;; Setup routes
-    (alter-var-root
-     #'my-routes
-     (constantly
-      (comp/routes
-       #_(ANY "/htseq/cmd" []
-            {:status 200
-             :headers {
-                       "Access-Control-Allow-Origin" "*"
-                       "Access-Control-Allow-Headers" "Content-Type"
-                       }
-             :body body})
-       (GET  "/"      req (landing-pg-handler req))
-       ;;
-       (GET "/mlab/upld"   [:as reqmap & args] (upload-file args reqmap))
-       (POST "/mlab/upld"  [:as reqmap & args] (upload-file args reqmap))
-       ;; HTSeq route
-       (GET "/htseq/cmd"   [:as reqmap & args] (htseq-file-get args reqmap))
-       (POST "/htseq/cmd"  [:as reqmap & args] (htseq-file-cmd args reqmap))
-       ;; Websocket paths
-       (GET  "/chsk"  req (ring-websocket req))
-       (POST "/chsk"  req (ring-ajax-post req))
-       ;; Static files, notably public/main.js (our cljs target)
-       (route/resources "/" {:root "public"})
-       (route/not-found "
Page not found
"))))
-
-    ;; Setup ring middleware handlers
-    (alter-var-root
-     #'my-ring-handler
-     (constantly
-      (let [ring-defaults-config
-            (assoc-in
-             ring.middleware.defaults/site-defaults
-             [:security :anti-forgery] false
-             ;; Turn off anti-forgery as
-             #_{:read-token (fn [req]
-                            (infof "**** %s" req)
-                            #_(-> req :params :csrf-token)
-                            (get req "csrf-token"))})]
-
-        ;; NB: Sente requires the Ring `wrap-params` + `wrap-keyword-params`
-        ;; middleware to work. These are included with
-        ;; `ring.middleware.defaults/wrap-defaults` - but you'll need to ensure
-        ;; that they're included yourself if you're not using `wrap-defaults`.
-        (ring.middleware.defaults/wrap-defaults
-         my-routes
-         ring-defaults-config))))))
+         [:p (str "User Agent: " user-agent)])))))
+
+
+(def aerobio-routes
+  (apply routes
+         (conj (srv/hanasu-handlers)
+               (GET "/" request (landing-handler request))
+               (GET "/htseq/cmd"   [:as reqmap & args]
+                    (htseq-file-get args reqmap))
+               (route/resources "/"))))
+
+(def aerobio-handler
+  (-> aerobio-routes
+      #_(ring.middleware.defaults/wrap-defaults
+       ring.middleware.defaults/site-defaults)
+      #_(wrap-cljsjs)
+      #_(wrap-gzip)))
+
+
+;;; ------------------------------------------------------------------------;;;
+;;;                   Aerobio Application Messaging...                      ;;;
+;;; ------------------------------------------------------------------------;;;
+
+(defmulti user-msg :op)
+
+(defmethod user-msg :default [msg]
+  (infof "ERROR: unknown user message %s" msg)
+  #_(srv/send-msg
+   (msg :ws) {:op "error" :payload "ERROR: unknown user message"}))

 ;;; ------------------------------------------------------------------------;;;
 ;;;                Control  starting and stoping Webserver                  ;;;
 ;;; ------------------------------------------------------------------------;;;

-(declare
- start-tool-watcher
- stop-tool-watcher
- start-job-watcher
- stop-job-watcher
- event-msg-handler*
- reset-backstreams)
-
-(defonce web-server_ (atom nil)) ; {:server _ :port _ :stop-fn (fn [])}
-
-(defn stop-web-server! []
-  (when-let [m @web-server_]
-    ((:stop-fn m))))
-
-(defn start-web-server! [& [port]]
-  (stop-web-server!)
-  (let [{:keys [stop-fn port] :as server-map}
-        (start-web-server!*
-         (var my-ring-handler)
-         (or port 0)) ; 0 => auto (any available) port
-        uri (format "http://localhost:%s/" port)]
-    (infof "Web server is running at `%s`" uri)
-    #_(try
-      (.browse (java.awt.Desktop/getDesktop)
-               (java.net.URI. uri))
-      (catch java.awt.HeadlessException _))
-    (reset! web-server_ server-map)))
-
-
-(defonce router_ (atom nil))
-
-(defn  stop-router! []
-  (when-let [stop-f @router_] (stop-f)))
-
-(defn start-router! []
-  (stop-router!)
-  (reset! router_
-          (sente/start-chsk-router! recvchan msgpacket event-msg-handler*)))
-
-
-(defn start! [& [port]]
-  (config-sente)
+(defn msg-handler [msg]
+  (infof ":MSG-HANDLER :MSG %s" msg)
+  (let [{:keys [op data]} (msg :data)]
+    (case op
+      ;;null for now
+      (user-msg (msg :data)))))
+
+
+(defn on-open [ch op payload]
+  (let [ws payload
+        uid-name ((-> :idfn get-adb first))
+        connfn (-> :connfn get-adb first)
+        uuid (uuid)
+        uid {:uuid uuid :name uid-name}
+        data (connfn {:uid uid})
+        name-uuids (or (get-adb uid-name) [])]
+    (infof ":SRV :open %s" uid)
+    (update-adb [uuid :ws] ws, [uuid :name] uid-name
+                [uuid :rcvcnt] 0, [uuid :sntcnt] 0
+                [ws :uuid] uuid
+                uid-name (conj name-uuids uuid))
+    (srv/send-msg ws {:op :register :data data})))
+
+
+(defn server-dispatch [ch op payload]
+  (case op
+    :msg (let [{:keys [ws]} payload]
+           (msg-handler payload)
+           (update-adb :rcvcnt inc, [ws :rcvcnt] inc))
+
+    :open (on-open ch op payload)
+    :close (let [{:keys [ws status]} payload
+                 uuid (get-adb [ws :uuid])
+                 uuid-name (get-adb [uuid :name])
+                 uuids (get-adb uuid-name)]
+             (infof ":SRV :close :uuid %s, :uuid-name %s" uuid uuid-name)
+             (update-adb ws :rm, uuid :rm
+                         uuid-name (->> uuids (remove #(= uuid %)) vec)))
+
+    :bpwait (let [{:keys [ws msg encode]} payload
+                  uuid (get-adb [ws :uuid])]
+              (infof ":SRV :uuid %s - Waiting to send msg %s" uuid msg)
+              (update-adb [uuid :bpdata] {:msg msg, :encode encode}))
+    :bpresume (let [{:keys [ws msg]} payload
+                    uuid (get-adb [ws :uuid])
+                    encode ((get-adb [uuid :bpdata]) :encode)]
+                (infof ":SRV BP Resume :uuid %s" (get-adb [ws :uuid]))
+                (srv/send-msg ws msg :encode encode))
+
+    :sent (let [{:keys [ws msg]} payload]
+            #_(infof ":SRV Sent msg %s" msg)
+            (update-adb :sntcnt inc, [ws :sntcnt] 0))
+    :failsnd (infof ":SRV Failed send for {:op %s :payload %s}" op payload)
+
+    :stop (let [{:keys [cause]} payload]
+            (infof ":SRV Stopping reads... Cause %s" cause)
+            (update-adb)
+            (srv/stop-server))
+    (infof ":SRV :WTF {:op %s :payload %s}" op payload)))
+
+(defn start-server
+  [port]
+  (let [ch (srv/start-server port :main-handler aerobio-handler)]
+    (infof "Server start, reading msgs from %s" ch)
+    (update-adb :chan ch
+                :idfn [(partial gensym "aerobio-")]
+                :connfn [identity])
+    (go-loop [msg (<! ch)]
+      (let [{:keys [op payload]} msg]
+        (future (server-dispatch ch op payload))
+        (when (not= op :stop)
+          (recur (<! ch)))))))
+
+(defn stop-server []
+  (async/>!! (get-adb :chan) {:op :stop :payload {:cause :userstop}}))
+
+
+(defn start! [port]
   (timbre/set-level! :info) ; :debug
-  (reset-backstreams)
   (start-tool-watcher)
   (start-job-watcher)
-  (start-router!)
-  (if port
-    (start-web-server! port)
-    (start-web-server!)))
+  (start-server port))

 (defn stop! []
   (stop-tool-watcher)
   (stop-job-watcher)
-  (stop-web-server!)
-  (stop-router!))
-
-
-;;; ------------------------------------------------------------------------;;;
-;;;                    Tool Config and  Watcher                             ;;;
-;;; ------------------------------------------------------------------------;;;
-
-(def tool-configs (atom nil))
-
-(defn bind-env [f env]
-  (let [val (env :value)
-        done? (env :done)]
-    (if done?
-      env
-      (let [val (f val)]
-        (assoc env :value val :done? (or (nil? val) (= val :done)))))))
-
-(defn read-tool-config [f]
-  (infof "Tool update: %s" f)
-  (binding [*ns* (find-ns 'aerobio.server)]
-    (if (= "clj" (fs/ftype f))
-      (let [cfg (-> f slurp clojure.core/read-string)
-            func (cfg :func)]
-        (if (and func (or (symbol? func) (list? func)))
-          (assoc cfg :func (eval func) :src func)
-          cfg))
-      (-> f slurp (json/read-str :key-fn keyword)))))
-
-(defn read-tool-configs
-  []
-  (let [wd (fs/pwd)
-        srvdir (fs/join wd "services")
-        _ (assert (fs/directory? srvdir)
-                  (format "Services dir %s missing!!" srvdir))
-        configs (fs/re-directory-files srvdir #"\.(clj|js)")
-        toolinfo (reduce
-                  (fn[M f]
-                    (assoc M (-> f fs/basename (str/split #"\.") first)
-                           (read-tool-config f)))
-                  {} configs)]
-    toolinfo))
-
-
-(def _watcher (atom nil))
-
-(defmulti
-  ^{:doc "Dispatch dynamic tool config based on service file event"
-    :arglists '([event filename])}
-  config-tool
-  (fn [event filename] event))
-
-
-(defmethod config-tool :create
-  [_ f]
-  (swap! tool-configs
-         assoc (-> f fs/basename (str/split #"\.") first)
-         (read-tool-config f)))
-
-(defmethod config-tool :modify
-  [_ f]
-  (swap! tool-configs
-         assoc (-> f fs/basename (str/split #"\.") first)
-         (read-tool-config f)))
-
-(defmethod config-tool :delete
-  [_ f]
-  (swap! tool-configs
-         dissoc  (-> f fs/basename (str/split #"\.") first)))
-
-(defn stop-tool-watcher []
-  (when-let [stopw @_watcher] (stopw)))
-
-(defn start-tool-watcher []
-  (stop-tool-watcher)
-  (reset! _watcher
-          (start-watch
-           [{:path (fs/join (fs/pwd) "services")
-             :event-types [:create :modify :delete]
-             :bootstrap (fn[_](swap! tool-configs (fn[_] (read-tool-configs))))
-             :callback config-tool
-             :options {:recursive true}}])))
-
-
-;;; ------------------------------------------------------------------------;;;
-;;;                     Job Config and  Watcher                             ;;;
-;;; ------------------------------------------------------------------------;;;
-
-(def job-configs (atom nil))
-
-(defn read-job-config [f]
-  (infof "Job update: %s" f)
-  (if (= "clj" (fs/ftype f))
-    (let [cfg (-> f slurp edn/read-string)
-          func (cfg :func)]
-      (if (and func (or (symbol? func) (list? func)))
-        (assoc cfg :func (eval func) :src func)
-        cfg))
-    (-> f slurp (json/read-str :key-fn keyword))))
-
-(defn read-job-configs
-  []
-  (let [wd (fs/pwd)
-        jobdir (fs/join wd "Jobs")
-        _ (assert (fs/directory? jobdir)
-                  (format "Jobs dir %s missing!!" jobdir))
-        configs (fs/re-directory-files jobdir #"\.(clj|js)")
-        jobinfo (reduce
-                  (fn[M f]
-                    (assoc M (-> f fs/basename (str/split #"\.") first)
-                           (read-job-config f)))
-                  {} configs)]
-    jobinfo))
-
-
-(def _job-watcher (atom nil))
-
-(defmulti
-  ^{:doc "Dispatch dynamic job config based on job file event"
-    :arglists '([event filename])}
-  config-job
-  (fn [event filename] event))
-
-
-(defmethod config-job :create
-  [_ f]
-  (swap! job-configs
-         assoc (-> f fs/basename (str/split #"\.") first)
-         (read-job-config f)))
-
-(defmethod config-job :modify
-  [_ f]
-  (swap! job-configs
-         assoc (-> f fs/basename (str/split #"\.") first)
-         (read-job-config f)))
-
-(defmethod config-job :delete
-  [_ f]
-  (swap! job-configs
-         dissoc  (-> f fs/basename (str/split #"\.") first)))
-
-(defn stop-job-watcher []
-  (when-let [stopw @_job-watcher] (stopw)))
-
-(defn start-job-watcher []
-  (stop-job-watcher)
-  (reset! _job-watcher
-          (start-watch
-           [{:path (fs/join (fs/pwd) "Jobs")
-             :event-types [:create :modify :delete]
-             :bootstrap (fn[_](swap! job-configs (fn[_] (read-job-configs))))
-             :callback config-job
-             :options {:recursive true}}])))
-
-
-;;; ------------------------------------------------------------------------;;;
-;;;                         Message Handlers...                             ;;;
-;;; ------------------------------------------------------------------------;;;
-
-(defmulti event-msg-handler :id) ; Dispatch on event-id
-
-;; Wrap for logging, catching, etc.:
-(defn event-msg-handler*
-  [{:as ev-msg :keys [id msg client msgmap]}]
-  (tracef "Event: %s, %s" id msg)
-  (event-msg-handler ev-msg))
-
-
-(defmethod event-msg-handler :default ; Fallback
-  [{:as ev-msg :keys [id msg client msgmap]}]
-  (let [ring-req (msgmap :ring-req)
-        session (:session ring-req)
-        uid     (:uid     session)]
-    (debugf "Unhandled event: %s, %s" msg (:websocket? ring-req))))
-
-
-;;; ---------- Handle Connection Open and Close ---------- ;;;
-
-(def backstream-clients (atom {}))
-
-(defn reset-backstreams []
-  (reset! backstream-clients {}))
-
-(defmethod event-msg-handler :connection ; new connection
-  [{:as ev-msg :keys [id msg client msgmap]}]
-  (let [ring-req (msgmap :ring-req)
-        url (ring-req :url)]
-    (tracef "CONNECTION!: %s, %s" msg (:websocket? ring-req))))
-
-(defmethod event-msg-handler :close ; connection/client closed
-  [{:as ev-msg :keys [id msg client msgmap]}]
-  (debugf "Remove closed client: %s" client)
-  (when client
-    (swap! backstream-clients dissoc (client :connectionID))))
-
-
-;;; ---------- Handle Stream Data: Run and Proxy Commands ---------- ;;;
-
-(defn parse-url [url]
-  (if (not url)
-    {:query {}}
-    (let [protocol (-> url (str/split #"://") first)
-          [host url-params] (-> url (str/split #"\?"))
-          isproxy? (= host "http://client")
-          result {:protocol protocol :host host
-                  :url-params url-params :isprox isproxy?}]
-      (if (not url-params)
-        result
-        (let [pairs (->> (str/split url-params #"&")
-                         (filter #(not= % ""))
-                         (map #(str/split % #"="))
-                         (map #(let [[x y] %]
-                                 [(keyword x) (ruc/url-decode y)]))
-                         (into {}))]
-          (assoc result :query pairs))))))
-
-(defn <cmd
-  "Split string cmd on spaces unless spaces are in double
-   quotes (\"). However remove any leading/ending double quotes from
-   any resulting element.
-  "
-  [cmd]
-  (when cmd
-    (as-> cmd x (str/replace x #"\".+\"" #(str/replace % #" " "^"))
-          (str/split x #" +")
-          (mapv #(-> % (str/replace #"\^" " ")
-                       (str/replace #"(^\"|\"$)" "")) x))))
-
-(defn service? [x]
-  (re-find #"^(http|ws)%3A%2F%2F.+\.iobio" x))
-
-(defn get-tool-name [url & [tool]]
-  (assert (or url tool) "Run Params requires url or tool field")
-  (if tool tool
-      (->> url (re-find #"^(ws|http)://.+\.iobio") first
-           (#(str/split % #"(//|\.)")) second)))
-
-(defn adjust-args [args toolname path inputs]
-  (cond (and (= toolname "samtools") (seq inputs))
-        (apply vector (first args) "-" (rest args))
-
-        :else args))
-
-
-;;; --------------------------------------------------------------------------
-;;; Node pgm graph - named service defines sub program graph
-
-
-(defn config-inputs-rolled [lingraph edges ins args nodes]
-  #_(prn nodes)
-  (reduce
-   (fn[nodes n]
-     (let [invec (ins n)
-           node (nodes n)
-           inputs (mapv #(nodes %) invec)
-           numin (count inputs)
-           node (cond (= 0 (count inputs))
-                      node ; Root node
-
-                      (every? #(= 1 %) (->> n edges (map #(count (ins %)))))
-                      (assoc node :inputs (mapv #(nodes %) invec))
-
-                      :else
-                      (assoc node
-                        :inputs []
-                        :pipe (pg/get-pipe (node :id))
-                        :args (replace
-                               (pg/replacement-map
-                                #(vector %1 ((nodes %2) :url)) "%" invec)
-                               (node :args))))
-           node (pg/add-input-pipes node invec nodes)
-           node (assoc node
-                  :args (replace
-                         (pg/replacement-map
-                          #(vector %1 %2) "#" args)
-                         (node :args)))]
-       (assoc nodes n node)))
-   nodes lingraph))
-
-
-(defn unroll-node [N E node]
-  (cond
-   (vector? node)
-   (reduce (fn[V x]
-             (if (:tool x)
-               (let [i (unroll-node N E (x :inputs))
-                     iids (mapv :id (x :inputs))
-                     x (assoc x :inputs iids)]
-                 (swap! N assoc (x :id) x)
-                 (swap! E into (map #(vector %1 (conj (get E %1 []) %2))
-                                    iids (repeat (:id x))))
-                 (conj V (conj i (dissoc x :inputs))))
-               (do
-                 (swap! N assoc (x :id) x)
-                 [x])))
-           [] node)
-   node node
-   :else []))
-
-(defn unroll-pipeline [pipeline]
-  (if (not= (first pipeline) :rolled)
-    pipeline
-    ;; Else, legacy...
-    (let [N (atom {})
-          E (atom {})]
-      (unroll-node N E (coll/dropv 1 pipeline))
-      [@N @E])))
-
-;;; --------------------------------------------------------------------------
-
-
-(defn get-toolinfo [toolname]
-  (assert (@tool-configs toolname)
-          (format "No such tool %s" toolname))
-  (merge {:inputOption "" :options "" :args ""}
-         (@tool-configs toolname)))
-
-(defn get-jobinfo [jobname]
-  (assert (@job-configs jobname)
-          (format "No such job %s" jobname))
-  (@job-configs jobname))
-
-
-(defn flow-program
-  ""
-  [cfg & {:keys [run prn]}]
-  (assert (not (and run prn)) "FLOW-PROGRAM, run and prn mutually exclusive")
-  (let [cfg (-> cfg (pg/config-pgm-graph-nodes get-toolinfo nil nil)
-                pg/config-pgm-graph)]
-    (cond
-      run (->> cfg pg/make-flow-graph pg/run-flow-program)
-      prn (->> cfg clojure.pprint/pprint)
-      :else cfg)))
-
-
-(defn config-stream-pipe-inputs [services]
-  (reduce
-   (fn[V url] #_(debugf "*** V %s, URL %s" V url)
-     (let [toolname (get-tool-name url)
-           {:keys [graph path func src options inputOption defargs]}
-           (get-toolinfo toolname)
-
-           url-info (parse-url url)
-           params (reduce (fn[M [k v]] (assoc M k v)) {} (url-info :query))
-
-           raw-args (or (<cmd (params :cmd)) [])
-           [nxtsrvs args] (reduce (fn[[M A] a]
-                                    (if (service? a)
-                                      [(conj M (ruc/url-decode a)) A]
-                                      [M (conj A (ruc/url-decode a))]))
-                                  [[] []] raw-args)
-           args (->> args (filterv #(not= % inputOption))
-                     (concat options #_defargs) vec)
-           args (mapv (fn[a] (if (= (.charAt a 0) \')
-                               (.substring a 1 (dec (.length a))) a)) args)
-
-           {:keys [inputs args]}
-           (group-by (fn[x]
-                       (cond
-                        (re-find #"^http://client" x) :inputs
-
-                        (#{"tabix"} toolname) :args
-
-                        (re-find #"^http://" x)
-                        (if graph :inputs
-                            (if (not= x (last args)) :args :inputs))
-
-                        :else :args))
-                     args)
-
-           args (adjust-args args toolname path inputs)
-           inputs (mapv (fn[url]
-                          (let [info (parse-url url)
-                                isprox (info :isprox)
-                                urlmap {:id (gensym "http") :url url}
-                                qid (when isprox (get-in info [:query :id]))
-                                proxclient (when qid (@backstream-clients qid))]
-                            (if isprox
-                              (assoc urlmap
-                                :bsc proxclient :qid qid
-                                :msgpacket msgpacket)
-                              urlmap)))
-                        inputs)
-
-           inputs (vec (into inputs (config-stream-pipe-inputs nxtsrvs)))]
-
-       (conj V (cond
-                (map? graph)
-                (let [data (pg/node-graph graph inputs args)]
-                  ((apply config-inputs-rolled data) (-> data first last)))
-
-                :else
-                {:tool path :path path
-                 :func func :src src
-                 :id (gensym toolname)
-                 :inputs inputs :args args :inpipes [] :outpipes []}))))
-   [] services))
-
-
-(defn get-services [params]
-  (or (params :url)
-      (params :graph)))
-
-(defn get-stream-in [edges]
-  (let [ek (-> edges keys set)
-        ik (-> edges pg/edges->ins keys set)]
-    (first (set/difference ik ek))))
-
-(defn config-pipe-def [stream params]
-  (let [services (get-services params)
-        strmid (gensym (str "strm-" (stream :id) "-"))
-        strm-node {:tool "stream" :name "webstrm" :type "stream"
-                   :stream stream :id strmid :path "strm"}]
-    (if (map? services)
-      (let [{:keys [nodes edges]} services
-            si (get-stream-in edges)
-            graph {:nodes (assoc nodes (keyword strmid) strm-node)
-                   :edges (assoc edges si [(keyword strmid)])}]
-        (-> graph
-            (pg/config-pgm-graph-nodes get-toolinfo
-                                       backstream-clients msgpacket)
-            pg/config-pgm-graph))
-      [:rolled
-       (assoc strm-node
-         :inputs (config-stream-pipe-inputs (coll/ensure-vec services)))])))
-
-(def dfg-dbg (atom nil))
-
-(defn run-command [stream params]
-  (debugf "!!! RequestParams: %s" params)
-  (tracef ">>> Stream = %s" stream)
-  (let [cmdpath (-> (fs/pwd) (fs/join "bin"))
-        _ (assert (fs/directory? cmdpath)
-                  (str "aerobio home directory '" (fs/pwd)
-                       "' requires a 'bin' directory"))
-        pipeline-config (config-pipe-def stream params)
-        _ (debugf "PIPELINE-CONFIG: %s" pipeline-config)
-        node-futures (->> pipeline-config
-                          unroll-pipeline
-                          pg/make-flow-graph
-                          pg/run-flow-program)]
-    (swap! dfg-dbg (fn[_] node-futures))))
-
-
-
-(defmethod event-msg-handler :stream
-  [{:as ev-msg :keys [id msg client msgmap]}]
-  (let [clientid (client :id)
-        [_ [stream options]] msg
-        {:keys [event connectionID params]} options
-        op event]
-    (tracef "*** Params: Op=%s, ConnID=%s, Params=%s" op connectionID params)
-    (cond
-     (= op "setID") ; Obsolete, but neededd for backward compatibility...
-     (let [client (assoc client :connectionID connectionID)]
-       (swap! (msgmap :clients) assoc clientid client)
-       (swap! backstream-clients assoc connectionID client))
-
-     (= op "run")
-     (let [params (assoc params
-                    :protocol (get params :protocol "http")
-                    :returnEvent (get params :returneEvent "results")
-                    :encoding (if (params :binary) ; backwards compatibility
-                                "binary"
-                                (or (params :encoding) "utf8")))
-           setfields (stream :setfields)
-           ;; Set params in stream, in client stream map - Then refetch
-           stream ((setfields (stream :id) :params params) (stream :id))]
-       (run-command stream params)))))
+  (stop-server))
+


Add command line arguments for locating OLA daemon

--- src/afterglow/core.clj
+++ src/afterglow/core.clj
@@ -2,7 +2,9 @@
   "This is the main class for running Afterglow as a self-contained JAR application.
   When you are learning and experimenting in your REPL, the main
   namespace you want to be using is afterglow.examples"
-  (:require [afterglow.web.handler :refer [app]]
+  (:require [afterglow.ola-client :as ola-client]
+            [afterglow.version :as version]
+            [afterglow.web.handler :refer [app]]
             [afterglow.web.session :as session]
             [org.httpkit.server :as http-kit]
             [environ.core :refer [env]]
@@ -14,6 +16,7 @@
             [selmer.parser :as parser]
             [taoensso.timbre :as timbre]
             [taoensso.timbre.appenders.3rd-party.rotor :as rotor])
+  (:import [java.net InetAddress])
   (:gen-class))

 (defonce ^{:doc "Holds the running web UI server, if there is one, for later shutdown."}
@@ -76,6 +79,15 @@
    (reset! appenders appenders-map)
    (init-logging)))

+(defn- valid-host?
+  "Check whether a string represents a valid host name."
+  [name]
+  (try
+    (InetAddress/getByName name)
+    true
+    (catch Exception e
+      false)))
+
 (def cli-options
   "The command-line options supported by Afterglow."
   [["-w" "--web-port PORT" "Port number for web UI"
@@ -88,6 +100,13 @@
     :validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536"]]
    ["-r" "--repl-port PORT" "Port number for REPL, if desired"
     :default (env :repl-port)
+    :parse-fn #(Integer/parseInt %)
+    :validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536"]]
+   ["-h" "--olad-host HOST" "Host name or address of OLA daemon, if not local"
+    :default (or (env :olad-host) "localhost")
+    :validate [valid-host? "Must be a valid host name"]]
+   ["-p" "--olad-port PORT" "Port number OLA daemon is listening on"
+    :default (or (when-let [default (env :olad-port)] (Integer/parseInt default)) 9010)
     :parse-fn #(Integer/parseInt %)
     :validate [#(< 0 % 0x10000) "Must be a number between 0 and 65536"]]])

@@ -96,7 +115,8 @@
   [options-summary]
   (clojure.string/join
    \newline
-   ["Afterglow, a functional lighting control environment."
+   ["Afterglow, a live-coding environment for light shows."
+    (str "Version " (version/tag))
     ""
     "Usage: afterglow [options]"
     ""
@@ -186,7 +206,9 @@
       errors (exit 1 (str (error-msg errors) "\n\n" (usage summary))))
     (init-logging)
     (.addShutdownHook (Runtime/getRuntime) (Thread. stop-servers))
-    (clojure.pprint/pprint options)
+    (reset! ola-client/olad-host (:olad-host options))
+    (reset! ola-client/olad-port (:olad-port options))
+    (timbre/info "Will find OLA daemon on host" @ola-client/olad-host ", port" @ola-client/olad-port)
     (start-web-server (:web-port options) true)
     (timbre/info "Web UI server on port:" (:web-port options))
     (start-osc-server (:osc-port options))


Fix indentation.

Fix indentation.


Simplifying rowStr

Simplifying rowStr

--- src/app/operations.clj
+++ src/app/operations.clj
@@ -58,14 +58,10 @@
     (padStr (str s " ") len)))

 (defn rowStr [lengths values]
-  (if (empty? lengths)
-    ""
-    (str
-      (padStr (first values) (first lengths))
-      (if (not (empty? (rest lengths)))
-        columnSeparator
-        "")
-      (rowStr (rest lengths) (rest values)))))
+  (let
+    [paddedValues (map (fn [l v] (padStr v l)) lengths values)]
+    (apply str
+      (interpose columnSeparator paddedValues))))

 (defn sum [v]
   (apply + v))


Debug nrepl bindexception on openshift

Debug nrepl bindexception on openshift

--- modules/core/src/main/clojure/immutant/repl.clj
+++ modules/core/src/main/clojure/immutant/repl.clj
@@ -80,11 +80,12 @@
        ((util/try-resolve 'clojure.tools.nrepl.middleware/set-descriptor!)
         #'nrepl-init-handler {}))

+     (log/info "Starting nREPL for" (util/app-name)
+               "at" (str interface-address ":" port))
      (when-let [server ((util/try-resolve 'clojure.tools.nrepl.server/start-server)
                         :handler ((util/try-resolve 'clojure.tools.nrepl.server/default-handler) #'nrepl-init-handler)
                         :port (fix-port port) :host interface-address)]
-       (log/info "Starting nREPL for" (util/app-name)
-                 "at" (str interface-address ":" (-> server deref :ss .getLocalPort)))
+       (log/info "Bound to " (str interface-address ":" (-> server deref :ss .getLocalPort)))
        (util/at-exit (partial stop-nrepl server))
        server))
   ([port]


Update handler.clj

Update handler.clj

--- src/formula1/handler.clj
+++ src/formula1/handler.clj
@@ -18,6 +18,7 @@
 ;  (println x "Hello, World!"))

 (defroutes public-routes
+  (GET "/" [] (controller/index))
   (GET "/drivers" [] (controller/drivers))
   (route/resources "/")
   (GET "/drivers/new" [] (controller/new))


Change text in replace button to make it stand out as an action

Close #1753

--- src/lt/objs/search.cljs
+++ src/lt/objs/search.cljs
@@ -85,7 +85,7 @@
           (ctx/out! :searcher.replace)))

 (defui replace-all-button [this]
-  [:button.replace "all"]
+  [:button.replace "Replace All"]
   :click (fn [e]
            (cmd/exec! :searcher.replace-all)))


updated the assets to include prod and dev segment

--- src/frontend/stefon.clj
+++ src/frontend/stefon.clj
@@ -6,8 +6,10 @@
                       :url "https://js.pusher.com/2.2/pusher.min.js"}
                      {:path "js/hosted/elevio.js"
                       :url "https://static.elev.io/js/v3.js"}
-                     {:path "js/hosted/segment.js"
-                      :url "http://cdn.segment.com/analytics.js/v1/AbgkrgN4cbRhAVEwlzMkHbwvrXnxHh35/analytics.min.js"}])
+                     {:path "js/hosted/segment-mAJ9W2SwLHgmJtFkpaXWCbwEeNk9D8CZ.js"
+                      :url "https://cdn.segment.com/analytics.js/v1/mAJ9W2SwLHgmJtFkpaXWCbwEeNk9D8CZ/analytics.min.js"}
+                     {:path "js/hosted/segment-AbgkrgN4cbRhAVEwlzMkHbwvrXnxHh35.js"
+                      :url "https://cdn.segment.com/analytics.js/v1/AbgkrgN4cbRhAVEwlzMkHbwvrXnxHh35/analytics.min.js"}])

 (def asset-roots ["resources/assets"])


Fix link to braid bot docs

Fix link to braid bot docs

--- src/braid/core/client/bots/views/bots_page.cljs
+++ src/braid/core/client/bots/views/bots_page.cljs
@@ -132,7 +132,7 @@
         [:div.add-bot
          [:h2 "Add a New Bot"]
          [:p "For information on creating bots, see "
-          [:a {:href "https://github.com/braidchat/braid/blob/master/docs/dev/how-to/developing-bots.md"}
+          [:a {:href "https://github.com/braidchat/braid/blob/master/docs/dev/developing-bots.md"}
            "the documentation"] "."]
          (case @state


Fix column reordering bug (#648)

Fix column reordering bug (#648)

--- src/cljs/main/broadfcui/common/table_utils.cljs
+++ src/cljs/main/broadfcui/common/table_utils.cljs
@@ -177,38 +177,39 @@
                    (:header-row-style props))}
      (map-indexed
        (fn [index column]
-         (let [{:keys [header header-key width starting-width sort-by]} column
+         (let [{:keys [header header-key width starting-width sort-by visible?]} column
                sort-key (or header-key header)
                onResizeMouseDown
                (when (get column :resizable? (:resizable-columns? props))
                  (fn [e]
                    (swap! state assoc :dragging? true :mouse-x (.-clientX e) :drag-column index
                           :saved-user-select-state (common/disable-text-selection))))]
-           (render-cell
-             {:width width
-              :content header
-              :cell-style (when onResizeMouseDown {:borderRight (str "1px solid " (or (:resize-tab-color props) "#777777"))
-                                                   :marginRight -1})
-              :cell-padding-left (or (:cell-padding-left props) 0)
-              :content-container-style (merge
+           (when visible?
+             (render-cell
+              {:width width
+               :content header
+               :cell-style (when onResizeMouseDown {:borderRight (str "1px solid " (or (:resize-tab-color props) "#777777"))
+                                                    :marginRight -1})
+               :cell-padding-left (or (:cell-padding-left props) 0)
+               :content-container-style (merge
                                          {:padding (str "0.8em 0 0.8em "
                                                         (or (:cell-padding-left props) 0))}
                                          (:header-style props))
-              :onResizeMouseDown onResizeMouseDown
-              :onResizeDoubleClick #(swap! state assoc-in [:column-meta index :width] starting-width)
-              :onSortClick (when (and (or sort-by
-                                          (:sortable-columns? props))
-                                      (not= :none sort-by))
-                             (fn [_]
-                               (if (= sort-key sort-column)
-                                 (case sort-order
-                                   :asc (swap! state update :query-params assoc :sort-order :desc)
-                                   :desc (if (:always-sort? props)
-                                           (swap! state update :query-params assoc :sort-order :asc)
-                                           (swap! state update :query-params dissoc :sort-column :sort-order)))
-                                 (swap! state update :query-params assoc :sort-column sort-key :sort-order :asc))))
-              :sortOrder (when (= sort-key sort-column) sort-order)})))
-       (filter :visible? (react/call :get-ordered-columns this)))
+               :onResizeMouseDown onResizeMouseDown
+               :onResizeDoubleClick #(swap! state assoc-in [:column-meta index :width] starting-width)
+               :onSortClick (when (and (or sort-by
+                                           (:sortable-columns? props))
+                                       (not= :none sort-by))
+                              (fn [_]
+                                (if (= sort-key sort-column)
+                                  (case sort-order
+                                    :asc (swap! state update :query-params assoc :sort-order :desc)
+                                    :desc (if (:always-sort? props)
+                                            (swap! state update :query-params assoc :sort-order :asc)
+                                            (swap! state update :query-params dissoc :sort-column :sort-order)))
+                                  (swap! state update :query-params assoc :sort-column sort-key :sort-order :asc))))
+               :sortOrder (when (= sort-key sort-column) sort-order)}))))
+       (react/call :get-ordered-columns this))
      (common/clear-both)]))

 (react/defc FilterGroupBar


Bump catalog/report wire format versions for the benchmark tool

--- src/com/puppetlabs/puppetdb/cli/benchmark.clj
+++ src/com/puppetlabs/puppetdb/cli/benchmark.clj
@@ -78,7 +78,7 @@
   command-processing endpoint located at `puppetdb-host`:`puppetdb-port`."
   [puppetdb-host puppetdb-port catalog]
   (let [result (command/submit-command-via-http! puppetdb-host puppetdb-port
-                 (command-names :replace-catalog) 1 (json/generate-string catalog))]
+                 (command-names :replace-catalog) 4 (json/generate-string catalog))]
     (when-not (= pl-http/status-ok (:status result))
       (log/error result))))

@@ -88,7 +88,7 @@
   [puppetdb-host puppetdb-port report]
   (let [result (command/submit-command-via-http!
                  puppetdb-host puppetdb-port
-                 (command-names :store-report) 1 report)]
+                 (command-names :store-report) 3 report)]
     (when-not (= pl-http/status-ok (:status result))
       (log/error result))))


refactor classify-line

refactor classify-line

--- src/me/panzoo/story.clj
+++ src/me/panzoo/story.clj
@@ -272,20 +272,28 @@
 ; Each line of a source file will be either code, comment, anchor, or include.
 ; Headings are treated as both anchors and comments.
 (defn classify-line
+  ""
+  [[line :as lines]]
+  (letfn [(match? [reg] (re-find (reg) line))]
+    (cond-let
+      [match]
+      (match? include) [[:include (string/split
+                                    (.substring line (count match)) #"\s+")]]
+      (match? anchor) [[:anchor (.substring line (count match))]]
+      (match? heading) [[:anchor (.substring line (count match))]
+                        [:comment (.substring
+                                    line (count (match? comment)))]]
+      (match? comment) [[:comment (.substring line (count match))]]
+      :else [[:code line]])))
+
+(defn classify-lines
   "Classify a line as :code or :comment. Return a pair of the classification
   and line string, sans leading comment tokens in the case of a comment."
-  [line]
-  (letfn [(match? [reg] (re-find (reg) line))]
-    (concat
-      (cond-let [match]
-        (match? include) [[:include (string/split
-                                      (.substring line (count match)) #"\s+")]]
-        (match? anchor) [[:anchor (.substring line (count match))]]
-        (match? heading) [[:anchor (.substring line (count match))]
-                          [:comment (.substring
-                                      line (count (match? comment)))]]
-        (match? comment) [[:comment (.substring line (count match))]]
-        :else [[:code line]]))))
+  [lines]
+  (loop [lines lines acc []]
+    (if (seq lines)
+      (recur (rest lines) (conj acc (classify-line lines)))
+      (apply concat acc))))

 ; Adjacent lines of the same classification need to be gathered together into
 ; a single string except for anchors and includes.
@@ -299,7 +307,7 @@
         (cons (first lines) (gather-lines- (rest lines)))))))

 (defn gather-lines [lines]
-  (gather-lines- (apply concat (map classify-line lines))))
+  (gather-lines- (classify-lines lines)))

 ; The result of gathering is a list of pairs of the form
 ; `[<classification> <data>]`.


+[babel.generate/try-hard-to]

+[babel.generate/try-hard-to]

--- src/babel/english.cljc
+++ src/babel/english.cljc
@@ -3,7 +3,7 @@
   (:require
    [dag_unify.core :refer (fail-path get-in unifyc)]
    [babel.engine :as engine]
-   [babel.generate :as generate]
+   [babel.generate :as generate :refer [try-hard-to]]
    [babel.english.grammar :refer [medium small-plus-vp-pronoun small-plus-plus-np]]
    [babel.english.morphology :as morph :refer [fo]]
    [babel.over :refer [over]]


Add test for BlobRef TaggedValue extension.

--- test/vault/blob_test.clj
+++ test/vault/blob_test.clj
@@ -1,6 +1,7 @@
 (ns vault.blob-test
   (:require [clojure.test :refer :all]
-            [vault.blob :refer :all]))
+            [vault.blob :refer :all]
+            [vault.print :refer [edn-tag edn-value]]))

 (def blob-content
@@ -36,6 +37,11 @@
     (is (= (with-out-str (pr blob-ref)) (str "#vault/ref " \" blob-address \")))))

+(deftest edn-representation
+  (is (= 'vault/ref (edn-tag blob-ref)))
+  (is (= blob-address (edn-value blob-ref))))
+
+
 (deftest address-parsing
   (testing "parse-address"
     (are [addr] (= (parse-address addr) blob-ref)


Adjust some docstrings.

Adjust some docstrings.

--- src/multicodec/core.clj
+++ src/multicodec/core.clj
@@ -15,13 +15,13 @@
   127)

-(def ^java.nio.charset.Charset header-charset
+(def ^:no-doc ^java.nio.charset.Charset header-charset
   "The character set that codec headers are encoded with."
   (Charset/forName "UTF-8"))

 (def paths
-  "Map of codec keywords to header paths. Drawn from the multicodec standards
+  "Map of codec keywords to header paths, drawn from the multicodec standards
   document."
   {:binary "/bin/"  ; raw binary
    :base2  "/b2/"   ; ascii base-2 (binary)
@@ -54,9 +54,9 @@
 ;; ## Encoding

 (defn encode-header
-  "Return the byte-encoded version of the given header path.
+  "Returns the byte-encoding of the header path.

-  The given path is trimmed and has a newline appended to it before encoding."
+  The path is trimmed and has a newline appended to it before encoding."
   ^bytes
   [path]
   (let [path-bytes (-> path (str/trim) (str "\n") (.getBytes header-charset))


CMR-1600: Change to use get-keys-in function in common utils

--- search-app/src/cmr/search/services/json_parameters/conversion.clj
+++ search-app/src/cmr/search/services/json_parameters/conversion.clj
@@ -5,7 +5,7 @@
             [cmr.common.services.errors :as errors]
             [cmr.search.models.query :as qm]
             [cmr.search.models.group-query-conditions :as gc]
-            [cmr.common.util :as u]
+            [cmr.common.util :as util]
             [cmr.search.services.parameters.legacy-parameters :as lp]
             [cmr.common.concepts :as cc]
             [cmr.common.date-time-parser :as parser]
@@ -75,26 +75,10 @@
   [condition-name value]
   (qm/negated-condition (parse-json-condition-map value)))

-(defn- get-keys
-  "Returns all of the keys from a nested map"
-  [m]
-  (cond
-    (map? m)
-    (for [[k v] m]
-      (conj (get-keys v) k))
-    (sequential? m)
-    (for [v m]
-      (get-keys v))))
-
-(defn- get-unique-keys
-  "Returns a set of keys from a nested map"
-  [m]
-  (set (flatten (get-keys m))))
-
 (defn- validate-json-conditions
   "Validates that the condition names in the query are valid"
   [concept-type json-query]
-  (let [all-condition-names (get-unique-keys json-query)
+  (let [all-condition-names (util/get-keys-in json-query)
         valid-conditions (get valid-conditions-for-concept-type concept-type)
         invalid-conditions (set/difference all-condition-names valid-conditions)]
     (when (seq invalid-conditions)
@@ -106,7 +90,7 @@
   "Converts a JSON query string and query parameters into a query model."
   [concept-type params json-string]
   (let [params (pv/validate-standard-query-parameters concept-type params)
-        json-query (u/map-keys->kebab-case (json/parse-string json-string true))]
+        json-query (util/map-keys->kebab-case (json/parse-string json-string true))]
     (validate-json-conditions concept-type json-query)
     (qm/query (assoc (pc/standard-params->query-attribs concept-type params)
                      :concept-type concept-type


CMR-1758: Refactor additional attribute condition search

--- search-app/src/cmr/search/services/json_parameters/conversion.clj
+++ search-app/src/cmr/search/services/json_parameters/conversion.clj
@@ -197,40 +197,31 @@
 (defmethod parse-json-condition :attribute
   [_ value]
   ;; (validate-attribute-condition value) - either update JSON schema or validate it here
-  (let [{:keys [name group type value min-value max-value exclude-boundary pattern]} value
-        type (keyword type)
-        parser-fn (attribute-type->parser-fn type)
-        value (parse-value parser-fn value)
-        min-value (parse-value parser-fn min-value)
-        max-value (parse-value parser-fn max-value)]
-
+  (let [parser-fn (attribute-type->parser-fn (keyword (:type value)))
+        parse-value-fn (partial parse-value parser-fn)
+        condition (-> value
+                      (update-in [:type] keyword)
+                      (update-in [:value] parse-value-fn)
+                      (update-in [:min-value] parse-value-fn)
+                      (update-in [:max-value] parse-value-fn)
+                      (set/rename-keys {:exclude-boundary :exclusive?
+                                        :pattern :pattern?}))]
     (cond
       ;; Range search
-      (or (some? min-value) (some? max-value))
-      (qm/map->AttributeRangeCondition {:type type
-                                        :name name
-                                        :group group
-                                        :min-value min-value
-                                        :max-value max-value
-                                        :exclusive? exclude-boundary})
+      (or (some? (:min-value condition)) (some? (:max-value condition)))
+      (qm/map->AttributeRangeCondition condition)

       ;; Exact value search
-      (some? value)
-      (qm/map->AttributeValueCondition {:type type
-                                        :name name
-                                        :group group
-                                        :value value})
+      (some? (:value condition))
+      (qm/map->AttributeValueCondition condition)

       ;; Attribute name search
-      (some? name)
-      (qm/map->AttributeNameCondition {:name name
-                                       :group group
-                                       :pattern? pattern})
+      (some? (:name condition))
+      (qm/map->AttributeNameCondition condition)

       ;; Attribute group search
-      (some? group)
-      (qm/map->AttributeGroupCondition {:group group
-                                        :pattern? pattern})
+      (some? (:group condition))
+      (qm/map->AttributeGroupCondition condition)

       ;; Validation should have caught any other case
       :else


More on atoms -- tidy separators.

More on atoms -- tidy separators.


Store book names

Store book names

--- src/bookshelf/core.clj
+++ src/bookshelf/core.clj
@@ -41,13 +41,13 @@
 (defn populate-db []
   (for [file (library-files)]
     (sql/insert! db :books
-                 {:name "name"
+                 {:name (.getName file)
                   :hash (md5/md5-file file)
                   :size (.length file)
                   :path (.getPath file)})))

 (defn library-files-html []
-  (let [rows (sql/query db "SELECT * FROM books")
+  (let [rows (sql/query db "SELECT * FROM books ORDER BY name")
         counts (frequencies (map :hash rows))]
     (hiccup/html5
      [:head


Add exclusions to from-java

Add exclusions to from-java

--- src/munge_tout/core.clj
+++ src/munge_tout/core.clj
@@ -4,53 +4,52 @@
   (:require [munge-tout.util :refer :all]
             [munge-tout.generics :refer :all]))

-(def ignorable? #{:class})
-
 (defn leave?
   [v]
   (or (instance? Boolean v)
       (number? v)
       (string? v)))

-(declare from-java)
-(defn from-java*
+(declare from-java*)
+(defn from-java
   ([jovo]
-   (from-java* jovo {}))
+   (from-java jovo {}))
   ([jovo conf]
-   (if (leave? jovo)
-     jovo
-     (into {}
-           (for
-             [[k v] (bean jovo) :when (not (ignorable? k))]
-             [(keyword (camel-case-to-hyphenated (name k))) (from-java v)])))))
-
-(defprotocol Mungeable (from-java [jovo]))
+   (let [ignorable? (into #{:class} (:exclusions conf))]
+     (if (leave? jovo)
+       jovo
+       (into {}
+             (for
+               [[k v] (bean jovo) :when (not (ignorable? k))]
+               [(keyword (camel-case-to-hyphenated (name k))) (from-java* v)]))))))
+
+(defprotocol Mungeable (from-java* [jovo]))

 (extend-protocol Mungeable
   nil
-  (from-java
+  (from-java*
     [_]
     nil)
   Enum
-  (from-java
+  (from-java*
     [enum]
     (.name enum))
   Map
-  (from-java
+  (from-java*
     [m]
     (into {} m))
   Set
-  (from-java
+  (from-java*
     [s]
     (into #{} s))
   Iterable
-  (from-java
+  (from-java*
     [s]
     (map from-java (seq s)))
   Object
-  (from-java
+  (from-java*
     [jovo]
-    (from-java* jovo)))
+    (from-java jovo)))

 ;; Reverse magic mapping from a map into a java class.


Remove builtin crypto primitives related to jwe.

That are replaced with buddy-core implementation of them.

--- src/buddy/sign/jwe.clj
+++ src/buddy/sign/jwe.clj
@@ -40,111 +40,6 @@
   (:import clojure.lang.Keyword
            org.bouncycastle.crypto.InvalidCipherTextException
            java.nio.ByteBuffer))
-
-(def keylength? #(= (count %1) %2))
-(def ivlength? #(= (count %1) %2))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Crypto primitives/helpers.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- split-by-blocksize
-  "Split a byte array in blocksize blocks.
-  Given a arbitrary size bytearray and block size in bytes,
-  returns a lazy sequence of bytearray blocks of blocksize
-  size. If last block does not have enought data for fill
-  all block, it is padded using zerobyte padding."
-  ([^bytes input ^long blocksize]
-   (split-by-blocksize input blocksize true))
-  ([^bytes input ^long blocksize additional]
-   (let [inputsize (count input)]
-     (loop [cursormin 0
-            cursormax blocksize
-            remain inputsize
-            result []]
-       (cond
-         (= remain 0)
-         (if additional
-           (conj result (byte-array blocksize))
-           result)
-
-         (< remain blocksize)
-         (let [buffer (byte-array blocksize)]
-           (System/arraycopy input cursormin buffer 0 remain)
-           (conj result buffer))
-
-         (>= remain blocksize)
-         (let [buffer (byte-array blocksize)]
-           (System/arraycopy input cursormin buffer 0 blocksize)
-           (recur cursormax
-                  (+ cursormax blocksize)
-                  (- inputsize cursormax)
-                  (conj result buffer))))))))
-
-(defn- encrypt-cbc
-  [cipher input key iv]
-  (let [blocksize (crypto/get-block-size cipher)
-        blocks (split-by-blocksize input blocksize)]
-    (crypto/initialize! cipher {:op :encrypt :iv iv :key key})
-    (apply bytes/concat
-           (reduce (fn [acc block]
-                     (let [padnum (padding/count block :zerobyte)
-                           length (count block)]
-                       (when (> padnum 0)
-                         (padding/pad! block (- length padnum) :pkcs7))
-                       (let [eblock (crypto/process-block! cipher block)]
-                         (conj acc eblock))))
-                   [] blocks))))
-
-(defn- decrypt-cbc
-  [cipher input key iv]
-  (let [blocksize (crypto/get-block-size cipher)
-        blocks (split-by-blocksize input blocksize false)]
-    (crypto/initialize! cipher {:op :decrypt :iv iv :key key})
-    (apply bytes/concat
-           (reduce (fn [acc block]
-                     (let [block (crypto/process-block! cipher block)]
-                       (when (padding/padded? block :pkcs7)
-                         (padding/unpad! block :pkcs7))
-                       (conj acc block)))
-                   [] blocks))))
-
-(defn- encrypt-gcm
-  [input key iv aad]
-  (let [cipher (crypto/block-cipher :aes :gcm)]
-    (crypto/initialize! cipher {:iv iv :key key :tagsize 128 :op :encrypt :aad aad})
-    (let [outputlength (crypto/get-output-size cipher (count input))
-          output (byte-array outputlength)
-          offset (crypto/process-block! cipher input 0 output 0)]
-      (try+
-        (crypto/calculate-authtag! cipher output offset)
-        (catch InvalidCipherTextException e
-          (let [message (str "Couldn't generate gcm authentication tag: " (.getMessage e))]
-            (throw+ {:type :encryption :cause :authtag :message message} e))))
-      (let [ciphertextlength (- outputlength 16)
-            ciphertext (byte-array ciphertextlength)
-            authtag (byte-array 16)]
-        (System/arraycopy output 0 ciphertext 0 ciphertextlength)
-        (System/arraycopy output ciphertextlength, authtag 0 16)
-        [ciphertext authtag]))))
-
-(defn- decrypt-gcm
-  [ciphertext authtag key iv aad]
-  (let [cipher (crypto/block-cipher :aes :gcm)
-        inputlength (+ (count ciphertext) (count authtag))
-        input (byte-array inputlength)]
-    (crypto/initialize! cipher {:iv iv :key key :tagsize 128 :op :decrypt :aad aad})
-    (System/arraycopy ciphertext 0 input 0 (count ciphertext))
-    (System/arraycopy authtag 0 input (count ciphertext) (count authtag))
-    (let [outputlength (crypto/get-output-size cipher inputlength)
-          output (byte-array outputlength)
-          offset (crypto/process-block! cipher input 0 output 0)]
-      (try+
-        (crypto/calculate-authtag! cipher output offset)
-        (catch InvalidCipherTextException e
-          (let [message (str "Couldn't validate gcm authentication tag: " (.getMessage e))]
-            (throw+ {:type :validation :cause :authtag :message message} e))))
-      output)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation details


Remove debug code

Remove debug code

--- src/harnocode/core.cljs
+++ src/harnocode/core.cljs
@@ -142,7 +142,6 @@
         unused               (arrange-unused ts-unused 160)
         result (concat arranged unused)
         ]
-    (println unused)
     (string/join "\n" result)              ; img must be resized by now, no need in w
     ))


nbsp is not good idea in formats

nbsp is not good idea in formats

--- src/ontrail/formats.clj
+++ src/ontrail/formats.clj
@@ -17,12 +17,12 @@
 (defn to-human-pace-minkm [duration distance]
   (let [pace  (/ (/ duration 6000) (/ distance 1000))
         secs (int (* 60.0 (- pace (int pace))))]
-    (str (int pace) "." (format "%02d" secs) " min/km")))
+    (str (int pace) "." (format "%02d" secs) " min/km")))

 (defn to-human-pace-kmh [duration distance]
   (let [speed (/ (/ distance 1000.0) (/ duration 360000.0))
         fraction (int (* 10 (- speed (int speed))))]
-    (str (int speed) "," (format "%01d" fraction) " km/h")))
+    (str (int speed) "," (format "%01d" fraction) " km/h")))

 (defn pace-conversion-fun [sport]
   (case sport
@@ -42,7 +42,7 @@
   (let [{:keys [duration distance avghr]} exercise
         {:keys [resthr]} profile]
     (if (positive-numbers? (list resthr duration distance avghr))
-        (string/replace (format "%.2f m/b" (/ distance (* (- avghr resthr) duration (double (/ 1 6000))))) #"\." ","))))
+        (string/replace (format "%.2f m/b" (/ distance (* (- avghr resthr) duration (double (/ 1 6000))))) #"\." ","))))

 (defn to-human-distance [distance]
   (if (= nil distance)
@@ -52,8 +52,8 @@
           m-as-str (str "," m)]
     (if (> km 0)
       (if (= m 0)
-        (str km " km")
-        (str km "," (string/replace  (format "%03d" (int m)) #"0+$" "")  " km"))
+        (str km " km")
+        (str km "," (string/replace  (format "%03d" (int m)) #"0+$" "")  " km"))
       (if (> m 0)
         (str (int m) "m")
         "")))))
@@ -78,13 +78,13 @@

 (defn seconds-part [seconds hundreds]
   (if (> hundreds 0)
-    (str seconds "," (format "%02d" (int hundreds)) " s")
-    (str seconds " s")))
+    (str seconds "," (format "%02d" (int hundreds)) " s")
+    (str seconds " s")))

 (defn minutes-part [minutes seconds]
   (if (> seconds 0)
-    (str minutes " min " seconds " s")
-    (str minutes " min")))
+    (str minutes " min " seconds " s")
+    (str minutes " min")))

 (defn to-human-time [duration]
   (try
@@ -96,11 +96,11 @@
             hours (int (/ duration 360000))]
         (if (> hours 0)
           (if (or (> minutes 0) (> seconds 0))
-            (str hours " h " (minutes-part minutes seconds))
-            (str hours " h"))
+            (str hours " h " (minutes-part minutes seconds))
+            (str hours " h"))
           (if (or (> seconds 0) (> hundreds 0))
-              (str minutes " min " (seconds-part seconds hundreds))
-              (str minutes " min")))))
+              (str minutes " min " (seconds-part seconds hundreds))
+              (str minutes " min")))))
     (catch Exception exception#
       (.error logger (str exception# duration))
       "NaN")))


Refresh screen after drag/drop done.

Refresh screen after drag/drop done.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -38,15 +38,14 @@

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

+(def net-addrs-g (atom {})) ; Last output of net-main render-net-addrs-to-el.
+
+(def addr-override-xy-g (atom {})) ; Explicit xy's (ex: drag/drop) of addr positions.
+
 (defn addr-attrs-fn [addr]
   (str "onmousedown=\"return startDrag('loc', 'addr-" addr "', null, onDragNetAddrDone);\""))

-(def addr-override-xy-g (atom {}))
-
-(defn addr-override-xy [addr x y]
-  (swap! addr-override-xy-g #(assoc % addr [x y])))
-
-(defn render-net [target-el-id net prev-addrs]
+(defn render-net-addrs-to-el [target-el-id net prev-addrs]
   (let [[addrs h]
         (cbfg.world.net/render-net-html net prev-addrs
                                         :addr-attrs-fn addr-attrs-fn
@@ -54,7 +53,12 @@
     (set-el-innerHTML target-el-id (apply str (flatten h)))
     addrs))

-(def net-addrs (atom {}))
+(defn render-net-addrs [net]
+  (swap! net-addrs-g #(render-net-addrs-to-el "net-main" net %)))
+
+(defn addr-override-xy [addr x y]
+  (swap! addr-override-xy-g #(assoc % addr [x y]))
+  (render-net-addrs (:net @prog-curr)))

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

@@ -118,7 +122,7 @@
 ; -------------------------------------------------------------------

 (defn on-prog-frame-focus [prog-frame]
-  (render-net "net-hover" (:net prog-frame) {})
+  (render-net-addrs-to-el "net-hover" (:net prog-frame) {})
   (.add gdom/classes (gdom/getElement "net-container") "hover"))

 (defn on-prog-frame-blur []
@@ -133,7 +137,7 @@
     (swap! prog-evts #(vec (filter (fn [[s & _]] (<= s ts)) %)))
     (swap! prog-ss #(into {} (filter (fn [[s _]] (<= s ts)) %)))
     (set-el-innerHTML "reqs" (render-reqs-html (:reqs prog-frame)))
-    (render-net "net-main" (:net prog-frame) @net-addrs)
+    (render-net-addrs-to-el "net-main" (:net prog-frame) {})
     (on-prog-frame-blur)))

 ; -------------------------------------------------------------------
@@ -227,7 +231,7 @@
                      (when-let [net (get-in vis [:actxs @net-actx :loop-state])]
                        (when (not= net (:net @prog-curr))
                          (swap! prog-curr #(assoc % :net net))
-                         (swap! net-addrs #(render-net "net-main" net %)))))]
+                         (render-net-addrs net))))]
         (prog-init world)
         (cbfg.vis/process-events vis event-delay cbfg.vis/vis-event-handlers
                                  event-ch step-ch event-run-ch)


hopefully fix the ping job bug

hopefully fix the ping job bug

--- src/pc/http/talaria.clj
+++ src/pc/http/talaria.clj
@@ -186,7 +186,11 @@
     (let [id (ch-id ch)
           msg-ch (:msg-ch @tal-state)
           ping-job (setup-ping-job tal-state id)]
-      (add-channel tal-state id ch ping-job)
+      (try
+       (add-channel tal-state id ch ping-job)
+       (catch java.lang.AssertionError e
+         (.cancel ping-job false)
+         (throw e)))
       (handle-message tal-state {:op :tal/channel-open
                                  :tal/ch ch
                                  :tal/ch-id id
@@ -274,7 +278,11 @@
 (defn handle-ajax-open [tal-state ch-id ring-req]
   (let [msg-ch (:msg-ch @tal-state)]
     (let [ping-job (setup-ping-job tal-state ch-id)
-          ch-count (get-in (add-channel tal-state ch-id nil ping-job)
+          new-state (try (add-channel tal-state ch-id nil ping-job)
+                         (catch java.lang.AssertionError e
+                           (.cancel ping-job false)
+                           (throw e)))
+          ch-count (get-in new-state
                            [:connections ch-id :ajax-channel-count])]
       (schedule-ajax-cleanup tal-state ch-id ring-req ch-count))
     (handle-message tal-state {:op :tal/channel-open


fix gear animator to work for multiple svgs

--- src/parinfer/gears.cljs
+++ src/parinfer/gears.cljs
@@ -98,12 +98,16 @@

       (.attr gear-obj (name k) v))))

-(defonce reload-index (atom 0))
+(defonce reload-indexes (atom {}))

 (defn animate-gears!
-  [svg gear-map gear-array anim-frames]
+  [svg selector gear-map gear-array anim-frames]

-  (let [index (swap! reload-index inc)]
+  (let [update-index #(inc (or % 0))
+        _ (swap! reload-indexes update selector update-index)
+        latest-index #(get @reload-indexes selector)
+        index (latest-index)
+        should-continue? #(= index (latest-index))]

     (when (seq anim-frames)
       (go-loop []
@@ -112,17 +116,13 @@
             (apply-gear-attrs! (gear-map key-) attrs))
           (js/Gear.updateGears gear-array)
           (<! (timeout dt)))
-
-        ;; only continue if this is still the active timer
-        (when (= index @reload-index)
+        (when (should-continue?)
           (recur)))

       (js/d3.timer
         (fn []
           (tick-svg! svg)
-
-          ;; only continue if this is still the active timer
-          (not= index @reload-index))))))
+          (not (should-continue?)))))))

 (defn create-gears!
   [selector
@@ -148,4 +148,4 @@
     (doseq [g gear-objs]
       (.push gear-array g))

-    (animate-gears! svg gear-map gear-array anim-frames)))
+    (animate-gears! svg selector gear-map gear-array anim-frames)))


Playing

Playing

--- src/kafka_test/core.clj
+++ src/kafka_test/core.clj
@@ -1,30 +1,81 @@
 (ns kafka-test.core
   (:require [com.stuartsierra.component :as component]
-            [clojure.core.async :as async :refer :all]))
+            [clojure.core.async :as async :refer [go go-loop chan <! close! put!]]
+            [clj-kafka.core :as kafka-core]
+            [clj-kafka.new.producer :as kafka]
+            [clj-kafka.consumer.zk :as kafka-zk]))

-(defn start-queue! [queue-chan]
-  (go-loop []
-    (let [x (<! c)]
-      (println "Got a value in this loop:" x))
-    (recur)))
+(defn start-queue! [c host port]
+  (with-open [p (kafka/producer {"bootstrap.servers" (str host ":" port)}
+                                (kafka/byte-array-serializer)
+                                (kafka/byte-array-serializer))]
+    (go-loop []
+      (println "Waiting to produce...")
+      (if-let [x (<! c)]
+        (do
+          (println "Producing =>" x)
+          (kafka/send p (kafka/record "test-topic" (.getBytes (str x))))
+          (println "Done")
+          (recur))))))

-(defrecord KafkaProducer [host port connection]
+(defrecord KafkaProducer [host port]
   component/Lifecycle
   (start [component]
-    (println ";; Starting producer...")
+    (println ";; Starting producer..." host port)
     (let [queue-chan (chan 50)]
-      (start-queue! queue-chan)
+      (start-queue! queue-chan host port)
       (assoc component :queue queue-chan)))

   (stop [component]
-    (println ";; Stopping database")
-    ;; In the 'stop' method, shut down the running
-    ;; component and release any external resources it has
-    ;; acquired.
-    (.close connection)
-    ;; Return the component, optionally modified. Remember that if you
-    ;; dissoc one of a record's base fields, you get a plain map.
-    (assoc component :connection nil)))
+    (println ";; Stopping producer...")
+    (close! (:queue component))
+    (assoc component :queue nil)))
+
+(defn new-kafka-producer [host port]
+  (map->KafkaProducer {:host host :port port}))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn do-message!
+  [msg]
+  (println "Consuming <=" msg))
+
+(defn start-listening! [host port]
+  (go
+    (let [config {"zookeeper.connect" (str host ":" port)
+                  "group.id" "clj-kafka.consumer"
+                  "auto.offset.reset" "smallest"
+                  "auto.commit.enable" "false"}]
+      (kafka-core/with-resource [c (kafka-zk/consumer config)]
+        kafka-zk/shutdown
+        (let [stream (kafka-zk/create-message-stream c "test-topic")]
+          (run! do-message! stream))))))
+
+(defrecord KafkaConsumer [host port]
+  component/Lifecycle
+  (start [component]
+    (println ";; Starting consumer..." host port)
+    (start-listening! host port)
+    component)
+
+  (stop [component]
+    (println ";; Stopping consumer...")))
+
+(defn new-kafka-consumer [host port]
+  (map->KafkaConsumer {:host host :port port}))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn kafka-test-system
+  [{:keys [host kafka-port zookeeper-port]}]
+  (component/system-map
+   :producer (new-kafka-producer host kafka-port)
+   :consumer (new-kafka-consumer host zookeeper-port)))
+
+(def system (kafka-test-system
+             {:host "127.0.0.1"
+              :kafka-port 9092
+              :zookeeper-port 2181}))

 (defn -main
   "I don't do a whole lot."


CMR-2482: Fixed problem caused by refactoring; Added handling of index deletion event.

--- indexer-app/src/cmr/indexer/services/index_service.clj
+++ indexer-app/src/cmr/indexer/services/index_service.clj
@@ -76,8 +76,8 @@
             (let [batch (if (= :collection (cs/concept-id->type (:concept-id (first batch))))
                           ;; Get the tag associations as well.
                           (map (fn [concept]
-                                (let [tag-associations (mdb/get-tag-associations-for-collection concept)]
-                                  (assoc concept :tag-associations tag-associations)))
+                                 (let [tag-associations (mdb/get-tag-associations-for-collection concept)]
+                                   (assoc concept :tag-associations tag-associations)))
                                batch)
                           ;; Just use the concepts as is.
                           batch)
@@ -208,7 +208,7 @@
             delete-time (get-in parsed-concept [:data-provider-timestamps :delete-time])]
         (when (or (nil? delete-time) (> (compare delete-time (tk/now)) 0))
           (let [tag-associations (mdb/get-tag-associations-for-collection context concept)
-                elastic-version (es/get-elastic-version concept tag-associations)
+                elastic-version (es/get-elastic-version (assoc concept :tag-associations tag-associations))
                 tag-associations (map cp/parse-concept (filter #(not (:deleted %)) tag-associations))
                 concept-index (idx-set/get-concept-index-name context concept-id revision-id
                                                               all-revisions-index? concept)
@@ -253,8 +253,12 @@
         (index-concept context concept parsed-concept options)
         (log-ingest-to-index-time concept)))))

-(defn delete-concept
+(defmulti delete-concept
   "Delete the concept with the given id"
+  (fn [context concept-id revision-id options]
+    (cs/concept-id->type concept-id)))
+
+(defmethod delete-concept :default
   [context concept-id revision-id options]
   ;; Assuming ingest will pass enough info for deletion
   ;; We should avoid making calls to metadata db to get the necessary info if possible
@@ -288,6 +292,11 @@
                 {:term {(query-field->elastic-field :collection-concept-id :granule)
                         concept-id}}))))))))

+(defmethod delete-concept :tag-association
+  [context concept-id revision-id options]
+  (let [concept (meta-db/get-concept context concept-id revision-id)]
+    (index-concept context concept nil options)))
+
 (defn force-delete-collection-revision
   "Removes a collection revision from the all revisions index"
   [context concept-id revision-id]


more flexible routes data structure

more flexible routes data structure

--- src/client/routes.cljs
+++ src/client/routes.cljs
@@ -8,6 +8,8 @@
     [client.pages.spectate :as spectate-page]
     [client.util :as util]))

+(def function? js/goog.isFunction)
+
 ;;------------------------------------------------------------------------------
 ;; Routes
 ;;------------------------------------------------------------------------------
@@ -16,8 +18,8 @@

 (def routes {
   ;; initial page + login
-  "/menu"  [menu-page/init!]
-  "/login" [login-page/init!]
+  "/menu"  menu-page/init!
+  "/login" login-page/init!

   ;; solo play screen
   "/play-solo" [play-page/init-solo! play-page/cleanup!]
@@ -34,7 +36,7 @@
   "/play2" [play-page/init-battle2! play-page/cleanup!]

   ;; redirects - where is my HTTP 301? :)
-  "/dashboard" [#(aset js/document "location" "hash" "/spectate")]
+  "/dashboard" #(aset js/document "location" "hash" "/spectate")
   })

 (def previous-page-cleanup-fn (atom nil))
@@ -42,14 +44,14 @@
 (defn- on-hash-change []
   (let [new-route (.replace (aget js/document "location" "hash") #"^#" "")
         page (get routes new-route)
-        init-fn (first page)
-        cleanup-fn (second page)]
-    (if-not (or page init-fn)
+        init-fn (if (vector? page) (first page) page)
+        cleanup-fn (if (vector? page) (second page))]
+    (if-not (function? init-fn)
       (aset js/document "location" "hash" default-route)
       (do
-        ;; run cleanup function from last page
+        ;; run cleanup function from the last page
         (if (and @previous-page-cleanup-fn
-                 (js/goog.isFunction @previous-page-cleanup-fn))
+                 (function? @previous-page-cleanup-fn))
           (@previous-page-cleanup-fn))

         ;; run init function for the new page


Limit jobs report to 10

Limit jobs report to 10

--- src/clj/inky/entry.clj
+++ src/clj/inky/entry.clj
@@ -390,7 +390,7 @@
                 (html-response
                   ($intro {:jobs (mon/fetch :compile-jobs
                                    :sort {:created -1}
-                                   :limit 30)}))))
+                                   :limit 10)}))))

   (GET "/dev" [] (fn [r]
                    (let [ns (or (-> r :params :ns)


Specify ms as timeout unit

Specify ms as timeout unit

--- src/clj/reply/main.clj
+++ src/clj/reply/main.clj
@@ -92,7 +92,7 @@
   --attach:            Attach to an existing nREPL session on this port or host:port, when used with nREPL
   --port:              Start a new nREPL session on this port, when used with nREPL
   --color:             Use color; currently only available with nREPL
-  --timeout:           Specify the network timeout, when used with nREPL"
+  --timeout:           Specify the network timeout in ms, when used with nREPL"

   [& args]
   (launch (parse-args args)))


Compact buffered commands into a single history entry

--- src/multi_repl/core.clj
+++ src/multi_repl/core.clj
@@ -85,6 +85,17 @@
   (binding [*out* (:out console)]
     (apply println args)))

+(defn add-to-history [console command]
+  (-> (:reader console)
+      .getHistory
+      (.add (str command "\r"))))
+
+(defn remove-n-from-history [console n]
+  (let [history (-> (:reader console)
+                    .getHistory)]
+    (dotimes [_ n]
+      (.removeLast history))))
+
 (defn drop-first-and-last [v]
   (subvec v 1 (- (count v) 1)))

@@ -104,10 +115,12 @@
     (loop [buffer [line]]
       (print-err "buffer" buffer)
       (if (= (last buffer) "%r")
-        (->> buffer
-             drop-first-and-last
-             (clojure.string/join "\n")
-             (eval-and-print system))
+        (let [command (->> buffer
+                           drop-first-and-last
+                           (clojure.string/join "\n"))]
+          (remove-n-from-history console (count buffer))
+          (add-to-history console command)
+          (eval-and-print system command))
         (recur (->> (read-console-line console)
                     (conj buffer)))))))


Handle twitter status post failure

Handle twitter status post failure

--- src/myshelf/twitter.clj
+++ src/myshelf/twitter.clj
@@ -72,13 +72,17 @@

 (defn handle-reply
   [creds channel metadata body]
-  (let [{:keys [user-handle msg url sent-cmd results]}
-        (json/parse-string (String. body "UTF-8") true)
-        status (generate-status msg url sent-cmd results)]
-    (twitter/statuses-update :oauth-creds creds
-                             :params {:status (str "@" user-handle
-                                                   "\n"
-                                                   status)})))
+  (let [parsed-body (json/parse-string (String. body "UTF-8") true)
+        status (generate-status parsed-body)]
+    (try (twitter/statuses-update :oauth-creds creds
+                                  :params
+                                  {:status (str "@"
+                                                (:user-handle parsed-body)
+                                                "\n"
+                                                status)})
+         (catch Exception ex
+           (println "error attempting to post status" status)
+           (println (.getMessage ex))))))

 (defn -main [& args]
   (let [conn (lc/connect)


Fix palisade double-turn bug

Fix palisade double-turn bug

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -1206,11 +1206,11 @@
               (= id :log)
                 (-> state
                   (rai/apply-log item)
-                  (rw/assoc-current-state :apply-item-normal))
+                  (rw/assoc-current-state :normal))
               (= id :bamboo)
                 (-> state
                   (rai/apply-log item)
-                  (rw/assoc-current-state :apply-item-normal))
+                  (rw/assoc-current-state :normal))
               (= id :bedroll)
                 (-> state
                   (rai/apply-bedroll item)


Change harvesting on ground to use > instead of .

--- src/robinson/update.clj
+++ src/robinson/update.clj
@@ -1909,7 +1909,7 @@
                            \j         [harvest-down           :normal          true]
                            \k         [harvest-up             :normal          true]
                            \l         [harvest-right          :normal          true]
-                           \.         [harvest-center         :normal          true]
+                           \>         [harvest-center         :normal          true]
                            :escape    [identity               :normal          false]}
                :wield     {:escape    [identity               :normal          false]
                            :else      [wield                  :normal          true]}


Added notes about how the file upload example works

--- src/css-guide/styles/components.cljs
+++ src/css-guide/styles/components.cljs
@@ -729,13 +729,18 @@
     (mapv (fn [typ] (dom/div #js {:key typ :className ""}
                       (dom/input #js {:type typ :placeholder typ :className "c-field"})))
           ["text" "password" "date" "datetime" "datetime-local" "month" "week" "email" "number" "search" "tel" "time" "url" "color"])
+
+    ;; File upload
     (l/row {:density :collapse}
       (l/col {:width 1}
+        ;; This is the button to init the upload dialog
         (dom/label #js {}
          (dom/span #js {:className "c-button c-button--circular c-button--primary c-button--dense"}
            (icons/icon :file_upload)
            (dom/input #js {:type "file" :className "u-hide" :id "file-input-file"}))))
       (l/col {:width 3}
+        ;; This is the input that displays the file name when selected
+        ;; When you have multiple files selected, this label should read "X files selected"
         (dom/input #js {:type "text" :className "c-field" :disabled true :readOnly true :id "file-input-text"})
         (dom/label #js {:htmlFor "file-input-text"}))
       )


Implement navigation using arrow keys

Implement navigation using arrow keys

--- src/reabledit/core.cljs
+++ src/reabledit/core.cljs
@@ -1,10 +1,40 @@
 (ns reabledit.core
   (:require [reagent.core :as reagent]))
+
+;;
+;; State-related helpers
+;;
+
+(defn set-selected!
+  [ui-state row col]
+  (swap! ui-state assoc :selected [row col]))
+
+
+;;
+;; Keyboard event handlers
+;;
+
+(defn handle-key-down
+  [e rows cols ui-state]
+  (let [keycode (.-keyCode e)
+        current-row (first (:selected @ui-state))
+        current-col (second (:selected @ui-state))
+        f (partial set-selected! ui-state)]
+    (condp = keycode
+      37 (f current-row (max 0 (dec current-col)))
+      38 (f (max 0 (dec current-row)) current-col)
+      39 (f current-row (min (dec cols) (inc current-col)))
+      40 (f (min (dec rows) (inc current-row)) current-col)
+      nil)))
+
+;;
+;; Components
+;;

 (defn data-table-cell
   [v nth-row nth-col ui-state]
   [:td {:class (if (= (:selected @ui-state) [nth-row nth-col]) "selected")
-        :on-click #(swap! ui-state assoc :selected [nth-row nth-col])} v])
+        :on-click #(set-selected! ui-state nth-row nth-col)} v])

 (defn data-table-row
   [headers row-data nth-row ui-state]
@@ -26,6 +56,8 @@
   (let [ui-state (reagent/atom {})]
     (fn [headers data]
       [:div.reabledit
+       {:tabIndex 0
+        :on-key-down #(handle-key-down % (count data) (count headers) ui-state)}
        [:table
         [data-table-headers headers]
         [:tbody


adjust java args for cluster

adjust java args for cluster

--- src/edu/berkeley/ai/util/cluster.clj
+++ src/edu/berkeley/ai/util/cluster.clj
@@ -29,7 +29,7 @@
 		  "-o" (str (util/file-stem f) ".out")
 		  "-e" (str (util/file-stem f) ".err")]
 		*default-qsub-options*
-		[:in (str "java -cp " *classpath* " clojure.main " f) :dir (util/dirname f)])))))))
+		[:in (str "java -server -Xmx1024m -cp " *classpath* " clojure.main " f) :dir (util/dirname f)])))))))

 (defn run-experiment-set-subprocesses [es]
   (run-files-subprocesses


Update ENV name.

Update ENV name.

--- src/oc/email/config.clj
+++ src/oc/email/config.clj
@@ -10,7 +10,7 @@

 ;; ------ OC Web -----

-(defonce web-url (or (env :oc-web-server-url) "http://localhost:3559"))
+(defonce web-url (or (env :oc-web-url) "http://localhost:3559"))

 ;; ----- AWS SQS / SES -----


Check task scheduler.

Check task scheduler.

--- src/onyx/validation.clj
+++ src/onyx/validation.clj
@@ -30,7 +30,8 @@

 (def job-validator
   {:catalog [(schema/pred map? 'map?)]
-   :workflow (schema/pred vector? 'vector?)})
+   :workflow (schema/pred vector? 'vector?)
+   :task-scheduler schema/Keyword})

 (defn validate-job
   [job]


Use Union to merge sets

Use Union to merge sets

--- src/riak_mesos/rest.clj
+++ src/riak_mesos/rest.clj
@@ -1,6 +1,6 @@
 (ns riak-mesos.rest
   (:require [compojure.core :refer [routes ANY]]
-            [clojure.set :refer [difference]]
+            [clojure.set :refer [difference union]]
             [ring.middleware.json :refer [wrap-json-response wrap-json-body]]
             [riak-mesos.curator :refer [make-curator]]
             [org.httpkit.server :refer [run-server]]
@@ -29,7 +29,7 @@
     :post! (fn [ctx]
              (let [pending-nodes (difference (into #{} (range 0 (nodes ctx)))
                                              @running)]
-               (swap! pending merge pending-nodes)))))
+               (swap! pending union pending-nodes)))))

 (defn app-routes
   [pending running]


Use an atom pointing to a simple list to store events in coalesce.

A possible further optimization would be to store events sorted
by their ttl, and thus dropping every expired events, then
returning the rest of the list.

--- src/riemann/streams.clj
+++ src/riemann/streams.clj
@@ -539,24 +539,12 @@
   Use coalesce to combine states that arrive at different times--for instance,
   to average the CPU use over several hosts."
   [& children]
-  (let [past (ref {})]
-    (fn [event]
-      ; Expire old events
-      (dosync
-        (ref-set past
-                 (let [p (deref past)]
-                   (reduce (fn [res [k v]]
-                             (if (expired? v)
-                               (dissoc res k)
-                               res))
-                           p p))))
-
-      ; Add event to memory
-      (let [events (vals
-        (dosync (alter past assoc [(:host event) (:service event)] event)))]
-
-        ; Pass on
-        (call-rescue events children)))))
+  (let [past (atom [])]
+    (fn [{:keys [host service] :as event}]
+      (call-rescue
+       (swap! past (comp (partial conj event)        ;; insert new event
+                         (partial filter expired?))) ;; expire old events
+       children))))

 (defn append
   "Conj events onto the given reference"


add another simply internally-timed synth example

--- src/overtone/examples/timing/internal_metro.clj
+++ src/overtone/examples/timing/internal_metro.clj
@@ -64,3 +64,41 @@
 (on-event "/tr" #(println "trigger: " %) ::metro-synth)

 (metro-synth)
+
+
+;; Here's a simple little melody-playing synth which reads a series of
+;; notes from a buffer (which you can change in real-time) and which
+;; also allows you to modulate the rates and rate ratios of the
+;; arpeggiator and cymbol sound:
+
+;; create a buffer for the notes
+(def notes-b (buffer 5))
+
+;; fillt he buffer with a nice chord
+(buffer-write! notes-b (take 5 (cycle (chord :Cb2 :minor))) )
+
+;; here's our swanky synth:
+
+(defsynth arpeg-click [rate 10 buf 0 arp-div 2 beat-div 1]
+  (let [tik   (impulse rate)
+        a-tik (pulse-divider tik arp-div)
+        b-tik (pulse-divider tik beat-div)
+        cnt   (mod (pulse-count tik) (buf-frames buf))
+        note  (buf-rd:kr 1 notes-b cnt)
+        freq  (midicps note)
+        snd   (white-noise)
+        snd   (rhpf snd 2000 0.4)
+        snd   (normalizer snd)
+        b-env (env-gen (perc 0.01 0.1) b-tik)
+        a-env (env-gen (perc 0.01 0.4) a-tik)]
+    (out 0 (pan2 (+ (* 0.5 snd b-env)
+                    (* (sin-osc freq) a-env)
+                    (* (sin-osc (* 2 freq)) a-env))))))
+
+;; have fun!
+;; (def s (arpeg-click))
+;; (ctl s :rate 20)
+;; (ctl s :rate 5)
+;; (buffer-write! notes-b (take 5 (cycle (chord :Eb3 :minor))))
+;; (buffer-write! notes-b (take 5 (cycle (chord :F#2 :minor))) )
+;; (stop)


upgrade default realtime memory size from a measly 8mb to 256mb.

--- src/overtone/sc/machinery/server/args.clj
+++ src/overtone/sc/machinery/server/args.clj
@@ -21,7 +21,7 @@
    :max-buffers              {:default 1024  :flag "-b" :desc "Number of sample buffers"}
    :max-nodes                {:default 1024  :flag "-n" :desc "Max number of executing nodes allowed in the server"}
    :max-sdefs                {:default 1024  :flag "-d" :desc "Max number of synthdefs allowed"}
-   :rt-mem-size              {:default 8192  :flag "-m" :desc "Real time memory size"}
+   :rt-mem-size              {:default 262144 :flag "-m" :desc "Real time memory size"}
    :max-w-buffers            {:default 64    :flag "-w" :desc "Number of wire buffers"}
    :num-rand-seeds           {:default 64    :flag "-r" :desc "Number of random seeds"}
    :load-sdefs?              {:default 1     :flag "-D" :desc "Load synthdefs on boot? 0 or 1"}


Fleshed out the DefaultNodePool implementation.

--- src/shale/node-pool.clj
+++ src/shale/node-pool.clj
@@ -1,5 +1,3 @@
-
-
 (defprotocol NodePool
   "Basic interface for choosing and managing Selenium nodes per session.
    Implementing this allows dynamic node domains- eg, by retrieving them from
@@ -9,7 +7,16 @@
   (add-node [this requirements] "")
   (remove-node [this url] ""))

-(deftype DefaultNodePool [options] NodePool
-  ""
-  ()
+(deftype DefaultNodePool [nodes] NodePool
+  "A simple node pool the chooses randomly from an initial list."
+  (get-node [this requirements]
+    (rand-nth nodes))
+
+  (add-node [this requirements]
+    (throw (ex-info "Unable to add new nodes to the default node pool."
+                    {:user-visible true :status 500})))
+
+  (remove-node [this requirements]
+    (throw (ex-info "Unable to remove nodes with the default node pool."
+                    {:user-visible true :status 500})))
   )


fix Exercise 3.5

fix Exercise 3.5

--- src/sicp/chapter3_1.clj
+++ src/sicp/chapter3_1.clj
@@ -129,17 +129,18 @@
   (let [ran (- high low)]
     (+ low (rand ran))))

-(defn estimate-integral [x1 y1 x2 y2 trials]
-  (letfn [(test []
-            (let [r (/ (- x2 x1) 2)
-                  cx (/ (+ x1 x2) 2)
-                  cy (/ (+ y1 y2) 2)
-                  x (random-in-range x1 x2)
-                  y (random-in-range y1 y2)]
-              (<= (+ (Math/pow (- x cx) 2)
-                     (Math/pow (- y cy) 2))
-                  (Math/pow r 2))))]
-    (double (* 4 (monte-carlo trials test)))))
+(defn estimate-integral [p x1 y1 x2 y2 trials]
+  (monte-carlo trials #(p (random-in-range x1 x2)
+                          (random-in-range y1 y2))))
+
+(defn estimate-pi [trials]
+  (letfn [(p [x y]
+            (<= (+ (Math/pow (- x 5) 2)
+                   (Math/pow (- y 7) 2))
+                (Math/pow 3 2)))]
+    (-> (estimate-integral p 2 4 8 10 trials)
+        (* 4)
+        double)))

 ;; Exercise 3.6
 ;; TODO


Removed unused function

Removed unused function

--- src/fake_http/fake.clj
+++ src/fake_http/fake.clj
@@ -58,13 +58,6 @@
     (for [[name value] headers]
       (.addHeader nano-response name value))
     nano-response))
-
-(defn- route-matches? [query-params route]
-  (let [route-matcher (:route-matcher route)
-        query-params-that-must-match (or (:query route-matcher) {})]
-    (if (zero? (count query-params-that-must-match))
-      route
-      (some #(if (= (get query-params (key %)) (val %)) route) query-params-that-must-match))))

 (defn- route->request-spec [fake-http-request {:keys [request-spec-fn]}]
   (request-spec-fn fake-http-request))


removed util references to get-parent-element-id calls inside of util.clj

--- src/vip/data_processor/validation/v5/util.clj
+++ src/vip/data_processor/validation/v5/util.clj
@@ -132,7 +132,7 @@
                 (reduce (fn [ctx path]
                           (let [missing-path (str path "."
                                                   (last xml-element-path))
-                                 parent-element-id (util/get-parent-element-id missing-path import-id)]
+                                 parent-element-id (get-parent-element-id missing-path import-id)]
                             (errors/add-v5-errors ctx :errors schema-type
                                                missing-path :missing
                                                parent-element-id
@@ -220,7 +220,7 @@
             invalid-elements (remove (comp valid? :value) elements)]
         (reduce (fn [ctx row]
                   (let [path (-> row :path .getValue)
-                        parent-element-id (util/get-parent-element-id path import-id)]
+                        parent-element-id (get-parent-element-id path import-id)]
                     (errors/add-v5-errors ctx error-severity error-root-element
                                        path error-type parent-element-id
                                        (:value row))))


Rename `future` to `promise->future` for avoid confusion.

--- src/futura/promise.clj
+++ src/futura/promise.clj
@@ -265,7 +265,7 @@
   [p]
   (pending* p))

-(defn future
+(defn promise->future
   "Converts a promise in a CompletableFuture instance."
   [^Promise p]
   (.-cf p))
@@ -286,7 +286,7 @@
   ([p] (deliver p nil))
   ([p v]
    {:pre [(promise? p)]}
-   (let [f (future p)]
+   (let [f (promise->future p)]
      (if (instance? Throwable v)
        (.completeExceptionally f v)
        (.complete f v)))))
@@ -297,7 +297,7 @@
   array are resolved."
   [promises]
   (let [promises (map promise promises)
-        futures (map future promises)
+        futures (map promise->future promises)
         promise' (->> (into-array CompletableFuture futures)
                       (CompletableFuture/allOf)
                       (Promise.))]
@@ -311,7 +311,7 @@
   [promises]
   (let [xform (comp
                (map promise)
-               (map future))]
+               (map promise->future))]
     (->> (sequence xform promises)
          (into-array CompletableFuture)
          (CompletableFuture/anyOf)