Add merge-sorted

Add merge-sorted

--- src/useful/seq.clj
+++ src/useful/seq.clj
@@ -214,3 +214,23 @@
       (and (= h (first needle))
            (recur hs (rest needle))))
     true))
+
+(defn merge-sorted
+  "Merge N sorted sequences together, as in the merge phase of a merge-sort.
+   Comparator should be a two-argument predicate like `<`, which returns true if
+   its first argument belongs before its second element in the merged sequence.
+   The collections themselves should already be sorted in the order your
+   comparator would put them; otherwise ordering is undefined."
+  ([comparator xs ys]
+     (lazy-loop [xs xs, ys ys]
+       (if-let [[x & more-xs] (seq xs)]
+         (if-let [[y & more-ys] (seq ys)]
+           (if (comparator x y)
+             (cons x (lazy-recur more-xs ys))
+             (cons y (lazy-recur xs more-ys)))
+           xs)
+         ys)))
+  ([comparator xs ys & more]
+     (apply merge-sorted comparator
+            (merge-sorted comparator xs ys)
+            more)))


Use edn for reading strings

Use edn for reading strings

--- src/ansel/session.clj
+++ src/ansel/session.clj
@@ -1,6 +1,7 @@
 (ns ansel.session
   (:import java.util.UUID)
   (:require [ring.middleware.session.store :refer :all]
+            [clojure.edn :as e]
             [ansel.util :refer [when-slurp]]))

 (defn new-key []
@@ -11,20 +12,20 @@

   (read-session [s session-key]
     (let [session-text (when-slurp session-filename)
-          session-data (read-string (or session-text "{}"))]
+          session-data (e/read-string (or session-text "{}"))]
       (when session-data
         (session-data (keyword session-key)))))

   (write-session [_ session-key data]
     (let [k (or session-key (new-key))
           session-text (when-slurp session-filename)
-          session-data (read-string (or session-text "{}"))
+          session-data (e/read-string (or session-text "{}"))
           updated-data (assoc session-data (keyword k) data)]
       (spit session-filename updated-data)
       k))

   (delete-session [_ session-key]
-    (let [session-data (read-string (when-slurp session-filename))
+    (let [session-data (e/read-string (when-slurp session-filename))
           updated-data (dissoc session-data (keyword session-key))]
       (spit session-filename updated-data)
       nil)))


Fixing those annoying square-bracket-in-email-addresses issues

--- src/arktikos/mail.clj
+++ src/arktikos/mail.clj
@@ -36,7 +36,7 @@
           (get (my-config) :redactions))))

 ;; Cache redactions, so we don't have to keep yanking them from the config files
-(def get-redactions (clojure.core.memoize/ttl get-new-redactions {} :ttl/threshold 10000))
+(def get-redactions (clojure.core.memoize/ttl get-new-redactions {} :ttl/threshold 10))

 ;;;
 ;;; Mail Data Formatting
@@ -86,6 +86,13 @@
        (subs rx (inc (.indexOf rx "<")) (.indexOf rx ">"))
          address))))

+(defn strip-email-square-brackets [address]
+  (let [rx (re-find #"\[\S+\]" address)]
+    (if rx
+      (subs rx (inc (.indexOf rx "\[")) (.indexOf rx "\]"))
+      address
+      )))
+
 (defn redact-addresses
   "Replace the addresses with aliases (presumably from the config files)."
   [address redactions]
@@ -96,7 +103,7 @@
 (defn strip-emails
   "Strip and redact a bunch of emails."
   [addresses redactions]
-  (map #(redact-addresses (strip-email %1) redactions) addresses))
+  (map #(redact-addresses (strip-email-square-brackets (strip-email %1)) redactions) addresses))

 (defn hash-message
@@ -205,15 +212,18 @@
   Remote complement to (ingest-mail)."
   ([] (remote-mail (gmail-folder)))
   ([folder-name]
-    (clojure.pprint/pprint (str "Accessing remote mail: " folder-name))
-    (map process-remote-message
-        (clojure-mail.core/with-store (clojure-mail.core/gen-store (gmail-username) (gmail-password))
-         (.getMessages (my-open-folder folder-name :readonly))
-                  ))))
+   ;(if (string? folder-name)
+     (let []
+      (clojure.pprint/pprint (str "Accessing remote mail: " folder-name))
+      (map process-remote-message
+           (clojure-mail.core/with-store (clojure-mail.core/gen-store (gmail-username) (gmail-password))
+             (.getMessages (my-open-folder folder-name :readonly))
+                  )))
+     ));)

 ;; Cache the fetched mail, because we really don't need real-time updates yet...
-;(def cached-remote-mail
-;  (clojure.core.memoize/ttl remote-mail {} :ttl/threshold 60))
+(def cached-remote-mail
+  (clojure.core.memoize/ttl remote-mail {} :ttl/threshold 60))

 ;(remote-mail)


Add more debug statements

Add more debug statements

--- src/aurora/btree.cljs
+++ src/aurora/btree.cljs
@@ -506,6 +506,7 @@
                        (when (< i (alength right-los))
                          (aset right-los i greatest)
                          (recur (+ i 1)))))))
+               (debug :right-los right-los)
                ;; ...and then seek past it
                (let [new-los (or (.seek-gt iterator right-los) failed-los)]
                  (loop [i 0]
@@ -561,7 +562,7 @@
                        (set! failed? true))))
                  changed?))
   (split [this current]
-         (debug :splitting los his (map #(.-lower %) constraints) (map #(.-upper %) constraints))
+         (debug :splitting-left los his current)
          (apush pushed-los (aclone los))
          (apush pushed-his (aclone his))
          (set! depth (+ depth 1))
@@ -569,7 +570,8 @@
            (.write-bounds this splitter)
            (.split-left (aget constraints splitter) (aget constraint->los splitter) (aget constraint->his splitter))
            (if (true? (.read-bounds this splitter))
-             (apush pushed-splitters splitter)
+             (do (apush pushed-splitters splitter)
+               (debug :split-left los his splitter))
              (let [new-splitter (mod (+ splitter 1) (alength constraints))]
                (if (identical? new-splitter current)
                  (assert false "Can't split anything!")
@@ -579,20 +581,27 @@
              (set! his (.pop pushed-his))
              (set! depth (- depth 1))
              (let [splitter (.pop pushed-splitters)]
+               (debug :backtracked los his splitter)
                (.write-bounds this splitter)
+               (debug :splitting-right los his splitter)
                (.split-right (aget constraints splitter) (aget constraint->los splitter) (aget constraint->his splitter))
-               (.read-bounds this splitter)))
+               (.read-bounds this splitter)
+               (debug :split-right los his splitter)
+               (set! failed? false)))
   (next [this]
         (debug :next los his pushed-los pushed-his)
         (loop [current 0
                last-changed (- (alength constraints) 1)]
+          (debug :next-loop los his current last-changed failed?)
           (if (true? failed?)
             (when (> depth 0)
               (.backtrack this)
               (recur current (- (alength constraints) 1)))
             (do
               (.write-bounds this current)
+              (debug :propagating current (aget constraint->los current) (aget constraint->his current))
               (.propagate (aget constraints current) (aget constraint->los current) (aget constraint->his current))
+              (debug :propagated current (aget constraint->los current) (aget constraint->his current))
               (if (.read-bounds this current)
                 (recur (mod (+ current 1) (alength constraints)) current)
                 (if (== current last-changed)


Pull in macro updates

Pull in macro updates

--- src/aurora/macros.clj
+++ src/aurora/macros.clj
@@ -7,6 +7,12 @@
 (defmacro debug [& args]
   (when debug?
     `(cljs.core.prn ~@args)))
+
+(def check? false)
+
+(defmacro check [& args]
+  (when check?
+    `(assert ~@args)))

 (defmacro amake [[ix size] & body]
   `(let [arr# (make-array 0)]
@@ -120,20 +126,6 @@
      (doseq ~bindings
        (apush result# (do ~@body)))
      result#))
-
-(defmacro check [& preds]
-  `(do
-     ~@(for [pred preds]
-         `(when-not ~pred
-            (throw (aurora.util.core.FailedCheck. '~pred ~(:line (meta &form)) ~*file* []))))
-     true))
-
-(defmacro deftraced [name args traced-args & body]
-  `(defn ~name ~args
-     (try
-       ~@body
-       (catch aurora.util.core.FailedCheck e#
-         (throw (update-in e# [:trace] conj (list '~name ~@traced-args)))))))

 (defmacro catch [& body]
   `(try


add explicit theme option

add explicit theme option


Fix platform dependent code on core ns.

Fix platform dependent code on core ns.

--- src/bytebuf/core.cljx
+++ src/bytebuf/core.cljx
@@ -28,7 +28,11 @@
   ([buff data spec]
    (write! buff data spec {}))
   ([buff data spec {:keys [offset] :or {offset 0}}]
+   #+clj
    (locking buff
+     (spec/write spec buff offset data))
+   #+cljs
+   (do
      (spec/write spec buff offset data))))

 (defn read*
@@ -39,8 +43,11 @@
   ([buff spec]
    (read* buff spec {}))
   ([buff spec {:keys [offset] :or {offset 0}}]
+   #+clj
    (locking buff
-     (spec/read spec buff offset))))
+     (spec/read spec buff offset))
+   #+cljs
+   (spec/read spec buff offset)))

 (defn read
   "Read data from buffer following the specified


WIP: markdown headers should allow wrapping '#'s

--- test/braid/test/server/markdown.clj
+++ test/braid/test/server/markdown.clj
@@ -13,7 +13,7 @@
                 " - thing one"
                 " - thing two"
                 ""
-                "## Other Heading"
+                "## Other Heading ##"
                 ""
                 " - x"
                 " - y"


Adds node-info, ssh-exec functions for running commands on remote nodes

--- src/circleci/init.clj
+++ src/circleci/init.clj
@@ -4,7 +4,8 @@
   (:require circleci.db.migrations)
   (:require circleci.web)
   (:require circleci.repl)
-  (:require circleci.logging))
+  (:require circleci.logging)
+  (:require circleci.backend.nodes))

 (defn -main []
   (try


Smaller test case.

Smaller test case.

--- test/onyx/peer/colors_flow_test.clj
+++ test/onyx/peer/colors_flow_test.clj
@@ -121,14 +121,14 @@
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/white?}

-   {:flow/from :colors-in
+   #_{:flow/from :colors-in
     :flow/to :none
     :flow/short-circuit? true
     :flow/exclude-keys [:extra-key]
     :flow/action :retry
     :flow/predicate :onyx.peer.colors-flow-test/black?}

-   {:flow/from :colors-in
+   #_{:flow/from :colors-in
     :flow/to [:process-red]
     :flow/short-circuit? true
     :flow/exclude-keys [:extra-key]
@@ -140,13 +140,13 @@
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/blue?}

-   {:flow/from :colors-in
+   #_{:flow/from :colors-in
     :flow/to [:process-green]
     :flow/short-circuit? true
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/green?}

-   {:flow/from :colors-in
+   #_{:flow/from :colors-in
     :flow/to [:process-red]
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/orange?}
@@ -156,7 +156,7 @@
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/orange?}

-   {:flow/from :colors-in
+   #_{:flow/from :colors-in
     :flow/to [:process-green]
     :flow/exclude-keys [:extra-key]
     :flow/predicate :onyx.peer.colors-flow-test/orange?}])


Add force reset to second job

Add force reset to second job

--- test/onyx/plugin/input_log_test.clj
+++ test/onyx/plugin/input_log_test.clj
@@ -205,6 +205,7 @@
     :onyx/medium :datomic
     :datomic/uri db-uri
     :checkpoint/key "global-checkpoint-key"
+    :checkpoint/force-reset? false
     :datomic/log-end-tx 1014
     :onyx/max-peers 1
     :onyx/batch-size batch-size


* src/clj/cljs/core.clj: remove hasOwnProperty test - this code won't work with advanced compilation. Sadly in JS we can't differentiate between a prototype and an actual instance of a type.

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -386,9 +386,9 @@
   (let [p (:name (cljs.compiler/resolve-var (dissoc &env :locals) psym))
         prefix (protocol-prefix p)]
     `(let [x# ~x]
-       (if (and x# (. x# ~(symbol prefix)) (not (. x# (~'hasOwnProperty ~prefix))))
-	 true
-	 (cljs.core/type_satisfies_ ~psym x#)))))
+       (if (and x# (. x# ~(symbol prefix)))
+         true
+         (cljs.core/type_satisfies_ ~psym x#)))))

 (defmacro lazy-seq [& body]
   `(new cljs.core.LazySeq nil false (fn [] ~@body)))


CLJS-366: revert CLJS-39, broke :when and change no longer necessary now that we track let expressions in loops.

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -944,7 +944,7 @@
                        v (second exprs)

                        seqsym (when-not (keyword? k) (gensym))
-                       recform (if (keyword? k) recform `(recur (first ~seqsym) ~seqsym))
+                       recform (if (keyword? k) recform `(recur (next ~seqsym)))
                        steppair (step recform (nnext exprs))
                        needrec (steppair 0)
                        subform (steppair 1)]
@@ -958,12 +958,11 @@
                                              ~subform
                                              ~@(when needrec [recform]))
                                            ~recform)]
-                     :else [true `(let [~seqsym (seq ~v)]
+                     :else [true `(loop [~seqsym (seq ~v)]
                                     (when ~seqsym
-                                      (loop [~k (first ~seqsym) ~seqsym ~seqsym]
-                                       ~subform
-                                       (when-let [~seqsym (next ~seqsym)]
-                                        ~@(when needrec [recform])))))]))))]
+                                      (let [~k (first ~seqsym)]
+                                        ~subform
+                                        ~@(when needrec [recform]))))]))))]
     (nth (step nil (seq seq-exprs)) 1)))

 (defmacro array [& rest]


CLJS-1149: cljs.repl/repl needs to support :compiler-env option

--- src/clj/cljs/repl.clj
+++ src/clj/cljs/repl.clj
@@ -645,7 +645,8 @@

 (defn repl*
   [repl-env {:keys [init need-prompt prompt flush read eval print caught reader
-                    print-no-newline source-map-inline wrap repl-requires]
+                    print-no-newline source-map-inline wrap repl-requires
+                    compiler-env]
              :or {init #()
                   need-prompt #(if (readers/indexing-reader? *in*)
                                  (== (readers/get-column-number *in*) 1)
@@ -683,8 +684,7 @@
                :reader reader
                :print-no-newline print-no-newline
                :source-map-inline source-map-inline})))]
-    (env/with-compiler-env
-     (or (::env/compiler repl-env) (env/default-compiler-env opts))
+    (env/with-compiler-env (or compiler-env (env/default-compiler-env opts))
      (binding [ana/*cljs-ns* 'cljs.user
                *cljs-verbose* repl-verbose
                ana/*cljs-warnings*


Add event :pre-first-turn.

Add event :pre-first-turn.

--- src/clj/game/core.clj
+++ src/clj/game/core.clj
@@ -573,11 +573,13 @@
       (when-let [mul (:mulligan cdef)]
         (mul state side card nil))))
   (swap! state assoc-in [side :keep] true)
-  (system-msg state side "takes a mulligan"))
+  (system-msg state side "takes a mulligan")
+  (trigger-event state side :pre-first-turn))

 (defn keep-hand [state side args]
   (swap! state assoc-in [side :keep] true)
-  (system-msg state side "keeps his or her hand"))
+  (system-msg state side "keeps his or her hand")
+  (trigger-event state side :pre-first-turn))

 (defn gain-agenda-point [state side n]
   (gain state side :agenda-point n)


crash fix

crash fix

--- src/clj/game/main.clj
+++ src/clj/game/main.clj
@@ -57,11 +57,11 @@
           "start" (core/init-game msg)
           "remove" (swap! game-states dissoc gameid)
           "do" ((commands command) state (keyword side) args)
-          "notification" (swap! state update-in [:log]
-                                #(conj % {:user "__system__" :text text}))
+          "notification" (when state
+                           (swap! state update-in [:log] #(conj % {:user "__system__" :text text})))
           "quit" (system-msg state (keyword side) "left the game"))
-        (if (not= action "remove")
-          (.send socket (generate-string (assoc (dissoc @(@game-states gameid) :events) :action action)))
+        (if-let [state (@game-states gameid)]
+          (.send socket (generate-string (assoc (dissoc @state :events) :action action)))
           (.send socket (generate-string "ok")))
         (catch Exception e
           (println "Error " action command (get-in args [:card :title]) e "\nStack trace:"


add java-hackers.com

add java-hackers.com


Show the publisher of an app as well

Show the publisher of an app as well

Reads this from the application table

--- idecode/myappshare/mainapp.cljs
+++ idecode/myappshare/mainapp.cljs
@@ -199,7 +199,7 @@
                "Build an app in 5 minutes")

   (div {:style {:marginLeft "25px"}}
-       (realtime select id, application_name, application_glyph from appshare_applications order by id {}
+       (realtime select id, application_name, application_glyph, fk_appshare_publisher_id from appshare_applications order by id {}
                (div nil

@@ -241,7 +241,12 @@
                                                        )

                                     :style {:display "inline-block" :fontFamily "Ubuntu" :fontWeight "700" :fontSize "1.3em" :marginTop "0.7em" :marginLeft "0.7em"}}
-                                   (str (<-- :application_name))))
+                                   (str (<-- :application_name)))
+
+                              (if (<-- :fk_appshare_publisher_id) (span {:style {:display "inline-block" :fontFamily "Ubuntu" :fontWeight "700" :fontSize "1.3em" :marginTop "0.7em" :marginLeft "0.7em"}}
+                                   (select id, publisher_name from appshare_publishers where id = ? {:params [(<-- :fk_appshare_publisher_id)]}
+                                                (str  (first (clojure.string/split (<-- :publisher_name) "@"))))))
+                              )
                         )))))))


Add cloverage

Add cloverage

--- leiningen/.lein/profiles.clj
+++ leiningen/.lein/profiles.clj
@@ -1,3 +1,4 @@
 {:user {:plugins [[lein-ancient "0.6.10"]
                   [lein-cljfmt "0.5.6"]
-                  [lein-kibit "0.1.5" :exclusions [org.clojure/clojure]]]}}
+                  [lein-kibit "0.1.5" :exclusions [org.clojure/clojure]]
+                  [lein-cloverage "1.0.9"]]}}


fixes edit evs > add schedule workflow

fixes edit evs > add schedule workflow


Add voting-method-preference to signup ctx


notify to be able to message a third channel

--- src/c4_arena/core.clj
+++ src/c4_arena/core.clj
@@ -57,18 +57,23 @@
                            (reset! last-move [move move])
                            true)))
         notify (fn [ch]
-                 (put! ch (cond->
-                              {:type "state"
-                               :turn (inc (or @turn -1))
-                               :you (inc (.indexOf ch-outs ch))
-                               :state @state}
-                            (@last-move (.indexOf ch-outs ch))
-                            (assoc :last-move (@last-move (.indexOf ch-outs ch)))
-                            @winner
-                            (assoc
-                             :winner (inc @winner)
-                             :turn 0)))
-                 (swap! last-move assoc (.indexOf ch-outs ch) nil))]
+                 (let [player-index (.indexOf ch-outs ch)
+                       player-index (when (not= player-index -1)
+                                      player-index)]
+                   (put! ch (cond-> {:type "state"
+                                     :turn (inc (or @turn -1))
+                                     :state @state}
+                              player-index
+                              (assoc :you (inc player-index))
+                              (@last-move player-index)
+                              (assoc :last-move
+                                     (let [lm (@last-move player-index)]
+                                       (swap! last-move assoc player-index nil)
+                                       lm))
+                              @winner
+                              (assoc
+                               :winner (inc @winner)
+                               :turn 0)))))]
     (go
       ;; Start out by notifying both sides of the board state
       (doseq [ch-out ch-outs]


Only import Go builds starting with given date

--- scripts/gosync.clj
+++ scripts/gosync.clj
@@ -9,6 +9,7 @@

 (require '[cheshire.core :as j]
          '[clj-http.client :as client]
+         '[clj-time.core :as t]
          '[clj-time.format :as tf]
          '[clj-time.coerce :as tc]
          '[clojure.tools.cli :refer [parse-opts]])
@@ -24,10 +25,13 @@
 (def go-url (second (:arguments args)))
 (def buildviz-url (:buildviz-url (:options args)))

+(def load-builds-from (t/minus (t/today-at-midnight) (t/weeks 1)))
+
 (def selected-pipeline-group-names (set (drop 2 (:arguments args))))

 (println "Storing build information to" buildviz-url)
 (println "Reading groups" selected-pipeline-group-names "from url" go-url)
+(println "Will load all builds starting from" (tf/unparse (tf/formatter "yyyy-MM-dd") load-builds-from))

 ;; util

@@ -75,14 +79,15 @@

 ;; /api/stages/%pipeline/%stage/history

-(defn job-instances-for-stage-instance [{pipelineRun :pipeline_counter
-                                         stageRun :counter
+(defn job-instances-for-stage-instance [{pipeline-run :pipeline_counter
+                                         stage-run :counter
                                          jobs :jobs}]
-  (map (fn [{id :id name :name result :result}]
+  (map (fn [{id :id name :name result :result scheduled-date :scheduled_date}]
          {:jobId id
           :jobName name
-          :stageRun stageRun
-          :pipelineRun pipelineRun})
+          :stageRun stage-run
+          :pipelineRun pipeline-run
+          :scheduledDateTime (tc/from-long scheduled-date)})
        jobs))

 (defn get-stage-instances [pipeline stage offset]
@@ -99,8 +104,9 @@

 (defn job-instances-for-stage [{stage :stage pipeline :pipeline}]
   (map #(assoc % :stageName stage :pipelineName pipeline)
-       (mapcat job-instances-for-stage-instance
-               (fetch-all-stage-history pipeline stage))))
+       (take-while #(.isAfter (:scheduledDateTime %) load-builds-from)
+                   (mapcat job-instances-for-stage-instance
+                           (fetch-all-stage-history pipeline stage)))))

 ;; /api/pipelines/%pipelines/instance/%run
@@ -234,3 +240,5 @@
        (map augment-job-instance-with-junit-xml)))

 (put-to-buildviz (map make-build-instance job-instances))
+
+(println (format "Done, wrote %s build entries" (count job-instances)))


Fix `extensions` function implementation.

--- src/datoteka/core.clj
+++ src/datoteka/core.clj
@@ -193,7 +193,7 @@
 (defn extension
   "Return the extension part of a file."
   [path]
-  (last (split-ext path)))
+  (subs (last (split-ext path)) 1))

 (defn base-name
   "Return the name part of a file."


Improve error messages in strict mode.

Improve error messages in strict mode.

--- src/cats/context.cljc
+++ src/cats/context.cljc
@@ -29,6 +29,11 @@

 (def ^:dynamic *context* nil)
 (def ^:dynamic *strict* false)
+
+(defn use-strict!
+  ([] (use-strict! true))
+  ([v]
+   (alter-var-root *strict* (constantly v))))

 (defn throw-illegal-argument
   {:no-doc true :internal true}
@@ -66,26 +71,29 @@
      `(with-context ~ctx
         ~@body)))

-;; TODO: improve error messages
-
 (defn infer
   "Given an optional value infer its context. If context is already set, it
   is returned as is without any inference operation."
   {:no-doc true}
   ([]
-   (if (nil? *context*)
-     (throw-illegal-argument "No context is set.")
-     *context*))
+   (when (nil? *context*)
+     (throw-illegal-argument "No context is set."))
+   *context*)
   ([v]
+   (infer v *strict*))
+  ([v strict?]
    (cond
      (not (nil? *context*))
-     *context*
+     (do
+       (when (and strict?
+                  (satisfies? p/Contextual v)
+                  (not= (p/-get-context v) *context*))
+         (throw-illegal-argument
+          (str "Context mismatch: you can't mix different context.")))
+       *context*)

      (satisfies? p/Contextual v)
      (p/-get-context v)
-
-     (satisfies? p/Context v)
-     v

      :else
      (throw-illegal-argument


adding registry services

adding registry services

--- src/celestial/api.clj
+++ src/celestial/api.clj
@@ -1,8 +1,10 @@
 (ns celestial.api
   (:use [compojure.core :only (defroutes context POST GET)]
+        [celestial.persistency :only (profile)]
         [metrics.ring.expose :only  (expose-metrics-as-json)]
         [metrics.ring.instrument :only  (instrument)]
         [ring.middleware.edn :only (wrap-edn-params)]
+        [clj-yaml.core :only (generate-string parse-string)]
         [ring.adapter.jetty :only (run-jetty)]
         [taoensso.timbre :only (debug info error warn set-config!)]
         [celestial.jobs :only (enqueue initialize-workers clear-all)])
@@ -34,10 +36,18 @@
                    (jobs/enqueue "machine" spec)
                    (generate-response {:status "submited system creation"})))

+(defroutes info-routes
+             (GET "/profile/:host" [host]
+                (debug "search after" host)
+                (generate-string (profile (keyword host))))
+             (POST "/profile/:type" [type & profile]
+                   (generate-response {:status "new profile type saved"})))
+
 (defroutes app-routes
   (context "/stage" [] stage-routes)
   (context "/provision" [] provision-routes)
   (context "/machine" [] machine-routes)
+  (context "/registry" [] info-routes)
   (route/not-found "Not Found"))

 (def app


Check for results before trying to paginate

--- src/cfpb/qu/views.clj
+++ src/cfpb/qu/views.clj
@@ -141,34 +141,35 @@
                               :offset ""})))))

 (defn- create-pagination [resource]
-  (let [window-size 3
-        current-page (or (get-in resource [:properties :page]) 1)
-        href (:href resource)
-        limit (get-in resource [:properties :query :limit])
-        total (get-in resource [:properties :total])
-        total-pages (+ (quot total limit)
-                       (if (zero? (rem total limit)) 0 1))
-        window (range (max 1 (- current-page window-size))
-                               (inc (min total-pages (+ current-page window-size))))
-        in-window? (fn [page]
-                     (contains? (set window) page))
-        pagination (map #(hash-map :page %
-                                   :class (when (= % current-page) "active")
-                                   :href (href-for-page resource %))
-                        window)]
-    (-> pagination
-        (conj {:page "Prev"
-               :class (when (<= current-page 1) "disabled")
-               :href (href-for-page resource (dec current-page))})
-        (conj {:page "First"
-               :class (when (in-window? 1) "disabled")
-               :href (href-for-page resource 1)})
-        (concat [{:page "Next"
-                  :class (when (>= current-page total-pages) "disabled")
-                  :href (href-for-page resource (inc current-page))}
-                 {:page "Last"
-                  :class (when (in-window? total-pages) "disabled")
-                  :href (href-for-page resource total-pages)}]))))
+  (if-let [total (get-in resource [:properties :total])]
+    (let [window-size 3
+          current-page (or (get-in resource [:properties :page]) 1)
+          href (:href resource)
+          limit (get-in resource [:properties :query :limit])
+          total-pages (+ (quot total limit)
+                         (if (zero? (rem total limit)) 0 1))
+          window (range (max 1 (- current-page window-size))
+                        (inc (min total-pages (+ current-page window-size))))
+          in-window? (fn [page]
+                       (contains? (set window) page))
+          pagination (map #(hash-map :page %
+                                     :class (when (= % current-page) "active")
+                                     :href (href-for-page resource %))
+                          window)]
+      (-> pagination
+          (conj {:page "Prev"
+                 :class (when (<= current-page 1) "disabled")
+                 :href (href-for-page resource (dec current-page))})
+          (conj {:page "First"
+                 :class (when (in-window? 1) "disabled")
+                 :href (href-for-page resource 1)})
+          (concat [{:page "Next"
+                    :class (when (>= current-page total-pages) "disabled")
+                    :href (href-for-page resource (inc current-page))}
+                   {:page "Last"
+                    :class (when (in-window? total-pages) "disabled")
+                    :href (href-for-page resource total-pages)}])))
+    []))

 (defmethod slice "text/html" [_ resource {:keys [metadata slicedef headers dimensions]}]
   (let [desc (partial concept-description metadata)
@@ -197,6 +198,7 @@
                   (->int 0)
                   inc)
         end (-> (get-in resource [:properties :size])
+                (->int 0)
                 (+ start)
                 dec)
         total (get-in resource [:properties :total])


Silly

Silly

--- server/project.clj
+++ server/project.clj
@@ -1,7 +1,6 @@
 (defproject bond "0.1.0-SNAPSHOT"
             :description "The spy agent"
             :dependencies [[org.clojure/clojure "1.3.0"]
-                           [org.clojars.tavisrudd/redis-clojure "1.3.1"]
                            [carmine "0.8.2-SNAPSHOT"]
                            [cheshire "4.0.0"]
                            [clj-time "0.4.2"]


add test macro

add test macro

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -34,7 +34,7 @@

                             cond-> cond->> as-> some-> some->>

-                            if-some when-some])
+                            if-some when-some test])
   (:require clojure.walk
             clojure.set
             cljs.compiler
@@ -1667,3 +1667,15 @@
      (fn []
        (this-as this#
          (cljs.core/es6-iterator this#)))))
+
+(defmacro test
+  "Given a symbol, resolve it as a var, if a test is attached
+  to a var execute it."
+  [v]
+  (let [f (-> (dissoc &env :locals)
+            (ana/resolve-var v)
+            :test)]
+    `(let [f# ~f]
+       (if f#
+         (do (f#) :ok)
+         :no-test))))


* src/clj/cljs/core.clj: change assert to throw js/Error instead of string

--- src/clj/cljs/core.clj
+++ src/clj/cljs/core.clj
@@ -490,13 +490,13 @@
   ([x]
      (when *assert*
        `(when-not ~x
-          (throw (cljs.core/str
-                   "Assert failed: " (cljs.core/pr-str '~x))))))
+          (throw (js/Error.
+                  (str "Assert failed: " (cljs.core/pr-str '~x)))))))
   ([x message]
      (when *assert*
        `(when-not ~x
-          (throw (cljs.core/str
-                  "Assert failed: " ~message "\n" (cljs.core/pr-str '~x)))))))
+          (throw (js/Error.
+                  (str "Assert failed: " ~message "\n" (cljs.core/pr-str '~x))))))))

 (defmacro ^{:private true} assert-args [fnname & pairs]
   `(do (when-not ~(first pairs)


improve find first process

improve find first process

--- src/cljs/sm/core.cljs
+++ src/cljs/sm/core.cljs
@@ -1,6 +1,6 @@
 (ns sm.core
   (:require-macros [wilkerdev.util.macros :refer [<? go-catch dochan]]
-                   [cljs.core.async.macros :refer [go]])
+                   [cljs.core.async.macros :refer [go alt!]])
   (:require [wilkerdev.util.nodejs :refer [lstat fopen fread http] :as node]
             [wilkerdev.util :as util]
             [wilkerdev.util.reactive :as r]
@@ -47,13 +47,26 @@

 (defn find-first [{:keys [sources path search-languages languages]}]
   (go-catch
-    (loop [sources sources]
-      (when-let [source (first sources)]
-        (let [[res] (sort-by #(* -1 (subtitle-language-score % languages)) (<? (sm/search-subtitles source path search-languages)))]
-          (if res
-            (-> (source-info source)
-                (assoc :subtitle res))
-            (recur (rest sources))))))))
+    (let [c (chan 1)
+          af (fn [source c]
+               (go
+                 (try
+                   (alt!
+                     (sm/search-subtitles source path search-languages)
+                       ([values]
+                         (r/throw-err values)
+                         (doseq [s (<? (sm/search-subtitles source path search-languages))]
+                           (>! c (assoc (source-info source) :subtitle s))))
+                     (async/timeout 5000) ([_]))
+                   (catch js/Error e
+                     (.log js/console "Error requesting" source (clj->js e)))
+                   (finally
+                     (close! c)))))]
+      (async/pipeline-async 5 c af (r/spool sources))
+
+      (let [sorter #(* -1 (subtitle-language-score (:subtitle %) languages))
+            subtitles (<? (async/into [] c))]
+        (first (sort-by sorter subtitles))))))

 (defn find-all [{:keys [sources path languages]}]
   (let [search (fn [source]


mild refactor and src-xpath is not a list of maps

--- src/crawler/crawl.clj
+++ src/crawler/crawl.clj
@@ -315,7 +315,7 @@
               src-xp  (-> queue first :src-xpath)
               src-nav-num (-> queue first :src-nav-num)
               body    (download-with-cookie url)
-
+
               ;; ask the rich extractor to sample and extract on this page.
               content    (try (rich-char-extractor/state-action
                                body url to-eliminate (clojure.set/union
@@ -323,17 +323,20 @@
                                                       (set [url])
                                                       (set (map :url queue))))
                               (catch Exception e nil))
+
+              score   (cur-nav-fraction body content)
+
               leaf?      (or (not body)
                              (rich-char-extractor/leaf?
-                              (first src-nav-num) (cur-nav-fraction body content)))
+                              (first src-nav-num)
+                              score))

               ;; doing something stupid?
               _          (println :leaf? leaf?)
               _          (println :src-score (try (double (first src-nav-num))
                                                   (catch Exception e nil)))
               _          (println :target-score (try
-                                                  (double
-                                                   (cur-nav-fraction body content))
+                                                  (double score)
                                                   (catch Exception e nil)))
               mined      (when-not leaf?
                            (rich-char-extractor/filter-content
@@ -352,19 +355,11 @@
                                 (map
                                  (fn [h]
                                    {:url h
-                                    :src-xpath (cons {:content xpath
-                                        ;:pagination
-                                        ;pagination
-                                                      }
-                                                     src-xp)
+                                    :src-xpath (cons xpath src-xp)
                                     :src-url url
-                                    :src-nav-num (cons (if body
-                                                         (cur-nav-fraction body content)
-                                                         0)
-                                                       src-nav-num)})
+                                    :src-nav-num (cons (if body score 0) src-nav-num)})
                                  hrefs))
-                              mined))))
-              _          (println :mined mined-links)]
+                              mined))))]
           (if (and (not leaf?) (seq mined-links))
             (recur (concat (rest queue)
                            mined-links)


adding pre keys

adding pre keys

--- src/docker/client.clj
+++ src/docker/client.clj
@@ -42,8 +42,8 @@

 (defn commit
   "Commit a container into an image"
-  {:pre [(every? (partial contains? spec) [:image :memory] )]}
   [node id m]
+  {:pre [(every? (partial contains? m) [:m :repo])]}
   (r/docker-post node (<< "commit?container=~{id}~(to-params m)") {}))

 (defn delete


supporting 'not satisfiable'

supporting 'not satisfiable'

--- src/evalback/core.clj
+++ src/evalback/core.clj
@@ -30,11 +30,13 @@
 (defmulti process-result (fn [r _ _ _] (class r)))
 (defmethod process-result EvalResult [res cbf introduced resp]
   (let [result (.getValue res)
-        bindings (into {} (.getSolutions res))]
+        bindings (into {} (.getSolutions res))
+        has-free-vars? (seq (.getFreeVariables res))]
     (into resp {:status :ok
                 :input cbf
                 :introduced introduced
                 :result result
+                :has-free-vars? has-free-vars?
                 :bindings bindings})))

 (defmethod process-result ComputationNotCompletedResult [res cbf _ resp]
@@ -129,24 +131,22 @@
     :else "false"
     ))

-(defn predicate-reply [result input bindings]
-  (let [has-free-vars? (seq bindings)]
-    (apply str "Predicate is " (pp-result has-free-vars? result) ".\n"
+(defn predicate-reply [result input has-free-vars? bindings]
+  (apply str "Predicate is " (pp-result has-free-vars? result) ".\n"
            (top-level-implication? input)
            (if has-free-vars? "\nSolution: \n" "")
-           (for [[k v] bindings] (str "  " k "=" v "\n")))))
-
-
-(defn valid-reply [result input introduced bindings]
+           (for [[k v] bindings] (str "  " k "=" v "\n"))))
+
+(defn valid-reply [result input introduced has-free-vars? bindings]
   (if introduced
     (expression-reply bindings introduced)
-    (predicate-reply result input bindings)))
-
-(defn old-json [{:keys [status result input introduced  bindings]}]
+    (predicate-reply result input has-free-vars? bindings)))
+
+(defn old-json [{:keys [status result input introduced has-free-vars? bindings]}]
   (json/write-str
    (if (= status :error)
      {:output (str "Error: " result)}
-     {:output (valid-reply result input introduced bindings)})))
+     {:output (valid-reply result input introduced has-free-vars? bindings)})))

 (defn get-api [] (.getInstance (Main/getInjector) Api))


cjl - Write correct json output of commands

--- src/icfp2015/core.clj
+++ src/icfp2015/core.clj
@@ -25,7 +25,7 @@
 (defn solve-game [game]
   { :problemId (:problemId game)
     :seed (:seed game)
-    :solution (map command-to-letter (get-commands dumb-ai game)) })
+    :solution (apply str (map command-to-letter (get-commands dumb-ai game))) })

 (def cli-options
   [["-f" "--file FILE" "Input filename"


Refactor to ensure small routes on print

--- modules/bidi/src/modular/bidi.clj
+++ modules/bidi/src/modular/bidi.clj
@@ -129,7 +129,7 @@
           (keyword? handler)
         (assoc res
                ::component ckey
-               :handler (cond-> (get-in handlers [ckey handler])
+               :handler (cond-> (get handlers handler)
                           ;; This should be based on given settings
                           add-exception-context? (wrap-capture-component-on-error :component ckey :handler handler)))
         ;; Otherwise continue to return the original result
@@ -156,7 +156,7 @@
                             ;; We wrap in some bidi middleware which
                             ;; allows us to form URIs via a
                             ;; keyword-path: [component-key handler-key]
-                            (->KeywordIndirection [(routes v)] ckey handlers add-exception-context?)]))])))
+                            (->KeywordIndirection [(routes v)] ckey (get handlers ckey) add-exception-context?)]))])))
   (stop [this] this)

   WebService


Use my email address to find GPG key

Use my email address to find GPG key

--- roles/clojure/files/profiles.clj
+++ roles/clojure/files/profiles.clj
@@ -1,4 +1,4 @@
-{:user {:signing {:gpg-key "8ED1CE42"}
+{:user {:signing {:gpg-key "james@logi.cl"}

         :dependencies [[alembic "0.2.1"]
                        [clj-stacktrace "0.2.7"]


Fixes #101 (stack overflow when using pprint in build.boot)

--- boot/pod/src/boot/util.clj
+++ boot/pod/src/boot/util.clj
@@ -171,13 +171,12 @@

 (defn auto-flush
   [writer]
-  (let [fmt #(if @*colorize?*
-               identity
-               (fn [s] (if (string? s)
-                         (ansi/strip-ansi s)
-                         s)))]
+  (let [strip? #(and (not @*colorize?*) (string? %))
+        strip  #(fn [s] (if (strip? s) (ansi/strip-ansi s) s))]
     (proxy [java.io.PrintWriter] [writer]
-      (write [s] (.write writer ((fmt) s)) (flush)))))
+      (write [s]
+        (.write writer ((strip) s))
+        (.flush writer)))))

 (defn extract-ids
   [sym]


Add disclaimer to autogenerated pom files.

--- src/leiningen/pom.clj
+++ src/leiningen/pom.clj
@@ -5,6 +5,12 @@
   (:import [org.apache.maven.model Model Parent Dependency Repository]
            [org.apache.maven.project MavenProject]
            [org.apache.maven.artifact.ant Pom]))
+
+(def #^{:doc "A notice to place at the bottom of generated files."} disclaimer
+     "\n<!-- This file was autogenerated by the Leiningen build tool.
+  Please do not edit it directly; instead edit project.clj and regenerate it.
+  It should not be considered canonical data. For more information see
+  http://github.com/technomancy/leiningen -->\n")

 (defn make-dependency [[dep version]]
   (doto (Dependency.)
@@ -40,10 +46,11 @@

 (defn pom [project & [args]]
   (let [pom-file (file (:root project) "pom.xml")]
-    (when (or (not (.exists pom-file))
-              (do (print "pom.xml exists; overwrite? ") (flush)
-                  (re-find #"^y(es)?" (.toLowerCase (read-line)))))
-      (.writeModel (MavenProject. (make-model project))
-                   (writer pom-file))
-      (println "Wrote pom.xml"))
+    (with-open [w (writer pom-file)]
+      (when (or (not (.exists pom-file))
+                (do (print "pom.xml exists; overwrite? ") (flush)
+                    (re-find #"^y(es)?" (.toLowerCase (read-line)))))
+        (.writeModel (MavenProject. (make-model project)) w)
+        (.write w disclaimer)
+        (println "Wrote pom.xml")))
     (.getAbsolutePath pom-file)))


Remove boot verbosity hack

Remove boot verbosity hack

--- src/less4clj/util.clj
+++ src/less4clj/util.clj
@@ -7,18 +7,9 @@

 (def ^:dynamic *verbosity* 1)

-; Hack to detect boot verbosity
-(defn- get-verbosity []
-  (try
-    (require 'boot.util)
-    ; Deref var and atom
-    @@(resolve 'boot.util/*verbosity*)
-    (catch Exception _
-      *verbosity*)))
-
 (defn- print*
   [verbosity args]
-  (when (>= (get-verbosity) verbosity)
+  (when (>= *verbosity* verbosity)
     (binding [*out* *err*]
       (apply printf args) (flush))))


Refactor: extract str-map and simplify code

--- src/archi/core.clj
+++ src/archi/core.clj
@@ -93,24 +93,26 @@
        (apply str (interpose ", " (map wrap-in-quotes coll)))
        "]"))

+(defn str-map [f coll]
+  (apply str (map f coll)))
+
 (defn make-scripts [edges]
   (let [edges-by-feature (group-by (comp :feature #(nth % 2)) edges)]
     [:script {:language "javascript"}
      (str "\n"
           (slurp "src/archi/highlight.js")
           "var data = {};\n"
-          (apply str (map (fn [[n1 n2 m]]
-                            (str "data['" n1 "'] = data['" n2 "'] = {nodes: ['" n1 "', '" n2 "'], edges: ['" (:id m) "']};\n"))
-                          edges))
-          (apply str (map (fn [edges]
-                            (let [nodes (distinct (sort (mapcat #(take 2 %) edges)))
-                                  edges (distinct (sort (map (fn [[n1 n2 m]] (:id m)) edges)))]
-                              (str "var nodes = " (js-array nodes) ";\n"
-                                   "var edges = " (js-array edges) ";\n"
-                                   "var d = {nodes: nodes, edges: edges};\n"
-                                   (apply str (for [e edges]
-                                                (str "data['" e "'] = d;\n"))))))
-                          (vals edges-by-feature)))
+          (str-map (fn [[n1 n2 m]]
+                     (str "data['" n1 "'] = data['" n2 "'] = {nodes: ['" n1 "', '" n2 "'], edges: ['" (:id m) "']};\n"))
+                   edges)
+          (str-map (fn [edges]
+                     (let [nodes (distinct (sort (mapcat #(take 2 %) edges)))
+                           edges (distinct (sort (map (fn [[n1 n2 m]] (:id m)) edges)))]
+                       (str "var d = {nodes: " (js-array nodes) ", edges: " (js-array edges) "};\n"
+                            (str-map (fn [e]
+                                       (str "data['" e "'] = d;\n"))
+                                     edges))))
+                   (vals edges-by-feature))
           "highlight(data);\n"
           )]))


Better formatting.

Better formatting.

--- src/asid/nodes.clj
+++ src/asid/nodes.clj
@@ -45,11 +45,12 @@

 (defn- objects-by-direction [start type dir which-end]
   (if (has-node? start)
-    (let [found-nodes (remove nil? (map #(if-let [end-node (-> % which-end)]
-                                           (nn/fetch-from end-node)
-                                           nil)
-                                        (nrl/traverse (:node-id start)
-                                                      :relationships [{:direction dir :type type}])))]
+    (let [found-nodes (remove nil?
+                              (map #(if-let [end-node (-> % which-end)]
+                                      (nn/fetch-from end-node)
+                                      nil)
+                                   (nrl/traverse (:node-id start)
+                                                 :relationships [{:direction dir :type type}])))]
       (map node-to-object found-nodes))
     []))


license and moving image-desc

license and moving image-desc

--- src/aws/common.clj
+++ src/aws/common.clj
@@ -1,3 +1,14 @@
+(comment
+  Celestial, Copyright 2012 Ronen Narkis, narkisr.com
+  Licensed under the Apache License,
+  Version 2.0  (the "License") you may not use this file except in compliance with the License.
+  You may obtain a copy of the License at http://www.apache.org/licenses/LICENSE-2.0
+  Unless required by applicable law or agreed to in writing, software
+  distributed under the License is distributed on an "AS IS" BASIS,
+  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+  See the License for the specific language governing permissions and
+  limitations under the License.)
+
 (ns aws.common
   "Common functionality like connection settings"
   (:require
@@ -15,3 +26,6 @@
 (defn instance-desc [endpoint instance-id & ks]
   (-> (with-ctx ec2/describe-instances (ec2/instance-id-filter instance-id))
       first :instances first (get-in ks)))
+
+(defn image-id [machine]
+  (hypervisor :aws :ostemplates (machine :os) :ami))


Fix exception catch in server. fatal and error are macros.

--- src/incise/server.clj
+++ src/incise/server.clj
@@ -29,7 +29,10 @@
     (try
       (apply func args)
       (catch Exception e
-        ((if bubble error fatal) (with-out-str (print-cause-trace e)))
+        (let [cause-trace (with-out-str (print-cause-trace e))]
+         (if bubble
+           (error cause-trace)
+           (fatal cause-trace)))
         (when bubble (throw e))))))

 (def app (-> routes


Add new middlewares to server.

Add new middlewares to server.

--- src/incise/server.clj
+++ src/incise/server.clj
@@ -2,9 +2,13 @@
   (:require (compojure [route :refer [resources not-found]]
                        [core :refer [defroutes]])
             (hiccup [page :refer [html5]])
+            [incise.load :refer [load-all]]
             (ring.middleware [reload :refer [wrap-reload]]
+                             [incise :refer [wrap-incise]]
                              [stacktrace :refer [wrap-stacktrace]])
             [dieter.core :refer [asset-pipeline]]
+            [taoensso.timbre :refer [error]]
+            [clojure.stacktrace :refer [print-cause-trace]]
             [org.httpkit.server :refer [run-server]]))

 (defroutes routes
@@ -17,10 +21,27 @@
                (assoc request :uri (str uri "index.html"))
                request))))

+(defn wrap-parsers-reload [handler]
+  (fn [request]
+    (load-all)
+    (handler request)))
+
+(defn wrap-log-exceptions [func]
+  "Log (i.e. print) exceptions received from the given function."
+  (fn [& args]
+    (try
+      (apply func args)
+      (catch Exception e
+        (error (with-out-str (print-cause-trace e)))))))
+
 (def app (-> routes
              (wrap-static-index)
              (wrap-reload :dirs ["src" "spec"])
+             (wrap-incise :out "resources/public"
+                          :in "resources/content")
+             (wrap-parsers-reload)
              (wrap-stacktrace)
+             (wrap-log-exceptions)
              (asset-pipeline {:cache-mode :development
                               :engine :rhino
                               :compress false})))
@@ -34,17 +55,20 @@
 (defn serve
   "Start the development server"
   [& [port thread-count]]
+  (load-all)
   (run-server app {:port (or port
                              (Integer. (getenv "PORT" "5000")))
                    :thread (or thread-count
                                (Integer. (getenv "THREAD_COUNT" "4")))}))

-(def server nil)
+(def server (atom nil))

 (defn defserver
   "Start a server and bind the result to a var, 'server'."
   [& args]
-  (alter-var-root #'server (fn [& _] (apply serve args))))
+  (reset! server (apply serve args)))

 (defn stop-server []
-  (when server (server)))
+  (when @server
+    (@server)
+    (reset! server nil)))


Renamed init to test-init.

Renamed init to test-init.

--- src/cbfg/core.cljs
+++ src/cbfg/core.cljs
@@ -18,6 +18,8 @@

 (println cbfg.ddl/hi)

+;; ------------------------------------------------
+
 (defn get-el-value [elId]
   (.-value (gdom/getElement elId)))

@@ -29,7 +31,9 @@
     (gevents/listen el type (fn [e] (put! out e)))
     out))

-(defn init [init-event-delay]
+;; ------------------------------------------------
+
+(defn test-init [init-event-delay]
   (let [clicks (listen (gdom/getElement "go") "click")
         event-delay (atom init-event-delay)
         event-ch (chan)
@@ -53,10 +57,10 @@
              (println "output" res))))
     event-delay))

-(def event-delay (init 0))
+(def test-event-delay (test-init 0))

-(defn change-event-delay [d]
-  (reset! event-delay d))
+(defn change-test-event-delay [d]
+  (reset! test-event-delay d))

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


add PG_PASSWORD env

add PG_PASSWORD env

--- src/luffer/models.clj
+++ src/luffer/models.clj
@@ -10,6 +10,7 @@
 (defdb db (postgres {:db (System/getenv "PG_DATABASE")
                      :host (or (System/getenv "PG_PORT_5432_TCP_ADDR") (System/getenv "PG_HOST"))
                      :port (or (System/getenv "PG_PORT_5432_TCP_PORT") (System/getenv "PG_PORT") 5432)
+                     :password (System/getenv "PG_PASSWORD")
                      :user (System/getenv "PG_USER")}))

 (declare plays users tracks shows tours venues api_clients)


Replace loop/recur with some

Replace loop/recur with some

--- src/io/aviso/rook.clj
+++ src/io/aviso/rook.clj
@@ -40,11 +40,7 @@
   (let [arg-kw (keyword (name argument))
         api-kw (keyword (.replace (name argument) "-" "_"))]
     (or
-      (loop [[arg-resolver & arg-resolvers] arg-resolvers]
-        (when arg-resolver
-          (or
-            (arg-resolver arg-kw request)
-            (recur arg-resolvers))))
+      (some #(% arg-kw request) arg-resolvers)
       (when (= :request arg-kw) request)
       (get (:route-params request) api-kw)
       (get (:route-params request) arg-kw)


Remove Unused Function partition-by

Remove Unused Function partition-by

--- src/lens/reducers.clj
+++ src/lens/reducers.clj
@@ -1,41 +1,6 @@
 (ns lens.reducers
   (:require [clojure.core.reducers :as r])
-  (:refer-clojure :exclude [empty? partition-by count]))
-
-(defn partition-by
-  "Applies f to each value in coll, splitting it each time f returns
-  a new value."
-  [f coll]
-  (reify
-    clojure.core.protocols/CollReduce
-    (coll-reduce [this f1]
-      (clojure.core.protocols/coll-reduce this f1 (f1)))
-    (coll-reduce [_ f1 init]
-      (let [result (clojure.core.protocols/coll-reduce
-                     coll
-                     (fn [accum v]
-                       (let [r (f v)
-                             vs (:vs accum)]
-                         (cond
-                           (= r (:last accum))
-                           (assoc! accum :vs (conj! vs v))
-
-                           (nil? vs)
-                           (-> accum
-                               (assoc! :vs (transient [v]))
-                               (assoc! :last r))
-
-                           :else
-                           (let [ret (f1 (:ret accum) (persistent! vs))]
-                             (if (reduced? ret)
-                               (reduced {:ret @ret})
-                               (assoc! accum :ret ret
-                                       :vs (transient [v])
-                                       :last r))))))
-                     (transient {:ret init}))]
-        (if (:vs result)
-          (f1 (:ret result) (persistent! (:vs result)))
-          (:ret result))))))
+  (:refer-clojure :exclude [empty? count]))

 (defn empty? [coll]
   (clojure.core/empty? (into [] (r/take 1 coll))))


Added notification upon successfully added note.

--- src/notes/handler.clj
+++ src/notes/handler.clj
@@ -26,26 +26,31 @@
     (println (mc/count "notes"))
     (mc/find-maps "notes")))

-(defn front-page [notes]
+(defn front-page [notes added?]
   (html [:h1 "Notes!"]
+        (if added? (html "Note added!" [:br]))
         (println "Notes from db: " notes)
         [:table
          [:tr [:th "Subject"] [:th "Note"]]
         (for [note notes]
           [:tr [:td (:heading note)] [:td (:body note)]])]
         (form-to [:post "/"]
+                 "Heading"
+                 [:br]
                  (text-field :heading)
+                 [:br]
+                 "Note"
                  [:br]
                  (text-area :body)
                  [:br]
                  (submit-button "submit"))))

 (defroutes app-routes
-  (GET "/" [] (front-page (find-notes)))
+  (GET "/" [] (front-page (find-notes) false))
   (POST "/" [heading body]
         (do
           (save-note! {:heading heading :body body})
-          (front-page (find-notes))))
+          (front-page (find-notes) true)))
   (route/not-found "Not Found"))

 (def app


(chore) change name

(chore) change name

--- src/papaline/core.clj
+++ src/papaline/core.clj
@@ -220,7 +220,7 @@
                               timeout-val))))
   (stop! [this]))

-(defn- ^CompletableFuture run-stage [^RealizedStage current-stage ctx]
+(defn- ^CompletableFuture run-stage* [^RealizedStage current-stage ctx]
   (let [task (.stage-fn current-stage)
         args (:args ctx)
         args (if (or (nil? args) ;; empty arguments
@@ -250,12 +250,12 @@
                 args-array (if (not-empty (:args ctx))
                              (.toArray ^clojure.lang.ArraySeq (:args ctx))
                              (into-array []))]
-            (letfn [(clos [stgs ctx]
+            (letfn [(run-stages [stgs ctx]
                       (if-let [^RealizedStage current-stage (first stgs)]
                         (let [current-stage-name (:name current-stage)
                               stage-name-aware-error-handler (partial process-exception current-stage-name error-handler)
                               processor (Thread/currentThread)]
-                          (.handle (run-stage current-stage ctx)
+                          (.handle (run-stage* current-stage ctx)
                                    (reify BiFunction
                                      (apply [_ next-args ex]
                                        (if (= processor (Thread/currentThread))
@@ -281,10 +281,10 @@
                                 (error-handler (UnsupportedOperationException. "Fork or Join is not supported in AsyncDedicatedThreadPoolPipeline"))
                                 (catch Exception _)))
                             (.complete result ctx))
-                          (clos (rest stgs) ctx))))]
+                          (run-stages (rest stgs) ctx))))]
               (.submit ^ExecutorService executor (wrap-with-arguments-aware-callable (fn []
                                                                                (when pre-hook (pre-hook ctx))
-                                                                                (clos stages ctx))
+                                                                                (run-stages stages ctx))
                                                                                args-array)))
             result))
   IPipeline


print stack trace when there's exception

--- src/papaline/core.clj
+++ src/papaline/core.clj
@@ -36,9 +36,13 @@
                          (go
                            (let [ctx (try
                                        (assoc ctx :args (apply task (:args ctx)))
-                                       (catch clojure.lang.ExceptionInfo e
-                                         (when (:abort (ex-data e))
-                                           (merge ctx (ex-data e)))))
+                                       (catch Exception e
+                                         (if (and (instance? clojure.lang.ExceptionInfo e)
+                                                  (:abort (ex-data e)))
+                                           (merge ctx (ex-data e))
+                                           (do
+                                             (.printStackTrace e)
+                                             (throw e)))))
                                  out-chan (or out-chan (:wait ctx))]
                              (when out-chan
                                (cond


don't let the mac menu only partially pick up keyboard shortcuts

Signed-off-by: Chris Granger <5654cde260ae99bc4d30054171b8bcd902efd19a@gmail.com>

--- src/lt/objs/menu.cljs
+++ src/lt/objs/menu.cljs
@@ -83,8 +83,9 @@

 (defn command->menu-binding [cmd]
   (let [ks (first (keyboard/cmd->current-binding cmd))
+        multi-part? (next (string/split ks " "))
         ks (string/split ks "-")]
-    (when (seq ks)
+    (when (and (seq ks) (not multi-part?))
       {:key (if (= "space" (last ks))
               " "
               (last ks))


make sure messages for a given channel are handled sequentially

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -1216,12 +1216,50 @@
                                    :cust (some-> req :ring-req :auth :cust)
                                    :extra-data (select-keys req [:?data :event])))))))

+(defn pop-message [lock-atom]
+  (let [val @lock-atom]
+    (when-let [message (first (:ready-messages val))]
+      (when (compare-and-set! lock-atom val (update-in val [:ready-messages] subvec 1))
+        message))))
+
+(defn lock-channel [lock-atom ch-id]
+  (let [val @lock-atom]
+    (and (not (contains? (:ch-ids val) ch-id))
+         (compare-and-set! lock-atom val (update-in val [:ch-ids] conj ch-id)))))
+
+(defn unlock-channel [lock-atom ch-id]
+  (swap! lock-atom
+         (fn [s]
+           (-> s
+             (update-in [:ch-ids] disj ch-id)
+             (update-in [:locked-messages] dissoc ch-id)
+             (update-in [:ready-messages]
+                        (fn [msgs]
+                          (if-let [queued (seq (get-in s [:locked-messages ch-id]))]
+                            (apply conj msgs queued)
+                            msgs)))))))
+
+(defn add-message-to-secondary-queue [lock-atom ch-id msg]
+  (swap! lock-atom
+         (fn [s]
+           (if (contains? (:ch-ids s) ch-id)
+             (update-in s [:locked-messages ch-id] (fnil conj []) msg)
+             (update-in s [:ready-messages] conj msg)))))
+
+(defonce lock-atom (atom {:ch-ids #{}
+                          :ready-messages []
+                          :locked-messages {}}))
+
 (defn setup-tal-handlers []
   (let [recv-queue (tal/recv-queue tal/talaria-state)]
     (mapv (fn [i]
             (future (while true
-                      (let [msg (.take recv-queue)]
-                        (utils/straight-jacket (handle-tal-msg msg))))))
+                      (let [msg (or (pop-message lock-atom) (.take recv-queue))]
+                        (if (lock-channel lock-atom (:tal/ch-id msg))
+                          (do
+                            (utils/straight-jacket (handle-tal-msg msg))
+                            (unlock-channel lock-atom (:tal/ch-id msg)))
+                          (add-message-to-secondary-queue lock-atom (:tal/ch-id msg) msg))))))
           (range (.availableProcessors (Runtime/getRuntime))))))

 (defn close-ws


Advance playhead in increments

Advance playhead in increments

* No longer just set it to current time.  Now, add delta of current and previous time to playhead.

--- src/playmary/one.cljs
+++ src/playmary/one.cljs
@@ -109,6 +109,7 @@
      :w 0 :h 0 :sound-ready false
      :px-per-ms 0.04
      :start start
+     :previous-time start
      :playhead start}))

 (defn add-synths-to-instrument
@@ -218,5 +219,9 @@
        (condp = c
          c-orientation-change (recur (update-size instrument canvas-id))
          c-touch (recur (fire-touch-data-on-instrument instrument data))
-         (recur (assoc instrument :playhead (.getTime (js/Date.))))))))
+         (recur (let [now (.getTime (js/Date.))]
+                  (-> instrument
+                      (assoc :playhead (+ (instrument :playhead)
+                                          (- now (instrument :previous-time))))
+                      (assoc :previous-time now))))))))
   )


fixes for vectors

fixes for vectors

--- src/semitone/core.clj
+++ src/semitone/core.clj
@@ -12,6 +12,11 @@
             MidiSystem MidiMessage MetaMessage MetaEventListener
             SysexMessage ShortMessage Sequencer Sequence MidiEvent Track]
            [java.nio ByteBuffer]))
+
+(defn vec-rest [coll]
+  (if (vector? coll)
+    (vec (clojure.core/rest coll))
+    (clojure.core/rest coll)))

 (defn parse-state [notes state]
   (if (empty? notes)
@@ -31,7 +36,7 @@
                                         1 3))
                                  3)
                    (:position state))))
-          (merge state (first notes) {:notes (rest notes)})))
+          (merge state (first notes) {:notes (vec-rest notes)})))
       state)))

 (defn parse-length [notes state]
@@ -44,7 +49,7 @@
         (merge state {:key (if (< length 0) nil (:key state))
                       :length (Math/abs (* 4.0 length ppq))
                       :repeat-length nil
-                      :notes (rest notes)})
+                      :notes (vec-rest notes)})
         (symbol? length)
         (if-let [m (re-matches #"(-|)((?:[xwhqistjlmno]\.*)+)" (name length))]
           (let [length-map {"x" 2 "w" 1 "h" 1/2 "q" 1/4 "i" 1/8 "s" 1/16 "t" 1/32
@@ -57,12 +62,12 @@
                                                    ppq)
                                                (re-seq #"\G([xwhqistjlmno])(\.*)" (get m 2))))
                           :repeat-length nil
-                          :notes (rest notes)}))
+                          :notes (vec-rest notes)}))
           (if-let [m (re-matches #"([-=])[-=]*" (name length))]
             (do
               (merge state {:repeat-length (* (:length state) (count (name length)))
                             :key (if (= "=" (get m 1)) (:key state) nil)
-                            :notes (rest notes)}))
+                            :notes (vec-rest notes)}))
             state))
         :else state))))

@@ -71,7 +76,7 @@
   (if (empty? notes)
     state
     (if (= (type (first notes)) MidiMessage)
-      (merge state {:key (first notes) :notes (rest notes)})
+      (merge state {:key (first notes) :notes (vec-rest notes)})
       (let [note (clojure.string/replace (name (first notes)) #"__[0-9]+__auto__$" "#")]
         ;; note on/off / key pressure by key name
         (if-let [m (re-matches #"(&|-|)([a-gA-G])(#|##|b|bb|n|)(-?[0-9]+|)(-|)" note)]
@@ -91,19 +96,19 @@
                                  :else nil)
                           :key (mod (+ (* (+ 1 octave) 12) key accidental) 128)
                           :param (if key-pressure :key-pressure :octave)
-                          :notes (rest notes)}))
+                          :notes (vec-rest notes)}))
           ;; cc
           (if-let [m (re-matches #"cc([0-9]+)" note)]
             (merge state {:key-type ShortMessage/CONTROL_CHANGE
                           :key (mod (Integer. (get m 1)) 128)
                           :param :cc-value
-                          :notes (rest notes)})
+                          :notes (vec-rest notes)})
             ;; program change
             (if-let [m (re-matches #"prog([0-9]+)" note)]
               (merge state {:key-type ShortMessage/PROGRAM_CHANGE
                             :key (mod (Integer. (get m 1)) 128)
                             :param nil
-                            :notes (rest notes)})
+                            :notes (vec-rest notes)})
               ;; channel pressure, pitch bend, note on/off / key pressure by key number
               (if-let [m (re-matches #"(&&|\^|&k|k|-k)(>+|<+|)(-?(?:[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.[0-9]*)(?:[eE]-?[0-9]+)?|)(-|)" note)]
                 (let [max-value (if (= "^" (get m 1)) 16384 128)
@@ -143,7 +148,7 @@
                             param value
                             :param param}
                            :else (throw (Exception. (format "Unhandled message: %s" (get m 1)))))
-                         {:notes (rest notes)}))
+                         {:notes (vec-rest notes)}))
                 state))))))))

 (defn parse-param [notes state]
@@ -171,7 +176,7 @@
                                            :else value)]
                                [{param value}]))
                      (re-seq #"\G(!|\?|&|@|)(>+|<+|)(-?(?:[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.[0-9]*)(?:[eE]-?[0-9]+)?|)" token)))
-         {:notes (rest notes)})
+         {:notes (vec-rest notes)})
         state))))

 (defn make-sequencer [& [sequence]]
@@ -222,12 +227,12 @@
               state (cond
                       (or (seq? (first notes)) (vector? (first notes)))
                       (merge (compose (first notes) sequencer state)
-                             {:notes (rest notes)}
+                             {:notes (vec-rest notes)}
                              (if (vector? notes) {:position position} {}))
                       (map? (first notes))
                       (parse-state notes state)
                       (keyword? (first notes))
-                      (parse-state (cons {(first notes) (first (rest notes))} (rest (rest notes))) state)
+                      (parse-state (cons {(first notes) (first (vec-rest notes))} (vec-rest (vec-rest notes))) state)
                       :else
                       (let [notes (:notes state)
                             state (parse-param (:notes state) state)
@@ -269,7 +274,10 @@
                                                          (:displacement state))))))
                           :else
                           (throw (Exception. (format "Could not parse key: %s" key))))
-                        (merge state {:position (+ (:position state) (or (:repeat-length state) (:length state)))})))
+                        (merge state {:position
+                                      (if (vector? (:notes state))
+                                        (:position state)
+                                        (+ (:position state) (or (:repeat-length state) (:length state))))})))
               notes (:notes state)]
           (recur notes (merge state {:repeat-length nil})))
         state))))


drop texts, simplify code

drop texts, simplify code

--- src/sormilla/core.clj
+++ src/sormilla/core.clj
@@ -23,11 +23,6 @@
                      (Color.   64  192  64    32)
                      (Color.   64  192  64    64)])

-(def font (.deriveFont gui/cutive (float 20.0)))
-
-(def ^String message-fmt  "  %+5.2f    %+5.2f    %+5.2f")
-(def ^String message      "r        p        y      ")
-
 (def pitch-bounds (partial math/bound -0.5 0.5))
 (def yaw-bounds (partial math/bound -0.4 0.4))
 (def roll-bounds (partial math/bound -1.2 1.2))
@@ -44,12 +39,7 @@
      ~@body
      (.setTransform ~g t#)))

-(defn draw-hand [^Graphics2D g w h tw th td {:keys [quality roll pitch yaw]} {:keys [norm lo]}]
-  (.setColor g hud-hi-color)
-  (.drawString g
-    (format "  %+5.2f    %+5.2f    %+5.2f" roll pitch yaw)
-    (int (- (/ w 4) (/ tw 2)))
-    (int (- h td)))
+(defn draw-hand [^Graphics2D g w h {:keys [quality roll pitch yaw]} {:keys [norm lo]}]
   (when (pos? quality)
     (.setColor g (nth quality-colors (dec quality)))
     (doseq [n (range 5 (* 10 quality) 10)]
@@ -75,18 +65,10 @@
 (defn render [^Graphics2D g ^long w ^long h frame]
   (.setColor g background-color)
   (.fillRect g 0 0 w h)
-  (let [[left-hand right-hand] frame
-        fm         (.getFontMetrics g font)
-        tw         (.stringWidth fm message)
-        th         (.getHeight fm)
-        td         (.getDescent fm)]
-    (.setRenderingHint g RenderingHints/KEY_TEXT_ANTIALIASING RenderingHints/VALUE_TEXT_ANTIALIAS_ON)
-    (.setRenderingHint g RenderingHints/KEY_ANTIALIASING RenderingHints/VALUE_ANTIALIAS_ON)
+  (.setRenderingHint g RenderingHints/KEY_ANTIALIASING RenderingHints/VALUE_ANTIALIAS_ON)
+  (let [[left-hand right-hand] frame]
     (.setColor g hud-color)
-    (.setFont g font)
     (.drawLine g (/ w 2 ) 0 (/ w 2) h)
-    (.drawString g message (int (- (/ w 4) (/ tw 2))) (int (- h td)))
-    (.drawString g message (int (- (* 3 (/ w 4)) (/ tw 2))) (int (- h td)))
     (.setColor g hud-lo-color)
     (doseq [x (map (fn [v] (int (* v (/ w 20.0)))) (range 20))]
       (.drawLine g x 0 x h))
@@ -97,10 +79,10 @@
     (doseq [y (map (fn [v] (int (* v (/ h 50.0)))) (range 50))]
       (.drawLine g (- (/ w 4) 5) y (+ (/ w 4) 5) y)
       (.drawLine g (- (* 3 (/ w 4)) 5) y (+ (* 3 (/ w 4)) 5) y))
-    (when left-hand (draw-hand g w h tw th td left-hand (:left hand-colors)))
+    (when left-hand (draw-hand g w h left-hand (:left hand-colors)))
     (.setClip g (Rectangle. 0 0 (inc w) (inc h)))
     (.translate g (double (/ w 2)) (double 0.0))
-    (when right-hand (draw-hand g w h tw th td right-hand (:right hand-colors)))))
+    (when right-hand (draw-hand g w h right-hand (:right hand-colors)))))

 (defn dummy-source []


Add docstring to table function on dsl namespace.

--- src/suricatta/dsl.clj
+++ src/suricatta/dsl.clj
@@ -229,6 +229,7 @@
   (val* v))

 (defn table
+  "Create a table instance."
   [data & {:keys [alias] :as opts}]
   (defer
     (let [f (table* data)]


a bit of code refactor

a bit of code refactor

--- src/my_todo/core.cljs
+++ src/my_todo/core.cljs
@@ -15,14 +15,23 @@
   (atom
     {:comments [] }))

-;;event handlers
+;;ajax

 (defn simple-handler [response]
   (.log js/console (str response)))

+(defn get-comments [f res]
+  (f res))
+
 (defn error-handler [{:keys [status status-text]}]
   (.log js/console (str "something bad happened: " status " " status-text)))

+(defn load-data [comm]
+  (GET "http://localhost:3000/comments"
+    {:response-format :json
+     :keywords? true
+     :handler (partial get-comments #(put! comm [:init %] ))
+     :error-handler error-handler}))

 (defn save-commemnt [new-comment]
   (POST "http://localhost:3000/comments"
@@ -30,6 +39,8 @@
      :format :json
      :handler simple-handler
      :error-handler error-handler}))
+
+;;event handlers

 (defn add-comment [evt owner {:keys [author text comm] :as data}]
   (.preventDefault evt)
@@ -80,28 +91,16 @@

 ;;main component

-(defn handler [f res]
-  (f res))
-
-(defn load-data [comm]
-  (GET "http://localhost:3000/comments"
-    {:response-format :json
-     :keywords? true
-     :handler (partial handler #(put! comm [:init %] ))
-     :error-handler error-handler}))
-
-;;put! comm [:add {:author "ar" :text "tr"}]
-;;#(put! comm [:add {:author "ra" :text "rt"}])
+(defn handle-comm-event [t app val]
+  (case t
+    :add (om/transact! app :comments #(conj % val))
+    :init (om/update! app {:comments val})
+    nil))

 (defn render-comment-list [{:keys [comments]}]
   (apply dom/ul #js {:className "commentList"}
     (om/build-all comment-view comments)))

-(defn handle-event [t app val]
-  (case t
-    :add (om/transact! app :comments #(conj % val))
-    :init (om/update! app {:comments val})
-    nil))

 (defn comment-box [app owner]
     (reify
@@ -113,7 +112,7 @@
            (load-data comm)
            (while true
             (let [ [t value] (<! comm)]
-              (handle-event t app value))))))
+              (handle-comm-event t app value))))))

     om/IRenderState
     (render-state [_ {:keys [comm]}]


Make sure vubis bulk import actually sets the productions to structured

--- src/mdr2/views.clj
+++ src/mdr2/views.clj
@@ -233,6 +233,8 @@

 (defn production-bulk-import
   [productions]
+  ;; FIXME: maybe the whole create and set structured should be in a
+  ;; transaction
   (let [created (doall (map (fn [[_ p]]
                               (-> p
                                   prod/parse
@@ -242,11 +244,12 @@
         errors (remove map? created)
         new (filter map? created)]
     (doseq [p new]
-      ;; productions from vubis do not need any manual structuring.
-      ;; They get their standard structure from a default template
-      prod/set-state-structured!
-      ;; write the dtbook template file
-      dtbook/dtbook-file)
+      (-> p
+       ;; productions from vubis do not need any manual structuring.
+       ;; They get their standard structure from a default template
+       prod/set-state-structured!
+       ;; write the dtbook template file
+       dtbook/dtbook-file))
     (-> (response/redirect-after-post "/")
         (cond-> (seq errors)
           (assoc :flash {:warnings (for [e errors]


Improved strucutre comments.

Improved strucutre comments.


whitespace

whitespace

--- src/pc/http/sente.clj
+++ src/pc/http/sente.clj
@@ -164,7 +164,7 @@
                                                                   (vals subs)))]
     (if-let [remainder (if (contains? available-remainders requested-remainder)
                          requested-remainder
-                         (first available-remainders ))]
+                         (first available-remainders))]
       (let [used-client-parts (web-peer/client-parts-for-ns db document-id)
             ;; do something to protect against over 100K eids
             ;; XXX should we ensure in the transactor that ids increase properly?


Get function directly from screen object

--- src/play_clj/core.clj
+++ src/play_clj/core.clj
@@ -553,7 +553,7 @@
     (run! my-other-screen :on-show)
     (run! my-other-screen :on-change-color :color :blue)"
   [screen-object fn-name & options]
-  (let [execute-fn! (-> screen-object :screen deref :execute-fn!)
+  (let [execute-fn! (:execute-fn! screen-object)
         screen-fn (-> screen-object :options (get fn-name))]
     (apply execute-fn! screen-fn options)
     nil))


Make promise printable in all platforms.

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -27,6 +27,7 @@
   (:require [cats.core :as m]
             [cats.context :as mc]
             [cats.protocols :as mp]
+            [cats.util :as mutil]
             [promesa.protocols :as p]
             #?(:cljs [org.bluebird]))
   #?(:clj
@@ -73,6 +74,15 @@
      mp/Contextual
      (-get-context [_] promise-context)

+     mp/Printable
+     (-repr [it]
+       (str "#<Promise ["
+            (cond
+              (p/-pending? it) "pending"
+              (p/-rejected? it) "rejected"
+              :else "resolved")
+            "]>"))
+
      mp/Extract
      (-extract [it]
        (if (.isRejected it)
@@ -99,6 +109,15 @@
    (extend-type CompletionStage
      mp/Contextual
      (-get-context [_] promise-context)
+
+     mp/Printable
+     (-repr [it]
+       (str "#<Promise ["
+            (cond
+              (p/-pending? it) "pending"
+              (p/-rejected? it) "rejected"
+              :else "resolved")
+            "]>"))

      mp/Extract
      (-extract [it]
@@ -147,6 +166,9 @@
        (and (not (.isCompletedExceptionally it))
             (not (.isCancelled it))
             (not (.isDone it))))))
+
+#?(:cljs (mutil/make-printable js/Promise)
+   :clj (mutil/make-printable CompletionStage))

 #?(:clj
    (extend-protocol p/IPromiseFactory


Unwrap promise on future macro.

Unwrap promise on future macro.

--- src/promesa/core.cljc
+++ src/promesa/core.cljc
@@ -397,8 +397,12 @@
    (defmacro future
      "Analogous to `clojure.core/future` that returns a promise instance
      instead of the `Future`. Usefull for execute synchronous code in a
-     separate thread (Also works in cljs)."
+     separate thread (also works in cljs)."
      [& body]
-     `(exec/submit (fn [] ~@body))))
-
-
+     `(->> (exec/submit (fn []
+                          (c/let [f# (fn [] ~@body)]
+                            (pt/-promise (f#)))))
+           (mapcat' identity))))
+
+
+


Remove commented code.

Remove commented code.

--- src/promesa/core.cljs
+++ src/promesa/core.cljs
@@ -153,7 +153,6 @@
   array are fulfilled."
   [promises]
   (m/sequence promises))
-  ;; (.all js/Promise (clj->js promises)))

 (defn any
   "Given an array of promises, return a promise


Split tagged values with a line when the value is a collection.

--- src/puget/printer.clj
+++ src/puget/printer.clj
@@ -170,16 +170,23 @@
   (if *strict-mode*
     (throw (IllegalArgumentException.
              (str "No canonical representation for " (class r) ": " r)))
-    [:span (color-doc :delimiter "#") (-> r class .getName) (canonize-map r)]))
+    [:span
+     (color-doc :delimiter "#")
+     (.getName (class r))
+     (canonize-map r)]))

 (prefer-method canonize clojure.lang.IRecord clojure.lang.IPersistentMap)

 (defmethod canonize :tagged-value
-  [v]
-  [:span (color-doc :tag (str \# (data/edn-tag v)))
-    " " (canonize (data/edn-value v))])
+  [tv]
+  (let [tag   (data/edn-tag tv)
+        value (data/edn-value tv)]
+    [:span
+     (color-doc :tag (str \# tag))
+     (if (coll? value) :line " ")
+     (canonize value)]))

 (defmethod canonize :default
@@ -187,7 +194,8 @@
   (if *strict-mode*
     (throw (IllegalArgumentException.
              (str "No canonical representation for " (class value) ": " value)))
-    [:span (color-doc :class-delimiter "#<")
+    [:span
+     (color-doc :class-delimiter "#<")
      (color-doc :class-name (.getName (class value)))
      " " (str value)
      (color-doc :class-delimiter ">")]))


More special handling of ‘delay’ statements.  Eliminates a warning that was hidden by all of the previous chatter in the test output.

--- src/pamela/htn.clj
+++ src/pamela/htn.clj
@@ -1573,7 +1573,9 @@
                                                  (if plant-id (str plant-id "."))
                                                  interface))
                                  :display-name (str (:display-name details_)
-                                                    (seq (to-pamela (:args details_)))))
+                                                    (if (= name 'delay)
+                                                      nil
+                                                      (seq (to-pamela (:args details_))))))
                          :command (:name details_)
                          :display-name (:display-name details_) ;; to be removed
                          :label (:label details_) ;; to be removed


next-tick moved as well

next-tick moved as well

--- src/reagent/core.cljs
+++ src/reagent/core.cljs
@@ -130,7 +130,7 @@
 (defn next-tick
   "Run f using requestAnimationFrame or equivalent."
   [f]
-  (util/next-tick f))
+  (batch/next-tick f))

 (defn partial
   "Works just like clojure.core/partial, except that it is an IFn, and


make swap-state multi airity add get-props

--- src/quiescent.cljs
+++ src/quiescent.cljs
@@ -101,10 +101,16 @@
   ([component] (aget (.-state component) "value")))

 (defn swap-state
-  "Set the \"value\" key of a component's state."
-  [component tx-fn]
-  (let [old-state (get-state component)
-        new-state (tx-fn old-state)]
-    (when (not= old-state new-state)
-      (set-state component new-state))))
-
+  "Swap the \"value\" key of a component's state."
+  ([tx-fn] (swap-state *component* tx-fn))
+  ([component tx-fn]
+   (let [old-state (get-state component)
+         new-state (tx-fn old-state)]
+     (when (not= old-state new-state)
+       (set-state component new-state))))
+  )
+(defn get-props
+  "Get the render args from a component's props."
+  ([] (get-props *component*))
+  ([component] [(aget (.-props component) "value")
+                (aget (.-props component) "statics")]))


adding components function

adding components function

--- src/rodeo/core.clj
+++ src/rodeo/core.clj
@@ -3,7 +3,15 @@
             [clj-http.client :as http]))

 (def ^:const api-key (get (System/getenv) "GEOCODIO_API_KEY"))
-(def ^:const url (str "http://api.geocod.io/v1/geocode?api_key=" api-key))
+(def ^:const geocode-url (str "http://api.geocod.io/v1/geocode?api_key=" api-key))
+(def ^:const parse-url (str "http://api.geocod.io/v1/parse?api_key=" api-key))
+
+(defn- geocodio-get [url address]
+  (let [get-url (str parse-url "&q=" address)]
+    (-> get-url
+        (http/get)
+        (:body)
+        (che/parse-string true))))

 (defn batch
   "Takes a vector of addresses and
@@ -13,7 +21,7 @@
   (let [addr-json (che/generate-string addresses)]
     (che/parse-string
       (->> {:body addr-json :content-type :json :accept :json}
-           (http/post url)
+           (http/post geocode-url)
            (:body)) true)))

 (defn single
@@ -21,8 +29,12 @@
   makes a request to Geocodio. Returns
   a Clojure map of results"
   [address]
-  (let [get-url (str url "&q=" address)]
-    (-> get-url
-        (http/get)
-        (:body)
-        (che/parse-string true))))
+  (geocodio-get geocode-url address))
+
+(defn components
+  "Takes a single address string and
+  returns a clojure map of the components
+  of that address (street, city, etc as a
+  Clojure map"
+  [address]
+  (geocodio-get parse-url address))


fix css transition problem with react 0.13

--- src/show/core.cljs
+++ src/show/core.cljs
@@ -22,7 +22,7 @@
   property set on each component/dom-element that you pass as a body"
   [opts body]
   (let [group (.. js/React -addons -CSSTransitionGroup)]
-    (group (clj->js opts) (clj->js body))))
+    (js/React.createElement group (clj->js opts) (clj->js body))))

 ;; Getters and setters
 (defn get-node


Add paths paremeter on story-component

Add paths paremeter on story-component

--- src/storemi/js.clj
+++ src/storemi/js.clj
@@ -25,13 +25,14 @@
       (js/eval scope (slurp s)))
     scope))

-(defn render-story-component [data & [paths]]
+(defn render-story-component [data paths]
   (let [sc (js/new-scope nil react-scope)]
     (js/set! sc "data" (js/to-js data sc))
     (js/set! sc "paths" (js/to-js paths sc))
     (js/eval
       sc "React.renderComponentToString(
-            Story({data: data, paths: paths}))")))
+            Story({data: data,
+                   paths: paths}))")))


Use persistent store again.

Use persistent store again.

--- src/topiq/core.clj
+++ src/topiq/core.clj
@@ -39,7 +39,7 @@
 (defn create-store
   "Creates a konserve store"
   [state]
-  (swap! state assoc :store (<?? (new-mem-store) #_(new-fs-store "store")))
+  (swap! state assoc :store (<?? #_(new-mem-store) (new-fs-store "store")))
   state)

 (def hooks (atom {[#".*"


fix hashtag references

fix hashtag references

--- src/ceres_collector/pipeline.clj
+++ src/ceres_collector/pipeline.clj
@@ -109,7 +109,7 @@
     (d/store-reference aid mid "pub")
     (doall (map #(d/store-reference mid (assoc % :mention true) "mention") me-ids))
     (doall (map #(d/store-reference mid % "url") url-ids))
-    (doall (map #(d/store-hashtag mid % "tag") hids))
+    (doall (map #(d/store-reference mid % "tag") hids))
     (case type
       :reply (let [sid (mc/find-one-as-map @db "messages" {:tid (:in_reply_to_status_id tweet)})]
                (d/store-reference mid sid "reply"))


nav/# needs a different fix for canonical, possibly 2 or more queries

--- src/clj/cljspazzer/db/schema.clj
+++ src/clj/cljspazzer/db/schema.clj
@@ -117,7 +117,7 @@
 (defn artist-search [db prefix]
   (cond (= prefix "all") (artist-list db)
         (= prefix "#")
-        (let [db-results (sql/query db [(format "select distinct artist from tracks where artist_canonical < 'a' order by artist_canonical")])
+        (let [db-results (sql/query db [(format "select distinct artist_canonical as artist from tracks where artist_canonical < 'a' order by artist_canonical")]) ;; needs fix for canonical
               results (filter (fn [x] (not (= (:artist x) ""))) db-results)]
           (take-while (fn [x] (not (= (subs (:artist x) 0 1) "a"))) results))
     :else (sql/query db [(format "select distinct artist from tracks where artist_canonical like '%s%%' order by artist_canonical" prefix)])))


remove quote from some arglists (#123)

remove quote from some arglists (#123)

--- src/cljs/snapshot/lumo/repl.cljs
+++ src/cljs/snapshot/lumo/repl.cljs
@@ -859,9 +859,12 @@
   "Return the argument lists for the given symbol as string."
   [s]
   (when-let [var (some->> s repl-read-string first (resolve-var @env/*compiler*))]
-    (if-not (:macro var)
-      (:arglists var)
-      (-> var :meta :arglists second))))
+    (let [arglists (if-not (:macro var)
+                     (:arglists var)
+                     (-> var :meta :arglists second))]
+      (if (= 'quote (first arglists))
+        (second arglists)
+        arglists))))

 ;; --------------------
 ;; Autocompletion


Formatting.

Formatting.

--- src/cljs/town_client/config.cljs
+++ src/cljs/town_client/config.cljs
@@ -1,6 +1,7 @@
 (ns town-client.config)

 (def url-base "http://dev.hel.fi/kenenkaupunki/api/")
+;(def url-base "http://localhost:8079/")

 (def aggregates
   {:asuminen #{"paikka-tai-alue-asuinrakentamiselle"
@@ -9,4 +10,5 @@
                "taalla-pitaisi-olla-enemman-kauppoja-ja-palveluita-rakennusten-kivijaloissa"}
   :virkistys #{"virkistyksellisesti-tarkea-mutta-saisi-olla-laadultaan-parempi"
                 "taalla-on-tallaisenaan-ainutlaatuista-kaupunkiluontoa"}
-  :ankeus #{"taalla-ymparisto-nayttaa-ankealta-ja-sita-pitaisi-parantaa-esimerkiksi-puuistutuksin" "huonosti-hoidettu-epamaarainen-alue-jota-tulisi-parantaa"}})
+  :ankeus #{"taalla-ymparisto-nayttaa-ankealta-ja-sita-pitaisi-parantaa-esimerkiksi-puuistutuksin"
+            "huonosti-hoidettu-epamaarainen-alue-jota-tulisi-parantaa"}})


Don't show overlay on main screen

Don't show overlay on main screen

--- src/clojure/nightmod/overlay.clj
+++ src/clojure/nightmod/overlay.clj
@@ -40,6 +40,8 @@
   [main-window editor-window]
   (reset! ui/root main-window)
   (u/toggle-editor! true)
+  (when (nil? @ui/tree-selection)
+    (u/toggle-editor! false))
   (set-hint-container! (.getLayeredPane main-window))
   (s/hide! editor-window))


Calculating percentage across all categories

--- src/cv_generator/html_writer.clj
+++ src/cv_generator/html_writer.clj
@@ -27,17 +27,23 @@
 (defn start-dates-and-years [start-dates]
   (map start-date-and-year start-dates))

-(defn add-percentage [skills]
-  (let [max-rank (apply max (map #(:points %) skills))]
-    (map #(merge % {:percentage (* 100 (/ (:points %) max-rank))}) skills))
-  )
+(defn add-percentage [skills max-rank]
+  (map #(merge % {:percentage (* 100 (/ (:points %) max-rank))}) skills))

-(defn add-percentage-to-skills-in-category [category]
+(defn add-percentage-to-skills-in-category [category max-rank]
   {:name   (:name category)
-   :skills (add-percentage (:skills category))})
+   :skills (add-percentage (:skills category) max-rank)})
+
+(defn max-rank-in-category [category]
+  (apply max (map #(:points %) (:skills category))))
+
+(defn max-rank-in-categories [categories]
+  (apply max (map #(max-rank-in-category %) categories)))

 (defn add-percentage-to-skills-in-categories [categories]
-  (map add-percentage-to-skills-in-category categories))
+  (let [max-rank (max-rank-in-categories categories)]
+    (println max-rank)
+    (map #(add-percentage-to-skills-in-category % max-rank) categories)))

 (defn convert-to-data-map [cv filter filename]
   {:cv-name         filename


Fixing broken test (which I should have spotted before - doh).

--- src/tyranitar/web.clj
+++ src/tyranitar/web.clj
@@ -44,7 +44,7 @@

 (defn- status
   []
-  (let [git-ok (not (nil? (store/git-connection-working)))]
+  (let [git-ok (not (nil? (store/git-connection-working?)))]
     (->
      {:name "tyranitar"
       :version *version*


Fleshing out visitors.

Fleshing out visitors.

--- src/dependency_reader/reader.clj
+++ src/dependency_reader/reader.clj
@@ -26,6 +26,13 @@
   [^String name]
   (.replaceAll name "/" "."))

+(defn- fix-field-descriptor
+  [^String field-descriptor]
+  (let [result (.getClassName (org.objectweb.asm.Type/getType field-descriptor))]
+    (if (.endsWith result "[]")   ; Trim array suffix - we don't differentiate between dependencies on arrays and the fundamental type
+      (.substring result 0 (- (.length result) 2))
+      result)))
+
 (defn- add-dependency
   [dependencies dependency type]
   (if (contains? dependencies dependency)
@@ -36,12 +43,14 @@

 (defn- add-dependencies
   [dependencies new-dependencies type]
-  (loop [result                 dependencies
-         current-dependency     (first new-dependencies)
-         remaining-dependencies (rest  new-dependencies)]
-    (if (empty? remaining-dependencies)
-      (add-dependency result current-dependency type)
-      (recur (add-dependency result current-dependency type) (first remaining-dependencies) (rest remaining-dependencies)))))
+  (if (or (empty? new-dependencies) (nil? new-dependencies))
+    dependencies
+    (loop [result                 dependencies
+           current-dependency     (first new-dependencies)
+           remaining-dependencies (rest  new-dependencies)]
+      (if (empty? remaining-dependencies)
+        (add-dependency result current-dependency type)
+        (recur (add-dependency result current-dependency type) (first remaining-dependencies) (rest remaining-dependencies))))))

 (defn- visit
   [class-info version access class-name signature super-name interfaces]
@@ -60,7 +69,14 @@
   [class-info access field-name desc signature value]
   (merge class-info
          {
-           :dependencies (add-dependency (:dependencies class-info) (.getClassName (org.objectweb.asm.Type/getType desc)) :uses)
+           :dependencies (add-dependency (:dependencies class-info) (fix-field-descriptor desc) :uses)
+         }))
+
+(defn- visit-annotation
+  [class-info name desc]
+  (merge class-info
+         {
+           ;####TODO!!!!
          }))

 (defn class-info
@@ -77,21 +93,31 @@

   The input stream is consumed, but _not_ closed."
   [^java.io.InputStream class-input-stream]
-  (let [result        (atom { :name              nil
-                              :type              nil
-                              :class-version     nil
-                              :class-version-str nil
-                              :dependencies      {} })
-        class-reader  (new org.objectweb.asm.ClassReader class-input-stream)
-        class-visitor (proxy [org.objectweb.asm.ClassVisitor] ; classes & interfaces
-                             [org.objectweb.asm.Opcodes/ASM4] ; constructor params
-                             ; Overridden functions
-                             (visit [version access class-name signature super-name interfaces]
-                               (swap! result visit version access class-name signature super-name interfaces))
-                             (visitField [access field-name desc signature value]
-                               (swap! result visit-field access field-name desc signature value)
-                               nil)
-                          )]
+  (let [result             (atom { :name              nil
+                                   :type              nil
+                                   :class-version     nil
+                                   :class-version-str nil
+                                   :dependencies      {} })
+        class-reader       (new org.objectweb.asm.ClassReader class-input-stream)
+        annotation-visitor (proxy [org.objectweb.asm.AnnotationVisitor]
+                                  [org.objectweb.asm.Opcodes/ASM4] ; constructor params
+                                  (visitAnnotation [name desc]
+                                    (swap! result visit-annotation name desc)
+                                    ;annotation-visitor))
+                                    nil))
+        field-visitor      (proxy [org.objectweb.asm.FieldVisitor]
+                                  [org.objectweb.asm.Opcodes/ASM4]
+                                  (visitAnnotation [desc visible]
+                                    annotation-visitor))
+        class-visitor      (proxy [org.objectweb.asm.ClassVisitor] ; classes & interfaces
+                                  [org.objectweb.asm.Opcodes/ASM4] ; constructor params
+                                  ; Overridden functions
+                                  (visit [version access class-name signature super-name interfaces]
+                                    (swap! result visit version access class-name signature super-name interfaces))
+                                  (visitField [access field-name desc signature value]
+                                    (swap! result visit-field access field-name desc signature value)
+                                    field-visitor)
+                           )]
     (.accept class-reader class-visitor 0)
     @result))


Basic checks if waive data are correct

Basic checks if waive data are correct

--- src/emender_jenkins/rest_api.clj
+++ src/emender_jenkins/rest_api.clj
@@ -556,8 +556,10 @@
                  (send-error-response request :internal-server-error)))))

 (defn throw-exception
-    [message previous-exception]
-    (throw (new Exception (str message (.getMessage previous-exception)))))
+    ( [message]
+      (throw (new Exception message)))
+    ( [message previous-exception]
+      (throw (new Exception (str message (.getMessage previous-exception))))))

 (defn read-waive-input-data
     [request]
@@ -575,14 +577,29 @@
             (assoc :product (results/job-name->product-name job-name))
             (assoc :version (results/job-name->version job-name))
             (assoc :guide   (results/job-name->book-name job-name))
-            (dissoc :job_name)
-            )))
+            (dissoc :job_name))))
+
+(defn assert-not-empty
+    [waive-data key-name message]
+    (if (empty? (get waive-data key-name))
+        (throw-exception message)))
+
+(defn check-waive-data
+    [waive-data]
+    (assert-not-empty waive-data :product    "Product name not specified")
+    (assert-not-empty waive-data :version    "Version not specified")
+    (assert-not-empty waive-data :guide      "Guide (book) name not specified")
+    (assert-not-empty waive-data :test_suite "Test suite not specified")
+    (assert-not-empty waive-data :test_name  "Test name not specified")
+    (assert-not-empty waive-data :cause      "Cause not specified")
+    (assert-not-empty waive-data :added      "Added (date) not specified"))

 (defn parse-waive-data
     [input-data]
     (let [parsed-data (if (:job_name input-data)
                           (parse-job-name input-data)
                           input-data)]
+         (check-waive-data parsed-data)
          parsed-data))

 (defn waive
@@ -592,7 +609,7 @@
         (let [waive-input-data  (read-waive-input-data request)
               parsed-waive-data (parse-waive-data waive-input-data)]
               (send-response parsed-waive-data request))
-        (catch Exception e
+        (catch Throwable e
             (let [error-message (str "Error waiving test results: " (.getMessage e))]
                 (log/error error-message)
                 (send-error-response error-message request :bad-request)))


getting rid of 'or' in 'match'

getting rid of 'or' in 'match'

--- src/fowles/yt_fetch/reporter.clj
+++ src/fowles/yt_fetch/reporter.clj
@@ -50,11 +50,13 @@
 (defn mk-pusher
   [host port]
   (let [pusher (util/mk-pusher host port)]
-    ;; acc is seq of 'resp-body', each a clj data structure (not json).
+    ;; acc is seq of 'resp-body', each a clj data structure (not a json str).
     (fn [{:keys [request resp-bodies]}]
       (match (:query-type request)
-             (:or :channels :videos) (push-items pusher request resp-bodies)
-             :activities  (push-activities-fancy pusher request resp-bodies)
-             :playlistItems       (push-playlist pusher request resp-bodies)
+             ;; We don't use `:or` here because it seems not to work sometimes!?
+             :channels      (push-items pusher request resp-bodies)
+             :videos        (push-items pusher request resp-bodies)
+             :activities    (push-activities-fancy pusher request resp-bodies)
+             :playlistItems (push-playlist pusher request resp-bodies)
              ;; throw!
              :else nil))))


Fix escape for undecoded values

Fix escape for undecoded values

--- src/transit/write.clj
+++ src/transit/write.clj
@@ -66,16 +66,13 @@
   [^String s]
   (if (> (.length s) 0)
     (let [c (subs s 0 1)]
-      (if (or (= ESC c)
-              (= SUB c)
-              (and (= RESERVED c)
-                   (> (.length s) 1)
-                   (not= ESC (subs s 1 2))))
-        (str ESC s)
-        (if (= RESERVED c)
-          (subs s 1)
-          s)))
-    s))
+      (cond (= RESERVED c)
+            (str ESC (subs s 1))
+
+            (or (= ESC c) (= SUB c))
+            (str ESC s)
+
+            :else s))))

 (defn nsed-name
   [^clojure.lang.Named kw-or-sym]