Clean up channel handling code.

Clean up channel handling code.

This should make testing a little easier by making the logic a little easier to get at.

--- frontend/core.cljs
+++ frontend/core.cljs
@@ -24,7 +24,7 @@
             [frontend.utils :as utils :refer [mlog merror third]]
             [secretary.core :as sec])
   (:require-macros [cljs.core.async.macros :as am :refer [go go-loop alt!]]
-                   [frontend.utils :refer [inspect timing]])
+                   [frontend.utils :refer [inspect timing swallow-errors]])
   (:use-macros [dommy.macros :only [node sel sel1]]))

 (enable-console-print!)
@@ -80,6 +80,43 @@
                   :mouse-up {:ch mouse-up-ch
                              :mult (async/mult mouse-up-ch)}})))

+(defn controls-handler
+  [value state container]
+  (when true (:log-channels? utils/initial-query-map)
+        (mlog "Controls Verbose: " value))
+  (swallow-errors
+   (let [previous-state @state]
+     (swap! state (partial controls-con/control-event container (first value) (second value)))
+     (controls-pcon/post-control-event! container (first value) (second value) previous-state @state))))
+
+(defn nav-handler
+  [value state history]
+  (when true (:log-channels? utils/initial-query-map)
+        (mlog "Navigation Verbose: " value))
+  (swallow-errors
+   (let [previous-state @state]
+     (swap! state (partial nav-con/navigated-to history (first value) (second value)))
+     (nav-pcon/post-navigated-to! history (first value) (second value) previous-state @state))))
+
+(defn api-handler
+  [value state container]
+  (when true (:log-channels? utils/initial-query-map)
+        (mlog "API Verbose: " (first value) (second value) (utils/third value)))
+  (swallow-errors
+    (let [previous-state @state]
+      (swap! state (partial api-con/api-event container (first value) (second value) (utils/third value)))
+      (api-pcon/post-api-event! container (first value) (second value) (utils/third value) previous-state @state))))
+
+(defn ws-handler
+  [value state pusher]
+  (when true (:log-channels? utils/initial-query-map)
+        (mlog "websocket Verbose: " (pr-str (first value)) (second value) (utils/third value)))
+  (swallow-errors
+    (let [previous-state @state]
+      ;; XXX: should these take the container like the rest of the controllers?
+      (swap! state (partial ws-con/ws-event pusher (first value) (second value)))
+      (ws-pcon/post-ws-event! pusher (first value) (second value) previous-state @state))))
+
 (defn main [state top-level-node]
   (let [comms       (:comms @state)
         target-name "app"
@@ -96,51 +133,10 @@
       :opts {:comms comms}})
     (go (while true
           (alt!
-           (:controls comms) ([v]
-                                (when true (:log-channels? utils/initial-query-map)
-                                      (mlog "Controls Verbose: " v))
-                                (try
-                                  (let [previous-state @state]
-                                    (swap! state (partial controls-con/control-event container (first v) (second v)))
-                                    (controls-pcon/post-control-event! container (first v) (second v) previous-state @state))
-                                  (catch js/Error e
-                                    (merror e)
-                                    (when (:rethrow-errors? utils/initial-query-map)
-                                      (throw e)))))
-           (:nav comms) ([v]
-                           (when true (:log-channels? utils/initial-query-map)
-                                 (mlog "Navigation Verbose: " v))
-                           (try
-                             (let [previous-state @state]
-                               (swap! state (partial nav-con/navigated-to history-imp (first v) (second v)))
-                               (nav-pcon/post-navigated-to! history-imp (first v) (second v) previous-state @state))
-                             (catch js/Error e
-                               (merror e)
-                               (when (:rethrow-errors? utils/initial-query-map)
-                                 (throw e)))))
-           (:api comms) ([v]
-                           (when true (:log-channels? utils/initial-query-map)
-                                 (mlog "API Verbose: " (first v) (second v) (drop 2 v)))
-                           (try
-                             (let [previous-state @state]
-                               (swap! state (partial api-con/api-event container (first v) (second v) (utils/third v)))
-                               (api-pcon/post-api-event! container (first v) (second v) (utils/third v) previous-state @state))
-                             (catch js/Error e
-                               (merror e)
-                               (when (:rethrow-errors? utils/initial-query-map)
-                                 (throw e)))))
-           (:ws comms) ([v]
-                           (when true (:log-channels? utils/initial-query-map)
-                                 (mlog "websocket Verbose: " (pr-str (first v)) (second v) (drop 2 v)))
-                           (try
-                             (let [previous-state @state]
-                               ;; XXX: should these take the container like the rest of the controllers?
-                               (swap! state (partial ws-con/ws-event pusher-imp (first v) (second v)))
-                               (ws-pcon/post-ws-event! pusher-imp (first v) (second v) previous-state @state))
-                             (catch js/Error e
-                               (merror e)
-                               (when (:rethrow-errors? utils/initial-query-map)
-                                 (throw e)))))
+           (:controls comms) ([v] (controls-handler v state container))
+           (:nav comms) ([v] (nav-handler v state history-imp))
+           (:api comms) ([v] (api-handler v state container))
+           (:ws comms) ([v] (ws-handler v state pusher-imp))
            ;; Capture the current history for playback in the absence
            ;; of a server to store it
            (async/timeout 10000) (do (print "TODO: print out history: ")))))))


benchmark method added to instance via specify

ridiculously fast ~30ms on my MBA 1.7ghz for 1000000 invokes. Thank you
JS fusion reactors.

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -45,6 +45,7 @@
 (println ";;; cloning & specify")
 (simple-benchmark [coll [1 2 3]] (clone coll) 1000000)
 (simple-benchmark [coll [1 2 3]] (specify coll IFoo (foo [_] :bar)) 1000000)
+(simple-benchmark [coll (specify [1 2 3] IFoo (foo [_] :bar))] (foo coll) 1000000)
 (println)

 (println ";;; list ops")


add indirect keyword and symbol invoke benchmark, keywords (JS Strings) are nearly >7X slower under v8

--- benchmark/cljs/benchmark_runner.cljs
+++ benchmark/cljs/benchmark_runner.cljs
@@ -158,6 +158,10 @@
 (simple-benchmark [coll {'foo 1 'bar 2}] (-lookup coll 'foo nil) 1000000)
 (simple-benchmark [coll {:foo 1 :bar 2}] (:foo coll) 1000000)
 (simple-benchmark [coll {'foo 1 'bar 2}] ('foo coll) 1000000)
+(let [kw  :foo
+      sym 'foo]
+  (simple-benchmark [coll {:foo 1 :bar 2}] (kw coll) 1000000)
+  (simple-benchmark [coll {'foo 1 'bar 2}] (sym coll) 1000000))
 (defrecord Foo [bar baz])
 (simple-benchmark [coll (Foo. 1 2)] (:bar coll) 1000000)
 (simple-benchmark [coll {:foo 1 :bar 2}] (assoc coll :baz 3) 100000)
@@ -176,6 +180,8 @@
                       (recur (inc i) (assoc m 'foo 2))
                       m))
                   1)
+(println)
+
 (println ";;; persistent hash maps")
 (def pmap (into cljs.core.PersistentHashMap/EMPTY
             [[:a 0] [:b 1] [:c 2] [:d 3] [:e 4] [:f 5] [:g 6] [:h 7]


added ptry macro to simplify try/catch code

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -1912,3 +1912,20 @@
                                    "unwindowed-fn" (or (:unwindowed-fn options)
                                                        (mk-default-unwindowed-fn options))}))

+(defn- parse-try
+  "Separates body from catch/finally clauses"
+  [body]
+  (loop [expressions []
+         clauses body]
+    (let [[head & tail] clauses]
+      (if (or (not head) (and (list? head) (#{'catch 'finally} (first head))))
+        [expressions clauses]
+        (recur (cons head expressions) tail)))))
+
+(defmacro dtry
+  {:doc "Just like try except it wraps the body in a safe-exec"
+   :added "0.5.2"}
+  [& body]
+  (let [[expressions clauses] (parse-try body)]
+    `(try (safe-exec ~@expressions)
+          ~@clauses)))


added with-keys

added with-keys

--- src/clj/datasplash/core.clj
+++ src/clj/datasplash/core.clj
@@ -1,13 +1,15 @@
 (ns datasplash.core
   (:require [taoensso.nippy :as nippy :refer [thaw freeze]]
             [cognitect.transit :as transit])
-  (:import [datasplash.fns ClojureDoFn]
+  (:import [datasplash.fns ClojureDoFn ClojureSerializableFn]
            [java.io InputStream OutputStream]
            [java.util UUID]
            [com.google.cloud.dataflow.sdk.options PipelineOptionsFactory]
            [com.google.cloud.dataflow.sdk Pipeline]
            [com.google.cloud.dataflow.sdk.io TextIO$Read TextIO$Write]
-           [com.google.cloud.dataflow.sdk.transforms DoFn DoFn$Context ParDo DoFnTester Create]
+           [com.google.cloud.dataflow.sdk.transforms
+            DoFn DoFn$Context ParDo DoFnTester Create
+            SerializableFunction WithKeys]
            [com.google.cloud.dataflow.sdk.values PCollection]
            [com.google.cloud.dataflow.sdk.coders ByteArrayCoder StringUtf8Coder CustomCoder Coder$Context]
            [datasplash.vals ClojureVal]
@@ -57,7 +59,6 @@

 (defmacro with-opts
   [schema opts & body]
-  (println opts)
   (let [full-name (name
                    (or (:name opts)
                        (do
@@ -76,13 +77,14 @@

 (defn map-op
   ([transform label coder]
-   (fn
-     [f options ^PCollection pcoll]
-     (let [opts (assoc options :label label)]
-       (-> pcoll
-           (.apply (with-opts base-schema opts
-                     (ParDo/of (dofn (transform f)))))
-           (.setCoder (or (:coder opts) coder))))))
+   (fn make-map-op
+     ([f options ^PCollection pcoll]
+      (let [opts (assoc options :label label)]
+        (-> pcoll
+            (.apply (with-opts base-schema opts
+                      (ParDo/of (dofn (transform f)))))
+            (.setCoder (or (:coder opts) coder)))))
+     ([f pcoll] (make-map-op f {} pcoll))))
   ([transform label]
    (map-op transform label (make-transit-coder))))

@@ -106,12 +108,29 @@

 (def to-edn (partial (map-op identity :to-edn (StringUtf8Coder/of)) to-edn*))

+(defn sfn
+  ^SerializableFunction [f]
+  (ClojureSerializableFn. f))
+
+(defn with-keys
+  ([f options ^PCollection pcoll]
+   (let [opts (assoc options :label :with-keys)]
+     (-> pcoll
+         (.apply (with-opts base-schema opts
+                   (WithKeys/of (sfn f)))))))
+  ([f pcoll] (with-keys f {} pcoll)))
+
 (defn make-pipeline
   [str-args]
   (let [builder (PipelineOptionsFactory/fromArgs
                  (into-array String str-args))
-        options (.create builder)]
-    (Pipeline/create options)))
+        options (.create builder)
+        pipeline (Pipeline/create options)
+        coder-registry (.getCoderRegistry pipeline)]
+    (doto coder-registry
+      (.registerCoder clojure.lang.IPersistentCollection (make-transit-coder))
+      (.registerCoder clojure.lang.Keyword (make-transit-coder)))
+    pipeline))

 (defn load-text-file
   [from options ^Pipeline p]
@@ -136,9 +155,9 @@
   [& args]
   (let [p (make-pipeline args)
         final (->> p
-                   (generate-input (range 10000) {:name "gengen"})
-                   (dmap inc {:name "map"})
-                   (dfilter even? {:name "filter"})
+                   (generate-input [{:key :a :val 10} {:key :b :val 5} {:key :a :val 42}] {:name "gengen"})
+                   (with-keys :key {:name :group-by-key})
+                   (dmap (fn [kv] (vector (.getKey kv) (.getValue kv))) )
                    (to-edn {:name "edn"})
                    (write-text-file "tee"))]


Swing half is working.

Swing half is working.

--- src/clj/mazegen/swingui.clj
+++ src/clj/mazegen/swingui.clj
@@ -1,60 +1,54 @@
-;(ns mazegen.swingui
-;  (:gen-class)
-;  (:require [mazegen.rules :as rules])
-;  (:import (javax.swing JFrame JPanel JButton BoxLayout Box)
-;           (java.awt BorderLayout Graphics2D Color ImageCapabilities)
-;           (java.awt.geom Rectangle2D$Double)
-;           (java.awt.event ActionListener)
-;           (java.awt.image VolatileImage)))
-;
-;(defn panel [grid]
-;  (doto (proxy [JPanel] []
-;    (paint [g]
-;      (let [w (.getWidth this)
-;            h (.getHeight this)
-;            bg (Rectangle2D$Double. 0 0 w (.getHeight this))
-;            vimg (.createVolatileImage this w h (ImageCapabilities. true))
-;            g2d (.createGraphics vimg)]
-;        (doto g2d
-;          (.setPaint Color/BLACK)
-;          (.fill bg))
-;        (doseq [i (range (count @grid))]
-;          (doseq [j (range (count (get @grid i)))]
-;            (let [c (if (= :alive (get-in @grid [i j])) Color/GREEN Color/RED)
-;                  sq (Rectangle2D$Double. (* i (/ w (count @grid)))
-;                                          (* j (/ h (count (get @grid i))))
-;                                          (/ w (count @grid))
-;                                          (/ h (count (get @grid i))))]
-;              (do (.setPaint g2d c) (.fill g2d sq)))))
-;        (.drawImage g vimg 0 0 this))))
-;    (#(add-watch grid :repaint (fn [_ _ _ _] (.repaint %))))))
-;
-;(defn sim [grid]
-;  (future (loop []
-;            (dosync (swap! grid rules/step))
-;            (recur))))
-;
-;(defn south-panel [grid-ref]
-;  (doto (Box. BoxLayout/Y_AXIS)
-;    (.add (doto (JButton. "Go")
-;            (.addActionListener
-;              (reify ActionListener
-;                (actionPerformed [_ _] (sim grid-ref))))))
-;    (.add (doto (JButton. "Reset")
-;            (.addActionListener
-;              (reify ActionListener
-;                (actionPerformed [_ _] (reset! grid-ref (rules/seed-grid 100 100)))))))))
-;
-;(defn launch [exit-behavior]
-;  (let [grid (atom (rules/seed-grid 100 100))]
-;    (doto (JFrame. "Maze Generator")
-;      (.setSize 800 600)
-;      (.setDefaultCloseOperation exit-behavior)
-;      (.add (panel grid) BorderLayout/CENTER)
-;      (.add (south-panel grid) BorderLayout/SOUTH)
-;      (.setVisible true))))
-;
-;(defn -main [& args]
-;  (launch JFrame/EXIT_ON_CLOSE))
-;
-;;(launch JFrame/DISPOSE_ON_CLOSE)
+(ns mazegen.swingui
+  (:gen-class)
+  (:require [mazegen.rules :as rules])
+  (:import (javax.swing JFrame JPanel JButton BoxLayout Box)
+           (java.awt BorderLayout Graphics2D Color ImageCapabilities)
+           (java.awt.geom Rectangle2D$Double Path2D$Double Ellipse2D$Double)))
+
+(defn draw-cell [p dx dy row col maze]
+  (let [sx (* dx col)
+        sy (* dy row)
+        cell (get-in maze [row col])]
+    (do
+      (when (cell :start)
+        (.append p (Ellipse2D$Double. sx sy dx dy) false))
+      (when-not (cell [row (dec col)])
+        (doto p (.moveTo sx sy) (.lineTo sx (+ sy dy))))
+      (when-not (cell [row (inc col)])
+        (doto p (.moveTo (+ sx dx) sy) (.lineTo (+ sx dx) (+ sy dy))))
+      (when-not (cell [(dec row) col])
+        (doto p (.moveTo sx sy) (.lineTo (+ sx dx) sy)))
+      (when-not (cell [(inc row) col])
+        (doto p (.moveTo sx (+ sy dy)) (.lineTo (+ sx dx) (+ sy dy)))))))
+
+(defn panel [maze]
+  (doto (proxy [JPanel] []
+          (paint [g2d]
+            (let [dx (/ (.getWidth this) (count (maze 0)))
+                  dy (/ (.getHeight this) (count maze))
+                  p (Path2D$Double.)
+                  bg (Rectangle2D$Double. 0 0 (.getWidth this) (.getHeight this))]
+              (do
+                (doseq [row (range (count maze))]
+                  (doseq [col (range (count (get maze row)))]
+                    (draw-cell p dx dy row col maze)))
+                (doto g2d
+                  (.setPaint Color/WHITE)
+                  (.fill bg)
+                  (.setPaint Color/BLACK)
+                  (.draw p))))))))
+
+(defn launch [exit-behavior]
+  (let [cells 20
+        empty-maze (rules/create-empty cells cells)
+        prim-maze (rules/prim-gen empty-maze [0 0])]
+    (doto (JFrame. "Maze Generator")
+      (.setSize 800 600)
+      (.setDefaultCloseOperation exit-behavior)
+      (.add (panel prim-maze) BorderLayout/CENTER)
+      (.setVisible true))))
+
+(defn -main [& args]
+  (launch JFrame/EXIT_ON_CLOSE))
+
+(launch JFrame/DISPOSE_ON_CLOSE)


Add an authorization middleware

Add an authorization middleware

That compares the roles from the identity in the request with the
roles required for the route that matches the current request.

--- src/clj/mdr2/middleware.clj
+++ src/clj/mdr2/middleware.clj
@@ -13,7 +13,9 @@
     [buddy.auth.middleware :refer [wrap-authentication wrap-authorization]]
     [buddy.auth.accessrules :refer [restrict]]
     [buddy.auth :refer [authenticated?]]
-    [buddy.auth.backends.token :refer [jws-backend]])
+    [buddy.auth.backends.token :refer [jws-backend]]
+    [clojure.set :refer [intersection]]
+    [reitit.ring :as ring])
   )

 (defn wrap-internal-error [handler]
@@ -34,7 +36,6 @@
        {:status 403
         :title "Invalid anti-forgery token"})}))

-
 (defn wrap-formats [handler]
   (let [wrapped (-> handler wrap-params (wrap-format formats/instance))]
     (fn [request]
@@ -46,6 +47,32 @@
   (error-page
     {:status 403
      :title (str "Access to " (:uri request) " is not authorized")}))
+
+;; https://learning.oreilly.com/library/view/web-development-with/9781680508833/f_0048.xhtml#:-:text=get-roles-from-match
+(defn get-roles-from-match [request]
+  (let [request-method (:request-method request)]
+    (-> request (ring/get-match) (get-in [:data request-method :authorized] #{}))))
+
+(defn- get-roles-from-identity [request]
+  (->> (get-in request [:identity :user :roles])
+       ;; unfortunately the jws-backend parses the token as json and
+       ;; hence ignores keywords and sets. So we have to reconstruct
+       ;; those here
+       (map keyword)
+       set))
+
+(defn authorized?
+  "Return true if the roles of the identity in `request` intersect with
+  the `roles` defined in the router. So if an identity has no roles it
+  will never be authorized."
+  [request]
+  (let [route-roles (get-roles-from-match request)
+        request-roles (get-roles-from-identity request)]
+    (some? (seq (intersection route-roles request-roles)))))
+
+(defn wrap-authorized [handler]
+  (restrict handler {:handler authorized?
+                     :on-error on-error})  )

 (defn wrap-restricted [handler]
   (restrict handler {:handler authenticated?


Fix typo.

Fix typo.

--- src/cljam/pileup/pileup.clj
+++ src/cljam/pileup/pileup.clj
@@ -32,7 +32,7 @@
   [rdr rname rlength start end step]
   (let [n-threads (get-exec-n-threads)
         read-fn (fn [r start end]
-                  (io/read-alignments r {:chr rname :start start :end end :deep :shallow}))
+                  (io/read-alignments r {:chr rname :start start :end end :depth :shallow}))
         count-fn (fn [xs]
                    (if (= n-threads 1)
                      (map (fn [[start end]]


Add more types

Add more types

--- src/cljs/triboard/core.cljs
+++ src/cljs/triboard/core.cljs
@@ -39,6 +39,11 @@
     (every? coord? (:taken m))
     (player? (:winner m))
     (cell? (:looser m))))
+
+(defn scores? [s]
+  (and
+    (<= 0 (reduce + (vals s)) 164)
+    (every? s players)))

 ;; -----------------------------------------
@@ -323,6 +328,7 @@

 (defn show-scores
   [scores player]
+  {:pre [(scores? scores)]}
   (for [p players]
     ^{:key p}
     [(if (= player p) :div.score--is-current :div.score)


replace separator, to match existing usage

--- src/cljs_workcalendar/format/plaintextformatter.clj
+++ src/cljs_workcalendar/format/plaintextformatter.clj
@@ -6,7 +6,7 @@
   f/ICanFormatWorkCalendar
   (format-work-calendar [this work-calendar]
     (map (fn [item]
-           (format "%04d.%02d.%02d:%d"
+           (format "%04d.%02d.%02d;%d"
                    (:year item)
                    (:month item)
                    (:day item)


TODO update doc

TODO update doc

--- src/clojento/magento/db.clj
+++ src/clojento/magento/db.clj
@@ -15,6 +15,8 @@
 ; see https://github.com/clj-time/clj-time/blob/master/src/clj_time/jdbc.clj
 ; and https://github.com/funcool/clojure.jdbc/blob/master/src/jdbc/proto.clj
 ; and https://github.com/funcool/clojure.jdbc/blob/master/src/jdbc/impl.clj
+
+; TODO pull request for doc at http://funcool.github.io/clojure.jdbc/latest/#extend-sql-types

 (extend-protocol proto/ISQLResultSetReadColumn
   java.sql.Timestamp


Add improved performance for `maybe?` predicate for most common cases.

--- src/cats/monad/maybe.cljc
+++ src/cats/monad/maybe.cljc
@@ -104,9 +104,14 @@
   "Return true in case of `v` is instance
   of Maybe monad."
   [v]
-  (if (satisfies? p/Contextual v)
+  (cond
+    (or (instance? Just v) (instance? Nothing v))
+    true
+
+    (satisfies? p/Contextual v)
     (identical? (p/-get-context v) context)
-    false))
+
+    :else false))

 (defn just
   "A Just type constructor."


Cleanup.

Cleanup.

--- src/dragon/selmer/tags/demo.clj
+++ src/dragon/selmer/tags/demo.clj
@@ -1,5 +1,6 @@
 (ns dragon.selmer.tags.demo
   (:require [clojure.string :as string]))

-(defn foo-tag [args context-map]
+(defn foo-tag
+  [args context-map]
   (str "foo " (first args)))


Fixed type in docstring of objects

Fixed type in docstring of objects

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

--- src/conexp/fca/contexts.clj
+++ src/conexp/fca/contexts.clj
@@ -28,7 +28,7 @@
   (instance? Context thing))

 (defmulti objects
-  "Returns the objects of a formal context.."
+  "Returns the objects of a formal context."
   {:arglists '([context])}
   type)


Make some indentation more Clojurey.

Make some indentation more Clojurey.

--- metrics-clojure-core/src/metrics/counters.clj
+++ metrics-clojure-core/src/metrics/counters.clj
@@ -20,10 +20,9 @@
 (defmacro defcounter
   "Define a new Counter metric with a given title, or group, type and title."
   ([title]
-     `(def ~title (counter ~(str title))))
-
+   `(def ~title (counter ~(str title))))
   ([group type title]
-     `(def ~title (counter ~(vec (map str [group type title]))))))
+   `(def ~title (counter ~(vec (map str [group type title]))))))

 ; Read ------------------------------------------------------------------------


change long-option for gpg-user-id

change long-option for gpg-user-id

--- boot/core/src/boot/task/built_in.clj
+++ boot/core/src/boot/task/built_in.clj
@@ -506,7 +506,7 @@

   [f file PATH            str  "The jar file to deploy."
    g gpg-sign             bool "Sign jar using GPG private key."
-   k gpg-key NAME         str  "The name used to find the GPG key."
+   k gpg-user-id NAME     str  "The name used to find the GPG key."
    K gpg-keyring PATH     str  "The path to secring.gpg file to use for signing."
    p gpg-passphrase PASS  str  "The passphrase to unlock GPG signing key."
    r repo ALIAS           str  "The alias of the deploy repository."
@@ -533,7 +533,7 @@
                  snapshot?    (.endsWith v "-SNAPSHOT")
                  artifact-map (when gpg-sign
                                 (util/info "Signing %s...\n" (.getName f))
-                                (helpers/sign-jar tgt f gpg-passphrase gpg-keyring gpg-key))]
+                                (helpers/sign-jar tgt f gpg-passphrase gpg-keyring gpg-user-id))]
             (assert (or (not ensure-branch) (= b ensure-branch))
               (format "current git branch is %s but must be %s" b ensure-branch))
             (assert (or (not ensure-clean) clean?)


optional macro loading

optional macro loading

parsing an 'ns has the side-effect of loading macros
which in some cases is undesireable

introduce *load-macros* to let tool authors disable this side effect

--- src/clj/cljs/analyzer.clj
+++ src/clj/cljs/analyzer.clj
@@ -34,6 +34,7 @@
 (def ^:dynamic *cljs-dep-set* (with-meta #{} {:dep-path []}))
 (def ^:dynamic *analyze-deps* true)
 (def ^:dynamic *load-tests* true)
+(def ^:dynamic *load-macros* true)

 (def -cljs-macros-loaded (atom false))

@@ -1231,11 +1232,12 @@
     (when (seq uses)
       (check-uses uses env))
     (set! *cljs-ns* name)
-    (load-core)
-    (doseq [nsym (concat (vals require-macros) (vals use-macros))]
-      (clojure.core/require nsym))
-    (when (seq use-macros)
-      (check-use-macros use-macros env))
+    (when *load-macros*
+      (load-core)
+      (doseq [nsym (concat (vals require-macros) (vals use-macros))]
+        (clojure.core/require nsym))
+      (when (seq use-macros)
+        (check-use-macros use-macros env)))
     (swap! env/*compiler* update-in [::namespaces name] assoc
       :specs args
       :name name


CLJS-89: Removed dbg println

CLJS-89: Removed dbg println

--- src/clj/cljs/compiler.clj
+++ src/clj/cljs/compiler.clj
@@ -561,7 +561,6 @@

 (defmethod emit :dot
   [{:keys [target field method args env]}]
-  (.println System/out (str "emit " [field method]))
   (emit-wrap env
              (if field
                (print (str (emits target) "." field))
@@ -852,6 +851,8 @@
              argexprs (map #(analyze enve %) args)]
          {:env env :op :dot :target targetexpr :method (munge method) :args argexprs :children (into children argexprs)})))))

+;; (def o (js* "{foo : 42, bar : function() { return 108 }}"))
+
 (defmethod parse 'js*
   [op env [_ form & args] _]
   (assert (string? form))


Fix apply in :mouse-wheel.

Fix apply in :mouse-wheel.

--- src/cljs/quil/sketch.cljs
+++ src/cljs/quil/sketch.cljs
@@ -71,7 +71,7 @@
                      :mouseReleased mouse-released
                      :mouseOut mouse-out
                      :mouseOver mouse-over
-                     :mouseScrolled (apply mouse-scrolled [(* -1 (.-mouseScroll prc))])) ;; -1 need for compability to Clojure version
+                     :mouseScrolled (mouse-scrolled (* -1 (.-mouseScroll prc)))) ;; -1 need for compability to Clojure version
       (set! (.-quil prc) (atom nil)))))


Moar.

Moar.

--- src/clojurecraft/core.clj
+++ src/clojurecraft/core.clj
@@ -62,6 +62,11 @@
       (doto (:out @conn)
          (.writeDouble (int i))))

+(defn -write-float [conn i]
+      (println (str "-> FLOAT: " i))
+      (doto (:out @conn)
+         (.writeFloat (int i))))
+
 (defn -write-string16 [conn s]
       (-write-short conn (count s))
       (println (str "-> STRING: " s))
@@ -154,6 +159,14 @@
 (defn -read-bool [conn]
    (let [b (.readBoolean (:in @conn))]
      b))
+
+(defn -read-double [conn]
+   (let [i (.readDouble (:in @conn))]
+     i))
+
+(defn -read-float [conn]
+   (let [i (.readFloat (:in @conn))]
+     i))

 (defn -read-string16 [conn]
   (let [str-len (.readShort (:in @conn))


Removed printing from translate.clj

Removed printing from translate.clj

--- src/clojush/translate.clj
+++ src/clojush/translate.clj
@@ -80,7 +80,7 @@
                                                 (count paren-stack)
                                                 paren-stack)
         ; Check if done
-        (empty? gn) (do (println "$$$$" (apply list prog)) (open-close-sequence-to-list (apply list prog)))
+        (empty? gn) (open-close-sequence-to-list (apply list prog))
         ; If here, ready for next instruction
         :else (let [number-paren-groups (lookup-instruction-paren-groups (:instruction (first gn)))
                     new-paren-stack (if (>= 0 number-paren-groups)
@@ -89,11 +89,7 @@
                                               '(:close)
                                               paren-stack))]
                 (if (= 'noop_delete_prev_paren_pair (:instruction (first gn)))
-                  (recur (let [asdasd (delete-prev-paren-pair prog)]
-                           (println "prog##" prog)
-                           (println "----- " asdasd)
-                           (println "gn:  " (rest gn))
-                           asdasd)
+                  (recur (delete-prev-paren-pair prog)
                          (rest gn)
                          (get (first gn) :close 0)
                          new-paren-stack)


refactor includes days in countdown for easier read

--- src/cljs/wombats_web_client/components/countdown_timer.cljs
+++ src/cljs/wombats_web_client/components/countdown_timer.cljs
@@ -31,29 +31,37 @@
   [start-time]
   (pos? (seconds-until start-time)))

-(defn- format-time
-  [time cmpnt-state]
-  (let [seconds-left (seconds-until time)]
-    ;; if time is left and requires an active timer
-    (if (time-left? time)
-      ;; calculate format of time
-      (let [seconds (mod seconds-left 60)
-            seconds-formatted (if (< seconds 10)
-                                (str "0" seconds)
-                                seconds)
-            minutes (/ (- seconds-left seconds) 60)
-            hours (int (/ minutes 60))
-            minutes-adjusted (- minutes (* hours 60))
-            minutes-single-digit (< minutes-adjusted 10)
-            minutes-formatted (str (when minutes-single-digit "0")
-                                   minutes-adjusted)
-            has-hours (pos? hours)]
-        (str (when has-hours
-               (str hours ":"))
-             minutes-formatted ":" seconds-formatted))
+(defn pad-time [time]
+  (if (< time 10)
+    (str "0" time)
+    time))

-      ;; set to 0 time
-      "0:00")))
+(defn total-time [smaller-unit divisor]
+  (int (/ smaller-unit divisor)))
+
+(defn remaining-time [total larger-total multiplier]
+  (- total (* larger-total multiplier)))
+
+(defn format-time2 [time]
+ (if (time-left? time)
+   (let [total-seconds (seconds-until time)
+         total-minutes (total-time total-seconds 60)
+         total-hours (total-time total-minutes 60)
+         total-days (total-time total-hours 24)
+         remaining-secs
+         (remaining-time total-seconds total-minutes 60)
+         remaining-mins
+         (remaining-time total-minutes total-hours 60)
+         remaining-hrs
+         (remaining-time total-hours total-days 24)]
+     (str
+      (when (pos? total-days)
+        (str (pad-time total-days) ":"))
+      (when (pos? total-hours)
+        (str (pad-time remaining-hrs) ":"))
+      (pad-time remaining-mins) ":"
+      (pad-time remaining-secs)))
+   "00:00"))

 (defn countdown-timer
   [start-time]
@@ -73,4 +81,4 @@
         (:update @cmpnt-state)

         [:span {:class-name "countdown-timer"}
-         (format-time start-time cmpnt-state)])})))
+         (format-time2 start-time)])})))


CMR-815: Coding style fixes

CMR-815: Coding style fixes

--- src/cmr/search/services/parameters/parameter_validation.clj
+++ src/cmr/search/services/parameters/parameter_validation.clj
@@ -60,7 +60,8 @@
   if the value cannot be converted to an Integer."
   [params value-keyword]
   (when-let [value (value-keyword params)]
-    (if (not (vector? value)) ; Return null if value is a vector.  Assumes single-value-validation handles arrays.
+    ; Return null if value is a vector.  Assumes single-value-validation handles vectors.
+    (when-not (sequential? value)
       (Integer. value))))

 (defn single-value-validation
@@ -68,10 +69,10 @@
    passed as a vector of values."
   [concept-type params]
   (->> (select-keys params single-value-params)
-       (filter (fn [[k v]] (or (vector? v) (seq? v))))
+       (filter #(sequential? (second %)))
        (map first)
        (map #(format "Parameter [%s] must have a single value." (csk/->snake_case_string %)))
-       (vec)))
+       vec))

 (defn page-size-validation
   "Validates that the page-size (if present) is a number in the valid range."


bugfix for the option -d : only show if any dependecy has been found

--- src/leiningen/leinsync/deps.clj
+++ src/leiningen/leinsync/deps.clj
@@ -89,14 +89,15 @@
        (apply hash-map)))

 (defn log-resources-table [selector m]
-  (m/info "* List of dependencies of" selector)
-  (m/info "  " different-marker "version :  means that the dependency on this project is out-of-date")
-  (pp/print-compact-table m))
+  (if (seq m)
+    (do
+      (m/info "* List of dependencies of" selector)
+      (m/info "  " different-marker "version :  means that the dependency on this project is out-of-date")
+      (pp/print-compact-table m))
+    (m/info "* No dependency has been found for" selector)))

 (defn check-dependencies-of [projects-desc selector]
-  (let [enrich-version-fn (->> projects-desc
-                               (repositories-of)
-                               (partial parallel-get-version ancient-latest-version-fn))]
+  (let [enrich-version-fn (partial parallel-get-version ancient-latest-version-fn (repositories-of projects-desc))]
     (->> projects-desc
          (deps->project selector)
          (merge-deps)


Add specs and fix docstring for 'expound' and 'expound-str'

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -18,11 +18,12 @@
 ;;;;;; internal specs ;;;;;;

 (s/def ::singleton (s/coll-of any? :count 1))
-(s/def :spec/spec keyword?)
-(s/def :spec/specs (s/coll-of :spec/spec))
-(s/def :spec.problem/via (s/coll-of :spec/spec :kind vector?))
-(s/def :spec/problem (s/keys :req-un [:spec.problem/via]))
-(s/def :spec/problems (s/coll-of :spec/problem))
+;; TODO - rename within expound namespace, I can't take top-level spec namespace
+;; (s/def :spec/spec keyword?)
+;; (s/def :spec/specs (s/coll-of :spec/spec))
+;; (s/def :spec.problem/via (s/coll-of :spec/spec :kind vector?))
+;; (s/def :spec/problem (s/keys :req-un [:spec.problem/via]))
+;; (s/def :spec/problems (s/coll-of :spec/problem))

 (s/def :expound.printer/show-valid-values? boolean?)
 (s/def :expound.printer/value-str-fn ifn?)
@@ -33,6 +34,11 @@
                                        :expound.printer/value-str-fn
                                        :expound.printer/print-specs?
                                        :expound.printer/theme]))
+(s/def :expound.spec/spec (s/or
+                           :set set?
+                           :pred ifn?
+                           :kw qualified-keyword?
+                           :spec s/spec?))

 ;;;;;; themes ;;;;;;

@@ -166,6 +172,7 @@
 (defn ^:private spec-w-error-message? [via pred]
   (boolean (let [last-spec (last via)]
              (and (not= ::s/unknown pred)
+                  (qualified-keyword? last-spec)
                   (error-message last-spec)
                   (s/get-spec last-spec)))))

@@ -179,7 +186,10 @@
      (remove nil?
              (conj (keep
                     (fn [{:keys [expound/via]}]
-                      (ansi/color (error-message (last via)) :good))
+                      (let [last-spec (last via)]
+                        (if (qualified-keyword? last-spec)
+                          (ansi/color (error-message last-spec) :good)
+                          nil)))
                     with-msg)
                    (when (seq no-msgs)
                      (printer/format
@@ -770,7 +780,7 @@

 (s/fdef error-message
         :args (s/cat :k qualified-keyword?)
-        :ret string?)
+        :ret (s/nilable string?))
 (defn error-message
   "Given a spec named `k`, return its human-readable error message"
   [k]
@@ -792,13 +802,20 @@
   (fn [explain-data]
     (print (printer-str opts explain-data))))

+(s/fdef printer
+        :args (s/cat :explain-data map?)
+        :ret nil?)
 (defn printer
-  "Prints explain-data in a human-readable format"
+  "Prints `explain-data` in a human-readable format"
   [explain-data]
   ((custom-printer {}) explain-data))

+(s/fdef expound-str
+        :args (s/cat :spec :expound.spec/spec
+                     :form any?)
+        :ret string?)
 (defn expound-str
-  "Given a spec and a value, either returns success message or returns a human-readable explanation as a string."
+  "Given a `spec` and a `form`, either returns success message or returns a human-readable explanation as a string."
   [spec form]
   ;; expound was initially released with support
   ;; for CLJS 1.9.542 which did not include
@@ -811,8 +828,12 @@
                           ::s/value form)
                    nil))))

+(s/fdef expound
+        :args (s/cat :spec :expound.spec/spec
+                     :form any?)
+        :ret nil?)
 (defn expound
-  "Given a spec and a value, either prints a success message or prints a human-readable explanation as a string."
+  "Given a `spec` and a `form`, either prints a success message or prints a human-readable explanation"
   [spec form]
   (print (expound-str spec form)))


Don't rely on 'def-print-method' implementation (cider-nrepl adds some)

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -202,7 +202,9 @@
      :clj (string/replace s "clojure.core/" "")))

 (defn pprint-fn [f]
-  (let [s (second (re-find #"\#object\[([^ ]+) " (pr-str f)))]
+  (let [pattern #?(:clj #"([^@]+)@"
+                   :cljs #"function ([^\(]+)\(")
+        s (second (re-find pattern (str f)))]
     (-> #?(:clj
            (clojure.main/demunge s)
            :cljs
@@ -465,6 +467,18 @@
          (if (= :instrument failure)
            (vec (rest (:path problem)))
            (:path problem))))
+
+(comment
+  (clojure.main/demunge
+   (second
+    (re-find
+     #"([^@]+)@"
+     (str string?))))
+
+  (str safe-sort-by)
+
+  (expound-str string? 1)
+  )

 (defn safe-sort-by
   "Same as sort-by, but if an error is raised, returns the original unsorted collection"


missed reference

missed reference

--- src/ghadi/reducers.clj
+++ src/ghadi/reducers.clj
@@ -16,9 +16,9 @@
 (defn ^:private reducing-impl
   [this f init body]
   `(p/CollReduce
-    (~'coll-reduce [this# f#]
+    (coll-reduce [this# f#]
        (p/coll-reduce this# f# (f#)))
-    (~'coll-reduce [~this ~f ~init]
+    (coll-reduce [~this ~f ~init]
        ~@body)))

 (defmacro reducible
@@ -26,7 +26,7 @@
    delegating to the provided two argument signature"
   [bindings & body]
   (assert (and (vector? bindings)
-               (= (count bindings) 2)
+               (= (clojure.core/count bindings) 2)
                (every? symbol? bindings)))
   (let [[f init] bindings]
     `(reify
@@ -159,3 +159,4 @@
    Analogous to (sequence xfn coll) but for Iterables"
   [xfn iterable]
   (XFIterable. xfn iterable))
+


Refactor projection code

Refactor projection code

--- src/graphito/core.cljs
+++ src/graphito/core.cljs
@@ -27,6 +27,10 @@

 (def swipe-damping-factor 1)
 (def min-slide-speed-sq 16)
+
+; A factor of 1 is an ellipse fitting the bounds of the window. Higher factors
+; expand the visualization linearly.
+(def displacement-factor 1)

 (def max-radius 32)
 (def min-radius 2)
@@ -56,18 +60,17 @@
     (add-background! svg width height)
     svg))

-
 ;; Vector math

 (defn math-vec [x y] {:x x :y y})

 (def sqrt (.-sqrt js/Math))

-(defn dist-sq [v]
+(defn vec-length-sq [v]
   (let [{:keys [x y]} v]
     (+ (* x x) (* y y))))

-(def dist (comp sqrt dist-sq))
+(def vec-length (comp sqrt vec-length-sq))

 (defn add-vec [v1 v2]
   (merge-with + v1 v2))
@@ -82,44 +85,53 @@
   (scalar-multiply v -1))

 (defn vec-with-length [v l]
-  (scalar-multiply v (/ l (dist v))))
+  (scalar-multiply v (/ l (vec-length v))))
+
+(def vec-distance (comp vec-length subtract-vec))

 ;; D3 magic

-(defn project-displacement [d view-length]
-  (let [t (/ d view-length)]
-    (* view-length
-       (cond
-         (<= t 0.5) t
-         (<= 0.5 t 1) (+ 0.5 (/ (- t 0.5) 2))
-         (<= 1 t 1.5) (+ 0.75 (/ (- t 1) 4))
-         (<= 1.5 t 2.5) (+ 0.875 (/ (- t 1.5) 8))
-         (<= 2.5 t) 1))))
-
-(defn view-position
-  "Given the actual position of a node (in world coordinates), return the
-  position of the node in screen coordinates according to the state."
+(defn scaled-distance-from-camera
+  "Returns the distance of the given point from the camera, scaled so that
+  points which would be at the corner of the screen are at distance 1"
   [state pos]
+  (let [{:keys [camera-pos view-size]} state
+        corner-distance (/ (vec-length view-size) 2)]
+    (/ (vec-distance (:camera-pos state) pos) corner-distance)))
+
+(defn elliptic-distance-from-camera [state pos]
+  (let [{:keys [view-size camera-pos]} state
+        rx (/ (:x view-size) 2)
+        ry (/ (:y view-size) 2)
+        sq (fn [x] (* x x))
+        {:keys [x y]} (subtract-vec pos camera-pos)]
+    (sqrt (+ (/ (sq x) (sq rx)) (/ (sq y) (sq ry))))))
+
+(defn project-displacement [t]
+  (cond
+    (<= t 0.5) t
+    (<= 0.5 t 1) (+ 0.5 (/ (- t 0.5) 2))
+    (<= 1 t 1.5) (+ 0.75 (/ (- t 1) 4))
+    (<= 1.5 t 2.5) (+ 0.875 (/ (- t 1.5) 8))
+    (<= 2.5 t) 1))
+
+(defn view-position [state pos]
   (let [{:keys [view-size camera-pos]} state
         view-center (scalar-multiply view-size 0.5)
-        view-radius (dist view-center)
+        corner-distance (vec-length view-center)
         displacement (subtract-vec pos camera-pos)
-        r (dist displacement)
-        projected-r (project-displacement r view-radius)]
-    (add-vec view-center (vec-with-length displacement projected-r))))
-
-(defn project-radius [d view-length]
-  (let [t (/ d view-length)]
+        r (scaled-distance-from-camera state pos)
+        projected-r (project-displacement r)]
+    (add-vec view-center (scalar-multiply displacement
+                                        (/ projected-r r)))))
+
+(defn project-radius [t]
     (+ min-radius (* (- max-radius min-radius)
-                     (min 1 (/ 1 (.pow js/Math 2 (* 2 (- t 0.25)))))))))
+                     (min 1 (/ 1 (.pow js/Math 2 (* 2 (- t 0.25))))))))

 (defn view-radius [state pos]
-  (let [{:keys [view-size camera-pos]} state
-        view-center (scalar-multiply view-size 0.5)
-        view-radius (dist view-center)
-        displacement (subtract-vec pos camera-pos)
-        r (dist displacement)]
-    (project-radius r view-radius)))
+  (let [r (scaled-distance-from-camera state pos)]
+    (project-radius r)))

 (defn sync-graph! [state]
   (let [{:keys [svg nodes]} state
@@ -136,8 +148,8 @@
         .enter
         (.append "circle")
         (.attr "class" "node")
-        (.attr "cx" (comp view-x))
-        (.attr "cy" (comp view-y))
+        (.attr "cx" view-x)
+        (.attr "cy" view-y)
         (.attr "r" _view-radius))))

 ;; State management
@@ -300,7 +312,7 @@
         (.map (constantly :scroll-end)))))

 (defn dampen [v]
-  (let [length (dist v)]
+  (let [length (vec-length v)]
     (vec-with-length v (- length swipe-damping-factor))))

 (defn swipe-displacements-observable [manager svg]
@@ -316,7 +328,7 @@
             (.generateWithRelativeTime rx-observable
               (math-vec (* update-interval-ms (or vx 0))
                         (* update-interval-ms (or vy 0)))
-              (fn [v] (> (dist-sq v) min-slide-speed-sq))
+              (fn [v] (> (vec-length-sq v) min-slide-speed-sq))
               dampen
               identity
               (constantly update-interval-ms))))))))


Clean up item create REST API integration tests. Don't need to use the REST API to validate it.

--- test/fcms/integration/api/item/item_create.clj
+++ test/fcms/integration/api/item/item_create.clj
@@ -7,7 +7,7 @@

 ;; Creating items with the REST API

-;; The system should store valid items into a collection and handle the following scenarios:
+;; The system should store newly created valid items into a collection and handle the following scenarios:

 ;; POST
 ;; all good - no slug
@@ -32,7 +32,7 @@
 (with-state-changes [(before :facts (empty-collection-e))
                      (after :facts (collection/delete-collection "e"))]

-  (facts "about creating valid new items")
+  (facts "about creating valid new items"

     ;; all good, no slug - 201 Created
     ;; curl -i --header "Accept: application/vnd.fcms.item+json;version=1" --header "Accept-Charset: utf-8" --header "Content-Type: application/vnd.fcms.item+json;version=1" -X POST -d '{"name":"i"}' http://localhost:3000/c/
@@ -44,31 +44,24 @@
           :Content-Type (mime-type :item)
         }
         :body {
-          :name "i"
+          :name i
         }})]
         (:status response) => 201
         (base-mime-type (get-in response [:headers "Content-Type"])) => (mime-type :item)
         (get-in response [:headers "Location"]) => "/e/i"
         (json? response) => true
-        (item/get-item "e" "i") => (contains {
-          :collection "e"
-          :name "i"
-          :slug "i"
+        (item/get-item e i) => (contains {
+          :collection e
+          :name i
+          :slug i
           :version 1})
-        (collection/item-count "e") => 1)
-      ;; Get the created item
-      (let [response (api-request :get "/e/i" {
-        :headers {
-          :Accept (mime-type :item)
-        }})]
-        (:status response) => 200
-        (base-mime-type (get-in response [:headers "Content-Type"])) => (mime-type :item)
-        (json? response) => true
-        (let [item (body-from-response response)]
-          (:slug item) => "i"
-          (:name item) => "i"
-          (:version item) => 1
-          (:collection item) => e)))
+        (collection/item-count e) => 1)
+      ;; Get the created item and make sure it's right
+      (let [item (item/get-item e i)]
+        (:slug item) => i
+        (:name item) => i
+        (:version item) => 1
+        (:collection item) => e))

     ;; all good, generated slug is different than the provided name - 201 Created
     ;; curl -i --header "Accept: application/vnd.fcms.item+json;version=1" --header "Accept-Charset: utf-8" --header "Content-Type: application/vnd.fcms.item+json;version=1" -X POST -d '{"name":" -tHiS #$is%?-----ελληνικήalso-მივჰხვდემასჩემსაãالزجاجوهذالايؤلمني-slüg♜-♛-☃-✄-✈  - "}' http://localhost:3000/c/
@@ -86,22 +79,15 @@
         (base-mime-type (get-in response [:headers "Content-Type"])) => (mime-type :item)
         (get-in response [:headers "Location"]) => "/e/this-is-also-a-slug"
         (json? response) => true
-        (item/get-item "e" "this-is-also-a-slug") => (contains {
-          :collection "e"
+        (item/get-item e "this-is-also-a-slug") => (contains {
+          :collection e
           :name " -tHiS #$is%?-----ελληνικήalso-მივჰხვდემასჩემსაãالزجاجوهذالايؤلمني-slüg♜-♛-☃-✄-✈  - "
           :slug "this-is-also-a-slug"
           :version 1})
         (collection/item-count "e") => 1)
-      ;; Get the created item
-      (let [response (api-request :get "/e/this-is-also-a-slug" {
-        :headers {
-          :Accept (mime-type :item)
-        }})]
-        (:status response) => 200
-        (base-mime-type (get-in response [:headers "Content-Type"])) => (mime-type :item)
-        (json? response) => true
-        (let [item (body-from-response response)]
-          (:slug item) => "this-is-also-a-slug"
-          (:name item) => " -tHiS #$is%?-----ελληνικήalso-მივჰხვდემასჩემსაãالزجاجوهذالايؤلمني-slüg♜-♛-☃-✄-✈  - "
-          (:version item) => 1
-          (:collection item) => e))))+      ;; Get the created item and make sure it's right
+      (let [item (item/get-item e "this-is-also-a-slug")]
+        (:slug item) => "this-is-also-a-slug"
+        (:name item) => " -tHiS #$is%?-----ελληνικήalso-მივჰხვდემასჩემსაãالزجاجوهذالايؤلمني-slüg♜-♛-☃-✄-✈  - "
+        (:version item) => 1
+        (:collection item) => e))))


Oops, hash-set takes & elems not coll

Oops, hash-set takes & elems not coll

--- src/icecap/execute.clj
+++ src/icecap/execute.clj
@@ -17,7 +17,7 @@

 (def ^:private supported-schemes
   "The currently supported schemes."
-  (hash-set (keys handlers)))
+  (into #{} (keys handlers)))

 (defn get-scheme
   "Gets the scheme of a URL."


add try-finally to test run

add try-finally to test run

--- test/shale/test/utils.clj
+++ test/shale/test/utils.clj
@@ -38,5 +38,6 @@
   [ports]
   (fn [test-fn]
     (let [servers (doall (pmap start-selenium-server ports))]
-      (test-fn)
-      (doall (pmap stop-selenium-server servers)))))
+      (try
+        (test-fn)
+        (finally (doall (pmap stop-selenium-server servers)))))))


Remove state

Remove state

--- src/doctopus/doctopus.clj
+++ src/doctopus/doctopus.clj
@@ -25,11 +25,8 @@
     [configuration substitutions]
   DoctopusMethods
   (bootstrap-heads [this]
-    (let [heads-dir (:heads-dir configuration)
-          dirs (fs/list-dir heads-dir)
-          head-names (map #(.getName %) dirs)
-          heads (map #(h/Head. %) head-names)]
-      (doall (map #(h/bootstrap-tentacles % heads-dir substitutions) heads))))
+    (let [heads (map h/map->Head (db/get-all-heads))]
+      (doall (map #(h/bootstrap-tentacles % substitutions) heads))))
   (list-heads [this] (doall (map h/map->Head (db/get-all-heads))))
   (list-tentacles [this]
     (into [] (flatten (for [head (list-heads this)


Don't bother running deps task if there aren't any dependencies.

--- src/leiningen/deps.clj
+++ src/leiningen/deps.clj
@@ -69,19 +69,20 @@
   "Download and install all :dependencies listed in project.clj.
 With an argument it will skip development dependencies."
   ([project skip-dev deps-set]
-     (when-not (:disable-implicit-clean project)
-       (delete-file-recursively (:library-path project) true))
-     (let [deps-task (make-deps-task project deps-set)
-           _ (.execute deps-task)
-           fileset (.getReference lancet/ant-project
-                                  (.getFilesetId deps-task))]
-       (.mkdirs (File. (:library-path project)))
-       (copy-dependencies (:jar-behavior project)
-                          (:library-path project)
-                          true fileset)
-       (when (and (not skip-dev) (seq (:dev-dependencies project)))
-         (deps (assoc project :library-path (str (:root project) "/lib/dev"))
-               true :dev-dependencies))
-       fileset))
+     (when (seq (project deps-set))
+       (when-not (:disable-implicit-clean project)
+         (delete-file-recursively (:library-path project) true))
+       (let [deps-task (make-deps-task project deps-set)
+             _ (.execute deps-task)
+             fileset (.getReference lancet/ant-project
+                                    (.getFilesetId deps-task))]
+         (.mkdirs (File. (:library-path project)))
+         (copy-dependencies (:jar-behavior project)
+                            (:library-path project)
+                            true fileset)
+         (when (and (not skip-dev) (seq (:dev-dependencies project)))
+           (deps (assoc project :library-path (str (:root project) "/lib/dev"))
+                 true :dev-dependencies))
+         fileset)))
   ([project skip-dev] (deps project skip-dev :dependencies))
   ([project] (deps project false)))


Add fetch-all subtask. Report repo instead of path while fetching.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -219,12 +219,16 @@
 (defn all-repos-dirs []
   (glob (str (s/replace voom-repos #"/$" "") "/*")))

-(defn fetch-all
-  [dirs]
-  (doseq [^File d dirs]
-    (print (str "Fetching: " (.getPath d) "\n"))
-    (flush)
-    (git {:gitdir d} "fetch")))
+(defn ^:info-subtask fetch-all
+  "Run 'git fetch' for all git repos in $VOOM_REPOS"
+  ([]
+     (fetch-all (all-repos-dirs))
+     'done)
+  ([dirs]
+     (doseq [^File d dirs]
+       (let [repo (-> (remotes d) :origin :fetch)]
+         (println "Fetching:" repo (print-str (list (.getName d))))
+         (git {:gitdir d} "fetch")))))

 (defn find-project
   [pgroup pname candidate]
@@ -537,7 +541,7 @@
   [project & args]
   (ensure-deps-repos (:dependencies project))
   (when (not-any? #{"--no-fetch"} args)
-    (fetch-all (all-repos-dirs)))
+    (fetch-all))
   (let [prj-file-name (str (:root project) "/project.clj")
         old-deps (:dependencies project)
         desired-new-deps (doall (map #(fresh-version %) old-deps))]
@@ -1125,8 +1129,8 @@

 (def ^{:doc "Display this help message"} box-help help)

-(def subtasks [#'build-deps #'deploy #'find-box #'freshen #'help #'install
-               #'update-repo-dbs #'ver-parse #'wrap
+(def subtasks [#'build-deps #'deploy #'fetch-all #'find-box #'freshen #'help
+               #'install #'update-repo-dbs #'ver-parse #'wrap
                #'box #'box-new #'box-init #'box-add #'box-remove #'box-help])

 ;; Note the docstring for 'voom' is seen when the user runs any of:


Tag project deletions explicitly.

Tag project deletions explicitly.

Without this 'newest-voom-ver-by-spec would sometimes walk forward too far,
returning a commit that didn't even have the matching project

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -418,10 +418,13 @@
     (doseq [:when (seq proj-shas)
             {:keys [sha refs parents ops]} (report-progress gitdir proj-shas)
             {:keys [op path]} ops]
-      (when-let [p (and (not= "D" op)
-                        (robust-read-project gitdir sha path))]
+      (when-let [p (if (= "D" op)
+                     {:root (str (.getParent (io/file path)))}
+                     (robust-read-project gitdir sha path))]
         (let [tag (s/join "--" (-> ["voom"
-                                    (str (:group p) "%" (:name p))
+                                    (str (:group p)
+                                         (when (:group p) "%")
+                                         (:name p))
                                     (:version p)
                                     (s/replace (:root p) #"/" "%")
                                     (subs sha 0 7)]


Fixing long-standing recursive build-deps bug.

Calls to build-deps may build projects using the same working copy but
depending on a different checkout state. Because the checkout state
was set prior to the call to build-deps, the checkout state may have
changed by install time. This didn't result in bad artifacts, our
safety mechanisms assure the proper version is being built, however it
did stop the build with an exception.

The previous work-around was to run "lein voom build-deps" enough
times, making a bit more progress each time, eventually succeeding.

This is no longer needed. Builds should run through to completion the
first time.

The solution is to set the checkout state before build-deps (as was
done previously) but to set the checkout state again, after
build-deps.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -293,9 +293,14 @@
   [version proot]
   (println "Calling recursive build-deps on:" proot)
   (print (:out (sh "lein" "voom" "build-deps" :dir proot)))
-  ;; BEWARE: Allowing dirty working copy here is ONLY OK because the
+  ;; Before getting here 'find-matching-projects had already called
+  ;; 'safe-checkout but "build-deps" dependencies may have modified
+  ;; the working-copy along the way so we make sure we're again at the
+  ;; right version before installing.
+  (safe-checkout proot (-> version ver-parse :sha))
+  ;; NOTE: Allowing dirty working copy here is ONLY OK because the
   ;; working copy in question was just checked out and cleaned using
-  ;; 'safe-checkout in 'find-matching-projects above:
+  ;; 'safe-checkout above.
   (let [install-cmd ["lein" "voom" "wrap" ":insanely-allow-dirty-working-copy"
                      (str ":expected-version--" version)
                      "install" :dir proot]


Filter 'newest-voom-ver-by-spec by repo, branch, and path

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -367,9 +367,11 @@
    (update-in [:proj] (fnil s/replace "") #"%" "/")))

 (defn newest-voom-ver-by-spec
-  [proj-name ver-spec {:keys [repo ref path]}]
+  [proj-name ver-spec {:keys [repo branch path]}]

   (for [gitdir (all-repos-dirs)
+        :let [found-repo (-> (remotes gitdir) :origin :fetch)]
+        :when (or (= found-repo repo) (nil? repo))
         :let [ptn (s/join "--" ["voom"
                                 (str (namespace proj-name) "%" (name proj-name))
                                 (str ver-spec "*")])
@@ -379,9 +381,11 @@
                        []
                        (map parse-tag tags))
               paths (set (map :path tspecs))]
-        path paths
-        branch (map #(re-find #"[^/]*/+[^/]*$" (str %))
-                    (glob (str gitdir "/refs/remotes/*/*")))
+        found-path paths
+        :when (or (= found-path path) (nil? path))
+        found-branch (map #(.getName ^File %)
+                          (glob (str gitdir "/refs/remotes/origin/*")))
+        :when (or (= found-branch branch) (nil? branch))
         :let [neg-tags (map #(str "^" % "^") tags)
               neg-tags (filter (partial contains-sha? gitdir) neg-tags)
               commits
@@ -389,24 +393,25 @@
                  parse-sha-refs
                  (:lines (apply git {:gitdir gitdir} "log"
                                 "--pretty=format:%H,%cd,%d" "--decorate" "--reverse"
-                                (concat neg-tags [branch "--" path]))))]
+                                (concat neg-tags [(str "origin/" found-branch) "--" found-path]))))]
         :when (seq commits)]
     (let [refs (-> commits first :refs)
           reflist (filter #(and
                             (= (str proj-name) (:proj %))
-                            (= path (:path %))) (map parse-tag refs))]
+                            (= found-path (:path %))) (map parse-tag refs))]
       (some (fn [[current next-commit]]
               #_(prn :refs path (:refs next-commit))
               (when (or (= :end next-commit)
-                        (some #(= path (:path (parse-tag %)))
+                        (some #(= found-path (:path (parse-tag %)))
                               (:refs next-commit)))
                 {:sha (:sha current)
                  :ctime (:ctime current)
                  :ver (-> reflist first :ver)
-                 :path path
+                 :path found-path
                  :proj proj-name
                  :gitdir gitdir
-                 :branch branch}))
+                 :repo found-repo
+                 :branch found-branch}))
             (partition 2 1 (concat commits [:end]))))))

 (defn fresh-version [[prj ver :as dep]]


Decomplect 'all-projects notion from 'resolve-short-proj.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -600,17 +600,19 @@
                            :desired-new-deps desired-new-deps
                            :tmp-file-name (str tmp-file)})))))))

+(defn all-projects
+  []
+  (into #{}
+        (flatten
+         (for [g (all-repos-dirs)]
+           (map #(s/replace (second (s/split % #"--")) #"%" "/")
+                (:lines (git {:gitdir g} "tag" "--list" "voom--*")))))))
+
 (defn resolve-short-proj
-  [dep]
-  (let [proj-set
-        , (into #{}
-                (flatten
-                 (for [g (all-repos-dirs)]
-                   (map #(s/replace (second (s/split % #"--")) #"%" "/")
-                        (:lines (git {:gitdir g} "tag" "--list" "voom--*"))))))]
-    (for [proj proj-set
-          :when (.contains ^String proj dep) ]
-      proj)))
+  [dep projects]
+  (for [proj projects
+        :when (.contains ^String proj dep)]
+    proj))

 (defn adj-path
   ([f path] (adj-path false f path))
@@ -685,7 +687,7 @@
           dep deps
           :let [full-projs (if (.contains (str dep) "/")
                              [dep]
-                             (resolve-short-proj (pr-str dep)))
+                             (resolve-short-proj (pr-str dep) (all-projects)))
                 full-projs (map symbol full-projs)
                 repo-infos (mapcat #(newest-voom-ver-by-spec % (meta dep)) full-projs)]]
     (case (count repo-infos)


Convert 'file-patho to 'obj-patho with extra 'ftype argument.

This makes it able to find parent sub-trees and the like.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -1042,14 +1042,14 @@
     ;; TODO: if dirty, write out db
     db))

-(defn file-patho
-  [tree-sha so-far fname fsha tree-path]
+(defn obj-patho
+  [tree-sha so-far fname ftype fsha tree-path]
   (l/conde
-   [(r-tree tree-sha fname :blob fsha) (l/== so-far tree-path)]
+   [(r-tree tree-sha fname ftype fsha) (l/== so-far tree-path)]
    [(l/fresh [next-path next-sha new-path]
              (r-tree tree-sha next-path :tree next-sha)
              (l/conso next-path so-far new-path)
-             (file-patho next-sha new-path fname fsha tree-path))]))
+             (obj-patho next-sha new-path fname ftype fsha tree-path))]))

 (def ancestoro
   (l/tabled [childer parenter]
@@ -1086,8 +1086,8 @@
                         (r-commit c-sha ctime tree-sha)
                         (r-commit-parent c-sha p-sha)
                         (r-commit p-sha p-ctime p-tree-sha)
-                        (file-patho p-tree-sha nil fname p-obj-sha tree-path)
-                        (file-patho tree-sha nil fname obj-sha tree-path)
+                        (obj-patho p-tree-sha nil fname :blob p-obj-sha tree-path)
+                        (obj-patho tree-sha nil fname :blob obj-sha tree-path)
                         (l/!= obj-sha p-obj-sha)))))))

   (time


good so far

good so far

--- src/epicea/typed/core.clj
+++ src/epicea/typed/core.clj
@@ -42,7 +42,13 @@

 (spec/def ::pointer (spec/cat
                      :type (partial = :pointer)
-                     :value-type ::type))
+                     :value-type ::type
+                     :at (spec/? (spec/cat
+                                  :array symbol?
+                                  :offset (spec/or :int ::int
+                                                   :long ::long)))))
+
+

 (spec/def ::constant (spec/cat
                       :type (partial = :constant)
@@ -60,7 +66,8 @@
                           :pointer ::pointer
                           :unspecified ::unspecified ;; <-- a primitive building block
                           :constant ::constant
-                          :dynamic ::dynamic))
+                          :dynamic ::dynamic
+                          :dynamic symbol?))

 (def pair-vec {:default-parent [nil nil]})
 (def type-head (access/vector-accessor 0 pair-vec))


compute size on works

compute size on works

--- src/epicea/typed/core.clj
+++ src/epicea/typed/core.clj
@@ -62,36 +62,12 @@
                           :constant ::constant
                           :dynamic ::dynamic))

-
-(defn export-primitive [x]
-  [:export x])
-
-;(defmultiple export-typed-value first
-;  (:primitive [x] (export-primitive x)))
-(defn export-typed-value [x]
-  [:export x])
-
-
-;; How to specify one:
-;; (value [:record :a :number :b double] [3 [4 9]])
-
-
-(assert (spec/valid? ::number :number))
-(assert (spec/valid? ::record [:record
-                               :a :number
-                               :b [:vec nil 3]]))
-
-
-(def pair-settings {:default-parent [nil nil]})
-
-(def pair-tag (access/vector-accessor 0 pair-settings))
-(def pair-value (access/vector-accessor 1 pair-settings))
-
-(def get-pair-tag (access/getter pair-tag))
-(def get-pair-value (access/getter pair-value))
-
-;;;;;; Type properties
-;; When it is stored
+(def pair-vec {:default-parent [nil nil]})
+(def type-head (access/vector-accessor 0 pair-vec))
+(def type-body (access/vector-accessor 1 pair-vec))
+
+(def primitive-values #{:double :float :long :int :bool :number})
+
 (declare compute-size)

 (defn size-op [f]
@@ -101,6 +77,92 @@
 (def size-add +)
 (def size-mul *)
 (def size-max max)
+
+(defn compute-vec-size [x]
+  (size-mul (compute-size (vec-type x))
+            (vec-size x)))
+
+(defn compute-record-size [x]
+  (reduce size-add (map (comp compute-size :value-type)
+                        (:fields x))))
+
+(defn compute-size [type]
+  (let [h (access/getx type-head type)
+        b (access/getx type-body type)]
+    (cond
+      (= :constant h) 0
+      (contains? primitive-values h) 1
+      (= :vec h) (compute-vec-size b)
+      (= :record h) (compute-record-size b)
+      :default nil)))
+
+(def compute-size-on (comp compute-size #(spec/conform ::type %)))
+
+;;
+(assert (= 1 (compute-size-on 9)))
+(assert (= 0 (compute-size-on [:constant 9])))
+(assert (= 3 (compute-size-on [:vecdata 3 4 5])))
+(assert (= 5 (compute-size-on [:vec :double 5])))
+(assert (= 5 (compute-size-on [:record :a [:vecdata 1 2 3] :b :double :c :int])))
+(assert (nil? (compute-size-on :dynamic)))
+(assert (spec/valid? ::type 9))
+(assert (= [:long [:value 9]] (spec/conform ::type 9)))
+(assert (spec/valid? ::type [:record :a [:constant 9] :b :double]))
+
+(defn export-primitive [x]
+  [:export x])
+
+
+(defn vec-body? [x]
+  (and (map? x)
+       (contains? #{:vecdata :vec} (:type x))))
+
+(defn vec-type [vec-body]
+  (assert (vec-body? vec-body))
+  (if (= :vecdata (:type vec-body))
+    (-> vec-body :data first)
+    (:value-type vec-body)))
+
+(defn vec-size [vec-body]
+  (assert (vec-body? vec-body))
+  (if (= :vecdata (:type vec-body))
+    (-> vec-body :data count)
+    (:count vec-body)))
+
+(def v0 (second (spec/conform ::type [:vecdata 1 2 3 4])))
+(def v1 (second (spec/conform ::type [:vec 1 3])))
+(assert (= :long (first (vec-type v0))))
+(assert (= :long (first (vec-type v1))))
+(assert (= 4 (vec-size v0)))
+(assert (= 3 (vec-size v1)))
+
+
+;(defmultiple export-typed-value first
+;  (:primitive [x] (export-primitive x)))
+(defn export-typed-value [x]
+  [:export x])
+
+
+;; How to specify one:
+;; (value [:record :a :number :b double] [3 [4 9]])
+
+
+(assert (spec/valid? ::number :number))
+(assert (spec/valid? ::record [:record
+                               :a :number
+                               :b [:vec nil 3]]))
+
+
+(def pair-settings {:default-parent [nil nil]})
+
+(def pair-tag (access/vector-accessor 0 pair-settings))
+(def pair-value (access/vector-accessor 1 pair-settings))
+
+(def get-pair-tag (access/getter pair-tag))
+(def get-pair-value (access/getter pair-value))
+
+;;;;;; Type properties
+;; When it is stored

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Grammar
 (spec/def ::arg-name symbol?)


Save and open examples as clj - repl it ftw

--- src/lt/plugins/inc_clojure.cljs
+++ src/lt/plugins/inc_clojure.cljs
@@ -4,7 +4,7 @@
             [clojure.string :as s]
             [lt.objs.editor.pool :as pool]
             [lt.plugins.clojure :as clojure]
-            [lt.objs.tabs :as tabs]
+            [lt.objs.files :as files]
             [lt.objs.notifos :as notifos]
             [lt.objs.command :as cmd])
   (:require-macros [lt.macros :refer [defui behavior]]))
@@ -33,6 +33,10 @@
                   :browser.url-bar.focus
                   [:browser.url-bar.navigate! url]
                   :browser.focus-content]))
+
+(defn tempfile [seed suffix]
+  (let [dir (.tmpdir (js/require "os"))]
+    (files/join dir (str seed "-" (js/Date.now) suffix))))

 ;; Open pages
 ;; ==========
@@ -103,7 +107,6 @@
                                    (str "(resolve '" (current-word ed) ")")
                                    :open-grimoire)))})

-;; (def url "http://grimoire.arrdem.com/1.5.0/clojure.string/blank_QMARK/examples")
 (defn GET [url cb]
   (let [req (.get (js/require "http") url
                   (fn [resp]
@@ -111,40 +114,30 @@
     (.on req "error" (fn [err]
                        (println "Request" url "failed with:" (.-message err))))))

-(defui examples-panel [{:keys [body]}]
-  [:pre body])
-
-(behavior ::on-close-destroy
-          :triggers #{:close}
-          :reaction (fn [this]
-                      (object/raise this :destroy)))
-
-(object/object* ::grimoire-examples
-                :tags [:grimoire-examples]
-                :behaviors [::on-close-destroy]
-                :name "Grimoire Examples"
-                :init (fn [this]
-                        (examples-panel (apply hash-map (:args @this)))))
-
 (def ->grimoire-examples-url (comp #(str % "/examples") ->grimoire-url))

-(defn ->examples-tab [url]
+(defn fetch-and-open-grimoire-examples* [{:keys [ns var url]}]
   (notifos/working)
   (GET url (fn [body]
-             (tabs/add-or-focus!
-              (object/create ::grimoire-examples :body (str body)))
+             (let [path (tempfile (str ns "-" var) ".clj")]
+               (files/save path body)
+               (cmd/exec! :open-path path))
              (notifos/done-working))))

-(def grimoire-examples-tab
-  (partial for-resolved-var (comp ->examples-tab ->grimoire-examples-url)))
+(def fetch-and-open-grimoire-examples
+  (partial for-resolved-var
+           (fn [ns var]
+             (fetch-and-open-grimoire-examples*
+              {:ns ns :var var :url (->grimoire-examples-url ns var)}))))

-(cmd/command {:command :inc-clojure.grimoire-examples-tab
-              :desc "IncClojure: Open grimoire examples tab for current symbol"
+(cmd/command {:command :inc-clojure.open-grimoire-examples
+              :desc "IncClojure: Open grimoire examples locally for current symbol"
               :exec (fn []
                       (let [ed (pool/last-active)]
                         (eval-code ed
                                    (str "(resolve '" (current-word ed) ")")
-                                   :grimoire-examples-tab)))})
+                                   :fetch-and-open-grimoire-examples)))})
+
 (comment
   (object/raise editor :editor.eval.clj.result.callback "OK?")
   (-> @editor :client :default deref)


Add TODO

Add TODO

--- src/main/clojure/pigpen/raw.clj
+++ src/main/clojure/pigpen/raw.clj
@@ -261,6 +261,7 @@

 ;; ********** Set **********

+;; TODO single union -> first relation
 (defn union$
   [ancestors opts]
   (command :union ancestors (-> ancestors first :fields) opts))


updating five points model

updating five points model

--- src/five_points/model.clj
+++ src/five_points/model.clj
@@ -13,6 +13,9 @@
 (s/defschema Item-Id (s/constrained s/Str #(re-matches #"item[A-Za-z0-9]{10}" %) 'Item-Id))

 (s/defschema Char-Id (s/constrained s/Str #(re-matches #"char[A-Za-z0-9]{10}" %) 'Char-Id))
+
+(s/defschema GameTime {:value s/Int
+                       :unit (s/enum :Minor-Action :Major-Action :Minute :Hour :Day :Month :Year)})

 (s/defschema Score
   (s/enum 1 2 3 4 5))
@@ -37,19 +40,26 @@

 (s/defschema Prerequisite
   (s/constrained
-    {(s/optional-key :min-lvl) s/Int
+    {(s/optional-key :kin) #{Kin-Id}
+     (s/optional-key :caste) #{Caste-Id}
      (s/optional-key :skill-sets) #{Skill-Set-Id}
      (s/optional-key :skills) #{Skill-Id}}
     not-empty))

 (s/defschema Bonus
-  {:check (s/either Check Stat)
+  {:description s/Str
+   :check (s/either Check Stat)
    :value (s/either Score :talent {:talent s/Int} {:level Score} {:talent :level})
-   (s/optional-key :min-lvl) s/Int})
+   (s/optional-key :lvl) s/Int
+   (s/optional-key :invocation) GameTime
+   (s/optional-key :duration) GameTime})

-(s/defschema Starting {(s/optional-key :skills) #{Skill-Id}
-                       (s/optional-key :skill-sets) #{Skill-Set-Id}
-                       (s/optional-key :items) #{Item-Id}})
+(s/defschema Starting
+  (s/constrained
+    {(s/optional-key :skills) #{Skill-Id}
+     (s/optional-key :skill-sets) #{Skill-Set-Id}
+     (s/optional-key :items) #{Item-Id}}
+    not-empty))

 (s/defschema Kin
   {:id Kin-Id
@@ -70,26 +80,28 @@
    :name s/Str
    :description s/Str
    :type [s/Str]
-   (s/optional-key :min-lvl) s/Int
-   (s/optional-key :prerequisites) #{Prerequisite}
+   (s/optional-key :lvl) s/Int
+   (s/optional-key :prerequisites) Prerequisite
    (s/optional-key :bonuses) #{Bonus}})

 (s/defschema Skill-Set
   {:id Skill-Set-Id
    :name s/Str
    :description s/Str
-   (s/optional-key :min-lvl) s/Int
-   (s/optional-key :prerequisites) #{Prerequisite}})
+   (s/optional-key :lvl) s/Int
+   (s/optional-key :prerequisites) Prerequisite})

 (s/defschema Item
   {:id Item-Id
    :name s/Str
    :description s/Str
    :type s/Str
-   (s/optional-key :min-lvl) s/Int
-   (s/optional-key :prerequisites) #{Prerequisite}
+   (s/optional-key :lvl) s/Int
+   (s/optional-key :bonded) (s/eq true)
+   (s/optional-key :prerequisites) Prerequisite
    (s/optional-key :bonuses) #{Bonus}
    (s/optional-key :heft) (s/enum :heavy :light)
+   (s/optional-key :time-to-equip) GameTime
    :cost {:value s/Int :unit s/Str}})

 (s/defschema Character


removing context specific checks

removing context specific checks

--- src/five_points/model.clj
+++ src/five_points/model.clj
@@ -31,8 +31,8 @@
 (s/defschema Check (s/enum
                      :Push :Pull :Jump :Catch :Throw :Run :Climb :Grab :Hold :Block :Melee-Attack
                      :Balance :Tumble :Dodge :Parry :Range-Attack :Hide
-                     :Resist-Attack :Resist-Poison :Resist-Disease :Heal-Self
-                     :Find :Recall :Learn :Resist-Psychic :Detect-Poison :Detect-Disease :Triage :Cure
+                     :Resist :Heal-Self
+                     :Find :Recall :Learn :Triage :Cure
                      :Look :Smell :Taste :Touch :Hear :Detect-Psychic
                      :Inspire :Sway :Mock :Tame :Lie))


Do a normal (catch Exception) in the final straight-jacket catch so that slingshot exceptions can be caught.

--- src/circle/util/straight_jacket.clj
+++ src/circle/util/straight_jacket.clj
@@ -7,20 +7,20 @@

 (defmacro straight-jacket*
   [& body]
-  `(try+
+  `(try
      (try+
-       (try+
-         (do
-           ~@body)
-         (catch (or (instance? Exception ~'%) (instance? AssertionError ~'%)) e#
-           (println "1")
-           (airbrake/airbrake :exception e#
-                              :data {:cmd (str (quote ~body))})))
+      (try+
+       (do
+         ~@body)
        (catch (or (instance? Exception ~'%) (instance? AssertionError ~'%)) e#
-         (.printStackTrace e#)
-         (println "2")
-         (errorf e# "straight-jacket")))
-     (catch (or (instance? Exception ~'%) (instance? AssertionError ~'%)) e#
+         (println "1")
+         (airbrake/airbrake :exception e#
+                            :data {:cmd (str (quote ~body))})))
+      (catch (or (instance? Exception ~'%) (instance? AssertionError ~'%)) e#
+        (.printStackTrace e#)
+        (println "2")
+        (errorf e# "straight-jacket")))
+     (catch Exception e#
        (println "3")
        (println "*** Straight Jacket WTF ***"))))


Don't force exceptions. Fixes email spam when testing locally

--- src/circle/util/straight_jacket.clj
+++ src/circle/util/straight_jacket.clj
@@ -16,7 +16,6 @@
          (catch Exception e#
            (println "1")
            (airbrake/airbrake :exception e#
-                              :force true
                               :data {:cmd (str (quote ~body))})))
        (catch Exception e#
          (.printStackTrace e#)


Fix datetime-field?

Fix datetime-field?

--- src/metabase/pulse.clj
+++ src/metabase/pulse.clj
@@ -36,6 +36,15 @@
 (def ^:private bar-td-style  (str font-style "font-size: 16px; font-weight: 400; text-align: left; padding-right: 1em; padding-top: 8px;"))
 (def ^:private button-style  (str font-style "display: inline-block; box-sizing: border-box; padding: 8px; color: " color-brand "; border: 1px solid " color-brand "; border-radius: 4px; text-decoration: none; "))

+(defn datetime-field?
+  [field]
+  (or (contains? #{:DateTimeField :TimeField :DateField} (:base_type field))
+      (contains? #{:timestamp_seconds :timestamp_milliseconds} (:special_type field))))
+
+(defn number-field?
+  [field]
+  (or (contains? #{:IntegerField :DecimalField :FloatField :BigIntegerField} (:base_type field))
+      (contains? #{:number} (:special_type field))))

 (defn- format-number
   [n]
@@ -203,16 +212,6 @@
       [:div {:style "margin-top: 20px; margin-left: 30px;"}
         (render-table card [(last rows) (first rows)] cols render-img [0 1] nil)]]))

-(defn datetime-field?
-  [field]
-  (or (contains? #{:DateTimeField :TimeField :DateField} (:base_type field))
-      (contains? #{:timestamp_seconds :timestamp_milliseconds} (:special_type field))))
-
-(defn number-field?
-  [field]
-  (or (contains? #{:IntegerField :DecimalField :FloatField :BigIntegerField} (:base_type field))
-      (contains? #{:number} (:special_type field))))
-
 (defn detect-pulse-card-type
   [card data]
   (let [col-count (-> data :cols count)


fixes off-by-one date discrepancy in edit schedule form

--- src/cljs/early_vote_site/utils.cljs
+++ src/cljs/early_vote_site/utils.cljs
@@ -11,20 +11,20 @@
   "Translates from a long date string format (ie 2017-10-10T13:23:34.00Z)
    to a short format (2017-10-10)."
   [date-str]
-  (let [parsed (format/parse full-format date-str)]
-    (format/unparse short-format parsed)))
+  (let [parsed (format/parse-local full-format date-str)]
+    (format/unparse-local short-format parsed)))

 (defn format-date
   "Translates from a js date object
    to a short format (2017-10-10)."
   [date]
   (let [coerced (coerce/from-date date)]
-    (format/unparse short-format coerced)))
+    (format/unparse-local short-format coerced)))

 (defn parse-date
-  "Translates a full state string into a js/Date"
+  "Translates a full date string into a js/Date"
   [date-str]
-  (let [parsed (format/parse full-format date-str)]
+  (let [parsed (format/parse-local full-format date-str)]
     (coerce/to-date parsed)))

 (defn military-to-standard
@@ -49,12 +49,12 @@
   [schedule]
   (str
     (->> (:start-date schedule)
-      (format/parse full-format)
-      (format/unparse (format/formatter "MM-dd")))
+      (format/parse-local full-format)
+      (format/unparse-local (format/formatter "MM-dd")))
     " - "
     (->> (:end-date schedule)
-      (format/parse full-format)
-      (format/unparse (format/formatter "MM-dd")))
+      (format/parse-local full-format)
+      (format/unparse-local (format/formatter "MM-dd")))
     ", "
     (military-to-standard (:start-time schedule))
     " - "


Start putting together AW posts ui

Start putting together AW posts ui

--- src/ecregister/posts_ui.clj
+++ src/ecregister/posts_ui.clj
@@ -19,10 +19,12 @@
            [(label :id :title :text title :font (font :name "Arial" :style :italic :size 15)) "cell 1 1,pushy,top"]]
    :constraints ["", "[][]", "[][]"]
    :border (line-border :color "#ccc" :thickness 1)
-   :minimum-size [400 :by 0]))
+   :minimum-size [400 :by 60]))

 (defn setup-events [form event-stream]
-  (let [fa-stream (r/filter #(= :fa-post (:id %)) event-stream)]
+  (let [fa-stream (r/filter #(= :fa-post (:id %)) event-stream)
+        fa-post-stream (r/filter #(map? (:value %)) fa-stream)]
+    ;; setup 'latest post' label and progressbar
     (r/map (fn [e]
              ;; TODO use cond
              (if (= :wait (:value e))
@@ -34,7 +36,19 @@
                  (config! (select form [:#faprog]) :visible? false)
                  (config! (select form [:#latest-fa-post]) :visible? true)
                  )))
-           fa-stream)))
+           fa-stream)
+    ;; setup 'fetching from aw'
+    (r/map (fn [e]
+             (add! (select form [:#aw-posts]) (make-post-widget {:author "he1" :title "ho"}))
+             (add! (select form [:#aw-posts]) (make-post-widget {:author "he" :title "ho"}))
+             (add! (select form [:#aw-posts]) (make-post-widget {:author "he" :title "ho"}))
+             (add! (select form [:#aw-posts]) (make-post-widget {:author "he" :title "ho"}))
+             (add! (select form [:#aw-posts]) (make-post-widget {:author "he" :title "ho"}))
+             (add! (select form [:#aw-posts]) (make-post-widget {:author "he" :title "ho"}))
+             (add! (select form [:#aw-posts]) (make-post-widget {:author "he" :title "ho"}))
+             (add! (select form [:#aw-posts]) (make-post-widget {:author "he" :title "ho"})))
+           fa-post-stream)
+    ))

 (defn launch-tab [event-stream]
   (let [c (async/chan)]
@@ -49,8 +63,9 @@
          :items [[(label "Последний опубликованный пост") "top,center,wrap"]
                  [(progress-bar :id :faprog :indeterminate? false :value 10) "center,wrap"]
                  [(make-post-widget {:id :latest-fa-post :author "" :title "" :visible? false}) "center,wrap"]
+                 [(scrollable (grid-panel :border 8 :id :aw-posts :vgap 10 :columns 1)) "grow,pushy"]
                  ]
-         :constraints ["fillx,gap 18px,hidemode 3"])
+         :constraints ["fill,gap 18px,hidemode 3"])
         evs (r/events)]
     (setup-events form evs)
     (launch-tab evs)


Remove plumbing

Remove plumbing

--- src/fugue_app/plumbing.cljs
+++ src/fugue_app/plumbing.cljs
@@ -1,22 +0,0 @@
-(ns fugue-app.plumbing
-  (:require [replumb.core :as replumb]))
-
-(comment
-
-(defn handle-result!
-  [console result]
-  (let [write-fn (if (replumb/success? result)
-                   console/write-return!
-                   console/write-error!)]
-    (write-fn console (replumb/unwrap-result result))))
-
-(defn read-eval-print!
-  [console user-input]
-  (replumb/read-eval-call (partial handle-result! console) user-input))
-
-(defn init-repl
-  [elt]
-  (let [console (console/new-console elt)]
-    (read-eval-print! console)))
-
-)


Avoid sending classes through endpoints

Avoid sending classes through endpoints

--- src/photon/handler.clj
+++ src/photon/handler.clj
@@ -104,10 +104,6 @@
       (GET "/ws-stats" []
            (wrap-websocket-handler ws-stats-handler)))))

-(add-encoder java.lang.Class
-             (fn [c json-generator]
-               (.writeString json-generator (.getSimpleName c))))
-
 (defn authenticated-mw [handler]
   (fn [request]
     (if (authenticated? request)
@@ -180,7 +176,6 @@
     false))

 (defn auth-credentials-response [req]
-  (println req)
   (let [user          (:identity req)
         refresh-token (str (java.util.UUID/randomUUID))]
     (dosync


break values off of namespaces collection

--- clojure/src/dataloader/core.clj
+++ clojure/src/dataloader/core.clj
@@ -126,12 +126,21 @@
   (mg/connect! { :host host })
   (mg/set-db! (mg/get-db db))
   (outln "okay")
-  (out "Dropping namespaces... ")
+  (out "Dropping collections... ")
   (coll/drop "namespaces")
+  (coll/drop "nsvalues")
   (outln "okay")
   (doseq [x (namespace-urls residx)]
     (out (str x "... "))
     (download-ns x "temp.belns")
-    (coll/insert "namespaces" (parse-namespace "temp.belns"))
+    (def nsmap (parse-namespace "temp.belns"))
+    (def nsmeta-id (ObjectId.))
+    (def nsmeta-doc (assoc (dissoc nsmap :values) :_id nsmeta-id))
+    (coll/insert "namespaces" nsmeta-doc)
+    (doseq [value (nsmap :values)]
+      (def nsval-id (ObjectId.))
+      (def nsval-meta {:_id nsval-id :nsmeta-id nsmeta-id})
+      (def nsval-data {:enc (value 1) :val (value 0)})
+      (coll/insert "nsvalues" (conj nsval-meta nsval-data)))
     (outln "okay"))
   (mg/disconnect!))


(PDB-5484) rm unused puppetlabs.puppetdb.testutils.event-counts

--- test/puppetlabs/puppetdb/testutils/event_counts.clj
+++ test/puppetlabs/puppetdb/testutils/event_counts.clj
@@ -1,11 +0,0 @@
-(ns puppetlabs.puppetdb.testutils.event-counts
-  (:require
-   [cheshire.core :as json]))
-
-(defn- json-encode-counts-filter
-  "Given the `params` to an event-counts query, convert the counts-filter
-  parameter to a JSON string if it is present, otherwise do nothing."
-  [params]
-  (if-let [counts-filter (params "counts_filter")]
-    (assoc params "counts_filter" (json/generate-string counts-filter))
-    params))


Updating version to 1.62.7-SNAPSHOT

Updating version to 1.62.7-SNAPSHOT

--- scheduler/project.clj
+++ scheduler/project.clj
@@ -13,7 +13,7 @@
 ;; See the License for the specific language governing permissions and
 ;; limitations under the License.
 ;;
-(defproject cook "1.62.6"
+(defproject cook "1.62.7-SNAPSHOT"
   :description "This launches jobs on a Mesos cluster with fair sharing and preemption"
   :license {:name "Apache License, Version 2.0"}
   :dependencies [[org.clojure/clojure "1.10.3"]


Make dag operations more efficient

Make dag operations more efficient

--- src/edu/berkeley/ai/util/graphs.clj
+++ src/edu/berkeley/ai/util/graphs.clj
@@ -1,4 +1,5 @@
 (ns edu.berkeley.ai.util.graphs
+  (:import [java.util HashSet HashMap LinkedList])
   (:use edu.berkeley.ai.util edu.berkeley.ai.util.queues edu.berkeley.ai.util.disjoint-sets)
   )

@@ -14,14 +15,25 @@

 (defn dag-descendant? [dag s t]
   (or (= s t)
-    (loop [open #{s} closed #{}]
-      (when-first [f open]
-	(let [r (disj open f)]
-	  (if (contains? closed f)
-	      (recur r closed)
-	    (let [desc (get dag f #{})]
-	      (or (contains? desc t)
-		  (recur (into r desc) (conj closed f))))))))))
+      (let [open (LinkedList.) closed (HashSet.)]
+	(loop []
+	  (when-not (.isEmpty open)
+	    (let [f (.remove open)]
+	      (if (.contains closed f)
+		  (recur)
+		(let [desc (dag-children dag f)]
+		  (or (contains? desc t)
+		      (do (.addAll open desc)
+			  (.add closed f)
+			  (recur)))))))))))
+;    (loop [open #{s} closed #{}]
+;      (when-first [f open]
+;	(let [r (disj open f)]
+;	  (if (contains? closed f)
+;	      (recur r closed)
+;	    (let [desc (get dag f #{})]
+;	      (or (contains? desc t)
+;		  (recur (into r desc) (conj closed f))))))))))

 (defn dag-add-edge [dag s t]
   (assert (not (dag-descendant? dag t s)))


Make campfire available to riemann

Make campfire available to riemann

--- src/riemann/config.clj
+++ src/riemann/config.clj
@@ -23,6 +23,7 @@
         riemann.sns
         [riemann.time :only [unix-time linear-time once! every!]]
         [riemann.pagerduty :only [pagerduty]]
+        [riemann.campfire :only [campfire]]
         [riemann.librato :only [librato-metrics]]
         riemann.streams)
   (:gen-class))