Fix For https://github.com/devth/yetibot/issues/614

--- src/yetibot/core/commands/about.clj
+++ src/yetibot/core/commands/about.clj
@@ -5,7 +5,8 @@
   "about # about Yetibot"
   {:yb/cat #{:info}}
   [& _]
-  ["Yetibot is a chat bot written in Clojure;"
+  ["https://github.com/devth/yetibot/raw/master/img/yetibot_final.png?raw=true"
+   "Yetibot is a chat bot written in Clojure;"
    "it wants to make your life easier;"
    "it wants you to have fun."
    "http://yetibot.com"])


0 | FM & JC | refactored mongo to take key from constructor

--- src/stonecutter/db/mongo.clj
+++ src/stonecutter/db/mongo.clj
@@ -20,7 +20,7 @@
   (query [e query]
     "Items are returned using a query map"))

-(defrecord MongoStore [mongo-db coll]
+(defrecord MongoStore [mongo-db coll k]
   cl-s/Store
   (fetch [this t]
     (when t
@@ -29,7 +29,7 @@
   (revoke! [this t]
     (when t
       (mc/remove-by-id mongo-db coll t)))
-  (store! [this k item]
+  (store! [this _ item]
     (-> (mc/insert-and-return mongo-db coll (assoc item :_id (k item)))
         (dissoc :_id)))
   (entries [this]
@@ -76,8 +76,8 @@
   ([data]
    (MemoryStore. (atom data))))

-(defn new-mongo-store [mongo-db coll]
-  (MongoStore. mongo-db coll))
+(defn new-mongo-store [mongo-db coll k]
+  (MongoStore. mongo-db coll k))

 (defn get-mongo-db [mongo-uri]
   (log/debug "Connecting to mongo")
@@ -85,29 +85,26 @@
     (log/debug "Connected to mongo.")
     db))

-(defn- create-mongo-store [db collection]
-  (new-mongo-store db collection))
-
 (defn create-user-store [db]
-  (create-mongo-store db user-collection))
+  (new-mongo-store db user-collection :login))

 (defn create-token-store [db]
-  (create-mongo-store db token-collection))
+  (new-mongo-store db token-collection :token))

 (defn create-auth-code-store [db]
-  (create-mongo-store db auth-code-collection))
+  (new-mongo-store db auth-code-collection :code))

 (defn create-client-store [db]
-  (create-mongo-store db client-collection))
+  (new-mongo-store db client-collection :client-id))

 (defn create-confirmation-store [db]
-  (create-mongo-store db confirmation-collection))
+  (new-mongo-store db confirmation-collection :confirmation-id))

 (defn create-forgotten-password-store [db]
-  (create-mongo-store db forgotten-password-collection))
+  (new-mongo-store db forgotten-password-collection :forgotten-password-id))

 (defn create-session-store [db]
   (mongo-session/session-store db session-collection))

 (defn create-invitation-store [db]
-  (create-mongo-store db invitation-collection))
+  (new-mongo-store db invitation-collection :invite-id))


ns docstring for 'move'

ns docstring for 'move'

Use older metadata syntax for backward-compatibility with older
versions of the 'ns' macro.

--- src/main/clojure/clojure/tools/namespace/move.clj
+++ src/main/clojure/clojure/tools/namespace/move.clj
@@ -6,14 +6,15 @@
 ;; agreeing to be bound by the terms of this license. You must not
 ;; remove this notice, or any other, from this software.

-(ns clojure.tools.namespace.move
-  "Refactoring tool to move a Clojure namespace from one name/file to
+(ns ^{:author "Stuart Sierra"
+      :doc "Refactoring tool to move a Clojure namespace from one name/file to
   another, and update all references to that namespace in your other
   Clojure source files.

   WARNING: This code is ALPHA and subject to change. It also modifies
   and deletes your source files! Make sure you have a backup or
-  version control."
+  version control."}
+  clojure.tools.namespace.move
   (:require [clojure.string :as str]
             [clojure.java.io :as io])
   (:import (java.io File)))


Test to make sure server stays running after it gets this

--- src/main/cawala/api/read.clj
+++ src/main/cawala/api/read.clj
@@ -6,7 +6,7 @@
                      :person/relation :friend}
                  2  {:db/id 2 :person/name "Sally" :person/age 22
                      :person/relation :friend}
-                 3  {:db/id 3 :person/name "Allie" :person/age 58
+                 3  {:db/id 3 :person/name "Allie" :person/age 57
                      :person/relation :enemy}
                  4  {:db/id 4 :person/name "Zoe" :person/age 32
                      :person/relation :friend}


M-x whitespace-cleanup

M-x whitespace-cleanup

--- src/uswitch/lambada/core.clj
+++ src/uswitch/lambada/core.clj
@@ -18,11 +18,3 @@
        (defn ~handleRequestMethod
          ~(into ['this] args)
          ~@body))))
-
-
-
-
-
-
-
-


Fix some function calls due to some functions renames on previous commits.

--- src/buddy/sign/jwe.clj
+++ src/buddy/sign/jwe.clj
@@ -373,18 +373,17 @@
 (defn encrypt
   "Encrypt then sign arbitrary length string/byte array using
   json web encryption."
-  [claims key & [{:keys [alg enc exp nbf iat zip]
-                  :or {alg :dir zip ::none
-                       enc :a128cbc-hs256}
-                  :as options}]]
+  [claims key & [{:keys [alg enc exp nbf iat zip typ]
+                  :or {alg :dir enc :a128cbc-hs256 zip false typ :jws}
+                  :as opts}]]
   {:pre [(map? claims)]}
   (let [scek (cek/generate {:key key :alg alg :enc enc})
         ecek (cek/encrypt {:key key :cek scek :alg alg :enc enc})
         iv (generate-iv {:enc enc})
-        header (generate-header {:alg alg :enc enc :zip zip})
-        plaintext (generate-plaintext claims zip exp nbf iat)
+        header (encode-header {:alg alg :enc enc :zip zip :typ typ})
+        claims (encode-claims claims zip opts)
         [ciphertext authtag] (aead-encrypt {:algorithm enc
-                                            :plaintext plaintext
+                                            :plaintext claims
                                             :secret scek
                                             :aad header
                                             :iv iv})]
@@ -396,40 +395,23 @@

 (defn decrypt
   "Decrypt the jwe compliant message and return its claims."
-  [input key & [{:keys [max-age]}]]
-  (let [[header ecek iv ciphertext authtag] (str/split input #"\." 5)
-        {:keys [alg enc zip] :or {zip ::none}} (parse-header header)
-        ecek (codecs/safebase64->bytes ecek)
-        scek (cek/decrypt {:key key :ecek ecek :alg alg :enc enc})
-        iv (codecs/safebase64->bytes iv)
-        header (codecs/safebase64->bytes header)
-        ciphertext (codecs/safebase64->bytes ciphertext)
-        authtag (codecs/safebase64->bytes authtag)
-        plaintext (aead-decrypt {:ciphertext ciphertext
-                                 :authtag authtag
-                                 :algorithm enc
-                                 :aad header
-                                 :secret scek
-                                 :iv iv})]
-    (let [now (util/timestamp)
-          claims (parse-plaintext plaintext zip)]
-      (cond
-        (and (:exp claims) (> now (:exp claims)))
-        (throw+ {:type :validation
-                 :cause :exp
-                 :message (format "Token is older than :exp (%s)" (:exp claims))})
-
-        (and (:nbf claims) (> now (:nbf claims)))
-        (throw+ {:type :validation
-                 :cause :nbf
-                 :message (format "Token is older than :nbf (%s)" (:nbf claims))})
-
-        (and (:iat claims) (number? max-age) (> (- now (:iat claims)) max-age))
-        (throw+ {:type :validation
-                 :cause :max-age
-                 :message (format "Token is older than max-age (%s)" max-age)})
-
-        :else claims))))
+  ([input key] (decrypt input key {}))
+  ([input key {:keys [zip] :as opts} ]
+   (let [[header ecek iv ciphertext authtag] (str/split input #"\." 5)
+         {:keys [alg enc]} (parse-header header opts)
+         ecek (codecs/safebase64->bytes ecek)
+         scek (cek/decrypt {:key key :ecek ecek :alg alg :enc enc})
+         iv (codecs/safebase64->bytes iv)
+         header (codecs/safebase64->bytes header)
+         ciphertext (codecs/safebase64->bytes ciphertext)
+         authtag (codecs/safebase64->bytes authtag)
+         claims (aead-decrypt {:ciphertext ciphertext
+                               :authtag authtag
+                               :algorithm enc
+                               :aad header
+                               :secret scek
+                               :iv iv})]
+     (parse-claims claims zip opts))))

 (defn encode
   "Encrypt then sign arbitrary length string/byte array using


Added JWS EdDSA signer and fixed header encoding

--- src/buddy/sign/jws.clj
+++ src/buddy/sign/jws.clj
@@ -52,14 +52,16 @@
    :es384 {:signer   #(dsa/sign %1 {:alg :ecdsa+sha384 :key %2})
            :verifier #(dsa/verify %1 %2 {:alg :ecdsa+sha384 :key %3})}
    :es512 {:signer   #(dsa/sign %1 {:alg :ecdsa+sha512 :key %2})
-           :verifier #(dsa/verify %1 %2 {:alg :ecdsa+sha512 :key %3})}})
+           :verifier #(dsa/verify %1 %2 {:alg :ecdsa+sha512 :key %3})}
+   :eddsa {:signer   #(dsa/sign %1 {:alg :eddsa :key %2})
+           :verifier #(dsa/verify %1 %2 {:alg :eddsa :key %3})}})

 ;; --- Implementation

 (defn- encode-header
   [header]
   (-> header
-      (update :alg #(str/upper-case (name %)))
+      (update :alg #(if (= % :eddsa) "EdDSA" (str/upper-case (name %))))
       (json/generate-string)
       (b64/encode true)
       (codecs/bytes->str)))


wishlist-from-html cljs

wishlist-from-html cljs

--- src/wishlistd/cljs/main.cljs
+++ src/wishlistd/cljs/main.cljs
@@ -38,4 +38,9 @@
   (append $content (wish-ul wishes))
   (append $header  (wishlist-title title)))

+(defn wishlist-from-html []
+  {:title (title-from-html)
+   :wishes (wishes-from-html)
+   :code (get-path)})

+


Fix wrong position handling on read-bytes implementation for nio ByteBuffer.

--- src/bytebuf/buffer.clj
+++ src/bytebuf/buffer.clj
@@ -31,6 +31,7 @@
   (read-bytes [buff pos size]
     (let [tmpbuf (byte-array size)
           oldpos (.position buff)]
+      (.position buff pos)
       (.get buff tmpbuf)
       (.position buff oldpos)
       tmpbuf))


fix indent

fix indent

--- stuf/src/sandbox/4clojure.clj
+++ stuf/src/sandbox/4clojure.clj
@@ -204,7 +204,7 @@

 ;;54 Partition a Sequence
 #(loop [xs %2  res []]
-   (if (>= (count xs) % )
+   (if (>= (count xs) %)
      (recur (drop % xs) (conj res (take % xs)))
      res))

@@ -575,8 +575,8 @@
    (cond
      (and (not (sequential? l)) (not (sequential? r))) (= l r)
      (and (sequential? l) (sequential? r)) (and (= (first l) (first r))
-                                  (f (second l) (last r))
-                                  (f (last l) (second r)))
+                                            (f (second l) (last r))
+                                            (f (last l) (second r)))
      :else false)))
 ;; wow solution
 ;;#(let [t (fn t [[v l r]] [v (if r (t r)) (if l (t l))])
@@ -685,7 +685,7 @@
                            9 [i x]}]
                  (apply str (d->r d))))
         digits (fn [n] (map #(- (int %) (int \0)) (str n)))]
-    (->> (map a->r (reverse (digits a)) (partition-all 3 2 r ))
+    (->> (map a->r (reverse (digits a)) (partition-all 3 2 r))
          (reverse)
          (apply str))))
 ;; wow solution
@@ -849,7 +849,7 @@
   (let [m* (fn [n m] (map #(* % n) m))
         l+ (fn [p l] (map #(map + p %) l))
         seed [[0 1] [1 0] [1 1] [-1 1]]
-        mult [-2 -1 1 2 ]
+        mult [-2 -1 1 2]
         delta (map (fn [l] (map #(m* % l) mult)) seed)
         lines (fn [p] (map #(l+ p %) delta))
         check-ln (fn [ln] (filter identity (map #(get-in xo %) ln)))
@@ -1113,18 +1113,18 @@
        (let [repeatv (comp vec repeat)]
          (repeatv size (repeatv size " "))))]

-     (fn f [base limit]
-       (let [squars (apply str (sq base limit))
-             len (int (Math/ceil (Math/sqrt (count squars))))
-             padded-squars (pad squars (* len len) \*)
-             start (int (Math/ceil (/ len 2)))
-             board (create-board (+ len (dec len)))
-             coords (map #(vector % %2) padded-squars (path [start start] len))]
-         (->>
-          (reduce (fn [m [sym coord]] (assoc-in m coord sym))
-                  board
-                  coords)
-          (map #(apply str %))))))
+    (fn f [base limit]
+      (let [squars (apply str (sq base limit))
+            len (int (Math/ceil (Math/sqrt (count squars))))
+            padded-squars (pad squars (* len len) \*)
+            start (int (Math/ceil (/ len 2)))
+            board (create-board (+ len (dec len)))
+            coords (map #(vector % %2) padded-squars (path [start start] len))]
+        (->>
+         (reduce (fn [m [sym coord]] (assoc-in m coord sym))
+                 board
+                 coords)
+         (map #(apply str %))))))

 ;;140 Veitch, Please!
 (letfn
@@ -1185,7 +1185,7 @@

      (match? [gray samples]
        (if (some identity (map #(every? (set gray) %) samples))
-            1 0))
+           1 0))

      (gray-map [samples]
        (let [sample (sort (clojure.string/lower-case (apply str (first samples))))
@@ -1235,4 +1235,3 @@
     (if (= (update sets) sets)
       sets
       (min-set (update sets)))))
-


Update swagger_ui.cljc

Update swagger_ui.cljc

Fix spelling in docstring.

--- modules/reitit-swagger-ui/src/reitit/swagger_ui.cljc
+++ modules/reitit-swagger-ui/src/reitit/swagger_ui.cljc
@@ -12,7 +12,7 @@
      | :root            | optional resource root, defaults to `\"swagger-ui\"`
      | :url             | path to swagger endpoint, defaults to `/swagger.json`
      | :path            | optional path to mount the handler to. Works only if mounted outside of a router.
-     | :config          | parameters passed to swaggger-ui as-is.
+     | :config          | parameters passed to swagger-ui as-is.

      See https://github.com/swagger-api/swagger-ui/blob/master/docs/usage/configuration.md
      for all available :config options.


Use out counter for direct nil foo.

Use out counter for direct nil foo.

--- src/dsbdp/main.clj
+++ src/dsbdp/main.clj
@@ -115,7 +115,7 @@
                                                (in-fn in-data)
                                                (.inc in-cntr))
                                              (sleep 1))
-                      :default (fn [] (.inc in-cntr))))
+                      :default (fn [] (.inc out-cntr))))
           thread-info-fn (create-thread-info-fn)
           stats-fn (fn []
                      (let [in (double (/ (.value in-cntr) 1000.0))


tests: also action source the model in controller tests

--- examples/friend-list/test/unit/controller.cljs
+++ examples/friend-list/test/unit/controller.cljs
@@ -23,7 +23,7 @@
   on-search-success-updates-friends
   (f/with-fakes
     (let [control (friend-list/new-control :_history :_search)
-          model (reaction (assoc friend-list.core/initial-model :query :_current-query))
+          model (reaction (friend-list/reconcile friend-list/initial-model [:set-query :_current-query]))
           dispatch-signal (f/recorded-fake)
           dispatch-action (f/recorded-fake)]
       ; act
@@ -37,7 +37,7 @@
   on-search-success-ignores-outdated-results
   (f/with-fakes
     (let [control (friend-list/new-control :_history :_search)
-          model (reaction (assoc friend-list.core/initial-model :query :_current-query))
+          model (reaction (friend-list/reconcile friend-list/initial-model [:set-query :_current-query]))
           dispatch-signal (f/recorded-fake)
           dispatch-action (f/recorded-fake)]
       ; act


Adding version, fixing build-tarball

Adding version, fixing build-tarball

--- src/fatty/core.clj
+++ src/fatty/core.clj
@@ -77,10 +77,10 @@

 (defn project
   "Create a new project"
-  [project-name build-order]
-  (dosync (ref-set project-map (assoc @project-map project-name build-order))))
+  [project-name version build-order]
+  (dosync (ref-set project-map (assoc @project-map project-name { :version version :build-order build-order }))))

-(project "chef-full" [ "zlib" "libiconv" "db" "gdbm" "ncurses" "openssl" "libxml2" "libxslt" "ruby" "chef" ])
+(project "chef-full" "0.9.8" [ "zlib" "libiconv" "db" "gdbm" "ncurses" "openssl" "libxml2" "libxslt" "ruby" "chef" ])

 (defn- log-sh-result
   [status true-log false-log]
@@ -153,14 +153,14 @@
     {:os (get ohai-data :os), :machine (get-in ohai-data [:kernel :machine])}))

 (defn build-tarball
-  [project-name os-data]
-  (let [status (sh "tar" "czf" (file-str fatty-pkg-dir "/" project-name "-" (os-data :os) "-" (os-data :machine) ".tar.gz") (file-str "/opt/opscode"))]
+  [project-name version os-data]
+  (let [status (sh "tar" "czf" (.toString (file-str fatty-pkg-dir "/" project-name "-" version "-" (os-data :os) "-" (os-data :machine) ".tar.gz")) (.toString (file-str "/opt" "/opscode")) :return-map true)]
     (log-sh-result status
-                   (str "Created package for " project-name " on " (os-data :os) " machine arch " (os-data :machine))
-                   (str "Failed to create package for " project-name " on " (os-data :os) " machine arch " (os-data :machine)))))
+                   (str "Created tarball package for " project-name " on " (os-data :os) " " (os-data :machine))
+                   (str "Failed to create tarball package for " project-name " on " (os-data :os) " " (os-data :machine)))))

 (defn build-fat-binary
   "Build a fat binary"
   [project-name]
-  (dorun (for [software-pkg (project-map project-name)] (build (software-map software-pkg))))
-  (let [os-data (get-os-and-machine)] (build-tarball)))
+  (dorun (for [software-pkg (get-in project-map [project-name :build-order])] (build (software-map software-pkg))))
+  (build-tarball project-name (get-in project-map [project-name :version]) (get-os-and-machine)))


Checkpoint

Checkpoint

Signed-off-by: Gregory Haskins <640d9fe47775e6723f0355b7315e38f7d98d3539@gmail.com>

--- src/obcc/build/interface.clj
+++ src/obcc/build/interface.clj
@@ -36,7 +36,6 @@
 ;; takes an interface name, maps it to a file, and if present, compiles
 ;; it to an AST.
 (defn compileintf [path intf]
-  (println "Compile " intf)
   (let [ipath (str path "/src/interfaces")]
     (->> (open ipath intf) slurp parse)))

@@ -110,30 +109,22 @@
   (let [msgs (->> ast (map (fn [[fqname ast]] (buildmessages fqname ast))) flatten)]
     (into {} (map #(vector (.name %) %) msgs))))

-;;(defn generateproto [intf ast template]
-;;  (loop [loc ast]
-;;    (cond
-;;
-;;      (zip/end? loc)
-;;      nil
-;;
-;;      :else
-;;      (do
-;;        ;; do something with each node here
-;;        (recur (zip/next loc))))))
+(defn generateproto [path config]
+  (let [asts (compileall path config)
+        messages (buildallmessages asts)
+        stg  (STGroupFile. "generators/proto.stg")
+        template (.getInstanceOf stg "protobuf")]
+
+    (.add template "messages" messages)
+    (.render template)))

 (defn compile [path config]
-
-  (let [asts (compileall path config)
-        messages (buildallmessages asts)
+  (let [protobuf (generateproto path config)
         protopath (io/file path "build/proto/project.proto")]

     ;; ensure the path exists
     (io/make-parents protopath)

-    ;; and then generate our output
-    (let [stg  (STGroupFile. "generators/proto.stg")
-          template (.getInstanceOf stg "protobuf")]
-      (.add template "messages" messages)
-      (with-open [output (io/writer protopath :truncate true)]
-        (.write output (.render template))))))
+    ;; and then emit our output
+    (with-open [output (io/writer protopath :truncate true)]
+      (.write output protobuf))))


fix minified_url for asset

fix minified_url for asset

--- src/pc/assets.clj
+++ src/pc/assets.clj
@@ -60,12 +60,15 @@
 (defn cdn-url [manifest-value]
   (str cdn-base-url "/" (:s3-key manifest-value)))

+(defn manifest-asset-path [manifest path]
+  (let [manifest-value (get-in manifest [:assets path])]
+    (assert manifest-value)
+    (cdn-url manifest-value)))
+
 (defn asset-path [path & {:keys [manifest]
                           :or {manifest @asset-manifest}}]
   (if (pc.profile/prod-assets?)
-    (let [manifest-value (get-in manifest [:assets path])]
-      (assert manifest-value)
-      (cdn-url manifest-value))
+    (manifest-asset-path manifest path)
     path))

 ;; TODO: make the caller set credentials
@@ -134,7 +137,7 @@
     (http/post "https://api.rollbar.com/api/1/sourcemap"
                {:multipart (concat [{:name "access_token" :content (rollbar/token)}
                                     {:name "version" :content sha1}
-                                    {:name "minified_url" :content (asset-path "/cljs/production/frontend.js" :manifest manifest)}
+                                    {:name "minified_url" :content (manifest-path "/cljs/production/frontend.js" manifest)}
                                     {:name "source_map" :content (clojure.java.io/file source-map)}]
                                    (for [source sources]
                                      (do (println source)


remove find-name and replace calls with calls to reverse-get

--- src/overtone/music/pitch.clj
+++ src/overtone/music/pitch.clj
@@ -5,6 +5,7 @@
       :author "Jeff Rose, Sam Aaron & Marius Kempe"}
   overtone.music.pitch
   (:use [overtone.helpers old-contrib]
+        [overtone.helpers.map :only [reverse-get]]
         [overtone.algo chance])
   (:require [clojure.string :as string]))

@@ -573,15 +574,6 @@
      (case tuning
            :equal-tempered (nth-equal-tempered-freq base-freq (nth-interval n mode)))))

-(defn find-name
-  "Return the name of the first matching thing found in things
-  or nil if not found"
-  ([thing things]
-     (if (= (val (first things)) thing)
-       (key (first things))
-       (if (< 1 (count things))
-         (find-name thing (rest things))))))
-
 (defn find-scale-name
   "Return the name of the first matching scale found in SCALE
   or nil if not found
@@ -589,7 +581,7 @@
   ie: (find-scale-name [2 1 2 2 2 2 1]
   :melodic-minor-asc"
   [scale]
-  (find-name scale SCALE))
+  (reverse-get SCALE scale))

 (defn find-pitch-class-name
   "Given a midi number representing a note, returns the name of the note
@@ -653,8 +645,8 @@
   (if (< 0 (count notes))
     (let [root (first (sort notes))
           adjusted-notes (set (map (fn [x] (- x root)) notes ))]
-      (or (find-name (simplify-chord adjusted-notes) CHORD)
-          (find-name (compress-chord adjusted-notes) CHORD)))))
+      (or (reverse-get CHORD (simplify-chord adjusted-notes))
+          (reverse-get CHORD (compress-chord adjusted-notes))))))

 (defn find-chord
   [notes]


Add puzzle test case

Add puzzle test case

--- test/dependable/core_test.clj
+++ test/dependable/core_test.clj
@@ -304,6 +304,63 @@
                             package-b
                             package-c
                             package-d3]))))
+         (testing (str "Inter-Locking Diamond problem")
+                  (let [package-a
+                        {:name "a"
+                         :version 1
+                         :location "a_loc1"
+                         :requires [{:name "b"}
+                                    {:name "c"}]}
+                        package-b
+                        {:name "b"
+                         :version 1
+                         :location "b_loc1"
+                         :requires [{:name "d"
+                                     :version-spec #(>= % 2)}
+                                    {:name "e"
+                                     :version-spec #(= % 5)}]}
+                        package-c
+                        {:name "c"
+                         :version 1
+                         :location "c_loc1"
+                         :requires [{:name "e"
+                                     :version-spec #(>= % 1)}
+                                    {:name "d"
+                                     :version-spec #(< % 4)}]}
+                        package-d3
+                        {:name "d"
+                         :version 3
+                         :location "d_loc3"}
+                        package-d4
+                        {:name "d"
+                         :version 4
+                         :location "d_loc4"}
+                        package-e6
+                        {:name "e"
+                         :version 6
+                         :location "e_loc6"}
+                        package-e5
+                        {:name "e"
+                         :version 6
+                         :location "e_loc5"}
+                        repo-info
+                        {"a" [package-a]
+                         "b" [package-b]
+                         "c" [package-c]
+                         "d" [package-d4 package-d3]
+                         "e" [package-e6 package-e5]}
+                        query
+                        (map-query repo-info)]
+                    (is (= (resolve-dependencies
+                             [{:name "a"}]
+                             query)
+                           [:successful
+                            package-a
+                            package-b
+                            package-c
+                            package-d3
+                            package-e5]))))
+(testing (str "The puzzle")
          (let [package-a
                {:name "a"
                 :version 1
@@ -315,48 +372,46 @@
                 :version 1
                 :location "b_loc1"
                 :requires [{:name "d"
-                            :version-spec #(>= % 2)}
-                           {:name "e"
-                            :version-spec #(= % 5)}]}
+                            :version-spec #(>= % 1)}]}
                package-c
                {:name "c"
                 :version 1
                 :location "c_loc1"
+                :requires [{:name "d"
+                            :version-spec #(< % 4)}]}
+               package-d1
+               {:name "d"
+                :version 1
+                :location "d_loc1"
                 :requires [{:name "e"
-                            :version-spec #(>= % 1)}
-                           {:name "d"
-                            :version-spec #(< % 4)}]}
-               package-d3
+                            :version-spec #(= % 4)}]}
+               package-d2
                {:name "d"
+                :version 2
+                :location "d_loc2"
+                :requires [{:name "e"
+                            :version-spec #(= % 3)}]}
+               package-e4
+               {:name "e"
+                :version 4
+                :location "e_loc4"}
+               package-e3
+               {:name "e"
                 :version 3
-                :location "d_loc3"}
-               package-d4
-               {:name "d"
-                :version 4
-                :location "d_loc4"}
-               package-e6
-               {:name "e"
-                :version 6
-                :location "e_loc6"}
-               package-e5
-               {:name "e"
-                :version 6
-                :location "e_loc5"}
+                :location "e_loc3"}
                repo-info
                {"a" [package-a]
                 "b" [package-b]
                 "c" [package-c]
-                "d" [package-d4 package-d3]
-                "e" [package-e6 package-e5]}
+                "d" [package-d2 package-d1]
+                "e" [package-e4 package-e3]}
                query
                (map-query repo-info)]
-           (testing (str "Inter-Locking Diamond problem")
-                    (is (= (resolve-dependencies
-                             [{:name "a"}]
-                             query)
-                           [:successful
-                            package-a
-                            package-b
-                            package-c
-                            package-d3
-                            package-e5])))))
+           (is (= (resolve-dependencies
+                    [{:name "a"}]
+                    query)
+                  [:successful #{package-a
+                                 package-b
+                                 package-c
+                                 package-d1
+                                 package-d2}])))))


Remove deprecated functions

Remove deprecated functions

--- src/play_clj/core_basics.clj
+++ src/play_clj/core_basics.clj
@@ -89,8 +89,6 @@
     :fps (graphics! :get-frames-per-second)
     :fullscreen? (graphics! :is-fullscreen)
     :touched? (input! :is-touched)
-    :is-fullscreen? (graphics! :is-fullscreen) ; deprecated
-    :is-touched? (input! :is-touched) ; deprecated
     :x (input! :get-x)
     :y (input! :get-y)
     (u/throw-key-not-found k)))
@@ -110,11 +108,6 @@
     (key-pressed? :page-down)"
   [k]
   `(input! :is-key-pressed (key-code ~k)))
-
-(defmacro is-pressed?
-  "Deprecated. Please use `key-pressed?` instead."
-  [k]
-  `(key-pressed? ~k))

 (defmacro button-code
   "Returns a static field from [Input.Buttons](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/Input.Buttons.html).


Fix how asset manager loads sounds

Fix how asset manager loads sounds

--- src/play_clj/core_basics.clj
+++ src/play_clj/core_basics.clj
@@ -149,11 +149,10 @@

 (defn sound*
   [path]
-  (let [^FileHandle fh (if (string? path)
-                         (files! :internal path)
-                         path)]
-    (or (u/load-asset (.path fh) Sound)
-        (audio! :new-sound fh))))
+  (or (u/load-asset path Sound)
+      (audio! :new-sound (if (string? path)
+                           (files! :internal path)
+                           path))))

 (defmacro sound
   "Returns a [Sound](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/audio/Sound.html).


M0ar tests

M0ar tests

--- test/grimoire/either_test.clj
+++ test/grimoire/either_test.clj
@@ -8,4 +8,7 @@
     (is (either/succeed? (either/succeed r)))

     (is (= r (either/message (either/fail r))))
-    (is (either/fail? (either/fail r)))))
+    (is (either/fail? (either/fail r)))
+
+    (is (either/either? (either/succeed r)))
+    (is (either/either? (either/fail r)))))


Small microscope changes

Small microscope changes

--- src/polismath/microscope.clj
+++ src/polismath/microscope.clj
@@ -20,7 +20,7 @@
       (ko/where {:zid zid})
       (ko/order [:zid :tid :pid :created] :asc))))

-
+;; XXX Should really move to db
 (defn get-zid-from-zinvite
   [zinvite]
   (->
@@ -63,6 +63,8 @@
     (env/with-env-overrides env-overrides
       (->
         (db/load-conv zid)
+        ;; This should be ok here right?
+        (cm/restructure-mongo-conv)
         (update-in
           [:repness]
           (partial pc/map-keys kw->int))))))
@@ -82,7 +84,7 @@
 (def cli-options
   [["-z" "--zid ZID" "ZID on which to do a rerun" :parse-fn #(Integer/parseInt %)]
    ["-Z" "--zinvite ZINVITE" "ZINVITE code on which to perform a rerun"]
-   ["-r" "--recompute" "ZINVITE code on which to perform a rerun"]])
+   ["-r" "--recompute" "If set, will run a full recompute"]])

 (defn -main


Extend show-fns to lookup functions by their names.

--- src/quil/core.clj
+++ src/quil/core.clj
@@ -4248,15 +4248,39 @@
           cats))))

 (defn show-fns
-  "Print all the functions within category or subcategory specified by
-  cat-idx (use print-cats to see a list of index nums). If a category is
-  specified, it will not print out the fns in any of cat's
-  subcategories. "
-  [cat-idx]
-  (let [res (get (all-category-map) (str cat-idx))]
-    (println (:name res))
-    (dorun
-     (map #(println "  -" %) (:fns res)))))
+  "If given a number, print all the functions within category or
+  subcategory specified by the category index (use show-cats to see a
+  list of index nums).
+
+  If given a string or a regular expression, print all the functions
+  whose name or category name contains that string.
+
+  If a category is specified, it will not print out the fns in any of
+  cat's subcategories."
+  [q]
+  (letfn [(show-fns-by-cat-idx [cat-idx]
+            (let [res (get (all-category-map) (str cat-idx))]
+              (println (:name res))
+              (dorun
+               (map #(println "  -" %) (:fns res)))))
+          (show-fns-by-name-regex [re]
+            (doseq [[_ c] (all-category-map)]
+              (let [in-cat-name? (or (re-find re (.toLowerCase (:name c)))
+                                     (re-find re (:name c)))
+                    in-fn-names? (some #(re-find re (str %)) (:fns c))]
+                (cond
+                 in-cat-name? (do   ;; print an entire category
+                                (println (:name c))
+                                (doseq [f (:fns c)] (println "  -" f)))
+                 in-fn-names? (do   ;; print only matching fns
+                                (println (:name c))
+                                (doseq [f (:fns c)]
+                                  (if (re-find re (str f))
+                                    (println "  -" f))))))))]
+    (cond
+     (string? q) (show-fns-by-name-regex (re-pattern q))
+     (isa? (type q) java.util.regex.Pattern) (show-fns-by-name-regex q)
+     :else (show-fns-by-cat-idx q))))

 (defn show-meths
   "Takes a string representing the start of a method name in the


Add corner case found in generative tests

--- test/transit/corner_cases.clj
+++ test/transit/corner_cases.clj
@@ -39,6 +39,7 @@
    [\[]
    {\{ 1}
    {1 \{}
+   [\` \~ \^ \#]
    ])

 (def transit-json


Made :dir and :dirs synonyms of :files

Made :dir and :dirs synonyms of :files

--- src/midje/repl.clj
+++ src/midje/repl.clj
@@ -498,7 +498,7 @@

     ;; Note that stopping and pausing, which seeming different to user, actually do
     ;; exactly the same thing.
-    (let [option ((parsing/make-option-arglist-parser [:files :file] [:dirs :dir]
+    (let [option ((parsing/make-option-arglist-parser [:files :file :dirs :dir]
                                                       [:interval :each]
                                                       [:filters :filter]
                                                       [:stop :pause] [:resume] [:all])
@@ -522,15 +522,10 @@
                  (complained-about-missing-on-filesystem? (:files-args option)))
             :oops

-            (and (:dirs? option)
-                 (complained-about-missing-on-filesystem? (:dirs-args option)))
-            :oops
-
             :else
             (do
               (when (:all? option) (set-autotest-option! :files (autotest-default-dirs)))
               (when (:files? option) (set-autotest-option! :files (:files-args option)))
-              (when (:dirs? option) (set-autotest-option! :files (:dirs-args option)))
               (when (:filters? option) (set-autotest-option! :fact-filters (:filters-args option)))
               (when (:interval? option) (set-autotest-option! :interval (first (:interval-args option))))
               (autotest)))))


Use multimethod to dynamically use an available query server implementation

--- src/onyx/query.clj
+++ src/onyx/query.clj
@@ -143,14 +143,24 @@
            :loggin-config nil
            :peer-config nil)))

-(defrecord DummyServer [replica loggin-config peer-config]
+(defrecord DummyQueryServer [replica loggin-config peer-config]
   component/Lifecycle
   (start [this]
     (assoc this :replica (atom nil)))
   (stop [this]
     (assoc this :replica nil)))

-(defn query-server [peer-config]
-  (if (:onyx.query/server? peer-config)
-    (map->QueryServer {:peer-config peer-config})
-    (map->DummyServer {})))
+(defmulti query-server :onyx.query/server?)
+
+(defmethod query-server false [_]
+  (map->DummyQueryServer {}))
+
+(defmethod query-server :default [peer-config]
+  (throw (ex-info (str "No query server implementation found."
+                       "Did you include org.onyxplatform/onyx-query in your dependencies "
+                       "and require onyx.query in your peer bootup namespace?")
+                  {:peer-config peer-config})))
+
+(defmethod clojure.core/print-method DummyQueryServer
+  [system ^java.io.Writer writer]
+  (.write writer "#<Dummy Query Server>"))


indentation

indentation

--- examples/drag-and-drop/src/drag_and_drop/core.cljs
+++ examples/drag-and-drop/src/drag_and_drop/core.cljs
@@ -175,20 +175,20 @@
                               :-moz-user-select "none"
                               :-ms-user-select "none"
                               :user-select "none"}}
-             (apply dom/div #js {:className "placed-boxes"}
-                    (map render-solid-box (:placed-boxes state)))
-             (apply dom/div #js {:className "moving-boxes"}
-                    (map render-ghost-box moving-boxes))
-             (render-ghost-box resizing-box)
-             (dom/div #js {:style #js {:position "relative"}}
-                      (dom/h1 nil "Drag and drop")
-                      (dom/p nil
-                             (dom/a #js {:href "https://github.com/jamesmacaulay/zelkova/blob/gh-pages/examples/drag-and-drop/src/drag_and_drop/core.cljs"}
-                                    "View source")
-                             ".")
-                      (dom/p nil
-                             "Drag to create boxes, drag to move them around, and click to remove them.")
-                      (dom/pre nil (.stringify js/JSON (clj->js state) nil 2))))))
+      (apply dom/div #js {:class "placed-boxes"}
+        (map render-solid-box (:placed-boxes state)))
+      (apply dom/div #js {:class "moving-boxes"}
+        (map render-ghost-box moving-boxes))
+      (render-ghost-box resizing-box)
+      (dom/div #js {:style #js {:position "relative"}}
+        (dom/h1 nil "Drag and drop")
+        (dom/p nil
+               (dom/a #js {:href "https://github.com/jamesmacaulay/zelkova/blob/gh-pages/examples/drag-and-drop/src/drag_and_drop/core.cljs"}
+                      "View source")
+               ".")
+        (dom/p nil
+               "Drag to create boxes, drag to move them around, and click to remove them.")
+        (dom/pre nil (.stringify js/JSON (clj->js state) nil 2))))))

 (om/root
   (fn [app owner]


Change argument order in run-test-case: strategy comes before active

--- lazytest.clj
+++ lazytest.clj
@@ -21,11 +21,11 @@
   (run-tests [x] "Runs tests defined for the Namespace, Var, or TestCase."))

 (defprotocol TestInvokable
-  (invoke-test [t states active strategy]
+  (invoke-test [t states strategy active]
                "(private) Executes the TestCase or Assertion."))

 (extend-class clojure.lang.Fn TestInvokable
-              (invoke-test [f states active strategy] (apply f states)))
+              (invoke-test [f states strategy active] (apply f states)))

 ;;; DATATYPES

@@ -36,9 +36,10 @@
 (deftype TestCase [contexts children] :as this
   clojure.lang.IFn
   (invoke [] (run-test-case this))
-  (invoke [active] (run-test-case this active))
-  TestInvokable (invoke-test [states active strategy]
-                             (run-test-case this active strategy)))
+  (invoke [strategy] (run-test-case this strategy))
+  (invoke [strategy active] (run-test-case this strategy active))
+  TestInvokable (invoke-test [states strategy active]
+                             (run-test-case this strategy active)))

 (deftype Assertion [locals form])

@@ -183,9 +184,9 @@
   "Executes a test case in context.  active is the map of currently
   active Contexts.  strategy is a function that determines how tests
   are executed."
-  ([t] (run-test-case t {}))
-  ([t active] (run-test-case t {} default-strategy))
-  ([t active strategy]
+  ([t] (run-test-case t default-strategy))
+  ([t strategy] (run-test-case t strategy {}))
+  ([t strategy active]
      {:pre [(= ::TestCase (type t))
             (every? #(= ::Context (type %)) (:contexts t))]}
      (try
@@ -193,7 +194,7 @@
             merged (reduce open-context active (:contexts t))
             states (map merged (:contexts t))
             results (mapper
-                     #(invoke-test % states merged child-strategy)
+                     #(invoke-test % states child-strategy merged)
                      (:children t))]
         ;; Force non-lazy execution to handle shutdown properly:
         (when (some has-after? (:contexts t))
@@ -436,7 +437,7 @@
 (def t6 (TestCase [c5] [t4 t4]))

 (with-log
-  (dorun (result-seq (run-test-case t6 {} lazy-strategy)))
+  (dorun (result-seq (run-test-case t6 lazy-strategy)))
   (assert (= @*log* [:c5-open :a3 :a4 :a3 :a4 :c5-close])))

 ;; Lazy Evaluation
@@ -445,7 +446,7 @@
 (def t7 (TestCase [c6] [a3 a4]))

 (with-log
-  (let [results (run-test-case t7 {} lazy-strategy)]
+  (let [results (run-test-case t7 lazy-strategy)]
     (assert (= @*log* [:c6-open]))
     (dorun (result-seq results))
     (assert (= @*log* [:c6-open :a3 :a4]))))
@@ -454,7 +455,7 @@
 (def t8 (TestCase [] [t7 t7]))

 (with-log
-  (let [results (run-test-case t8 {} lazy-strategy)]
+  (let [results (run-test-case t8 lazy-strategy)]
     (assert (= @*log* []))
     (dorun (:children (first (:children results))))
     (assert (= @*log* [:c6-open :a3 :a4]))
@@ -464,7 +465,7 @@
 (def t9 (TestCase [c6] [t7 t7]))

 (with-log
-  (let [results (run-test-case t9 {} lazy-strategy)]
+  (let [results (run-test-case t9 lazy-strategy)]
     (assert (= @*log* [:c6-open]))
     (dorun (result-seq results))
     (assert (= @*log* [:c6-open :a3 :a4 :a3 :a4]))))


Don't require the latest dynapath to be loaded [IMMUTANT-435]

--- namespaces/common/src/main/clojure/immutant/util.clj
+++ namespaces/common/src/main/clojure/immutant/util.clj
@@ -1,15 +1,15 @@
 ;; Copyright 2008-2014 Red Hat, Inc, and individual contributors.
-;;
+;;
 ;; This is free software; you can redistribute it and/or modify it
 ;; under the terms of the GNU Lesser General Public License as
 ;; published by the Free Software Foundation; either version 2.1 of
 ;; the License, or (at your option) any later version.
-;;
+;;
 ;; This software is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
 ;; Lesser General Public License for more details.
-;;
+;;
 ;; You should have received a copy of the GNU Lesser General Public
 ;; License along with this software; if not, write to the Free
 ;; Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA
@@ -49,7 +49,7 @@
 (defn classpath
   "Returns the effective classpath for the app"
   []
-  (dp/all-classpath-urls))
+  (dp/all-classpath-urls clojure.lang.RT/baseLoader))

 (defn at-exit
   "Registers a function to be called when the application is undeployed.
@@ -210,7 +210,7 @@
      (wait-for #(.isStarted x) f attempts)))

 (defn waiting-derefable
-  "Returns an IDeref/IBlockingDeref that completes the deref and returns x when
+  "Returns an IDeref/IBlockingDeref that completes the deref and returns x when
    (t) is true."
   [t x]
   (reify


for some reason the default git branch was false, made it "master"

--- src/duffel_ext/git.clj
+++ src/duffel_ext/git.clj
@@ -29,7 +29,7 @@
         (merge dext-util/dir-ownership-tpl
             { :git_url    (list :string)
               :git_user   (list :string (list :optional dext-util/default-username))
-              :git_branch (list :string (list :optional false)) }))
+              :git_branch (list :string (list :optional "master")) }))

     (postprocess-file [x file-struct] file-struct)
     (postprocess-dir  [x dir-struct]  dir-struct)
@@ -48,15 +48,14 @@
                     (git-exec-dir git-user "." "clone" git-url abs))
                 (println abs "already exists, not cloning into it"))

-            (when git-branch
-                (if (re-find #"working directory clean" (git-exec-dir git-user abs "status"))
-                    (do
-                        (println "Checking out" abs "to" git-branch "branch") (flush)
-                        (git-exec-dir git-user abs "checkout" git-branch)
-                        (git-exec-dir git-user abs "fetch")
-                        (git-exec-dir git-user abs "reset" "--hard" (str "origin/" git-branch)))
-                    (throw (Exception.
-                        (str "Git project at " abs " is not clean, can't checkout branch")))))
+            (if (re-find #"working directory clean" (git-exec-dir git-user abs "status"))
+                (do
+                    (println "Checking out" abs "to" git-branch "branch") (flush)
+                    (git-exec-dir git-user abs "checkout" git-branch)
+                    (git-exec-dir git-user abs "fetch")
+                    (git-exec-dir git-user abs "reset" "--hard" (str "origin/" git-branch)))
+                (throw (Exception.
+                    (str "Git project at " abs " is not clean, can't checkout branch"))))

             (dext-util/try-ownership abs meta-struct))
     )


Make clojure.test output look same as with `lein repl`

--- src/midje/ideas/reporting/report.clj
+++ src/midje/ideas/reporting/report.clj
@@ -43,6 +43,13 @@
 (defn- fact-checks-out? []
   (not *failure-in-fact*))

+;; This turns off "Testing ...." lines, which I hate, especially
+;; when there's no failure output. The type check is because
+;; `lein test` overrides clojure.test/report with a non-multimethod.
+(when (= clojure.lang.MultiFn (type clojure.test/report))
+  (defmethod clojure.test/report :begin-test-ns [m]))
+
+
 (defn form-providing-friendly-return-value [test-form]
   `(do
      (#'fact-begins)


Remove unused function

Remove unused function

This is unnecessary after the refactoring a couple of commits ago.

--- src/extracter/core.clj
+++ src/extracter/core.clj
@@ -45,6 +45,7 @@
    :Docs (fn [& facts] {:facts (vec facts)})})

 (defn transform-file
+  "Given an instance of java.io.File, parse and transform it. Returns a vector of hash-maps."
   [^java.io.File f]
   {:pre [(files/fact? f)]}
   (let [parse-tree (parse (slurp-comments f))]
@@ -61,11 +62,6 @@
        (map (partial insta/transform transformations))
        flatten
        (filter :title))) ;; we don't want "facts" with nil values
-
-(defn path->md
-  [^String path ^String fout-path]
-  (let [facts (transform-facts-in-dir path)]
-    (md/facts->file facts fout-path)))

 (def cli-options
   [["-o" "--out FILE" "The path to the output file"]


Fix error-message in build-failure

Fix error-message in build-failure

--- src/puppeteer/app/slackbot/alice.clj
+++ src/puppeteer/app/slackbot/alice.clj
@@ -87,7 +87,13 @@
    m]
   (let [job (get-job job-usecase (:id m))]
     (when job
-      (message-usecase/send-build-failure-message message-usecase job))))
+      (message-usecase/send-build-failure-message
+        message-usecase
+        {:message (:message job)
+         :user-name (:user-name job)
+         :repo-name (:repo-name job)
+         :branch-name (:branch-name job)
+         :error-message (:logUrl job)}))))

 (defmulti reaction
   (fn [_ m] (:type m)))


(PDB-1810) Cleanup syntax in catalogs.clj for code-id patch

This commit cleans up some of the syntax in the catalogs code for some
of the changes from the new code-id v7 catalogs patch.

--- src/puppetlabs/puppetdb/catalogs.clj
+++ src/puppetlabs/puppetdb/catalogs.clj
@@ -201,9 +201,9 @@
       (dissoc :api_version)
       wire-v6->wire-v7))

-(defn wire-v4->wire-v7 [catalog recieved-time]
+(defn wire-v4->wire-v7 [catalog received-time]
   (-> catalog
-      (assoc :producer_timestamp recieved-time)
+      (assoc :producer_timestamp received-time)
       wire-v5->wire-v7))

 (def ^:const valid-relationships
@@ -325,11 +325,13 @@
         (throw (IllegalArgumentException. (format "Catalog is missing keys: %s" (string/join ", " (map name missing-keys)))))))
     catalog))

-(def validate
+(defn validate
   "Function for validating v7- of the catalogs"
-  (comp validate-edges
-        validate-resources
-        #(s/validate catalog-wireformat-schema %)))
+  [catalog]
+  (->> catalog
+       (s/validate catalog-wireformat-schema)
+       validate-resources
+       validate-edges))

 ;; ## High-level parsing routines

@@ -436,8 +438,8 @@
   [catalog :- catalog-query-schema]
   (-> catalog
       (dissoc :hash)
-      (update-in [:edges] edges-expanded->wire-v7)
-      (update-in [:resources] resources-expanded->wire-v7)))
+      (update :edges edges-expanded->wire-v7)
+      (update :resources resources-expanded->wire-v7)))

 (defn catalogs-query->wire-v7 [catalogs]
   (map catalog-query->wire-v7 catalogs))


remove debug stuff

remove debug stuff

--- src/test/clj/com/climate/services/aws/s3_test.clj
+++ src/test/clj/com/climate/services/aws/s3_test.clj
@@ -18,7 +18,6 @@
     lemur.test
     clojure.test)
   (:require
-    [alex-and-georges.debug-repl :refer [debug-repl]]
     [com.climate.services.aws.common :as awscommon]
     [clojure.tools.logging :as log])
   (:import


made flue nonvibrato

made flue nonvibrato

--- src/temperaments/core.clj
+++ src/temperaments/core.clj
@@ -15,10 +15,32 @@

 (def tuning (atom :equalTemperament))

+(def twelfth6 (sqrt 2))
+(def twelfth3 (sqrt twelfth6))
+(def twelfth1  (expt twelfth3 1/3))
+(def twelfth4 (expt 2 1/3))
+(def twelfth5 (* twelfth1 twelfth4))
+(def twelfth2 (* twelfth1 twelfth1))
+(def twelfth7 (* twelfth3 twelfth4))
+
 (def tuning-map
   (atom {:equalTemperament (map #(Math/pow 2 (/ % 12)) (range 0 12)),
          :pythagorean '(1 256/243 9/8 32/27 81/64 4/3 729/512 3/2 128/81 27/16 16/9 243/128),
          :justIntonation '(1 16/15 9/8 6/5 5/4 4/3 45/32 3/2 8/5 5/3 9/5 15/8)
+         :odonnel (list 1,(* 8/9 twelfth3),
+                        (* 8/9 twelfth4),(* 8/9 twelfth5),
+                        (* 8/9 twelfth6),
+                        4/3,(* 8/9 twelfth4 twelfth4),
+                        (* 4/3 twelfth2),(* 8/9 twelfth6 twelfth4),
+                        (* 32/27 twelfth6),(* twelfth6 twelfth4),
+                        (* 32/27 twelfth4 twelfth4))
+         :neidhardt (list 1,(* 8/9 twelfth3),
+                        (* 8/9 twelfth4),(* 8/9 twelfth5),
+                        (* 8/9 twelfth6),
+                        4/3,(* 8/9 twelfth4 twelfth4),
+                        (* 4/3 twelfth2),(* 8/9 twelfth6 twelfth4),
+                        (* 32/27 twelfth6),(* 9/8 twelfth4 twelfth4),
+                        (* 32/27 twelfth4 twelfth4))
          }))

 (def counter (atom 0))
@@ -39,12 +61,92 @@

 (require '[overtone.inst.synth :as syn])

-(def flute syn/simple-flute)
+;(def flute syn/simple-flute)
 (def cs80  syn/cs80lead)
 (def ssaw  syn/supersaw)
 (def tick  syn/ticker)
 (def ping  syn/ping)

+(o/definst flute [freq 880
+                       amp 0.5
+                       attack 0.4
+                       decay 0.5
+                       sustain 0.8
+                       release 1
+                       gate 1
+                       out 0]
+  (let [env  (o/env-gen (o/adsr attack decay sustain release) gate :action o/FREE)
+        mod2 (o/lin-lin:kr (o/lf-noise2:kr 1) -1 1 0.2 1)
+        mod3 (o/lin-lin:kr (o/sin-osc:kr (o/ranged-rand 4 6)) -1 1 0.5 1)
+        sig (o/distort (* env (o/sin-osc freq)))
+        sig (* amp sig mod2 mod3)]
+    sig))
+
+
+;; IMPORTANT: requires the mda-piano ugen to be available on your system
+
+;; modified from repo to take freq rather than note
+(o/definst piano [freq 220
+                  gate 1
+                  vel 100
+                  decay 0.8
+                  release 0.8
+                  hard 0.8
+                  velhard 0.8
+                  muffle 0.8
+                  velmuff 0.8
+                  velcurve 0.8
+                  stereo 0.2
+                  tune 0.5
+                  random 0.1
+                  stretch 0
+                  sustain 0]
+  (let [snd (o/mda-piano {:freq freq
+                          :gate gate
+                          :vel vel
+                          :decay decay
+                          :release release
+                          :hard hard
+                          :velhard velhard
+                          :muffle muffle
+                          :velmuff velmuff
+                          :velcurve velcurve
+                          :stereo stereo
+                          :tune tune
+                          :random random
+                          :stretch stretch
+                          :sustain sustain})]
+                                        ;(o/detect-silence snd 0.05 :action o/FREE)
+    snd))
+
+;; modified from repo to take freq rather than note
+(o/definst mooger
+  "Choose 0, 1, or 2 for saw, sin, or pulse"
+  [freq 220
+   amp  {:default 0.5 :min 0 :max 1 :step 0.01}
+   osc1 {:default 0 :min 0 :max 2 :step 1}
+   osc2 {:default 1 :min 0 :max 2 :step 1}
+   osc1-level {:default 0.5 :min 0 :max 1 :step 0.01}
+   osc2-level {:default 0.3 :min 0 :max 1 :step 0.01}
+   cutoff {:default 500 :min 0 :max 20000 :step 1}
+   attack {:default 0.0001 :min 0.0001 :max 5 :step 0.001}
+   decay {:default 0.3 :min 0.0001 :max 5 :step 0.001}
+   sustain {:default 0.99 :min 0.0001 :max 1 :step 0.001}
+   release {:default 0.0001 :min 0.0001 :max 6 :step 0.001}
+   fattack {:default 0.0001 :min 0.0001 :max 6 :step 0.001}
+   fdecay {:default 0.3 :min 0.0001 :max 6 :step 0.001}
+   fsustain {:default 0.999 :min 0.0001 :max 1 :step 0.001}
+   frelease {:default 0.0001 :min 0.0001 :max 6 :step 0.001}
+   gate 1]
+  (let [osc-bank-1 [(o/saw freq) (o/sin-osc freq) (o/pulse freq)]
+        osc-bank-2 [(o/saw freq) (o/sin-osc freq) (o/pulse freq)]
+        amp-env    (o/env-gen (o/adsr attack decay sustain release) gate :action o/FREE)
+        f-env      (o/env-gen (o/adsr fattack fdecay fsustain frelease) gate)
+        s1         (* osc1-level (o/select osc1 osc-bank-1))
+        s2         (* osc2-level (o/select osc2 osc-bank-2))
+        filt       (o/moog-ff (+ s1 s2) (* cutoff f-env) 3)]
+    (* amp filt)))
+
 (def inst-cur flute)

 (defn play-test-tone [e]
@@ -55,13 +157,22 @@

 (def aof-subject '([:d4 2] [:a4 2] [:f4 2] [:d4 2] [:c#4 2] [:d4 1]
                    [:e4 1] [:f4 2.5] [:g4 0.5] [:f4 0.5] [:e4 0.5] [:d4 1]))
-(def major '([:c4 1] [:d4 1] [:e4 1] [:f4 1] [:g4 1] [:a4 1] [:b4 1] [:c5 1]))
-(def minor '([:c4 1] [:d4 1] [:eb4 1] [:f4 1] [:g4 1] [:ab4 1] [:bb4 1] [:c5 1]))
+(def major
+  (let [half '([:c4 1] [:d4 1] [:e4 1] [:f4 1] [:g4 1] [:a4 1] [:b4 1] [:c5 1])
+        rev (drop 1 (reverse half))]
+    (concat half rev)))
+(def minor
+  (let [half '([:c4 1] [:d4 1] [:d#4 1] [:f4 1] [:g4 1] [:a4 1] [:b4 1] [:c5 1])
+        rev (concat '([:a#4 1] [:g#4 1]) (drop 3 (reverse half)))]
+    (concat half rev)))
+

 (defn inst-chooser [e]
   (let [val (value (.getSource e))]
     (case val
       "Flute"  (def inst-cur flute)
+      "Piano"  (def inst-cur piano)
+      "Mooger" (def inst-cur mooger)
       "CS80"   (def inst-cur cs80)
       "SSaw"   (def inst-cur ssaw)
       "Ticker" (def inst-cur tick)
@@ -108,7 +219,9 @@
     (case val
       "Equal"       (reset! tuning :equalTemperament)
       "Pythagorean" (reset! tuning :pythagorean)
-      "Just"        (reset! tuning :justIntonation)))
+      "Just"        (reset! tuning :justIntonation)
+      "O'Donnel"        (reset! tuning :odonnel)
+      "Neidhardt"        (reset! tuning :neidhardt)))
   ;;(println (midi->freq 60))
   )

@@ -160,22 +273,25 @@
 ;;(println aof-subject)

 (defn play-one
-  [metronome beat instrument [pitch dur]]
+  [metronome beat instrument [pitch dur] {midiq :midi}]
   (let [end (+ beat dur)]
     (if pitch
-      (let [id (o/at (metronome beat) (instrument (midi->freq pitch)))]
+      (let [freq (if midiq
+                   (midi->freq pitch)
+                   pitch)
+            id (o/at (metronome beat) (instrument freq))]
         (o/at (metronome end) (o/ctl id :gate 0))))
     end))

 (defn play
-  ([metronome inst score]
-     (play metronome (metronome) inst score))
-  ([metronome beat instrument score]
+  ([metronome inst score {midiq :midi}]
+     (play metronome (metronome) inst score {:midi midiq}))
+  ([metronome beat instrument score {midiq :midi}]
      (let [cur-note (first score)]
        (when cur-note
-         (let [next-beat (play-one metronome beat instrument cur-note)]
+         (let [next-beat (play-one metronome beat instrument cur-note {:midi midiq})]
            (o/apply-at (metronome next-beat) play metronome next-beat instrument
-             (next score) []))))))
+             (next score) {:midi midiq} []))))))

 (def a-scale ["A" "B\u266D" "B" "C" "C\u266F" "D"
               "E\u266D" "E" "F" "F\u266F" "G" "G\u266F"] )
@@ -341,13 +457,13 @@
   (let [score (or @melody
                   (make-score))]
     (doseq [part score]
-      (play one-twenty-bpm inst-cur part))))
+      (play one-twenty-bpm inst-cur part {:midi true}))))

 (defn play-solo [id e]
   (let [[mel rhy] (make-part id)
         notes (map str->midi mel)
         part (map vector notes rhy)]
-    (play one-twenty-bpm inst-cur part)))
+    (play one-twenty-bpm inst-cur part {:midi true})))

 (defn remove-circle [id kw]
   (let [len (get-in @melody-map [id kw])
@@ -521,7 +637,8 @@
                            (label :text ""
                                   :size [100 :by 30])
                            (label "Instrument:")
-                           (combobox :model ["Flute" "CS80" "SSaw" "Ticker" "Ping"]
+                           (combobox :model ["Flute" "Piano" "Mooger" "CS80"
+                                             "SSaw" "Ticker" "Ping"]
                                      :id :instChooser
                                      :listen [:action inst-chooser])
                            (label "Tonic:")
@@ -529,7 +646,8 @@
                                      :id :tonicChooser
                                      :listen [:action tonic-chooser])
                            (label "Tuning:")
-                           (combobox :model ["Equal" "Pythagorean" "Just"]
+                           (combobox :model ["Equal" "Pythagorean" "Just"
+                                             "O'Donnel" "Neidhardt"]
                                      :id :tuningChooser
                                      :listen [:action tuning-chooser])
                            (label "Melody:")


Use glTexSubImage3D instead of glTexImage3D for texture updating

--- src/zaffre/glterminal.clj
+++ src/zaffre/glterminal.clj
@@ -846,19 +846,19 @@
               ; Send updated glyph texture to gl
               (GL13/glActiveTexture GL13/GL_TEXTURE1)
               (GL11/glBindTexture GL30/GL_TEXTURE_2D_ARRAY glyph-texture)
-              (GL12/glTexImage3D GL30/GL_TEXTURE_2D_ARRAY 0 GL30/GL_RGBA8UI texture-columns texture-rows layer-count 0 GL30/GL_RGBA_INTEGER GL11/GL_UNSIGNED_BYTE glyph-image-data)
+              (GL12/glTexSubImage3D GL30/GL_TEXTURE_2D_ARRAY 0 0 0 0 texture-columns texture-rows layer-count GL30/GL_RGBA_INTEGER GL11/GL_UNSIGNED_BYTE glyph-image-data)
               (except-gl-errors "glyph texture data")
               ; Send updated fg texture to gl
               (GL13/glActiveTexture GL13/GL_TEXTURE2)
               (GL11/glBindTexture GL30/GL_TEXTURE_2D_ARRAY fg-texture)
-              (GL12/glTexImage3D GL30/GL_TEXTURE_2D_ARRAY 0 GL11/GL_RGBA texture-columns texture-rows layer-count 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE fg-image-data)
+              (GL12/glTexSubImage3D GL30/GL_TEXTURE_2D_ARRAY 0 0 0 0 texture-columns texture-rows layer-count GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE fg-image-data)
               (except-gl-errors "fg color texture data")
               ; Send updated bg texture to gl
               (GL13/glActiveTexture GL13/GL_TEXTURE3)
               (except-gl-errors "bg color glActiveTexture")
               (GL11/glBindTexture GL30/GL_TEXTURE_2D_ARRAY bg-texture)
               (except-gl-errors "bg color glBindTexture")
-              (GL12/glTexImage3D GL30/GL_TEXTURE_2D_ARRAY 0 GL11/GL_RGBA texture-columns texture-rows layer-count 0 GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE bg-image-data)
+              (GL12/glTexSubImage3D GL30/GL_TEXTURE_2D_ARRAY 0 0 0 0 texture-columns texture-rows layer-count GL11/GL_RGBA GL11/GL_UNSIGNED_BYTE bg-image-data)
               (except-gl-errors "bg color glTexImage2D")
               (GL11/glDrawArrays GL11/GL_TRIANGLE_STRIP 0 vertices-count)
               (except-gl-errors "bg color glDrawArrays")


Colorize evaluation results in terminal REPLs

--- profiles.clj
+++ profiles.clj
@@ -104,6 +104,9 @@
                           ;; in vinyasa. See https://github.com/zcaudate/vinyasa/pull/31
                           (inject '[[clojure.tools.namespace.repl refresh refresh-all]]))]}

+ :whidbey {:plugins [;; Colorize and pretty-print all evaluation results
+                     [mvxcvi/whidbey "1.3.1"]]}
+
  ;; END profiles with optional injections

  :lint {:plugins [;; Miscellaneous linting
@@ -163,7 +166,8 @@
             :inject
             :alembic
             :pretty
-            :refresh]
+            :refresh
+            :whidbey]

  ;; This profile is for use from Emacs.
  :emacs [:cljs


Add example object commands.

Add example object commands.

--- src/vault/tool.clj
+++ src/vault/tool.clj
@@ -26,6 +26,21 @@
 (def ^:private config-readers
   "Map of EDN readers for supported types in config files."
   {'vault/file-store (partial apply file-store)})
+
+
+
+;; UTILITY ACTIONS
+
+(defn- debug-command
+  [opts args]
+  (pprint opts)
+  (pprint args))
+
+
+(defn- not-yet-implemented
+  [opts args]
+  (println "This command is not yet implemented")
+  (System/exit 1))

@@ -119,7 +134,25 @@

       (command "put < blob.dat"
         "Store a blob of data read from stdin and print the resulting blobref."
-        (action blob-tool/put-blob)))))
+        (action blob-tool/put-blob)))
+
+    (command "object <action> [args]"
+      "Interact with object entities and data."
+
+      (command "create [args]"
+        "Create a new object."
+
+        ["--time" "Set the time to create the object root with. Defaults to the current time."]
+        ["--id" "Set an identity for the object root. Defaults to a random string."]
+        ["--attributes" "Provide an initial set of attributes for the object."]
+        ["--value" "Set the initial object value to the given reference."]
+
+        (action not-yet-implemented))
+
+      (command "update <object> <type> [args]"
+        "Apply an update to an existing object."
+
+        (action not-yet-implemented)))))

 (defn -main [& args]


[#293] Tests housekeeping

[#293] Tests housekeeping

--- test/org/httpkit/num_connections.clj
+++ test/org/httpkit/num_connections.clj
@@ -3,24 +3,43 @@
              [org.httpkit.server :refer [run-server]]
              [org.httpkit.client :as client]))

-(defn h [p]
-  (fn [r]
-    (if (= (:uri r) "/wait")
-      {:status @p}
-      {:status 200})))
+(deftest one-connection
+  (let [client  (org.httpkit.client.HttpClient. 1) ; Max 1 conn
+        p       (promise)
+        handler (fn [req]
+                  (if (= (:uri req) "/wait")
+                    {:status @p}
+                    {:status 200}))
+        server (run-server handler {:port 4347})
+        r1 (client/get "http://localhost:4347/wait" {:client client})
+        r2 (client/get "http://localhost:4347"      {:client client})]

-(deftest one-connection
-  (let [p (promise)
-        c (org.httpkit.client.HttpClient. 1)
-        s (run-server (h p) {:port 4347})
-        r1 (client/get "http://localhost:4347/wait" {:client c})
-        r2 (client/get "http://localhost:4347" {:client c})]
     (try
+      (Thread/sleep 100)
       (is (not (realized? r1)))
-      (is (not (realized? r2)))
-      (deliver p 200)
+      (is (not (realized? r2))) ; Waiting till r1 completes
+      (deliver p 200) ; Complete r1
       (Thread/sleep 100)
       (is (realized? r1))
+      (is (realized? r2))
+      (finally (server)))))
+
+(deftest many-connections
+  (let [client  (org.httpkit.client.HttpClient.) ; Unlimited conns
+        p       (promise)
+        handler (fn [req]
+                  (if (= (:uri req) "/wait")
+                    {:status @p}
+                    {:status 200}))
+        server (run-server handler {:port 4347})
+        r1 (client/get "http://localhost:4347/wait" {:client client})
+        r2 (client/get "http://localhost:4347"      {:client client})]
+
+    (try
       (Thread/sleep 100)
-      (is (realized? r2))
-      (finally (s)))))
+      (is (not (realized? r1)))
+      (is      (realized? r2)) ; Not waiting till r1 completes
+      (deliver p 200) ; Complete r1
+      (Thread/sleep 100)
+      (is (realized? r1))
+      (finally (server)))))


Add delete shape tests.

Add delete shape tests.

And general test format change.

--- test/uxbox/data/workspace_tests.cljs
+++ test/uxbox/data/workspace_tests.cljs
@@ -4,127 +4,169 @@
             [uxbox.rstore :as rs]
             [uxbox.data.workspace :as dw]))

-(t/deftest drop-shape-test
-  (t/testing "case 1: move shape before other shape"
-    (let [initial {:pages-by-id {1 {:id 1 :shapes [1 2 3]}}
-                   :shapes-by-id {1 {:id 1 :page 1}
-                                  2 {:id 2 :page 1}
-                                  3 {:id 3 :page 1}}}
-          expected (assoc-in initial [:pages-by-id 1 :shapes] [3 1 2])
-          event (dw/drop-shape 3 1 :before)
-          result (rs/-apply-update event initial)]
-      ;; (pprint expected)
-      ;; (pprint result)
-      (t/is (= result expected))
-      (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))
+;; delete shape: delete from page
+(t/deftest delete-shape-test1
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 3 4]}}
+                 :shapes-by-id {1 {:id 1 :page 1
+                                   :type :builtin/group
+                                   :items [2]}
+                                2 {:id 2 :page 1 :group 1}
+                                3 {:id 3 :page 1}
+                                4 {:id 4 :page 1}}}
+        event (dw/delete-shape 4)
+        expected (-> initial
+                     (assoc-in [:pages-by-id 1 :shapes] [1 3])
+                     (update-in [:shapes-by-id] dissoc 4))
+        result (rs/-apply-update event initial)]
+    ;; (pprint expected)
+    ;; (pprint result)
+    (t/is (= result expected))))

-  (t/testing "case 2: move shape after other shape"
-    (let [initial {:pages-by-id {1 {:id 1 :shapes [1 2 3]}}
-                   :shapes-by-id {1 {:id 1 :page 1}
-                                  2 {:id 2 :page 1}
-                                  3 {:id 3 :page 1}}}
-          expected (assoc-in initial [:pages-by-id 1 :shapes] [1 3 2])
-          event (dw/drop-shape 3 1 :after)
-          result (rs/-apply-update event initial)]
-      (t/is (= result expected))
-      (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))
+;; delete shape: delete from group
+(t/deftest delete-shape-test2
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 3 4]}}
+                 :shapes-by-id {1 {:id 1 :page 1
+                                   :type :builtin/group
+                                   :items [2]}
+                                2 {:id 2 :page 1 :group 1}
+                                3 {:id 3 :page 1}
+                                4 {:id 4 :page 1}}}
+        event (dw/delete-shape 2)
+        expected (-> initial
+                     (assoc-in [:pages-by-id 1 :shapes] [3 4])
+                     (update-in [:shapes-by-id] dissoc 2)
+                     (update-in [:shapes-by-id] dissoc 1))
+        result (rs/-apply-update event initial)]
+    ;; (pprint expected)
+    ;; (pprint result)
+    (t/is (= result expected))))

-  (t/testing "case 3: move shape before other shape that is part of group."
-    (let [initial {:pages-by-id {1 {:id 1 :shapes [1 3 4]}}
-                   :shapes-by-id {1 {:id 1 :page 1
-                                     :type :builtin/group
-                                     :items [2]}
-                                  2 {:id 2 :page 1 :group 1}
-                                  3 {:id 3 :page 1}
-                                  4 {:id 4 :page 1}}}
-          event (dw/drop-shape 3 2 :before)
-          expected (-> initial
-                       (assoc-in [:pages-by-id 1 :shapes] [1 4])
-                       (assoc-in [:shapes-by-id 1 :items] [3 2])
-                       (assoc-in [:shapes-by-id 3 :group] 1))
-          result (rs/-apply-update event initial)]
-      (t/is (= result expected))
-      (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))
+;; drop shape: move shape before other shape
+(t/deftest drop-shape-test1
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 2 3]}}
+                 :shapes-by-id {1 {:id 1 :page 1}
+                                2 {:id 2 :page 1}
+                                3 {:id 3 :page 1}}}
+        expected (assoc-in initial [:pages-by-id 1 :shapes] [3 1 2])
+        event (dw/drop-shape 3 1 :before)
+        result (rs/-apply-update event initial)]
+    ;; (pprint expected)
+    ;; (pprint result)
+    (t/is (= result expected))
+    (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))

-  (t/testing "case 4: move shape inside group"
-    (let [initial {:pages-by-id {1 {:id 1 :shapes [1 3 4]}}
-                   :shapes-by-id {1 {:id 1 :page 1
-                                     :type :builtin/group
-                                     :items [2]}
-                                  2 {:id 2 :page 1 :group 1}
-                                  3 {:id 3 :page 1}
-                                  4 {:id 4 :page 1}}}
-          event (dw/drop-shape 3 1 :inside)
-          expected (-> initial
-                       (assoc-in [:pages-by-id 1 :shapes] [1 4])
-                       (assoc-in [:shapes-by-id 1 :items] [2 3])
-                       (assoc-in [:shapes-by-id 3 :group] 1))
-          result (rs/-apply-update event initial)]
-      ;; (pprint expected)
-      ;; (pprint result)
-      (t/is (= result expected))
-      (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))
+;; drop shape: move shape after other shape
+(t/deftest drop-shape-test2
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 2 3]}}
+                 :shapes-by-id {1 {:id 1 :page 1}
+                                2 {:id 2 :page 1}
+                                3 {:id 3 :page 1}}}
+        expected (assoc-in initial [:pages-by-id 1 :shapes] [1 3 2])
+        event (dw/drop-shape 3 1 :after)
+        result (rs/-apply-update event initial)]
+    (t/is (= result expected))
+    (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))

-  (t/testing "case 5: move shape outside of group"
-    (let [initial {:pages-by-id {1 {:id 1 :shapes [1 4]}}
-                   :shapes-by-id {1 {:id 1 :page 1
-                                     :type :builtin/group
-                                     :items [2 3]}
-                                  2 {:id 2 :page 1 :group 1}
-                                  3 {:id 3 :page 1 :group 1}
-                                  4 {:id 4 :page 1}}}
-          event (dw/drop-shape 3 4 :after)
-          expected (-> initial
-                       (assoc-in [:pages-by-id 1 :shapes] [1 4 3])
-                       (assoc-in [:shapes-by-id 1 :items] [2])
-                       (update-in [:shapes-by-id 3] dissoc :group))
-          result (rs/-apply-update event initial)]
-      (t/is (= result expected))
-      (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))
+;; drop shape: move shape before other shape that is part of group.
+(t/deftest drop-shape-test3
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 3 4]}}
+                 :shapes-by-id {1 {:id 1 :page 1
+                                   :type :builtin/group
+                                   :items [2]}
+                                2 {:id 2 :page 1 :group 1}
+                                3 {:id 3 :page 1}
+                                4 {:id 4 :page 1}}}
+        event (dw/drop-shape 3 2 :before)
+        expected (-> initial
+                     (assoc-in [:pages-by-id 1 :shapes] [1 4])
+                     (assoc-in [:shapes-by-id 1 :items] [3 2])
+                     (assoc-in [:shapes-by-id 3 :group] 1))
+        result (rs/-apply-update event initial)]
+    (t/is (= result expected))
+    (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))

-  (t/testing "case 6: move group inside group"
-    (let [initial {:pages-by-id {1 {:id 1 :shapes [1 2]}}
-                   :shapes-by-id {1 {:id 1 :page 1
-                                     :type :builtin/group
-                                     :items [3]}
-                                  2 {:id 2 :page 1
-                                     :type :builtin/group
-                                     :items [4]}
-                                  3 {:id 3 :page 1 :group 1}
-                                  4 {:id 4 :page 1 :group 2}}}
-          event (dw/drop-shape 2 3 :after)
-          expected (-> initial
-                       (assoc-in [:pages-by-id 1 :shapes] [1])
-                       (assoc-in [:shapes-by-id 1 :items] [3 2])
-                       (assoc-in [:shapes-by-id 2 :group] 1))
+;; drop shape: move shape inside group
+(t/deftest drop-shape-test4
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 3 4]}}
+                 :shapes-by-id {1 {:id 1 :page 1
+                                   :type :builtin/group
+                                   :items [2]}
+                                2 {:id 2 :page 1 :group 1}
+                                3 {:id 3 :page 1}
+                                4 {:id 4 :page 1}}}
+        event (dw/drop-shape 3 1 :inside)
+        expected (-> initial
+                     (assoc-in [:pages-by-id 1 :shapes] [1 4])
+                     (assoc-in [:shapes-by-id 1 :items] [2 3])
+                     (assoc-in [:shapes-by-id 3 :group] 1))
+        result (rs/-apply-update event initial)]
+    ;; (pprint expected)
+    ;; (pprint result)
+    (t/is (= result expected))
+    (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))

-          result (rs/-apply-update event initial)]
-      ;; (pprint expected)
-      ;; (pprint result)
-      (t/is (= result expected))
-      (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))
+;; drop shape: move shape outside of group
+(t/deftest drop-shape-test5
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 4]}}
+                 :shapes-by-id {1 {:id 1 :page 1
+                                   :type :builtin/group
+                                   :items [2 3]}
+                                2 {:id 2 :page 1 :group 1}
+                                3 {:id 3 :page 1 :group 1}
+                                4 {:id 4 :page 1}}}
+        event (dw/drop-shape 3 4 :after)
+        expected (-> initial
+                     (assoc-in [:pages-by-id 1 :shapes] [1 4 3])
+                     (assoc-in [:shapes-by-id 1 :items] [2])
+                     (update-in [:shapes-by-id 3] dissoc :group))
+        result (rs/-apply-update event initial)]
+    (t/is (= result expected))
+    (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))

-  (t/testing "case 7: move group outside group"
-    (let [initial {:pages-by-id {1 {:id 1 :shapes [1 3]}}
-                   :shapes-by-id {1 {:id 1 :page 1
-                                     :type :builtin/group
-                                     :items [2]}
-                                  2 {:id 2 :page 1
-                                     :group 1
-                                     :type :builtin/group
-                                     :items [4]}
-                                  3 {:id 3 :page 1}
-                                  4 {:id 4 :page 1 :group 2}}}
-          event (dw/drop-shape 2 1 :after)
-          expected (-> initial
-                       (assoc-in [:pages-by-id 1 :shapes] [2 3])
-                       (update-in [:shapes-by-id] dissoc 1)
-                       (update-in [:shapes-by-id 2] dissoc :group))
-          result (rs/-apply-update event initial)]
-      ;; (pprint expected)
-      ;; (pprint result)
-      (t/is (= result expected))
-      (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))
-)
+;; drop shape: move group inside group
+(t/deftest drop-shape-test6
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 2]}}
+                 :shapes-by-id {1 {:id 1 :page 1
+                                   :type :builtin/group
+                                   :items [3]}
+                                2 {:id 2 :page 1
+                                   :type :builtin/group
+                                   :items [4]}
+                                3 {:id 3 :page 1 :group 1}
+                                4 {:id 4 :page 1 :group 2}}}
+        event (dw/drop-shape 2 3 :after)
+        expected (-> initial
+                     (assoc-in [:pages-by-id 1 :shapes] [1])
+                     (assoc-in [:shapes-by-id 1 :items] [3 2])
+                     (assoc-in [:shapes-by-id 2 :group] 1))
+
+        result (rs/-apply-update event initial)]
+    ;; (pprint expected)
+    ;; (pprint result)
+    (t/is (= result expected))
+    (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))
+
+;; drop shape: move group outside group
+(t/deftest drop-shape-test7
+  (let [initial {:pages-by-id {1 {:id 1 :shapes [1 3]}}
+                 :shapes-by-id {1 {:id 1 :page 1
+                                   :type :builtin/group
+                                   :items [2]}
+                                2 {:id 2 :page 1
+                                   :group 1
+                                   :type :builtin/group
+                                   :items [4]}
+                                3 {:id 3 :page 1}
+                                4 {:id 4 :page 1 :group 2}}}
+        event (dw/drop-shape 2 1 :after)
+        expected (-> initial
+                     (assoc-in [:pages-by-id 1 :shapes] [2 3])
+                     (update-in [:shapes-by-id] dissoc 1)
+                     (update-in [:shapes-by-id 2] dissoc :group))
+        result (rs/-apply-update event initial)]
+    ;; (pprint expected)
+    ;; (pprint result)
+    (t/is (= result expected))
+    (t/is (vector? (get-in result [:pages-by-id 1 :shapes])))))


fix pos

fix pos

--- src/xom/server.clj
+++ src/xom/server.clj
@@ -106,9 +106,9 @@
       (let [new-winner (-> (d/with db [new-pos])
                            :db-after
                            (d/entity (:db/id g))
-                           :xom/positions
                            board
                            winner)]
+        (log "new-winner " new-winner)
         [{:db/id (:db/id g) :xom/winner new-winner}
          new-pos])
       (log "illegal move " new-pos))))


changing test to match jobs fn

changing test to match jobs fn

--- test/celestial/integration/jobs.clj
+++ test/celestial/integration/jobs.clj
@@ -1,11 +1,14 @@
 (ns celestial.integration.jobs
   (:require
+    [celestial.model :refer (operations)]
     [celestial.fixtures.core :refer (with-conf)]
-    [celestial.jobs :as jobs :refer (initialize-workers workers)])
+    [celestial.jobs :refer (jobs initialize-workers workers)])
   (:use midje.sweet))

 (with-conf
-  (with-state-changes [(before :facts (reset! jobs/jobs {:machine [identity 2]}))]
+  (with-state-changes [(before :facts (reset! workers {}))]
     (fact "workers creation" :integration :redis
-       (initialize-workers)
-       (keys @workers) => (just :machine))))
+      (initialize-workers) => nil
+      (provided
+        (jobs) => {:machine [identity 2]})
+      (keys @workers) => (just :machine))))


fix test

fix test

--- test/com/rpl/specter/core_test.cljc
+++ test/com/rpl/specter/core_test.cljc
@@ -3,7 +3,7 @@
              [cljs.test :refer [is deftest]]
              [cljs.test.check.cljs-test :refer [defspec]]
              [com.rpl.specter.cljs-test-helpers :refer [for-all+]]))
-  (:use
+  (:use
     #?(:clj [clojure.test :only [deftest is]])
     #?(:clj [clojure.test.check.clojure-test :only [defspec]])
     #?(:clj [com.rpl.specter.test-helpers :only [for-all+]])
@@ -321,7 +321,7 @@
                                  #(= 3 %) (s/view dec))]
                  [1 2 3 4 5 6 7 8])))
   (is (empty? (s/select (s/if-path odd? (s/view inc)) 2)))
-  (is (= [6 2 10 6 14]
+  (is (= [6 2 10 6 14]
          (s/transform [(s/putval 2)
                   s/ALL
                   (s/if-path odd? [(s/view inc) (s/view inc)] (s/view dec))]
@@ -353,9 +353,9 @@
          k (if (pred v1) k2 k3)]
      (and
        (= (s/transform (s/if-path [k1 pred] k2 k3) inc m)
-          (s/transform k inc m))
+          (s/transform k inc m))
        (= (s/select (s/if-path [k1 pred] k2 k3) m)
-          (s/select k m))
+          (s/select k m))
        ))))

 (defspec multi-path-test
@@ -396,11 +396,12 @@
   (is (thrown? #?(:clj Exception :cljs js/Error) (s/select-one! s/ALL [])))
   )

+
 (defspec transformed-test
   (for-all+
     [v (gen/vector gen/int)
-     pred (gen/elements [even? odd?]
-     op   (gen/elements [inc dec]))]
-    (= (select-one (transformed [ALL pred] op) v)
-       (transform [ALL pred] op v))
+     pred (gen/elements [even? odd?])
+     op   (gen/elements [inc dec])]
+    (= (s/select-one (s/transformed [s/ALL pred] op) v)
+       (s/transform [s/ALL pred] op v))
     ))


test of filterer with parameterization

test of filterer with parameterization

--- test/com/rpl/specter/core_test.cljc
+++ test/com/rpl/specter/core_test.cljc
@@ -420,7 +420,7 @@
         (= (s/compiled-transform (p k1 k2) pred m1) (s/transform [k1 k2] pred m1))
         ))))

-(defspec various-orders-comp
+(defspec various-orders-comp-test
   (for-all+
     [k1 (limit-size 3 gen/keyword)
      k2 (limit-size 3 gen/keyword)
@@ -452,6 +452,31 @@
         (apply = (for [p paths] (s/compiled-transform p pred m1)))
         ))))

+(defspec filterer-param-test
+  (for-all+
+    [k gen/keyword
+     k2 gen/keyword
+     v (gen/vector
+         (limit-size 5
+           (gen-map-with-keys
+                        gen/keyword
+                        gen/int
+                        k
+                        k2
+                        )))
+     pred (gen/elements [odd? even?])
+     updater (gen/elements [inc dec])]
+    (and
+      (= (s/compiled-select ((s/filterer s/keypath pred) k) v)
+         (s/compiled-select (s/filterer k pred) v))
+      (= (s/compiled-transform ((s/comp-paths (s/filterer s/keypath pred) s/ALL k2) k)
+           updater
+           v)
+         (s/compiled-transform (s/comp-paths (s/filterer k pred) s/ALL k2)
+           updater
+           v))
+      )))
+
 ;;TODO: test using params path
 ;; using filterer, transformed, selected? with parameterized paths
 ;; using cond-path parameterized paths


Chris #22 - use the base url to get the test data as well!

--- test/functional/functional_test.clj
+++ test/functional/functional_test.clj
@@ -24,25 +24,26 @@
 (use-fixtures :once functional-fixture)

 (defn nevergreen-under-test []
-  (let [url (or (env :functional-url) "http://localhost:5000/config")]
+  (let [url (or (env :functional-url) "http://localhost:5000")]
     (println "Running agaisnt" url)
     url))

 (def expected-projects ["success building project", "failure sleeping project", "failure building project"])

 (deftest simple-journey
-  (to (nevergreen-under-test))
+  (let [base-url (nevergreen-under-test)]
+    (to (str base-url "/config"))

-  (clear "#cctray-url")
-  (input-text "#cctray-url" "http://localhost:5000/test_data.xml")
-  (click "#cctray-fetch")
+    (clear "#cctray-url")
+    (input-text "#cctray-url" (str base-url "/test_data.xml"))
+    (click "#cctray-fetch")

-  (wait-until #(exists? "#projects > p > label > input"))
+    (wait-until #(exists? "#projects > p > label > input"))

-  (click "#include-all")
-  (click "#monitor")
+    (click "#include-all")
+    (click "#monitor")

-  (wait-until #(= (title) "Nevergreen"))
+    (wait-until #(= (title) "Nevergreen"))

-  (doseq [actual-project (elements "#projects > li > div > div")]
-    (is (in? expected-projects (text actual-project)) "Expected project not displayed")))
+    (doseq [actual-project (elements "#projects > li > div > div")]
+      (is (in? expected-projects (text actual-project)) "Expected project not displayed"))))


Exports to XML - updated to export all new attributes

--- src/zg/server.clj
+++ src/zg/server.clj
@@ -317,10 +317,20 @@
     (with-out-str
         (xml/emit {:tag :whitelist :content (for [word words]
                                              {:tag :word :attrs {
-                                                             :added-by     (:user word)
-                                                             :date-time    (:datetime word)
-                                                             :deleted      (:deleted word)
-                                                             :description  (:description word)}
+                                                             :added-by        (:user word)
+                                                             :date-time       (:datetime word)
+                                                             :deleted         (:deleted word)
+                                                             :description     (:description word)
+                                                             :class           (:class_name word)
+                                                             :source          (:source word)
+                                                             :product         (:product word)
+                                                             :use             (:use word)
+                                                             :correct_forms   (:correct_forms word)
+                                                             :incorrect_forms (:incorrect_forms word)
+                                                             :see_also        (:see_also word)
+                                                             :internal        (:internal word)
+                                                             :verified        (:verified word)
+                                                             :copyrighted     (:copyrighted word)}
                                                              :content      [(:word word)]})})))

 (defn words->edn


Add support for eskip file

Add support for eskip file

--- src/instaskip/core.clj
+++ src/instaskip/core.clj
@@ -5,7 +5,8 @@
 (def eskip
   (insta/parser
     "
-     eskip            = name <':'> predicates <'->'> (filter <'->'> )* backend
+     eskip-file       = eskip+
+     eskip            = name <':'> predicates <'->'> (filter <'->'> )* backend <';'>
      name             = #'[a-zA-Z0-9]+'
      predicates       = predicate? (<'&&'> predicate)*
      predicate        = predicate-name <'('> predicate-arg? (<','> predicate-arg)* <')'>
@@ -24,11 +25,13 @@
     :auto-whitespace :standard))

-(let [eskip-route "hello: predicate1(/^.*$/) && predicate2(\"arg1\", 4.3)
-                   -> filter1(\"arg1\")
-                   -> filter2(\"arg1\", 4.3, \"arg2\")
-                   -> filter3()
-                   -> <shunt>"]
+(let [eskip-route "
+                   hello: predicate1(/^.*$/) && predicate2(\"arg1\", 4.3)
+                   -> filter1(\"arg1\")
+                   -> filter2(\"arg1\", 4.3, \"arg2\")
+                   -> filter3()
+                   -> <shunt>;
+                   hello1: <shunt>;"]
   (defn -main
     "I don't do a whole lot ... yet."
     [& args]


Add some documentatiom

Add some documentatiom

--- worker/src/clinicico/worker/pirate/core.clj
+++ worker/src/clinicico/worker/pirate/core.clj
@@ -12,8 +12,8 @@
 (def ^:private default-packages ["RJSONIO"])

 (def ^:private load-template
-  (str "l = tryCatch(require('%1$s'), warning=function(w) w);
-        if(is(l, 'warning')) print(l[1])"))
+  (str "l = tryCatch(require('%1$s'), warning=function(w) w);"
+       "if(is(l, 'warning')) print(l[1])"))

 (def ^:private bootstrap-template "#AUTO-GENERATED\nsource('%s')\n")

@@ -26,7 +26,9 @@
     (spit (io/resource "bootstrap.R") bootstrap)))

 (defn initialize
-  [file packages]
+  "Generates a bootstrap.R file and executes scripts/start.sh in a shell
+   Typically starting a new RServe with the generated file 'sourced'"
+  [packages]
   (create-bootstrap packages)
   (sh (io/as-relative-path "scripts/start.sh")))

@@ -52,6 +54,10 @@
       (str e))))

 (defn execute
+  "Executes, in R, the method present in the file with the given params.
+   Callback is function taking one argument which can serve to
+   allow OOB updates from the R session
+   See resources/wrap.R for details."
   [file method params callback]
   (with-open [R (pirate/connect)]
     (try


Garr references

Garr references

--- src/lazubot/docker.clj
+++ src/lazubot/docker.clj
@@ -2,7 +2,7 @@
   (:require [clojure.string :as string]
             [clojure.java.io :as io]
             [clojure.java.shell :as shell]
-            [clojure.core.async :refer [go chan sliding-buffer <! >! timeout alts!]]
+            [clojure.core.async :refer [go go-loop chan sliding-buffer <! >! timeout alts!]]
             [com.keminglabs.zmq-async.core :refer [register-socket!]]
             [clj-http.client :as client]
             [cheshire.core :as cheshire])


Oops; swapped the order of the repl host/port.

--- src/leiningen/repl.clj
+++ src/leiningen/repl.clj
@@ -91,7 +91,7 @@
 chosen randomly."
   ([] (repl {}))
   ([project]
-     (let [[host port] (repl-socket-on project)
+     (let [[port host] (repl-socket-on project)
            server-form (repl-server project host port)]
        (future (try (if (empty? project)
                       (clojure.main/with-bindings


Fix issue with overly lenient tag finding in 'newest-voom-ver-by-spec.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -453,7 +453,11 @@
                             (= found-path (:path %))) (map parse-tag refs))]
       (some (fn [[current next-commit]]
               (when (or (= :end next-commit)
-                        (some #(= found-path (:path (parse-tag %)))
+                        (some #(let [t (parse-tag %)]
+                                 (and
+                                  (= "voom" (:prefix t))
+                                  (= (str proj-name) (:proj t))
+                                  (= found-path (:path t))))
                               (:refs next-commit)))
                 {:sha (:sha current)
                  :ctime (:ctime current)


Remove voom-tag related functions

Remove voom-tag related functions

The whole approach of using git tags to store lein project version information
has been abandoned as unworkable. We're now using core.logic/pldb instead.

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -463,92 +463,6 @@
       xs))
    (lazy-seq (println "done"))))

-(defn parse-sha-refs
-  [s]
-  (let [[sha datestr parents refstr] (vec (.split #"," s 4))
-        refs (when refstr
-               (when-let [[_ x] (re-find #"\((.*)\)" refstr)]
-                 (mapv #(s/replace % #"^tag: " "") (.split #",\s+" x))))]
-    {:sha sha, :ctime (Date. ^String datestr), :parents parents, :refs refs}))
-
-(defn project-change-shas
-  [gitdir & opts]
-  (->> (apply git {:gitdir gitdir} "log" "--pretty=format:%H,%cd,%p,%d"
-              "--name-status" "-m" opts)
-       :lines
-       (keep #(if-let [[_ op path] (re-matches #"(.)\t(.*)" %)]
-                (when (re-find #"(^|/)project\.clj$" path)
-                  {:op op :path path})
-                (when (seq %)
-                  (parse-sha-refs %))))
-       (#(concat % [{:sha "end sigil"}]))
-       (reductions (fn [[partial complete] entry]
-                     (if (:sha entry)
-                       [entry partial]
-                       [(update-in partial [:ops] (fnil conj []) entry) nil]))
-                   [nil nil])
-       (keep second)
-       (filter :ops)))
-
-(def repo-tag-version "2")
-
-(defn get-repo-tag-version
-  [gitdir]
-  (-> (git {:gitdir gitdir :ok-statuses #{0 1}}
-           "config" "--local" "voom.tag-version") :out s/trim))
-
-(defn set-repo-tag-version
-  [gitdir ver]
-  (git {:gitdir gitdir :ok-statuses #{0 5}}
-       "config" "--local" "--unset-all" "voom.tag-version")
-  (git {:gitdir gitdir}
-       "config" "--local" "--add" "voom.tag-version" (str ver)))
-
-(defn clear-voom-tags
-  [gitdir]
-  (let [tags (->> (git {:gitdir gitdir} "tag" "--list" "voom-*")
-                  :lines
-                  (remove empty?))]
-    (when (seq tags)
-      (apply git {:gitdir gitdir} "tag" "--delete" tags)
-      nil)))
-
-(defn tag-repo-projects
-  [gitdir]
-  (when (not= repo-tag-version (get-repo-tag-version gitdir))
-    (clear-voom-tags gitdir))
-  (let [branches (origin-branches gitdir)
-        proj-shas (apply project-change-shas gitdir
-                         "--not" "--tags=voom-branch--*"
-                         (map #(str #_double-negative--> "^origin/" %) branches))]
-
-    ;; add missing voom-- tags
-    (doseq [:when (seq proj-shas)
-            {:keys [sha refs parents ops]} (report-progress gitdir proj-shas)
-            {:keys [op path]} ops]
-      (when-let [p (if (= "D" op)
-                     {:root (str (.getParent (io/file path)))}
-                     (robust-read-project gitdir sha path))]
-        (let [snaps (some #(.contains ^String % "-SNAPSHOT")
-                         (map second (:dependencies p)))
-              tag (s/join "--" (-> ["voom"
-                                    (str (:group p)
-                                         (when (:group p) "%")
-                                         (:name p))
-                                    (:version p)
-                                    (s/replace (:root p) #"/" "%")
-                                    (subs sha 0 7)
-                                    (when snaps "snaps")
-                                    (when (empty? parents) "no-parent")]))]
-          (git {:gitdir gitdir} "tag" "-f" tag sha))))
-
-    ;; TODO: clean up abandoned voom-- and voom-branch-- tags
-    ;; Update all voom-branch-- tags
-    (doseq [branch branches]
-      (let [tag (str "voom-branch--" branch)]
-        (git {:gitdir gitdir} "tag" "-f" tag (str "origin/" branch)))))
-  (set-repo-tag-version gitdir repo-tag-version))
-
 (defn p-repos
   "Call f once for each repo dir, in parallel. When all calls are
   done, return nil."
@@ -558,26 +472,6 @@
        doall
        (map deref)
        dorun))
-
-(defn parse-tag
-  [tag]
-  (->
-   (zipmap [:prefix :proj :version :path :sha :snaps :no-parent] (s/split tag #"--"))
-   (update-in [:path] (fnil #(s/replace % #"%" "/") :NOT_FOUND))
-   (update-in [:proj] (fnil #(s/replace % #"%" "/") :NOT_FOUND))))
-
-(defn assert-good-version [ver proj-name version tags found-branch neg-tags commits]
-  (when-not ver
-    (println "Tags matching" proj-name version ":")
-    (doseq [t tags]
-      (prn t))
-    (println "Tag filters to exclude from branch" found-branch ":")
-    (doseq [t neg-tags]
-      (prn t))
-    (println "Commits:")
-    (doseq [c commits]
-      (prn c))
-    (throw (ex-info "Failed to find version for commit." {}))))

 (declare newest-voom-ver-by-spec)

@@ -648,7 +542,6 @@
   Example: lein voom freshen"
   [project]
   (ensure-deps-repos (:dependencies project))
-  (p-repos (fn [p] (fetch-all [p]) (tag-repo-projects p)))
   (let [prj-file-name (str (:root project) "/project.clj")
         old-deps (:dependencies project)
         desired-new-deps (doall (map #(fresh-version %) old-deps))]
@@ -781,7 +674,6 @@
   [proj & adeps]
   (let [deps (fold-args-as-meta (map edn/read-string adeps))]
     (ensure-deps-repos deps)
-    (p-repos (fn [p] (tag-repo-projects p)))
     (doseq [dep deps
             :let [full-projs (if (.contains (str dep) "/")
                                [dep]
@@ -886,16 +778,6 @@
   [project & args]
   (apply wrap project "deploy" args))

-(defn retag-all-repos
-  "Clear and recreate all voom index tags in $VOOM_REPOS.
-
-  You shouldn't need to use this usually because the index tags are
-  automatically added incrementally and re-generated when tag schemas
-  change.
-
-  Example: lein voom retag-all-repos"
-  [_]
-  (time (p-repos (fn [p] (clear-voom-tags p) (tag-repo-projects p)))))

 ;; ===== Git import =====

@@ -1248,7 +1130,7 @@
 (def ^{:doc "Display this help message"} box-help help)

 (def subtasks [#'build-deps #'deploy #'find-box #'freshen #'help #'install
-               #'retag-all-repos #'update-repo-dbs #'ver-parse #'wrap
+               #'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:


cues with heads positioning chase

cues with heads positioning chase

--- src/lights/my_show.clj
+++ src/lights/my_show.clj
@@ -442,6 +442,36 @@
     :short-name "Back only"
     ))

+  (ct/set-cue! (:cue-grid *show*) 0 4
+    (cues/cue :position  (fn [_] (afterglow.effects/scene
+      "Change heads directions"
+      (fx/chase "Chase heads directions" [
+        (move/direction-effect "" (params/build-direction-param :x 0 :y 0 :z 1) (show/fixtures-named "head"))
+        (move/direction-effect "" (params/build-direction-param :x 1 :y 0 :z 0) (show/fixtures-named "head"))
+        (move/direction-effect "" (params/build-direction-param :x 0 :y 0 :z -1) (show/fixtures-named "head"))
+        (move/direction-effect "" (params/build-direction-param :x 0 :y -1 :z 0) (show/fixtures-named "head"))
+        (move/direction-effect "" (params/build-direction-param :x -1 :y 0 :z 0) (show/fixtures-named "head"))
+        ]
+        (params/build-step-param :interval :beat :fade-fraction 0.3 :fade-curve :sine)
+        :beyond :loop
+        )))))
+
+  (ct/set-cue! (:cue-grid *show*) 1 4
+    (cues/cue :position  (fn [_] (afterglow.effects/scene
+      "Heads corners of dancefloor"
+      (fx/chase "Heads corners of dancefloor" [
+        (move/aim-effect "" (params/build-aim-param :x 0 :y 0 :z 0) (show/fixtures-named "head"))
+        (move/aim-effect "" (params/build-aim-param :x 5 :y 0 :z 0) (show/fixtures-named "head"))
+        (move/aim-effect "" (params/build-aim-param :x -5 :y 0 :z 0) (show/fixtures-named "head"))
+        (move/aim-effect "" (params/build-aim-param :x -5 :y 0 :z 5) (show/fixtures-named "head"))
+        (move/aim-effect "" (params/build-aim-param :x 0 :y 0 :z 5) (show/fixtures-named "head"))
+        (move/aim-effect "" (params/build-aim-param :x 5 :y 0 :z 5) (show/fixtures-named "head"))
+        (move/aim-effect "" (params/build-aim-param :x 5 :y 0 :z 10) (show/fixtures-named "head"))
+        (move/aim-effect "" (params/build-aim-param :x -5 :y 0 :z 10) (show/fixtures-named "head"))
+        ]
+        (params/build-step-param :interval :beat :fade-fraction 0.3 :fade-curve :sine)
+        :beyond :loop
+        )))))

   (ct/set-cue! (:cue-grid *show*) 0 3
     (cues/cue :color  (fn [_] (afterglow.effects/scene